summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfukachan <fukachan>2001-04-03 09:45:39 +0000
committerfukachan <fukachan>2001-04-03 09:45:39 +0000
commitb6af6fcbb57b2055ab25971a05bfa227a9071627 (patch)
tree869963af37702f9d5bf7c02ee59a35ff1c877839
parentcae9f2a10686f824349b9d85ba2e75b9b08b366d (diff)
downloadfml8-b6af6fcbb57b2055ab25971a05bfa227a9071627.tar.gz
fml8-b6af6fcbb57b2055ab25971a05bfa227a9071627.tar.bz2
fml8-b6af6fcbb57b2055ab25971a05bfa227a9071627.zip
change class hiererychy from MailingList -> Mail
Mail::Delivery is the entrance for all delivery systems. Mail::Message handles mail message/content, multipart operations et. al.
Diffstat
-rw-r--r--fml/lib/FML/Article.pm2
-rw-r--r--fml/lib/FML/Parse.pm8
-rw-r--r--fml/lib/FML/Process/Distribute.pm6
-rw-r--r--fml/lib/FML/Process/Kernel.pm2
-rw-r--r--fml/lib/FML/Process/index.ja.html3
-rw-r--r--fml/lib/FML/Process/pointer.ja.html2
-rw-r--r--fml/lib/FML/Ticket/Model/minimal_states.pm2
-rw-r--r--fml/lib/MailingList/.cvsignore1
-rw-r--r--fml/lib/MailingList/@template4
-rw-r--r--fml/lib/MailingList/Delivery.pm147
-rw-r--r--fml/lib/MailingList/ESMTP.pm59
-rw-r--r--fml/lib/MailingList/Makefile16
-rw-r--r--fml/lib/MailingList/Messages.pm1044
-rw-r--r--fml/lib/MailingList/Net/.cvsignore1
-rw-r--r--fml/lib/MailingList/Net/INET4.pm112
-rw-r--r--fml/lib/MailingList/Net/INET6.pm209
-rw-r--r--fml/lib/MailingList/Net/Makefile6
-rw-r--r--fml/lib/MailingList/Net/index.ja.html31
-rw-r--r--fml/lib/MailingList/SMTP.pm804
-rw-r--r--fml/lib/MailingList/Utils.pm338
-rw-r--r--fml/lib/MailingList/delivery.ja.html62
-rw-r--r--fml/lib/MailingList/index.ja.html59
-rw-r--r--fml/lib/MailingList/pointer.ja.html3
-rw-r--r--fml/lib/Makefile2
-rw-r--r--fml/lib/index.ja.html7
25 files changed, 20 insertions, 2910 deletions
diff --git a/fml/lib/FML/Article.pm b/fml/lib/FML/Article.pm
index 9c0ec1ee..f427be19 100644
--- a/fml/lib/FML/Article.pm
+++ b/fml/lib/FML/Article.pm
@@ -32,7 +32,7 @@ FML::Article - article manipulation components
$article object is just a container which holds
C<header> and C<body> object as hash keys.
The C<header> is an FML::Header object and
-the C<body> is a MailingList::Messages object.
+the C<body> is a Mail::Message object.
=head1 METHODS
diff --git a/fml/lib/FML/Parse.pm b/fml/lib/FML/Parse.pm
index 68757829..117767e5 100644
--- a/fml/lib/FML/Parse.pm
+++ b/fml/lib/FML/Parse.pm
@@ -14,7 +14,7 @@ use vars qw($InComingMessage);
use strict;
use Carp;
use FML::Header;
-use MailingList::Messages;
+use Mail::Message;
use FML::Config;
use FML::Log qw(Log LogWarn LogError);
@@ -37,7 +37,7 @@ C<new()> returns a set of hash references.
C<$r_header> is the reference to a header object, which is
C<Mail::Header> object.
C<$r_body> is reference to the scalar mail body variable, which is
-C<MailingList::Messages> object.
+C<Mail::Message> object.
=head1 METHODS
@@ -104,7 +104,7 @@ sub _parse
# extract each field from the header array
my $r_header = new FML::Header \@h, Modify => 0;
- my $r_body = new MailingList::Messages {
+ my $r_body = new Mail::Message {
boundary => $r_header->mime_boundary(),
content_type => $r_header->content_type(),
content => \$InComingMessage,
@@ -119,7 +119,7 @@ sub _parse
L<Mail::Header>,
L<FML::Header>,
-L<MailingList::Messages>,
+L<Mail::Message>,
L<FML::Config>,
L<FML::Log>
diff --git a/fml/lib/FML/Process/Distribute.pm b/fml/lib/FML/Process/Distribute.pm
index 2b3cbc7f..684d4ee6 100644
--- a/fml/lib/FML/Process/Distribute.pm
+++ b/fml/lib/FML/Process/Distribute.pm
@@ -251,7 +251,7 @@ sub _deliver_article
my ($curproc, $args) = @_;
my $config = $curproc->{ config }; # FML::Config obj
- my $body = $curproc->{ article }->{ body }; # MailingList::Messages obj
+ my $body = $curproc->{ article }->{ body }; # Mail::Message obj
my $header = $curproc->{ article }->{ header };# FML::Header obj
unless ( $config->yes( 'use_article_delivery' ) ) {
@@ -265,7 +265,7 @@ sub _deliver_article
}
# distribute article
- use MailingList::Delivery;
+ use Mail::Delivery;
my $fp = sub { Log(@_);}; # pointer to the log function
my $sfp = sub { my ($s) = @_; print $s; print "\n" if $s !~ /\n$/o;};
@@ -287,7 +287,7 @@ sub _deliver_article
}
}
- my $service = new MailingList::Delivery {
+ my $service = new Mail::Delivery {
log_function => $fp,
smtp_log_function => $sfp,
};
diff --git a/fml/lib/FML/Process/Kernel.pm b/fml/lib/FML/Process/Kernel.pm
index 83a03eaa..6f554733 100644
--- a/fml/lib/FML/Process/Kernel.pm
+++ b/fml/lib/FML/Process/Kernel.pm
@@ -394,7 +394,7 @@ and
$curproc->{'incoming_message'}->{ body }
.
The C<header> is C<FML::Header> object.
-The C<body> is C<MailingList::Messages> object.
+The C<body> is C<Mail::Message> object.
=cut
diff --git a/fml/lib/FML/Process/index.ja.html b/fml/lib/FML/Process/index.ja.html
index 593c18b8..81702c7e 100644
--- a/fml/lib/FML/Process/index.ja.html
+++ b/fml/lib/FML/Process/index.ja.html
@@ -11,7 +11,8 @@ FML/Process::* classes
<BODY BGCOLOR="#E6E6FA">
<CENTER><EM>FML::Process class modules</EM></CENTER>
<HR>
-<A HREF="programs.ja.html">各モジュールと対応するプログラム</A><HR>
+<A HREF="programs.ja.html">各モジュールと対応するプログラム</A>
+<HR>
<TABLE>
<TR>
<TD>
diff --git a/fml/lib/FML/Process/pointer.ja.html b/fml/lib/FML/Process/pointer.ja.html
index 9883287d..a4aea5b1 100644
--- a/fml/lib/FML/Process/pointer.ja.html
+++ b/fml/lib/FML/Process/pointer.ja.html
@@ -1 +1 @@
-<A HREF="programs.ja.html">各モジュールと対応するプログラム</A> \ No newline at end of file
+<A HREF="programs.ja.html">各モジュールと対応するプログラム</A>
diff --git a/fml/lib/FML/Ticket/Model/minimal_states.pm b/fml/lib/FML/Ticket/Model/minimal_states.pm
index 88c2fedd..4b5f6a86 100644
--- a/fml/lib/FML/Ticket/Model/minimal_states.pm
+++ b/fml/lib/FML/Ticket/Model/minimal_states.pm
@@ -183,7 +183,7 @@ sub update_status
my $content = '';
my $message = $body->get_first_plaintext_message();
- if ( ref($message) eq 'MailingList::Messages' ) {
+ if ( ref($message) eq 'Mail::Message' ) {
$content = $message->get_content_body();
}
else {
diff --git a/fml/lib/MailingList/.cvsignore b/fml/lib/MailingList/.cvsignore
deleted file mode 100644
index b643ba41..00000000
--- a/fml/lib/MailingList/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-@@doc
diff --git a/fml/lib/MailingList/@template b/fml/lib/MailingList/@template
deleted file mode 100644
index 81d97312..00000000
--- a/fml/lib/MailingList/@template
+++ /dev/null
@@ -1,4 +0,0 @@
-# Descriptions:
-# Arguments: $self $args
-# Side Effects:
-# Return Value: none
diff --git a/fml/lib/MailingList/Delivery.pm b/fml/lib/MailingList/Delivery.pm
deleted file mode 100644
index 88afbc67..00000000
--- a/fml/lib/MailingList/Delivery.pm
+++ /dev/null
@@ -1,147 +0,0 @@
-#-*- 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::Delivery;
-
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK);
-use Carp;
-use IO::Socket;
-
-
-=head1 NAME
-
-MailingList::Delivery - mail delivery system interface
-
-=head1 SYNOPSIS
-
- use MailingList::Delivery;
- my $service = new MailingList::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<MailingList::SMTP> class.
-Please see it for more details.
-
-=head1 DESCRIPTION
-
-In C<MailingList> 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 = 'MailingList::SMTP';
-
- # char's of the protocol name is aligned to upper case.
- $protocol =~ tr/a-z/A-Z/;
-
- if ($protocol eq 'SMTP') {
- $pkg = 'MailingList::SMTP';
- }
- elsif ($protocol eq 'ESMTP') {
- $pkg = 'MailingList::EMTP';
- }
- elsif ($protocol eq 'LMTP') {
- $pkg = 'MailingList::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
-
-MailingList::Delivery appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-
-1;
diff --git a/fml/lib/MailingList/ESMTP.pm b/fml/lib/MailingList/ESMTP.pm
deleted file mode 100644
index fb9019f8..00000000
--- a/fml/lib/MailingList/ESMTP.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-#-*- 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::ESMTP;
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
-use Carp;
-use MailingList::SMTP;
-
-require Exporter;
-@ISA = qw(MailingList::SMTP Exporter);
-
-sub new
-{
- my ($self) = @_;
- $self->SUPER::new(@_);
-}
-
-
-=head1 NAME
-
-MailingList::ESMTP - Extended SMTP class
-
-=head1 SYNOPSIS
-
- use MailingList::ESMTP;
- $service = new MailingList::ESMTP;
- $service->deliver( ... );
-
-See L<MailingList::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
-
-MailingList::ESMTP appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-1;
diff --git a/fml/lib/MailingList/Makefile b/fml/lib/MailingList/Makefile
deleted file mode 100644
index 67ad8d35..00000000
--- a/fml/lib/MailingList/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-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/MailingList/Messages.pm b/fml/lib/MailingList/Messages.pm
deleted file mode 100644
index 0fe60af9..00000000
--- a/fml/lib/MailingList/Messages.pm
+++ /dev/null
@@ -1,1044 +0,0 @@
-#-*- 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 $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
-
-MailingList::Messages -- message manipulator
-
-=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.
-
-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 MailingList::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 MailingList::Messages 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 MailingList::Messages {
- 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 MailingList::Messages {
- 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
-
-MailingList::Messages appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-1;
diff --git a/fml/lib/MailingList/Net/.cvsignore b/fml/lib/MailingList/Net/.cvsignore
deleted file mode 100644
index b643ba41..00000000
--- a/fml/lib/MailingList/Net/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-@@doc
diff --git a/fml/lib/MailingList/Net/INET4.pm b/fml/lib/MailingList/Net/INET4.pm
deleted file mode 100644
index f2ebfe78..00000000
--- a/fml/lib/MailingList/Net/INET4.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-#-*- 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::Net::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_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
-
-MailingList::Net::INET4 - establish tcp connection over IPv4
-
-=head1 SYNOPSIS
-
- use MailingList::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<MailingList::SMTP>,
-L<Socket>,
-L<IO::Socket>,
-L<MailingList::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
-
-MailingList::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/MailingList/Net/INET6.pm b/fml/lib/MailingList/Net/INET6.pm
deleted file mode 100644
index f0717075..00000000
--- a/fml/lib/MailingList/Net/INET6.pm
+++ /dev/null
@@ -1,209 +0,0 @@
-#-*- 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::Net::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
-
-MailingList::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<MailingList::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<MailingList::SMTP>,
-L<Socket6>,
-L<Socket>,
-L<IO::Handle>,
-L<IO::Socket>,
-L<MailingList::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
-
-MailingList::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/MailingList/Net/Makefile b/fml/lib/MailingList/Net/Makefile
deleted file mode 100644
index 795737fa..00000000
--- a/fml/lib/MailingList/Net/Makefile
+++ /dev/null
@@ -1,6 +0,0 @@
-all: html
-
-html: index.ja.html
-
-index.ja.html: *pm
- ../../../../doc/bin/dir2url.pl > index.ja.html
diff --git a/fml/lib/MailingList/Net/index.ja.html b/fml/lib/MailingList/Net/index.ja.html
deleted file mode 100644
index 07fd0456..00000000
--- a/fml/lib/MailingList/Net/index.ja.html
+++ /dev/null
@@ -1,31 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
-<HTML>
-<HEAD>
-<TITLE>
-MailingList/Net::* classes
-</TITLE>
-<META http-equiv="Content-Type"
- content="text/html; charset=EUC-JP">
-</HEAD>
-
-<BODY BGCOLOR="#E6E6FA">
-<CENTER><EM>MailingList::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/MailingList/SMTP.pm b/fml/lib/MailingList/SMTP.pm
deleted file mode 100644
index ea5ac4ef..00000000
--- a/fml/lib/MailingList/SMTP.pm
+++ /dev/null
@@ -1,804 +0,0 @@
-#-*- 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::Net::INET4;
-use MailingList::Net::INET6;
-
-require Exporter;
-@ISA = qw(Exporter);
-
-
-BEGIN {}
-END {}
-
-
-=head1 NAME
-
-MailingList::SMTP - 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,
- 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<MailingList::Net::INET4> and
-C<MailingList::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: 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.
- # _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 MailingList::Messages 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<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->{ 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 "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>,
-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
-
-MailingList::SMTP appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-1;
diff --git a/fml/lib/MailingList/Utils.pm b/fml/lib/MailingList/Utils.pm
deleted file mode 100644
index 82bcf39f..00000000
--- a/fml/lib/MailingList/Utils.pm
+++ /dev/null
@@ -1,338 +0,0 @@
-#-*- 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;
-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
-
-MailingList::utils - utiliti programs for mail delivery
-
-=head1 SYNOPSIS
-
-For example,
-
- use MailingList::utils;
- Log( $message_to_log );
-
-=head1 DESCRIPTION
-
-several utility functions for C<MailingList> 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<MailingList::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<MailingList::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
-
-MailingList::utils appeared in fml5 mailing list driver package.
-See C<http://www.fml.org/> for more details.
-
-=cut
-
-1;
diff --git a/fml/lib/MailingList/delivery.ja.html b/fml/lib/MailingList/delivery.ja.html
deleted file mode 100644
index 5b0ccd94..00000000
--- a/fml/lib/MailingList/delivery.ja.html
+++ /dev/null
@@ -1,62 +0,0 @@
-<!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 の最大の目的の一つは、メンバーリストの取得と操作の統合と抽象化です。
-配送には抽象化された MailingList クラスを次のように使います。
-
-<P> MailingList::* クラスの使い方について
-
-MailingList::* に属するクラスは SMTP および LMTP 配送へのインターフェ
-イスを提供します。
-
-<PRE>
-MailingList::SMTP の実例
-
- use MailingList::SMTP;
- my $service = new MailingList::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 はメール本文で、MailingList::Messages オブジェクトです。
-
-
-<P> コンポーネント
-
-C<Delivery> は
-C<SMTP>
-C<ESMTP>
-C<LMTP>
-などへのインターフェイスです。
-
-
-<!-- =================================================================== -->
-</BODY>
-</HTML>
diff --git a/fml/lib/MailingList/index.ja.html b/fml/lib/MailingList/index.ja.html
deleted file mode 100644
index c7c3d053..00000000
--- a/fml/lib/MailingList/index.ja.html
+++ /dev/null
@@ -1,59 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
-<HTML>
-<HEAD>
-<TITLE>
-MailingList::* classes
-</TITLE>
-<META http-equiv="Content-Type"
- content="text/html; charset=EUC-JP">
-</HEAD>
-
-<BODY BGCOLOR="#E6E6FA">
-<CENTER><EM>MailingList class modules</EM></CENTER>
-<HR>
-<A HREF="delivery.ja.html">
-fml5 のメール配送システムについて
-</A>
-<HR>
-<TABLE>
-<TR>
-<TD>
- Delivery.pm <TD>
-<A HREF="Delivery.pm">[source]</A>
-<TD>
-<A HREF="@@doc/Delivery.txt">[manual]</A>
-<TD>
-<TR>
-<TD>
- ESMTP.pm <TD>
-<A HREF="ESMTP.pm">[source]</A>
-<TD>
-<A HREF="@@doc/ESMTP.txt">[manual]</A>
-<TD>
-<TR>
-<TD>
- Messages.pm <TD>
-<A HREF="Messages.pm">[source]</A>
-<TD>
-<A HREF="@@doc/Messages.txt">[manual]</A>
-<TD>
-<TR>
-<TD>
- <A HREF=Net/index.ja.html>MailingList::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/MailingList/pointer.ja.html b/fml/lib/MailingList/pointer.ja.html
deleted file mode 100644
index 9b88d7f1..00000000
--- a/fml/lib/MailingList/pointer.ja.html
+++ /dev/null
@@ -1,3 +0,0 @@
-<A HREF="delivery.ja.html">
-fml5 のメール配送システムについて
-</A>
diff --git a/fml/lib/Makefile b/fml/lib/Makefile
index 9eed9557..b8818f7e 100644
--- a/fml/lib/Makefile
+++ b/fml/lib/Makefile
@@ -10,7 +10,7 @@ _subdir: [A-Z]*
(cd FML; make html)
(cd File; make html)
(cd IO; make html)
- (cd MailingList; make html)
+ (cd Mail; make html)
(cd Tie; make html)
(cd SQL; make html)
(cd ErrorMessages; make html)
diff --git a/fml/lib/index.ja.html b/fml/lib/index.ja.html
index 809efef3..d543bb99 100644
--- a/fml/lib/index.ja.html
+++ b/fml/lib/index.ja.html
@@ -29,7 +29,10 @@
<A HREF=Language/index.ja.html>Language::*</A>
<TR>
<TD>
- <A HREF=MailingList/index.ja.html>MailingList::*</A>
+ <A HREF=Mail/index.ja.html>Mail::*</A>
+<TR>
+<TD>
+MailingList/
<TR>
<TD>
<A HREF=SQL/index.ja.html>SQL::*</A>
@@ -46,3 +49,5 @@
</TABLE>
</BODY>
</HTML>
+*** warning ***
+Error: *** fail to convert MailingList ***
generated by cgit v1.2.1 (git 2.18.0) at 2026-09-17 02:21:15 +0000