s/Netlib/MailingList/g

9 files changed, 1637 insertions, 0 deletions

diff --git a/fml/lib/MailingList/@template b/fml/lib/MailingList/@template
new file mode 100644
index 00000000..81d97312
--- /dev/null
+++ b/fml/lib/MailingList/@template
@@ -0,0 +1,4 @@
+# Descriptions: 
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
diff --git a/fml/lib/MailingList/CheckSum.pm b/fml/lib/MailingList/CheckSum.pm
new file mode 100644
index 00000000..c4f2dbf0
--- /dev/null
+++ b/fml/lib/MailingList/CheckSum.pm
@@ -0,0 +1,68 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package MailingList::CheckSum;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+sub md5
+{
+    ;
+}
+
+
+=head1 NAME
+
+MailingList::CheckSum.pm - what is this
+
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 new
+
+=item Function()
+
+
+=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
+
+MailingList::CheckSum.pm appeared in fml5.
+
+=cut
+
+
+1;
diff --git a/fml/lib/MailingList/INET4.pm b/fml/lib/MailingList/INET4.pm
new file mode 100644
index 00000000..9b7336b9
--- /dev/null
+++ b/fml/lib/MailingList/INET4.pm
@@ -0,0 +1,83 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package MailingList::INET4;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use MailingList::Utils;
+
+require Exporter;
+
+@ISA       = qw(Exporter);
+@EXPORT    = qw(_connect4);
+
+sub _connect4
+{
+    my ($self, $args) = @_;
+    my $mta = $args->{ _mta };
+    my $socket = '';
+
+    # avoid croak() in IO::Socket module;
+    eval {
+	local($SIG{ALRM}) = sub { Log("Error: timeout to connect $mta");};
+	use IO::Socket;
+	$socket = new IO::Socket::INET($mta);
+    };
+    if ($@) {
+	Log("Error: cannot make socket for $mta");
+	$self->_error_reason("Error: cannot make socket: $@");
+	return undef;
+    }
+
+    if (defined $socket) {
+	Log("(debug) o.k. connected to $mta");
+	$self->{'_socket'} = $socket;
+	$socket->autoflush(1);
+	return $socket;
+    }
+    else {
+	Log("(debug) error. fail to connect $mta");
+	$self->_error_reason("Error: cannot open socket: $!");
+	return undef;
+    }
+}
+
+
+=head1 NAME
+
+FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this
+
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 new
+
+=item Function()
+
+
+=head1 AUTHOR
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 __YOUR_NAME__
+
+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::__MODULE_NAME__.pm appeared in fml5.
+
+=cut
+
+1;
diff --git a/fml/lib/MailingList/INET6.pm b/fml/lib/MailingList/INET6.pm
new file mode 100644
index 00000000..0055b371
--- /dev/null
+++ b/fml/lib/MailingList/INET6.pm
@@ -0,0 +1,174 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package MailingList::INET6;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use MailingList::Utils;
+
+require Exporter;
+
+@ISA       = qw(Exporter);
+@EXPORT    = qw(is_ipv6_ready is_ipv6_mta_syntax _connect6);
+
+sub _we_can_use_Socket6
+{
+    my ($self, $args) = @_;
+
+    eval q{ 
+	use Socket; 
+	use Socket6;
+    };
+
+    if ($@ =~ /Can\'t locate Socket6.pm/) { 
+	$self->{_ipv6_ready} = 'no';
+    }
+    else {
+	Log("IPv6 ready");
+	$self->{_ipv6_ready} = 'yes';
+    }
+}
+
+
+sub is_ipv6_ready
+{
+    my ($self, $args) = @_;
+
+    # probe the IPv6 availability for the first time
+    unless ($self->{_ipv6_ready}) {
+	_we_can_use_Socket6($self, $args);
+    };
+
+    $self->{_ipv6_ready} eq 'yes' ? 1 : 0;
+}
+
+
+sub is_ipv6_mta_syntax
+{
+    my ($self, $host) = @_;
+    my ($x_host, $x_port);
+
+    # check the mta syntax whether it is ipv6 form or not.
+    if ( $host =~ /\[([\d:]+)\]:(\d+)/) {
+	($x_host, $x_port) = ($1, $2);
+	return ($x_host, $x_port);
+    }
+    else {
+	return wantarray ? () : undef;
+    }
+}
+
+
+sub _connect6
+{
+    my ($self, $args) = @_;
+    my $mta = $args->{ _mta };
+
+    # check the mta syntax is $ipv6_addr:$port or not.
+    my ($host, $port) = $self->is_ipv6_mta_syntax( $args->{ _mta } );
+
+    # if mta is ipv6 raw address syntax, 
+    # try to parse $mta to $host:$port style.
+    unless ($host) {
+	if ($mta =~ /(\S+):(\S+)/) {
+	    ($host, $port) = ($1, $2);
+	}
+    }
+
+    # hmm, invalid MTA
+    unless ($host && $port) {
+	Log("_connect6: cannot find mta=$mta");
+	$self->{_socket} = undef;
+	return undef;
+    }
+
+    $self->{_socket} = undef;
+    return undef;
+
+    eval q{
+	use IO::Handle;
+	use Socket; 
+	use Socket6;
+
+	my ($family, $type, $proto, $saddr, $canonname);
+	my $fh = new IO::Socket;
+	my $inet6_family = &AF_INET6;
+
+	# resolve socket info by getaddrinfo()
+	my @res = getaddrinfo($host, $port, AF_UNSPEC, SOCK_STREAM);
+	$family = -1;
+
+      LOOP:
+	while (scalar(@res) >= 5) {
+	    ($family, $type, $proto, $saddr, $canonname, @res) = @res;
+
+	    my ($host, $port) = 
+		getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV);
+
+	    # check only IPv6 case here.
+	    next LOOP if $family != $inet6_family;
+
+	    socket($fh, $family, $type, $proto) || do {
+		Log("Error: cannot create IPv6 socket");
+		next LOOP;
+	    };
+	    if (connect($fh, $saddr)) {
+		Log("(debug6) o.k. connect $host");
+		last LOOP;
+	    }
+	    else {
+		Log("Error: cannot connect via IPv6");
+	    }
+
+	    $family = -1;
+	}
+
+	if ($family != -1) {
+	    $self->{_socket} = $fh;
+	    Log("connected to $host:$port by IPv6");
+	} else {
+	    $self->{_socket} = undef;
+	    Log("(debug6) fail to connect $host:$port by IPv6");
+	}
+    };
+}
+
+
+=head1 NAME
+
+FML::__HERE_IS_YOUR_MODULE_NAME__.pm - what is this
+
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 new
+
+=item Function()
+
+
+=head1 AUTHOR
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 __YOUR_NAME__
+
+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::__MODULE_NAME__.pm appeared in fml5.
+
+=cut
+
+1;
diff --git a/fml/lib/MailingList/Messages.pm b/fml/lib/MailingList/Messages.pm
new file mode 100644
index 00000000..946a3c9c
--- /dev/null
+++ b/fml/lib/MailingList/Messages.pm
@@ -0,0 +1,202 @@
+#-*- perl -*-
+#
+#  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. 
+#
+# $Id$
+# $FML$
+#
+
+package MailingList::Messages;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+
+sub new
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    if ($args) { create($me, $args);}
+    return bless $me, $type;
+}
+
+
+######################################################################
+=head1 NAME
+
+MailingList::Messages -- message manipulators
+
+=head1 SYNOPSIS
+
+    my $m1 = new MailingList::Messages { content => \$body1 };
+
+    my $m2 = new MailingList::Messages;
+    $m2->create( { content => \$body2 });
+
+    # make a chain of $m1, $m2, ...
+    $m1->chain( $m2 );
+
+    # print the contents in the order:  $m1, $m2, ... 
+    $m1->print;
+
+=head1 DESCRIPTION
+
+A message has the content and a header including the next message
+pointer, et. al. Out idea is similar to IPv6.
+
+Message Format
+
+   %message = {
+                version      => 1.0
+                content_type => message/rfc822
+                next         => \%next_message
+                prev         => \%prev_message
+                header       => {
+                                    field_name => field_value
+                                 }
+                content      => \$message_body
+               }
+
+
+=item Function()
+
+=cut
+
+
+sub create
+{
+    my ($self, $args) = @_;
+
+    $self->{ version } = $args->{ version } || 1.0; 
+    $self->{ type    } = $args->{ type    } || 'message/rfc822';
+    $self->{ next    } = $args->{ next    } || undef;
+    $self->{ prev    } = $args->{ prev    } || undef;
+    $self->{ header  } = $args->{ header  } || undef;
+    $self->{ content } = $args->{ content } || '';
+}
+
+
+sub next_chain
+{
+    my ($self, $ref_next_message) = @_;
+    $self->{ next } = $ref_next_message;
+}
+
+
+sub prev_chain
+{
+    my ($self, $ref_prev_message) = @_;
+    $self->{ prev } = $ref_prev_message;
+}
+
+
+sub print
+{
+    my ($self, $fd) = @_;
+    my $msg = $self;
+
+    # if $fd is not given, we use STDOUT.
+    unless (defined $fd) { $fd = \*STDOUT;}
+    
+  MSG:
+    while (1) {
+	$self->_print($fd, $msg->{ content });
+	last MSG unless $msg->{ next };
+	$msg = $self->{ next };
+    }
+}
+
+
+# Descriptions: send the body part of the message to socket
+#               replace "\n" in the end of line with "\r\n" on memory.
+#               We should do it to use as less memory as possible.
+#               So we use substr() to process each line.
+#    Arguments: $self $socket $ref_to_body
+# Side Effects: none
+# Return Value: none
+sub _print
+{
+    my ($self, $fd, $r_body) = @_;
+
+    my $pp     = 0;
+    my $maxlen = length($$r_body);
+    my $logfp  = $self->{ _log_function };
+    $logfp     = ref($logfp) eq 'CODE' ? $logfp : undef;
+
+    # write each line in buffer
+    my ($p, $len, $buf, $pbuf);
+  SMTP_IO:
+    while (1) {
+	$p   = index($$r_body, "\n", $pp);
+	$len = $p  - $pp + 1;
+	$buf = substr($$r_body, $pp, ($p < 0 ? $maxlen-$pp : $len));
+	if ($buf !~ /\r\n$/) { $buf =~ s/\n$/\r\n/;}
+
+	# ^. -> ..
+	$buf =~ s/^\./../;
+
+	print $fd    $buf;
+	&$logfp($buf) if $logfp;
+
+	last SMTP_IO if $p < 0;
+	$pp = $p + 1;
+    }
+}
+
+
+sub size
+{
+    my ($self) = @_;
+    my $c = $self->{ content };
+    length($$c);
+}
+
+
+sub is_empty
+{
+    my ($self) = @_;
+    my $size   = $self->size;
+    my $c      = $self->{ content };
+
+    if ($size == 0) { return 1;}
+    if ($size <= 8) {
+	if ($$c =~ /^\s*$/) { return 1;}
+    }
+
+    # false
+    return 0;
+}
+
+
+sub set_log_function
+{
+    my ($self, $fp) = @_;
+    $self->{ _log_function } = $fp; # log function pointer
+}
+
+
+######################################################################
+=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
+
+MailingList::Messages.pm appeared in fml5.
+
+=cut
+
+1;
diff --git a/fml/lib/MailingList/SMTP.ja.pod b/fml/lib/MailingList/SMTP.ja.pod
new file mode 100644
index 00000000..183dc70b
--- /dev/null
+++ b/fml/lib/MailingList/SMTP.ja.pod
@@ -0,0 +1,83 @@
+=head1	NAME
+
+fml5 のメール配送システムについて
+
+=head1	DESCRIPTION
+
+=head2	fml4 と fml5 の相違点
+
+fml5 の最大の目的の一つは、メンバーリストの取得と操作の統合と抽象化で
+す。MailingList::SMTP は次のように使います。
+
+
+=head1	使い方
+
+=head2 MailingList::* クラスの使い方について
+
+MailingList::* に属するクラスは SMTP および LMTP 配送へのインターフェイスを
+提供します。
+
+MailingList::SMTP は次のように使います。
+
+    use MailingList::SMTP;
+    my $service = new MailingList::SMTP {
+	log_function   => $fp,
+	socket_timeout => 2,
+    };
+
+    my $ref_to_array   = [ 'kenken@nuinui.net' ];
+    my $recipient_maps = 'file:/var/spool/ml/elena/actives';
+
+    $service->deliver(
+		      {
+			  'mta'             => 'localhost:25',
+
+			  'smtp_sender'     => 'rudo@nuinui.net',
+			  'recipient_array' => $ref_to_array,
+			  'recipient_maps'  => $recipient_maps,
+
+			  'header'          => $header,
+			  'body'            => $body,
+		      });
+    if ($service->error) { Log($service->error); return;}
+
+ここで $header はヘッダで、FML::Header オブジェクトです。
+そして $body   はメール本文で、FML::Body オブジェクトです。
+
+=head1	コンポーネント
+
+	MailingList::SMTP >-|
+	               |- MailingList::Utils
+	               |- MailingList::INET4 >--- Socket
+	               |- MailingList::INET6 >--- Socket
+	               |                  |- Socket6
+	               |
+	               |- FML::IO::Map
+	               |
+	               |- IO::Socket
+
+MailingList::SMTP uses MailingList::Utils, MailingList::INET4 and MailingList::INET6.
+MailingList::SMTP also uses FML::IO::Map to resolve $recipient_maps
+operations.
+
+=head1	参照
+
+L<"MailingList::SMTP">,
+L<"FML::IO::Map">
+
+=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
+
+MailingList class appeared in fml5.
+fml5 is fully rewrite of fml4 based on the experience of fml4
+(1993-2001).
diff --git a/fml/lib/MailingList/SMTP.pm b/fml/lib/MailingList/SMTP.pm
new file mode 100644
index 00000000..5a83e85b
--- /dev/null
+++ b/fml/lib/MailingList/SMTP.pm
@@ -0,0 +1,774 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2000-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. 
+#
+# $Id$
+# $FML$
+#
+
+
+package MailingList::SMTP;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use IO::Socket;
+use MailingList::Utils;
+use MailingList::INET4;
+use MailingList::INET6;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+
+BEGIN {}
+
+
+=head1 NAME
+
+MailingList::SMTP.pm - interface for SMTP service
+
+=head1 SYNOPSIS
+
+To initialize, 
+
+    use MailingList::SMTP;
+    my $fp  = sub { Log(@_);}; # pointer to the log function
+    my $sfp = sub { my ($s) = @_; print $s; print "\n" if $s !~ /\n$/o;};
+    my $service = new MailingList::SMTP {
+        log_function       => $fp,
+        smtp_log_function  => $sfp,
+        socket_timeout     => 2,     # XXX 2 for debug but 10 by default
+    };
+    if ($service->error) { Log($service->error); return;}
+
+To start delivery, use deliver() method in this way.
+
+    $service->deliver(
+                      {
+                          mta             => '127.0.0.1:25',
+
+                          smtp_sender     => 'rudo@nuinui.net',
+                          recipient_maps  => $recipient_maps,
+                          recipient_limit => 1000,
+
+                          header          => $header_object,
+                          body            => $body_object,
+                      });
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=item C<new()>
+
+constructor. If you control parameters, specify it in a hash reference
+as an argument of new().
+
+        hash key           value
+        --------------------------------------------
+        log_function       reference to function for logging
+        smtp_log_function  reference to function for logging
+        socket_timeout     set the timeout associated with the socket
+
+log_function() is for general purpose.
+smtp_log_function() is used to log SMTP transactions.
+
+=cut
+
+# Descriptions: MailingList::SMTP constructor
+#    Arguments: $self $args
+# Side Effects: $self ($me) hash has some default values
+# Return Value: object
+sub new
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {}; # malloc new SMTP session struct
+
+    # _recipient_limit: maximum recipients in one smtp session.
+    #  _socket_timeout: basic timeout parameter for smtp session
+    #    _log_function: pointer to the log() function
+    $me->{_recipient_limit} = $args->{recipient_limit} || 1000;
+    $me->{_socket_timeout}  = $args->{socket_timeout}  || 10;
+    $me->{_log_function}      = $args->{log_function};
+    $me->{_smtp_log_function} = $args->{smtp_log_function};
+
+    _initialize_delivery_session($me, $args);
+
+    # define package global pointer to the log() function
+    $LogFunctionPointer     = $args->{log_function};
+    $SmtpLogFunctionPointer = $args->{smtp_log_function};
+
+    return bless $me, $type;
+}
+
+
+# Descriptions: send a (SMTP/LMTP) command string to BSD socket
+#    Arguments: $self $command_string
+# Side Effects: log file by _smtplog
+#               set _last_command and _error_action in object itself
+# Return Value: none
+sub _send_command
+{
+    my ($self, $command) = @_;
+    my $socket = $self->{'_socket'};
+
+    $self->{_last_command} = $command;
+    $self->{_error_action} = '';
+    $self->smtplog($command);
+
+    if (defined $socket) {
+	$socket->print($command, "\r\n");
+    }
+    else {
+	Log("Error: _send_command: undefined socket");
+    }
+}
+
+
+# Descriptions: receive a reply for a (SMTP/LMTP) command
+#    Arguments: $self
+# Side Effects: log file by _smtplog
+# Return Value: none
+sub _read_reply
+{
+    my ($self) = @_;
+    my $socket = $self->{'_socket'};
+
+    # unique identifier to clarify the trapped error message
+    my $id = $$;
+
+    # toggle flag whether we should check SMTP attributes or not.
+    # we should check it only in HELO phase.
+    my $check_attributes = 0;
+    if ($self->{_last_command} =~ /^(EHLO|HELO|LHLO)/) {
+	$check_attributes = 1;
+    }
+
+    # XXX Attention! dynamic scope by local() for %SIG is essential.
+    #     See books on Perl for more details on my() and local() difference.
+    eval {
+	local($SIG{ALRM}) = sub { die("$id socket timeout")}; 
+	alarm( $self->{_socket_timeout} );
+	my $buf = '';
+
+      SMTP_REPLY:
+	while (1) {
+	    $buf = $socket->getline;
+	    $self->smtplog($buf);
+
+	    # check smtp attributes
+	    if ($check_attributes) {
+		if ($buf =~ /^250.PIPELINING/i) {
+		    $self->{'_can_use_pipelining'} = 'yes'; 
+		}
+		if ($buf =~ /^250.ETRN/i) {
+		    $self->{'_can_use_etrn'} = 'yes';
+		}
+		if ($buf =~ /^250.SIZE\s+(\d+)/i) {
+		    $self->{'_size_limit'} = $1;
+		}
+	    }
+
+	    # store the latest status code
+	    if ($buf =~ /^(\d{3})/) { $self->_set_status_code($1);}
+
+	    # check status code
+	    if ($buf =~ /^[45]\d{2}\s/) {
+		Log($buf);
+		die("$id retry");
+	    }
+
+	    # end of reply e.g. "250 ..."
+	    last SMTP_REPLY if $buf =~ /^\d{3}\s/;
+	}
+    };
+
+    if ($@ =~ /$id retry/) {
+	$self->{'_error_action'} = "retry";
+    }
+
+    if ($@ =~ /$id socket timeout/) {
+	my $x = $self->{'_last_command'};
+	Log("Error: smtp reply for \"$x\" is timeout");
+	$self->_error_reason("Error: smtp reply for \"$x\" is timeout");
+    }
+}
+
+
+# Descriptions: connect(2)
+#               1. try connect(2) by IPv6 if we can use Socket6.pm
+#               2. try connect(2) by IPv4
+#                  if $host is not IPv6 raw address e.g. [::1]:25
+#    Arguments: $self $args
+# Side Effects: set file handle (BSD socket) in $self->{_socket}
+# Return Value: file handle (created BSD socket) or undef()
+sub _connect
+{
+    my ($self, $args) = @_;
+    my $mta = $args->{'_mta'} || '127.0.0.1:25';
+    my $socket;
+
+    # 1. try to connect(2) $args->{ _mta } by IPv6 if we can use Socket6.
+    if ($self->is_ipv6_ready($args)) {
+	$self->_connect6($args);
+	my $socket = $self->{_socket};
+	return $socket if defined $socket;
+    }
+    else {
+	Log("(debug) IPv6 is not ready");
+    }
+
+    # 2. try to connect(2) $args->{ _mta } by IPv4.
+    #    XXX check the _mta syntax.
+    #    XXX if $args->{ _mta } looks [$ipv6_addr]:$port style,
+    #    XXX we do not try to connect the host by IPv4.
+    if ( $self->is_ipv6_mta_syntax($mta) ) {
+	Log("(debug) not try MTA $args->{_mta}");
+	return undef;
+    }
+    else {
+	$self->_connect4($args);
+    }
+}
+
+
+# Descriptions: close BSD socket
+#    Arguments: $self
+# Side Effects: 
+# Return Value: none
+sub close
+{
+    my ($self) = @_;
+    my $socket = $self->{'_socket'};
+
+    if (defined $socket) {
+	$socket->close;
+    }
+    else {
+	Log("Error: try to close invalid socket");
+    }
+}
+
+
+############################################################
+#####
+##### SMTP delivery main loop
+#####
+
+=item C<deliver()>
+
+start delivery process.
+
+        hash key           value
+        --------------------------------------------
+        mta                127.0.0.1:25 [::1]:25
+        smtp_sender        sender's mail address
+        recipient_maps     $recipient_maps
+        recipient_limit    recipients in one SMTP transactions
+        header             FML::Header object
+        body               MailingList::Messages object
+
+C<mta> is a list of MTA's.
+The syntax of each MTA is address:port style. 
+If you use a raw IPv6 address, use [address]:port syntax. 
+For example, [::1]:25 (v6 loopback).
+You can specify IPv4 and IPv6 addresses.
+deliver() automatically tries smtp in both protocols.
+
+C<smtp_sender> is the sender's email address. It is used at MAIL FROM:
+parameter.
+
+C<recipient_maps> is a list of C<maps>.
+See L<IO::MapAdapter> for more details. 
+For example,
+
+to read address from a file
+
+         file:/var/spool/ml/elena/recipients
+
+to read addresses from /etc/group
+
+         unix.group:fml
+
+C<recipient_limit> is the max number of recipients in one SMTP
+transaction. 1000 by default, which corresponds to the limit by Postfix. 
+
+C<header> is FML::Header object.
+
+C<body> is MailingList::Messages object.
+See L<MailingList::Messages> for more details.
+
+=cut
+
+# Descriptions: main delivery loop for each recipient_maps and each mta.
+#               real delivery is done within _deliver() method.
+#               algorithm:
+#                 for each $map {
+#                    for each $mta {
+#                       call _deliver()
+#                       send recipients up to $recipient_limit
+#                    } 
+#                 }
+#                 
+#    Arguments: $self $args
+# Side Effects: See MailingList::Utils for recipient_map utilities 
+#               to track the delivery process status.
+# Return Value: none
+sub deliver
+{
+    my ($self, $args) = @_;
+
+    # recipient limit
+    $self->{_recipient_limit} = $args->{recipient_limit} || 1000;
+
+    # temporary hash to check whether the map/mta is used already.
+    my %used_mta = ();
+    my %used_map = ();
+
+    # prepare loop for each mta and map 
+    my @mta  = split(/\s+/, $args->{ mta } || '127.0.0.1:25');
+    my @maps = ();
+    if ( $args->{ recipient_maps } ) {
+	@maps = split(/\s+/, $args->{ recipient_maps });
+    }
+
+    # alloc virtual recipient map
+    if (ref( $args->{ recipient_array } ) eq 'ARRAY') {
+	my $map = $self->_alloc_recipients_array_on_memory($args);
+	push(@maps, $map);
+    }
+
+
+  MAP:
+    for my $map ( @maps ) {
+	# uniq $map
+	next if $used_map{ $map }; $used_map{ $map } = 1;
+
+	# try to open $map
+	eval q{
+	    use IO::MapAdapter;
+	    my $obj = new IO::MapAdapter $map;
+	    if (defined $obj) { 
+		$obj->open || croak("cannot open $map");
+	    }
+	};
+	if ($@) {
+	    Log("Error: cannot open and ignore $map");
+	    next MAP;
+	}
+	
+	$self->_set_target_map($map);
+	$self->_set_map_status($map, 'not done');
+	$self->_set_map_position($map, 0);
+
+	# To avoid infinite loop, we enforce some artificial limit.
+	# The loop evaluation is limited to "4 * $number_of_mta" for each $map.
+	my $loop_count     = 0;
+	my $max_loop_count = ($#mta * 4) || 4;
+
+      MTA_RETRY_LOOP:
+	while (1) {
+	    my $n_mta = 0;
+
+	    # check infinite loop
+	    if ($loop_count++ > $max_loop_count) {
+		Log("Error: infinite loop for map=$map");
+		last MTA_RETRY_LOOP;
+	    }
+
+	  MTA:
+	    for my $mta (@mta) {
+		# uniq $mta
+		next if $used_mta{ $mta }; $used_mta{ $mta } = 1;
+
+		# count the number of effective mta in this inter loop.
+		$n_mta++;
+
+		# o.k. try to deliver mail by using $mta.
+		Log("(debug) use $mta for map=$map");
+		$args->{ _mta } = $mta;
+		$self->_deliver($args);
+
+		# remove error messages for the next _deliver() session.
+		$self->error_reset;
+
+		# we read the whole $map now. 
+		if ($self->_get_map_status($map) eq 'done') {
+		    last MTA;
+		}
+	    } # end of MTA: loop
+
+	    # end of MTA_RETRY_LOOP: loop
+	    if ($self->_get_map_status($map) eq 'done') {
+		last MTA_RETRY_LOOP;
+	    }
+
+	    # NO effective mta in this inter loop. It impiles that
+	    # we used all MTA candidates. We reuse @mta again.
+	    if ($n_mta == 0) { 
+		Log("(debug) we used all MTA candidates. reuse \$mta");
+		undef %used_mta;
+		next MTA_RETRY_LOOP;
+	    }
+	}
+    }
+
+    # clean up recipient_map information after "all delivery"
+    # CAUTION: this mapinfo tracks the delivery status.
+    $self->_reset_mapinfo;
+
+    if ( $self->{ _num_recipients } ) { 
+	Log( "recipients: ". $self->{ _num_recipients } );
+    }
+}
+
+
+# Descriptions: ordinary SMTP sequence (see RFC821 for more details)
+#              >220 I am some MTA ...
+#              <EHLO/HELO myname
+#              >250 ok
+#              <MAIL FROM:<$sender>
+#              >250 ok
+#              <RCPT TO:<$recipient>
+#              >250 oK
+#              <DATA
+#              >354 ...
+#              < message
+#              <.
+#              >250 oK
+#              <QUIT
+#              >221 good bye
+#    Arguments: $self $args
+# Side Effects: remove error messages when we return from here
+#               for the next _deliver() session.
+# Return Value: none
+sub _deliver
+{
+    my ($self, $args) = @_;
+
+    $self->_initialize_delivery_session($args);
+
+    # prepare smtp information
+    my $myhostname = $args->{ myhostname } || 'localhost';
+    
+    # 0. create BSD SOCKET as the communication terminal
+    #    IF_ERROR_FOUND: do nothing and return as soon as possible
+    my $socket = $self->_connect($args);
+    $socket || return;
+
+    # 1. receive the first "220 .." message
+    #    If you faces some error in this stage, you have to do nothing 
+    #    since smtp connection has not established yet.
+    #    IF_ERROR_FOUND: do nothing and return as soon as possible
+    $self->_read_reply;
+    if ($self->error) { return;}
+
+    # 2. EHLO/HELO;
+    #    IF_ERROR_FOUND: do nothing and return as soon as possible
+    $self->_send_command("EHLO $myhostname");
+    $self->_read_reply;
+    if ($self->error) { $self->_reset_smtp_transaction;	return;}
+
+    # 3. MAIL FROM;
+    #    IF_ERROR_FOUND: do nothing and return as soon as possible
+    $self->_send_mail_from($args);
+    if ($self->error) { $self->_reset_smtp_transaction; return;}
+
+    # 4. RCPT TO; ... send list of recipients
+    #    IF_ERROR_FOUND: roll back the process to the state before this 
+    $self->_send_recipient_list($args);
+    if ($self->error) {
+	$self->_rollback_map_position;
+	$self->_reset_smtp_transaction;
+	return;
+    }
+
+    # 5. DATA; send the mail body itself
+    #    IF_ERROR_FOUND: handled in _send_data_to_mta(), so
+    #                    return as soon as possible from here.
+    $self->_send_data_to_mta($args);
+    if ($self->error) { return;}
+
+    # 6. QUIT; SMTP session closing ...
+    #    IF_ERROR_FOUND: do nothing ?
+    $self->_send_command("QUIT");
+    $self->_read_reply;
+    if ($self->error) { $self->_reset_smtp_transaction; return;}
+}
+
+
+# Descriptions: initialize _deliver() process
+#               this routine is called at the first phase in _deliver()
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+sub _initialize_delivery_session
+{
+    my ($self, $args) = @_;
+    $self->{ _last_command } = '';
+    $self->{ _status_code  } = '';
+}
+
+
+############################################################
+#####
+##### MAIL FROM:
+#####
+
+# Descriptions: send SMTP command "MAIL FROM"
+#    Arguments: $self $args
+# Side Effects: none
+# Return Value: none
+#     See Also: RFC821, RFC1123
+#         TODO: VERP's
+sub _send_mail_from
+{
+    my ($self, $args) = @_;
+    my $sender = $args->{ smtp_sender };
+    $self->_send_command("MAIL FROM:<$sender>");
+    $self->_read_reply;
+}
+
+
+
+############################################################
+#####
+##### RCPT TO:
+#####
+
+# Descriptions: We evaluate recipient_maps parameter here. 
+#               You can use a lot of classes for this directive: e.g.
+#               file, UNIX's /etc/group, YP, SQL, LDAP, ...
+#               Example: recipient_maps = file:members
+#                                         unix.group:admin
+#                                         mysql:toymodel
+#               IO::MapAdapter class is essential to handle abstract 
+#               $recipient_map.
+#    Arguments: $self $args
+# Side Effects: $self->{ _retry_recipient_table } has recipients which 
+#               causes some errors.
+#               _{set,get}_map_position() and _{set,get}_map_status()
+#               tracks the delivery process.
+# Return Value: none
+sub _send_recipient_list_by_recipient_map
+{
+    my ($self, $args) = @_;
+    my $map = $self->_get_target_map;
+
+    # open abstract recipient list objects.
+    # $map syntax is "type:parameter", e.g., 
+    # file:$filename mysql:$schema_name
+    use IO::MapAdapter;
+    my $obj = new IO::MapAdapter $map;
+
+    unless (defined $obj) {
+	Log("Error: cannot get object for $map by IO::MapAdapter");
+    }
+    else { # $obj is good.
+	my $rcpt;
+	my $num_recipients = 0;
+	my $recipient_limit = $self->{_recipient_limit};
+
+	$obj->open || do {
+	    $self->_error_reason( $obj->error );
+	    return undef;
+	};
+
+	# roll back the previous file offset
+	if ($self->_get_map_position($map) > 0) {
+	    $obj->setpos( $self->_get_map_position($map) );
+	}
+
+	# XXX $obj->get_recipient returns a mail address.
+      RCPT_INPUT:
+	while (defined ($rcpt = $obj->get_recipient)) {
+	    $num_recipients++;
+	    $self->_send_command("RCPT TO:<$rcpt>");
+	    $self->_read_reply;
+
+	    # save addresses to retry later.
+	    if ($self->{_error_action} eq 'retry') {
+		$self->{ _retry_recipient_table }->{ $rcpt } = 'retry';
+	    }
+
+	    last RCPT_INPUT if $num_recipients >= $recipient_limit;
+	}
+
+	# save the current position in the file handle
+	$self->_set_map_position($map, $obj->getpos);
+
+	# done.
+	if ($obj->eof) {
+	    $self->_set_map_status($map, 'done');
+	}
+
+	# ends
+	$obj->close;
+
+	# count up the total number of recipients
+	$self->{ _num_recipients } += $num_recipients;
+
+	unless ($num_recipients) {
+	    Log("Error: no recipients for $map");
+	    $self->_send_command("RSET");
+	    $self->_read_reply;
+	}
+    }
+}
+
+
+# Descriptions: send "RCPT TO:<recipient>" to MTA
+#    Arguments: $self $args
+# Side Effects: none
+# Return Value: none
+sub _send_recipient_list
+{
+    my ($self, $args) = @_;
+    
+    # evaluate recipient_maps
+    if ( $self->_get_target_map ) {
+	$self->_send_recipient_list_by_recipient_map($args);
+    }
+}
+
+
+# Descriptions: create CODE REFERECE to handle recipients array on memory 
+#    Arguments: $self $args
+# Side Effects: $me is referenced, so not destroyed. It is a closure (?).
+# Return Value: CODE REFERENCE
+sub _alloc_recipients_array_on_memory
+{
+    my ($self, $args) = @_;
+    return sub {
+	my ($me) = @_;
+	$me->{ _recipients_array_on_memory } = $args->{ recipient_array };
+    };
+}
+
+
+############################################################
+#####
+##### DATA:
+#####
+
+# Descriptions: send the header part of the message to socket
+#    Arguments: $self $socket $ref_to_header
+#               $ref_to_header is the FML::Header class object.
+# Side Effects: none
+# Return Value: none
+sub _send_header_to_mta
+{
+    my ($self, $socket, $header) = @_;
+
+    # get header 
+    my $h = $header->as_string($socket);
+    $h =~ s/\n/\r\n/g;
+    print $socket $h;
+    $self->smtplog($h);
+}
+
+
+# Descriptions: send the body part of the message to socket
+#    Arguments: $self $socket "MailingList::Messages object"
+# Side Effects: none
+# Return Value: none
+sub _send_body_to_mta
+{
+    my ($self, $socket, $msg) = @_;
+
+    # XXX $msg is MailingList::Messages object.
+    $msg->set_log_function( $SmtpLogFunctionPointer );
+    $msg->print($socket);
+}
+
+
+# Descriptions: send message itself to file handle (BSD socket here)
+#    Arguments: $self $args
+# Side Effects: 
+# Return Value: none
+#         TODO: MIME/multipart
+sub _send_data_to_mta
+{
+    my ($self, $args) = @_;
+
+    # prepare smtp information
+    my $body       = $args->{ body };
+    my $header     = $args->{ header };
+    my $socket     = $self->{'_socket'};
+
+    if (defined $body) {
+	$self->_send_command("DATA");
+	$self->_read_reply;
+
+	# XXX if "DATA" transaction cannot start, retry ?
+	if ($self->_get_status_code != '354' || $self->error) { 
+	    Log($self->error); 
+	    return undef;
+	}
+
+	# 1. header; send header
+	$self->_send_header_to_mta($socket, $header);
+
+	# 2. separator between header and body
+	print $socket "\r\n";
+	$self->smtplog("\r\n");
+
+	# 3. body; send(copy) body on memory to socket each line
+	$self->_send_body_to_mta($socket, $body);
+
+	# end "DATA" transaction
+	$self->_send_command(".");
+	$self->_read_reply;
+    }
+}
+
+
+############################################################
+#####
+##### QUIT / RSET
+#####
+
+# Descriptions: send the SMTP reset "RSET" command
+#    Arguments: $self $args
+# Side Effects: none
+# Return Value: none
+sub _reset_smtp_transaction
+{
+    my ($self, $args) = @_;
+    $self->_send_command("RSET");
+    $self->_read_reply;
+    Log("Info: reset smtp transcation");
+}
+
+
+
+=head1 SEE ALSO
+
+L<IO::Socket>
+L<MailingList::Utils>
+L<MailingList::INET4>
+L<MailingList::INET6>
+
+
+=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
+
+MailingList::SMTP.pm appeared in fml5.
+
+=cut
+
+1;
diff --git a/fml/lib/MailingList/Utils.pm b/fml/lib/MailingList/Utils.pm
new file mode 100644
index 00000000..2730768f
--- /dev/null
+++ b/fml/lib/MailingList/Utils.pm
@@ -0,0 +1,217 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2000-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. 
+#
+# $Id$
+# $FML$
+#
+
+package MailingList::Utils;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $LogFunctionPointer $SmtpLogFunctionPointer);
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+	     Log
+	     _smtplog
+	     smtplog
+
+	     $LogFunctionPointer
+	     $SmtpLogFunctionPointer
+
+	     _error_reason
+	     error 
+	     error_reset 
+
+	     _set_status_code 
+	     _get_status_code
+
+	     _set_target_map
+	     _get_target_map
+	     _set_map_status
+	     _set_map_position
+	     _get_map_status
+	     _get_map_position
+	     _rollback_map_position
+	     _reset_mapinfo
+	     );
+
+sub Log
+{
+    my ($buf) = @_;
+
+    # function pointer to logging function
+    my $fp = $LogFunctionPointer;
+
+    if ($fp) {
+	eval &$fp($buf);
+	print STDERR $@, "\n" if $@;
+    }
+    else {
+	print STDERR @_, "\n";
+    }
+}
+
+
+sub smtplog
+{
+    my ($self, $buf) = @_;
+    _smtplog($buf);
+}
+
+sub _smtplog
+{
+    my ($buf) = @_;
+
+    # function pointer to logging function
+    my $fp = $SmtpLogFunctionPointer;
+
+    if ($fp) {
+	eval &$fp($buf);
+	print STDERR $@, "\n" if $@;
+    }
+    else {
+	print STDERR @_, "\n";
+    }
+}
+
+
+sub _error_reason
+{
+    my ($self, $mesg) = @_;
+    $self->{'_error_reason'} = $mesg;
+}
+
+
+sub error_reason
+{
+    my ($self, $mesg) = @_;
+    $self->_error_reason($mesg);
+}
+
+
+sub error
+{
+    my ($self, $args) = @_;
+    return $self->{'_error_reason'};
+}
+
+
+sub error_reset
+{
+    my ($self, $args) = @_;
+    my $msg = $self->{'_error_reason'};
+    undef $self->{'_error_reason'} if defined $self->{'_error_reason'};
+    undef $self->{'_error_action'} if defined $self->{'_error_action'};
+    return $msg;
+}
+
+
+sub _set_status_code
+{
+    my ($self, $value) = @_;
+    $self->{'_status_code'} = $value;
+}
+
+
+sub _get_status_code
+{
+    my ($self) = @_;
+    $self->{'_status_code'};
+}
+
+
+
+############################################################
+#####
+##### utility functions to operate $recipient_maps
+#####
+
+
+sub _set_target_map
+{
+    my ($self, $map) = @_;
+    $self->{ _mapinfo }->{ _curmap } = $map;
+}
+
+
+sub _get_target_map
+{
+    my ($self) = @_;
+    $self->{ _mapinfo }->{ _curmap };
+}
+
+
+sub _set_map_status
+{
+    my ($self, $map, $status) = @_;
+    $self->{ _mapinfo }->{ $map }->{prev_status} = 
+	$self->{ _mapinfo }->{ $map }->{status} || 'not done';
+    $self->{ _mapinfo }->{ $map }->{status}      = $status;
+}
+
+sub _set_map_position
+{
+    my ($self, $map, $position) = @_;
+    $self->{ _mapinfo }->{ $map }->{prev_position} = 
+	$self->{ _mapinfo }->{ $map }->{position} || 0;
+    $self->{ _mapinfo }->{ $map }->{position}   = $position;
+}
+
+sub _get_map_status
+{
+    my ($self, $map) = @_;
+    $self->{ _mapinfo }->{ $map }->{status};
+}
+
+sub _get_map_position
+{
+    my ($self, $map) = @_;
+    $self->{ _mapinfo }->{ $map }->{position};
+}
+
+
+sub _rollback_map_position
+{
+    my ($self) = @_;
+    my $map      = $self->_get_target_map;
+
+    # count the number of rollback to avoid infinite loop
+    if ( $self->{ _map_rollback_info }->{ $map }->{ count } > 2 ) {
+	Log("Error: not rollback $map to avoid infinite loop");
+	return ;
+    }
+    else {
+	$self->{ _map_rollback_info }->{ $map }->{ count }++;
+    }
+
+    my $prev_pos = $self->{ _mapinfo }->{ $map }->{prev_position};
+    my $pos      = $self->{ _mapinfo }->{ $map }->{position};
+    $self->_set_map_position($map, $prev_pos);
+    Log("Info: rollback $map from $pos to $prev_pos");
+
+    my $prev_status = $self->{ _mapinfo }->{ $map }->{prev_status};
+    my $status      = $self->{ _mapinfo }->{ $map }->{status};
+    $self->_set_map_status($map, $prev_status);
+    Log("Info: rollback status of $map to '$prev_status'");
+}
+
+
+sub _reset_mapinfo
+{
+    my ($self) = @_;
+    $self->_set_target_map('');
+    delete $self->{ _mapinfo };
+    delete $self->{ _map_rollback_info };
+}
+
+
+1;
+
+
+1;
diff --git a/fml/lib/MailingList/index.ja.html b/fml/lib/MailingList/index.ja.html
new file mode 100644
index 00000000..82ebc1cb
--- /dev/null
+++ b/fml/lib/MailingList/index.ja.html
@@ -0,0 +1,32 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+MailingList:: クラス
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<CENTER>
+MailingList:: クラス
+</CENTER>
+
+<BODY BGCOLOR="#E6E6FA">
+<!-- ================== body =========================================== -->
+
+<UL>
+	<LI>
+	<A HREF=INET6.pm>INET6.pm</A>
+
+	<LI>
+	<A HREF=SMTP.pm>SMTP.pm</A>
+
+	<LI>
+	<A HREF=Utils.pm>Utils.pm</A>
+
+</UL>
+
+<!-- =================================================================== -->
+</BODY>
+</HTML>