example/sendmsg/send-msg.pl

# $Header: $
# $RCSfile: $ $Source$
use strict;
use vars qw($MYNAME $MYVERSION $VERSION);
$MYNAME = $0;
$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
$MYVERSION = qq{2.5.$VERSION};
use lib qw(/home/wakaba/temp/msg/);
use Message::Entity;
use Message::Field::Date;
use Message::MIME::Charset::Jcode 'Jcode.pm';
use Message::MIME::Charset::Jcode 'jcode.pl';
use Socket;
binmode STDOUT; $| = 1;  binmode STDERR;
my %server;
$server{smtp} ||= 'suika.fam.cx';
$server{nntp} ||= 'suika.fam.cx';
my $debug_msg_log = 0;

open LOG, '>> send.slog';  binmode LOG;
my $date = Message::Field::Date->new (zone => [+1, 9, 0]);
$date->unix_time (time);
pmsg ("\x0C",
      'User-Agent: '.$MYNAME.'/'.$VERSION,
      'Date: '.$date);

opendir DIR, '.';
  my @files = sort(grep(/^[^_][\x00-\xFF]*?\.822$/, readdir(DIR)));
close DIR;
if ($#files < 0) {
  pmsg("These are no files to send!"); close LOG; die;
}
$Send::SMTP::connected = 0;
$Send::NNTP::connected = 0;

my $crlf = "\x0D\x0A";


