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;

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} || &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;
}

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/26 06:25:30 $

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