merge new command mail framework [from command-reconstruct branch]

3 files changed, 260 insertions, 34 deletions

diff --git a/fml/lib/FML/Command/Admin/password.pm b/fml/lib/FML/Command/Admin/password.pm
index 949c08c9..1649a660 100644
--- a/fml/lib/FML/Command/Admin/password.pm
+++ b/fml/lib/FML/Command/Admin/password.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: password.pm,v 1.12 2004/01/01 08:41:34 fukachan Exp $
+# $FML: password.pm,v 1.13.2.1 2004/03/04 04:00:20 fukachan Exp $
 #
 
 package FML::Command::Admin::password;
@@ -59,6 +59,59 @@ sub need_lock { 1;}
 sub lock_channel { return 'command_serialize';}
 
 
+# Descriptions: rewrite buffer to hide the password phrase in $rbuf
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) STR_REF($rbuf)
+# Side Effects: none
+# Return Value: none
+sub rewrite_prompt
+{
+    my ($self, $curproc, $command_args, $rbuf) = @_;
+
+    if (defined $rbuf) {
+	$$rbuf =~ s/^(.*(password|pass)\s+).*/$1 ********/;
+    }
+}
+
+
+=head2 verify_syntax($curproc, $command_args)
+
+verify the syntax command string.
+return 0 if it looks insecure.
+
+=cut
+
+
+# Descriptions: verify the syntax command string.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub verify_syntax
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $comname    = $command_args->{ comname }    || '';
+    my $comsubname = $command_args->{ comsubname } || '';
+    my $options    = $command_args->{ options }    || [];
+    my @test       = ($comname);
+
+    # XXX Let original_command be "admin password PASSWORD".
+    # XXX options = [ 'password', PASSWORD ] (not shifted yet here).
+    my $i = 0;
+  DATA:
+    for my $x (@$options) {
+	if ($i++ == 1) {
+	    push(@test, "PASSWORD");
+	}
+	else {
+	    push(@test, $x);
+	}
+    }
+
+    use FML::Command;
+    my $dispatch = new FML::Command;
+    return $dispatch->safe_regexp_match($curproc, $command_args, \@test);
+}
+
+
 # Descriptions: dummy in the case of command mail.
 #
 #               [Case 1: command mail]
@@ -74,23 +127,12 @@ sub lock_channel { return 'command_serialize';}
 sub process
 {
     my ($self, $curproc, $command_args) = @_;
+    my $option = $command_args->{ options } || [];
 
-    # dummy. see descriptions above.
-    return 1;
-}
-
-
-# Descriptions: rewrite buffer to hide the password phrase in $rbuf
-#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) STR_REF($rbuf)
-# Side Effects: none
-# Return Value: none
-sub rewrite_prompt
-{
-    my ($self, $curproc, $command_args, $rbuf) = @_;
-
-    if (defined $rbuf) {
-	$$rbuf =~ s/^(.*(password|pass)\s+).*/$1 ********/;
-    }
+    # XXX Let original_command be "admin password PASSWORD".
+    # XXX $option is shifted before this method called, so [ PASSWORD ] now.
+    my $p = $option->[ 0 ];
+    $curproc->command_context_set_admin_password($p);
 }
 
 
diff --git a/fml/lib/FML/Command/Auth.pm b/fml/lib/FML/Command/Auth.pm
index 9b88d9c0..5fc76037 100644
--- a/fml/lib/FML/Command/Auth.pm
+++ b/fml/lib/FML/Command/Auth.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: Auth.pm,v 1.32 2004/01/02 14:50:30 fukachan Exp $
+# $FML: Auth.pm,v 1.33.2.1 2004/03/04 04:21:28 fukachan Exp $
 #
 
 package FML::Command::Auth;
@@ -132,6 +132,7 @@ sub check_admin_member_password
     my ($self, $curproc, $optargs) = @_;
     my $function = "check_admin_member_password";
     my $cred     = $curproc->{ credential };
+    my $sender   = $cred->sender();
     my $config   = $curproc->config();
     my $status   = 0;
 
@@ -142,8 +143,8 @@ sub check_admin_member_password
     return 0 unless $optargs->{ password };
 
     # get a set of address and password
