From a66bacedf58e41da62a6b401fabc18f31c929d88 Mon Sep 17 00:00:00 2001
From: fukachan <fukachan>
Date: Tue, 3 Apr 2001 09:53:28 +0000
Subject: change class hierarchy from MailingList:: to Mail:: The entrance to
 these module is Mail::Delivery and all operations of mail content is served
 by Mail::Message.

---
 fml/lib/Mail/.cvsignore                 |    1 +
 fml/lib/Mail/Delivery.pm                |  147 +++++
 fml/lib/Mail/Delivery/ESMTP.pm          |   59 ++
 fml/lib/Mail/Delivery/Makefile          |   16 +
 fml/lib/Mail/Delivery/Net/.cvsignore    |    1 +
 fml/lib/Mail/Delivery/Net/INET4.pm      |  112 ++++
 fml/lib/Mail/Delivery/Net/INET6.pm      |  209 +++++++
 fml/lib/Mail/Delivery/Net/Makefile      |    6 +
 fml/lib/Mail/Delivery/Net/index.ja.html |   31 +
 fml/lib/Mail/Delivery/SMTP.pm           |  804 ++++++++++++++++++++++++
 fml/lib/Mail/Delivery/Utils.pm          |  338 ++++++++++
 fml/lib/Mail/Delivery/index.ja.html     |   41 ++
 fml/lib/Mail/Makefile                   |   16 +
 fml/lib/Mail/Message.pm                 | 1044 +++++++++++++++++++++++++++++++
 fml/lib/Mail/delivery.ja.html           |   62 ++
 fml/lib/Mail/index.ja.html              |   38 ++
 fml/lib/Mail/pointer.ja.html            |    3 +
 17 files changed, 2928 insertions(+)
 create mode 100644 fml/lib/Mail/.cvsignore
 create mode 100644 fml/lib/Mail/Delivery.pm
 create mode 100644 fml/lib/Mail/Delivery/ESMTP.pm
 create mode 100644 fml/lib/Mail/Delivery/Makefile
 create mode 100644 fml/lib/Mail/Delivery/Net/.cvsignore
 create mode 100644 fml/lib/Mail/Delivery/Net/INET4.pm
 create mode 100644 fml/lib/Mail/Delivery/Net/INET6.pm
 create mode 100644 fml/lib/Mail/Delivery/Net/Makefile
 create mode 100644 fml/lib/Mail/Delivery/Net/index.ja.html
 create mode 100644 fml/lib/Mail/Delivery/SMTP.pm
 create mode 100644 fml/lib/Mail/Delivery/Utils.pm
 create mode 100644 fml/lib/Mail/Delivery/index.ja.html
 create mode 100644 fml/lib/Mail/Makefile
 create mode 100644 fml/lib/Mail/Message.pm
 create mode 100644 fml/lib/Mail/delivery.ja.html
 create mode 100644 fml/lib/Mail/index.ja.html
 create mode 100644 fml/lib/Mail/pointer.ja.html