for my $file (@files) {
  pmsg('Open message file for sending: '.$file);
  my $m;
  {
    open M, $file or &error ($!);
      local $/ = undef;
      $m = <M>;
    close M;
  }
  $m =~ s/\x0D(?!\x0A)/\x0D\x0A/gs;
  $m =~ s/(?<!\x0D)\x0A/\x0D\x0A/gs;
  my $msg = Message::Entity->parse ($m , -parse_all => 1,
    -fill_date => 0, -fill_msgid => 0,
  );
  
  ## mail/post to...
  my $header = $msg->header;
  
    ## Envelope From, To
    my $eFrom = $msg->sender;
    my $resent = $header->field_exist ('resent-from');
    my @eTo = $msg->destination;
    my ($send_mail,$post_news) = (0, 0);
    unless ($resent) {
      $post_news = 1 if $header->field_exist ('newsgroups');
    }
    $send_mail = 1 if @eTo > 0;
    &error ('No envelope from') if $send_mail && !$eFrom;
    if ($eFrom && $header->field ('from')->item (0, -by => 'index')->display_name =~ /</) {
      my $buggy = 0;
      for (@eTo) {
        $buggy = 1 if /\@jp-[a-z]\.ne\.jp$/i;
      }
      $header->field ('from')->item (0, -by => 'index')->option (output_display_name => 0) if $buggy;
    }
    
    if ($send_mail && $post_news) {
      $header->replace ('Posted-And-Mailed' => 'yes');
    } elsif (!$send_mail && !$post_news) {
      &error('Not for mail nor news!');
    }
  
  my $a = '';
  $a = 'resent-' if ($resent);
  unless ($header->field_exist ($a.'message-id')) {
    my $msgid;
    if ($resent) {
      $msgid = $header->field ('resent-message-id', -prepend => 1);
    } else {
      $msgid = $header->field ('message-id');
    }
    $msgid->generate (addr_spec => $eFrom);
    pmsg ($a.'Message-id: '.$msgid);
  }
  
  unless ($header->field_exist ($a.'date')) {
    my $date;
    if ($resent) {
      $date = $header->field ('resent-date', -prepend => 1);
    } else {
      $date = $header->field ('date');
    }
    $date->unix_time ((stat ($file))[9]);
    pmsg($a.'Date: '.$date);
  }
  my $ua;
  if ($resent) {
    $ua = $header->add ('resent-user-agent' => '', -prepend => 1);
    $msg->option (fill_ua_name => 'resent-user-agent');
  } else {
    $ua = $header->field ('user-agent');
  }
  if ($Jcode::VERSION) {
    $ua->add ('Jcode.pm' => $Jcode::VERSION);
  }
  if ($jcode::rcsid) {
    $ua->add_rcs ($jcode::rcsid);
  }
  $ua->add_rcs (q$Date: 2002/07/27 04:44:25 $, name => $MYNAME, version => $MYVERSION, -prepend => 1);
  
  $header->delete (qw(date-received relay-version status x-envelope-from x-envelope-to xref));
  $header->option (field_sort => 'good-practice') unless $resent;
  
  my %sopt = (
    -fill_date  => 0,   -fill_msgid     => 0,
    -ua_field_name      => $a.'user-agent',
  );
  my ($msg_mail, $msg_news);
  if ($send_mail) {
    $msg_mail =  $msg->stringify (-format => 'mail-rfc2822', %sopt);
    $msg_mail =~ s/\x0D\x0A\./\x0D\x0A../gs;
    $msg_mail .= "\x0D\x0A.\x0D\x0A";
  }
  if ($post_news) {
    my %rename;
    for (qw(cc complaints-to injector-info received to x-complaints-to x-trace)) {
      $rename{$_} = 'original-'.$_;
    }
    for (qw(nntp-posting-date nntp-posting-host posting-version)) {
      $rename{$_} = 'x-'.$_;
    }
    $header->rename (%rename);
    $msg_news =  $msg->stringify (-format => 'news-usefor', %sopt);
    $msg_news =~ s/\x0D\x0A\./\x0D\x0A../gs;
    $msg_news .= "\x0D\x0A.\x0D\x0A";
  }
  
  Send::SMTP::Connect () if $send_mail && !$Send::SMTP::connected;
  if ($send_mail) {
    pmsg('send a mail message...');
    printS("MAIL FROM:<${eFrom}>\x0D\x0A");
      my $r = <SMTP>;
      error25($r) unless $r =~ /^250/;
      Send::Log::Server25($r);
    for my $rcptto (@eTo) {
      next unless $rcptto;
      printS("RCPT TO:<$rcptto>\x0D\x0A");
        my $r = <SMTP>;
        error25($r) unless $r =~ /^25/;
        Send::Log::Server25($r);
    }
    printS("DATA\x0D\x0A");
      my $r = <SMTP>;
      error25($r) unless $r =~ /^354/;
      Send::Log::Server25($r);
    print SMTP $msg_mail;
      cmsg25 ('(message)');
      cmsg25 ($msg_mail) if $debug_msg_log;
      my $r = <SMTP>;
      error25($r) unless $r =~ /^250/;
      Send::Log::Server25($r);
  }
  Send::NNTP::Connect() if $post_news && !$Send::NNTP::connected;
  if ($post_news) {
    pmsg('post a news article...');
    printN("POST\x0D\x0A");
      my $r = <NNTP>;
      error119($r) unless $r =~ /^340/;
      Send::Log::Server119($r);
    print NNTP $msg_news;
      cmsg119('(article)');
      cmsg119($msg_news) if $debug_msg_log;
      my $r = <NNTP>;
      error119($r) unless $r =~ /^240/;
      Send::Log::Server119($r);
  }
  
  my $t = time;
  pmsg("\$ mv \"$file\" \"sent/$t.822\"");
  pmsg(`mv "$file" "sent/$t.822"`);
}
    Send::SMTP::Close() if $Send::SMTP::connected;
    Send::NNTP::Close() if $Send::NNTP::connected;
    close LOG;

sub pmsg {
  print STDOUT "$0: ". join("\n$0: ",@_)."\n";
  print LOG join("\n",@_)."\n";
}

sub cmsg {pmsg('C: '.shift,@_)}
sub smsg {pmsg('S: '.shift,@_)}
sub cmsg25 {pmsg('C25: '.shift,@_)}
sub smsg25 {pmsg('S25: '.shift,@_)}
sub cmsg119 {pmsg('C119: '.shift,@_)}
sub smsg119 {pmsg('S119: '.shift,@_)}

  sub Send::SMTP::Close {
    printS("QUIT\x0D\x0A");
      my $r = <SMTP>;
      smsg25($r);
    close SMTP;
    $Send::SMTP::connected = 0;
  }
  sub Send::NNTP::Close {
    printN("QUIT\x0D\x0A");
      my $r = <NNTP>;
      smsg119($r);
    close NNTP;
    $Send::NNTP::connected = 0;
  }
    
    sub printS {
      print SMTP $_[0];
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      cmsg25($s);
    }
    sub printN {
      print NNTP $_[0];
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      cmsg119($s);
    }
    
    
    sub wm::smtp::addstatus {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      smsg($s);
    }
    sub Send::Log::Server25 {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      smsg25($s);
    }
    sub Send::Log::Server119 {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      smsg119($s);
    }
    
    sub error {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      pmsg($s);
      Send::SMTP::Close() if $Send::SMTP::connected;
      Send::NNTP::Close() if $Send::NNTP::connected;
      close LOG;
      use Carp;
      croak ($s);
    }
    sub error25 {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      smsg25($s);
      Send::SMTP::Close() if $Send::SMTP::connected;
      Send::NNTP::Close() if $Send::NNTP::connected;
      close LOG;
      die;
    }
    sub error119 {
      my $s = $_[0];
      $s =~ s/\x0D\x0A$//s;
      $s =~ s/\x0D\x0A/\x0D\x0A   /gs;
      smsg119($s);
      Send::SMTP::Close() if $Send::SMTP::connected;
      Send::NNTP::Close() if $Send::NNTP::connected;
      close LOG;
      die;
    }
    

