example/sendmsg/send-msg.pl

use strict;
use vars qw($MYNAME $VERSION);
$MYNAME = 'send.pl'; $VERSION = '2.4';
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;

my $myhostname = 'send-msg';

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 = $header->field ('x-envelope-from')->addr_spec;
    my $resent = $header->field ('resent-from')->addr_spec;
    if ($resent) {
      $eFrom ||= $resent;
    } else {
      $eFrom ||= $header->field ('from')->addr_spec;
    }
    my @eTo = $header->field ('x-envelope-to')->addr_spec;
    my ($send_mail,$post_news) = (0, 0);
    if ($resent) {
      @eTo =($header->field ('resent-to')->addr_spec,
             $header->field ('resent-cc')->addr_spec,
             $header->field ('resent-bcc')->addr_spec) if $#eTo < 0;
    } else {
      @eTo =($header->field ('to')->addr_spec,
             $header->field ('cc')->addr_spec,
             $header->field ('bcc')->addr_spec) if $#eTo < 0;
      $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);
  }
  #my $jv=do{my @r=($jcode::rcsid=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
  $ua->add ('jcode.pl' => ['',$jcode::rcsid]);
  $ua->add ($MYNAME => $VERSION);
  
  $header->delete (qw(bcc date-received relay-version resent-bcc status x-envelope-from x-envelope-to xref));
  
  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/\x0D\x0A/gs;
    $msg_mail =~ s/\x0D\x0A\./\x0D\x0A../gs;
    #$msg_mail =~ s/^(?:\x0D\x0A)+//;
    #$msg_mail =~ s/(?:\x0D\x0A)*$/\x0D\x0A/;
    $msg_mail .= "\x0D\x0A.\x0D\x0A";
  }
  if ($post_news) {
    my %rename;
    for (qw(cc complaints-to nntp-posting-date injector-info nntp-posting-host posting-version received to x-complaints-to x-trace)) {
      $rename{$_} = 'x-'.$_;
    }
    $header->rename (%rename);
    $msg_news =  $msg->stringify (-format => 'news-usefor', %sopt);
    #$msg_news =~ s/\x0D\x0A|\x0D|\x0A/\x0D\x0A/gs;
    $msg_news =~ s/\x0D\x0A\./\x0D\x0A../gs;
    #$msg_news =~ s/^(?:\x0D\x0A)+//;
    #$msg_news =~ s/(?:\x0D\x0A)*$/\x0D\x0A/;
    $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} || '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;
}

sub __fw2hw ($) {
  my $s = shift;
  jcode::tr(\$s, "\xa3\xb0-\xa3\xb9\xa3\xc1-\xa3\xda\xa3\xe1-\xa3\xfa\xa1\xf5".
                 "\xa1\xa4\xa1\xa5\xa1\xa7\xa1\xa8\xa1\xa9\xa1\xaa\xa1\xae".
                 "\xa1\xb0\xa1\xb2\xa1\xbf\xa1\xc3\xa1\xca\xa1\xcb\xa1\xce".
                 "\xa1\xcf\xa1\xd0\xa1\xd1\xa1\xdc\xa1\xf0\xa1\xf3\xa1\xf4".
                 "\xa1\xf6\xa1\xf7\xa1\xe1\xa2\xaf\xa2\xb0\xa2\xb2\xa2\xb1".
                 "\xa1\xe4\xa1\xe3\xA1\xC0\xA1\xA1" =>
            '0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=\'"~-><\\ ');
  $s;
}

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/20 08:42:56 $

=cut

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