# # MailScanner - SMTP E-Mail Virus Scanner # Copyright (C) 2002 Julian Field # # $Id: MessageBatch.pm 3918 2007-05-27 20:32:11Z 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 # # # All functions for dealing with the entire batch of messages. # package MailScanner::MessageBatch; use strict 'vars'; use strict 'refs'; no strict 'subs'; # Allow bare words for parameter %'s use DirHandle; use Time::HiRes qw ( time ); use vars qw($VERSION); ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = substr q$Revision: 3918 $, 10; my $maxcleanbytes = 0; my $maxcleanmessages = 0; my $maxdirtybytes = 0; my $maxdirtymessages = 0; my $initialised = 0; # # Members: # $starttime Set by new # $endtime Set by EndBatch # $bytespersecond Set by EndBatch # $totalmessages Set by CreateBatch # $totalbytes Set by CreateBatch # $dirtymessages Set by CreateBatch # $dirtybytes Set by CreateBatch # # Constructor. # Builds the batch full of messages. # Note: this currently does not archive messages anywhere, it just works # out where they will need archiving. Do the archiving once we # are about to remove it from the inqueue. sub new { my $type = shift; my $this = {}; #print STDERR "In new MessageBatch\n"; MailScanner::Log::DieLog("Tried to create a MessageBatch without calling initglobals") unless $initialised; $global::MS->{mta}->CreateBatch($this); $this->{starttime} = time; bless $this, $type; return $this; } # Work out the overall speed figures and log them sub EndBatch { my $this = shift; my $now = time; my $totalbytes = $this->{totalbytes}; my $totaltime = $now - $this->{starttime}; my $speed; #print STDERR "Started at " . $this->{starttime} . "\n"; #print STDERR "Finished at " . $now . "\n"; #print STDERR "Tool " . $totaltime . "\n"; $this->{endtime} = $now; $this->{totaltime} = $totaltime; $totaltime = 1 unless $totaltime > 0.001; # Minimum of 1 m-second $speed = ($totalbytes*1.0) / ($totaltime*1.0) if $totaltime > 0; $this->{bytespersecond} = $speed; $speed = 0 if $speed > 1_000_000 || $speed < 0; if (MailScanner::Config::Value('logspeed')) { MailScanner::Log::InfoLog("Batch completed at %d bytes per second (%d / %d)", $speed, $totalbytes, $now-$this->{starttime}); # Work out current size of batch. my $msgs = $this->{messages}; my $msgcount = scalar(keys %$msgs); MailScanner::Log::InfoLog("Batch (%d message%s) processed in %.2f seconds", $msgcount, ($msgcount==1?'':'s'), $totaltime); } } # Start the timing for a section of the main code # Using $varprefix as a prefix on the property name, # set up properties for the figures. sub StartTiming { my $this = shift; my($varprefix, $usertext) = @_; my $command = ""; my $now = time; $command = '$this->{' . $varprefix . '_starttime} = $now;'; eval $command; } # Stop the timing for a section of the main code # Uses the xxx_starttime property created in StartTiming sub StopTiming { my $this = shift; my($varprefix, $usertext) = @_; my $command = ""; my $now = time; my $totaltime; my $speed; # totaltime = now - starttime $command = '$totaltime = $now - $this->{' . $varprefix . '_starttime};'; eval $command; # endtime = now $command = '$this->{' . $varprefix . '_endtime} = $now;'; eval $command; # totaltime = totaltime $command = '$this->{' . $varprefix . '_totaltime} = $totaltime;'; eval $command; $totaltime = 1 unless $totaltime > 0; # Minimum of 1 second # speed = bytes / totaltime $speed = ($this->{totalbytes}*1.0) / ($totaltime*1.0) if $totaltime > 0; $speed = 0 if $speed > 1_000_000 || $speed < 0; # bytespersecond = speed $command = '$this->{' . $varprefix . '_bytespersecond} = $speed;'; eval $command; MailScanner::Log::InfoLog("%s completed at %d bytes per second", $usertext, $speed) if MailScanner::Config::Value('logspeed') && $speed > 0; } # This must be called as a class method before new() is used sub initialise { #my $type = shift; $maxcleanbytes = MailScanner::Config::Value('maxunscannedbytes'); $maxcleanmessages = MailScanner::Config::Value('maxunscannedmessages'); $maxdirtybytes = MailScanner::Config::Value('maxdirtybytes'); $maxdirtymessages = MailScanner::Config::Value('maxdirtymessages'); $initialised = 1; #print STDERR "MessageBatch class has been initialised\n"; #print STDERR "Limits are $maxcleanbytes, $maxcleanmessages, $maxdirtybytes, $maxdirtymessages\n"; } # Return the max size of the batch sub BatchLimits { return ($maxcleanbytes, $maxcleanmessages, $maxdirtybytes, $maxdirtymessages); } sub print { my $this = shift; my($id, $msg); my $msgs = $this->{messages}; foreach $id (keys %$msgs) { $msg = $msgs->{$id}; print STDERR "\n"; $msg->print(); } } # Delete the passed in messages from the batch, this wipes them # out so nothing will still think they are in the queue. # It just deletes the files, it doesn't delete the data structure # as we will probably need it later for logging. sub RemoveDeletedMessages { my $this = shift; my($id, $message, @badentries); my $deleteifnotdelivering = 0; $deleteifnotdelivering = 1 if MailScanner::Config::IsSimpleValue('keepspamarchiveclean') && !MailScanner::Config::Value('keepspamarchiveclean'); #print STDERR "Deleteifnotdelivering = $deleteifnotdelivering\n"; #print STDERR "About to remove deleted messages\n"; while(($id, $message) = each %{$this->{messages}}) { #print STDERR "Looking at $id for deletion\n"; if (!$message) { #MailScanner::Log::WarnLog("RemoveDeletedMessages: Found bad message $id"); push @badentries, $id; next; } #MailScanner::Log::InfoLog("RemoveDeletedMessages: Deleting message $id") # if $message->{deleted}; #print STDERR "Message->deleted = " . $message->{deleted} . "and dontdeliver = " . $message->{dontdeliver} . "\n"; $message->DeleteMessage() if $message->{deleted} || ($message->{dontdeliver} && $deleteifnotdelivering); #delete $this->{messages}{$id} if $this->{messages}{$id}->{deleted}; } foreach $id (@badentries) { delete $this->{messages}{$id}; } } # Do all the spam checks. # Must have removed deleted messages from the batch first. sub SpamChecks { my $this = shift; my($id, $message); my $counter = 0; #print STDERR "Starting spam checks\n"; MailScanner::Log::InfoLog("Spam Checks: Starting") if MailScanner::Config::Value('logspam'); # If the cache contents have expired then clean it all up first MailScanner::SA::CheckForCacheExpire(); while(($id, $message) = each %{$this->{messages}}) { next if $message->{scanmail} =~ /^[0\s]+$/; next if $message->{deleted}; next unless MailScanner::Config::Value('spamchecks', $message) =~ /1/; #print STDERR "Spam checks for $id\n"; $counter += $message->IsSpam(); if (!MailScanner::Config::Value('spamdetail', $message)) { $message->{spamreport} = MailScanner::Config::LanguageValue($message, ($message->{isspam}?'spam':'notspam')); } } MailScanner::Log::NoticeLog("Spam Checks: Found $counter spam messages") if $counter>0; #print STDERR "$counter messages were spam\n"; } # Handle the spam results using the actions they have defined. # Can deliver, delete, store, and forward or any combination. sub HandleSpam { my $this = shift; my($id, $message); #print STDERR "Starting to handle spam\n"; while(($id, $message) = each %{$this->{messages}}) { # Skip deleted and non-spam messages #print STDERR "Deleted = " . $message->{deleted} . ", isspam = " . $message->{isspam} . ", scanmail = " . $message->{scanmail} . ", spamwhitelisted = " . $message->{spamwhitelisted} . "\n"; next if $message->{deleted} || !$message->{isspam} || $message->{scanmail} =~ /^[0\s]+$/ || $message->{spamwhitelisted}; #print STDERR "Spam checks for $id\n"; $message->HandleHamAndSpam('spam'); } #print STDERR "Finished handling spam\n\n"; } # Handle the non-spam results using the actions they have defined. # Can deliver, delete, store, and forward or any combination. sub HandleHam { my $this = shift; my($id, $message); #print STDERR "Starting to handle ham\n"; while(($id, $message) = each %{$this->{messages}}) { # Skip deleted and non-spam messages next if $message->{deleted} || $message->{scanmail} =~ /^[0\s]+$/ || $message->{isspam}; #print STDERR "Ham checks for $id\n"; $message->HandleHamAndSpam('nonspam'); } #print STDERR "Finished handling ham\n\n"; } # Reject messages that come from people we want to reject. Send nice report # instead. sub RejectMessages { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { # Skip deleted and non-spam messages next if $message->{deleted}; #print STDERR "May reject message $id\n"; $message->RejectMessage() if MailScanner::Config::Value('rejectmessage',$message) !~ /0/; } } # Do all the MCP checks. # Must have removed deleted messages from the batch first. sub MCPChecks { my $this = shift; my($id, $message); my $counter = 0; #print STDERR "Starting spam checks\n"; MailScanner::Log::InfoLog("MCP Checks: Starting") if MailScanner::Config::Value('logmcp'); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; next if $message->{scanmail} =~ /^[0\s]+$/; next unless MailScanner::Config::Value('mcpchecks', $message); #print STDERR "Spam checks for $id\n"; $counter += $message->IsMCP(); if (!MailScanner::Config::Value('mcpdetail', $message)) { $message->{mcpreport} = MailScanner::Config::LanguageValue($message, ($message->{ismcp}?'mcpspam':'mcpnotspam')); } #print STDERR "Spam header = \"" . $message->{spamreport} . "\"\n"; } MailScanner::Log::NoticeLog("MCP Checks: Found $counter MCP messages") if $counter>0; #print STDERR "$counter messages were spam\n"; } # Handle the spam results using the actions they have defined. # Can deliver, delete, store, and forward or any combination. sub HandleMCP { my $this = shift; my($id, $message); #print STDERR "Starting to handle spam\n"; while(($id, $message) = each %{$this->{messages}}) { # Skip deleted and non-spam messages next if $message->{deleted} || !$message->{ismcp} || $message->{scanmail} =~ /^[0\s]+$/ || $message->{mcpwhitelisted}; #print STDERR "Spam checks for $id\n"; $message->HandleMCP('mcp'); } #print STDERR "Finished handling spam\n\n"; } # Handle the non-spam results using the actions they have defined. # Can deliver, delete, store, and forward or any combination. sub HandleNonMCP { my $this = shift; my($id, $message); #print STDERR "Starting to handle ham\n"; while(($id, $message) = each %{$this->{messages}}) { # Skip deleted and non-spam messages next if $message->{deleted} || $message->{scanmail} =~ /^[0\s]+$/ || $message->{ismcp}; #print STDERR "Ham checks for $id\n"; $message->HandleMCP('nonmcp'); } #print STDERR "Finished handling ham\n\n"; } # Deliver the messages that aren't to be scanned. # Uses the "virusscanme" property to determine this. # This does not add the clean sig or anything like that. sub DeliverUnscanned { my $this = shift; my($OutQ, @messages, $id, $message); while(($id,$message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; # This is for mail we don't want to touch at all if ($message->{scanmail} =~ /^[0\s]+$/) { $OutQ = MailScanner::Config::Value('outqueuedir', $message); $message->DeliverUntouched($OutQ); $message->{deleted} = 1; # This marks it for purging from disk push @messages, $message; next; } if (!$message->{scanme}) { #print STDERR "Delivering unscanned message $id\n"; # Strip it if necessary $message->StripHTML() if $message->{needsstripping}; #print STDERR "Tagstoconvert = " . $message->{tagstoconvert} . "\n"; $message->DisarmHTML() if $message->{tagstoconvert}; # Encapsulate the message if necessary $message->EncapsulateMessage() if $message->{needsencapsulating}; # The message might have been changed by the RFC822 encapsulation # or the HTML stripping. if ($message->{bodymodified}) { $message->DeliverModifiedBody('unscannedheader'); } else { $OutQ = MailScanner::Config::Value('outqueuedir', $message); $message->DeliverUnscanned($OutQ); } $message->{deleted} = 1; # This marks it for purging from disk push @messages, $message; } } # Note this passes a list now, not a ref to a list MailScanner::Mail::TellAbout(@messages); MailScanner::Log::InfoLog("Unscanned: Delivered %d messages", scalar(@messages)) if @messages; } # Parse all the messages and expand all the attachments sub Explode { my $this = shift; my($key, $message); # jjh 2004-03-12 reap as many as we can. # JKF Test 2004-11-23 1 until waitpid(-1, &POSIX::WNOHANG) == -1; 1 until waitpid(-1, WNOHANG) == -1; #print STDERR "About to explode messages\n"; print STDERR "Ignore errors about failing to find EOCD signature\n"; umask $global::MS->{work}->{fileumask}; while(($key, $message) = each %{$this->{messages}}) { next if $message->{deleted}; #print STDERR "About to explode message $key $message\n"; $message->Explode(); # jjh 2004-03-12 reap as many as we can. # JKF Test 2004-11-23 1 until waitpid(-1, &POSIX::WNOHANG) == -1; 1 until waitpid(-1, WNOHANG) == -1; } umask 0077; } # Do all the checking and log the number of viruses/problems found sub VirusScan { my $this = shift; # Call them with the scanning settings MailScanner::Log::InfoLog("Virus and Content Scanning: Starting"); my $viruses = MailScanner::SweepViruses::ScanBatch($this, 'scan'); MailScanner::Log::NoticeLog("Virus Scanning: Found %d viruses", $viruses+0) if defined $viruses && $viruses>0; #MailScanner::Log::InfoLog("Other Checks: Starting"); my $others = MailScanner::SweepOther::ScanBatch($this, 'scan'); MailScanner::Log::NoticeLog("Other Checks: Found %d problems", $others+0) if defined $others && $others>0; #MailScanner::Log::InfoLog("Content Checks: Starting"); my $content = MailScanner::SweepContent::ScanBatch($this, 'scan'); MailScanner::Log::NoticeLog("Content Checks: Found %d problems", $content+0) if defined $content && $content>0; } # Print the infection reports for all the messages sub PrintInfections { my $this = shift; my($key, $message); #print "In PrintInfections(), this = $this\n"; while(($key, $message) = each %{$this->{messages}}) { #print STDERR "Key is $key and Message is $message\n"; $message->PrintInfections() unless $message->{deleted}; } } # Convert errors that occurred in the extraction process into infection reports sub ReportBadMessages { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; if ($message->{cantparse}) { $message->{otherreports}{""} .= MailScanner::Config::LanguageValue($message, 'cantanalyze') . "\n"; $message->{othertypes}{""} .= 'e'; } if ($message->{toomanyattach}) { $message->{otherreports}{""} .= MailScanner::Config::LanguageValue($message, 'toomanyattachments') . "\n"; $message->{othertypes}{""} .= 'e'; } if ($message->{badtnef}) { $message->{entityreports}{$this->{tnefentity}} .= MailScanner::Config::LanguageValue($message, 'badtnef') . "\n"; $message->{entitytypes}{$this->{tnefentity}} .= 'e'; } } } # Remove any infected spam or mcp from their archives. We have saved # all the spam+mcp archive places we stored this message, so go delete # the dirs and all the files in each one. sub RemoveInfectedSpam { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { #print STDERR "Message is infected\n" if $message->{infected}; next unless $message->{infected}; next unless MailScanner::Config::Value('keepspamarchiveclean', $message) =~ /1/; #print STDERR "Deleting " . join(',',@{$message->{spamarchive}}) . "\n"; unlink @{$message->{spamarchive}}; # Wipe the spamarchive files @{$this->{spamarchive}} = (); # Wipe the spamarchive array } } # Set up the entity2file and entity2parent hashes in every message sub CreateEntitiesHelpers { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { $message->CreateEntitiesHelpers() unless $message->{deleted}; } } # Print out the number of parts in each message sub PrintNumParts { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; #print "Message $id has " . $message->{numberparts} . " parts\n"; } } # Print out the filenames in each message sub PrintFilenames { my $this = shift; my($id, $message); my($fnames, @filenames); while(($id, $message) = each %{$this->{messages}}) { #next if $message->{deleted}; #print STDERR "Message $id has filenames "; @filenames = keys %{$message->{file2entity}}; #print STDERR join(", ", @filenames) . "\n"; } } # Print out the infected sections of all messages sub PrintInfectedSections { my $this = shift; my($id, $message); my($parts, $file, $entity); print STDERR "\nInfected sections are:\n"; while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; $parts = $message->{virusreports}; foreach $file (keys %$parts) { $entity = $message->{file2entity}{$file}; $entity->dump_skeleton(); } $parts = $message->{otherreports}; foreach $file (keys %$parts) { $entity = $message->{file2entity}{$file}; $entity->dump_skeleton(); } } } # Clean all the messages. # Clean ==> remove the viruses, it doesn't imply macro-virus disinfection. sub Clean { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; #print STDERR "\nCleaning message $id\n"; $message->Clean(); } } # Zip up all the attachments in the messages, to save space on the # mail servers. sub ZipAttachments { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; print STDERR "\nZipping attachments, message $id\n"; $message->ZipAttachments(); } } # Combine the virus and other reports and types for all the messages. # Might change this to do it at source later. sub CombineReports { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { $message->CombineReports() unless $message->{deleted}; } } # Store all the infected files in the quarantine if they want me to. # Quarantine decision has to be done on a per-message basis. sub QuarantineInfections { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; next unless $message->{infected}; next if $message->{silent} && !$message->{noisy} && MailScanner::Config::Value('quarantinesilent', $message) !~ /1/; next unless MailScanner::Config::Value('quarantineinfections', $message) =~ /1/; #print STDERR "Quarantining infections for $id\n"; $global::MS->{quar}->StoreInfections($message); $message->{quarantinedinfections} = 1; # Stop it quarantining it twice } } # Store all the disarmed files in the quarantine if they want me to. # Quarantine decision has to be done on a per-message basis. sub QuarantineModifiedBody { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next unless $message->{bodymodified}; next if $message->{quarantinedinfections}; # Optimisation next if MailScanner::Config::Value ('quarantinemodifiedbody', $message) !~ /1/; $global::MS->{quar}->StoreInfections($message); MailScanner::Log::NoticeLog("Quarantining modified message for %s", $id); } } # Sign all the messages that were clean with a tag line saying # (ideally) that MailScanner is wonderful :-) sub SignUninfected { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; $message->SignUninfected() if MailScanner::Config::Value('signcleanmessages', $message) && !$message->{infected}; } } # Deliver all the messages that were never infected. # This uses the "bodychanged" tag in the message properties # to know whether to just move the incoming body to the out queue, # or whether the outgoing message has got to be reconstructed. # Also tag the message for future deletion. sub DeliverUninfected { my $this = shift; my($id, $message, @messages); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; #print STDERR "Possibly delivering uninfected message $id\n"; next if $message->{infected}; #print STDERR "Delivering uninfected message $id\n"; $message->DeliverUninfected(); $message->{deleted} = 1; push @messages, $message; } MailScanner::Mail::TellAbout(@messages); MailScanner::Log::InfoLog("Uninfected: Delivered %d messages", scalar(@messages)) if @messages; } # If we aren't delivering cleaned messages from a local domain, # i.e. we are trying to ensure that no-one outside our local domains # discovers we have a virus, then just delete the messages rather # that deliver them. # This replaces the "Deliver From Local Domains" keyword and the # "Deliver To Recipients" keyword. # When we delete them here, we still want to be able to issue the # warnings, so this is only a "semi-deletion". sub DeleteUnwantedCleaned { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if !$message->{infected} || $message->{deleted}; next if MailScanner::Config::Value('delivercleanedmessages', $message) =~ /1/; #print STDERR "Deleting unwanted cleaned message $id\n"; $message->{deleted} = 1; $message->{stillwarn} = 1; } } # Find all the messages infected with a "Silent" virus. # Really must try to rename this option before shipping this! # Set the "silent" flag as appropriate. sub FindSilentAndNoisyInfections { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if !$message->{infected}; next if $message->{deleted} && !$message->{stillwarn}; $message->FindSilentAndNoisyInfections(); } } # Deliver all the "silent" and not noisy infected messages, # and mark them for deletion from the queue. sub DeliverOrDeleteSilent { my $this = shift; my($id, $message, @messages); while(($id, $message) = each %{$this->{messages}}) { next if !$message->{silent} || $message->{noisy} || $message->{deleted} || $message->{dontdeliver}; #MailScanner::Log::WarnLog("Deliversilent for %s is %s", $message->{id}, # MailScanner::Config::Value('deliversilent', $message)); if (MailScanner::Config::Value('deliversilent', $message)) { $message->DeliverCleaned(); #print STDERR "Deleting silent-infected message " . $message->{id} . "\n"; push @messages, $message; } $message->{deleted} = 1; $message->{stillwarn} = 1; } if (@messages) { MailScanner::Mail::TellAbout(@messages); MailScanner::Log::NoticeLog("Silent: Delivered %d messages containing " . "silent viruses", scalar(@messages)); } } # Deliver all the "cleaned" messages from the queue. Any # unwanted ones will have already been deleted. sub DeliverCleaned { my $this = shift; my($id, $message, @messages); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; $message->DeliverCleaned(); #print STDERR "Deleting cleaned message " . $message->{id} . "\n"; # BUGFIX: JKF $message->{deleted} = 1; push @messages, $message; } MailScanner::Mail::TellAbout(@messages); MailScanner::Log::NoticeLog("Cleaned: Delivered %d cleaned messages", scalar(@messages)) if @messages; } # Warn the senders of the infected/troublesome messages that we # didn't like them. Only do this if we've been told to! sub WarnSenders { my $this = shift; my($id, $message, $counter, $reasons, $warnviruses); $counter = 0; while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} && !$message->{stillwarn}; next if $message->{silent} && !$message->{noisy}; #print STDERR "Looking to warn sender of $id\n"; next unless $message->{infected}; #print STDERR "Warning sender of $id who is " . $message->{from} . "\n"; next unless MailScanner::Config::Value('warnsenders', $message) =~ /1/; #print STDERR "2Warning sender of $id who is " . $message->{from} . "\n"; # Count up the number of reasons why we want to warn the sender. # If it's 0 then don't warn them. # However, let the "warnvirussenders" take priority over the other 2. # So if there is a virus and they don't want to warn virus senders # then don't send a warning regardless of the other traps. $warnviruses = MailScanner::Config::Value('warnvirussenders', $message); next if $message->{virusinfected} && !$warnviruses; $reasons = 0; $reasons++ if $message->{virusinfected} && $warnviruses; $reasons++ if $message->{nameinfected} && MailScanner::Config::Value('warnnamesenders', $message); $reasons++ if $message->{sizeinfected} && MailScanner::Config::Value('warnsizesenders', $message); $reasons++ if $message->{otherinfected} && MailScanner::Config::Value('warnothersenders', $message); #$reasons++ if ($message->{otherinfected} || $message->{sizeinfected}) && # MailScanner::Config::Value('warnothersenders', $message); next if $reasons==0; $message->WarnSender(); $counter++; } MailScanner::Log::NoticeLog("Sender Warnings: Delivered %d warnings to " . "virus senders", $counter) if $counter; } # Warn the local postmaster (or whoever is receiving the notices) # a summary of the infections found. # Save the notices into different emails, one per different postmaster, # so that the notices can be sent to different people depending on the # domain. sub WarnLocalPostmaster { my $this = shift; my($id, $message, $counter); my(%notices, $notice, %headers, %signatures, $email); my(@posties, $posties, $postie, $sig, %reasons, $reasons, $thisreason); # Create all the email messages $counter = 0; while(($id, $message) = each %{$this->{messages}}) { next if !$message->{infected}; next if $message->{deleted} && !$message->{stillwarn}; next unless MailScanner::Config::Value('sendnotices', $message) =~ /1/; $posties = MailScanner::Config::Value('noticerecipient', $message); return if $posties =~ /^\s*$/; # Return if no opsties defined @posties = split(" ", $posties); foreach $postie (@posties) { $headers{$postie} = $message->CreatePostmasterHeaders($postie) unless $headers{$postie}; # Change the subject to include the problem types %reasons = (); $reasons = ""; $reasons{virusinfected} = 1 if $message->{virusinfected}; $reasons{filenameinfected} = 1 if $message->{nameinfected}; $reasons{otherinfected} = 1 if $message->{otherinfected}; $reasons{sizeinfected} = 1 if $message->{sizeinfected}; $reasons{passwordprotected} = 1 if $message->{passwordprotected}; foreach $thisreason (sort keys %reasons) { $reasons .= " : " if $reasons ne ""; $reasons .= MailScanner::Config::LanguageValue($message, "notice" . $thisreason); } $headers{$postie} =~ s/\nSubject:.*?\n/\nSubject: $reasons\n/si; $notices{$postie} .= $message->CreatePostmasterNotice(); unless ($signatures{$postie}) { $sig = MailScanner::Config::Value('noticesignature', $message); $sig =~ s/\\n/\n/g; $signatures{$postie} = $sig; } } $counter++; } while(($postie,$notice) = each %notices) { $email = $headers{$postie} . "\n" . #MailScanner::Config::LanguageValue($message, 'noticeheading') . ":\n" . #$notices{$postie} . "\n" . $signatures{$postie} . "\n"; MailScanner::Config::LanguageValue($message, 'noticeprefix') . ": " . $reasons . "\n" . $notices{$postie} . "\n" . $signatures{$postie} . "\n"; $global::MS->{mta}->SendMessageString(undef, $email, $postie) or MailScanner::Log::WarnLog("Could not notify postmaster from $postie, %s", $!); } MailScanner::Log::NoticeLog("Notices: Warned about %d messages", $counter) if $counter; } # Disinfect the cleaned messages as far as possible, # then deliver the disinfected attachments. # The only messages left on disk are # 1. the unparsable ones, which I am about to delete anyway, and # 2. the cleaned ones, which is what I want to work on. sub DisinfectAndDeliver { my $this = shift; my($id, $message, @interesting); # Delete all the unparsable messages from disk, # and all the messages with "whole body" infections # such as DoS attacks. while(($id, $message) = each %{$this->{messages}}) { if ($message->{deleted} || $message->{dontdeliver} || $message->{cantparse} || $message->{badtnef} || $message->{nameinfected} || $message->{cantdisinfect} || ($message->{allreports} && $message->{allreports}{""}) || !MailScanner::Config::Value('deliverdisinfected',$message)) { $message->DeleteMessage(); } else { if ($message->{virusinfected}) { #print STDERR "Found message $id to be worth disinfecting\n"; push @interesting, $id; } } } # Nothing to do? return unless @interesting; MailScanner::Log::NoticeLog("Disinfection: Attempting to disinfect %d " . "messages", scalar(@interesting)); # Save the infection reports, they will be needed to compare # with the post-disinfection reports. foreach $id (@interesting) { $message = $this->{messages}{$id}; # Move its reports somewhere safe $message->{oldviruses} = $message->{virusreports}; $message->{virusreports} = {}; # I want a new hashref $message->{virusinfected} = 0; # Reset its status } # Re-scan the batch of messages (just for viruses) # with the disinfection settings. # This should not produce any output reports at all. #print STDERR "Calling disinfection code for messages " . # join(', ', @interesting) . "\n"; MailScanner::SweepViruses::ScanBatch($this, 'disinfect'); # Throw away the disinfection reports if there are any foreach $id (@interesting) { $message->{virusreports} = {}; } # Now re-scan the batch to find revised virus reports my $viruses = MailScanner::SweepViruses::ScanBatch($this, 'rescan'); #print STDERR "Revised scanning found $viruses viruses\n"; MailScanner::Log::NoticeLog("Disinfection: Rescan found only %d viruses", $viruses+0); # Look through the original list of reports, finding reports that # were present in the old list that are not in the new list. foreach $id (@interesting) { $this->{messages}{$id}->DeliverDisinfectedAttachments(); } } # Copy raw message files to archive directories sub ArchiveToFilesystem { my $this = shift; my($id, $message, $DidAnything, $log); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted}; $DidAnything = $message->ArchiveToFilesystem(); $log .= " " . $id if $DidAnything; } MailScanner::Log::NoticeLog("Saved archive copies of%s", $log) if $log; } # Strip the HTML out of messages that need to be stripped, # either because strip ruleset says they should be stripped # or because striphtml was one of the spam actions. sub StripHTML { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; next unless $message->{needsstripping}; $message->StripHTML(); } } # Disarm some of the HTML tags in messages. sub DisarmHTML { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { #print STDERR "In MessageBatch, tags are " . # $message->{tagstoconvert} . "\n"; next if $message->{deleted} || $message->{dontdeliver}; next unless $message->{tagstoconvert}; $message->DisarmHTML(); } } # Turn the entire message into an RFC822 attachment off a multipart # message, if this is one of their spam/ham actions. sub Encapsulate { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { next if $message->{deleted} || $message->{dontdeliver}; next unless $message->{needsencapsulating}; $message->EncapsulateMessage(); } } # Add the virus statistics to the SpamAssassin results cache # so we know to keep the cache record for much longer. sub AddVirusInfoToCache { my $this = shift; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { MailScanner::SA::AddVirusStats($message); } } # This simply evaluates a known configuration parameter for every message # in the batch, whether it has been deleted or not. This solely exists so # that the lookup can be a Custom Function that has "side-effects" such # as logging data about the message. sub LastLookup { my $this = shift; my $start = time; my($id, $message); while(($id, $message) = each %{$this->{messages}}) { MailScanner::Config::Value('lastlookup', $message); } unless (MailScanner::Config::IsSimpleValue('lastlookup') && !MailScanner::Config::Value('lastlookup')) { MailScanner::Log::InfoLog("\"Always Looked Up Last\" took %.2f seconds", time-$start+0.0) if MailScanner::Config::Value('logspeed') =~ /1/; } # Lookup one remaining value after end of batch # Putting in $this is against the rules as it isn't a message, # but it doesn't actually cause any problems and gives MailWatch # a way of getting hold of the batch statistics. MailScanner::Config::Value('lastafterbatch', $this); } 1;