add/enable a prototype of libexe/fml/error (mead)

5 files changed, 236 insertions, 7 deletions

diff --git a/INSTALL.sh b/INSTALL.sh
index 0d14d21a..41e8d908 100755
--- a/INSTALL.sh
+++ b/INSTALL.sh
@@ -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: INSTALL.sh,v 1.46 2002/04/15 10:28:08 fukachan Exp $
+# $FML: INSTALL.sh,v 1.47 2002/04/25 04:45:15 fukachan Exp $
 #
 
 # Run this from the top-level fml source directory.
@@ -99,8 +99,8 @@ do
 	mv ${bindir}/$prog.new ${bindir}/$prog
 done
 
-PROGRAMS="fml.pl distribute command ";
-PROGRAMS="$PROGRAMS fmlserv mead fmlconf fmldoc"
+PROGRAMS="fml.pl distribute command error mead";
+PROGRAMS="$PROGRAMS fmlserv fmlconf fmldoc"
 PROGRAMS="$PROGRAMS fmlthread fmlthread.cgi"
 PROGRAMS="$PROGRAMS makefml makefml.cgi menu.cgi"
 PROGRAMS="$PROGRAMS fmlsch fmlsch.cgi"
diff --git a/fml/etc/aliases b/fml/etc/aliases
index 6699fa3b..409a775d 100644
--- a/fml/etc/aliases
+++ b/fml/etc/aliases
@@ -11,5 +11,7 @@ owner-__ml_name__-ctl: __fml_owner__
 # maintainer
 __ml_name__-request: __ml_name__-admin
 __ml_name__-admin: __fml_owner__
+#__ml_name__-admin: __fml_owner__, __ml_name__-error
+#__ml_name__-error: :include:__ml_home_dir__/include-error
 
 ### </ALIASES __ml_name__@__ml_domain__ ML> ###
