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