1# 2# MailScanner - SMTP Email Processor 3# Copyright (C) 2002 Julian Field 4# 5# $Id: SA.pm 5090 2011-03-23 17:50:47Z sysjkf $ 6# 7# This program is free software; you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation; either version 2 of the License, or 10# (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this program; if not, write to the Free Software 19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20# 21# https://www.mailscanner.info 22# 23 24package MailScanner::SA; 25 26use strict 'vars'; 27use strict 'refs'; 28no strict 'subs'; # Allow bare words for parameter %'s 29#use English; # Needed for $PERL_VERSION to work in all versions of Perl 30 31use IO::Pipe; 32use POSIX qw(:signal_h); # For Solaris 9 SIG bug workaround 33use DBI; 34use Compress::Zlib; 35 36use vars qw($VERSION); 37 38### The package version, both in 1.23 style *and* usable by MakeMaker: 39$VERSION = substr q$Revision: 5090 $, 10; 40 41# Attributes are 42# 43# 44 45my($LOCK_SH) = 1; 46my($LOCK_EX) = 2; 47my($LOCK_NB) = 4; 48my($LOCK_UN) = 8; 49 50my $SAversion; # SpamAssassin version number 51my @SAsuccessqueue; # queue of failure history 52my $SAsuccessqsum; # current sum of history queue 53 54my($SAspamtest, $SABayesLock, $SABayesRebuildLock, $SpamAssassinInstalled); 55 56my($SQLiteInstalled, $cachedbh, $cachefilename, $NextCacheExpire); 57 58my $HamCacheLife = 30*60; # Lifetime of non-spam from first seen 59my $SpamCacheLife = 5*60; # Lifetime of low-scoring spam from first seen 60my $HighSpamCacheLife = 3*60*60; # Lifetime of high spam from last seen 61my $VirusesCacheLife = 48*60*60; # Lifetime of viruses from last seen 62my $ExpireFrequency = 10*60; # How often to run the expiry of the cache 63 64sub CreateTempDir { 65 my($runasuser,$satmpdir) = @_; 66 67 # Create the $TMPDIR for SpamAssassin if necessary, then check we can 68 # write to it. If not, change to /tmp. 69 lstat $satmpdir; 70 unless (-d _) { 71 unlink $satmpdir; 72 mkdir $satmpdir or warn "Could not create SpamAssassin temporary directory $satmpdir, $!"; 73 } 74 chmod 0755, $satmpdir unless $satmpdir =~ /^\/tmp/; 75 chown $runasuser, -1, $satmpdir; 76 77 $ENV{'TMPDIR'} = $satmpdir; 78} 79 80sub initialise { 81 my($RebuildBayes, $WantLintOnly) = @_; # Start by rebuilding the Bayes database? 82 83 my(%settings, $val, $val2, $prefs); 84 85 # Initialise the class variables 86 @SAsuccessqueue = (); 87 $SAsuccessqsum = 0; 88 89 # If the "debug-sa" command-line flag was given, then we want to print out 90 # the current time at the start of each line that is sent to STDERR, 91 # in particular the stuff from SpamAssassin. 92 if ($MailScanner::SA::Debug) { 93 my $result; 94 # Do a trial run of awk to see if it is going to work on this system. 95 eval { 96 $result = `echo 'Hello,World' | awk '{printf \"%s %s\\n\", strftime(\"%T\"), \$0}' 2>&1`; 97 #print "Result is \"$result\"\n"; 98 }; 99 #print "Eval result = \"$@\"\n"; 100 101 # If the trial worked... 102 if ($result =~ /\d+:\d.*Hello,World/) { 103 #print STDERR "It Succeeded!\n"; 104 #select STDERR; $| = 1; 105 # Re-open STDERR with the current time stuck on the front of each line. 106 # It should work okay as we have just tried it out. 107 open STDERR, "| awk '{printf \"%s %s\\n\", strftime(\"%T\"), \$0}'"; 108 select STDOUT; 109 } else { 110 print STDERR "\n\n*****\n"; 111 print STDERR "If 'awk' (with support for the function strftime) was\n"; 112 print STDERR "available on your \$PATH then all the SpamAssassin debug\n"; 113 print STDERR "output would have the current time added to the start of\n"; 114 print STDERR "every line, making debugging far easier.\n*****\n\n"; 115 } 116 } 117 118 # Can't just do this when sendmail.pl loads, as we are still running as 119 # root then & spamassassin will get confused when we are later running 120 # as something else. 121 122 # Only do this if we want to use SpamAssassin and therefore have it installed. 123 # Justin Mason advises only creating 1 Mail::SpamAssassin object, so I do it 124 # here while we are starting up. 125 126 # N.B. SpamAssassin will use home dir defined in ENV{HOME} 127 # 'if $ENV{HOME} =~ /\//' 128 # So, set ENV{HOME} to desired directory, or undef it to force it to get home 129 # using getpwnam of $> (EUID) 130 131 unless (MailScanner::Config::IsSimpleValue('usespamassassin') && 132 !MailScanner::Config::Value('usespamassassin')) { 133 $settings{post_config_text} = MailScanner::ConfigSQL::ReturnSpamAssassinConfig(); 134 $settings{dont_copy_prefs} = 1; # Removes need for home directory 135 # This file is now read directly by SpamAssassin's normal startup code. 136 #$prefs = MailScanner::Config::Value('spamassassinprefsfile'); 137 #$settings{userprefs_filename} = $prefs if defined $prefs; 138 $val = $MailScanner::SA::Debug; 139 $settings{debug} = $val; 140 # for unusual bayes and auto whitelist database locations 141 $val = MailScanner::Config::Value('spamassassinuserstatedir'); 142 $settings{userstate_dir} = $val if $val ne ""; 143 $val = MailScanner::Config::Value('spamassassinlocalrulesdir'); 144 $settings{LOCAL_RULES_DIR} = $val if $val ne ""; 145 $val = MailScanner::Config::Value('spamassassinlocalstatedir'); 146 $settings{LOCAL_STATE_DIR} = $val if $val ne ""; 147 $val = MailScanner::Config::Value('spamassassindefaultrulesdir'); 148 $settings{DEF_RULES_DIR} = $val if $val ne ""; 149 $val = MailScanner::Config::Value('spamassassininstallprefix'); 150 151 # For version 3 onwards, shouldn't cause problems with earlier code 152 $val2 = MailScanner::Config::Value('spamassassinautowhitelist'); 153 $settings{use_auto_whitelist} = $val2?1:0; 154 $settings{save_pattern_hits} = 1; 155 156 if ($val ne "") { # ie. if SAinstallprefix is set 157 # for finding rules in the absence of the above settings 158 $settings{PREFIX} = $val; 159 # for finding the SpamAssassin libraries 160 # Use unshift rather than push so that their given location is 161 # always searched *first* and not last in the include path. 162 #my $perl_vers = $PERL_VERSION < 5.006 ? $PERL_VERSION 163 # : sprintf("%vd",$PERL_VERSION); 164 my $perl_vers = $] < 5.006 ? $] : sprintf("%vd",$^V); 165 unshift @INC, "$val/lib/perl5/site_perl/$perl_vers"; 166 } 167 # Now we have the path built, try to find the SpamAssassin modules 168 my $required_sa_class = 'Mail::SpamAssassin'; 169 unless (eval "require $required_sa_class") { 170 MailScanner::Log::WarnLog("You want to use SpamAssassin but have not installed it."); 171 MailScanner::Log::WarnLog("I will run without SpamAssassin for now, you will not detect much spam until you install SpamAssassin."); 172 $SpamAssassinInstalled = 0; 173 return; 174 } 175 176 # SpamAssassin "require"d okay. 177 $SpamAssassinInstalled = 1; 178 179 # Find the version number 180 $SAversion = $Mail::SpamAssassin::VERSION + 0.0; 181 182 # 183 # Load the SQLite support for the SA data cache 184 # 185 $SQLiteInstalled = 0; 186 unless (MailScanner::Config::IsSimpleValue('usesacache') && 187 !MailScanner::Config::Value('usesacache')) { 188 unless (eval "require DBD::SQLite") { 189 MailScanner::Log::WarnLog("WARNING: You are trying to use the SpamAssassin cache but your DBI and/or DBD::SQLite Perl modules are not properly installed!"); 190 $SQLiteInstalled = 0; 191 } else { 192 $SQLiteInstalled = 1; 193 unless (eval "require Digest::MD5") { 194 MailScanner::Log::WarnLog("WARNING: You are trying to use the SpamAssassin cache but your Digest::MD5 Perl module is not properly installed!"); 195 $SQLiteInstalled = 0; 196 } else { 197 MailScanner::Log::InfoLog("Using SpamAssassin results cache"); 198 $SQLiteInstalled = 1; 199 # 200 # 201 # Put the SA cache database initialisation code here! 202 # 203 # 204 $MailScanner::SA::cachefilename = MailScanner::Config::Value("sacache"); 205 $MailScanner::SA::cachedbh = DBI->connect( 206 "dbi:SQLite:$MailScanner::SA::cachefilename", 207 "","",{PrintError=>0,InactiveDestroy=>1}); 208 $NextCacheExpire = $ExpireFrequency+time; 209 if ($MailScanner::SA::cachedbh) { 210 MailScanner::Log::InfoLog("Connected to SpamAssassin cache database"); 211 # Rebuild all the tables and indexes. The PrintError=>0 will make it 212 # fail quietly if they already exist. 213 # Speed up writes at the cost of database integrity. Only tmp data! 214 $MailScanner::SA::cachedbh->do("PRAGMA default_synchronous = OFF"); 215 $MailScanner::SA::cachedbh->do("CREATE TABLE cache (md5 TEXT, count INTEGER, last TIMESTAMP, first TIMESTAMP, sasaysspam INT, sahighscoring INT, sascore FLOAT, saheader BLOB, salongreport BLOB, virusinfected INT)"); 216 $MailScanner::SA::cachedbh->do("CREATE UNIQUE INDEX md5_uniq ON cache(md5)"); 217 $MailScanner::SA::cachedbh->do("CREATE INDEX last_seen_idx ON cache(last)"); 218 $MailScanner::SA::cachedbh->do("CREATE INDEX first_seen_idx ON cache(first)"); 219 #my $sacDB = MailScanner::Config::Value("sacache"); 220 #chmod 0660, $sacDB; 221 $SQLiteInstalled = 1; 222 SetCacheTimes(); 223 # Now expire all the old tokens 224 CacheExpire() unless $WantLintOnly; 225 } else { 226 MailScanner::Log::WarnLog("Could not create SpamAssassin cache database %s", $MailScanner::SA::cachefilename); 227 $SQLiteInstalled = 0; 228 print STDERR "Could not create SpamAssassin cache database $MailScanner::SA::cachefilename\n" if $WantLintOnly; 229 } 230 } 231 } 232 } 233 234 $MailScanner::SA::SAspamtest = new Mail::SpamAssassin(\%settings); 235 236 if ($WantLintOnly) { 237 my $errors = $MailScanner::SA::SAspamtest->lint_rules(); 238 if ($errors) { 239 print STDERR "SpamAssassin reported an error.\n"; 240 $MailScanner::SA::SAspamtest->debug_diagnostics(); 241 } else { 242 print STDERR "SpamAssassin reported no errors.\n"; 243 } 244 return; 245 } 246 247 # Rebuild the Bayes database if it is due 248 $MailScanner::SA::BayesRebuildLock = MailScanner::Config::Value( 249 'lockfiledir') . '/MS.bayes.rebuild.lock'; 250 $MailScanner::SA::BayesRebuildStartLock = 251 MailScanner::Config::Value('lockfiledir') . '/MS.bayes.starting.lock'; 252 $MailScanner::SA::WaitForRebuild = MailScanner::Config::Value('bayeswait'); 253 $MailScanner::SA::DoingBayesRebuilds = MailScanner::Config::Value('bayesrebuild'); 254 if ($RebuildBayes) { 255 #MailScanner::Log::InfoLog('SpamAssassin Bayes database rebuild preparing'); 256 # Tell the other children that we are trying to start a rebuild 257 my $RebuildStartH = new FileHandle; 258 unless ($RebuildStartH->open("+>$MailScanner::SA::BayesRebuildStartLock")) { 259 MailScanner::Log::WarnLog("Bayes rebuild process could not write to " . 260 "%s to signal starting", 261 $MailScanner::SA::BayesRebuildStartLock); 262 } 263 # 20090107 Get exclusive lock on the startlock 264 #flock($RebuildStartH, $LOCK_EX); 265 flock($RebuildStartH, $LOCK_EX); 266 $RebuildStartH->seek(0,0); 267 $RebuildStartH->autoflush(); 268 print $RebuildStartH "1\n"; 269 flock($RebuildStartH, $LOCK_UN); 270 $RebuildStartH->close(); 271 272 # Get an exclusive lock on the bayes rebuild lock file 273 my $RebuildLockH = new FileHandle; 274 if ($RebuildLockH->open("+>$MailScanner::SA::BayesRebuildLock")) { 275 flock($RebuildLockH, $LOCK_EX) 276 or MailScanner::Log::WarnLog("Failed to get exclusive lock on %s, %s", 277 $MailScanner::SA::BayesRebuildLock, $!); 278 279 # Do the actual expiry run 280 $0 = 'MailScanner: rebuilding Bayes database'; 281 MailScanner::Log::InfoLog('SpamAssassin Bayes database rebuild starting'); 282 eval { 283 $MailScanner::SA::SAspamtest->init(1) if $SAversion<3; 284 $MailScanner::SA::SAspamtest->init_learner({ 285 force_expire => 1, 286 learn_to_journal => 0, 287 wait_for_lock => 1, 288 caller_will_untie => 1}); 289 $MailScanner::SA::SAspamtest->rebuild_learner_caches({ 290 verbose => 0, 291 showdots => 0}); 292 $MailScanner::SA::SAspamtest->finish_learner(); 293 }; 294 MailScanner::Log::WarnLog("SpamAssassin Bayes database rebuild " . 295 "failed with error: %s", $@) 296 if $@; 297 298 # Unlock the "starting" lock 299 $RebuildStartH = new FileHandle; 300 $RebuildStartH->open("+>$MailScanner::SA::BayesRebuildStartLock"); 301 flock($RebuildStartH, $LOCK_EX); 302 $RebuildStartH->seek(0,0); 303 $RebuildStartH->autoflush(); 304 print $RebuildStartH "0\n"; 305 flock($RebuildStartH, $LOCK_UN); 306 $RebuildStartH->close(); 307 # Unlock the bayes rebuild lock file 308 #20090107 unlink($MailScanner::SA::BayesRebuildLock); 309 flock($RebuildLockH, $LOCK_UN); 310 $RebuildLockH->close(); 311 MailScanner::Log::InfoLog('SpamAssassin Bayes database rebuild completed'); 312 } 313 314 # Now the rebuild has properly finished, we let the other children back 315 #20090107 unlink $MailScanner::SA::BayesRebuildStartLock; 316 $RebuildStartH->close(); 317 } 318 319 if (MailScanner::Config::Value('spamassassinautowhitelist')) { 320 # JKF 14/6/2002 Enable the auto-whitelisting functionality 321 MailScanner::Log::InfoLog("Enabling SpamAssassin auto-whitelist functionality..."); 322 if ($SAversion<3) { 323 require Mail::SpamAssassin::DBBasedAddrList; 324 # create a factory for the persistent address list 325 my $addrlistfactory = Mail::SpamAssassin::DBBasedAddrList->new(); 326 $MailScanner::SA::SAspamtest->set_persistent_address_list_factory 327 ($addrlistfactory); 328 } 329 } 330 331 # If the Bayes database lock file is still present due to the process 332 # being killed, we must delete it. The difficult bit is finding it. 333 # Wrap this in an eval for those using old versions of SA which don't 334 # have the Bayes engine at all. 335 eval { 336 my $t = $MailScanner::SA::SAspamtest; 337 $MailScanner::SA::SABayesLock = $t->sed_path($t->{conf}->{bayes_path}) . 338 '.lock'; 339 #print STDERR "SA bayes lock is $MailScanner::SA::SABayesLock\n"; 340 }; 341 342 #print STDERR "Bayes lock is at $MailScanner::SA::SABayesLock\n"; 343 # JKF 7/1/2002 Commented out due to it causing false positives 344 # JKF 7/6/2002 Now has a config switch 345 # JKF 12/6/2002 Remember to read the prefs file 346 #if (MailScanner::Config::Value('compilespamassassinonce')) { 347 # Saves me recompiling all the modules every time 348 349 # Need to delete lock file now or compile_now may never return 350 unlink $MailScanner::SA::SABayesLock; 351 352 # If they are using MCP at all, then we need to compile SA differently 353 # here due to object clashes within SA. 354 if (MailScanner::Config::IsSimpleValue('mcpchecks') && 355 !MailScanner::Config::Value('mcpchecks')) { 356 # They are definitely not using MCP 357 $MailScanner::SA::SAspamtest->compile_now(); 358 } else { 359 # They are possibly using MCP somewhere 360 # Next line should have a 0 parameter in it 361 #$MailScanner::SA::SAspamtest->compile_now(0); 362 $MailScanner::SA::SAspamtest->read_scoreonly_config($prefs); 363 } 364 #print STDERR "In initialise, spam report is \"" . 365 # $MailScanner::SA::SAspamtest->{conf}->{report_template} . "\"\n"; 366 #JKF$MailScanner::SA::SAspamtest->compile_now(); 367 368 # Apparently this doesn't do anything after compile_now() 369 #$MailScanner::SA::SAspamtest->read_scoreonly_config($prefs); 370 } 371 372 # Turn off warnings again, as SpamAssassin switches them on 373 $^W = 0; 374} 375 376# Set all the cache expiry timings from the cachetiming conf option 377sub SetCacheTimes { 378 my $line = MailScanner::Config::Value('cachetiming'); 379 $line =~ s/^\D+//; 380 return unless $line; 381 my @numbers = split /\D+/, $line; 382 return unless @numbers; 383 384 $HamCacheLife = $numbers[0] if $numbers[0]; 385 $SpamCacheLife = $numbers[1] if $numbers[1]; 386 $HighSpamCacheLife = $numbers[2] if $numbers[2]; 387 $VirusesCacheLife = $numbers[3] if $numbers[3]; 388 $ExpireFrequency = $numbers[4] if $numbers[4]; 389 390 #print STDERR "Timings are \"" . join(' ',@numbers) . "\"\n"; 391} 392 393 394# Constructor. 395sub new { 396 my $type = shift; 397 my $this = {}; 398 399 bless $this, $type; 400 return $this; 401} 402 403# Do the SpamAssassin checks on the passed in message 404sub Checks { 405 my $message = shift; 406 407 # If they never actually installed SpamAssassin, then just bail out quietly. 408 return (0,0,"",0,"") unless $SpamAssassinInstalled; 409 410 my($dfhandle, $SAReqHits, $HighScoreVal); 411 my($dfilename, $dfile, @WholeMessage, $SAResult, $SAHitList); 412 my($HighScoring, $SAScore, $maxsize, $SAReport, $GSHits); 413 my $GotFromCache = undef; # Did the result come from the cache? 414 $SAReqHits = MailScanner::Config::Value('reqspamassassinscore',$message)+0.0; 415 $HighScoreVal = MailScanner::Config::Value('highspamassassinscore',$message); 416 $GSHits = $message->{gshits} || 0.0; 417 418 # Bail out and fake a miss if too many consecutive SA checks failed 419 my $maxfailures = MailScanner::Config::Value('maxspamassassintimeouts'); 420 421 # If we get maxfailures consecutive timeouts, then disable the 422 # SpamAssassin RBL checks in an attempt to get it working again. 423 # If it continues to time out for another maxfailures consecutive 424 # attempts, then disable it completely. 425 if ($maxfailures>0) { 426 if ($SAsuccessqsum>=2*$maxfailures) { 427 return (0,0, 428 sprintf(MailScanner::Config::LanguageValue($message,'sadisabled'), 429 2*$maxfailures), 0); 430 } elsif ($SAsuccessqsum>$maxfailures) { 431 $MailScanner::SA::SAspamtest->{conf}->{local_tests_only} = 1; 432 } elsif ($SAsuccessqsum==$maxfailures) { 433 $MailScanner::SA::SAspamtest->{conf}->{local_tests_only} = 1; 434 MailScanner::Log::WarnLog("Disabling SpamAssassin network checks"); 435 } 436 } 437 438 # If the Bayes rebuild is in progress, then either wait for it to 439 # complete, or just bail out as we are busy. 440 # Get a shared lock on the bayes rebuild lock file. 441 # If we don't want to wait for it, then do a non-blocking call and 442 # just return if it couldn't be locked. 443 my $BayesIsLocked = 0; 444 my($RebuildLockH, $Lockopen); 445 if ($MailScanner::SA::DoingBayesRebuilds) { 446 # If the lock file exists at all, do not try to get a lock on it. 447 # Shared locks are handed out even when someone else is trying to 448 # get an exclusive lock, so long as at least 1 other shared lock 449 # already exists. 450 #20090107 if (-e $MailScanner::SA::BayesRebuildStartLock) { 451 my $fh = new FileHandle; 452 $fh->open("+<" . $MailScanner::SA::BayesRebuildStartLock); 453 flock($fh, $LOCK_EX); 454 $fh->seek(0,0); 455 my $line = <$fh>; 456 flock($fh, $LOCK_UN); 457 $fh->close(); 458 459 if ($line =~ /1/) { 460 # Do we wait for Bayes rebuild to occur? 461 if ($MailScanner::SA::WaitForRebuild) { 462 $0 = 'MailScanner: waiting for Bayes rebuild'; 463 # Wait quietly for the file to disappear 464 # This must not take more than 1 hour or we are in trouble! 465 #MailScanner::Log::WarnLog("Waiting for rebuild start request to disappear"); 466 my $waiter = 0; 467 for ($waiter = 0; $waiter<3600 && $line =~ /1/; $waiter+=30) { 468 #-e $MailScanner::SA::BayesRebuildStartLock; $waiter+=10) { 469 sleep 30; 470 $fh = new FileHandle; 471 $fh->open("+<" . $MailScanner::SA::BayesRebuildStartLock); 472 flock($fh, $LOCK_EX); 473 $fh->seek(0,0); 474 $line = <$fh>; 475 flock($fh, $LOCK_UN); 476 $fh->close(); 477 #MailScanner::Log::WarnLog("Waiting for start request to disappear"); 478 } 479 # Did it take too long? 480 #unlink $MailScanner::SA::BayesRebuildStartLock if $waiter>=3590; 481 if ($waiter>=4000) { 482 $fh = new FileHandle; 483 $fh->open("+>" . $MailScanner::SA::BayesRebuildStartLock); 484 flock($fh, $LOCK_EX); 485 $fh->seek(0,0); 486 $fh->autoflush(); 487 print $fh "0\n"; 488 flock($fh, $LOCK_UN); 489 $fh->close(); 490 } 491 #MailScanner::Log::WarnLog("Start request has disappeared"); 492 $0 = 'MailScanner: checking with SpamAssassin'; 493 } else { 494 # Return saying we are skipping SpamAssassin this time 495 return (0,0, 'SpamAssassin rebuilding', 0); 496 } 497 } 498 499 $Lockopen = 0; 500 $RebuildLockH = new FileHandle; 501 502 if (open($RebuildLockH, "+>" . $MailScanner::SA::BayesRebuildLock)) { 503 print $RebuildLockH "SpamAssassin Bayes database locked for use by " . 504 "MailScanner $$\n"; 505 #MailScanner::Log::InfoLog("Bayes lock is $RebuildLockH"); 506 #MailScanner::Log::InfoLog("Bayes lock is read-write"); 507 $Lockopen = 1; 508 #The lock file already exists, so just open for reading 509 } elsif (open($RebuildLockH, $MailScanner::SA::BayesRebuildLock)) { 510 #MailScanner::Log::InfoLog("Bayes lock is $RebuildLockH"); 511 #MailScanner::Log::InfoLog("Bayes lock is read-only"); 512 $Lockopen = 1; 513 } else { 514 # Could not open the file at all 515 $Lockopen = 0; 516 MailScanner::Log::WarnLog("Could not open Bayes rebuild lock file %s, %s", 517 $MailScanner::SA::BayesRebuildLock, $!); 518 } 519 520 if ($Lockopen) { 521 #MailScanner::Log::InfoLog("Bayes lock is open"); 522 if ($MailScanner::SA::WaitForRebuild) { 523 # Do a normal lock and wait for it 524 flock($RebuildLockH, $LOCK_SH) or 525 MailScanner::Log::WarnLog("At start of SA checks could not get " . 526 "shared lock on %s, %s", $MailScanner::SA::BayesRebuildLock, $!); 527 $BayesIsLocked = 1; 528 } else { 529 #MailScanner::Log::InfoLog("Bayes lock2 is %s", $RebuildLockH); 530 if (flock($RebuildLockH, ($LOCK_SH | $LOCK_NB))) { 531 #MailScanner::Log::InfoLog("Got non-blocking shared lock on Bayes lock"); 532 $BayesIsLocked = 1; 533 } else { 534 #MailScanner::Log::InfoLog("Skipping Bayes due to %s", $!); 535 $RebuildLockH->close(); 536 #MailScanner::Log::InfoLog("Skipping SpamAssassin while waiting for Bayes database to rebuild"); 537 return (0,0, 'SpamAssassin rebuilding', 0); 538 } 539 } 540 } else { 541 MailScanner::Log::WarnLog("At start of SA checks could not open %s, %s", 542 $MailScanner::SA::BayesRebuildLock, $!); 543 } 544 } 545 546 $maxsize = MailScanner::Config::Value('maxspamassassinsize'); 547 548 # Construct the array of lines of the header and body of the message 549 # JKF 30/1/2002 Don't chop off the line endings. Thanks to Andreas Piper 550 # for this. 551 # For SpamAssassin 3 we add the "EnvelopeFrom" header to make SPF work 552 my $fromheader = MailScanner::Config::Value('envfromheader', $message); 553 $fromheader =~ s/:$//; 554 555 # Build a list of all the headers, so we can remove any $fromheader that 556 # is already in there. 557 my @SAheaders = $global::MS->{mta}->OriginalMsgHeaders($message, "\n"); 558 @SAheaders = grep !/^$fromheader\:/i, @SAheaders; 559 @SAheaders = grep !/^\s*$/, @SAheaders; # ditch blank lines 560 561 # Fix for RP_8BIT rule issue by Steve Freegard 562 #push(@WholeMessage, $fromheader . ': ' . $message->{from} . "\n") 563 unshift(@SAheaders, $fromheader . ': ' . $message->{from} . "\n") 564 if $fromheader; 565 566 # Add the spamvirusreport to the input to SA. 567 # The header name should be documented in the MailScanner.conf docs. 568 my $svheader = MailScanner::Config::Value('spamvirusheader', $message); 569 if ($svheader && $message->{spamvirusreport}) { 570 $svheader =~ s/:$//; 571 #push(@WholeMessage, $svheader . ': ' . $message->{spamvirusreport} . "\n"); 572 unshift(@SAheaders, $svheader . ': ' . $message->{spamvirusreport} . "\n"); 573 #print STDERR "Added $svheader: " . $message->{spamvirusreport} . "\n"; 574 } 575 576 # Return-Path header should only be present on final delivery. 577 # See RFC5321 Section 4.4. 578 # Sendmail appears to add a placeholder Return-Path header which it uses 579 # for expansion later, unfortunately this placeholder uses high-bit chars. 580 # So we remove the header and create one from the envelope for SA. 581 @SAheaders = grep !/^Return-Path\:/i, @SAheaders; 582 unshift(@SAheaders, 'Return-Path: <' . $message->{from} . ">\n"); 583 584 #push(@WholeMessage, $global::MS->{mta}->OriginalMsgHeaders($message, "\n")); 585 push(@WholeMessage, @SAheaders); 586 #print STDERR "Headers are : " . join(', ', @WholeMessage) . "\n"; 587 unless (@WholeMessage) { 588 flock($RebuildLockH, $LOCK_UN) if $BayesIsLocked; 589 $RebuildLockH->close() if $MailScanner::SA::DoingBayesRebuilds; 590 return (0,0, MailScanner::Config::LanguageValue($message, 'sanoheaders'), 0); 591 } 592 593 push(@WholeMessage, "\n"); 594 595 my(@WholeBody); 596 $message->{store}->ReadBody(\@WholeBody, $maxsize); 597 push(@WholeMessage, @WholeBody); 598 599 # Work out the MD5 sum of the body 600 my($testcache,$md5,$md5digest); 601 if ($SQLiteInstalled) { 602 $testcache = MailScanner::Config::Value("usesacache",$message); 603 $testcache = ($testcache =~ /1/)?1:0; 604 $md5 = Digest::MD5->new; 605 eval { $md5->add(@WholeBody) }; 606 if ($@ ne "" || @WholeBody<=1) { 607 # The eval failed 608 $md5digest = "unknown"; 609 $testcache = 0; 610 } else { 611 # The md5->add worked okay, so use the results 612 # Get the MD5 digest of the message body 613 $md5digest = $md5->hexdigest; 614 } 615 616 # Store it for later 617 $message->{md5} = $md5digest; 618 #print STDERR "MD5 digest is $md5digest\n"; 619 } else { 620 $testcache = 0; 621 #print STDERR "Not going to use cache\n"; 622 } 623 624 # Now construct the SpamAssassin object for version < 3 625 my $spammail; 626 $spammail = Mail::SpamAssassin::NoMailAudit->new('data'=>\@WholeMessage) 627 if $SAversion<3; 628 629 if ($testcache) { 630 if (my $cachehash = CheckCache($md5digest)) { 631 #print STDERR "Cache hit for " . $message->{id} . "\n"; 632 MailScanner::Log::InfoLog("SpamAssassin cache hit for message %s", $message->{id}); 633 # Read the cache result and update the timestamp ***** 634 #($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) = 635 #($cachehash->{sasaysspam}, $cachehash->{sahighscoring}, 636 # uncompress($cachehash->{saheader}), $cachehash->{sascore}, 637 # uncompress($cachehash->{salongreport})); 638# ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) = 639# ($cachehash->{sasaysspam}, $cachehash->{sahighscoring}, 640# uncompress($cachehash->{saheader}), $cachehash->{sascore}, 641# uncompress($cachehash->{salongreport})); 642 ($SAHitList, $SAScore, $SAReport) = ( 643 uncompress($cachehash->{saheader}), $cachehash->{sascore}, 644 uncompress($cachehash->{salongreport}) 645 ); 646 647 # calculate SAResult and HighScoring from actual message 648 ($SAResult, $HighScoring) = SATest_spam( $message, $GSHits, $SAScore ); 649 650 # Log the fact we got it from the cache. Must not add the "cached" 651 # word on the front here or it will be put into the cache itself! 652 $GotFromCache = 1; 653 654 # Need to make sure that any differences in scores are being utilized 655 if ($SAScore >= $SAReqHits) { 656 $SAResult = 1; 657 $SAHitList =~ s/required ([\d\.]+)\,/required $SAReqHits\,/; 658 $HighScoring= 1 if !$HighScoring && $SAScore >= $HighScoreVal; 659 } elsif ($SAScore < $SAReqHits) { 660 $SAResult = 0; 661 $SAHitList =~ s/required ([\d\.]+)\,/required $SAReqHits\,/; 662 $HighScoring = 0 if $HighScoring && $SAScore < $HighScoreVal; 663 } 664 665 #print STDERR "Cache results are $SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport\n"; 666 # Unlock and close the lockfile 667 flock($RebuildLockH, $LOCK_UN) if $MailScanner::SA::DoingBayesRebuilds; # $BayesIsLocked; 668 $RebuildLockH->close() if $MailScanner::SA::DoingBayesRebuilds; 669 } else { 670 # Do the actual SpamAssassin call 671 #print STDERR "Cache miss for " . $message->{id} . "\n"; 672 673 # Test it for spam-ness 674 if ($SAversion<3) { 675 ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) 676 = SAForkAndTest($GSHits, $MailScanner::SA::SAspamtest, 677 $spammail, $message); 678 } else { 679 #print STDERR "Check 1, report template = \"" . 680 # $MailScanner::SA::SAspamtest->{conf}->{report_template} . "\"\n"; 681 ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) 682 = SAForkAndTest($GSHits, $MailScanner::SA::SAspamtest, 683 \@WholeMessage, $message); 684 } 685 686 # Log the fact we didn't get it from the cache. Must not add the 687 # "not cached" word on the front here or it will be put into the 688 # cache itself! 689 $GotFromCache = 0; 690 691 #MailScanner::Log::WarnLog("Done SAForkAndTest"); 692 #print STDERR "SAResult = $SAResult\nHighScoring = $HighScoring\n" . 693 # "SAHitList = $SAHitList\n"; 694 695 # Write the record to the cache ***** 696 # Don't cache "timed out" results. 697 if ($SAHitList ne MailScanner::Config::LanguageValue($message, 'satimedout')) { 698 CacheResult($md5digest, $SAResult, $HighScoring, 699 compress($SAHitList), $SAScore, compress($SAReport)); 700 } 701 702 703 # Unlock and close the lockfile 704 flock($RebuildLockH, $LOCK_UN) if $MailScanner::SA::DoingBayesRebuilds; # $BayesIsLocked; 705 $RebuildLockH->close() if $MailScanner::SA::DoingBayesRebuilds; 706 } 707 708 # Add the cached / not cached tag to $SAHitList if appropriate 709 if (defined($GotFromCache)) { 710 if ($GotFromCache) { 711 $SAHitList = MailScanner::Config::LanguageValue($message, 'cached') 712 . ', ' . $SAHitList; 713 } else { 714 $SAHitList = MailScanner::Config::LanguageValue($message, 'notcached') 715 . ', ' . $SAHitList; 716 } 717 } 718 719 } else { 720 # No cache here 721 722 # Test it for spam-ness 723 if ($SAversion<3) { 724 ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) 725 = SAForkAndTest($GSHits, $MailScanner::SA::SAspamtest, 726 $spammail, $message); 727 } else { 728 #print STDERR "Check 1, report template = \"" . 729 # $MailScanner::SA::SAspamtest->{conf}->{report_template} . "\"\n"; 730 ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) 731 = SAForkAndTest($GSHits, $MailScanner::SA::SAspamtest, 732 \@WholeMessage, $message); 733 } 734 #MailScanner::Log::WarnLog("Done SAForkAndTest"); 735 #print STDERR "SAResult = $SAResult\nHighScoring = $HighScoring\n" . 736 # "SAHitList = $SAHitList\n"; 737 # Unlock and close the lockfile 738 flock($RebuildLockH, $LOCK_UN) if $MailScanner::SA::DoingBayesRebuilds; # $BayesIsLocked; 739 $RebuildLockH->close() if $MailScanner::SA::DoingBayesRebuilds; 740 } 741 742 743 return ($SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport); 744} 745 746# Look up the passed MD5 in the cache database and return true/false 747sub CheckCache { 748 my $md5 = shift; 749 750 my($sql, $sth); 751 $sql = "SELECT md5, count, last, first, sasaysspam, sahighscoring, sascore, saheader, salongreport FROM cache WHERE md5=?"; 752 my $hash = $MailScanner::SA::cachedbh->selectrow_hashref($sql,undef,$md5); 753 754 if (defined($hash)) { 755 # Cache hit! 756 #print STDERR "Cache hit $hash!\n"; 757 # Update the counter and timestamp 758 $sql = "UPDATE cache SET count=count+1, last=strftime('%s','now') WHERE md5=?"; 759 $sth = $MailScanner::SA::cachedbh->prepare($sql); 760 $sth->execute($md5); 761 return $hash; 762 } else { 763 # Cache miss... we'll create the cache record after SpamAssassin has run. 764 #print STDERR "Cache miss!\n"; 765 return undef; 766 } 767} 768 769# Check to see if the cache should have an expiry run done, do it if so. 770sub CheckForCacheExpire { 771 # Check to see if a cache expiry run is needed 772 CacheExpire() if $NextCacheExpire<=time; 773 # NextCacheExpire is updated by CacheExpire() so not needed here. 774} 775 776sub CacheResult { 777 my ($md5, $SAResult, $HighScoring, $SAHitList, $SAScore, $SAReport) = @_; 778 779 my $dbh = $MailScanner::SA::cachedbh; 780#print STDERR "dbh is $dbh and cachedbh is $MailScanner::SA::cachedbh\n"; 781 782 my $sql = "INSERT INTO cache (md5, count, last, first, sasaysspam, sahighscoring, sascore, saheader, salongreport) VALUES (?,?,?,?,?,?,?,?,?)"; 783 my $sth = $dbh->prepare($sql); 784 #print STDERR "$sth, $@\n"; 785 my $now = time; 786 $sth->execute($md5,1,$now,$now, 787 $SAResult, $HighScoring, $SAScore, $SAHitList, $SAReport); 788} 789 790# Expire records from the cache database 791sub CacheExpire { 792 my $expire1 = shift || $HamCacheLife; # non-spam 793 my $expire2 = shift || $SpamCacheLife; # low-scoring spam 794 my $expire3 = shift || $HighSpamCacheLife; # everything else except viruses 795 my $expire4 = shift || $VirusesCacheLife; # viruses 796 797 return unless $SQLiteInstalled; 798 799 my $sth = $MailScanner::SA::cachedbh->prepare(" 800 DELETE FROM cache WHERE ( 801 (sasaysspam=0 AND virusinfected<1 AND first<=(strftime('%s','now')-?)) OR 802 (sasaysspam>0 AND sahighscoring=0 AND virusinfected<1 AND first<=(strftime('%s','now')-?)) OR 803 (sasaysspam>0 AND sahighscoring>0 AND virusinfected<1 AND last<=(strftime('%s','now')-?)) OR 804 (virusinfected>=1 AND last<=(strftime('%s','now')-?)) 805 )"); 806 MailScanner::Log::DieLog("Database complained about this: %s. I suggest you delete your %s file and let me re-create it for you", $DBI::errstr, MailScanner::Config::Value("sacache")) unless $sth; 807 my $rows = $sth->execute($expire1, $expire2, $expire3, $expire4); 808 $sth->finish; 809 810 MailScanner::Log::InfoLog("Expired %s records from the SpamAssassin cache", $rows) if $rows>0; 811 812 # This is when we should do our next cache expiry (20 minutes from now) 813 $NextCacheExpire = time + $ExpireFrequency; 814} 815 816# Add the virus information to the cache entry so we can keep infected 817# attachment details a lot longer than normal spam. 818sub AddVirusStats { 819 my($message) = @_; 820 #my $virus; 821 return unless $message; 822 823 return unless $SQLiteInstalled && 824 MailScanner::Config::Value("usesacache",$message) =~ /1/; 825 826 my $sth = $MailScanner::SA::cachedbh->prepare('UPDATE cache SET virusinfected=? WHERE md5=?'); 827 828 ## Also print 1 line for each report about this message. These lines 829 ## contain all the info above, + the attachment filename and text of 830 ## each report. 831 #my($file, $text, @report_array); 832 #while(($file, $text) = each %{$message->{allreports}}) { 833 # $file = "the entire message" if $file eq ""; 834 # # Use the sanitised filename to avoid problems caused by people forcing 835 # # logging of attachment filenames which contain nasty SQL instructions. 836 # $file = $message->{file2safefile}{$file} or $file; 837 # $text =~ s/\n/ /; # Make sure text report only contains 1 line 838 # $text =~ s/\t/ /; # and no tab characters 839 # push (@report_array, $text); 840 #} 841 # 842 #my $reports = join(",",@report_array); 843 ## This regexp only works for clamav 844 #if ($reports =~ /(.+) contains (\S+)/) { $virus = $2; } 845 846 $sth->execute($message->{virusinfected}, 847 $message->{md5}) or MailScanner::Log::WarnLog($DBI::errstr); 848} 849 850 851 852# Fork and test with SpamAssassin. This implements a timeout on the execution 853# of the SpamAssassin checks, which occasionally take a *very* long time to 854# terminate due to regular expression backtracking and other nasties. 855sub SAForkAndTest { 856 my($GSHits, $Test, $Mail, $Message) = @_; 857 858 my($pipe); 859 my($SAHitList, $SAHits, $SAReqHits, $IsItSpam, $IsItHighScore, $AutoLearn); 860 my($HighScoreVal, $pid2delete, $IncludeScores, $SAReport, $queuelength); 861 my $PipeReturn = 0; 862 863 #print STDERR "Check 2, is \"" . $Test->{conf}->{report_template} . "\"\n"; 864 865 $IncludeScores = MailScanner::Config::Value('listsascores', $Message); 866 $queuelength = MailScanner::Config::Value('satimeoutlen', $Message); 867 868 $pipe = new IO::Pipe 869 or MailScanner::Log::DieLog('Failed to create pipe, %s, try reducing ' . 870 'the maximum number of unscanned messages per batch', $!); 871 #$readerfh = new FileHandle; 872 #$writerfh = new FileHandle; 873 #($readerfh, $writerfh) = FileHandle::pipe; 874 875 my $pid = fork(); 876 die "Can't fork: $!" unless defined($pid); 877 878 if ($pid == 0) { 879 # In the child 880 my($spamness, $SAResult, $HitList, @HitNames, $Hit); 881 $pipe->writer(); 882 #close($readerfh); 883 #POSIX::setsid(); 884 #select($writerfh); 885 #$| = 1; # Line buffering, not block buffering 886 $pipe->autoflush(); 887 # Do the actual tests and work out the integer result 888 if ($SAversion<3) { 889 $spamness = $Test->check($Mail); 890 } else { 891 my $mail = $Test->parse($Mail, 1); 892 $spamness = $Test->check($mail); 893 } 894 print $pipe ($SAversion<3?$spamness->get_hits():$spamness->get_score()) 895 . "\n"; 896 $HitList = $spamness->get_names_of_tests_hit(); 897 if ($IncludeScores) { 898 @HitNames = split(/\s*,\s*/, $HitList); 899 $HitList = ""; 900 foreach $Hit (@HitNames) { 901 $HitList .= ($HitList?', ':'') . $Hit . ' ' . 902 sprintf("%1.2f", $spamness->{conf}->{scores}->{$Hit}); 903 } 904 } 905 # Get the autolearn status 906 if ($SAversion<3) { 907 # Old code 908 if (!defined $spamness->{auto_learn_status}) { 909 $AutoLearn = "no"; 910 } elsif ($spamness->{auto_learn_status}) { 911 $AutoLearn = "spam"; 912 } else { 913 $AutoLearn = "not spam"; 914 } 915 } else { 916 # New code 917 $spamness->learn(); 918 $AutoLearn = $spamness->{auto_learn_status}; 919 $AutoLearn = 'no' if $AutoLearn eq 'failed' || $AutoLearn eq ""; 920 $AutoLearn = 'not spam' if $AutoLearn eq 'ham'; 921 } 922 #if (!defined $spamness->{auto_learn_status} || $spamness->{auto_learn_status} eq 'no') { 923 # $AutoLearn = "no"; 924 #} elsif ($spamness->{auto_learn_status}) { 925 # $AutoLearn = "spam"; 926 #} else { 927 # $AutoLearn = "not spam"; 928 #} 929 #sleep 30 if rand(3)>=2.0; 930 print $pipe $AutoLearn . "\n"; 931 932 print $pipe $HitList . "\n"; 933 # JKF New code here to print out the full spam report 934 $HitList = $spamness->get_report(); 935 $HitList =~ tr/\n/\0/; 936 print $pipe $HitList . "\n"; 937 $spamness->finish(); 938 $pipe->close(); 939 $pipe = undef; 940 exit 0; # $SAResult; 941 } 942 943 eval { 944 $pipe->reader(); 945 local $SIG{ALRM} = sub { die "Command Timed Out" }; 946 alarm MailScanner::Config::Value('spamassassintimeout'); 947 $SAHits = <$pipe>; 948 #print STDERR "Read SAHits = $SAHits " . scalar(localtime) . "\n"; 949 $AutoLearn = <$pipe>; 950 $SAHitList = <$pipe>; 951 $SAReport = <$pipe>; 952 #print STDERR "Read SAHitList = $SAHitList " . scalar(localtime) . "\n"; 953 # Not sure if next 2 lines should be this way round... 954 $pipe->close(); 955 waitpid $pid, 0; 956 ## JKF 4.71.7 waitpid $pid, 0; 957 #my $kid; 958 #do { 959 # $kid = waitpid(-1,&POSIX::WNOHANG); 960 #} until $kid == -1; 961 ## JKF 4.71.7 end 962 $PipeReturn = $?; 963 alarm 0; 964 $pid = 0; 965 chomp $SAHits; 966 chomp $AutoLearn; 967 chomp $SAHitList; 968 $SAHits = $SAHits + 0.0; 969 #$safailures = 0; # This was successful so zero counter 970 # We got a result so store a success 971 push @SAsuccessqueue, 0; 972 # Roll the queue along one 973 $SAsuccessqsum += (shift @SAsuccessqueue)?1:-1 974 if @SAsuccessqueue>$queuelength; 975 #print STDERR "Success: sum = $SAsuccessqsum\n"; 976 $SAsuccessqsum = 0 if $SAsuccessqsum<0; 977 }; 978 alarm 0; 979 # Workaround for bug in perl shipped with Solaris 9, 980 # it doesn't unblock the SIGALRM after handling it. 981 eval { 982 my $unblockset = POSIX::SigSet->new(SIGALRM); 983 sigprocmask(SIG_UNBLOCK, $unblockset) 984 or die "Could not unblock alarm: $!\n"; 985 }; 986 987 # Construct the hit-list including the score we got. 988 my($longHitList); 989 $SAReqHits = MailScanner::Config::Value('reqspamassassinscore',$Message)+0.0; 990 $longHitList = MailScanner::Config::LanguageValue($Message, 'score') . '=' . 991 ($SAHits+0.0) . ', ' . 992 MailScanner::Config::LanguageValue($Message, 'required') .' ' . 993 $SAReqHits; 994 $longHitList .= ", autolearn=$AutoLearn" unless $AutoLearn eq 'no'; 995 $longHitList .= ", $SAHitList" if $SAHitList; 996 $SAHitList = $longHitList; 997 998 # Note to self: I only close the KID in the parent, not in the child. 999 1000 # Catch failures other than the alarm 1001 MailScanner::Log::DieLog("SpamAssassin failed with real error: $@") 1002 if $@ and $@ !~ /Command Timed Out/; 1003 1004 # In which case any failures must be the alarm 1005 if ($pid>0) { 1006 $pid2delete = $pid; 1007 my $maxfailures = MailScanner::Config::Value('maxspamassassintimeouts'); 1008 # Increment the "consecutive" counter 1009 #$safailures++; 1010 if ($maxfailures>0) { 1011 # We got a failure 1012 push @SAsuccessqueue, 1; 1013 $SAsuccessqsum++; 1014 # Roll the queue along one 1015 $SAsuccessqsum += (shift @SAsuccessqueue)?1:-1 1016 if @SAsuccessqueue>$queuelength; 1017 #print STDERR "Failure: sum = $SAsuccessqsum\n"; 1018 $SAsuccessqsum = 1 if $SAsuccessqsum<1; 1019 1020 if ($SAsuccessqsum>$maxfailures && @SAsuccessqueue>=$queuelength) { 1021 MailScanner::Log::WarnLog("SpamAssassin timed out (with no network" . 1022 " checks) and was killed, failure %d of %d", 1023 $SAsuccessqsum, $maxfailures*2); 1024 } else { 1025 MailScanner::Log::WarnLog("SpamAssassin timed out and was killed, " . 1026 "failure %d of %d", $SAsuccessqsum, $maxfailures); 1027 } 1028 } else { 1029 MailScanner::Log::WarnLog("SpamAssassin timed out and was killed"); 1030 } 1031 1032 # Make the report say SA was killed 1033 $SAHitList = MailScanner::Config::LanguageValue($Message, 'satimedout'); 1034 $SAHits = 0; 1035 1036 # Kill the running child process 1037 my($i); 1038 kill 15, $pid; # Was -15 1039 # Wait for up to 10 seconds for it to die 1040 for ($i=0; $i<5; $i++) { 1041 sleep 1; 1042 waitpid($pid, &POSIX::WNOHANG); 1043 ($pid=0),last unless kill(0, $pid); 1044 kill 15, $pid; # Was -15 1045 } 1046 # And if it didn't respond to 11 nice kills, we kill -9 it 1047 if ($pid) { 1048 kill 9, $pid; # Was -9 1049 waitpid $pid, 0; # 2.53 1050 } 1051 1052 # As the child process must now be dead, remove the Bayes database 1053 # lock file if it exists. Only delete the lock file if it mentions 1054 # $pid2delete in its contents. 1055 if ($pid2delete && $MailScanner::SA::SABayesLock) { 1056 my $lockfh = new FileHandle; 1057 if ($lockfh->open($MailScanner::SA::SABayesLock)) { 1058 my $line = $lockfh->getline(); 1059 chomp $line; 1060 $line =~ /(\d+)$/; 1061 my $pidinlock = $1; 1062 if ($pidinlock =~ /$pid2delete/) { 1063 unlink $MailScanner::SA::SABayesLock; 1064 MailScanner::Log::InfoLog("Delete bayes lockfile for %s",$pid2delete); 1065 } 1066 $lockfh->close(); 1067 } 1068 } 1069 #unlink $MailScanner::SA::SABayesLock if $MailScanner::SA::SABayesLock; 1070 } 1071 #MailScanner::Log::WarnLog("8 PID is $pid"); 1072 1073 # SpamAssassin is known to play with the umask 1074 umask 0077; # Safety net 1075 1076 # The return from the pipe is a measure of how spammy it was 1077 MailScanner::Log::DebugLog("SpamAssassin returned $PipeReturn"); 1078 1079 #$PipeReturn = $PipeReturn>>8; 1080 #if ($SAHits && ($SAHits+$GSHits>=$SAReqHits)) { 1081 # $IsItSpam = 1; 1082 #} else { 1083 # $IsItSpam = 0; 1084 #} 1085 #$HighScoreVal = MailScanner::Config::Value('highspamassassinscore',$Message); 1086 #if ($SAHits && $HighScoreVal>0 && ($SAHits+$GSHits>=$HighScoreVal)) { 1087 # $IsItHighScore = 1; 1088 #} else { 1089 # $IsItHighScore = 0; 1090 #} 1091 #print STDERR "Check 3, is \"" . $Test->{conf}->{report_template} . "\"\n"; 1092 ($IsItSpam, $IsItHighScore) = SATest_spam( $Message, $GSHits, $SAHits ); 1093 1094 return ($IsItSpam, $IsItHighScore, $SAHitList, $SAHits, $SAReport); 1095} 1096 1097# 1098# Subroutine to calculate whether the mail is SPAM or not 1099# 1100sub SATest_spam 1101{ 1102 my ( $Message, $GSHits, $SAHits ) = @_; 1103 my ( $IsItSpam, $IsItHighScore ) = (0,0); 1104 1105 my $SAReqHits = 0.0 + MailScanner::Config::Value( 1106 'reqspamassassinscore', $Message 1107 ); 1108 if ( $SAHits && ($SAHits+$GSHits >= $SAReqHits) ) 1109 { 1110 $IsItSpam = 1; 1111 } 1112 1113 my $HighScoreVal = 0.0 + MailScanner::Config::Value( 1114 'highspamassassinscore', $Message 1115 ); 1116 if ( $SAHits && $HighScoreVal>0 && ($SAHits+$GSHits >= $HighScoreVal) ) 1117 { 1118 $IsItHighScore = 1; 1119 } 1120 1121 return ( $IsItSpam, $IsItHighScore ); 1122} 1123 1124 1125sub SATest { 1126 my($GSHits, $Test, $Mail, $Message) = @_; 1127 1128 my($SAHitList, $SAHits, $SAReqHits, $IsItSpam, $IsItHighScore, $AutoLearn); 1129 my($HighScoreVal, $pid2delete, $IncludeScores, $SAReport, $queuelength); 1130 my $PipeReturn = 0; 1131 1132 $IncludeScores = MailScanner::Config::Value('listsascores', $Message); 1133 $queuelength = MailScanner::Config::Value('satimeoutlen', $Message); 1134 1135 my($spamness, $SAResult, $HitList, @HitNames, $Hit); 1136 # Do the actual tests and work out the integer result 1137 if ($SAversion<3) { 1138 $spamness = $Test->check($Mail); 1139 } else { 1140 my $mail = $Test->parse($Mail, 1); 1141 $spamness = $Test->check($mail); 1142 } 1143 # 1st output is get_hits or get_score \n 1144 $SAHits = ($SAversion<3?$spamness->get_hits():$spamness->get_score()) + 0.0; 1145 $HitList = $spamness->get_names_of_tests_hit(); 1146 if ($IncludeScores) { 1147 @HitNames = split(/\s*,\s*/, $HitList); 1148 $HitList = ""; 1149 foreach $Hit (@HitNames) { 1150 $HitList .= ($HitList?', ':'') . $Hit . ' ' . 1151 sprintf("%1.2f", $spamness->{conf}->{scores}->{$Hit}); 1152 } 1153 } 1154 # Get the autolearn status 1155 if ($SAversion<3) { 1156 # Old code 1157 if (!defined $spamness->{auto_learn_status}) { 1158 $AutoLearn = "no"; 1159 } elsif ($spamness->{auto_learn_status}) { 1160 $AutoLearn = "spam"; 1161 } else { 1162 $AutoLearn = "not spam"; 1163 } 1164 } else { 1165 # New code 1166 $spamness->learn(); 1167 $AutoLearn = $spamness->{auto_learn_status}; 1168 $AutoLearn = 'no' if $AutoLearn eq 'failed' || $AutoLearn eq ""; 1169 $AutoLearn = 'not spam' if $AutoLearn eq 'ham'; 1170 } 1171 # 3rd output is $HitList \n 1172 $SAHitList = $HitList; 1173 # JKF New code here to print out the full spam report 1174 $HitList = $spamness->get_report(); 1175 $HitList =~ tr/\n/\0/; 1176 # 4th output is $HitList \n which is now full spam report 1177 $SAReport = $HitList . "\n"; 1178 $spamness->finish(); 1179 1180 #print STDERR "Read SAHits = $SAHits " . scalar(localtime) . "\n"; 1181 1182 # Construct the hit-list including the score we got. 1183 my($longHitList); 1184 $SAReqHits = MailScanner::Config::Value('reqspamassassinscore',$Message)+0.0; 1185 $longHitList = MailScanner::Config::LanguageValue($Message, 'score') . '=' . 1186 ($SAHits+0.0) . ', ' . 1187 MailScanner::Config::LanguageValue($Message, 'required') .' ' . 1188 $SAReqHits; 1189 $longHitList .= ", autolearn=$AutoLearn" unless $AutoLearn eq 'no'; 1190 $longHitList .= ", $SAHitList" if $SAHitList; 1191 $SAHitList = $longHitList; 1192 1193 # SpamAssassin is known to play with the umask 1194 umask 0077; # Safety net 1195 1196 if ($SAHits && ($SAHits+$GSHits>=$SAReqHits)) { 1197 $IsItSpam = 1; 1198 } else { 1199 $IsItSpam = 0; 1200 } 1201 $HighScoreVal = MailScanner::Config::Value('highspamassassinscore',$Message); 1202 if ($SAHits && $HighScoreVal>0 && ($SAHits+$GSHits>=$HighScoreVal)) { 1203 $IsItHighScore = 1; 1204 } else { 1205 $IsItHighScore = 0; 1206 } 1207 return ($IsItSpam, $IsItHighScore, $SAHitList, $SAHits, $SAReport); 1208} 1209 12101; 1211