allow CUI(fml,makefml) to send messages.

this function disabled by default.
fml and makefml can use --allow-send-message --send-to=ADDRESS option for it.

5 files changed, 92 insertions, 31 deletions

diff --git a/fml/etc/command_line_options b/fml/etc/command_line_options
index c222de53..9c303189 100644
--- a/fml/etc/command_line_options
+++ b/fml/etc/command_line_options
@@ -1,5 +1,5 @@
 #
-# $FML: command_line_options,v 1.13 2004/03/14 06:55:14 fukachan Exp $
+# $FML: command_line_options,v 1.14 2004/03/23 04:20:45 fukachan Exp $
 #
 # map between programs and options
 #
@@ -17,7 +17,7 @@ mead		debug! help! -c=s -o=s%
 faker		debug! help! -c=s -o=s%
 
 # bin/
-fml		debug! help! force! log-dup! log-computer-output! quiet! q! allow-send-message! -c=s -o=s% -O=s% mode=s
+fml		debug! help! force! log-dup! log-computer-output! quiet! q! allow-send-message! send-to=s -c=s -o=s% -O=s% mode=s
 fmladdr		debug! help! n! -c=s -o=s%
 fmlalias	debug! help! n! -c=s -o=s%
 fmlconf		debug! help! n! -c=s -o=s%
@@ -26,7 +26,7 @@ fmlerror	debug! help! -o=s%
 fmlhtmlify	debug! help! -I=s -o=s%
 fmlspool	debug! help! -I=s convert! style=s srcdir=s -o=s%
 fmlthread	debug! help! article_id_max=i spool_dir=s base_url=s msg_base_url=s reverse! -f=s -c=s -o=s%
-makefml		debug! help! force! log-dup! log-computer-output! quiet! q! allow-send-message! -c=s -o=s% -O=%s mode=s
+makefml		debug! help! force! log-dup! log-computer-output! quiet! q! allow-send-message! send-to=s -c=s -o=s% -O=%s mode=s
 
 # cgi-bin/
 config.cgi		
diff --git a/fml/lib/FML/Command/Admin/get.pm b/fml/lib/FML/Command/Admin/get.pm
index 1c5a1d4d..5fd77ed0 100644
--- a/fml/lib/FML/Command/Admin/get.pm
+++ b/fml/lib/FML/Command/Admin/get.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: get.pm,v 1.22 2004/01/18 03:34:44 fukachan Exp $
+# $FML: get.pm,v 1.23 2004/01/21 03:51:16 fukachan Exp $
 #
 
 package FML::Command::Admin::get;
@@ -66,6 +66,12 @@ sub process
     my $ml_home_dir = $config->{ ml_home_dir };
     my $command     = $command_args->{ command };
     my $options     = $command_args->{ options };
+    my $recipient   = '';
+
+    if ($curproc->is_cui_process()) {
+	$recipient = $curproc->command_specific_recipient() || '';
+	$command_args->{ _recipient } = $recipient;
+    }
 
     # This module is called after
     # FML::Process::Command::_can_accpet_command() already checks the
@@ -87,6 +93,7 @@ sub process
 
 	    delete $command_args->{ _filename_to_send };
 	    delete $command_args->{ _filepath_to_send };
