#!/usr/bin/perl
# SSL for Net::POP3
package Net::POP3::SSL;
use strict;
use vars qw[@ISA];
use IO::Socket::SSL;
use Net::POP3;
@ISA = ( 'IO::Socket::SSL', grep { $_ ne 'IO::Socket::INET' } @Net::POP3::ISA );
no strict 'refs';
foreach ( keys %Net::POP3:: ) {
next unless defined *{$Net::POP3::{$_}}{CODE};
*{$_} = \&{"Net::POP3::$_"};
}
# Fetch And Send Mail
package main;
use strict;
use File::Path;
use File::Spec;
use File::Copy;
use LockFile::Simple;
use Net::POP3;
use Net::SMTP;
use Sys::Hostname;
use Tie::DNS;
use Date::Format;
use Text::Wrap;
use ClamAV::Client;
use Mail::SpamAssassin;
use Email::Address;
use Email::MessageID;
use Mail::Header;
use Mail::Field::Received;
use MIME::Lite;
use Sys::Syslog;
my $debug = 0;
my $dbglog = 0;
my $dbgproto = 0;
my $version = time2str('%Y%m%d.%H%M%S',(stat($0))[9]);
$version .= ' debug' if ($debug);
my $name = $0;
$name =~ s/^.*[\/\\]//;
$name =~ s/\.pl$//;
my $locker = LockFile::Simple->make(-autoclean=>1,-hold=>48*60*60,-stale=>1,-warn=>0);
my %dns; tie(%dns,'Tie::DNS');
openlog('fetchandsend','pid,nowait','mail');
$dbglog = 1 if ($debug);
my %boxes = ();
my %config = ();
sub oneline {
my $l =~ join('; ',@_);
$l =~ s/[\r\n]+/; /gs;
$l =~ s/(; )+/; /;
$l =~ s/^; //;
$l =~ s/; $//;
return $l;
}
sub logmsg {
my $msg = shift @_;
return unless ($msg);
syslog("info",$msg,@_);
print sprintf("$msg\n",@_) if ($dbglog);
}
sub read_conf_f {
my $file = shift;
my $ince = shift;
$ince = 0 unless ($ince);
return 0 unless ($file);
my $rf = 0;
my @cl = ();
if (open(F,'<',$file)) {
logmsg('Reading config: %s',$file) if ($dbglog);
$rf = 1;
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
next if ($l =~ /^[;:#]/);
push @cl, $l;
}
close(F);
my $cs = '';
foreach my $l (@cl) {
$l =~ s/[\r\n]+//gs;
next if ($l =~ /^[;:#]/);
if ($l =~ /^\s*\@\s*(.*?\S.*?)\s*$/) {
unless (read_conf($1,$ince)) {
die("Bad Config: $1") if ($ince);
logmsg('Bad config: %s',$1);
%boxes = ();
%config = ();
return 0;
}
} elsif ($l =~ /^\s*\[\s*(.*)?\s*\]\s*$/) {
$cs = $1;
} elsif ($l =~ /^\s*(\S+)[\s:=]+(.*?)\s*$/) {
my $c = lc($1);
$c =~ s/[-_]+//g;
my $v = $2;
if (lc($c) eq 'spamassassincf') {
$c .= '_';
if ($v =~ /^([^\s\&]\S*):(.*)$/) {
$c = sprintf('%s%s_',$c,$1);
$v = $2;
}
my $n = 0;
if ($cs) {
while ($boxes{$cs}{"$c$n"}) { $n++; }
} else {
while ($config{"$c$n"}) { $n++; }
}
$c = "$c$n";
}
if ($cs) {
$boxes{$cs}{$c} = $v;
} else {
$config{$c} = $v;
}
}
}
return 1;
}
return 0;
}
sub read_conf {
my $files = shift;
my $ince = shift;
$files = '' unless ($files);
$ince = 0 unless ($ince);
unless ($files) {
my $d = $0;
$d =~ s/[\\\/][^\\\/]*$//;
foreach my $dir ('.',$d,'/etc','/usr/local/etc') {
for my $ext ('conf','cf','cfg') {
if (-f "$dir/$name.$ext") {
$files = "$dir/$name.conf";
last;
}
}
last if ($files);
}
}
return 0 unless ($files);
return read_conf_f($files,$ince) unless ($files =~ /[?*]/);
my $r = 0;
foreach my $file (glob($files)) {
$r = read_conf_f($file,$ince);
last unless ($r);
}
return $r;
}
sub config_config {
$config{spooldir} = '/var/spool/FetchAndSendMail' unless ($config{spooldir});
$config{spooldir} = File::Spec->rel2abs($config{spooldir});
$config{expire} = 7 unless ($config{expire});
$config{useclamav} = 1 unless (defined($config{useclamav}));
$config{clamavsocket} = '/var/run/clamav/clamd' unless ($config{clamavsocket});
$config{hostname} = hostname() unless ($config{hostname});
$config{spamlimit} = 5 unless ($config{spamlimit});
$config{hostname} = hostname() unless ($config{hostname});
$config{hello} = $config{hostname} unless ($config{hello});
$config{postmaster} = sprintf('%s@%s','postmaster',$config{hostname}) unless ($config{postmaster});
foreach my $box (keys %boxes) {
$boxes{$box}{authmethod} = 'auto' unless ($boxes{$box}{authmethod});
$boxes{$box}{spamlimit} = $config{spamlimit} unless ($boxes{$box}{spamlimit});
$boxes{$box}{protocol} = 'pop3' unless ($boxes{$box}{protocol});
$boxes{$box}{protocol} = '' unless ($boxes{$box}{protocol});
$boxes{$box}{server} = $boxes{$box}{protocol} if (!$boxes{$box}{server} && $boxes{$box}{protocol} =~ /^(hotmail|gmail|yahoo)$/);
$boxes{$box}{spooldir} = sprintf('%s/%s',$config{spooldir},$box);
$boxes{$box}{spooldir} = File::Spec->rel2abs($boxes{$box}{spooldir});
}
return unless ($debug);
return;
while (my ($c,$v) = each %config) {
print "config $c = $v\n";
}
while (my ($b,$i) = each %boxes) {
while (my ($c,$v) = each %$i) {
print "box '$b' $c = $v\n";
}
}
}
sub print_config {
foreach my $cfg (sort keys %config) {
print sprintf("%-30s%s\n",$cfg,$config{$cfg});
}
foreach my $box (sort keys %boxes) {
print "\n$box\n";
foreach my $cfg (sort keys %{$boxes{$box}}) {
print sprintf("\t%-30s%s\n",$cfg,$boxes{$box}{$cfg});
}
}
}
sub assure_dir {
my $dir = shift;
unless (-d $dir) {
eval { mkpath($dir) };
if ($@) {
logmsg('Error creating spool dir: %s',$dir);
return 0;
}
}
return 1 if (-d $dir);
return 0;
}
sub make_dsn {
my $dir = shift;
my $msg = shift;
my $rsn = shift;
my $num = shift;
my $box = $dir;
$box =~ s/^.*[\/\\]//;
my $id = $msg;
$id =~ s/\.(msg|dsn)$//i;
$id =~ s/\@.*$//i;
logmsg('Creating DSN for "%s": %s',$box,$id);
if ($msg =~ /\.dsn$/i) {
eval { copy("$dir/$msg",sprintf('%s/%s.%s',$config{spooldir},$box,$msg)); };
return 0;
}
return 0 unless (open(BF,'<',"$dir/$msg"));
my $hdr = '';
while (my $l = <BF>) {
$l =~ s/[\r\n]+//gs;
last if ($l eq '');
$hdr .= "$l\n";
}
close(BF);
my $xtr = (stat("$dir/$msg"))[7];
my $txt = "The message with the following headers could not be delivered to the final recipient.\n$rsn\n\n$hdr";
my $enc = '7bit';
$enc = '8bit' if ($txt =~ /[\x7F-\xFF]/);
my $eml = MIME::Lite->new(
Subject => 'Delivery Status Notification',
From => Email::Address->new('FetchAndSendMail',$config{postmaster})->format,
To => Email::Address->new('Postmaster',$config{postmaster})->format,
Type => 'text/plain',
'Message-ID' => Email::MessageID->new()->format,
'X-MTA' => "$name $version",
Encoding => $enc,
Data => $txt,
);
my $bfn = '';
my $gfn = 0;
my $fnt = 0;
while (!$gfn && $fnt < 10000) {
$fnt ++;
$id = sprintf('t%010Xn%08Xp%04Xs%08Xr%04X',time(),$num,$$,$xtr,rand(65534));
$bfn = sprintf('%s/%s@%s.dsn',$dir,$id,$config{postmaster});
if (-e $bfn) {
sleep(1) unless ($fnt % 100);
} else {
$gfn = 1;
}
}
$gfn = 0 if ($gfn && !open(BF,'>',$bfn));
unless ($gfn) {
logmsg('Error creating dsn file: %s',$dir);
return (0);
}
print BF $eml->as_string;
close(BF);
return 1;
}
sub clean_dir {
my $w = shift;
my $c = 0;
my $age = $config{expire} * 24*60*60;
foreach my $dir (@_) {
my $box = $dir;
$box =~ s/^.*[\\\/]//;
next unless (opendir(DD,$dir));
my @df = ();
while (my $f = readdir(DD)) {
next if ($f =~ /^\./);
next unless (-f "$dir/$f");
if ($w =~ /r/i) {
push @df, $f if ($f =~ /\.(rcv|rin)$/i);
}
if ($w =~ /s/i) {
if ($f =~ /^t([a-f0-9]+)[g-z].*\.(msg|dsn)$/i) {
my $mcr = hex($1);
my $min = time() - $age;
if ($mcr < $min) {
my $id = $f;
$id =~ s/\.(msg|dsn)$//i;
if ($id =~ /^(.*?)\@(.*)$/i) {
#$snd = $2;
$id = $1;
}
logmsg('%s: expired;%s;%f',$id,$box,$mcr/(24*60*60));
make_dsn($dir,$f,'The message has expired.',$#df+2);
push @df, $f unless ($debug);
}
}
}
}
closedir(DD);
foreach my $f (@df) {
$c ++ if (unlink("$dir/$f"));
}
}
return $c;
}
my $clamav;
sub check_message_clamav {
return 1 unless ($config{useclamav});
my $box = shift;
my $id = shift;
my $tfn = shift;
my $hdr = shift;
logmsg('Checking with ClamAV: %s:%s',$box,$id) if ($dbglog);
$clamav = ClamAV::Client->new(socket_name=>$config{clamavsocket}) unless ($clamav);
if ($clamav) {
my ($fn,$vr) = $clamav->scan_path($tfn);
if ($vr) {
logmsg('%s: virus;%s;%s',$id,$box,$vr);
return 0;
}
unshift @{$hdr}, sprintf("X-Virus-Scanned-By: %s, using %s\n",$config{hostname},$clamav->version);
}
return 1;
}
sub spamassassin_cf {
my $eml = shift;
my $prc = shift;
my $cfg = shift;
my $trl = shift;
$prc .= '_' if ($prc);
my $scf = '';
$scf = spamassassin_cf($eml,'',$cfg,$trl) if ($prc);
foreach my $c (sort keys %{$cfg}) {
if ($c =~ /^spamassassincf_$prc\d+$/) {
my $v = $cfg->{$c};
if ($v =~ /^\s*\&\s*(.*?)\s*$/) {
my $x = $1;
if ($x =~ /^trust_?received[\s:=]+(\d+)$/) {
my $cr = $1;
next unless ($x);
my $h = Mail::Header->new($eml);
next unless ($h);
my @r = Mail::Field->extract('Received',$h);
next unless (@r);
my $rc = 0;
while ($rc < $cr && (my $r = shift @r)) {
$rc ++;
my %i = %{$r->parse_tree()};
next unless (defined($i{from}{address}) && $i{from}{address});
$scf .= sprintf("trusted_networks %s\n",$i{from}{address});
push @$trl, $i{from}{address} if ($trl);
}
}
} else {
$v =~ s/\|/\n/gs;
$scf .= "$v\n";
}
}
}
return $scf;
}
my $spamassassin;
sub check_message_spamassassin {
my $box = shift;
my $id = shift;
my $tfn = shift;
my $hdr = shift;
return 1 unless ($boxes{$box}{spamlimit});
return 1 unless ($boxes{$box}{spamlimit} =~ /^\d+(\.\d+)?$/);
return 1 unless (-s $tfn < 250*1024);
return 1 unless (open(F,'<',$tfn));
my @eml = <F>;
close(F);
logmsg('Checking with SpamAssassin: %s:%s',$box,$id) if ($dbglog);
unless ($spamassassin) {
my @trl = ();
my $cf = spamassassin_cf(\@eml,$boxes{$box}{protocol},\%config,\@trl);
$cf .= spamassassin_cf(\@eml,$boxes{$box}{protocol},$boxes{$box},\@trl);
unshift @{$hdr}, sprintf("X-Trusted-Relays: %s\n",join(', ',@trl)) if (@trl);
if ($cf) {
my $cff = sprintf('%s/%s',$boxes{$box}{spooldir},'spamassassin.cf');
unless (open(CF,'>',$cff)) {
logmsg('Error creating spamassassin.cf for "%s"',$box);
return 1;
}
print CF $cf;
close(CF);
$spamassassin = Mail::SpamAssassin->new({local_tests_only=>0,dont_copy_prefs=>1,userprefs_filename=>$cff});
} else {
$spamassassin = Mail::SpamAssassin->new({local_tests_only=>0,dont_copy_prefs=>1});
}
}
return 1 unless ($spamassassin);
my $msg = $spamassassin->parse(\@eml);
return 1 unless ($msg);
my $sst = $spamassassin->check($msg);
unless ($sst) {
$msg->finish;
return 1;
}
my $hits = $sst->get_score();
my $snm = $sst->get_names_of_tests_hit();
if ($hits > $boxes{$box}{spamlimit}) {
logmsg('%s: spam;%s;%s;%s',$id,$box,$hits,$snm);
$sst->finish;
$msg->finish;
return 0;
}
my $lrn = '';
if (defined($spamassassin->{auto_learn_status})) {
if ($spamassassin->{auto_learn_status}) {
$lrn = ', learned as spam';
} else {
$lrn = ', learned as ham';
}
}
my $ver = 'SpamAssassin '.Mail::SpamAssassin->Version();
unshift @{$hdr}, sprintf("X-Spam-Scanned-By: %s, using SpamAssassin %s (hard limit %s%s)\n",$config{hostname},Mail::SpamAssassin->Version(),$boxes{$box}{spamlimit},$lrn);
my $nmh = '';
if ($snm && length($snm) > 54) {
my $twco = $Text::Wrap::columns;
my $twbo = $Text::Wrap::break;
my $twho = $Text::Wrap::huge;
my $twso = $Text::Wrap::separator;
$Text::Wrap::columns = 74;
$Text::Wrap::break = ',';
$Text::Wrap::huge = 'overflow';
$Text::Wrap::separator = ",\n";
my $nht = wrap("\t","\t",$snm);
$nht = "\t$nht" if ($nht !~ /^\t/);
$nmh = ";\n$nht";
$Text::Wrap::columns = $twco;
$Text::Wrap::break = $twbo;
$Text::Wrap::huge = $twho;
$Text::Wrap::separator = $twso;
} elsif ($snm) {
$nmh = "; $snm";
}
$nmh =~ s/[\r\n]+$//;
unshift @{$hdr}, sprintf("X-Spam-Info: %s%s\n",$hits,$nmh);
if ($hits > 0) {
my($score);
if ($hits < 40) {
$score = "*" x int($hits);
} else {
$score = "*" x 40;
}
unshift @{$hdr}, sprintf("X-Spam-Score: %s (%s)\n",$hits,$score);
}
$sst->finish;
$msg->finish;
return 1;
}
sub check_message {
my $box = shift;
my $id = shift;
my $tfn = shift;
my @hdr = ();
$tfn .= '.rcv';
return 0 unless (check_message_clamav($box,$id,$tfn,\@hdr));
return 0 unless (check_message_spamassassin($box,$id,$tfn,\@hdr));
return (1,\@hdr);
}
sub open_temp_file {
my $box = shift;
my $num = shift;
my $xtr = shift;
my $dir = $boxes{$box}{spooldir};
my $snd = $boxes{$box}{sendto};
my $id;
my $tfn;
my $mfn;
my $gfn = 0;
my $fnt = 0;
while (!$gfn && $fnt < 10000) {
$fnt ++;
$id = sprintf('t%Xn%Xp%Xs%Xr%Xc%X',time(),$num,$$,$xtr,rand(65534),$fnt);
$tfn = sprintf('%s/%s',$dir,$id);
$mfn = $tfn;
$mfn .= sprintf('@%s',$snd) if ($snd);
$mfn .= '.msg';
if (-e $mfn || -e "$tfn.rcv" || -e "$tfn.rin") {
sleep(1) unless ($fnt % 100);
} else {
$gfn = 1;
}
}
my $fh;
$gfn = 0 if ($gfn && !open($fh,'>',"$tfn.rcv"));
unless ($gfn) {
logmsg('Error creating tempfile: %s',$dir);
return (0);
}
return ($fh,$id,$tfn,$mfn);
}
sub insert_file {
my $box = shift;
my $id = shift;
my $tfn = shift;
my $mfn = shift;
my $proto = shift;
my $fst = time();
my ($ok,$hdr) = check_message($box,$id,$tfn);
return (1,0) unless ($ok);
logmsg('Inserting: %s:%s',$box,$id) if ($dbglog);
return (0,0) unless (open(FR,'<',"$tfn.rcv"));
unless (open(FT,'>',"$tfn.rin")) {
close(FR);
return (0,0);
}
my $from = $boxes{$box}{server};
if ($from =~ /\./) {
my $dr = $dns{$from};
if ($dr) {
my $xf = "[$dr]";
$dr = $dns{$dr};
$xf = "$dr $xf" if ($dr);
$from = "$from ($xf)";
}
}
$proto = '' unless ($proto);
$proto = " $proto" if ($proto);
print FT sprintf("X-FetchAndSendMail: %s %s %s\n",$config{hostname},$box,time2str('%Y-%m-%d %H:%M:%S',$fst));
print FT @{$hdr} if ($hdr && @{$hdr});
print FT sprintf("Received: from %s\n\tby %s (%s %s)\n\twith$proto id %s;\n\t%s\n",$from,$config{hostname},$name,$version,$id,time2str('%a, %d %b %Y %T %z',time()));
my $ih = 1;
while (my $l = <FR>) {
$l =~ s/[\r\n]+//gs;
if ($ih) {
if ($l eq '') {
$ih = 0;
} elsif ($l =~ /^X-Spam-Score[:\s]/i) {
$l = "X-$l";
}
}
print FT "$l\n";
}
close(FT);
close(FR);
$ok = rename("$tfn.rin",$mfn);
logmsg('Error inserting message: %s',$mfn) unless ($ok);
return ($ok,$ok);
}
sub clean_file {
my $tfn = shift;
return if ($debug);
unlink("$tfn.rcv") if (-f "$tfn.rcv");
unlink("$tfn.rin") if (-f "$tfn.rin");
}
sub fetch_mails_pop3 {
my $box = shift;
logmsg('Connecting with POP3: %s',$box) if ($dbglog);
my $pop;
if ($boxes{$box}{protocol} =~ /ssl/i) {
Net::POP3::SSL->debug(1) if ($dbgproto);
$boxes{$box}{server} .= ':995' unless ($boxes{$box}{server} =~ /:/);
$boxes{$box}{authmethod} = 'login,apop,sasl' if (lc($boxes{$box}{authmethod}) eq 'auto');
$pop = Net::POP3::SSL->new($boxes{$box}{server});
} else {
Net::POP3->debug(1) if ($dbgproto);
$boxes{$box}{authmethod} = 'sasl,apop,login' if (lc($boxes{$box}{authmethod}) eq 'auto');
$pop = Net::POP3->new($boxes{$box}{server});
}
unless ($pop) {
logmsg('Error connecting to POP3 server for "%s": %s',$box,$boxes{$box}{server});
return 0;
}
$pop->debug(1) if ($dbgproto);
logmsg('Authenticating: %s',$box) if ($dbglog);
my $auth = 0;
foreach my $authm (split(/\s*,\s*/,$boxes{$box}{authmethod})) {
logmsg('Authenticating: %s %s',$box,$authm) if ($dbglog);
$auth = $pop->auth($boxes{$box}{username},$boxes{$box}{password}) if (!$auth && $authm =~ /^(auth|sasl|auto)$/i);
$auth = $pop->apop($boxes{$box}{username},$boxes{$box}{password}) if (!$auth && $authm =~ /^(apop|auto)$/i);
$auth = $pop->login($boxes{$box}{username},$boxes{$box}{password}) if (!$auth && $authm =~ /^(login|auto)$/i);
last if ($auth);
}
unless ($auth) {
logmsg('Error authenticating for POP3 box "%s": %s',$box,$boxes{$box}{authmethod});
return 0;
}
my %done = ();
if (open(F,'<',sprintf('%s/%s',$boxes{$box}{spooldir},'uidls'))) {
while (my $l = <F>) {
next unless ($l =~ /^(\d+)\s+(.*?)\s*$/);
$done{$2} = $1 ? $1 : 0E0;
}
close(F);
}
logmsg('Listing: %s',$box) if ($dbglog);
my $c = 0;
my $dc = 0;
my $msgs = $pop->list();
my $uidl = $pop->uidl();
foreach my $num (sort { $a <=> $b } keys %{$msgs}) {
next if ($uidl && $uidl->{$num} && $done{$uidl->{$num}});
my $siz = $msgs->{$num};
my ($fh,$id,$tfn,$mfn) = open_temp_file($box,$num,$siz);
last unless ($fh);
logmsg('Fetching: %s:%u,%s',$box,$num,$id) if ($dbglog);
my $got = $pop->get($num,$fh);
close($fh);
logmsg('Error retrieving message from "%s": %u, %s',$box,$num,oneline($pop->message)) unless ($got);
my $rem = 1;
if ($got) {
my ($del,$ins) = insert_file($box,$id,$tfn,$mfn,'POP3');
#logmsg('%u, %u',$del,$ins);
if ($del && !$debug) {
$rem = $pop->delete($num);
logmsg('Error deleting message from "%s": %u %s',$box,$num,oneline($pop->message)) unless ($rem);
}
if ($ins) {
if ($uidl && $uidl->{$num}) {
$done{$uidl->{$num}} = $num;
$dc ++;
}
logmsg('%s: retrieved;%s;%s;%u;%u',$id,$box,$boxes{$box}{server},$num,$siz);
}
$c ++;
}
clean_file($tfn);
last unless ($rem);
}
$pop->quit();
if ($dc && open(F,'>',sprintf('%s/%s',$boxes{$box}{spooldir},'uidls'))) {
while (my ($uid,$num) = each %done) {
print F sprintf("%u %s\n",$num,$uid);
}
close(F);
}
return $c;
}
sub fetch_mails {
push @_, keys %boxes unless (@_);
while (my $bl = shift @_) {
foreach my $box (split(/\s*,\s*/,$bl)) {
next if ($boxes{$box}{ignore});
unless ($box && $boxes{$box}{server} && $boxes{$box}{username} && $boxes{$box}{password}) {
logmsg('Unknown or incomplete box specified: %s',$box);
next;
}
next unless (assure_dir($boxes{$box}{spooldir}));
my $fp = fork();
if ($fp) {
waitpid($fp,0);
} elsif (defined($fp)) {
exit(1) unless ($locker->trylock(sprintf('%s/%s',$boxes{$box}{spooldir},'fetch')));
clean_dir('r',$boxes{$box}{spooldir});
if ($boxes{$box}{protocol} =~ /pop3?/i) {
fetch_mails_pop3($box);
} else {
logmsg('Unknown protocol for box "%s": %s',$box,$boxes{$box}{protocol});
}
if ($spamassassin) {
$spamassassin->finish;
$spamassassin = undef;
}
$locker->unlock(sprintf('%s/%s',$boxes{$box}{spooldir},'fetch'));
exit(0);
} else {
die("Fork?");
}
}
}
}
my $smtp;
sub send_mail_smtp {
my $dir = shift;
my $msg = shift;
my $snd = shift;
my $frm = shift;
my $eml = shift;
my $num = shift;
my $r = 2;
unless ($smtp) {
Net::SMTP::debug(1) if ($dbgproto);
$smtp = Net::SMTP->new($config{server},Hello=>$config{hello});
unless ($smtp) {
logmsg('Error connecting to SMTP: %s',$config{server});
return 0;
}
$r = $smtp->status();
$smtp->debug(1) if ($dbgproto);
}
close(F);
my $nr = 0;
if ($r == 2) {
$smtp->mail($frm);
$r = $smtp->status();
}
if ($r == 2) {
$nr ++;
$smtp->recipient($snd);
$r = $smtp->status();
}
if ($r == 2) {
$nr ++;
$smtp->data();
$r = $smtp->status();
}
if ($r == 3) {
$nr = 0;
$smtp->datasend($eml);
$smtp->dataend();
$r = $smtp->status();
}
my $ans = sprintf('%s %s',$smtp->code,$smtp->message);
$ans =~ s/[\r\n]+$//;
$ans =~ s/[\r\n]+/; /g;
make_dsn($dir,$msg,sprintf("SMTP server %s said: %s",$config{server},$ans),$num) unless ($r == 2 || $r == 4);
unlink("$dir/$msg") unless ($debug || $r == 4);
unless ($r == 2) {
logmsg('SMTP server %s said: %s',$config{server},$ans);
$smtp->quit;
$smtp = undef;
return 0;
}
return 1;
}
sub send_mails_in_dir {
my $dir = shift;
my $box = shift;
return 0 unless (opendir(D,$dir));
my $cnt = 0;
my $mc = 0;
my @msgs = ();
while (my $f = readdir(D)) {
push @msgs, $f if ($f =~ /\.(msg|dsn)$/i);
}
closedir(D);
foreach my $msg (sort { $a cmp $b } @msgs) {
my $snd = $boxes{$box}{sendto};
my $id = $msg;
$id =~ s/\.(msg|dsn)$//i;
if ($id =~ /^(.*?)\@(.*)$/i) {
$snd = $2;
$id = $1;
}
unless ($snd) {
logmsg('Unknown recipient in box "%s": %s',$box,$msg);
next;
}
unless (open(F,'<',"$dir/$msg")) {
logmsg('Error reading message in box "%s": %s',$box,$msg);
next;
}
my @eml = ();
my $bdy = 0;
my $frm;
$frm = $boxes{$box}{sender} if (defined($boxes{$box}{sender}));
unless (defined($frm)) {
$frm = '';
while (my $l = <F>) {
push @eml, $l;
next if ($bdy);
if ($l =~ /^[\r\n]*$/) {
$bdy = 1;
} elsif (!$frm && $l =~ /^Return-Path:\s(.+)$/) {
$frm = $1;
}
}
}
close(F);
next unless (@eml);
$frm =~ s/^.*?<//;
$frm =~ s/>.*$//;
$mc ++;
if (send_mail_smtp($dir,$msg,$snd,$frm,\@eml,$mc)) {
$cnt ++;
logmsg('%s: delivered;%s;%s;%s',$id,$box,$frm,$snd);
}
}
return $cnt;
}
sub send_mails {
unless (@_) {
if (opendir(D,$config{spooldir})) {
while (my $f = readdir(D)) {
next if ($f =~ /^\./);
push @_, $f if (-d sprintf('%s/%s',$config{spooldir},$f));
}
closedir(D);
}
}
while (my $bl = shift @_) {
foreach my $box (split(/\s*,\s*/,$bl)) {
next if ($boxes{$box}{ignore});
my $dir = sprintf('%s/%s',$config{spooldir},$box);
next unless (-d $dir);
next unless ($locker->trylock(sprintf('%s/%s',$dir,'send')));
clean_dir('s',$dir);
send_mails_in_dir($dir,$box);
$locker->unlock(sprintf('%s/%s',$dir,'send'));
}
}
}
read_conf();
config_config();
print_config if ($dbglog);
foreach my $p (@ARGV) {
$p =~ s/^[-_]+//;
if ($p =~ /^\@(.*)$/) {
logmsg('Reset config') if ($dbglog);
%boxes = ();
%config = ();
die("Bad Config: $1") unless read_conf($1,1);
config_config();
} elsif ($p =~ /^s(end)?[\s:=]+(.*)$/i) {
send_mails($2);
} elsif ($p =~ /^f(etch)?[\s:=]+(.*)$/i) {
fetch_mails($2);
} elsif ($p =~ /^sleep[\s:=]+(\d+)\s*$/i) {
sleep($1);
} elsif ($p =~ /^s(end)?$/i) {
send_mails();
} elsif ($p =~ /^f(etch)?$/i) {
fetch_mails();
} elsif ($p =~ /^sleep$/i) {
sleep(5);
} elsif ($p =~ /^debug$/i) {
$debug = 1;
} elsif ($p =~ /^debug-?log$/i) {
$dbglog = 1;
} elsif ($p =~ /^debug-?proto(cols?)?$/i) {
$dbgproto = 1;
} else {
die("$p?");
}
}
$smtp->quit if ($smtp);
waitpid(-1,0);
(2008-01-11)