-    my $address  = $optargs->{ address };
-    my $password = $optargs->{ password };
+    my $address  = $optargs->{ address }  || $sender;
+    my $password = $optargs->{ password } || '';
     unless ($address && $password) {
 	# XXX-TODO: please return error message.
 	return 0;
@@ -162,6 +163,10 @@ sub check_admin_member_password
     # o.k. start ...
     $curproc->lock($lock_channel);
 
+    # error details.
+    my $user_entry_found = 0;
+    my $password_match   = 0;
+
     # search $user in password database map, which has a hash of
     # { $user => $encrypted_passwrod }.
     my $maplist = $config->get_as_array_ref('admin_member_password_maps');
@@ -179,15 +184,18 @@ sub check_admin_member_password
 	  PASSWORD_ENTRY:
 	    for my $r (@$pwent) {
 		my ($u, $p_infile) = split(/\s+/, $r);
-		my $p_input        = $crypt->unix_crypt($password, $p_infile);
 
 		# 1.1 user match ? ($address syntax is checked above.)
 		if ($cred->is_same_address($u, $address)) {
+		    $user_entry_found = 1;
+
 		    # 1.2 password match ?
+		    my $p_input = $crypt->unix_crypt($password, $p_infile);
 		    if ($p_infile eq $p_input) {
 			if ($debug) {
 			    $curproc->log("$function: password match");
 			}
+			$password_match = 1;
 			$status = 1;
 			last PASSWORD_ENTRY;
 		    }
@@ -198,7 +206,18 @@ sub check_admin_member_password
 
     $curproc->unlock($lock_channel);
 
-    $curproc->logerror("$function: password mismatch") unless $status;
+    unless ($status) {
+	# 1. user not found.
+	unless ($user_entry_found) {
+	    $curproc->logerror("$function: no such user");
+	}
+	# 2. user is found but password is wrong.
+	else {
+	    unless ($password_match) {
+		$curproc->logerror("$function: password mismatch");
+	    }
+	}
+    }
     return $status;
 }
 
@@ -249,6 +268,9 @@ sub change_password
 		$curproc->log("delete $address from=$map");
 	    }
 	}
+	else {
+	    $curproc->logerror("$address not found");
+	}
 
 	# add
 	$obj->add( $address, [ $cp, "UNIX_CRYPT" ] ) && $status++;
diff --git a/fml/lib/FML/Command/User/admin.pm b/fml/lib/FML/Command/User/admin.pm
index d4a2b5ee..a6769fbe 100644
--- a/fml/lib/FML/Command/User/admin.pm
+++ b/fml/lib/FML/Command/User/admin.pm
@@ -1,10 +1,10 @@
 #-*- perl -*-
 #
-#  Copyright (C) 2003 Ken'ichi Fukamachi
+#  Copyright (C) 2003,2004 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.
 #
-# $FML: admin.pm,v 1.2 2003/02/09 12:31:42 fukachan Exp $
+# $FML: admin.pm,v 1.3.2.1 2004/03/04 04:02:56 fukachan Exp $
 #
 
 package FML::Command::User::admin;
@@ -13,6 +13,19 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
 use Carp;
 
 
+=head1 NAME
+
+FML::Command::User::admin - entrance for priviledged command world.
+
+=head1 SYNOPSIS
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+=cut
+
+
 # Descriptions: constructor.
 #    Arguments: OBJ($self)
 # Side Effects: none
@@ -42,22 +55,171 @@ sub rewrite_prompt
 }
 
 
-# XXX-TODO: process() is not implementd. correct ?
+# Descriptions: need lock or not
+#    Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 0;}
 
 
-=head1 NAME
+=head2 verify_syntax($curproc, $command_args)
 
-FML::Command::User::admin - dummy.
+verify the syntax command string.
+return 0 if it looks insecure.
 
-=head1 SYNOPSIS
+=cut
 
-See C<FML::Command> for more details.
 