diff --git a/fml/etc/include-error b/fml/etc/include-error
new file mode 100644
index 00000000..22c43b0e
--- /dev/null
+++ b/fml/etc/include-error
@@ -0,0 +1 @@
+"| __executable_prefix__/error __ml_home_prefix__/__ml_name__"
diff --git a/fml/lib/FML/Process/Error.pm b/fml/lib/FML/Process/Error.pm
new file mode 100644
index 00000000..62afdff9
--- /dev/null
+++ b/fml/lib/FML/Process/Error.pm
@@ -0,0 +1,224 @@
+#-*- perl -*-
+#
+# Copyright (C) 2002 Ken'ichi Fukamachi
+#          All rights reserved.
+#
+# $FML: Error.pm,v 1.55 2002/05/19 04:57:46 fukachan Exp $
+#
+
+package FML::Process::Error;
+
+use vars qw($debug @ISA @EXPORT @EXPORT_OK);
+use strict;
+use Carp;
+use FML::Log qw(Log LogWarn LogError);
+use FML::Config;
+use FML::Process::Kernel;
+@ISA = qw(FML::Process::Kernel);
+
+
+=head1 NAME
+
+FML::Process::Error -- command dispacher.
+
+=head1 SYNOPSIS
+
+   use FML::Process::Error;
+   ...
+
+See L<FML::Process::Flow> for details of fml process flow.
+
+=head1 DESCRIPTION
+
+C<FML::Process::Error> is a command wrapper and top level
+dispatcher for commands. 
+
+=head1 METHODS
+
+=head2 C<new($args)>
+
+make fml process object, which inherits C<FML::Process::Kernel>.
+
+=cut
+
+
+# Descriptions: standard constructor.
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: inherit FML::Process::Kernel
+# Return Value: OBJ
+sub new
+{
+    my ($self, $args) = @_;
+    my $type    = ref($self) || $self;
+    my $curproc = new FML::Process::Kernel $args;
+    return bless $curproc, $type;
+}
+
+
+=head2 C<prepare($args)>
+
+forward the request to SUPER CLASS.
+
+=cut
+
+# Descriptions: dummy
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub prepare
+{
+    my ($self, $args) = @_;
+    my $config = $self->{ config };
+
+    my $eval = $config->get_hook( 'error_prepare_start_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+
+    $self->SUPER::prepare($args);
+
+    $eval = $config->get_hook( 'error_prepare_end_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+}
+
+
+=head2 C<verify_request($args)>
+
+verify the sender is a valid member or not.
+
+=cut
+
+
+# Descriptions: verify the sender of this process is an ML member.
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: 1 or 0
+sub verify_request
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->{ config };
+
+    my $eval = $config->get_hook( 'error_verify_request_start_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+
+    $curproc->verify_sender_credential();
+
+    $eval = $config->get_hook( 'error_verify_request_end_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+}
+
+
+=head2 C<run($args)>
+
+dispatcher to run correspondig C<FML::Error::command> for
+C<command>. Standard style follows:
+
+    lock
+    execute FML::Error::command
+    unlock
+
+XXX Each command determines need of lock or not.
+
+=cut
+
+
+# Descriptions: call _evaluate_command_lines()
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub run
+{
+    my ($curproc, $args) = @_;
+    my $msg = $curproc->{ incoming_message }->{ message };
+
+    eval q{
+	use Mail::Bounce;
+	my $bouncer = new Mail::Bounce;
+	$bouncer->analyze( $msg );
+    };
+    unles ($@) {
+	# show results
+	for my $a ( $bouncer->address_list ) {
+	    my $status = $bouncer->status( $a );
+	    my $reason = $bouncer->reason( $a );
+	    Log("bounced: $a");
+	    Log("bounced: reason=$reason");
+	    Log("bounced: status=$status");
+	}
+    }
+    else {
+	LogError($@);
+    }
+}
+
+
+=head2 help()
+
+show help.
+
+=cut
+
+
+# Descriptions: show help
+#    Arguments: none
+# Side Effects: none
+# Return Value: none
+sub help
+{
+print <<"_EOF_";
+
+Usage: $0 \$ml_home_prefix/\$ml_name [options]
+
+   For example, process command of elena ML
+   $0 /var/spool/ml/elena
+
+_EOF_
+}
+
+
+=head2 C<finish($args)>
+
+    $curproc->inform_reply_messages();
+
+=cut
+
+
+# Descriptions: finalize command process.
+#               reply messages, command results et. al.
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: queue manipulation
+# Return Value: none
+sub finish
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->{ config };
+
+    my $eval = $config->get_hook( 'error_finish_start_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+
+    $curproc->inform_reply_messages();
+    $curproc->queue_flush();
+
+    $eval = $config->get_hook( 'error_finish_end_hook' );
+    if ($eval) { eval qq{ $eval; }; LogWarn($@) if $@; }
+}
+
+
+=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::Process::Error 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/Switch.pm b/fml/lib/FML/Process/Switch.pm
index 5a4af3fa..0d9c7611 100644
--- a/fml/lib/FML/Process/Switch.pm
+++ b/fml/lib/FML/Process/Switch.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: Switch.pm,v 1.66 2002/04/19 13:34:19 fukachan Exp $
+# $FML: Switch.pm,v 1.67 2002/04/25 04:46:09 fukachan Exp $
 #
 
 package FML::Process::Switch;
@@ -390,6 +390,8 @@ sub _module_specific_options
     if ($myname eq 'fml.pl'     ||
 	$myname eq 'distribute' ||
 	$myname eq 'command'    ||
+	$myname eq 'mead'       ||
+	$myname eq 'error'      ||
 	$myname eq 'loader' ) {
 	return qw(ctladdr! debug! help! params=s -c=s);
     }
@@ -490,6 +492,9 @@ sub _module_we_use
     elsif ($name eq 'fml.pl' || $name eq 'distribute' || $name eq 'loader') {
 	$pkg = 'FML::Process::Distribute';
     }
+    elsif ($name eq 'mead' || $name eq 'error') {
+	$pkg = 'FML::Process::Error';
+    }
     elsif ($name eq 'fmlserv') {
 	$pkg = 'FML::Process::ListServer';
     }
@@ -513,9 +518,6 @@ sub _module_we_use
 	   $name eq 'threadview.cgi') {
 	$pkg = 'FML::CGI::ThreadTrack';
     }
-    elsif ($name eq 'mead') {
-	$pkg = 'FML::Process::MailErrorAnalyzer';
-    }
     elsif ($name eq 'qmail-ext') {
 	$pkg = 'FML::Process::QMail';
     }