+	    delete $command_args->{ _recipient };
 	}
 	else {
 	    $curproc->log("$filename not found");
diff --git a/fml/lib/FML/Command/SendFile.pm b/fml/lib/FML/Command/SendFile.pm
index b733ebe9..fc1870f8 100644
--- a/fml/lib/FML/Command/SendFile.pm
+++ b/fml/lib/FML/Command/SendFile.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: SendFile.pm,v 1.37 2004/02/13 14:10:26 fukachan Exp $
+# $FML: SendFile.pm,v 1.38 2004/02/15 04:38:27 fukachan Exp $
 #
 
 package FML::Command::SendFile;
@@ -82,6 +82,7 @@ sub send_article
 {
     my ($self, $curproc, $command_args) = @_;
     my $command   = $command_args->{ command };
+    my $recipient = $command_args->{ _recipient } || '';
     my $config    = $curproc->config();
     my $ml_name   = $config->{ ml_name };
     my $spool_dir = $config->{ spool_dir };
@@ -100,13 +101,16 @@ sub send_article
 		my $article  = new FML::Article $curproc;
 		my $filepath = $article->filepath($filename);
 		if (-f $filepath) {
-		    $curproc->log("send back article $filename");
-		    $curproc->reply_message( {
+		    my $rm_args = {
 			type        => "message/rfc822",
 			path        => $filepath,
 			filename    => $filename,
 			disposition => "$ml_name ML article $filename",
-		    });
+		    };
+		    if ($recipient) { $rm_args->{ recipient } = $recipient;}
+
+		    $curproc->log("send back article $filename");
+		    $curproc->reply_message($rm_args, $rm_args);
 		}
 		else {
 		    $curproc->reply_message_nl('command.no_such_article',
@@ -172,9 +176,10 @@ send back file specified as C<$command_args->{ _filepath_to_send }>.
 sub send_file
 {
     my ($self, $curproc, $command_args) = @_;
-    my $filename = $command_args->{ _filename_to_send };
-    my $filepath = $command_args->{ _filepath_to_send };
-    my $config   = $curproc->config();
+    my $filename  = $command_args->{ _filename_to_send };
+    my $filepath  = $command_args->{ _filepath_to_send };
+    my $recipient = $command_args->{ _recipient } || '';
+    my $config    = $curproc->config();
 
     # XXX get_charset() take Accpet-Language: header field into account.
     my $charset  = $curproc->get_charset("reply_message");
@@ -191,12 +196,15 @@ sub send_file
     my $xxxx_template = $curproc->prepare_file_to_return( $params );
 
     if (-f $xxxx_template) {
-	$curproc->reply_message( {
+	my $rm_args = {
 	    type        => "text/plain; charset=$charset",
 	    path        => $xxxx_template,
 	    filename    => $filename,
 	    disposition => $filename,
-	});
+	};
+	if ($recipient) { $rm_args->{ recipient } = $recipient;}
+
+	$curproc->reply_message($rm_args, $rm_args);
     }
     else {
 	croak("$filepath not found\n");
diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm
index acabf17c..048d7fb9 100644
--- a/fml/lib/FML/Process/Kernel.pm
+++ b/fml/lib/FML/Process/Kernel.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: Kernel.pm,v 1.220 2004/03/14 06:33:14 fukachan Exp $
+# $FML: Kernel.pm,v 1.221 2004/03/20 16:27:01 fukachan Exp $
 #
 
 package FML::Process::Kernel;
@@ -1449,7 +1449,10 @@ sub _reply_message_queuein
 
     # process running under MTA can handle reply messages by mail.
     unless ($curproc->allow_reply_message()) {
-	$curproc->logwarn("(debug) $myname disables reply_message()");
+	unless ($curproc->error_message_get_count("disable_reply_message")) {
+	    $curproc->logwarn("(debug) $myname disables reply_message()");
+	    $curproc->error_message_set_count("disable_reply_message");
+	}
 	return;
     }
 
diff --git a/fml/lib/FML/Process/Utils.pm b/fml/lib/FML/Process/Utils.pm
index b031e4d3..fbdae955 100644
--- a/fml/lib/FML/Process/Utils.pm
+++ b/fml/lib/FML/Process/Utils.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: Utils.pm,v 1.108 2004/03/13 10:27:43 fukachan Exp $
+# $FML: Utils.pm,v 1.109 2004/03/23 04:20:46 fukachan Exp $
 #
 
 package FML::Process::Utils;
@@ -801,19 +801,6 @@ sub command_line_options
 }
 
 
-# Descriptions: return comman specific options (-O key=value) as HASH_REF.
-#    Arguments: OBJ($curproc)
-# Side Effects: none
-# Return Value: HASH_REF
-sub cui_command_specific_options
-{
-    my ($curproc) = @_;
-    my $args = $curproc->{ __parent_args };
-
-    return( $args->{ options }->{ O } || {} );
-}
-
-
 =head2 set_config_files_list($cf_file_path_array)
 
 set configuration file (.cf) to internal list.
@@ -1232,6 +1219,10 @@ sub __get_ml_home_prefix_maps
 }
 
 
+=head2 is_cui_process()
+
+inform whether this process runs as CUI (fml/makefml) ?
+
 =head2 is_cgi_process()
 
 inform whether this process runs as cgi ?
@@ -1243,6 +1234,24 @@ inform whether this process runs under MTA ?
 =cut
 
 
+# Descriptions: whether this process runs as CUI ?
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub is_cui_process
+{
+    my ($curproc) = @_;
+    my $name = $curproc->myname() || '';
+
+    # XXX-TODO: HARD CODED
+    if ($name eq 'fml' || $name eq 'makefml') {
+	return 1;
+    }
+
+    return 0;
+}
+
+
 # Descriptions: whether this process runs as cgi ?
 #    Arguments: OBJ($curproc)
 # Side Effects: none
@@ -1290,13 +1299,13 @@ return 0 if not.
 
 For example, processes running under MTA e.g. libexec/distribute,
 libexec/command receives a mail and reply it if needed.
-But makefml command do not. 
+But makefml command do not.
 
 =cut
 
 
 # Descriptions: check if we can send messages to the sender or
-#               specified address. 
+#               specified address.
 #    Arguments: OBJ($curproc)
 # Side Effects: none
 # Return Value: NUM(1 or 0)
@@ -1829,6 +1838,40 @@ sub get_debug_level
 }
 
 
+=head1 CUI specific
+
+=cut
+
+
+# Descriptions: return comman specific options (-O key=value) as HASH_REF.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: HASH_REF
+sub cui_command_specific_options
+{
+    my ($curproc) = @_;
+    my $args = $curproc->{ __parent_args };
+
+    return( $args->{ options }->{ O } || {} );
+}
+
+
+# Descriptions: return sender or recipient specified by --send-to option.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: STR
+sub command_specific_recipient
+{
+    my ($curproc) = @_;
+    my $args      = $curproc->{ __parent_args };
+    my $rcpt      = $args->{ options }->{ 'send-to' } || '';
+    my $cred      = $curproc->{ credential };
+    my $sender    = $cred->sender() || '';
+
+    return( $rcpt || $sender || '' );
+}
+
+
 =head1 CODING STYLE
 
 See C<http://www.fml.org/software/FNF/> on fml coding style guide.