sub Send::SMTP::Connect (;%) {
  my %o = @_;
  my $myname = $o{myname} || &Message::Util::get_host_fqdn || 'send.pl.'.$server{smtp};
  pmsg('connecting to '.$server{smtp}.':25...');
    socket (SMTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);
    my $aton = inet_aton($server{smtp});
    pmsg ('IPv4 address: ' . sprintf '%vd', $aton);
    connect(SMTP, sockaddr_in(25, $aton))
                   || error("Can't connect to $server{smtp}:25");
    select(SMTP), $| =1;  binmode SMTP;
      my $r = <SMTP>;
      error25($r) unless $r =~ /^220/;
      Send::Log::Server25($r);
    printS('HELO '.$myname."\x0D\x0A");
      my $r = <SMTP>;
      error25() unless $r =~ /^250/;
      Send::Log::Server25($r);
  $Send::SMTP::connected = 1;
}

sub Send::NNTP::Connect {
  pmsg('conecting to '.$server{nntp}.':119...');
    socket (NNTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);
    connect(NNTP, sockaddr_in(119, inet_aton($server{nntp})))
                   || error("Can't connect to $server{nntp}:119");
    select(NNTP), $| =1;   binmode NNTP;
      my $r = <NNTP>;
      error119($r) unless $r =~ /^200/;
      Send::Log::Server119($r);
    #printN('AUTHINFO USER foo'."\x0D\x0A");
    #  $r = <NNTP>;
    #  error119($r) unless $r =~ /^381/;
    #  Send::Log::Server119($r);
    #print NNTP ('AUTHINFO PASS bar'."\x0D\x0A");
    #  cmsg119('AUTHINFO PASS (password)');
    #  $r = <NNTP>;
    #  error119($r) unless $r =~ /^281/;
    #  Send::Log::Server119($r);
  $Send::NNTP::connected = 1;
}

END {
      Send::SMTP::Close() if $Send::SMTP::connected;
      Send::NNTP::Close() if $Send::NNTP::connected;
}

=head1 LICENSE

Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=head1 CHANGE

See F<ChangeLog>.
$Date: 2002/07/27 04:56:38 $

=cut