diff --git a/fml/lib/Mail/.cvsignore b/fml/lib/Mail/.cvsignore
new file mode 100644
index 00000000..b643ba41
--- /dev/null
+++ b/fml/lib/Mail/.cvsignore
@@ -0,0 +1 @@
+@@doc
diff --git a/fml/lib/Mail/Delivery.pm b/fml/lib/Mail/Delivery.pm
new file mode 100644
index 00000000..99a81975
--- /dev/null
+++ b/fml/lib/Mail/Delivery.pm
@@ -0,0 +1,147 @@
+#-*- 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 Mail::Delivery;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use IO::Socket;
+
+
+=head1 NAME
+
+Mail::Delivery - mail delivery system interface
+
+=head1 SYNOPSIS
+
+    use Mail::Delivery;
+    my $service = new Mail::Delivery {
+	protocol           => 'SMTP',
+	default_io_timeout => 10,
+    };
+    if ($service->error) { Log($service->error); return;}
+
+
+    $map_params = {
+	'mysql:toymodel' => {
+	    getline        => "select ... ",
+	    get_next_value => "select ... ",
+	    add            => "insert ... ",
+	    delete         => "delete ... ",
+	    replace        => "set address = 'value' where ... ",
+	},
+    };
+
+    $service->deliver(
+                      {
+                          smtp_servers    => '[::1]:25 127.0.0.1:25',
+
+                          smtp_sender     => 'rudo@nuinui.net',
+                          recipient_maps  => $recipient_maps,
+                          recipient_limit => 1000,
+			  map_params      => $map_params,
+
+                          header          => $header_object,
+                          body            => $body_object,
+                      });
+    if ($service->error) { Log($service->error); return;}
+
+Actually the real estate of this class is 
+almost C<Mail::Delivery::SMTP> class.
+Please see it for more details.
+
+=head1 DESCRIPTION
+
+In C<Mail::Delivery> class, 
+C<Delivery> is an adapter to
+C<SMTP>
+C<ESMTP>
+C<LMTP> classes. 
+For example, we use 
+C<Delivery>
+as an entrance into 
+actual delivery routines in 
+C<SMTP>
+C<ESMTP>
+C<LMTP> classes. 
+
+                     SMTP
+                      |
+                      A
+                  ----------
+                 |          |
+  Delivery --> ESMTP       LMTP
+
+
+=head1 METHODS
+
+=item C<new($args)>
+
+constructor. The request is forwarded to SUPER class.
+
+=cut
+
+
+sub new
+{
+    my ($self, $args) = @_;
+    my $protocol =  $args->{ protocol } || 'SMTP';
+    my $pkg      = 'Mail::Delivery::SMTP';
+
+    # char's of the protocol name is aligned to upper case.
+    $protocol =~ tr/a-z/A-Z/;
+ 
+    if ($protocol eq 'SMTP') {
+	$pkg = 'Mail::Delivery::SMTP';
+    }
+    elsif ($protocol eq 'ESMTP') {
+	$pkg = 'Mail::Delivery::EMTP';
+    }
+    elsif ($protocol eq 'LMTP') {
+	$pkg = 'Mail::Delivery::LMTP';
+    }
+    else {
+	croak("unknown protocol=$protocol");
+	return undef;
+    }
+
+    unshift(@ISA, $pkg);
+    eval qq{require $pkg; $pkg->import();};
+    unless ($@) {
+	$self->SUPER::new($args);
+    }
+    else {
+	croak("fail to load $pkg");
+	return undef;
+    }
+}
+
+
+=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
+
+Mail::Delivery appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/Mail/Delivery/ESMTP.pm b/fml/lib/Mail/Delivery/ESMTP.pm
new file mode 100644
index 00000000..90922430
--- /dev/null
+++ b/fml/lib/Mail/Delivery/ESMTP.pm
@@ -0,0 +1,59 @@
+#-*- 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 Mail::Delivery::ESMTP;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use Mail::Delivery::SMTP;
+
+require Exporter;
+@ISA = qw(Mail::Delivery::SMTP Exporter);
+
+sub new
+{
+    my ($self) = @_;
+    $self->SUPER::new(@_);
+}
+
+
+=head1 NAME
+
+Mail::Delivery::ESMTP - Extended SMTP class
+
+=head1 SYNOPSIS
+
+   use Mail::Delivery::ESMTP;
+   $service = new Mail::Delivery::ESMTP;
+   $service->deliver( ... );
+
+See L<Mail::Delivery::SMTP> for more details since this ESMTP class
+is an adapter for SMTP (super) class for convenience.
+All requests are forwarded to SMTP super class.
+
+=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
+
+Mail::Delivery::ESMTP appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/Delivery/Makefile b/fml/lib/Mail/Delivery/Makefile
new file mode 100644
index 00000000..86f70b09
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Makefile
@@ -0,0 +1,16 @@
+all: anal
+
+anal:
+	@ find . | sort | grep -v CVS | sed 's@./@@'
+
+html:	index.ja.html
+
+index.ja.html: *.pm
+	(cd Net; make html)
+	../../../../doc/bin/dir2url.pl > index.ja.html
+
+_clean:
+	rm -f index.ja.html */index.ja.html
+
+clean:
+	(cd ../../../..;make clean)
diff --git a/fml/lib/Mail/Delivery/Net/.cvsignore b/fml/lib/Mail/Delivery/Net/.cvsignore
new file mode 100644
index 00000000..b643ba41
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Net/.cvsignore
@@ -0,0 +1 @@
+@@doc
diff --git a/fml/lib/Mail/Delivery/Net/INET4.pm b/fml/lib/Mail/Delivery/Net/INET4.pm
new file mode 100644
index 00000000..f9005ff8
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Net/INET4.pm
@@ -0,0 +1,112 @@
+#-*- 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 Mail::Delivery::Net::INET4;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use Mail::Delivery::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_set("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_set("Error: cannot open socket: $!");
+	return undef;
+    }
+}
+
+
+=head1 NAME
+
+Mail::Delivery::Net::INET4 - establish tcp connection over IPv4
+
+=head1 SYNOPSIS
+
+   use Mail::Delivery::Net::INET4;
+
+   $mta = '127.0.0.1:25';
+   $self->connect4( { _mta => $mta });
+
+=head1 DESCRIPTION
+
+This module tries to create a socket and establish tcp connection over
+IPv4. This is a typical socket program.
+
+=head1 METHODS
+
+=item C<connect4()>
+
+try L<connect(2)>. 
+If it succeeds, returned 
+$self->{ _socket } has true value.
+If not, 
+$self->{ _socket } is undef. 
+
+Avaialble arguments follows:
+
+    connect4( { _mta => $mta });
+
+$mta is a hostname or [raw_ipv4_addr]:port form, for example, 
+127.0.0.1:25.
+
+=head1 SEE ALSO
+
+L<Mail::Delivery::SMTP>,
+L<Socket>,
+L<IO::Socket>,
+L<Mail::Delivery::Utils>
+
+=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
+
+Mail::Delivery::Net::INET4 appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/Delivery/Net/INET6.pm b/fml/lib/Mail/Delivery/Net/INET6.pm
new file mode 100644
index 00000000..eb6f4bdc
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Net/INET6.pm
@@ -0,0 +1,209 @@
+#-*- 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 Mail::Delivery::Net::INET6;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use Mail::Delivery::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
+
+Mail::Delivery::Net::INET6 - establish tcp connection over IPv6 
+
+=head1 SYNOPSIS
+
+    if ($self->is_ipv6_ready($args)) {
+	$self->connect6($args);
+    }
+
+=head1 DESCRIPTION
+
+This module tries to create a socket and establish a tcp connection
+over IPv6. It is used within C<Mail::Delivery::SMTP> module.
+
+=head1 METHODS
+
+=item C<is_ipv6_ready()>
+
+It checks whether your environment has Socket6.pm or not?
+If Socket6 module exists, we assume your operating system is IPv6 ready!
+
+=item C<connect6()>
+
+try L<connect(2)>. 
+If it succeeds, returned 
+$self->{ _socket } has true value.
+If not, 
+$self->{ _socket } is undef. 
+
+Avaialble arguments follows:
+
+    connect6( { _mta => $mta });
+
+$mta is a hostname or [raw_ipv6_addr]:port form, for example, 
+[::1]:25.
+
+=head1 SEE ALSO
+
+L<Mail::Delivery::SMTP>,
+L<Socket6>,
+L<Socket>,
+L<IO::Handle>,
+L<IO::Socket>,
+L<Mail::Delivery::Utils>
+
+=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
+
+Mail::Delivery::Net::INET6 appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/Delivery/Net/Makefile b/fml/lib/Mail/Delivery/Net/Makefile
new file mode 100644
index 00000000..795737fa
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Net/Makefile
@@ -0,0 +1,6 @@
+all: html
+
+html:	index.ja.html
+
+index.ja.html: *pm
+	../../../../doc/bin/dir2url.pl > index.ja.html
diff --git a/fml/lib/Mail/Delivery/Net/index.ja.html b/fml/lib/Mail/Delivery/Net/index.ja.html
new file mode 100644
index 00000000..1bdd7b0b
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Net/index.ja.html
@@ -0,0 +1,31 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+Mail::Delivery/Net::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>Mail::Delivery::Net class modules</EM></CENTER>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ INET4.pm <TD>
+<A HREF="INET4.pm">[source]</A>
+<TD>
+<A HREF="@@doc/INET4.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ INET6.pm <TD>
+<A HREF="INET6.pm">[source]</A>
+<TD>
+<A HREF="@@doc/INET6.txt">[manual]</A>
+<TD>
+</TABLE>
+</BODY>
+</HTML>
diff --git a/fml/lib/Mail/Delivery/SMTP.pm b/fml/lib/Mail/Delivery/SMTP.pm
new file mode 100644
index 00000000..06309d03
--- /dev/null
+++ b/fml/lib/Mail/Delivery/SMTP.pm
@@ -0,0 +1,804 @@
+#-*- 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 Mail::Delivery::SMTP;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+use IO::Socket;
+use Mail::Delivery::Utils;
+use Mail::Delivery::Net::INET4;
+use Mail::Delivery::Net::INET6;
+
+require Exporter;
+@ISA = qw(Exporter);
+
+
+BEGIN {}
+END   {}
+
+
+=head1 NAME
+
+Mail::Delivery::SMTP - interface for SMTP service
+
+=head1 SYNOPSIS
+
+To initialize, 
+
+    use Mail::Delivery::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 Mail::Delivery::SMTP {
+        log_function       => $fp,
+        smtp_log_function  => $sfp,
+        default_io_timeout => 10,
+    };
+    if ($service->error) { Log($service->error); return;}
+
+To start delivery, use deliver() method in this way.
+
+    $service->deliver(
+                      {
+                          smtp_servers    => '127.0.0.1:25',
+
+                          smtp_sender     => 'rudo@nuinui.net',
+                          recipient_maps  => $recipient_maps,
+                          recipient_limit => 1000,
+
+                          header          => $header_object,
+                          body            => $body_object,
+                      });
+
+You can specify the recipient list as an ARRAY REFERENCE.
+
+    # reference to an array of recipients
+    $rarray = [ 'kenken@nuinui.net' ];
+
+    $service->deliver(
+                      {
+                          smtp_servers    => '127.0.0.1:25',
+
+                          smtp_sender     => 'rudo@nuinui.net',
+                          recipient_array_reference => $rarray,
+                          recipient_limit => 1000,
+
+                          header          => $header_object,
+                          body            => $body_object,
+                      });
+
+=head1 DESCRIPTION
+
+This module provides SMTP/ESMTP mail delivery service.
+It tries IPv6 connection If possible.
+
+The socket creation and tcp connection is controlled by
+sub-classes, 
+C<Mail::Delivery::Net::INET4> and
+C<Mail::Delivery::Net::INET6>.
+
+It sends a list of all recipients indicated by $recipient_maps.
+C<IO::MapAdapter> resolves $recipient_maps and provides the abstract
+IO layer. It provides the usual file IO methods for each C<map>.
+See L<IO::MapAdapter> for more details.
+
+=head1 METHODS
+
+=item C<new($args)>
+
+the constructor. 
+Please specify it in a hash reference as an argument of new().
+Several parameters on logging and timeout et. al. are avialable.
+
+   hash key             value
+   --------------------------------------------
+   log_function         reference to function for logging
+   smtp_log_function    reference to function for logging
+   default_io_timeout   default timeout associated with the socket IO
+
+C<log_function()> is the function pointer to write a message in the
+log file.  
+C<smtp_log_function()> is special function pointer to log SMTP
+transactions.
+
+=cut
+
+# Descriptions: Mail::Delivery::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.
+    #  _default_io_timeout: basic timeout parameter for smtp session
+    #        _log_function: pointer to the log() function
+    $me->{_recipient_limit}    = $args->{recipient_limit}    || 1000;
+    $me->{_default_io_timeout} = $args->{default_io_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."\r\n");
+
+    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 { croak("$id socket timeout")}; 
+	alarm( $self->{_default_io_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_set("Error: smtp reply for \"$x\" is timeout");
+    }
+
+    # reset latest alarm() setting
+    alarm(0);
+}
+
+
+# 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($args)>
+
+start delivery process.
+You can specify the following parameter at C<$args> HASH REFERENCE.
+
+    hash key           value
+    --------------------------------------------
+    smtp_servers       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               Mail::Message object
+
+C<smtp_servers> is a list of MTA's (Mail Transport Agents).
+The syntax of each MTA is C<host:port> or C<address:port> style. 
+If you use a raw IPv6 address, use C<[address]:port> syntax. 
+For example, [::1]:25 (IPv6 loopback address).
+You can specify a combination of IPv4 and IPv6 addresses at
+C<smtp_servers>.
+C<deliver()> automatically tries smtp connection on both protocols.
+
+C<smtp_sender> is the sender's email address. 
+It is used at MAIL FROM: command.
+
+C<recipient_maps> is a list of C<maps>.
+See L<IO::MapAdapter> for more details. 
+For example,
+
+To read addresses from a file, specify the map as
+
+         file:/var/spool/ml/elena/recipients
+
+and 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 C<Postfix>. 
+
+C<header> is an C<FML::Header> object.
+
+C<body> is a C<Mail::Message> object.
+See L<Mail::Message> 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 Mail::Delivery::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->{ smtp_servers } || '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_reference } ) eq 'ARRAY') {
+	my $map = $args->{ recipient_array_reference };
+	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, $args->{ map_params });
+	    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_clear;
+
+		# 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_set( $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);
+    }
+}
+
+
+############################################################
+#####
+##### 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 "Mail::Message object"
+# Side Effects: none
+# Return Value: none
+sub _send_body_to_mta
+{
+    my ($self, $socket, $msg) = @_;
+
+    # XXX $msg is Mail::Message 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<Mail::Delivery::Utils>,
+L<Mail::Delivery::INET4>,
+L<Mail::Delivery::INET6>,
+L<IO::MapAdapter>
+
+See I<http://www.postfix.org/> on C<Postfix> 
+which replaces sendmail with little effort 
+but provides a lot of compatibility except for sendmail.cf.
+
+=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
+
+Mail::Delivery::SMTP appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/Delivery/Utils.pm b/fml/lib/Mail/Delivery/Utils.pm
new file mode 100644
index 00000000..a69759a5
--- /dev/null
+++ b/fml/lib/Mail/Delivery/Utils.pm
@@ -0,0 +1,338 @@
+#-*- 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 Mail::Delivery::Utils;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK 
+	    $LogFunctionPointer $SmtpLogFunctionPointer);
+use Carp;
+use ErrorMessages::Status qw(error_set error error_clear);
+
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+	     Log
+	     _smtplog
+	     smtplog
+
+	     $LogFunctionPointer
+	     $SmtpLogFunctionPointer
+
+	     error_set 
+	     error 
+	     error_clear 
+
+	     _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
+	     );
+
+
+=head1 NAME
+
+Mail::Delivery::utils - utiliti programs for mail delivery
+
+=head1 SYNOPSIS
+
+For example,
+
+   use Mail::Delivery::utils;
+   Log( $message_to_log );
+
+=head1 DESCRIPTION
+
+several utility functions for C<Mail::Delivery> sub classes.
+
+=cut
+
+#################################################################
+#####
+##### General Logging
+#####
+
+=head1 LOGGING FUNCTIONS
+
+=head2 C<Log($buf)>
+
+Logging interface. 
+send C<$buf> (the log message) to the function specified as
+C<$LogFunctionPointer> (CODE REFERENCE).
+C<$LogFunctionPointer> is expected to set up at
+C<Mail::Delivery::Delivery::new()>
+If it is not specified,
+the logging message is forwarded to STDERR channel.
+
+=cut
+
+
+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";
+    }
+}
+
+
+#################################################################
+#####
+##### SMTP Logging
+#####
+
+=head2 C<smtplog($buf)>
+
+smtp logging interface as the same as C<Log()> but for smtp
+transcation log.
+If the real log function pointer is not specified at
+C<Mail::Delivery::Delivery::new()>, 
+C<$buf> is sent to C<STDERR>.
+
+=cut
+
+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";
+    }
+}
+
+
+
+#################################################################
+
+=head1 METHODS FOR ERROR MESSAGES AND STATUS CODES
+
+=head2 C<error_set($mesg)>
+
+save C<$mesg>.
+
+=head2 C<error()>
+
+return the latest error message which saved by C<error_set()>.
+
+=head2 C<error_clear()>
+
+reset the error buffer which C<error_set()> and C<error()> use.
+
+=cut
+
+
+#################################################################
+#####
+##### status codes manipulations
+#####
+
+=head2 C<_set_status_code($value)>
+
+save C<($value)> as status code.
+
+=head2 C<_get_status_code()>
+
+get the latest status code.
+
+=cut
+
+
+sub _get_status_code
+{
+    my ($self) = @_;
+    $self->{'_status_code'};
+}
+
+
+sub _set_status_code
+{
+    my ($self, $value) = @_;
+    $self->{'_status_code'} = $value;
+}
+
+
+
+
+#################################################################
+#####
+##### utility to control $recipient_map
+#####
+
+=head1 METHODS TO HANDLE POSITION at IO MAP
+
+=head2	     C<_set_target_map($map)>
+
+save the current C<map> name
+where C<map> is a name usable at C<recipient_maps>
+
+=head2	     C<_get_target_map()>
+
+return the current C<map>
+where C<map> is a name usable at C<recipient_maps>
+
+=cut
+
+sub _set_target_map
+{
+    my ($self, $map) = @_;
+    $self->{ _mapinfo }->{ _curmap } = $map;
+}
+
+
+sub _get_target_map
+{
+    my ($self) = @_;
+    $self->{ _mapinfo }->{ _curmap };
+}
+
+
+=head2	     C<_set_map_status($map, $status)>
+
+save C<$status> for C<$map> IO.
+For example, C<$status> is 'not done'.
+
+=head2	     C<_set_map_position($map, $position)>
+
+save the C<$position> for C<$map> IO.
+
+=head2	     C<_get_map_status($map)>
+
+get the current C<$status> for C<$map> IO.
+
+=head2	     C<_get_map_position($map)>
+
+get the current C<$position> for C<$map> IO.
+
+=cut
+
+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};
+}
+
+
+=head2	     C<_rollback_map_position()>
+
+stop the IO for the current C<$map>.
+This method rolls back the operation state to the time when the
+current IO for C<$map> begins.
+
+=head2	     C<_reset_mapinfo()>
+
+clear information around the latest map operation.
+
+=cut
+
+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 };
+}
+
+
+
+=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
+
+Mail::Delivery::utils appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/Delivery/index.ja.html b/fml/lib/Mail/Delivery/index.ja.html
new file mode 100644
index 00000000..ae9d7db1
--- /dev/null
+++ b/fml/lib/Mail/Delivery/index.ja.html
@@ -0,0 +1,41 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+Mail/Delivery::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>Mail::Delivery class modules</EM></CENTER>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ ESMTP.pm <TD>
+<A HREF="ESMTP.pm">[source]</A>
+<TD>
+<A HREF="@@doc/ESMTP.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ <A HREF=Net/index.ja.html>Mail::Delivery::Net::* class</A>
+<TR>
+<TD>
+ SMTP.pm <TD>
+<A HREF="SMTP.pm">[source]</A>
+<TD>
+<A HREF="@@doc/SMTP.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ Utils.pm <TD>
+<A HREF="Utils.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Utils.txt">[manual]</A>
+<TD>
+</TABLE>
+</BODY>
+</HTML>
diff --git a/fml/lib/Mail/Makefile b/fml/lib/Mail/Makefile
new file mode 100644
index 00000000..e7ce3c86
--- /dev/null
+++ b/fml/lib/Mail/Makefile
@@ -0,0 +1,16 @@
+all: anal
+
+anal:
+	@ find . | sort | grep -v CVS | sed 's@./@@'
+
+html:	index.ja.html
+
+index.ja.html: *.pm
+	(cd Delivery; make html)
+	../../../doc/bin/dir2url.pl > index.ja.html
+
+_clean:
+	rm -f index.ja.html */index.ja.html
+
+clean:
+	(cd ../../..;make clean)
diff --git a/fml/lib/Mail/Message.pm b/fml/lib/Mail/Message.pm
new file mode 100644
index 00000000..c145de7e
--- /dev/null
+++ b/fml/lib/Mail/Message.pm
@@ -0,0 +1,1044 @@
+#-*- 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 Mail::Message;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+
+# virtual content-type
+my %content_type = 
+    (
+     'preamble'        => '_multipart_preamble/plain',
+     'delimiter'       => '_multipart_delimiter/plain',
+     'close-delimiter' => '_multipart_close-delimiter/plain',
+     'trailer'         => '_multipart_trailer/plain',
+     );
+
+
+sub new
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+
+    bless $me, $type;
+
+    if ($args) { create($me, $args);}
+
+    return bless $me, $type;
+}
+
+
+######################################################################
+=head1 NAME
+
+Mail::Message -- message manipulator
+
+=head1 SYNOPSIS
+
+    my $m1 = new Mail::Message { content => \$body1 };
+
+    my $m2 = new Mail::Message;
+    $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.
+
+The messages are chained from/to others among them.
+Out idea on the chain is similar to IPv6.
+For example, MIME/multipart is a chain of messages such as
+
+  mesg1 -> mesg2 -> mesg3 (-> undef)
+
+Whereas the usual mail, which Content-Type is text/plain, is described
+as
+
+  mesg1 (-> undef)
+
+To describe such chains, a message format is a hash reference
+internally.
+
+   $message = {
+                version           => 1.0
+
+                next              => $next_message (HASH reference)
+                prev              => $prev_message (HASH reference)
+
+                mime_version      => 1.0
+                base_content_type => text/plain
+                content_type      => text/plain
+                header            => {
+                                       field_name => field_value
+                                     }
+                content           => \$message_body
+               }
+
+   key                value
+   -----------------------------------------------------
+   next               pointer to the next message
+   prev               pointer to the previous message
+   version            Mail::Delivery::Message object version
+   mime_version       MIME version
+   base_content_type  MIME content-type specified in the header
+   content_type       MIME content-type
+   header             MIME header
+   content            reference to the content (that is, memory area)
+
+Each default value follows:
+
+   key              value
+   -----------------------------------------------------
+   next              undef
+   prev              undef
+   version           1.0
+   mime_version      1.0
+   base_content_type
+   content_type      text/plain
+   header            undef
+   content           ''
+
+
+=head1 INTERNAL REPRESENTATION
+
+=head2 plain/text
+
+If the message is just an plain/text, which is usual,
+internal representation follows:
+
+   i  base_content_type              content_type
+   ----------------------------------------------------------
+   0: text/plain                      text/plain
+
+where the C<i> is the C<i>-th element of a chain.
+
+=head2 multipart/...
+
+Consider a multipart such as
+
+   Content-Type: multipart/mixed; boundary="boundary"
+
+      ... preamble ...
+
+   --boundary
+   Content-Type: text/plain; charset="iso-2022-jp"
+
+   --boundary
+   Content-Type: image/gif;
+
+   --boundary--
+      ... trailor ...
+
+The internal parser interpetes it as follows:
+
+      base_content_type              content_type
+   ----------------------------------------------------------
+   0: multipart/mixed                _multipart_preamble/plain
+   1: multipart/mixed                _multipart_delimiter/plain
+   2: multipart/mixed                text/plain
+   3: multipart/mixed                _multipart_delimiter/plain
+   4: multipart/mixed                image/gif
+   5: multipart/mixed                _multipart_close-delimiter/plain
+   6: multipart/mixed                _multipart_trailer/plain
+
+C<_multipart_something> is a faked type to treat both real content,
+delimiters and others in the same Mail::Message framework.
+
+=head1 METHOD
+
+=head2 C<new($args)>
+
+constructor. if $args is given, create() method is called.
+
+=head2 C<create($args)>
+
+build a template message following the given $args (a hash reference).
+
+=cut
+
+
+# Descriptions: adapter to forward the request to object builders
+#               by following content-type. The real work is done at
+#                 &parse_and_build_mime_multipart_chain() if multipart
+#                 &_create() if not
+#    Arguments: $self $args
+# Side Effects: none
+# Return Value: none
+sub create
+{
+    my ($self, $args) = @_;
+
+    # set up template anyway
+    $self->_set_up_template($args);
+
+    # parse the non multipart mail and build a chain
+    if ($args->{ content_type } =~ /multipart/i) {
+	$self->parse_and_build_mime_multipart_chain($args);
+    }
+    else {
+	$self->_create($args);
+    }
+}
+
+
+sub _set_up_template
+{
+    my ($self, $args) = @_;
+
+    # message chains
+    $self->{ 'next' }       = $args->{ 'next' } || undef;
+    $self->{ 'prev' }       = $args->{ 'prev' } || undef;
+
+    # basic content information
+    $self->{ version }      = $args->{ version }       || 1.0;
+    $self->{ mime_version } = $args->{ mime_version }  || 1.0;
+    $self->{ content_type } = $args->{ content_type  } || 'text/plain';
+
+    # header
+    $self->{ header  }      = $args->{ header  } || undef;
+
+    # save the mail header Content-Type information
+    $self->{ base_content_type } =
+	$args->{ base_content_type } || $args->{ content_type } || undef;
+}
+
+
+sub _create
+{
+    my ($self, $args) = @_;
+
+    _set_up_template($self, $args);
+
+    # message itself (mail body)
+    my $r_content = $args->{ content };
+    my $filename  = $args->{ filename };
+
+    # on memory
+    if (defined $r_content) {
+	my $len = length( $$r_content );
+	$self->{ content }      = $args->{ content } || '';
+	$self->{ offset_begin } = $args->{ offset_begin } || 0;
+	$self->{ offset_end }   = $args->{ offset_end   } || $len;
+	$self->{ _on_memory }   = 1;
+    }
+    # on disk
+    elsif (defined $filename) {
+	if (-f $filename) {
+	    undef $self->{ content };
+	    $self->{ header }     = build_mime_header($self, $args);
+	    $self->{ filename }   = $filename;
+	    $self->{ _on_memory } = 0; # not on memory
+	}
+	else {
+	    carp("$filename not exist");
+	}
+    }
+    else {
+	carp("neither content nor filename specified");
+    }
+}
+
+
+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 build_mime_multipart_chain
+{
+    my ($self, $args) = @_;
+    my ($head, $prev_m);
+
+    my $base_content_type = $args->{ base_content_type };
+    my $msglist           = $args->{ message_list };
+    my $boundary          = $args->{ boundary } || "--". time ."-$$-";
+    my $dash_boundary     = "--". $boundary;
+    my $delbuf            = "\n". $dash_boundary."\n";
+    my $delbuf_end        = "\n". $dash_boundary . "--\n";
+
+    for my $m (@$msglist) {
+	# delimeter: --boundary
+	my $msg = new Mail::Message {
+	    base_content_type => $base_content_type,
+	    content_type      => $content_type{'delimeter'},
+	    boundary          => $boundary,
+	    content           => \$delbuf,
+	};
+
+	$head = $msg unless $head; # save the head $msg
+
+	# boundary -> content -> boundary ...
+	if (defined $prev_m) { $prev_m->next_chain( $msg );}
+	$msg->next_chain( $m );
+
+	# for the next loop
+	$prev_m = $m;
+    }
+
+    # close delimeter: --boundary--
+    my $msg = new Mail::Message {
+	base_content_type => $base_content_type,
+	content_type      => $content_type{'close-delimeter'},
+	boundary          => $boundary,
+	content           => \$delbuf_end,
+    };
+    $prev_m->next_chain( $msg ); # ... -> content -> close-delimeter
+
+    return $head; # return the pointer to the head of a chain
+}
+
+
+=head2 C<next_chain( $reference_to_message )>
+
+The next one of this message is $reference_to_message.
+
+=head2 C<prev_chain( $reference_to_message )>
+
+The previous one of this message is $reference_to_message.
+
+=head2 C<print( $fd )>
+
+print out a chain of messages to the file descriptor $fd.
+If $fd is not specified, STDOUT is used.
+
+=cut
+
+sub raw_print
+{
+    my ($self, $fd) = @_;
+
+    $self->{ _raw_print } = 1;
+    $self->print($fd);
+    delete $self->{ _raw_print };
+}
+
+
+sub print
+{
+    my ($self, $fd) = @_;
+    my $msg  = $self;
+    my $args = $self; # e.g. pass _raw_print flag among functions
+
+    # if $fd is not given, we use STDOUT.
+    unless (defined $fd) { $fd = \*STDOUT;}
+
+  MSG:
+    while (1) {
+	# on memory
+	if (defined $msg->{ content }) {
+	    $msg->_print_messsage_on_memory($fd, $args);
+	}
+	# not on memory, may be on disk
+	elsif (defined $msg->{ filename } &&
+	    -f $msg->{ filename }) {
+	    $msg->_print_messsage_on_disk($fd, $args);
+	}
+
+	last MSG unless $msg->{ 'next' };
+	$msg = $msg->{ 'next' };
+    }
+}
+
+
+# Descriptions: send the body part of the message on memory 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.
+#               XXX the message to send out is $self->{ content }.
+#    Arguments: $self $socket
+# Side Effects: none
+# Return Value: none
+sub _print_messsage_on_memory
+{
+    my ($self, $fd, $args) = @_;
+
+    # \n -> \r\n
+    my $raw_print_mode = 1 if defined $args->{ _raw_print };
+
+    # set up offset for the buffer
+    my $r_body = $self->{ content };
+    my $header = $self->{ header };
+    my $pp     = $self->{ offset_begin };
+    my $p_end  = $self->{ offset_end };
+    my $maxlen = length($$r_body);
+    my $logfp  = $self->{ _log_function };
+    $logfp     = ref($logfp) eq 'CODE' ? $logfp : undef;
+
+    # 1. print content header if exists
+    if (defined $header) {
+	$header =~ s/\n/\r\n/g unless (defined $raw_print_mode);
+	print $fd $header;
+	print $fd ($raw_print_mode ? "\n" : "\r\n");
+    }
+
+    # 2. print content body: write each line in buffer
+    my ($p, $len, $buf, $pbuf);
+  SMTP_IO:
+    while (1) {
+	$p = index($$r_body, "\n", $pp);
+	last SMTP_IO if $p >= $p_end;
+
+	$len = $p - $pp + 1;
+	$len = ($p < 0 ? ($maxlen - $pp) : $len);
+	$buf = substr($$r_body, $pp, $len);
+
+	# do nothing, get away from here 
+	last SMTP_IO if $len == 0;
+
+	unless (defined $raw_print_mode) {
+	    # fix \n -> \r\n in the end of the line
+	    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 _print_messsage_on_disk
+{
+    my ($self, $fd, $args) = @_;
+
+    # \n -> \r\n
+    my $raw_print_mode = 1 if defined $args->{ _raw_print };
+    my $header   = $self->{ header }   || undef;
+    my $filename = $self->{ filename } || undef;
+    my $logfp    = $self->{ _log_function };
+    $logfp       = ref($logfp) eq 'CODE' ? $logfp : undef;
+
+    # 1. print content header if exists
+    if (defined $header) {
+	$header =~ s/\n/\r\n/g unless (defined $raw_print_mode);
+	print $fd $header;
+	print $fd ($raw_print_mode ? "\n" : "\r\n");
+    }
+
+    # 2. print content body: write each line in buffer
+    use FileHandle;
+    my $fh = new FileHandle $filename;
+    if (defined $fh) {
+	my $buf;
+
+      SMTP_IO:
+	while (<$fh>) {
+	    $buf = $_;
+
+	    unless (defined $raw_print_mode) {
+		# fix \n -> \r\n in the end of the line
+		if ($buf !~ /\r\n$/) { $buf =~ s/\n$/\r\n/;}
+
+		# ^. -> ..
+		$buf =~ s/^\./../;
+	    }
+
+	    print $fd $buf;
+	    &$logfp($buf) if $logfp;
+	}
+	close($fh);
+    }
+    else {
+	carp("cannot open $filename");
+    }
+}
+
+
+=head2 C<parse_and_build_mime_multipart_chain($args)>
+
+parse the multipart mail. Actually it calculates the begin and end
+offset for each part of content, not split() and so on.
+C<new()> calls this routine if the message looks MIME multipart.
+
+=cut
+
+
+# CAUTION: $args must be the same as it of new().
+#
+#         ... preamble ...
+#      V $mpb_begin
+#      ---boundary
+#         ... message 1 ...
+#      ---boundary
+#         ... message 2 ...
+#      V $mpb_end  (V here is not $buf_end)
+#      ---boundary--
+#         ... trailor ...
+#
+# RFC2046 Appendix say,
+#           multipart-body := [preamble CRLF]
+#                              dash-boundary transport-padding CRLF
+#                              body-part *encapsulation
+#                              close-delimiter transport-padding
+#                              [CRLF epilogue]
+#
+sub parse_and_build_mime_multipart_chain
+{
+    my ($self, $args) = @_;
+
+    # check input parameters
+    return undef unless $args->{ boundary };
+    return undef unless $args->{ content  };
+
+    # base content-type
+    my $base_content_type = $args->{ content_type };
+
+    # boundaries of the continuous multipart blocks
+    my $content         = $args->{ content };  # reference to content
+    my $content_end     = length($$content);   # end position of the content
+    my $boundary        = $args->{ boundary }; # MIME boundary string
+    my $dash_boundary   = "--".$boundary;
+    my $delimeter       = "\n". $dash_boundary;
+    my $close_delimeter = $delimeter ."--";
+
+    # 1. check the preamble before multipart blocks
+    #    XXX mpb = multipart-body
+    my $mpb_begin       = index($$content, $delimeter, 0);
+    my $mpb_end         = index($$content, $close_delimeter, 0);
+    my $pb              = 0; # pb = position of the beginning in $content
+    my $pe              = $mpb_begin; # pe = position of the end in $content
+    $self->_set_pos( $pe + 1 );
+
+    # prepare lexical variables
+    my ($msg, $next_part, $prev_part, @m);
+    my $i = 0; # counter to indicate the $i-th message
+    do {
+	# 2. analyze the region for the next part in $content
+	#     we should check the condition "$pe > $pb" here
+	#     to avoid the empty preamble case.
+	# XXX this function is not called
+	# XXX if there is not the prededing preamble.
+	if ($pe > $pb) { # XXX not effective region if $pe <= $pb
+	    my ($header, $pb) = _get_mime_header($content, $pb);
+
+	    my $args = {
+		boundary          => $boundary,
+		offset_begin      => $pb,
+		offset_end        => $pe,
+		header            => $header || undef,
+		content           => $content,
+		base_content_type => $base_content_type,
+	    };
+	    my $default = ($i == 0) ? $content_type{'preamble'} : undef;
+	    $args->{ content_type } = _get_content_type($args, $default);
+
+	    $m[ $i++ ] = $self->_alloc_new_part($args);
+	}
+
+	# 3. where is the region for the next part?
+	($pb, $pe) = $self->_next_part_pos($content, $delimeter);
+
+	# 4. insert a multipart delimiter
+	#    XXX we malloc(), "my $tmpbuf", to store the delimeter string.
+	if ($pe > $mpb_end) { # check the closing of the blocks or not
+	    my $buf = $close_delimeter."\n";
+	    $m[ $i++ ] = $self->_alloc_new_part({
+		content           => \$buf,
+		content_type      => $content_type{'close-delimiter'},
+		base_content_type => $base_content_type,
+	    });
+
+	}
+	else {
+	    my $buf = $delimeter."\n";
+	    $m[ $i++ ] = $self->_alloc_new_part({
+		content           => \$buf,
+		content_type      => $content_type{'delimiter'},
+		base_content_type => $base_content_type,
+	    });
+	}
+
+    } while ($pe <= $mpb_end);
+
+    # check the trailor after multipart blocks exists or not.
+    {
+	my $p = index($$content, "\n", $mpb_end + length($close_delimeter)) +1;
+	if (($content_end - $p) > 0) {
+	    $m[ $i++ ] = $self->_alloc_new_part({
+		boundary          => $boundary,
+		offset_begin      => $p,
+		offset_end        => $content_end,
+		content           => $content,
+		content_type      => $content_type{'trailor'},
+		base_content_type => $base_content_type,
+	    });
+	}
+    }
+
+    # build a chain of multipart blocks and delimeters
+    my $j = 0;
+    for ($j = 0; $j < $i; $j++) {
+	if (defined $m[ $j + 1 ]) {
+	    next_chain( $m[ $j ], $m[ $j + 1 ] );
+	}
+	if (($j > 1) && defined $m[ $j - 1 ]) {
+	    prev_chain( $m[ $j ], $m[ $j - 1 ] );
+	}
+
+	if (0) { # debug
+	    printf STDERR "%d: %-30s %-30s\n", $j,
+		$m[ $j]->{ base_content_type },
+		$m[ $j]->{ content_type };
+	}
+    }
+
+    # chain $self and our chains built here.
+    next_chain($self, $m[0]);
+}
+
+
+sub _get_content_type
+{
+    my ($args, $default) = @_;
+    my $buf = $args->{ header } || '';
+
+    if ($buf =~ /Content-Type:\s*(\S+)\;/) {
+	return $1;
+    }
+    else {
+	$default
+    }
+}
+
+
+sub _get_mime_header
+{
+    my ($content, $pos_begin) = @_;
+    my $pos = index($$content, "\n\n", $pos_begin) + 1;
+    my $buf = substr($$content, $pos_begin, $pos - $pos_begin);
+
+    if ($buf =~ /Content-Type:\s*(\S+)\;/) {
+	return ($buf, $pos + 1);
+    }
+    else {
+	return ('', $pos_begin);
+    }
+}
+
+
+sub build_mime_header
+{
+    my ($self, $args) = @_;
+    my ($buf, $charset);
+    my $content_type = $args->{ content_type };
+
+    if ($content_type =~ /^text/) {
+	$charset = $args->{ charset } || 'us-ascii';
+    }
+
+    $buf .= "Content-Type: $content_type" if defined $content_type;
+    $buf .= ";\n\tcharset=$charset" if $charset;
+
+    # use File::Basename;
+    # my $fn = basename($args->{ filename } || '');
+    # $buf .= ";\n\tfilename=\"$fn\"" if $fn;
+
+    return ($buf ? $buf."\n" : undef);
+}
+
+
+# XXX $buf contains no MIME delimeter, acutual message itself:
+#     {Content-Type: ...
+#
+#       ... body ...}
+sub _alloc_new_part
+{
+    my ($self, $args) = @_;
+    my $me = {};
+
+    _create($me, $args);
+    return bless $me, ref($self);
+}
+
+
+sub _next_part_pos
+{
+    my ($self, $content, $delimeter) = @_;
+    my ($len, $p, $pb, $pe, $pp);
+    my $maxlen = length($$content);
+
+    # get the next deliemter position
+    $pp  = $self->_get_pos();
+    $p   = index($$content, $delimeter, $pp);
+    $self->_set_pos( $p + 1 );
+
+    # determine the begin and end of the next block without delimiter
+    $len = $p > 0 ? ($p - $pp) : ($maxlen - $pp);
+    $pb  = $pp + length($delimeter);
+    $pe  = $pb + $len - length($delimeter);
+
+    return ($pb, $pe);
+}
+
+
+sub _get_pos
+{
+    my ($self) = @_;
+    defined $self->{ _current_pos } ? $self->{ _current_pos } : 0;
+}
+
+
+sub _set_pos
+{
+    my ($self, $pos) = @_;
+    $self->{ _current_pos } = $pos;
+}
+
+
+=head2 C<size()>
+
+return the message size.
+
+=head2 C<is_empty()>
+
+return this message has empty content or not.
+
+=cut
+
+my $total = 0;
+
+sub size
+{
+    my ($self) = @_;
+    my $rc = $self->{ content };
+    my $pb = $self->{ offset_begin };
+    my $pe = $self->{ offset_end };
+
+    if ((defined $pe) && (defined $pb)) {
+	if ($pe - $pb > 0) {
+	    $total += ($pe - $pb);
+	    return ($pe - $pb);
+	}
+    }
+    else {
+	defined $rc ? length($$rc) : 0;
+    }
+}
+
+
+sub is_empty
+{
+    my ($self) = @_;
+    my $size   = $self->size;
+    my $rc     = $self->{ content };
+
+    if ($size == 0) { return 1;}
+    if ($size <= 8) {
+	if ($$rc =~ /^\s*$/) { return 1;}
+    }
+
+    # false
+    return 0;
+}
+
+
+sub get_content_type
+{
+    my ($self) = @_;
+    my $type = $self->{ content_type };
+    $type =~ s/;//;
+    $type;
+}
+
+
+=head2 C<num_paragraph()>
+
+return the number of paragraphs in the message ($self).
+
+=cut
+
+sub num_paragraph
+{
+    my ($self) = @_;
+
+    # exit ASAP if the message is empty. 
+    return 0 if $self->is_empty();
+
+    my $pb      = $self->{ offset_begin };
+    my $pe      = $self->{ offset_end };
+    my $bodylen = $self->size;
+    my $content = $self->{ content };
+
+    my $i  = 0; # the number of paragraphs
+    my $p  = $pb;
+    my $pp = $p;
+
+    # skip "\n" in the first and end of the buffer
+    while (substr($$content, $p, 1) eq "\n") { $p++;}
+    while (substr($$content, $pe -1, 1) eq "\n") { $pe--;} 
+
+    my (@pmap) = ($pb);
+  LINE:
+    while ($p < $pe) {
+	$pp = index($$content, "\n\n", $p);
+	if ($pp < $p ||    # not found
+	    $pp >= $pe ) { # over the end of buffer boundary
+
+	    push(@pmap, $pe); # the end of the last paragraph
+	    last LINE; 
+	}
+	else {
+	    # skip trailing "\n" after "\n\n"
+	    while (substr($$content, $pp, 1) eq "\n") { $pp++;}
+
+	    push(@pmap, $pp) if $pp > 0;
+
+	    $p = $pp;
+	}
+    }
+
+    # XXX debug
+    if (0) {
+	for (my $i = 0; $i < $#pmap; $i++ ) {
+	    my $p  = $pmap[ $i ];
+	    my $pp = $pmap[ $i + 1 ];
+	    print STDERR "($p,$pp)<", substr($$content, $p, $pp - $p) , ">\n";
+	}
+	print STDERR "( @pmap )\n"; 
+    }
+
+    $#pmap;
+}
+
+
+=head2 C<get_content_header($size)>
+
+get header in the content.
+
+=head2 C<get_content_body($size)>
+
+get body part in the content, 
+which is the whole mail or a part of multipart.
+
+=head2 C<get_first_plaintext_message($args)>
+
+return the Messages object for the first "plain/text" message in a
+chain. For example,
+
+         $m    = $msg->get_first_plaintext_message();
+         $body = $m->get_content_body();
+
+where $body is the mail body (string).
+
+=cut
+
+
+sub get_content_header
+{
+    my ($self, $size) = @_;
+    return defined $self->{ header } ? $self->{ header } : undef;
+}
+
+
+sub get_content_body
+{
+    my ($self, $size) = @_;
+    my $content           = $self->{ content };
+    my $base_content_type = $self->{ base_content_type };
+    my ($pos, $pos_begin, $msglen);
+
+    # if the content is undef, do nothing.
+    return undef unless $content; 
+
+    if ($base_content_type =~ /multipart/i) {
+	$pos_begin = $self->{ offset_begin };
+	$msglen    = $self->{ offset_end } - $pos_begin;
+    }
+    else {
+	$pos_begin = 0;
+	$msglen    = length($$content);
+    }
+
+    $size ||= 512;
+    if ($msglen < $size) { $size = $msglen;}
+    return substr($$content, $pos_begin, $size);
+}
+
+
+sub get_first_plaintext_message
+{
+    my ($self, $args) = @_;
+    my $size = $args->{ 'size' } || 512;
+    my $mp ; # mp = message pointer
+
+    # Let's go along the chain of message objects.
+    # This routine return the first reference to the message with the
+    # type = ' plain/text'
+    for ($mp = $self; 
+	 defined $mp->{ content } || defined $mp->{ 'next' }; 
+	 $mp = $mp->{ 'next' }) {
+	my $type = $mp->get_content_type;
+
+	if ($type eq 'text/plain') {
+	    return $mp;
+	}
+    }
+
+    return undef;
+}
+
+
+sub AUTOLOAD
+{
+    my ($self, $args) = @_;
+    my $function = $AUTOLOAD;
+    $function =~ s/.*:://;
+
+    return if $function =~ /DESTROY/;
+
+    if ($function =~ /^get_(\w+)_reference$/) {
+	return $self->{ $1 };
+    }
+    else {
+	return undef;
+    }
+}
+
+
+=head2 C<get_xxx_reference()>
+
+get the reference to xxx, which is a key of the message.
+For example,
+C<get_content_reference()>
+returns the reference to the content of the message.
+
+=head2 C<set_log_function()>
+
+internal use. set CODE REFERENCE to the log function
+
+=cut
+
+# set log function pointer (CODE REFERNCE)
+sub set_log_function
+{
+    my ($self, $fp) = @_;
+    $self->{ _log_function } = $fp;
+}
+
+
+# XXX debug, remove this in the future
+sub get_content_type_list
+{
+    my ($msg) = @_;
+    my ($m, @buf, $i);
+
+    for ($i = 0, $m = $msg; defined $m ; $m = $m->{ 'next' }) {
+	$i++;
+	push(@buf, "type[$i]: $m->{'content_type'} | $m->{'base_content_type'}");
+    }
+    \@buf;
+}
+
+
+=head1 APPENDIX (RFC2046 Appendix A)
+
+Appendix A -- Collected Grammar
+
+   This appendix contains the complete BNF grammar for all the syntax
+   specified by this document.
+
+   By itself, however, this grammar is incomplete.  It refers by name to
+   several syntax rules that are defined by RFC 822.  Rather than
+   reproduce those definitions here, and risk unintentional differences
+   between the two, this document simply refers the reader to RFC 822
+   for the remaining definitions. Wherever a term is undefined, it
+   refers to the RFC 822 definition.
+
+     boundary := 0*69<bchars> bcharsnospace
+
+     bchars := bcharsnospace / " "
+
+     bcharsnospace := DIGIT / ALPHA / "'" / "(" / ")" /
+                      "+" / "_" / "," / "-" / "." /
+                      "/" / ":" / "=" / "?"
+
+     body-part := <"message" as defined in RFC 822, with all
+                   header fields optional, not starting with the
+                   specified dash-boundary, and with the
+                   delimiter not occurring anywhere in the
+                   body part.  Note that the semantics of a
+                   part differ from the semantics of a message,
+                   as described in the text.>
+
+     close-delimiter := delimiter "--"
+
+     dash-boundary := "--" boundary
+                      ; boundary taken from the value of
+                      ; boundary parameter of the
+                      ; Content-Type field.
+
+     delimiter := CRLF dash-boundary
+
+     discard-text := *(*text CRLF)
+                     ; May be ignored or discarded.
+
+     encapsulation := delimiter transport-padding
+                      CRLF body-part
+
+     epilogue := discard-text
+
+     multipart-body := [preamble CRLF]
+                       dash-boundary transport-padding CRLF
+                       body-part *encapsulation
+                       close-delimiter transport-padding
+                       [CRLF epilogue]
+
+     preamble := discard-text
+
+     transport-padding := *LWSP-char
+                          ; Composers MUST NOT generate
+                          ; non-zero length transport
+                          ; padding, but receivers MUST
+                          ; be able to handle padding
+                          ; added by message transports.
+
+=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
+
+Mail::Message appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+1;
diff --git a/fml/lib/Mail/delivery.ja.html b/fml/lib/Mail/delivery.ja.html
new file mode 100644
index 00000000..0715354b
--- /dev/null
+++ b/fml/lib/Mail/delivery.ja.html
@@ -0,0 +1,62 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+fml5 のメール配送システムについて
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+
+<CENTER>
+fml5 のメール配送システムについて
+</CENTER>
+
+<P>	fml4 と fml5 の相違点
+
+fml5 の最大の目的の一つは、メンバーリストの取得と操作の統合と抽象化です。
+配送には抽象化された Mail::Delivery クラスを次のように使います。
+
+<P> Mail::Delivery::* クラスの使い方について
+
+Mail::Delivery::* に属するクラスは SMTP および LMTP 配送へのインターフェ
+イスを提供します。
+
+<PRE>
+Mail::Delivery::SMTP の実例
+
+    use Mail::Delivery::SMTP;
+    my $service = new Mail::Delivery::SMTP;
+    if ($service->error) { Log($service->error); return;}
+
+    $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,
+                      });
+</PRE>
+
+ここで $header_object はヘッダで、FML::Header オブジェクトです。
+そして $body_oject   はメール本文で、Mail::Message オブジェクトです。
+
+
+<P> コンポーネント
+
+C<Delivery> は
+C<SMTP>
+C<ESMTP>
+C<LMTP>
+などへのインターフェイスです。
+
+
+<!-- =================================================================== -->
+</BODY>
+</HTML>
diff --git a/fml/lib/Mail/index.ja.html b/fml/lib/Mail/index.ja.html
new file mode 100644
index 00000000..5cd28e53
--- /dev/null
+++ b/fml/lib/Mail/index.ja.html
@@ -0,0 +1,38 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+Mail::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>Mail class modules</EM></CENTER>
+<HR>
+<A HREF="delivery.ja.html">
+fml5 のメール配送システムについて
+</A>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ <A HREF=Delivery/index.ja.html>Mail::Delivery::* class</A>
+<TR>
+<TD>
+ Delivery.pm <TD>
+<A HREF="Delivery.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Delivery.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
+ Message.pm <TD>
+<A HREF="Message.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Message.txt">[manual]</A>
+<TD>
+</TABLE>
+</BODY>
+</HTML>
diff --git a/fml/lib/Mail/pointer.ja.html b/fml/lib/Mail/pointer.ja.html
new file mode 100644
index 00000000..9b88d7f1
--- /dev/null
+++ b/fml/lib/Mail/pointer.ja.html
@@ -0,0 +1,3 @@
+<A HREF="delivery.ja.html">
+fml5 のメール配送システムについて
+</A>
-- 
cgit v1.2.1