#!/usr/bin/perl
#***********************************************************************
#
# mdf-mail-reporter
#
# mimedefang-filter spam/ham report handler
#
# $Id: mdf-mail-reporter.pl,v 1.32 2009/04/22 16:31:46 jonas Exp $
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
#***********************************************************************
use strict;
use Socket;
use MIME::Parser;
use MIME::Entity;
use Email::Address;
use Email::Received;
use Email::MessageID;
use Mail::Field;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Client;
use Mail::SpamAssassin::Util::RegistrarBoundaries;
use LockFile::Simple;
use Date::Parse;
use Sys::Syslog;
use Digest::MD5;
use Digest::SHA;
use DBI;
use YAML::XS;
use Regexp::Common qw(net URI);
use URI::Find::Schemeless;
use HTML::Tree;
use Net::DNS;
use CGI;
use CGI::Pretty;
use CSS::Tiny;
use Date::Format;
my $debug = 0;
my $debugprint = 0;
my $debugnoage = 0;
my $stdlog = 0;
my $learnage = 30*24*60*60;
my $forwardage = 3*24*60*60;
my $parseage = 3*24*60*60;
my $maxage = 0; foreach my $cage (($learnage,$forwardage,$parseage)) { $maxage = $cage if ($cage > $maxage); }
my $postconf = '';
my $noreport = 0;
my $nosend = 0;
my $nochange = 0;
my $noparse = 0;
my $nosave = 0;
my $nospam = 0;
my $noham = 0;
my $spamd = '';
my $mailto = '';
#***********************************************************************
# Code...
#***********************************************************************
openlog("mdfrep","pid","mail");
my $locker = LockFile::Simple->make(-autoclean=>1,-hold=>24*60*60,-stale=>1);
sub log_msg {
syslog('notice',@_);
return unless ($debug || $stdlog);
my $msg = shift @_;
print sprintf("$msg\n",@_);
}
sub file_id {
my $fn = shift;
my $ft = shift;
$ft = '' unless ($ft);
$fn =~ s/^.*\///;
$fn =~ s/$ft$//;
return $fn;
}
# Read file into array
sub read_a_file {
my ($fn,$match,$noclean) = @_;
my @l = ();
if ($fn && (-f $fn) && (open(CF,'<',$fn))) {
while (my $l = <CF>) {
unless ($noclean) {
next if ($l =~ /^[;#]/);
next if ($l =~ /^[\s\r\n]*$/s);
next if ($match && $l !~ /^$match/i);
}
push @l, $l;
}
close(CF);
}
return \@l;
}
#***********************************************************************
# Config.
#***********************************************************************
my $FilterRevision = '$Revision: 1.32 $';
my $FilterUtilVers = '?';
if ('$Id: mdf-mail-reporter.pl,v 1.32 2009/04/22 16:31:46 jonas Exp $' =~ /^\S+?:\s(\S+?),v\s([.\d]+)\s/) { $FilterUtilVers = "$1 $2"; }
my %Features;
$Features{'Path:SPOOLDIR'} = '/var/spool/MIMEDefang';
# Add setting to config parser
my %cfgcfg = ();
$cfgcfg{'@i'}{i} = 0;
$cfgcfg{'@i'}{c} = 0;
sub add_cfg_cfg {
my ($c,$v,$d,$t,$f) = @_;
$d = '' unless (defined($d));
$t = 's' unless ($t);
$f = '' unless ($f);
$c =~ s/[-_]+//g;
$c = lc($c);
$$v = $d;
$cfgcfg{'@i'}{c} ++;
$cfgcfg{$c}{v} = $v;
$cfgcfg{$c}{t} = lc($t);
$cfgcfg{$c}{f} = lc($f);
$cfgcfg{$c}{i} = $cfgcfg{'@i'}{c};
$cfgcfg{$c}{x} = 0;
}
use vars qw($MyFilterHostName $MyFilterHostNames $AdminAddress $AdminContactAddress $OurDomains);
add_cfg_cfg('MyFilterHostName',\$MyFilterHostName,'host.domain.tld','s');
add_cfg_cfg('MyFilterHostNames',\$MyFilterHostNames,'','l','myfilterhostname');
add_cfg_cfg('AdminAddress',\$AdminAddress,'postmaster','a');
add_cfg_cfg('AdminContactAddress',\$AdminContactAddress,'','a');
add_cfg_cfg('OurDomains',\$OurDomains,'','l','myfilterhostnames');
use vars qw($SpamReportSpool $HamReportSpool $SpamTrapSpool $SASizeLimit $SpamReportForward $PurgeSpools $SpamReportSender);
add_cfg_cfg('SpamReportSpool',\$SpamReportSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('HamReportSpool',\$HamReportSpool,'/var/spool/ham-reports','p');
add_cfg_cfg('SpamTrapSpool',\$SpamTrapSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('SASizeLimit',\$SASizeLimit,200*1024,'i');
add_cfg_cfg('SpamReportForward',\$SpamReportForward,'','ms');
add_cfg_cfg('PurgeSpools',\$PurgeSpools,30*24*60*60,'i');
add_cfg_cfg('SpamReportSender',\$SpamReportSender,'','a');
use vars qw($SpamParseSpool $SpamParseURL);
add_cfg_cfg('SpamParseSpool',\$SpamParseSpool,'/var/spool/spam-parsed','p');
add_cfg_cfg('SpamParseURL',\$SpamParseURL,'','s');
use vars qw($database_spec $database_user $database_pass);
add_cfg_cfg('database_spec',\$database_spec,'dbi:SQLite:dbname=%s/filterdata.db','p');
add_cfg_cfg('database_user',\$database_user,'','s');
add_cfg_cfg('database_pass',\$database_pass,'','s');
use vars qw($sa_database_spec $sa_database_user $sa_database_pass);
add_cfg_cfg('sa_database_spec',\$sa_database_spec,'','p');
add_cfg_cfg('sa_database_user',\$sa_database_user,'','s');
add_cfg_cfg('sa_database_pass',\$sa_database_pass,'','s');
use vars qw($spamdsocket $spamdhost $spamdport);
add_cfg_cfg('SpamdSocket',\$spamdsocket,'','s');
add_cfg_cfg('SpamdHost',\$spamdhost,'','s');
add_cfg_cfg('SpamdPort',\$spamdport,0,'i');
use vars qw($sendmailconfdir $sm_domains);
add_cfg_cfg('SendmailConfig',\$sendmailconfdir,'/etc/mail','p');
add_cfg_cfg('SM_Domains',\$sm_domains,'local-host-names;mailertable;virtdomains','mpsm');
# Get a file path name
sub get_file_path_name {
my $f = shift;
return $f if ($f =~ /[\/\\]/);
foreach my $d (('/usr/local/etc/mimedefang/filter','/etc/mimedefang/filter',
'/usr/local/etc/mimedefang','/etc/mimedefang',
'/usr/local/etc/mail','/etc/mail', )) {
if ($d =~ /mimedefang/) {
return "$d/$f" if (-f "$d/$f");
return "$d/mimedefang-$f" if (-f "$d/mimedefang-$f");
} else {
return "$d/mimedefang-$f" if (-f "$d/mimedefang-$f");
return "$d/$f" if (-f "$d/$f");
}
}
return '';
}
# read the configuration file
sub read_cfg_params {
my @pp = @ARGV;
@ARGV = ();
foreach my $p (@pp) {
$p =~ s/^-+//;
if ($p =~ /^H(?:am)?[-_]?R(?:eport)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
$HamReportSpool = $1;
} elsif ($p =~ /^S(?:pam)?[-_]?R(?:eport)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
$SpamReportSpool = $1;
} else {
push @ARGV, $p;
}
}
}
sub read_cfg_cfg {
my $cfgfn = get_file_path_name('filter.conf');
if ($cfgfn) {
die('No filter config!') unless ($cfgfn);
$Features{'Path:CONFDIR'} = $cfgfn; $Features{'Path:CONFDIR'} =~ s/(\/filter)?\/[^\/]*$//;
die('Cannot read filter config!') unless (open(F,'<',$cfgfn));
#md_syslog('info',"Filter config: $cfgfn");
while (my $l = <F>) {
$l =~ s/[\r\n]+//gs;
next unless ($l);
next if ($l =~ /^\s*[#;]/);
if ($l =~ /^\$(\S+):\s*(.*?)\s*\$?$/) {
#log_msg('Config %s: %s',$1,$2);
} elsif ($l =~ /^\s*(\S+)\s*?[\s:=]\s*(\S.*?)\s*$/) {
my $c = lc($1);
my $v = $2;
$c =~ s/[-_]+//g;
next unless ($c);
next if ($c =~ /^\@/);
if (defined($cfgcfg{$c})) {
if ($cfgcfg{$c}{x} && $cfgcfg{$c}{t} =~ /^m/i) {
${$cfgcfg{$c}{v}} .= ';' if (${$cfgcfg{$c}{v}} ne '');
${$cfgcfg{$c}{v}} .= $v;
} elsif (($cfgcfg{$c}{t} eq 'l' || $cfgcfg{$c}{t} =~ /^m/i) && $v =~ /^\s*\@\{\s*(.*?)\s*\}\s*$/) {
my $lst = read_a_file(get_file_path_name($1,'.*\S'));
if ($cfgcfg{$c}{t} eq 'l') {
${$cfgcfg{$c}{v}} = '';
foreach my $le (@{$lst}) {
$le =~ s/[\r\n]+//gs;
unless ($le =~ /\\[.@]/) {
$le =~ s/\./\\./g;
$le =~ s/\@/\\\@/g;
}
next unless ($le);
${$cfgcfg{$c}{v}} .= '|' if (${$cfgcfg{$c}{v}} ne '');
${$cfgcfg{$c}{v}} .= $le
}
} elsif ($cfgcfg{$c}{t} =~ /^m/i) {
foreach my $le (@{$lst}) {
$le =~ s/[\r\n]+//gs;
${$cfgcfg{$c}{v}} .= ';' if (${$cfgcfg{$c}{v}} ne '');
${$cfgcfg{$c}{v}} .= $le;
}
}
} else {
${$cfgcfg{$c}{v}} = $v;
$cfgcfg{$c}{x} = 1;
}
}
}
}
close(F);
#return;
} else {
$Features{'Path:CONFDIR'} = '.';
}
read_cfg_params();
$Features{'Path:SPOOLDIR'} = '.' unless ($Features{'Path:SPOOLDIR'} && (-d $Features{'Path:SPOOLDIR'}));
$Features{'Path:QUARANTINEDIR'} = '.' unless ($Features{'Path:QUARANTINEDIR'} && (-d $Features{'Path:QUARANTINEDIR'}));
my @ck = sort { $cfgcfg{$a}{i} <=> $cfgcfg{$b}{i} } keys %cfgcfg;
foreach my $c (@ck) {
next if ($c =~ /^\@/);
${$cfgcfg{$c}{v}} = ${$cfgcfg{$cfgcfg{$c}{f}}{v}} if ($cfgcfg{$c}{f} && !${$cfgcfg{$c}{v}});
}
foreach my $c (@ck) {
next if ($c =~ /^\@/);
if ($cfgcfg{$c}{t} eq 'l') {
${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} =~ s/\s//g;
${$cfgcfg{$c}{v}} =~ s/\./\\./g if (${$cfgcfg{$c}{v}} !~ /\\\./);
${$cfgcfg{$c}{v}} =~ s/\@/\\\@/g if (${$cfgcfg{$c}{v}} !~ /\\\@/);
${$cfgcfg{$c}{v}} =~ s/\./\\./g if (${$cfgcfg{$c}{v}} !~ /\\\./);
${$cfgcfg{$c}{v}} =~ s/,/\|/g if (${$cfgcfg{$c}{v}} !~ /[\(\)\|\{\}]/ && ${$cfgcfg{$c}{v}} =~ /\,/);
${$cfgcfg{$c}{v}} = sprintf('(%s)',${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /[\(\)]/ && ${$cfgcfg{$c}{v}} =~ /\|/);
} elsif ($cfgcfg{$c}{t} eq 'a') {
${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
next unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} .= '@'.${$cfgcfg{'myfilterhostname'}{v}} if (${$cfgcfg{$c}{v}} =~ /^[^@]+$/);
} elsif ($cfgcfg{$c}{t} eq 't') {
${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = sprintf(${$cfgcfg{$c}{v}},${$cfgcfg{'myfilterhostname'}{v}});
${$cfgcfg{$c}{v}} =~ s/[\r\n]*$/\n\n/s;
} elsif ($cfgcfg{$c}{t} eq 'b') {
${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = 0 if (${$cfgcfg{$c}{v}} =~ /^\s*(false|no?|off|0+)\s*$/);
${$cfgcfg{$c}{v}} = 1 if (${$cfgcfg{$c}{v}});
} elsif ($cfgcfg{$c}{t} eq 'i') {
${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = eval(${$cfgcfg{$c}{v}});
} elsif ($cfgcfg{$c}{t} eq 'ps') {
${$cfgcfg{$c}{v}} = $Features{'Path:SPOOLDIR'} unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = sprintf('%s/%s',$Features{'Path:SPOOLDIR'},${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /[\/\\]/);
} elsif ($cfgcfg{$c}{t} eq 'pc') {
${$cfgcfg{$c}{v}} = $Features{'Path:CONFDIR'} unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = sprintf('%s/%s',$Features{'Path:CONFDIR'},${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /[\/\\]/);
} elsif ($cfgcfg{$c}{t} eq 'p') {
${$cfgcfg{$c}{v}} = $Features{'Path:CONFDIR'} unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = sprintf(${$cfgcfg{$c}{v}},$Features{'Path:SPOOLDIR'});
} elsif ($cfgcfg{$c}{t} eq 'mpsm') {
my @pil = split(/\s*;\s*/,${$cfgcfg{$c}{v}});
for (my $i=0;$i<@pil;$i++) {
my ($fn,$ft,$fo,$x) = split(/\s*,\s*/,$pil[$i]);
$fn = sprintf('%s/%s',${$cfgcfg{'sendmailconfig'}{v}},$fn) if ($fn !~ /[\/\\]/);
$fo = '?' unless ($fo);
unless ($ft) {
if ($fn =~ /table/i) {
$ft = 'table'
} else {
$ft = 'list';
}
}
$pil[$i] = join(',',$fn,lc($ft),lc($fo));
}
${$cfgcfg{$c}{v}} = join(';',@pil);
} elsif ($cfgcfg{$c}{t} eq 'mbs') {
${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
${$cfgcfg{$c}{v}} = 0 if (${$cfgcfg{$c}{v}} =~ /^\s*(false|no|n|off|0+)\s*$/);
${$cfgcfg{$c}{v}} = 1 if (${$cfgcfg{$c}{v}} =~ /^\s*(true|yes|y|on|\d*[1-9]\d*)\s*$/);
} else {
${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
}
}
# if ($database_spec =~ /sqlite/i) {
# $sqldbd = 'L';
# } elsif ($database_spec =~ /mysql/i) {
# $sqldbd = 'M';
# }
$spamd = -1 if ($spamdsocket || ($spamdhost && $spamdport));
}
# Initialize some stuff from the sendmail config
sub read_sendmail_config_stuff {
return unless ($sm_domains);
my $dl = $OurDomains;
$dl =~ s/^\(\?:(.*)\)$/$1/;
$dl =~ s/\\\././g;
foreach my $smd (split(/;/,$sm_domains)) {
my ($smdfn,$smdft,$smdfo,$xxx) = split(/,/,$smd);
next unless ($smdfn);
unless (open(CF,'<',$smdfn)) {
debug_log(-1,'Cannot read sendmail file %s',$smdfn);
die("Cannot read sendmail file $smdfn!") if ($smdfo =~ /\!/);
next;
}
my $mdfignore = 0;
if ($smdft eq 'table') {
while (my $l = <CF>) {
$l =~ s/[\r\n]+//g;
if ($l =~ /^\s*\#\s*mdf-?ignore\s+begin\s*$/i) {
$mdfignore ++;
} elsif ($l =~ /^\s*\#\s*mdf-?ignore\s+end\s*$/i) {
$mdfignore --;
} elsif ($mdfignore < 1) {
next if ($l =~ /^\s*#/);
if ($l =~ /^(\S+)\s+smtp:\[(\S+)\]\s*$/) {
my $d = $1;
my $h = $2;
next if (!$d || !$h);
if ($dl !~ /^(|.*\|)$d(|\|.*)/) {
$dl .= '|' if ($dl);
$dl .= '*' if ($d =~ /^\./);
$dl .= $d;
}
debug_log(1,"mailertable: $d -> $h");
}
}
}
close(CF);
} elsif ($smdft eq 'list') {
while (my $l = <CF>) {
$l =~ s/[\r\n]+//g;
if ($l =~ /^\s*\#\s*mdf-?ignore\s+begin\s*$/i) {
$mdfignore ++;
} elsif ($l =~ /^\s*\#\s*mdf-?ignore\s+end\s*$/i) {
$mdfignore --;
} elsif ($mdfignore < 1) {
next if ($l =~ /^\s*#/);
$l =~ s/\s+$//;
next if (!$l || $l =~ /\s/);
if ($dl !~ /^(|.*\|)$l(|\|.*)/) {
$dl .= '|' if ($dl);
$dl .= $l;
}
}
}
close(CF);
} else {
debug_log(-1,'Unknown file type %s (%s)',$smdft,$smdfn);
die("Unknown file type $smdft ($smdfn)") if ($smdfo =~ /\!/);
close(CF);
}
}
$dl =~ s/(\.)/\\$1/g;
$dl =~ s/\*/.*/g;
$dl =~ s/\?/./g;
debug_log(1,"domains: ($dl)");
$OurDomains = "($dl)";
}
# read parameters
sub read_params {
my %gp = ();
foreach my $p (@ARGV) {
$p =~ s/^-+//;
if ($p =~ /^P(?:ost)?[-_]?C(?:onf(?:if)?)?[:=]\s*(.*?)\s*$/i) {
$postconf = $1;
} elsif ($p =~ /^S(?:pam)?[-_]?D(?:aemon)?[:=]\s*(.*?)\s*$/i) {
$spamd = $1;
} elsif ($p =~ /^S(?:pam)?[-_]?D(?:aemon)?$/i) {
$spamd = -1;
} elsif ($p =~ /^S(?:pam)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
$SpamReportSpool = $1;
$HamReportSpool = '' unless ($gp{hrs});
$SpamTrapSpool = '';
$gp{srs} = 1;
} elsif ($p =~ /^H(?:am)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
$HamReportSpool = $1;
$SpamReportSpool = '' unless ($gp{srs});
$SpamTrapSpool = '';
$gp{hrs} = 1;
} elsif ($p =~ /^No?[-_]?R(?:eports?)?$/i) {
$noreport = 1;
} elsif ($p =~ /^No?[-_]?S(?:ends?)?$/i) {
$nosend = 1;
} elsif ($p =~ /^No?[-_]?S(?:aves?)?$/i) {
$nosave = 1;
} elsif ($p =~ /^No?[-_]?C(?:hanges?)?$/i) {
$nochange = 1;
} elsif ($p =~ /^No?[-_]?P(?:ars(?:e|e?ing)s?)?$/i) {
$noparse = 1;
} elsif ($p =~ /^No?[-_]?S(?:pam)?[-_]?S(?:pool)?$/i) {
$nospam = 1;
} elsif ($p =~ /^No?[-_]?H(?:am)?[-_]?S(?:pool)?$/i) {
$noham = 1;
} elsif ($p =~ /^O(?:nly)?[-_]?S(?:pam)?$/i) {
$noham = 1;
} elsif ($p =~ /^O(?:nly)?[-_]?H(?:am)?$/i) {
$nospam = 1;
} elsif ($p =~ /^D(?:ebug)?$/i) {
$debug = 1;
} elsif ($p =~ /^D(?:ebug)?[-_]?P(?:rint)?$/i) {
$debugprint = 1;
} elsif ($p =~ /^D(?:ebug)?[-_]?No?[-_]?A(?:ge)?$/i) {
$debugnoage = 1;
}
}
}
#***********************************************************************
# App...
#***********************************************************************
sub css {
my $css = CSS::Tiny->new();
$css->{'body'} = {
'background-color' => 'rgb(220,255,220)',
'color' => 'black',
'margin' => '1%',
'font-family' => 'arial, helvetica, sans-serif',
};
$css->{'h1'} = {
'text-align' => 'center',
'font-weight' => 'bold',
'margin-top' => '0em',
'margin-bottom' => '1em',
'margin-left' => '0',
'clear' => 'both',
};
$css->{'h2'} = {
'font-weight' => 'bold',
'margin-top' => '1em',
'margin-bottom' => '0.5em',
'margin-left' => '0',
'clear' => 'both',
};
$css->{'tr'} = {
'vertical-align' => 'baseline'
};
$css->{'table.top tr'} = {
'vertical-align' => 'top'
};
$css->{'tr.even'} = {
'background-color' => 'rgb(220,220,255)'
};
$css->{'tr.odd'} = {
'background-color' => 'rgb(255,220,220)'
};
$css->{'th'} = {
'background-color' => 'rgb(0,50,0)',
'color' => 'rgb(220,255,220)',
};
$css->{'td'} = {
'border-style' => 'none',
};
my $r = $css->write_string;
$r =~ s/\{\s+/{/gs;
$r =~ s/\s+\}/}/gs;
$r =~ s/\s+\{/{/gs;
$r =~ s/: /:/gs;
return $r;
}
my $sqlsa;
sub sql_connect_sa {
return 1 if ($sqlsa);
#dbg('sql connect');
$sqlsa = DBI->connect_cached($sa_database_spec,$sa_database_user,$sa_database_pass,{RaiseError=>0,AutoCommit=>1});
return 1 if ($sqlsa);
return 0;
}
sub sql_disconnect_sa {
$sqlsa->disconnect() if ($sqlsa);
$sqlsa = undef;
}
sub check_ip_in_list($$) {
my $ip = shift;
return 0 unless ($ip && $ip =~ /^$RE{net}{IPv4}$/);
my $addr = inet_aton($ip);
return 0 unless ($addr);
foreach my $lst (@_) {
next unless ($lst);
foreach my $net (split(/;/,$lst)) {
$net =~ s/\s+//g;
next unless ($net);
my ($na_s,$nm_s) = split(/\//,$net);
$nm_s = '255.255.255.255' unless ($nm_s);
my $na = inet_aton($na_s);
my $nm = inet_aton($nm_s);
next unless ($na && $nm);
return 1 if (($addr & $nm) eq ($na & $nm));
}
}
return 0;
}
sub check_black_nets($) {
my($ip) = @_;
return check_ip_in_list($ip,'10.0.0.0/255.0.0.0;172.16.0.0/255.240.0.0;192.168.0.0/255.255.0.0;127.0.0.0/255.255.255.0');
}
sub trim_host_part {
my ($addr,$toboundary) = @_;
$addr =~ s/^.*\@//;
$toboundary = 1 unless (defined($toboundary));
if ($addr =~ /^$RE{net}{IPv4}$/) {
return "$3.$4.$5" if ($toboundary);
return $addr;
}
my $dn = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($addr);
return lc($addr) unless ($dn);
return lc($dn) if ($toboundary);
$addr =~ s/^(.*?\.)([^.]+\.$dn)$/$2/;
return lc($addr);
}
my $resolver;
sub get_resolver {
return $resolver if (defined($resolver));
$resolver = Net::DNS::Resolver->new;
#$resolver->persistent_tcp(0);
#$resolver->tcp_timeout($to);
#$resolver->udp_timeout($to);
return $resolver;
}
my %queries = ();
my $queries = 0;
my $queriec = 0;
sub dns_bgsend {
my ($addr,$type,$qf,$qF) = @_;
return 0 unless ($type && $addr);
return 0 unless (get_resolver());
$addr = lc($addr);
$type = uc($type);
$qF = defined($qF) ? $qF+1 : 0;
my $oaddr = $addr;
my $otype = $type;
if ($type eq 'A') {
return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
} elsif ($type eq 'PTR') {
return 0 if ($addr !~ /^$RE{net}{IPv4}$/);
} elsif ($type eq 'ABUSE') {
return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
return 0 if ("1.$addr" =~ /^$RE{net}{IPv4}$/);
$type = 'TXT';
$addr= "$addr.contacts.abuse.net";
} elsif ($type eq 'RFC') {
$type = 'A';
$addr = "$addr.rfc-ignorant.org";
$qF = 999;
} elsif ($type eq 'SOA') {
return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
$addr = trim_host_part($addr);
} elsif ($type ne 'TXT') {
return 0;
}
return 1 if (defined($queries{"$type:$addr"}));
my $qs = $resolver->bgsend($addr,$type);
return 0 unless ($qs);
$queriec ++;
my %qi = (
qT => $otype,
qA => $oaddr,
qt => $type,
qa => $addr,
qc => $queriec,
qs => $qs,
qF => $qF,
);
$qi{qf} = $qf if ($qf);
$queries{"$type:$addr"} = \%qi;
$queries ++;
return $queries;
}
sub dns_bgclose {
foreach my $qi (values %queries) {
eval { $qi->{qs}->close unless (defined($qi->{rl})); };
}
}
sub dns_bgclear {
dns_bgclose();
%queries = ();
$queries = 0;
}
sub dns_bglist {
return sort { $a->{qc} <=> $b->{qc} } values %queries;
}
sub dns_bgresult {
my ($addr,$type,$raw) = @_;
return 0 unless ($type && $addr);
$addr = lc($addr);
$type = uc($type);
my $otype = $type;
if ($type eq 'ABUSE') {
$type = 'TXT';
$addr= "$addr.contacts.abuse.net";
} elsif ($type eq 'RFC') {
$type = 'A';
$addr = "$addr.rfc-ignorant.org";
} elsif ($type eq 'SOA') {
$addr = trim_host_part($addr);
}
return wantarray ? () : undef unless (defined($queries{"$type:$addr"}) && defined($queries{"$type:$addr"}->{rl}) && @{$queries{"$type:$addr"}->{rl}});
return wantarray ? @{$queries{"$type:$addr"}->{rl}} : [@{$queries{"$type:$addr"}->{rl}}] if ($raw);
my @ans = ();
if ($type eq 'MX') {
foreach my $ans (sort {$a->{p} <=> $b->{p}} @{$queries{"$type:$addr"}->{rl}}) {
push @ans, $ans->{x};
}
} else {
foreach my $ans (@{$queries{"$type:$addr"}->{rl}}) {
my $res = $type eq 'PTR' || $type eq 'A' ? $ans->{a} :
$type eq 'SOA' ? join(' ',$ans->{ns},$ans->{mb}) :
$otype eq 'ABUSE' ? $ans->{a} :
$type eq 'TXT' ? $ans->{t} :
undef;
push @ans, $res if ($res);
}
}
return wantarray ? @ans : [@ans];
}
sub dns_bgfullcircle {
my ($addr) = @_;
if ($addr =~ /^$RE{net}{IPv4}$/) {
my $ans = dns_bgresult($addr,'PTR');
return 0 unless ($ans);
foreach my $res (@{$ans}) {
my $rans = dns_bgresult($res,'A');
next unless ($rans);
foreach my $rres (@{$rans}) {
return 1 if ($rres eq $addr);
}
}
} else {
my $ans = dns_bgresult($addr,'A');
return 0 unless ($ans);
$addr = lc($addr);
foreach my $res (@{$ans}) {
my $rans = dns_bgresult($res,'PTR');
next unless ($rans);
foreach my $rres (@{$rans}) {
return 1 if (lc($rres) eq $addr);
}
}
}
return 0;
}
sub dns_bgcollect {
my ($to,$follow,$abuse) = @_;
return 0 unless ($resolver);
$to = 300 unless ($to);
my $dnst = time() + $to;
while ($queries) {
my $wq = 0;
foreach my $qi (values %queries) {
next if (defined($qi->{rl}));
unless ($resolver->bgisready($qi->{qs})) {
$wq ++;
next;
}
my $pkt = $resolver->bgread($qi->{qs});
$qi->{qs}->close;
$queries --;
$qi->{rl} = [];
next unless ($pkt);
foreach my $ans ($pkt->answer) {
next unless ($ans->class eq 'IN');
next unless ($ans->type eq $qi->{qt});
if ($qi->{qt} eq 'MX') {
next unless ($ans->exchange);
push @{$qi->{rl}}, {p=>$ans->preference,x=>$ans->exchange};
if ($follow) {
$wq ++ if (dns_bgsend($ans->exchange,'A',$qi->{qc}));
$wq ++ if (dns_bgsend($ans->exchange,'PTR',$qi->{qc}));
$wq ++ if (dns_bgsend($ans->exchange,'SOA',$qi->{qc}));
}
if ($abuse) {
$wq ++ if (dns_bgsend($ans->exchange,'ABUSE',$qi->{qc}));
$wq ++ if (dns_bgsend(trim_host_part($ans->exchange),'ABUSE',$qi->{qc}));
}
} elsif ($qi->{qt} eq 'PTR') {
next unless ($ans->ptrdname);
push @{$qi->{rl}}, {a=>$ans->ptrdname};
if ($follow && $qi->{qF}<4) {
$wq ++ if (dns_bgsend($ans->ptrdname,'A',$qi->{qc},$qi->{qF}));
$wq ++ if (dns_bgsend($ans->ptrdname,'SOA',$qi->{qc}));
}
if ($abuse) {
$wq ++ if (dns_bgsend($ans->ptrdname,'ABUSE',$qi->{qc}));
$wq ++ if (dns_bgsend(trim_host_part($ans->ptrdname),'ABUSE',$qi->{qc}));
}
} elsif ($qi->{qt} eq 'A') {
next unless ($ans->address);
push @{$qi->{rl}}, {a=>$ans->address};
if ($follow && $qi->{qF}<4) {
$wq ++ if (dns_bgsend($ans->address,'PTR',$qi->{qc},$qi->{qF}));
}
} elsif ($qi->{qt} eq 'SOA') {
next unless ($ans->mname && $ans->rname);
push @{$qi->{rl}}, {ns=>$ans->mname,mb=>$ans->rname,sn=>$ans->serial,rf=>$ans->refresh,ry=>$ans->retry,ex=>$ans->expire,mt=>$ans->minimum};
} elsif ($qi->{qt} eq 'TXT') {
next unless ($ans->txtdata);
if ($qi->{qT} eq 'ABUSE') {
push @{$qi->{rl}}, {a=>$ans->txtdata,d=>trim_host_part($ans->txtdata)};
$wq ++ if (dns_bgsend($ans->txtdata,'SOA',$qi->{qc}));
if ($ans->txtdata =~ /^<?(postmaster|abuse)\@(.*?)>?$/i) {
$wq ++ if (dns_bgsend("$2.$1",'RFC',$qi->{qc}));
}
} else {
push @{$qi->{rl}}, {t=>$ans->txtdata};
}
}
}
}
return 0E0 unless ($wq && $queries);
return $wq if (time() > $dnst);
sleep(1);
}
return $queries ? $queries : 0E0;
}
my %mails = ();
my @atts = ();
sub init_mail {
my ($spam,$from) = @_;
return if ($mails{$spam});
my $spams = $spam?'spam':'ham';
$mails{$spam} = {};
$mails{$spam}->{frm} = $from;
$mails{$spam}->{att} = 0;
$mails{$spam}->{ent} = MIME::Entity->build(
From => $from,
Subject => $spams,
Data => "$spams reports attached\n",
Encoding => '-SUGGEST',
'X-MDF-Report:' => "($FilterUtilVers) <forward>",
'Message-ID:' => Email::MessageID->new($MyFilterHostName)->format,
'Reply-To:' => $AdminContactAddress ? $AdminContactAddress : $AdminAddress,
);
}
sub done_mail {
%mails = ();
while (my $nf = shift @atts) {
unlink($nf);
}
}
sub add_mail {
return 0 if ($nosend);
my ($spam,$rf,$ra) = @_;
return 0 unless ($mails{$spam} && $mails{$spam}->{ent});
return 0 unless (-e $rf);
my $nf = sprintf('%s.%03u',$rf,$#atts+1);
return 0 unless link($rf,$nf);
push @atts, $nf;
my $df = $nf;
$df =~ s/^.*[\/\\]//s;
$mails{$spam}->{att}++;
$mails{$spam}->{ent}->attach(
Path => $nf,
Type => 'message/rfc822',
Disposition => 'attachment',
Encoding => '-SUGGEST',
Filename => "$df.eml",
'X-Age:' => $ra ? sprintf('%u',$ra/(24*60*60)) : '?',
);
return 1;
}
sub send_mail {
return 0 if ($nosend);
return 1 unless (@atts);
my $cnt = 0;
my $snd = $SpamReportSender ? $SpamReportSender : $AdminAddress;
while (my ($spam,$mail) = each %mails) {
next unless ($mail->{ent} && $mail->{att});
my $cmd = "sendmail -odd -Ac -oi -f '$snd' --";
my @rcpts = ();
my $rc = 0;
if ($spam) {
foreach my $rcpt (split(/\s*;\s*/,$SpamReportForward)) {
next unless ($rcpt =~ /^\S+\@\S+$/);
$cmd .= " '$rcpt'";
push @rcpts, $rcpt;
}
}
next unless (@rcpts);
log_msg('Sending: %s -> %s',$AdminAddress,join(', ',@rcpts));
print "=============================================\n".
"Send mail (".($spam?'spam':'ham').")\n".
"---------------------------------------------\n".
$mail->{ent}->as_string.
"=============================================\n" if ($debugprint);
$cnt ++;
next if ($debug);
unless (open(SM,"|$cmd")) {
log_msg('Error calling sendmail!');
return 0;
}
print SM $mail->{ent}->as_string;
close(SM);
}
return $cnt;
}
my $mparser;
my $sparser;
sub clean_parser {
unless (@_) {
push @_, $sparser if (defined($sparser));
push @_, $mparser if (defined($mparser));
}
foreach my $prs (@_) {
return unless (defined($prs));
my $dir = $prs->output_dir();
$prs->filer->purge();
rmdir($dir) if ($dir && (-d $dir));
}
}
sub init_mparser {
return 1 if (defined($mparser));
$mparser = new MIME::Parser();
return 0 unless (defined($mparser));
$mparser->output_under('/tmp');
$mparser->extract_nested_messages(0);
$mparser->filer->ignore_filename(1);
return 1;
}
sub init_sparser {
return 1 if (defined($sparser));
$sparser = new MIME::Parser();
return 0 unless (defined($sparser));
$sparser->output_under('/tmp');
$sparser->extract_nested_messages(1);
$sparser->extract_uuencode(1);
$sparser->filer->ignore_filename(1);
}
sub cat_message {
my ($spam,$rf) = @_;
return 0 unless (open(FS,'<',$rf));
print $spam?"SPAM\n":"HAM\n";
while (my $l = <FS>) { print $l; }
close(FS);
return 1;
}
my $sa;
sub report_message_sa {
return 2 if ($noreport);
my ($spam,$eml,$id,$ri) = @_;
return 0 unless ($eml);
return 3 if (length($eml) > $SASizeLimit);
if ($ri) {
log_msg('Reporting: {%s} %s %s <%s> %s [%s] (%s)',$spamd?'SD':'SA',$id,$spam?'spam':'ham',$ri->{addr},$ri->{helo},$ri->{ip},$ri->{rdns});
} else {
log_msg('Reporting: {%s} %s %s',$spamd?'SD':'SA',$id,$spam?'spam':'ham');
}
print "=============================================\n".
"Report message (".($spam?'spam':'ham').")\n".
"---------------------------------------------\n".
$eml.
"=============================================\n" if ($debugprint);
return 1 if ($debug);
if ($spamd) {
unless (defined($sa)) {
my %sap = (
socketpath => $spamdsocket,
host => $spamdhost,
port => $spamdport,
username => 'mdf',
);
unless ($spamd == -1) {
my ($sdh,$sdp,$sdu) = split(/:/,$spamd,3);
$sap{socketpath} = $sdh if ($sdh && $sdh =~ /\//);
$sap{host} = $sdh if ($sdh && $sdh !~ /\//);
$sap{port} = $sdp if ($sdp);
$sap{username} = $sdu if ($sdu);
}
$sa = new Mail::SpamAssassin::Client(\%sap);
$sa = 0 unless ($sa && $sa->ping);
}
return 0 unless ($sa && defined($sa->learn($eml,$spam?0:1)));
return 1;
}
unless (defined($sa)) {
if ($postconf) {
$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,post_config_text=>$postconf});
} else {
my $cfg = '/usr/local/etc/mimedefang/spamassassin.cf';
foreach my $cfn (('/usr/local/etc/mimedefang/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/local.cf')) {
if (-r $cfn) {
$cfg = $cfn;
last;
}
}
$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,userprefs_filename=>$cfg});
}
$sa->init_learner({caller_will_untie=>1,learn_to_journal=>1});
}
return 0 unless (defined($sa));
my $msg = $sa->parse($eml);
return 0 unless ($msg);
my $ok = 0;
my $st = $sa->learn($msg,undef,$spam,0);
if ($st) {
$ok = 1;
$st->finish();
}
$msg->finish();
return $ok;
}
my $prsc = 0;
my $prst = time();
my $urif;
sub save_parsed {
my ($path,$file,$spam,$ra) = @_;
return 0 unless ($path && $file);
return 0 unless (init_sparser());
return 0 unless ((-d $path) && (-e $file));
log_msg('Saving: %s',$file);
my $entity = $sparser->parse_open($file);
unless ($entity) {
clean_parser($sparser);
return 0;
}
my %msg = (
rage => $ra,
spam => $spam,
stamp => time(),
relays => [],
senders => [],
abuse => {},
ignorants => {},
nosoas => {},
data => {
received => [],
senders => [],
original => [],
links => [],
queries => [],
},
);
my @senders = ();
$entity->head->unfold();
foreach my $val ($entity->head->get('Received')) {
next unless (defined($val));
$val =~ s/[\s\r\n]+$//;
next if ($val eq '');
push @{$msg{data}->{original}}, {field=>'Received',value=>$val};
my %rcvd = ();
my ($tree,$fld);
if (($fld = Mail::Field->new('Received',$val)) && ($tree = $fld->parse_tree()) && $fld->parsed_ok) {
$rcvd{mft} = $tree;
$rcvd{from_helo} = lc($tree->{from}->{HELO}) if ($tree->{from}->{HELO});
$rcvd{from_host} = lc($tree->{from}->{domain}) if ($tree->{from}->{domain});
$rcvd{from_addr} = lc($tree->{from}->{address}) if ($tree->{from}->{address});
$rcvd{by_host} = lc($tree->{by}->{domain}) if ($tree->{by}->{domain});
}
if ($tree = parse_received($val)) {
$rcvd{ert} = $tree;
$rcvd{from_helo} = lc($tree->{helo}) if ($tree->{helo});
$rcvd{from_host} = lc($tree->{rdns}) if ($tree->{rdns});
$rcvd{from_addr} = lc($tree->{ip}) if ($tree->{ip});
$rcvd{from_mail} = lc($tree->{envfrom}) if ($tree->{envfrom});
$rcvd{by_host} = lc($tree->{by}) if ($tree->{by});
push @senders, {hn=>'Received',hv=>$tree->{envfrom},ho=>$#{$msg{data}->{original}}} if ($tree->{envfrom});
}
next unless (%rcvd);
foreach my $k (keys %rcvd) {
next unless ($k =~ /^(?:by|from)_/);
$rcvd{$k} =~ s/^[<\[](.*?)[\]>]$/$1/;
}
$rcvd{from_rdom} = trim_host_part($rcvd{from_host}) if ($rcvd{from_host});
$rcvd{from_hdom} = trim_host_part($rcvd{from_helo}) if ($rcvd{from_helo});
$rcvd{by_dom} = trim_host_part($rcvd{by_host}) if ($rcvd{by_host});
$rcvd{original} = $#{$msg{data}->{original}};
push @{$msg{data}->{received}}, \%rcvd;
}
foreach my $ahn (('From','Reply-To','Sender','Return-Path','Envelope-From','To','CC','BCC')) {
foreach my $val ($entity->head->get($ahn)) {
next unless (defined($val));
$val =~ s/[\s\r\n]+$//;
next if ($val eq '');
push @{$msg{data}->{original}}, {field=>$ahn,value=>$val};
push @senders, {hn=>$ahn,hv=>$val,ho=>$#{$msg{data}->{original}}};
}
}
my @uris = ();
foreach my $part ($entity->parts_DFS) {
next unless ($part->effective_type =~ /^text\/(?:plain|flowed|html)$/i);
$urif = URI::Find::Schemeless->new(sub {
my ($uri,$txt) = @_;
push @uris, {uri=>$uri,txt=>$txt,src=>'plain'};
return $txt;
}) unless (defined($urif));
my $body = $part->bodyhandle;
next unless ($body);
my $data = join('',$body->as_lines);
if ($part->effective_type =~ /^text\/html$/i) {
my $html = HTML::TreeBuilder->new_from_content($data);
if ($html) {
foreach my $tag ($html->look_down(sub { defined($_[0]->attr('src')) })) {
my %uri = (tag=>$tag->tag,fld=>'src',txt=>$tag->attr('src'),uri=>URI->new($tag->attr('src')),src=>'html');
push @uris, \%uri if ($uri{uri});
}
foreach my $tag ($html->look_down(sub { defined($_[0]->attr('href')) })) {
my %uri = (tag=>$tag->tag,fld=>'href',txt=>$tag->attr('href'),uri=>URI->new($tag->attr('href')),src=>'html');
push @uris, \%uri if ($uri{uri});
}
}
$data =~ s/<.*?>//gs;
}
next unless ($urif);
$urif->find(\$data);
}
clean_parser($sparser);
foreach my $uri (@uris) {
my %uri = (text=>$uri->{txt});
eval { $uri{schm} = lc($uri->{uri}->scheme) if ($uri->{uri}->scheme); };
next unless ($uri{schm});
eval{ $uri{host} = lc($uri->{uri}->host) if ($uri->{uri}->host); };
eval{ $uri{addr} = lc($uri->{uri}->address) if ($uri->{uri}->address); };
eval{ $uri{addr} = lc($uri->{uri}->to) if ($uri->{uri}->to); } unless ($uri{addr} || $uri{schm} !~ /^(?:mailto)$/i);
next unless ($uri{host} || $uri{addr});
eval{ $uri{user} = $uri->{uri}->user if ($uri->{uri}->user); };
eval{ $uri{user} = $uri->{uri}->userinfo if ($uri->{uri}->userinfo); $uri{user} =~ s/:.*$// if ($uri{user}); } unless ($uri{user});
$uri{rdom} = trim_host_part($uri{host}) if ($uri{host});
if ($uri{addr} && $uri{addr} =~ /^.*\@((?:[-\w]+\.)+?(?:[-\w]+))$/) {
$uri{adom} = $1;
}
$uri{type} = lc($uri->{src});
$uri{type} .= lc(".$uri->{tag}") if ($uri->{tag});
if ($uri->{host} =~ /^$RE{net}{IPv4}$/) {
$uri{ip} = $uri->{host};
delete $uri->{host};
}
push @{$msg{data}->{links}}, \%uri;
}
my $pelo;
my $trust = 1;
foreach my $rcvd (@{$msg{data}->{received}}) {
if ($pelo && $rcvd->{by_dom} ne $pelo) {
$rcvd->{note} = "by helo domain '$pelo' != domain '$rcvd->{by_dom}'";
last;
}
$pelo = $rcvd->{from_hdom};
unless ($rcvd->{from_addr}) {
$rcvd->{note} = 'not from addr';
next;
}
if (check_black_nets($rcvd->{from_addr})) {
$rcvd->{note} = "from local addr '$rcvd->{from_addr}'";
next;
}
my %relay = (addr=>$rcvd->{from_addr});
$relay{host} = $rcvd->{from_host} if ($rcvd->{from_host});
$relay{helo} = $rcvd->{from_helo} if ($rcvd->{from_helo});
$relay{rdom} = $rcvd->{from_rdom} if ($rcvd->{from_rdom});
push @{$msg{relays}}, \%relay;
unless ($trust) {
if ($rcvd->{from_helo} =~ /^\d+\.\d+\.\d+\.\d+$/ && $rcvd->{from_helo} !~ /^$RE{net}{IPv4}$/) {
$rcvd->{note} = "from bad helo addr '$rcvd->{from_helo}'";
last;
}
if ($rcvd->{from_helo} =~ /^$RE{net}{IPv4}$/ && $rcvd->{from_helo} ne $rcvd->{from_addr}) {
$rcvd->{note} = "from bogus helo addr '$rcvd->{from_helo}'";
last;
}
if ($rcvd->{from_helo} !~ /^([-\w]+\.)+?([-\w]+)$/) {
$rcvd->{note} = "from bad helo '$rcvd->{from_helo}'";
last;
}
}
$trust = 0;
}
my %senders = ();
foreach my $snd (@senders) {
foreach my $adr (Email::Address->parse($snd->{hv})) {
next unless ($adr && $adr->address);
my $caddr = lc($adr->address);
next if ($caddr =~ /\@$OurDomains>?$/i);
my $dp = -1;
my $sp = -1;
if ($senders{$caddr}) {
$dp = $senders{$caddr}->{d};
$sp = $senders{$caddr}->{s};
} else {
$senders{$caddr} = {};
}
if (!defined($dp) || $dp<0) {
my %sndr = (address=>$caddr);
$senders{$sndr{address}} = {};
$sndr{phrase} = $adr->phrase if ($adr->phrase);
$sndr{comment} = $adr->comment if ($adr->comment);
$sndr{host} = lc($adr->host) if ($adr->host);
$sndr{user} = lc($adr->user) if ($adr->user);
$sndr{format} = $adr->format if ($adr->format);
$sndr{name} = $adr->name if ($adr->name);
$sndr{domain} = trim_host_part($sndr{host}) if ($sndr{host});
$sndr{originals} = [];
$sndr{headers} = [];
push @{$msg{data}->{senders}}, \%sndr;
$dp = $#{$msg{data}->{senders}};
$senders{$caddr}->{d} = $dp;
}
if (!defined($sp) || $sp<0) {
my %sender = (addr=>$caddr);
$sender{user} = lc($adr->user) if ($adr->user);
$sender{host} = lc($adr->host) if ($adr->host);
$sender{rdom} = trim_host_part($sender{host}) if ($sender{host});
push @{$msg{senders}}, \%sender;
$sp = $#{$msg{senders}};
$senders{$caddr}->{s} = $sp;
}
if (defined($dp) && $dp >= 0) {
push @{$msg{data}->{senders}->[$dp]->{headers}}, $snd->{hn};
push @{$msg{data}->{senders}->[$dp]->{originals}}, $snd->{ho};
}
if (defined($sp) && $sp >= 0) {
push @{$msg{senders}->[$dp]->{headers}}, $snd->{hn};
push @{$msg{senders}->[$dp]->{originals}}, $snd->{ho};
}
}
}
dns_bgclear();
foreach my $uri (@{$msg{data}->{links}}) {
if ($uri->{host}) {
dns_bgsend($uri->{host},'A');
dns_bgsend($uri->{host},'ABUSE');
dns_bgsend($uri->{rdom},'ABUSE');
}
if ($uri->{ip}) {
dns_bgsend($uri->{ip},'PTR');
dns_bgsend($uri->{ip},'ABUSE');
}
if ($uri->{adom} && $uri->{schm} =~ /mail/i) {
dns_bgsend($uri->{adom},'MX');
dns_bgsend($uri->{adom},'A');
dns_bgsend($uri->{adom},'PTR');
dns_bgsend($uri->{adom},'ABUSE');
}
}
foreach my $snd (@{$msg{senders}}) {
if ($snd->{host}) {
dns_bgsend($snd->{host},'MX');
dns_bgsend($snd->{host},'A');
dns_bgsend($snd->{host},'PTR');
dns_bgsend($snd->{host},'ABUSE');
dns_bgsend($snd->{rdom},'ABUSE');
dns_bgsend($snd->{rdom},'SOA');
}
}
foreach my $rly (@{$msg{relays}}) {
if ($rly->{addr}) {
dns_bgsend($rly->{addr},'PTR');
dns_bgsend($rly->{addr},'ABUSE');
}
if ($rly->{host}) {
dns_bgsend($rly->{host},'A');
dns_bgsend($rly->{host},'ABUSE');
dns_bgsend($rly->{rdom},'ABUSE');
}
}
dns_bgcollect(300,1,1);
dns_bgclose();
$msg{querycount} = scalar %queries;
foreach my $qi (dns_bglist()) {
delete $qi->{qs} if ($qi->{qs});
my %qx = (type=>$qi->{qt},addr=>$qi->{qa},qcid=>$qi->{qc});
$qx{qsrc} = $qi->{qf} if ($qi->{qf});
$qx{otyp} = $qi->{qT} if ($qi->{qt} ne $qi->{qT});
$qx{oadr} = $qi->{qA} if ($qi->{qa} ne $qi->{qA});
if ($qi->{rl} && @{$qi->{rl}}) {
$qx{ansr} = $qi->{rl};
if ($qi->{qT} eq 'ABUSE') {
$msg{abuse}->{$qi->{qA}} = $qi->{rl};
} elsif ($qi->{qT} eq 'RFC' && $qi->{qA} =~ /^(.*?)\.([a-z])$/i) {
$msg{ignorants}->{lc("$2\@$1")} = 1;
}
}
push @{$msg{data}->{queries}}, \%qx;
}
my $dans;
foreach my $uri (@{$msg{data}->{links}}) {
if ($uri->{host} && ($dans = dns_bgresult($uri->{host},'A'))) {
$uri->{ip} = [@{$dans}];
} elsif ($uri->{ip} && ($dans = dns_bgresult($uri->{ip},'PTR'))) {
$uri->{host} = [@{$dans}];
}
}
foreach my $snd (@{$msg{senders}}) {
$msg{nosoas}->{lc($snd->{addr})} = 1 unless ($msg{nosoas}->{lc($snd->{addr})} || dns_bgresult($snd->{rdom},'SOA'));
next unless ($snd->{host});
if ($dans = dns_bgresult($snd->{host},'MX')) {
$snd->{mx} = [];
foreach my $qa ((@{$dans})) {
my %mxi = (host=>$qa);
if ($qa =~ /^$RE{net}{IPv4}$/) {
$mxi{addr} = [$qa];
} elsif ($dans = dns_bgresult($qa,'A')) {
$mxi{addr} = [@{$dans}];
}
push @{$snd->{mx}}, \%mxi;
}
}
next if ($snd->{mx} && @{$snd->{mx}});
if ($dans = dns_bgresult($snd->{host},'A')) {
$snd->{mx} = [{
host => $snd->{host},
addr => [@{$dans}],
}];
}
}
foreach my $snd (values %{$msg{abuse}}) {
foreach my $abu (@{$snd}) {
$msg{nosoas}->{lc($abu->{a})} = 1 unless ($msg{nosoas}->{lc($abu->{a})} || dns_bgresult($abu->{d},'SOA'));
}
}
foreach my $rly (@{$msg{relays}}) {
if ($rly->{addr}) {
if ($dans = dns_bgresult($rly->{addr},'PTR')) {
$rly->{rdns} = [@{$dans}];
}
$rly->{fadr} = dns_bgfullcircle($rly->{addr});
}
if ($rly->{host}) {
if ($dans = dns_bgresult($rly->{host},'A')) {
$rly->{fdns} = [@{$dans}];
}
$rly->{fhst} = dns_bgfullcircle($rly->{host});
}
}
dns_bgclear();
my $dump = Dump(\%msg);
print "=============================================\n".
"Save '$file' to '$path'\n".
"---------------------------------------------\n".
$dump.
"=============================================\n" if ($debugprint);
return 1 if ($debug);
my $nfn;
my $fnc = 0;
while (1) {
$prsc ++;
$nfn = sprintf('t%Xr%Xp%Xn%Xs%Xr%X.prs',time(),rand(0xFFFF),$$,$prsc,$prst,rand(0xFFFF));
last if (!(-e "$path/$nfn.eml") && link($file,"$path/$nfn.eml"));
$fnc ++;
return 0 if ($fnc > 10000);
}
log_msg('Saved: %s',"$path/$nfn");
return 0 unless (open(F,'>',"$path/$nfn.dat"));
print F $dump;
close(F);
if (open(F,'>',"$path/$nfn.sav")) { close(F); }
if (open(F,'>',"$path/$nfn.new")) { close(F); }
return 1;
}
sub make_hash0 {
my ($body,$header) = @_;
$body =~ s/^[\s\n]+//s;
$body =~ s/[\s\n]+$//s;
my $hdr = '';
foreach my $h (@{$header}) {
next unless ($h =~ /^(?:Content-\S+|Subject):/i);
$hdr .= $h;
}
$body = "$hdr\n$body";
my $hash = join('+',Digest::MD5::md5_hex($body),Digest::SHA::sha1_hex($body));
return "=$hash";
}
sub make_hash1 {
my ($body) = @_;
$body =~ s/([[:space:]]{100})(?:\1+)/$1/g;
$body =~ s/([[:space:]])(?:\1+)/$1/g;
$body =~ s/[[:graph:]]+//go;
my $hash = Digest::MD5::md5_hex($body);
return "~$hash";
}
sub make_hash2 {
my ($body) = @_;
$body =~ s/[[:cntrl:][:alnum:]%&#;=]+//g;
$body =~ tr/_/./;
$body =~ s/([[:print:]]{100})(?:\1+)/$1/g;
$body =~ s/([[:print:]])(?:\1+)/$1/g;
my $hash = Digest::MD5::md5_hex($body);
return "~$hash";
}
sub make_hash3 {
my ($body) = @_;
$body =~ s/[[:cntrl:][:space:]=]+//g;
$body =~ s/([[:print:]]{100})(?:\1+)/$1/g;
$body =~ s/([[:graph:]])(?:\1+)/$1/g;
my $hash = Digest::MD5::md5_hex($body);
return "~$hash";
}
sub add_hashes {
my $ft = shift;
my $sti = $sqlsa->prepare('INSERT INTO hashcount (stamp,type,hash) VALUES (?,?,?)');
return 0 unless ($sti);
my $cnt = ($ft =~ /tra?p/i) ? 'count_trap' : 'count_flag';
my $ok = 1;
my $now = time();
foreach my $hash (@_) {
#log_msg('AddHash: %s %s',$cnt,$hash);
next if ($debug);
next if ($sti->execute($now,($ft=~/tra?p/i)?'trap':'flag',$hash));
$ok = 0;
last;
}
$sti->finish;
return $ok if ($sqlsa->{AutoCommit});
return $sqlsa->commit if ($ok);
$sqlsa->rollback;
return $ok;
}
sub report_message_count {
return 0 if ($noreport);
my ($spam,$ft,$body,$header) = @_;
return 0 unless ($body);
return 0 unless ($spam);
my @hashes = ();
push @hashes, make_hash0($body,$header);
push @hashes, make_hash1($body) if (($body =~ /(?:[\s\t].+?){20}/ ) && ($body =~ /\n.*?\n/));
push @hashes, make_hash2($body) if ($body =~ /(?:(?:(?:[<>\(\)\|@\*'!?,]){3}|(:\/)))/m);
push @hashes, make_hash3($body) if (!@hashes && ($body =~ /\S{4}.*\S{4}/));
return 0 unless (@hashes);
return 0 unless (sql_connect_sa());
my $ok = add_hashes($ft,@hashes);
sql_disconnect_sa();
return 0 unless ($ok);
return scalar @hashes;
}
sub handle_message {
my ($spam,$mf,$id,$ft) = @_;
return (1,1,0) if ($noreport && $nosend && $nosave && $noparse);
my $notreport = $noreport;
my $notcount = $spam ? $noreport : 1;
my $notsend = ($nosend || $ft =~ /tra?p/i);
my $notchange = ($nochange || $ft =~ /tra?p/i);
my $notparse = ($noparse || (!$maxage && $ft =~ /tra?p/i));
my $notsave = ($nosave || $ft =~ /tra?p/i);
return (1,1,0) if ($notreport && $notsend && $notsave && $notparse && $notcount);
return (0,0,1) unless (open(FI,'<',$mf));
my @hdr = ();
while (my $l = <FI>) {
last if ($l =~ /^[\r\n]*$/s);
$l =~ s/\r\n/\n/s;
$l =~ s/\r/\n/s;
if (@hdr && $l =~ /^\s/) {
$hdr[$#hdr] .= $l;
} else {
push @hdr, $l;
}
}
my @bdy = ();
while (my $l = <FI>) {
$l =~ s/\r\n/\n/s;
$l =~ s/\r/\n/s;
#print "B:$l";
push @bdy, $l;
}
close(FI);
my $rpath = '';
my $hdr1 = '';
my $hdr2 = '';
my $ri;
my @hish = ([]);
my $msgid;
my $ok = 1;
my $ra;
unless ($notparse && $notchange) {
my $rp = -1;
my $rt = 0;
my $fp = -1;
for (my $li=0;$li<@hdr;$li++) {
if ($hdr[$li] =~ /^Received:/i) {
if ($hdr[$li] =~ /^Received:\s+from\s+(\S+\s+\([^\)]*\))\s+by\s+$MyFilterHostNames(\s.*|)$/si) {
$rp = $li;
if ($hdr[$li] =~ /;\s*([^;]*?)(\s*\([^\)]*\))?\s*$/si) {
my $t = str2time($1);
$rt = $t if ($t);
}
} else {
pop @hish if (@hish);
}
push @hish, [];
} elsif ($hdr[$li] =~ /^X-Scanned-By:\s+$MyFilterHostNames([,\s].*|)$/si) {
$fp = $li if ($fp < 0);
} elsif ($hdr[$li] =~ /^Return-Path:\s+(.*?)\s*$/si) {
push @{$hish[$#hish]}, $hdr[$li];
$rpath = $1 unless ($rpath);
init_mail($spam,$rpath);
} elsif ($hdr[$li] =~ /^Message-ID:\s*\S+\s*$/i) {
$msgid = $hdr[$li];
push @{$hish[$#hish]}, $hdr[$li];
} elsif ($hdr[$li] =~ /^(X-SMTP-From|Return-Path|Delivered-To|Sent-To|Received-From):/i) {
push @{$hish[$#hish]}, $hdr[$li];
}
}
return (1,0,0) unless (@hdr && ($rp >= 0 || $ft =~ /tra?p/i));
my $now = time();
$rt = $now unless ($rt);
$ra = $now-$rt;
if ($ra>$maxage && !$debugnoage) {
log_msg('Too old: %s',$id);
return (1,0,4);
}
pop @hish if ($#hish > 0);
#for (my $hi=1;$hi<=@hish;$hi++) {
# print "$hi\n";
# for (my $li=1;$li<=@{$hish[$hi-1]};$li++) {
# print "$hi.$li $hish[$hi-1]->[$li-1]\n";
# }
#}
while ($#hish > 0) { shift @hish; }
foreach (my $li=0;$li<@{$hish[0]};$li++) {
if ($hish[0]->[$li] =~ /^X-SMTP-From:\s+\S+\s+<(\S*)>\s+(\S+)\s+\[(\S+)\]\s+\((\S+)\)/si) {
$ri = {addr=>$1,helo=>$2,ip=>$3,rdns=>$4};
} else {
next if ($ft !~ /(auto?|tra?p)/i && $hish[0]->[$li] =~ /^(Return-Path|Delivered-To|Sent-To|Received-From):/i);
$msgid = '' if ($hish[0]->[$li] =~ /^Message-ID:\s*(\S+)\s*$/i);
$hdr1 .= $hish[0]->[$li];
}
}
for (my $li=0;$li<@hdr;$li++) {
next if ($li < $rp);
next if ($hdr[$li] =~ /^X-Antivirus:/i);
next if ($fp > $rp && $hdr[$li] =~ /^(X-Mailer|Thread-Index|X-Redirected|X-Filter-Time|X-Greylist|X-Scanned-By|X-SMTP-From|X-Fortune|X-Exclamation|X-Virus-Scanned-By|X-Spam-Info|X-Spam-Scanned-By|X-Spam-Score):/i);
next if ($ft !~ /(auto?|tra?p)/i && $hdr[$li] =~ /^(Return-Path|Delivered-To|Sent-To|Received-From):/i);
$msgid = '' if ($hdr[$li] =~ /^Message-ID:\s*(\S+)\s*$/i);
$hdr2 .= $hdr[$li];
}
$rpath = "Return-Path: $rpath\n" if ($rpath ne '');
unless ($notparse) {
$notreport = 0 unless ($noreport || ($ra>$learnage && !$debugnoage) || (-s $mf > $SASizeLimit));
$notsend = 0 unless ($nosend || ($ra>$forwardage && !$debugnoage) || !$spam || $ft !~ /spam/i || $ft =~ /(auto?|tra?p)/i);
$notsave = 0 unless ($nosave || ($ra>$forwardage && !$debugnoage) || !$spam || $ft !~ /spam/i || $ft =~ /(auto?|tra?p)/i);
}
}
unless ($notcount) {
$ok = 0 unless (report_message_count($spam,$ft,join('',@bdy),\@hdr));
}
unless ($notreport) {
if ($msgid) {
push @{$hish[0]}, $msgid;
} elsif (!defined($msgid)) {
unshift @{$hish[0]}, sprintf("Message-ID: <%s.%u.%s\@%s>\n",$id,$spam,$ft,$MyFilterHostName);
}
$ok = 0 unless (report_message_sa($spam,$notchange?join('',@hdr,"\n",@bdy):join('',$rpath,$hdr1,$hdr2,"\n",@bdy),$id,$ri));
}
unless ($notsend && $notsave) {
return (0,1,2) unless (open(FO,'>',"$mf.report"));
print FO $notchange ? join('',@hdr,"\n",@bdy) : join('',$rpath,$hdr2,"\n",@bdy);
close(FO);
add_mail($spam,"$mf.report",$ra) unless ($notsend);
save_parsed($SpamParseSpool,"$mf.report",$spam,$ra) unless ($notsave);
unlink("$mf.report");
}
return ($ok,1,3);
}
sub handle_part {
my ($spam,$mf,$id,$ft,$prt,$xm) = @_;
return (1,0,14) if ($prt->is_multipart);
my $rfn = $prt->head ? $prt->head->recommended_filename : '';
my $mine = 0;
$mine = 1 if (!$mine && $prt->effective_type eq 'message/rfc822');
my $fixm = 0;
if (!$mine && $xm =~ /Outlook/ && $prt->effective_type eq 'text/plain' && $rfn =~ /^(?:report|Messagedat)\d+\.txt$/) {
$mine = 1;
$fixm = 1;
}
return (1,0,15) unless ($mine);
my $bh = $prt->bodyhandle;
return (1,0,16) unless ($bh);
my $bio = $bh->open('r');
return (1,0,17) unless ($bio);
my $cl = 0;
if ($fixm) {
my $part = '';
while (my $l = $bio->getline) {
next if ($cl == 0 && $l =~ /^>?From /);
$l =~ s/[\r\n]+//s;
$part .= "$l\n";
$cl ++;
}
$part =~ s/^(.*?\n)\n(Content-Type: \S+(?:;\n\s+\S+)\n\n)/$1$2/s;
return (0,0,13) unless (open(F,'>',"$mf.part"));
print F $part;
close(F);
$part = '';
} else {
return (0,0,13) unless (open(F,'>',"$mf.part"));
my $cl = 0;
while (my $l = $bio->getline) {
next if ($cl == 0 && $l =~ /^>?From /);
$l =~ s/[\r\n]+//s;
print F "$l\n";
$cl ++;
}
close(F);
}
$bio->close();
my ($ok,$dh,$en) = handle_message($spam,"$mf.part",$id,$ft);
unlink("$mf.part");
return ($ok,$dh,$en);
}
sub handle_attaches {
my ($spam,$mf,$id,$ft) = @_;
return (0,0,11) unless (init_mparser());
my $msg = $mparser->parse_open($mf);
unless ($msg) {
clean_parser($mparser);
return (0,0,12);
}
init_mail($spam,$msg->get('Return-Path')) unless ($nosend);
my $ok = 1;
my $dh = 0;
my $en = 0;
my $xm = $msg->get('X-Mailer');
if ($msg->is_multipart) {
foreach my $prt ($msg->parts) {
my ($xdh);
($ok,$xdh,$en) = handle_part($spam,$mf,$id,$ft,$prt,$xm);
$dh += $xdh;
last unless ($ok);
}
} else {
($ok,$dh,$en) = handle_part($spam,$mf,$id,$ft,$msg,$xm);
}
clean_parser($mparser);
return ($ok,$dh,$en);
}
sub handle_report {
my ($spam,$ft,$id,$rf,$df) = @_;
log_msg('Handling: %s %s',$id,$spam?'spam':'ham');
my ($ok,$dh,$en);
if ($ft =~ /(auto?|tra?p)/i) {
($ok,$dh,$en) = handle_message($spam,$rf,$id,$ft);
} else {
($ok,$dh,$en) = handle_attaches($spam,$rf,$id,$ft);
}
unless ($SpamReportSender) {
send_mail() if ($ok);
done_mail();
}
unless ($ok) {
log_msg('Error: %s %u %u %u',$id,$dh,$en);
return 0;
}
if (!$dh) {
log_msg('Unhandled: %s',$id);
} else {
log_msg('Reported: %s %u',$id,$dh);
}
return 1 if ($debug);
unlink($rf) if ($df);
rename($rf,"$rf.done") if (-e $rf);
return 1;
}
sub handle_dir {
my ($spam,$d) = @_;
return unless ($d);
my $now = time();
my @reports = ();
my @olds = ();
return unless (opendir(D,$d));
#init_mail(0,$HamReportSender) if ($HamReportSender);
init_mail(1,$SpamReportSender) if ($SpamReportSender);
while (my $f = readdir(D)) {
next if ($f =~ /^\./);
next unless (-f "$d/$f");
if ($now-(stat(_))[9]>$PurgeSpools) {
push @olds, $f;
next;
}
my $csm = $spam;
my $ft = '';
if ($f =~ /(\.[^\.]*)$/) {
$ft = $1;
if ($ft =~ /spam/i) {
$csm = 1;
} elsif ($ft =~ /ham/i) {
$csm = 0;
} elsif ($ft !~ /(auto?|tra?p|localdelivery)/i) {
$csm = -1;
}
}
next if ($csm < 0);
next if ($nospam && $csm);
next if ($noham && !$csm);
push @reports, {ft=>$ft,fn=>$f,sm=>$csm,id=>file_id($f,$ft)};
}
closedir(D);
unless ($debug) {
foreach my $f (@olds) {
unlink("$d/$f");
}
}
return unless (@reports);
log_msg('Handling: %s',$d);
foreach my $rf (@reports) {
handle_report($rf->{sm},$rf->{ft},$rf->{id},"$d/$rf->{fn}",1);
}
send_mail();
done_mail();
}
sub handle_parsed_dir {
my ($d) = @_;
return unless ($d);
return unless (opendir(D,$d));
my $now = time();
my %al = ();
while (my $f = readdir(D)) {
next unless ($f =~ /([a-z0-9]+)\.prs\.(new|eml|dat|sav)$/i);
my $n = $1;
my $e = $2;
next unless (-f "$d/$f");
$al{$n} = {tl=>$now,th=>0,el=>[]} unless (defined($al{$n}));
push @{$al{$n}->{el}}, $e;
$al{$n}->{fn} = $n;
$al{$n}->{lc($e)} = 1;
$al{$n}->{th} = (stat(_))[9] unless ($al{$n}->{th} >= (stat(_))[9]);
$al{$n}->{tl} = (stat(_))[9] unless ($al{$n}->{tl} <= (stat(_))[9]);
}
closedir(D);
return 0 unless (%al);
my @nl = ();
foreach my $f (values %al) {
$f->{old} = $debugnoage ? 0 : ($now - $f->{th} > $maxage) ? 1 : 0;
unless ($f->{old}) {
if ($f->{dat} && $f->{eml} && $f->{new}) {
unless ($f->{sav}) {
if (open(F,'>',"$d/$f->{fn}.prs.sav")) { close(F); }
}
push @nl, $f;
}
next;
}
log_msg('Purge: %s/%s',$d,$f->{fn});
next if ($debug);
foreach my $e (@{$f->{el}}) {
unlink("$d/$f->{fn}.prs.$e");
}
}
return 0 unless (@nl);
my $cgi = $debug ? new CGI::Pretty : new CGI;
my @tl = ();
my @pl = ();
foreach my $f (@nl) {
log_msg('List: %s/%s',$d,$f->{fn});
my @rl = ();
push @rl, $cgi->td(time2str('%Y-%m-%d %H:%M:%S',$f->{tl}));
push @pl, time2str('%Y-%m-%d %H:%M:%S ',$f->{tl});
if ($SpamParseURL) {
push @rl, $cgi->td($cgi->a({href=>"$SpamParseURL/$f->{fn}"},$f->{fn}));
$pl[$#pl] .= "<$SpamParseURL/$f->{fn}>\n";
} else {
push @rl, $cgi->td($f->{fn});
$pl[$#pl] .= "$f->{fn}\n";
}
push @tl, $cgi->TR({class=>$#tl%2?'odd':'even'},@rl);
}
return 0 unless (@tl);
unshift @tl, $cgi->TR($cgi->th('received'),$cgi->th('id'));
unshift @pl, "\n";
unshift @pl, "New spam ready for reporting\n";
my $mt = $mailto ? $mailto : $AdminAddress;
my $snd = $SpamReportSender ? $SpamReportSender : $AdminAddress;
my $eml = MIME::Entity->build(
From => $snd,
To => $mt,
Subject => 'You have new spam ready for reporting',
Encoding => '-SUGGEST',
Type => 'multipart/alternative',
'X-MDF-Report:' => "($FilterUtilVers) <reported>",
'Message-ID:' => Email::MessageID->new($MyFilterHostName)->format,
'Reply-To:' => $AdminContactAddress ? $AdminContactAddress : $AdminAddress,
);
return 0 unless ($eml);
$eml->attach(
Type => 'text/plain',
Disposition => 'inline',
Encoding => '-SUGGEST',
Data => join('',@pl),
);
$eml->attach(
Type => 'text/html',
Disposition => 'inline',
Encoding => '-SUGGEST',
Data => join('',
$cgi->start_html(-title=>'report spam',-style=>{-verbatim=>css()}),
$cgi->h1('New spam ready for reporting'),
$cgi->table(@tl).
$cgi->end_html),
);
log_msg('Sending: %s -> %s',$snd,$mt);
print "=============================================\n".
"Send mail (reports) from '$snd' to '$mt'\n".
"---------------------------------------------\n".
$eml->as_string.
"=============================================\n" if ($debugprint);
return scalar @nl if ($debug);
my $cmd = "/usr/sbin/sendmail -odd -Ac -oi -f '$snd' -- '$mt'";
unless (open(SM,"|$cmd")) {
log_msg('Error calling sendmail!');
return 0;
}
print SM $eml->as_string;
close(SM);
foreach my $f (@nl) {
foreach my $e (@{$f->{el}}) {
unlink("$d/$f->{fn}.prs.$e") if (lc($e) eq 'new');
}
if (open(F,'>',"$d/$f->{fn}.prs.rep")) { close(F); }
}
return scalar @nl;
}
sub handle_a_dir {
my ($spam,$d) = @_;
return unless ($d);
return unless ($locker->trylock("$d/mdf-mail-reporter"));
if ($spam eq 'P') {
handle_parsed_dir($d);
} else {
handle_dir($spam,$d);
}
$locker->unlock("$d/mdf-mail-reporter");
}
read_cfg_cfg();
read_params();
$nosave = 1 unless ($SpamParseSpool && (-d $SpamParseSpool));
if ($SpamReportSpool eq $HamReportSpool) {
handle_a_dir(-1,$SpamReportSpool);
} else {
handle_a_dir(1,$SpamReportSpool);
handle_a_dir(0,$HamReportSpool);
}
done_mail();
if ($SpamTrapSpool && ($SpamTrapSpool ne $SpamReportSpool) && ($SpamTrapSpool ne $HamReportSpool)) {
handle_a_dir(1,$SpamTrapSpool);
}
done_mail();
unless ($nosave) {
handle_a_dir('P',$SpamParseSpool);
}
done_mail();
$sa->finish_learner() if (defined($sa) && !$spamd);
clean_parser();
(2008-09-12)