### send-msg.pl ends here
1	wakaba	1.4	# $Header: $
2			# $RCSfile: $ $Source$
3	wakaba	1.1	use strict;
4	wakaba	1.3	use vars qw($MYNAME $MYVERSION $VERSION);
5	wakaba	1.4	$MYNAME = $0;
6			$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
7	wakaba	1.3	$MYVERSION = qq{2.5.$VERSION};
8	wakaba	1.1	use lib qw(/home/wakaba/temp/msg/);
9			use Message::Entity;
10			use Message::Field::Date;
11			use Message::MIME::Charset::Jcode 'Jcode.pm';
12			use Message::MIME::Charset::Jcode 'jcode.pl';
13			use Socket;
14			binmode STDOUT; $\| = 1; binmode STDERR;
15			my %server;
16			$server{smtp} \|\|= 'suika.fam.cx';
17			$server{nntp} \|\|= 'suika.fam.cx';
18			my $debug_msg_log = 0;
19
20			open LOG, '>> send.slog'; binmode LOG;
21			my $date = Message::Field::Date->new (zone => [+1, 9, 0]);
22			$date->unix_time (time);
23			pmsg ("\x0C",
24			'User-Agent: '.$MYNAME.'/'.$VERSION,
25			'Date: '.$date);
26
27			opendir DIR, '.';
28			my @files = sort(grep(/^[^_][\x00-\xFF]*?\.822$/, readdir(DIR)));
29			close DIR;
30			if ($#files < 0) {
31			pmsg("These are no files to send!"); close LOG; die;
32			}
33			$Send::SMTP::connected = 0;
34			$Send::NNTP::connected = 0;
35
36			my $crlf = "\x0D\x0A";
37
38
39			for my $file (@files) {
40			pmsg('Open message file for sending: '.$file);
41			my $m;
42			{
43			open M, $file or &error ($!);
44			local $/ = undef;
45			$m = <M>;
46			close M;
47			}
48			$m =~ s/\x0D(?!\x0A)/\x0D\x0A/gs;
49			$m =~ s/(?<!\x0D)\x0A/\x0D\x0A/gs;
50			my $msg = Message::Entity->parse ($m , -parse_all => 1,
51			-fill_date => 0, -fill_msgid => 0,
52			);
53
54			## mail/post to...
55			my $header = $msg->header;
56
57			## Envelope From, To
58	wakaba	1.4	my $eFrom = $msg->sender;
59			my $resent = $header->field_exist ('resent-from');
60			my @eTo = $msg->destination;
61	wakaba	1.1	my ($send_mail,$post_news) = (0, 0);
62	wakaba	1.4	unless ($resent) {
63	wakaba	1.1	$post_news = 1 if $header->field_exist ('newsgroups');
64			}
65			$send_mail = 1 if @eTo > 0;
66			&error ('No envelope from') if $send_mail && !$eFrom;
67			if ($eFrom && $header->field ('from')->item (0, -by => 'index')->display_name =~ /</) {
68			my $buggy = 0;
69			for (@eTo) {
70			$buggy = 1 if /\@jp-[a-z]\.ne\.jp$/i;
71			}
72			$header->field ('from')->item (0, -by => 'index')->option (output_display_name => 0) if $buggy;
73			}
74
75			if ($send_mail && $post_news) {
76			$header->replace ('Posted-And-Mailed' => 'yes');
77			} elsif (!$send_mail && !$post_news) {
78			&error('Not for mail nor news!');
79			}
80
81			my $a = '';
82			$a = 'resent-' if ($resent);
83			unless ($header->field_exist ($a.'message-id')) {
84			my $msgid;
85			if ($resent) {
86			$msgid = $header->field ('resent-message-id', -prepend => 1);
87			} else {
88			$msgid = $header->field ('message-id');
89			}
90			$msgid->generate (addr_spec => $eFrom);
91			pmsg ($a.'Message-id: '.$msgid);
92			}
93
94			unless ($header->field_exist ($a.'date')) {
95			my $date;
96			if ($resent) {
97			$date = $header->field ('resent-date', -prepend => 1);
98			} else {
99			$date = $header->field ('date');
100			}
101			$date->unix_time ((stat ($file))[9]);
102			pmsg($a.'Date: '.$date);
103			}
104			my $ua;
105			if ($resent) {
106			$ua = $header->add ('resent-user-agent' => '', -prepend => 1);
107			$msg->option (fill_ua_name => 'resent-user-agent');
108			} else {
109			$ua = $header->field ('user-agent');
110			}
111			if ($Jcode::VERSION) {
112			$ua->add ('Jcode.pm' => $Jcode::VERSION);
113			}
114	wakaba	1.4	if ($jcode::rcsid) {
115			$ua->add_rcs ($jcode::rcsid);
116			}
117			$ua->add_rcs (q$Date: 2002/07/27 04:44:25 $, name => $MYNAME, version => $MYVERSION, -prepend => 1);
118	wakaba	1.1
119	wakaba	1.3	$header->delete (qw(date-received relay-version status x-envelope-from x-envelope-to xref));
120			$header->option (field_sort => 'good-practice') unless $resent;
121	wakaba	1.1
122			my %sopt = (
123			-fill_date => 0, -fill_msgid => 0,
124			-ua_field_name => $a.'user-agent',
125			);
126			my ($msg_mail, $msg_news);
127			if ($send_mail) {
128			$msg_mail = $msg->stringify (-format => 'mail-rfc2822', %sopt);
129			$msg_mail =~ s/\x0D\x0A\./\x0D\x0A../gs;
130			$msg_mail .= "\x0D\x0A.\x0D\x0A";
131			}
132			if ($post_news) {
133			my %rename;
134	wakaba	1.4	for (qw(cc complaints-to injector-info received to x-complaints-to x-trace)) {
135			$rename{$_} = 'original-'.$_;
136			}
137			for (qw(nntp-posting-date nntp-posting-host posting-version)) {
138	wakaba	1.1	$rename{$_} = 'x-'.$_;
139			}
140			$header->rename (%rename);
141			$msg_news = $msg->stringify (-format => 'news-usefor', %sopt);
142			$msg_news =~ s/\x0D\x0A\./\x0D\x0A../gs;
143			$msg_news .= "\x0D\x0A.\x0D\x0A";
144			}
145
146			Send::SMTP::Connect () if $send_mail && !$Send::SMTP::connected;
147			if ($send_mail) {
148			pmsg('send a mail message...');
149			printS("MAIL FROM:<${eFrom}>\x0D\x0A");
150			my $r = <SMTP>;
151			error25($r) unless $r =~ /^250/;
152			Send::Log::Server25($r);
153			for my $rcptto (@eTo) {
154			next unless $rcptto;
155			printS("RCPT TO:<$rcptto>\x0D\x0A");
156			my $r = <SMTP>;
157			error25($r) unless $r =~ /^25/;
158			Send::Log::Server25($r);
159			}
160			printS("DATA\x0D\x0A");
161			my $r = <SMTP>;
162			error25($r) unless $r =~ /^354/;
163			Send::Log::Server25($r);
164			print SMTP $msg_mail;
165			cmsg25 ('(message)');
166			cmsg25 ($msg_mail) if $debug_msg_log;
167			my $r = <SMTP>;
168			error25($r) unless $r =~ /^250/;
169			Send::Log::Server25($r);
170			}
171			Send::NNTP::Connect() if $post_news && !$Send::NNTP::connected;
172			if ($post_news) {
173			pmsg('post a news article...');
174			printN("POST\x0D\x0A");
175			my $r = <NNTP>;
176			error119($r) unless $r =~ /^340/;
177			Send::Log::Server119($r);
178			print NNTP $msg_news;
179			cmsg119('(article)');
180			cmsg119($msg_news) if $debug_msg_log;
181			my $r = <NNTP>;
182			error119($r) unless $r =~ /^240/;
183			Send::Log::Server119($r);
184			}
185
186			my $t = time;
187			pmsg("\$ mv \"$file\" \"sent/$t.822\"");
188			pmsg(`mv "$file" "sent/$t.822"`);
189			}
190			Send::SMTP::Close() if $Send::SMTP::connected;
191			Send::NNTP::Close() if $Send::NNTP::connected;
192			close LOG;
193
194			sub pmsg {
195			print STDOUT "$0: ". join("\n$0: ",@_)."\n";
196			print LOG join("\n",@_)."\n";
197			}
198
199			sub cmsg {pmsg('C: '.shift,@_)}
200			sub smsg {pmsg('S: '.shift,@_)}
201			sub cmsg25 {pmsg('C25: '.shift,@_)}
202			sub smsg25 {pmsg('S25: '.shift,@_)}
203			sub cmsg119 {pmsg('C119: '.shift,@_)}
204			sub smsg119 {pmsg('S119: '.shift,@_)}
205
206			sub Send::SMTP::Close {
207			printS("QUIT\x0D\x0A");
208			my $r = <SMTP>;
209			smsg25($r);
210			close SMTP;
211			$Send::SMTP::connected = 0;
212			}
213			sub Send::NNTP::Close {
214			printN("QUIT\x0D\x0A");
215			my $r = <NNTP>;
216			smsg119($r);
217			close NNTP;
218			$Send::NNTP::connected = 0;
219			}
220
221			sub printS {
222			print SMTP $_[0];
223			my $s = $_[0];
224			$s =~ s/\x0D\x0A$//s;
225			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
226			cmsg25($s);
227			}
228			sub printN {
229			print NNTP $_[0];
230			my $s = $_[0];
231			$s =~ s/\x0D\x0A$//s;
232			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
233			cmsg119($s);
234			}
235
236
237			sub wm::smtp::addstatus {
238			my $s = $_[0];
239			$s =~ s/\x0D\x0A$//s;
240			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
241			smsg($s);
242			}
243			sub Send::Log::Server25 {
244			my $s = $_[0];
245			$s =~ s/\x0D\x0A$//s;
246			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
247			smsg25($s);
248			}
249			sub Send::Log::Server119 {
250			my $s = $_[0];
251			$s =~ s/\x0D\x0A$//s;
252			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
253			smsg119($s);
254			}
255
256			sub error {
257			my $s = $_[0];
258			$s =~ s/\x0D\x0A$//s;
259			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
260			pmsg($s);
261			Send::SMTP::Close() if $Send::SMTP::connected;
262			Send::NNTP::Close() if $Send::NNTP::connected;
263			close LOG;
264			use Carp;
265			croak ($s);
266			}
267			sub error25 {
268			my $s = $_[0];
269			$s =~ s/\x0D\x0A$//s;
270			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
271			smsg25($s);
272			Send::SMTP::Close() if $Send::SMTP::connected;
273			Send::NNTP::Close() if $Send::NNTP::connected;
274			close LOG;
275			die;
276			}
277			sub error119 {
278			my $s = $_[0];
279			$s =~ s/\x0D\x0A$//s;
280			$s =~ s/\x0D\x0A/\x0D\x0A /gs;
281			smsg119($s);
282			Send::SMTP::Close() if $Send::SMTP::connected;
283			Send::NNTP::Close() if $Send::NNTP::connected;
284			close LOG;
285			die;
286			}
287
288
289			sub Send::SMTP::Connect (;%) {
290			my %o = @_;
291	wakaba	1.2	my $myname = $o{myname} \|\| &Message::Util::get_host_fqdn \|\| 'send.pl.'.$server{smtp};
292	wakaba	1.1	pmsg('connecting to '.$server{smtp}.':25...');
293			socket (SMTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);
294			my $aton = inet_aton($server{smtp});
295			pmsg ('IPv4 address: ' . sprintf '%vd', $aton);
296			connect(SMTP, sockaddr_in(25, $aton))
297			\|\| error("Can't connect to $server{smtp}:25");
298			select(SMTP), $\| =1; binmode SMTP;
299			my $r = <SMTP>;
300			error25($r) unless $r =~ /^220/;
301			Send::Log::Server25($r);
302			printS('HELO '.$myname."\x0D\x0A");
303			my $r = <SMTP>;
304			error25() unless $r =~ /^250/;
305			Send::Log::Server25($r);
306			$Send::SMTP::connected = 1;
307			}
308
309			sub Send::NNTP::Connect {
310			pmsg('conecting to '.$server{nntp}.':119...');
311			socket (NNTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);
312			connect(NNTP, sockaddr_in(119, inet_aton($server{nntp})))
313			\|\| error("Can't connect to $server{nntp}:119");
314			select(NNTP), $\| =1; binmode NNTP;
315			my $r = <NNTP>;
316			error119($r) unless $r =~ /^200/;
317			Send::Log::Server119($r);
318			#printN('AUTHINFO USER foo'."\x0D\x0A");
319			# $r = <NNTP>;
320			# error119($r) unless $r =~ /^381/;
321			# Send::Log::Server119($r);
322			#print NNTP ('AUTHINFO PASS bar'."\x0D\x0A");
323			# cmsg119('AUTHINFO PASS (password)');
324			# $r = <NNTP>;
325			# error119($r) unless $r =~ /^281/;
326			# Send::Log::Server119($r);
327			$Send::NNTP::connected = 1;
328			}
329
330			END {
331			Send::SMTP::Close() if $Send::SMTP::connected;
332			Send::NNTP::Close() if $Send::NNTP::connected;
333			}
334
335			=head1 LICENSE
336
337			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
338
339			This program is free software; you can redistribute it and/or modify
340			it under the terms of the GNU General Public License as published by
341			the Free Software Foundation; either version 2 of the License, or
342			(at your option) any later version.
343
344			This program is distributed in the hope that it will be useful,
345			but WITHOUT ANY WARRANTY; without even the implied warranty of
346			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
347			GNU General Public License for more details.
348
349			You should have received a copy of the GNU General Public License
350			along with this program; see the file COPYING. If not, write to
351			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
352			Boston, MA 02111-1307, USA.
353
354			=head1 CHANGE
355
356			See F<ChangeLog>.
357	wakaba	1.4	$Date: 2002/07/27 04:56:38 $
358	wakaba	1.1
359			=cut
360
361			### send-msg.pl ends here