Не самый отпимальный вариант - я торопился.
#!/usr/bin/perl -w
require 5.004;
use strict;
use Mail::Header;
use Mail::Address;
# use MIME::QuotedPrint;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use MIME::Words qw(:all);
#-------------------------------------------------------------------
my $REF_HOST = "lybrand.securities.com.ru"; # prefix before message ref number
my $DVD_NEWSGROUP = "cityline.dvd";
my $MAX_NAME = 50;
my $MAX_MAIL = 40;
my $MAX_SUBJ = 50;
my $MAX_PASS = 40;
my $POST_CGI = 'http://www.rusdvdportal.com/cgi-bin/board.cgi?post';
#my $POST_CGI = 'http://localhost/cgi-bin/board.cgi?post';
#--------------------------------------------------------------------
my @koi2cp_t = (
128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,
144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,
160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,
176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,
254,224,225,246,228,229,244,227,245,232,233,234,235,236,237,238,
239,255,240,241,242,243,230,226,252,251,231,248,253,249,247,250,
222,192,193,214,196,197,212,195,213,200,201,202,203,204,205,206,
207,223,208,209,210,211,198,194,220,219,199,216,221,217,215,218
);
sub koi2cp {
my $ch = shift;
return substr($ch,0,1) if ord($ch) < 128;
return chr($koi2cp_t[ord($ch)-128]);
}
sub koi2cp_str {
my $s = shift;
my $r = "";
while (length $s > 0) {
$r .= koi2cp($s);
$s = substr($s, 1);
}
return $r;
}
my $head = new Mail::Header \*STDIN;
# Parse for proper newsgroup first (just agains wrong inn config)
$head->combine('Newsgroups', ',');
my @newsgroups = split(/,/, $head->get('Newsgroups'));
if ($#newsgroups < 0) {
printf STDERR "No newsgroup in header\n";
exit 65; # EX_DATAERR
}
my $group;
my $group_found = 0;
foreach $group ( @newsgroups ) {
chomp $group;
if ($group eq $DVD_NEWSGROUP) {
$group_found = 1;
last;
}
}
unless ($group_found) {
print STDERR "Message doesn't belong to $DVD_NEWSGROUP\n";
exit 78; # EX_CONFIG
}
#print "Valid newsgroup found\n";
# Extract ref number if present
$head->combine('References', ',');
my $ref = -1; # watermark
if ($#newsgroups >= 0) {
my @addrs = Mail::Address->parse($head->get('References'));
my $addr;
foreach $addr ( @addrs ) {
my $extracted_ref = $addr->user();
$ref = $extracted_ref
if $addr->host eq $REF_HOST and $ref < $extracted_ref;
}
}
# get user and address
unless (defined $head->get('From')) {
print STDERR "Missing From header\n";
exit 65;
}
my ($user, $email, @addrs);
@addrs = Mail::Address->parse($head->get('From'));
unless ($#addrs >= 0)
{
print STDERR "Ill-formed from field\n";
exit 65;
}
my $addr = $addrs[0];
$user = decode_mimewords($addr->name());
$user = "Ill-formed user name" unless $user;
$user = substr($user, 0, $MAX_NAME);
$email = substr($addr->address(), 0, $MAX_MAIL);
# Possible reply-to support should be here
#if (defined $head->get('Reply-To')) {
#...
#}
# Password is just user address + magic str for now
my $pass = substr("PASS_tilsxc_$email", 0, $MAX_PASS);
# subject
my $subject = $head->get('Subject');
chomp $subject;
$subject = decode_mimewords($subject);
$subject = 'Ill-formed subject' unless($subject);
$subject = substr($subject, 0, $MAX_SUBJ);
my $body;
while (<>) {
$body .= $_;
}
$user = koi2cp_str($user);
$email = koi2cp_str($email);
$subject = koi2cp_str($subject);
$pass = koi2cp_str($pass);
$body = koi2cp_str($body);
#$pass = '123'; # for testing
#print "Answer to post #$ref\n" if $ref >= 0;
#print "Name: $user\nEmail: $email\n";
#print "Subject: $subject\n";
#print "Password: $pass\n------------------------\n\n";
# When the fun begins
my $ua = new LWP::UserAgent;
#$ua->agent("NNTP_HTTP_Gateway/0.1 " . $ua->agent);
$ua->agent('Mozilla/4.7 [en] (X11; I; Linux 2.2.15pre4 i686)');
$ua->from('nikkic@cityline.ru');
$ua->timeout(120);
# Create a request
my $http_req;
if ($ref >= 0) {
$http_req = POST $POST_CGI,
Content => [ followup => $ref, name => $user, email => $email,
subject => $subject, body => $body, password => $pass,
Post => "Post+Message" ];
} else {
$http_req = POST $POST_CGI,
Content => [ name => $user, email => $email,
subject => $subject, body => $body, password => $pass,
Post => "Post+Message" ];
}
my $res = $ua->request($http_req);
if ($res->is_success) {
exit 0;
} else {
print STDERR $res->as_string;
exit 75;
}
