add prototype of admin command auth governed by $admin_command_restrictions

2 files changed, 122 insertions, 23 deletions

diff --git a/fml/lib/FML/Command/Auth.pm b/fml/lib/FML/Command/Auth.pm
new file mode 100644
index 00000000..04927857
--- /dev/null
+++ b/fml/lib/FML/Command/Auth.pm
@@ -0,0 +1,75 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2002 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: @template.pm,v 1.5 2002/01/18 15:37:38 fukachan Exp $
+#
+
+package FML::Command::Auth;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+
+=head1 NAME
+
+FML::Command::Auth - authentication functions
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new()>
+
+=cut
+
+
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+sub reject
+{ 
+    return 0;
+}
+
+
+sub check_password
+{
+    return 1;
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 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::Command::Auth appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Process/Command.pm b/fml/lib/FML/Process/Command.pm
index d6d16693..d88f8e83 100644
--- a/fml/lib/FML/Process/Command.pm
+++ b/fml/lib/FML/Process/Command.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001,2002 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: Command.pm,v 1.37 2002/03/17 06:24:31 fukachan Exp $
+# $FML: Command.pm,v 1.38 2002/03/22 11:40:27 fukachan Exp $
 #
 
 package FML::Process::Command;
@@ -256,27 +256,6 @@ sub _is_valid_command
 	return 0;
     }
 
-    if (0) {
-	# 3. Even new comer need to use commands [ guide, subscirbe, confirm ].
-	unless ($cred->is_member($curproc, $args)) {
-	    unless ($config->has_attribute("available_commands_for_stranger",
-					   $comname)) {
-		$curproc->reply_message("\n$prompt $command");
-		$curproc->reply_message_nl('command.deny',
-					   "not allowed to use this command.");
-		return 0;
-	    }
-	    else {
-		return 1;
-		Log("permit command $comname for stranger");
-	    }
-	}
-
-	# not reach here
-	LogWarn("_is_member: invalid condition");
-	return 0;
-    }
-
     return 1; # o.k. accpet this command.
 }
 
@@ -318,6 +297,39 @@ sub _get_command_name
 }
 
 
+sub _auth_admin
+{
+    my ($curproc, $args, $optargs) = @_;
+    my $is_auth = 0;
+    my $obj     = undef;
+
+    eval q{
+	use FML::Command::Auth;
+	$obj = new FML::Command::Auth;
+    };
+    unless ($@) {
+	my $config = $curproc->{ config };
+	my $rules  = $config->get_as_array_ref('admin_command_restrictions');
+	for my $rule (@$rules) {
+	    if ($rule eq 'reject') { 
+		return 0;
+	    }
+
+	    $is_auth = $obj->$rule($curproc, $args, $optargs);
+	    if ($is_auth) { 
+		return $is_auth;
+	    }
+	    else {
+		Log("admin: $rule fail");
+	    }
+	}
+    }
+    else {
+	return 0;
+    }
+}
+
+
 # Descriptions: scan message body and execute approviate command
 #               with dynamic loading of command definition.
 #               It resolves your customized command easily.
@@ -353,7 +365,11 @@ sub _evaluate_command
     # 
     my $cred      = $curproc->{ credential };
     my $is_member = $cred->is_member($curproc, $args);
+
+    # is_admin: From: is a member of admin users.
+    #  is_auth: authenticated or not by e.g. password
     my $is_admin  = $cred->is_privileged_member($curproc, $args);
+    my $is_auth   = 0;
 
     # 
     # main loop
@@ -397,7 +413,15 @@ sub _evaluate_command
 	}
 	# Case: "admin" command is exceptional. try priviledged mode.
 	elsif ($comname =~ /$admin_prefix/) {
-	    if ($is_admin) {
+	    unless ($is_auth) { # for the first time ?
+		my $sender  = $curproc->{'credential'}->{'sender'};
+		my $optargs = { address => $sender, data => $command };
+
+		# try auth by FML::Command::Auth;
+		$is_auth = $curproc->_auth_admin($args, $optargs);
+	    }
+
+	    if ($is_admin && $is_auth) {
 		$comname = $comsubname;
 		$command =~ s/^.*$comname/admin $comname/;
 		$opts    = { comname => $comname, command => $command };