-=head1 DESCRIPTION
+# Descriptions: verify the syntax command string.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub verify_syntax
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $command = undef;
+    my $comname = $command_args->{ comsubname };
+    my $pkg     = "FML::Command::Admin::${comname}";
+
+    eval qq{ use $pkg; \$command = new $pkg;};
+    unless ($@) {
+	if ($command->can('verify_syntax')) {
+	    return $command->verify_syntax($curproc, $command_args);
+	}
+    }
+
+    use FML::Command;
+    my $dispatch = new FML::Command;
+    return $dispatch->simple_syntax_check($curproc, $command_args);
+}
+
+
+# Descriptions: interface for priviledged command world.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update authentication state if needed.
+# Return Value: none
+sub process
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $command = $command_args->{ original_command };
+
+    # 1. check already authenticated. if not, try auth.
+    #    authentication rules are defined as $admin_command_restrictions.
+    #    XXX _try_admin_auth() needs to handle several types:
+    #              1. password auth (one line).
+    #              2. pgp auth      (one file).
+    unless ($curproc->command_context_get_admin_auth()) {
+	my $status = $self->_try_admin_auth($curproc, $command_args);
+	if ($status) {
+	    $curproc->reply_message_nl("command.admin_auth_ok",
+				       "authenticated.");
+	    $curproc->command_context_set_admin_auth();
+	}
+    }
+
+    # 2. run admin command if already authenticated. 
+    #    if not, fatal error.
+    if ($curproc->command_context_get_admin_auth()) {
+	my $class = $command_args->{ comsubname } || '';
+	$self->_execute_admin_command($curproc, $command_args, $class);
+    }
+    else {
+	$curproc->logerror("admin: not auth, cannot run \"$command\"");
+	$curproc->reply_message_nl("command.admin_auth_fail",
+				   "not authenticated.");
+	$curproc->command_context_set_stop_process();
+	croak("admin authentication failed.");
+    }
+}
+
+
+# Descriptions: authenticate the currrent process sender as an admin.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub _try_admin_auth
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $config  = $curproc->config();
+    my $rules   = $config->get_as_array_ref('admin_command_restrictions');
+    my $cred    = $curproc->{ credential };
+    my $sender  = $cred->sender();
+    my $optargs = { address => $sender };
+    my $class   = $command_args->{ comsubname } || '';
+    my $is_auth = 0;
+
+    # XXX-TODO: configurable.
+    # prepare() for later use.
+    if ($class eq 'pass' || $class eq 'password') {
+	$self->_execute_admin_command($curproc, $command_args, $class);
+	my $p = $curproc->command_context_get_admin_password();
+	$optargs->{ password } = $p || '';
+    }
+
+    use FML::Command::Auth;
+    my $auth = new FML::Command::Auth;
+    for my $rule (@$rules) {
+	$is_auth = $auth->$rule($curproc, $optargs);
+
+	# reject as soon as possible
+	if ($is_auth eq '__LAST__') {
+	    $curproc->log("admin: rejected by $rule");
+	    return 0;
+	}
+	elsif ($is_auth) {
+	    $curproc->log("admin: auth by $rule");
+	    return $is_auth;
+	}
+	else {
+	    $curproc->log("admin: not match rule=$rule");
+	}
+    }
+
+    # deny transition to admin mode by default
+    return 0;
+}
+
+
+# Descriptions: execute admin command.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args) STR($class)
+# Side Effects: none
+# Return Value: none
+sub _execute_admin_command
+{
+    my ($self, $curproc, $command_args, $class) = @_;
+    my $args = $self->_prepare_command_args($curproc, $command_args);
+
+    use FML::Command;
+    my $dispatch = new FML::Command;
+    $dispatch->$class($curproc, $args);
+}
+
+
+# Descriptions: adjust $command_args for admin mode.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: none
+sub _prepare_command_args
+{
+    my ($self, $curproc, $command_args) = @_;
+
+    # duplicate $command_args HASH_REF.
+    my $args = {};
+    for my $k (keys %$command_args) {
+	$args->{ $k } = $command_args->{ $k };
+    }
+    $args->{ command_mode } = 'Admin';
+
+    # we need to shift "options" by one column in admin command.
+    # e.g. for "admin add some thing", 
+    # options = [ add, some, thing ] => [ some, thing ]
+    my @options = @{ $command_args->{ options } };
+    shift @options;
+    $args->{ options } = \@options;
+
+    return $args;
+}
 
-In fact, this module is dummy but provide utility for the case auth
-fail. It rewrites buffer to hide the password phrase in command
-prompt.
 
 =head1 CODING STYLE
 
@@ -69,7 +231,7 @@ Ken'ichi Fukamachi
 
 =head1 COPYRIGHT
 
-Copyright (C) 2003 Ken'ichi Fukamachi
+Copyright (C) 2003,2004 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.