reconstructured safe parameter definitions

2 files changed, 162 insertions, 26 deletions

diff --git a/fml/lib/FML/Process/CGI/Param.pm b/fml/lib/FML/Process/CGI/Param.pm
index 136f9c55..8722d40e 100644
--- a/fml/lib/FML/Process/CGI/Param.pm
+++ b/fml/lib/FML/Process/CGI/Param.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself. 
 #
-# $FML: Param.pm,v 1.6 2001/11/13 03:43:07 fukachan Exp $
+# $FML: Param.pm,v 1.7 2001/11/13 15:19:18 fukachan Exp $
 #
 
 package FML::Process::CGI::Param;
@@ -39,22 +39,8 @@ It provides basic functions and flow.
 
 =cut
 
-@EXPORT_OK = qw(safe_param %allow_regexp);
 
-my %allow_regexp = 
-    (
-     'address'    => '[-a-z0-9_]+\@[-A-Za-z0-9\.]+',
-     'ml_name'    => '[-a-z0-9_]+',
-     'action'     => '[-a-z_]+',
-     'command'    => '[-a-z_]+',
-     'user'       => '[-a-z0-9_]+',
-     'article_id' => '\d+',
-     );
-
-my %allow_regexp_list = 
-    (
-     'threadcgi_change_status' => 'change_status\.(__ml_name_regexp__)\/(\d+)',
-     );
+my $debug = defined $ENV{'debug'} ? 1 : 0;
 
 
 # Descriptions: 
@@ -66,10 +52,17 @@ sub safe_param
 {
     my ($self, $key) = @_;
 
-    if (defined $allow_regexp{ $key }) {
+    use FML::Process::SafeData;
+    my $safe = new FML::Process::SafeData;
+    my $safe_param_regexp  = $safe->cgi_param_regexp();
+    my $safe_method_regexp = $safe->cgi_method_regexp();
+
+    print STDERR "\n<!-- check param $key -->\n" if $debug;
+
+    if (defined $safe_param_regexp->{ $key }) {
 	if (defined param($key)) {
 	    my $value  = param($key);
-	    my $filter = $allow_regexp{ $key };
+	    my $filter = $safe_param_regexp->{ $key };
 
 	    if ($value =~ /^$filter$/) {
 		return $value;
@@ -99,16 +92,15 @@ sub safe_paramlist
     my ($self, $numregexp, $key) = @_;
     my (@list) = ();
 
-    # convert $key => regexp
-    $key = $allow_regexp_list{ $key };
-    for my $regexpkey (keys %allow_regexp) {
-	my $x = "__${regexpkey}_regexp__";
-	my $y = $allow_regexp{$regexpkey};
-	$key =~ s/$x/$y/g;
-    }
+    use FML::Process::SafeData;
+    my $safe = new FML::Process::SafeData;
+    my $safe_param_regexp  = $safe->cgi_param_regexp();
+    my $safe_method_regexp = $safe->cgi_method_regexp();
 
-    # search
+    # match method and return HASH ARRAY with matching values
+    $key = $safe_method_regexp->{ $key };
     for my $x (param()) {
+	print STDERR "\n<!-- check param: $x =~ /^$key$/ -->\n";
 	if ($x =~ /^$key$/) {
 	    my $value = defined param($x) ? param($x) : '';
 	    if ($numregexp == 1) { push(@list, [ $1, $value ] );}
diff --git a/fml/lib/FML/Process/SafeData.pm b/fml/lib/FML/Process/SafeData.pm
new file mode 100644
index 00000000..356316dd
--- /dev/null
+++ b/fml/lib/FML/Process/SafeData.pm
@@ -0,0 +1,144 @@
+#!/usr/local/bin/perl -w
+#-*- perl -*-
+#
+# Copyright (C) 2001 Ken'ichi Fukamachi
+#          All rights reserved. 
+#
+# $FML: SafeData.pm,v 1.5 2001/11/23 02:52:24 fukachan Exp $
+#
+
+package FML::Process::SafeData;
+
+use vars qw($debug @ISA @EXPORT @EXPORT_OK);
+use strict;
+use Carp;
+
+=head1 NAME
+
+FML::Process::SafeData -- define safe data class
+
+=head1 SYNOPSIS
+
+    use FML::Process::SafeData;
+    $safe = new FML::Process::SafeData;
+    my $regexp = $safe->regexp();
+
+=head1 DESCRIPTION
+
+FML::Process::SafeData provides data type considered as safe.
+
+=head1 METHODS
+
+=head2 C<new($args)>
+
+usual constructor.
+
+=cut
+
+
+# avoid default fml new() since we do not need it.
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+=head1 Basic Parameter Definition for common use
+
+   %basic_variable
+
+=cut
+
+
+my %basic_variable =
+    (
+     'address'    => '[-a-z0-9_]+\@[-A-Za-z0-9\.]+',
+     'ml_name'    => '[-a-z0-9_]+',
+     'action'     => '[-a-z_]+',
+     'command'    => '[-a-z_]+',
+     'user'       => '[-a-z0-9_]+',
+     'article_id' => '\d+',
+     );
+
+
+=head1 Safe Parameter Definition for programs kicked by MTA
+
+not defined yet.
+
+Please extract regexp hash { varname => allowed_regexp } as HASH
+REFERENCE via the following access method:
+
+    ?
+
+=head1 Safe Parameter Definition for CGI use
+
+Please extract regexp hash { varname => allowed_regexp } as HASH
+REFERENCE via the following access method:
+
+    cgi_param_regexp()
+    cgi_method_regexp()
+
+=cut
+
+
+my %cgi_methond = 
+    (
+     'threadcgi_change_status' => 'change_status\.(__ml_name_regexp__)\/(\d+)',
+     );
+
+
+
+sub cgi_param_regexp
+{ 
+    my ($self) = @_;
+
+    return \%basic_variable;
+}
+
+
+sub cgi_method_regexp
+{ 
+    my ($self) = @_;
+
+    # expand __var__regexp__ to regular expression defined in other hash
+    for my $key (keys %cgi_methond) {
+	my $value = $cgi_methond{ $key };
+	if ($value =~ /__/o) {
+
+	    # expand variables defined in %basic_variable HASH
+	    for my $regexpkey (keys %basic_variable) {
+		my $x = "__${regexpkey}_regexp__";
+		my $y = $basic_variable{$regexpkey};
+		$value =~ s/$x/$y/g;
+		$cgi_methond{ $key } = $value;
+	    }
+	}
+    }
+
+    return \%cgi_methond;
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+FML::Process::Configure appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;