#
# MailScanner - SMTP E-Mail Virus Scanner
# Copyright (C) 2002 Julian Field
#
# $Id: MCP.pm 3813 2007-01-22 21:08:44Z sysjkf $
#
# 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; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# The author, Julian Field, can be contacted by email at
# Jules@JulianField.net
# or by paper mail at
# Julian Field
# Dept of Electronics & Computer Science
# University of Southampton
# Southampton
# SO17 1BJ
# United Kingdom
#
package MailScanner::MCP;
use strict 'vars';
use strict 'refs';
no strict 'subs'; # Allow bare words for parameter %'s
#use English; # Needed for $PERL_VERSION to work in all versions of Perl
use POSIX qw(:signal_h); # For Solaris 9 SIG bug workaround
use IO;
# Don't do this any more as SpamAssassin prefers to do it itself
# use AnyDBM_File; # Doing this here keeps SpamAssassin quiet
use vars qw($VERSION $SAspamtest $SABayesLock);
### The package version, both in 1.23 style *and* usable by MakeMaker:
$VERSION = substr q$Revision: 3813 $, 10;
# Attributes are
#
#
my $SAversion;
my($safailures) = 0;
#my($SAspamtest, $SABayesLock);
sub initialise {
my(%settings, $val, $val2, $prefs);
# Can't just do this when sendmail.pl loads, as we are still running as
# root then & spamassassin will get confused when we are later running
# as something else.
# Only do this if we want to use SpamAssassin and therefore have it installed.
# Justin Mason advises only creating 1 Mail::SpamAssassin object, so I do it
# here while we are starting up.
# N.B. SpamAssassin will use home dir defined in ENV{HOME}
# 'if $ENV{HOME} =~ /\//'
# So, set ENV{HOME} to desired directory, or undef it to force it to get home
# using getpwnam of $> (EUID)
# If they don't want MCP Checks at all, or they don't want MCP SA Checks
# then do nothing, else...
unless ((MailScanner::Config::IsSimpleValue('mcpchecks') &&
!MailScanner::Config::Value('mcpchecks')) ||
(MailScanner::Config::IsSimpleValue('mcpusespamassassin') &&
!MailScanner::Config::Value('mcpusespamassassin'))) {
$settings{dont_copy_prefs} = 1; # Removes need for home directory
$prefs = MailScanner::Config::Value('mcpspamassassinprefsfile');
$settings{userprefs_filename} = $prefs if defined $prefs;
$val = MailScanner::Config::Value('debugspamassassin');
$settings{debug} = $val;
# for unusual bayes and auto whitelist database locations
$val = MailScanner::Config::Value('mcpspamassassinuserstatedir');
$settings{userstate_dir} = $val if $val ne "";
$val = MailScanner::Config::Value('mcpspamassassinlocalrulesdir');
$settings{LOCAL_RULES_DIR} = $val if $val ne "";
# Set the local state directory to a bogus value so it is not used
$settings{LOCAL_STATE_DIR} = '/BogusSAStateDir';
$val = MailScanner::Config::Value('mcpspamassassindefaultrulesdir');
$settings{DEF_RULES_DIR} = $val if $val ne "";
$val = MailScanner::Config::Value('mcpspamassassininstallprefix');
# For version 3 onwards, shouldn't cause problems with earlier code
$val2 = MailScanner::Config::Value('spamassassinautowhitelist');
$settings{use_auto_whitelist} = $val2?1:0;
$settings{save_pattern_hits} = 1;
if ($val ne "") {
# for finding rules in the absence of the above settings
$settings{PREFIX} = $val;
# for finding the SpamAssassin libraries
# Use unshift rather than push so that their given location is
# always searched *first* and not last in the include path.
#my $perl_vers = $PERL_VERSION < 5.006 ? $PERL_VERSION
# : sprintf("%vd",$PERL_VERSION);
my $perl_vers = $] < 5.006 ? $] : sprintf("%vd",$^V);
unshift @INC, "$val/lib/perl5/site_perl/$perl_vers";
}
# Now we have the path built, try to find the SpamAssassin modules
MailScanner::Log::DieLog("Message Content Protection SpamAssassin installation could not be found")
unless eval "require Mail::SpamAssassin";
$SAversion = $Mail::SpamAssassin::VERSION + 0.0;
$MailScanner::MCP::SAspamtest = new Mail::SpamAssassin(\%settings);
#print STDERR "MCP: Created SA object $MailScanner::MCP::SAspamtest\n";
#if ($prefs ne "") {
# $MailScanner::MCP::SAspamtest = new Mail::SpamAssassin(
# {'userprefs_filename' => $prefs,
# 'dont_copy_prefs' => 0 });
#} else {
# $MailScanner::MCP::SAspamtest = new Mail::SpamAssassin();
#}
#if (MailScanner::Config::Value('mcpspamassassinautowhitelist')) {
# # JKF 14/6/2002 Enable the auto-whitelisting functionality
# MailScanner::Log::InfoLog("Enabling Message Content Procection SpamAssassin auto-whitelist functionality...");
# if ($SAversion<3) {
# require Mail::SpamAssassin::DBBasedAddrList;
# # create a factory for the persistent address list
# my $addrlistfactory = Mail::SpamAssassin::DBBasedAddrList->new();
# $MailScanner::MCP::SAspamtest->set_persistent_address_list_factory
# ($addrlistfactory);
# }
#}
# If the Bayes database lock file is still present due to the process
# being killed, we must delete it. The difficult bit is finding it.
# Wrap this in an eval for those using old versions of SA which don't
# have the Bayes engine at all.
eval {
my $t = $MailScanner::MCP::SAspamtest;
$MailScanner::MCP::SABayesLock = $t->sed_path($t->{conf}->{bayes_path}) .
'.lock';
};
#print STDERR "Bayes lock is at $MailScanner::MCP::SABayesLock\n";
# JKF 7/1/2002 Commented out due to it causing false positives
# JKF 7/6/2002 Now has a config switch
# JKF 12/6/2002 Remember to read the prefs file
#if (MailScanner::Config::Value('compilespamassassinonce')) {
# Saves me recompiling all the modules every time
# Need to delete lock file now or compile_now may never return
unlink $MailScanner::MCP::SABayesLock;
#$MailScanner::MCP::SAspamtest->compile_now(0);
# Apparently this doesn't do anything after compile_now()
$MailScanner::MCP::SAspamtest->read_scoreonly_config($prefs);
}
}
# Constructor.
sub new {
my $type = shift;
my $this = {};
bless $this, $type;
return $this;
}
# Do the SpamAssassin checks on the passed in message
sub Checks {
my $message = shift;
my($dfhandle);
my($dfilename, $dfile, @WholeMessage, $SAResult, $SAHitList);
my($HighScoring, $SAScore, $maxsize);
# Bail out and fake a miss if too many consecutive SA checks failed
my $maxfailures = MailScanner::Config::Value('mcpmaxspamassassintimeouts');
# If we get maxfailures consecutive timeouts, then disable the
# SpamAssassin RBL checks in an attempt to get it working again.
# If it continues to time out for another maxfailures consecutive
# attempts, then disable it completely.
if ($maxfailures>0) {
if ($safailures>=2*$maxfailures) {
return (0,0,
sprintf(MailScanner::Config::LanguageValue($message,'mcpsadisabled'),
2*$maxfailures), 0);
} elsif ($safailures>$maxfailures) {
$MailScanner::MCP::SAspamtest->{conf}->{skip_rbl_checks} = 1;
} elsif ($safailures==$maxfailures) {
$MailScanner::MCP::SAspamtest->{conf}->{skip_rbl_checks} = 1;
MailScanner::Log::WarnLog("Disabling Message Content Protection SpamAssassin RBL checks");
}
}
#return (0,0,
# sprintf(MailScanner::Config::LanguageValue($message,'sadisabled'),
# $maxfailures), 0)
# if $maxfailures>0 &&
# $safailures>=$maxfailures;
# Also only do this if the message is reasonably small.
# LEOH 26/03/2003 We do not always have dpath file, so we ask to
# the store module the size
# $dsize = (stat($message->{store}{dpath}))[7];
#$dsize = $message->{store}->dsize();
#return (0,0, MailScanner::Config::LanguageValue($message,'satoolarge'), 0)
# if $dsize > MailScanner::Config::Value('maxspamassassinsize');
$maxsize = MailScanner::Config::Value('mcpmaxspamassassinsize');
# Construct the array of lines of the header and body of the message
# JKF 30/1/2002 Don't chop off the line endings. Thanks to Andreas Piper
# for this.
#my $h;
#foreach $h (@{$message->{headers}}) {
# push @WholeMessage, $h . "\n";
#}
my $fromheader = MailScanner::Config::Value('envfromheader', $message);
$fromheader =~ s/:$//;
push(@WholeMessage, $fromheader . ': ' . $message->{from} . "\n")
if $fromheader;
@WholeMessage = $global::MS->{mta}->OriginalMsgHeaders($message, "\n");
#print STDERR "Headers are : " . join(', ', @WholeMessage) . "\n";
return (0,0, MailScanner::Config::LanguageValue($message, 'mcpsanoheaders'), 0)
unless @WholeMessage;
push(@WholeMessage, "\n");
$message->{store}->ReadBody(\@WholeMessage, $maxsize);
#print STDERR "Whole message is this:\n";
#print STDERR "----------------------\n";
#print STDERR @WholeMessage;
#print STDERR "---------------\n";
#print STDERR "End of message.\n";
# Now construct the SpamAssassin object for version < 3
my $spammail;
$spammail = Mail::SpamAssassin::NoMailAudit->new('data'=>\@WholeMessage)
if $SAversion < 3;
#print STDERR "NoMailAudit thinks the message is this:\n";
#print STDERR "---------------------------------------\n";
#print STDERR $spammail->as_string();
#print STDERR "---------------\n";
#print STDERR "End of message.\n";
# Test it for spam-ness
#print STDERR "About to try MCP\n";
if ($SAversion<3) {
($SAResult, $HighScoring, $SAHitList, $SAScore)
= SAForkAndTest($MailScanner::MCP::SAspamtest, $spammail, $message);
} else {
($SAResult, $HighScoring, $SAHitList, $SAScore)
= SAForkAndTest($MailScanner::MCP::SAspamtest, \@WholeMessage, $message);
}
#print STDERR "Done MCP call\n";
#MailScanner::Log::WarnLog("Done SAForkAndTest");
#print STDERR "SAResult = $SAResult\nHighScoring = $HighScoring\n" .
# "SAHitList = $SAHitList\n";
return ($SAResult, $HighScoring, $SAHitList, $SAScore);
}
# Fork and test with SpamAssassin. This implements a timeout on the execution
# of the SpamAssassin checks, which occasionally take a *very* long time to
# terminate due to regular expression backtracking and other nasties.
sub SAForkAndTest {
my($Test, $Mail, $Message) = @_;
my($pipe);
my($SAHitList, $SAHits, $SAReqHits, $IsItSpam, $IsItHighScore);
my($HighScoreVal, $pid2delete, $IncludeScores);
my $PipeReturn = 0;
my $Error = 0;
$IncludeScores = MailScanner::Config::Value('mcplistsascores', $Message);
$pipe = new IO::Pipe
or MailScanner::Log::DieLog('Failed to create pipe, %s, try reducing ' .
'the maximum number of unscanned messages per batch', $!);
#$readerfh = new FileHandle;
#$writerfh = new FileHandle;
#($readerfh, $writerfh) = FileHandle::pipe;
my $pid = fork();
die "Can't fork: $!" unless defined($pid);
if ($pid == 0) {
# In the child
my($spamness, $SAResult, $HitList, @HitNames, $Hit);
$pipe->writer();
#close($readerfh);
#POSIX::setsid();
#select($writerfh);
#$| = 1; # Line buffering, not block buffering
$pipe->autoflush();
# Do the actual tests and work out the integer result
if ($SAversion < 3) {
$spamness = $Test->check($Mail);
} else {
my $mail = $Test->parse($Mail, 1);
$spamness = $Test->check($mail);
}
print $pipe ($SAversion<3?$spamness->get_hits():$spamness->get_score())
. "\n";
$HitList = $spamness->get_names_of_tests_hit();
if ($IncludeScores) {
@HitNames = split(/\s*,\s*/, $HitList);
$HitList = "";
foreach $Hit (@HitNames) {
$HitList .= ($HitList?', ':'') . $Hit . ' ' .
sprintf("%1.2f", $spamness->{conf}->{scores}->{$Hit});
}
}
print $pipe $HitList . "\n";
$spamness->finish();
$pipe->close();
$pipe = undef;
exit 0; # $SAResult;
}
eval {
$pipe->reader();
local $SIG{ALRM} = sub { die "Command Timed Out" };
alarm MailScanner::Config::Value('mcpspamassassintimeout');
$SAHits = <$pipe>;
#print STDERR "Read SAHits = $SAHits " . scalar(localtime) . "\n";
$SAHitList = <$pipe>;
#print STDERR "Read SAHitList = $SAHitList " . scalar(localtime) . "\n";
# Not sure if next 2 lines should be this way round...
waitpid $pid, 0;
$pipe->close();
$PipeReturn = $?;
alarm 0;
$pid = 0;
chomp $SAHits;
chomp $SAHitList;
$SAHits = $SAHits + 0.0;
$safailures = 0; # This was successful so zero counter
};
alarm 0;
# Workaround for bug in perl shipped with Solaris 9,
# it doesn't unblock the SIGALRM after handling it.
eval {
my $unblockset = POSIX::SigSet->new(SIGALRM);
sigprocmask(SIG_UNBLOCK, $unblockset)
or die "Could not unblock alarm: $!\n";
};
# Construct the hit-list including the score we got.
$SAReqHits = MailScanner::Config::Value('mcpreqspamassassinscore',$Message)+0.0;
$SAHitList = MailScanner::Config::LanguageValue($Message, 'score') . '=' .
($SAHits+0.0) . ', ' .
MailScanner::Config::LanguageValue($Message, 'required') .' ' .
$SAReqHits . ($SAHitList?", $SAHitList":'');
# Note to self: I only close the KID in the parent, not in the child.
# Catch failures other than the alarm
if ($@ and $@ !~ /Command Timed Out/) {
MailScanner::Log::DieLog("Message Content Protection SpamAssassin failed with real error: $@");
$Error = 1;
}
# In which case any failures must be the alarm
#if ($@ or $pid>0) {
if ($pid>0) {
$pid2delete = $pid;
my $maxfailures = MailScanner::Config::Value('mcpmaxspamassassintimeouts');
# Increment the "consecutive" counter
$safailures++;
if ($maxfailures>0) {
if ($safailures>$maxfailures) {
MailScanner::Log::WarnLog("Message Content Protection SpamAssassin timed out (with no RBL" .
" checks) and was killed, consecutive failure " .
$safailures . " of " . $maxfailures*2);
} else {
MailScanner::Log::WarnLog("Message Content Protection SpamAssassin timed out and was killed, " .
"consecutive failure " . $safailures .
" of " . $maxfailures);
}
} else {
MailScanner::Log::WarnLog("Message Content Protection SpamAssassin timed out and was killed");
}
# Make the report say SA was killed
$SAHitList = MailScanner::Config::LanguageValue($Message, 'mcpsatimedout');
$SAHits = 0;
$Error = 1;
# Kill the running child process
my($i);
kill -15, $pid;
# Wait for up to 10 seconds for it to die
for ($i=0; $i<5; $i++) {
sleep 1;
waitpid($pid, &POSIX::WNOHANG);
($pid=0),last unless kill(0, $pid);
kill -15, $pid;
}
# And if it didn't respond to 11 nice kills, we kill -9 it
if ($pid) {
kill -9, $pid;
waitpid $pid, 0; # 2.53
}
# As the child process must now be dead, remove the Bayes database
# lock file if it exists. Only delete the lock file if it mentions
# $pid2delete in its contents.
if ($pid2delete && $MailScanner::MCP::SABayesLock) {
my $lockfh = new FileHandle;
if ($lockfh->open($MailScanner::MCP::SABayesLock)) {
my $line = $lockfh->getline();
chomp $line;
$line =~ /(\d+)$/;
my $pidinlock = $1;
if ($pidinlock =~ /$pid2delete/) {
unlink $MailScanner::MCP::SABayesLock;
MailScanner::Log::InfoLog("Delete bayes lockfile for %s",$pid2delete);
}
$lockfh->close();
}
}
#unlink $MailScanner::MCP::SABayesLock if $MailScanner::MCP::SABayesLock;
}
#MailScanner::Log::WarnLog("8 PID is $pid");
# The return from the pipe is a measure of how spammy it was
MailScanner::Log::DebugLog("Message Content Protection SpamAssassin returned $PipeReturn");
# SpamAssassin is known to play with the umask
umask 0077; # Safety net
# Handle the case when there was an error
if ($Error) {
MailScanner::Log::DebugLog("Message Content Protection SpamAssassin check failed");
$SAHits = MailScanner::Config::Value('mcperrorscore',$Message);
}
#$PipeReturn = $PipeReturn>>8;
$IsItSpam = ($SAHits && $SAHits>=$SAReqHits)?1:0;
$HighScoreVal = MailScanner::Config::Value('mcphighspamassassinscore',$Message);
$IsItHighScore = ($SAHits && $HighScoreVal>0 && $SAHits>=$HighScoreVal)?1:0;
return ($IsItSpam, $IsItHighScore, $SAHitList, $SAHits);
}
1;
syntax highlighted by Code2HTML, v. 0.9.1