#!/usr/bin/perl -I/usr/local/lib/MailScanner
#
# MailScanner - SMTP E-Mail Virus Scanner
# Copyright (C) 2002 Julian Field
#
# $Id: mailscanner.sbin 3919 2007-05-27 20:36:32Z 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
#
use strict;
no strict 'subs';
use POSIX;
require 5.005;
# Awkard BEGIN block so that we pick up MIME::Base64 from the right place!
BEGIN {
my(@oldinc,@safecopy,$path);
# Look in /usr/local/MailScanner/utils for the modules
@oldinc = @INC;
@safecopy = @INC;
# Duplicate path with /usr/local/MailScanner/utils stuck on the front
# of each element
foreach $path (reverse @oldinc) {
next unless $path =~ /\//;
$path =~ s/^\/usr/\/usr\/lib\/MailScanner\/utils/;
unshift @INC, $path;
}
require MIME::Base64;
require MIME::QuotedPrint;
@INC = @safecopy;
}
use FileHandle;
use File::Path;
use IO::Handle;
use Getopt::Long;
use Time::HiRes qw ( time );
use Filesys::Df;
use Sys::Hostname::Long;
use MailScanner::Config;
use MailScanner::CustomConfig;
use MailScanner::GenericSpam;
use MailScanner::Lock;
use MailScanner::Log;
use MailScanner::Mail;
use MailScanner::MessageBatch;
use MailScanner::Quarantine;
use MailScanner::Queue;
use MailScanner::RBLs;
use MailScanner::MCPMessage;
use MailScanner::Message;
use MailScanner::MCP;
use MailScanner::SA;
use MailScanner::SweepContent;
use MailScanner::SweepOther;
use MailScanner::SweepViruses;
use MailScanner::TNEF;
use MailScanner::WorkArea;
use MailScanner;
my $autoinstalled=0;
# To detect whether we've been auto-configured & installed
# -- $autoinstalled will be set to 1 if so.
#@@$autoinstalled=1;
# Needed for Sys::Syslog, as Debian Potato (at least) doesn't
# appear to have "gethostname" syscall as used (indirectly) by Sys::Syslog
# So it uses `hostname` instead, which it can't do if PATH is tainted.
# It's good to have this anyway, although we may need to modify it for
# other OS when we find that something we need isn't here -- nwp 14/01/02
$ENV{PATH}="/sbin:/bin:/usr/sbin:/usr/bin";
# We *really* should clear *all* environment bar what we *know* we
# need here. It will avoid surprises (like bash running BASH_ENV or
# SpamAssassin using $ENV{HOME} rather than getpwnam to decide where
# to drop its load.
# Needed for -T:
delete $ENV{'BASH_ENV'}; # Don't run things on bash startup
# Needed for SpamAssassin:
delete $ENV{'HOME'};
# Need the parent process to ignore SIGHUP, and catch SIGTERM
$SIG{'HUP'} = 'IGNORE';
$SIG{'TERM'} = \&ExitParent;
# Remember to update this before releasing a new version of MailScanner.
#
# Version numbering scheme is this:
# 4 Major release
# 00 Minor release, incremented for new features and major changes
# 0 Incremented for bug fixes and beta releases
# Any numbers after a "-" are packaging release numbers. They reflect
# changes in the packaging, and occasionally very small changes to the code.
#
# First production release will be 4.00.1.
#
$MailScanner::Config::MailScannerVersion = '4.60.5';
my $WantHelp = 0;
my $Versions = 0;
my $WantLintOnly = 0;
my $WantChangedOnly = 0;
my $WantRuleCheck = "";
my $RuleCheckFrom = "";
my @RuleCheckTo = "";
my $RuleCheckIP = "";
my $RuleCheckVirus = "";
my $PidFile = "";
my $Debug = "";
my $DebugSpamAssassin = 0;
my $result = GetOptions ("h|H|help" => \$WantHelp,
"v|V|version|Version" => \$Versions,
"lint" => \$WantLintOnly,
"c|C|changed" => \$WantChangedOnly,
"value=s" => \$WantRuleCheck,
"from=s" => \$RuleCheckFrom,
"to=s@" => \@RuleCheckTo,
"ip=s" => \$RuleCheckIP,
"virus=s" => \$RuleCheckVirus,
"debug" => \$Debug,
"debug-sa" => \$DebugSpamAssassin);
if ($WantHelp) {
print STDERR "Usage:\n";
print STDERR "MailScanner [ -h|-v|--debug|--debug-sa|--lint ] |\n";
print STDERR " [ -c|--changed ] |\n";
print STDERR " [--value=<option-name> --from=<from-address>\n";
print STDERR " --to=<to-address>, --to=<to-address-2>, ...]\n";
print STDERR " --ip=<ip-address>, --virus=<virus-name> ]\n";
print STDERR " <MailScanner.conf-file-location>\n";
exit 0;
}
# Are we just printing version numbers and exiting?
if ($Versions) {
my @Modules = qw/AnyDBM_File Archive::Zip bignum Carp Convert::BinHex Convert::TNEF Data::Dumper DirHandle Fcntl File::Basename File::Copy FileHandle File::Path File::Temp Filesys::Df HTML::Entities HTML::Parser HTML::TokeParser IO IO::File IO::Pipe Mail::ClamAV Mail::Header Mail::SpamAssassin Math::BigInt Math::BigRat MIME::Base64 MIME::Decoder MIME::Decoder::UU MIME::Head MIME::Parser MIME::QuotedPrint MIME::Tools MIME::WordDecoder Net::CIDR Net::IP POSIX Scalar::Util Socket Sys::Hostname::Long Sys::Syslog Test::Simple Time::HiRes Time::localtime/;
my @Optional = qw#Archive/Tar.pm bignum.pm Business/ISBN.pm Business/ISBN/Data.pm Convert/TNEF.pm Data/Dump.pm DB_File.pm DBD/SQLite.pm DBI.pm Digest.pm Digest/HMAC.pm Digest/MD5.pm Digest/SHA1.pm Encode/Detect.pm Error.pm ExtUtils/CBuilder.pm ExtUtils/ParseXS.pm Inline.pm IO/String.pm IO/Zlib.pm IP/Country.pm Mail/ClamAV.pm Mail/SpamAssassin.pm Mail/SPF.pm Mail/SPF/Query.pm Math/BigRat.pm Module/Build.pm Net/CIDR/Lite.pm Net/DNS.pm Net/DNS/Resolver/Programmable.pm Net/LDAP.pm NetAddr/IP.pm Parse/RecDescent.pm SAVI.pm Test/Harness.pm Test/Manifest.pm Text/Balanced.pm URI.pm version.pm YAML.pm#;
my($module, $s, $v, $m);
printf("Running on\n%s", `uname -a`);
printf("This is %s", `cat /etc/redhat-release`) if -f "/etc/redhat-release";
printf("This is %s", `head -1 /etc/SuSE-release`) if -f "/etc/SuSE-release";
printf("This is Perl version %f (%vd)\n", $], $^V);
print "\nThis is MailScanner version " . $MailScanner::Config::MailScannerVersion . "\n";
print "Module versions are:\n";
foreach $module (@Modules) {
$s = '$' . "$module" . '::VERSION';
$v = eval("$s");
print "$v\t$module\n" if $v ne "";
}
print "\nOptional module versions are:\n";
foreach $module (@Optional) {
$m = $module;
$m =~ s/\//::/g;
$m =~ s/\.pm$//;
$s = '$' . "$m" . '::VERSION';
$v = eval("require \"$module\"; $s") || "missing";
print "$v\t$m\n";
}
exit;
}
# Work out what directory we're in and add it onto the front
# of the include path so that we can work if we're just chucked
# any old where in a directory with the modules. Also add
# ./MailScanner for v4.
#
# Also get process name while we're at it.
#
my $dir = $0;
# can't use s/// as it doesn't untaint $dir
$dir =~ m#^(.*)/([^/]+)$#;
$dir = $1;
$MailScanner::Config::MailScannerProcessName = ""; # Avoid 'used only once' warning BS.
$MailScanner::Config::MailScannerProcessName = $2;
# Add my directory onto the front of the include path
unless ($autoinstalled) {
unshift @INC, "$dir/MailScanner";
unshift @INC, $dir;
}
# Set umask nice and safe so no-one else can access anything!
umask 0077;
# Find the mailscanner.conf file, with a default just in case.
my $ConfFile = $ARGV[0];
$ConfFile = '/usr/local/etc/MailScanner/MailScanner.conf' if $ConfFile eq "";
# Check the MailScanner version number against what is in MailScanner.conf
my $NeedVersion = MailScanner::Config::QuickPeek($ConfFile,
'mailscannerversionnumber');
if ($NeedVersion) {
my($ConfMajor, $ConfMinor, $ConfRelease);
my($Error, $AreMajor, $AreMinor, $AreRelease);
$Error = 0;
$NeedVersion =~ /^(\d+)\.(\d+)\.(\d+)$/;
($ConfMajor, $ConfMinor, $ConfRelease) = ($1+0, $2+0, $3+0);
$ConfMajor = 0 unless $ConfMajor;
$ConfMinor = 0 unless $ConfMinor;
$ConfRelease = 0 unless $ConfRelease;
$MailScanner::Config::MailScannerVersion =~ /^(\d+)\.(\d+)\.(\d+)$/;
($AreMajor, $AreMinor, $AreRelease) = ($1+0, $2+0, $3+0);
$AreMajor = 0 unless $AreMajor;
$AreMinor = 0 unless $AreMinor;
$AreRelease = 0 unless $AreRelease;
if ($ConfMajor > $AreMajor) {
$Error = 1;
} elsif ($ConfMajor == $AreMajor) {
if ($ConfMinor > $AreMinor) {
$Error = 1;
} elsif ($ConfMinor == $AreMinor) {
if ($ConfRelease > $AreRelease) {
$Error = 1;
}
}
}
if ($Error) {
print STDERR "The configuration file $ConfFile\nis too new for this version of MailScanner.\nThis is version " . $MailScanner::Config::MailScannerVersion . " but the config file is for at least version $NeedVersion\n";
exit 1;
}
}
# Check they have configured a virus scanner and the name of their site.
if (MailScanner::Config::QuickPeek($ConfFile, 'virusscanners', 'notifldap')
eq "none") {
print STDERR <<EONONE;
Currently you are using no virus scanners.
This is probably not what you want.
In your /usr/local/etc/MailScanner/MailScanner.conf file, set
Virus Scanners = clamav
Then download
http://www.sng.ecs.soton.ac.uk/mailscanner/files/4/install-Clam-SA.tar.gz
Unpack it, "cd" into the directory and run ./install.sh
EONONE
}
my $NotConfigured = 0;
$NotConfigured++ if MailScanner::Config::QuickPeek($ConfFile,
'%org-name%', 'notifldap')
eq "yoursite";
$NotConfigured++ if MailScanner::Config::QuickPeek($ConfFile,
'%org-long-name%',
'notifldap')
eq "Your Organisation Name Here";
$NotConfigured++ if MailScanner::Config::QuickPeek($ConfFile,
'%web-site%', 'notifldap')
eq "www.your-organisation.com";
if ($NotConfigured == 3) {
# Set them all to be something sensible
my $domain_name = hostname_long;
$domain_name =~ s/^[^.]+\.//;
my $header_domain = $domain_name;
$header_domain =~ tr/./_/; # So as not to kill Symantec's broken scanner
MailScanner::Config::SetPercent('org-name', $header_domain);
MailScanner::Config::SetPercent('org-long-name', $domain_name);
MailScanner::Config::SetPercent('web-site', 'www.' . $domain_name);
}
# Set an indication of the version number for rules.
MailScanner::Config::SetPercent('version', $MailScanner::Config::MailScannerVersion);
# Load the MTA modules we need
my($MTAmod, $MTADSmod);
# LEOH:if (MailScanner::Config::QuickPeek($ConfFile, 'mta') =~ /exim/i) {
$_=MailScanner::Config::QuickPeek($ConfFile, 'mta');
if (/exim/i) {
$MTAmod = 'Exim.pm';
$MTADSmod = 'EximDiskStore.pm';
} elsif(/zmailer/i) {
$MTAmod = 'ZMailer.pm';
$MTADSmod = 'ZMDiskStore.pm';
} elsif(/postfix/i) {
$MTAmod = 'Postfix.pm';
$MTADSmod = 'PFDiskStore.pm';
} elsif(/qmail/i) {
$MTAmod = 'Qmail.pm';
$MTADSmod = 'QMDiskStore.pm';
} else {
$MTAmod = 'Sendmail.pm';
$MTADSmod = 'SMDiskStore.pm';
}
require "MailScanner/$MTAmod";
require "MailScanner/$MTADSmod";
# All they want is the list of settings that have been changed from the
# default values hard-coded into ConfigDefs.pl. These values may well be
# different from those supplied in the default MailScanner.conf file.
if ($WantChangedOnly) {
MailScanner::Config::Read($ConfFile);
MailScanner::Config::PrintNonDefaults();
exit 0;
}
# If all we are doing is linting the configuration file, then do it here
# and get out.
if ($WantLintOnly) {
# Read the configuration file and start logging to syslog/stderr
StartLogging($ConfFile);
my $logbanner = "MailScanner E-Mail Virus Scanner version " .
$MailScanner::Config::MailScannerVersion .
" checking configuration...\n";
MailScanner::Log::Configure($logbanner, 'stderr');
# Read the configuration file properly
MailScanner::Config::Read($ConfFile);
# Tried to set [u,g]id after writing pid, but then it fails when it re-execs
# itself. Using the posix calls because I don't want to have to bother to
# find out what happens when "$< = $uid" fails (i.e. not running as root).
# This needs to be global so checking functions can all get at them.
# This now also adds group membership for the quarantine and work directories.
my($uname, $gname, $qgname, $igname, $uid, $gid, $qgid, $igid);
$uname = MailScanner::Config::Value('runasuser');
$gname = MailScanner::Config::Value('runasgroup');
$qgname= MailScanner::Config::Value('quarantinegroup');
$igname= MailScanner::Config::Value('workgroup');
$uid = $uname?getpwnam($uname):0;
$gid = $gname?getgrnam($gname):0;
$qgid = $qgname?getgrnam($qgname):0;
$igid = $igname?getgrnam($igname):0;
# Check the version number in MailScanner.conf is correct.
my($currentver, $confver);
$currentver = $MailScanner::Config::MailScannerVersion;
$confver = MailScanner::Config::Value('mailscannerversionnumber');
#print STDERR "Running ver = $currentver\nConf ver = $confver\n";
print STDERR "Checking version numbers...\n";
if ($currentver ne $confver) {
print STDERR "Version installed ($currentver) does not match version stated in\nMailScanner.conf file ($confver), you may want to run upgrade_MailScanner_conf\nto ensure your MailScanner.conf file contains all the latest settings.\n";
} else {
print STDERR "Version number in MailScanner.conf ($confver) is correct.\n";
}
# Need to find the PidFile before changing uid/gid as its ownership will need
# to be set to the new uid/gid. It must be created first if necessary.
# Need PidFile to be able to manage pid of parent process
$PidFile = MailScanner::Config::Value('pidfile');
WritePIDFile("MailScanner");
chown $uid, $gid, $PidFile;
my $workarea = new MailScanner::WorkArea;
my $inqueue = new MailScanner::Queue(
@{MailScanner::Config::Value('inqueuedir')});
my $mta = new MailScanner::Sendmail;
my $quar = new MailScanner::Quarantine;
$global::MS = new MailScanner(WorkArea => $workarea,
InQueue => $inqueue,
MTA => $mta,
Quarantine => $quar);
SetUidGid($uid, $gid, $qgid, $igid);
print STDERR "\nChecking for SpamAssassin errors (if you use it)...\n";
MailScanner::SA::initialise(0,1); # Just do a Lint check
MailScanner::Lock::initialise();
#print STDERR "\nLock type = " . MailScanner::Lock::ReportLockType() . "\n";
print STDERR "MailScanner.conf says \"Virus Scanners = " .
MailScanner::Config::Value('virusscanners') . "\"\n";
my @scannerlist = MailScanner::SweepViruses::InstalledScanners();
print STDERR "Found these virus scanners installed: " .
join(', ', @scannerlist) . "\n";
exit;
}
# Do they want us to work out the value of a rule
if ($WantRuleCheck ne "") {
my($rule,$user,$domain,$to,$msg,$result);
# Read the configuration file properly
MailScanner::Config::Read($ConfFile);
# We have external configuration name, first translate it to internal
$WantRuleCheck = lc($WantRuleCheck);
$WantRuleCheck =~ s/[^a-z0-9]//g; # Leave numbers and letters only
$rule = MailScanner::Config::EtoI($WantRuleCheck);
$rule = $WantRuleCheck if $rule eq "";
$msg = MailScanner::Message->new('1','/tmp','fake');
$RuleCheckFrom = lc($RuleCheckFrom);
($user, $domain) = ($1,$2) if $RuleCheckFrom =~ /^([^@]*)@(.*)$/;
$msg->{from} = $RuleCheckFrom;
$msg->{fromdomain} = $domain;
$msg->{fromuser} = $user;
$msg->{clientip} = $RuleCheckIP;
%{$msg->{allreports}} = ();
$msg->{allreports}{""} = $RuleCheckVirus;
foreach $to (@RuleCheckTo) {
$to = lc($to);
next unless $to;
($user, $domain) = ($1,$2) if $to =~ /^([^@]*)@(.*)$/;
push @{$msg->{to}}, $to;
push @{$msg->{todomain}}, $domain;
push @{$msg->{touser}}, $user;
}
$result = MailScanner::Config::Value($rule, $msg);
print STDERR "Looked up internal option name \"$rule\"\n";
print STDERR "With sender = " . $msg->{from} . "\n";
foreach $to (@{$msg->{to}}) {
next unless $to;
print STDERR " recipient = " . $to . "\n";
}
print STDERR "Client IP = " . $msg->{clientip} . "\n";
print STDERR "Virus = " . $msg->{allreports}{""} . "\n";
print STDERR "Result is \"$result\"\n";
print STDERR "\n0=No 1=Yes\n" if $result =~ /^[01]$/;
exit 0;
}
# In case we lose privs to the file later, delete the SA signaller now
my $startlock = MailScanner::Config::QuickPeek($ConfFile, 'lockfiledir') .
'/MS.bayes.starting.lock';
unlink $startlock if $startlock && -f $startlock;
# Tried to set [u,g]id after writing pid, but then it fails when it re-execs
# itself. Using the posix calls because I don't want to have to bother to
# find out what happens when "$< = $uid" fails (i.e. not running as root).
# This needs to be global so checking functions can all get at them.
# This now also adds group membership for the quarantine and work directories.
my($uname, $gname, $qgname, $igname, $uid, $gid, $qgid, $igid);
$uname = MailScanner::Config::QuickPeek($ConfFile, 'runasuser');
$gname = MailScanner::Config::QuickPeek($ConfFile, 'runasgroup');
$qgname= MailScanner::Config::QuickPeek($ConfFile, 'quarantinegroup');
$igname= MailScanner::Config::QuickPeek($ConfFile, 'incomingworkgroup');
$uid = $uname?getpwnam($uname):0;
$gid = $gname?getgrnam($gname):0;
$qgid = $qgname?getgrnam($qgname):0;
$igid = $igname?getgrnam($igname):0;
# Need to find the PidFile before changing uid/gid as its ownership will need
# to be set to the new uid/gid. It must be created first if necessary.
# Need PidFile to be able to manage pid of parent process
$PidFile = MailScanner::Config::QuickPeek($ConfFile, 'pidfile');
WritePIDFile("MailScanner");
chown $uid, $gid, $PidFile;
SetUidGid($uid, $gid, $qgid, $igid);
CheckModuleVersions();
# Can't do this here, config not read yet: CheckQueuesAreTogether();
#
# Need MaxChildren to know how many children to fork
# Debug to know whether to terminate
# WorkDir to be able to clean up after killed children
# BayesRebuildPeriod to be able to rebuild the Bayes database regularly
#
use vars qw($RunInForeground);
$RunInForeground= MailScanner::Config::QuickPeek($ConfFile, 'runinforeground');
my $MaxChildren = MailScanner::Config::QuickPeek($ConfFile, 'maxchildren');
$Debug .= MailScanner::Config::QuickPeek($ConfFile, 'debug');
my $WorkDir = MailScanner::Config::QuickPeek($ConfFile, 'incomingworkdir');
my $BayesRebuildPeriod = MailScanner::Config::QuickPeek($ConfFile, 'rebuildbayesevery');
# FIXME: we should check that the ownership and modes on piddir do not
# allow random people to do nasty things in there (like create symlinks
# to critical system files, or create pidfiles that point to critical
# system processes)
$Debug = 0 unless $Debug =~ /yes|1/i;
$RunInForeground = 0 unless $RunInForeground =~ /yes|1/i;
# Enable STDOUT flushing if running in foreground
# to be able to actively capture it with a logger
$| = 1 if $RunInForeground;
# Give the user their shell back
ForkDaemon($Debug);
# Only write the parent pid, not the children yet
WritePIDFile($$);
#
# Do it only once when debugging.
#
if ($Debug) {
WorkForHours();
print STDERR "Stopping now as you are debugging me.\n";
exit 0;
}
#
# Start forking off child workers.
#
setpgrp();
$MaxChildren = 1 if $MaxChildren<1; # You can't have 0 workers
my $NumberOfChildren = 0;
my %Children;
my $NextRebuildDueTime = 0;
my $RebuildDue = 0;
# Set when the next rebuild is due if regular rebuilds are being done
$NextRebuildDueTime = time + $BayesRebuildPeriod if $BayesRebuildPeriod;
# If we run in foreground, SIGKILL to the parent will try to reload
# by SIGKILLing its children
$SIG{'HUP'} = 'ReloadParent'; # JKF 20060731 if $RunInForeground;
for (;;) {
while($NumberOfChildren < $MaxChildren) {
$0 = 'MailScanner: starting children';
# Trigger 1 Bayes rebuild if the period has expired
$RebuildDue = 0;
if (time > $NextRebuildDueTime && $BayesRebuildPeriod) {
$RebuildDue = 1;
$NextRebuildDueTime = time + $BayesRebuildPeriod;
}
print STDOUT sprintf("About to fork child #%d of %d...\n",
$NumberOfChildren+1, $MaxChildren)
if $RunInForeground;
my $born_pid = fork();
if (!defined($born_pid)) {
die "Cannot fork off child process, $!";
}
if ($born_pid == 0) {
# I am a child process.
# Set up SIGHUP handler and
# Run MailScanner for a few hours.
WorkForHours($RebuildDue);
exit 0;
}
print STDOUT "\tForked OK - new child is [$born_pid]\n" if $RunInForeground;
# I am the parent process.
$Children{$born_pid} = 1;
$NumberOfChildren++;
sleep 5; # Dropped this from 11 2006-11-01
}
# I have started enough children. Let's wait for one to die...
my $dying_pid;
$0 = 'MailScanner: master waiting for children, sleeping';
until (($dying_pid = wait()) == -1) {
my $exitstatus = $?;
$0 = 'MailScanner: waiting for children to die';
#if ($dying_pid == -1) {
# warn "We haven't got any child processes, which isn't right!, $!";
#}
if ($dying_pid>0 && exists($Children{$dying_pid})) {
# Knock the dying process off the list and decrement the counter.
delete $Children{$dying_pid};
$NumberOfChildren--;
# Don't have Pid files for children any more
# DeletePIDFile($dying_pid);
if ($exitstatus) {
# $? = (exit_status << 8) | (signal_it_died_from)
my $code = $exitstatus >> 8;
my $signal = $exitstatus & 0xFF;
MailScanner::Log::WarnLog("Process did not exit cleanly, returned " .
"%d with signal %d", $code, $signal);
}
# Clean up after the dying process in case it left a mess.
# If they change the work dir they really will have to stop and re-start.
rmtree("$WorkDir/$dying_pid", 0, 1) if -d "$WorkDir/$dying_pid";
#
# Re-spawn a replacement child process
#
# Trigger 1 Bayes rebuild if the period has expired
$RebuildDue = 0;
if (time > $NextRebuildDueTime && $BayesRebuildPeriod) {
$RebuildDue = 1;
$NextRebuildDueTime = time + $BayesRebuildPeriod;
}
print STDOUT sprintf("About to re-fork child #%d of %d...\n",
$NumberOfChildren+1, $MaxChildren)
if $RunInForeground;
$0 = 'MailScanner: starting child';
my $born_pid = fork();
if (!defined($born_pid)) {
die "Cannot fork off child process, $!";
}
if ($born_pid == 0) {
# I am a child process.
# Set up SIGHUP handler and
# Run MailScanner for a few hours.
WorkForHours($RebuildDue);
exit 0;
}
print STDOUT "\tRe-forked OK - new child is [$born_pid]\n"
if $RunInForeground;
# I am the parent process.
$Children{$born_pid} = 1;
$NumberOfChildren++;
sleep 5; # Dropped this from 11 2006-11-01
} else {
warn "We have just tried to reap a process which wasn't one of ours!, $!";
}
}
}
#if ($Debug) {
# print STDERR "Stopping now as you are debugging me.\n";
# exit 0;
#}
print STDERR "Oops, tried to go into Never Never Land!\n";
exit 1;
#
#
#
#
#
# The End
#
#
#
#
#
#
# Start each of the worker processes here.
# Just run for a few hours and then terminate.
# If we are debugging, then just run once.
#
sub WorkForHours {
my ($BayesRebuild) = @_; # Should we start by rebuilding Bayes databases
# Read the configuration file and start logging to syslog/stderr
StartLogging($ConfFile);
# Check the programs listed in SystemDefs.pl as some of them
# might be wrong
# This is now obsolete as all references to it have been removed
#CheckSystemDefs();
# Setup SIGHUP and SIGTERM handlers
$SIG{'HUP'} = \&ExitChild;
#$SIG{'CHLD'} = \&Reaper; # Addition by Bart Jan Buijs
$SIG{'TERM'} = 'DEFAULT';
# Read the directory containing all the custom code
MailScanner::Config::initialise(MailScanner::Config::QuickPeek($ConfFile,
'customfunctionsdir'));
# Read the configuration file properly
MailScanner::Config::Read($ConfFile);
# Check the home directory exists and is writable,
# otherwise SA will fail, as it wants to write Bayes databases and all
# sorts of other stuff in the home directory.
CheckHomeDir()
if MailScanner::Config::Value('spamassassinuserstatedir') eq "";
# Initialise class variables now we are the right user
MailScanner::MessageBatch::initialise();
MailScanner::MCP::initialise();
MailScanner::Log::InfoLog("Bayes database rebuild is due") if $BayesRebuild;
$MailScanner::SA::Debug = $DebugSpamAssassin ||
MailScanner::Config::Value('debugspamassassin');
MailScanner::SA::initialise($BayesRebuild);
MailScanner::TNEF::initialise();
# Setup the Sendmail and Sendmail2 variables if they aren't set yet
MailScanner::Sendmail::initialise();
CheckQueuesAreTogether(); # Can only do this after reading conf file
MailScanner::SweepViruses::initialise(); # Setup Sophos SAVI library
my $workarea = new MailScanner::WorkArea;
my $inqueue = new MailScanner::Queue(
@{MailScanner::Config::Value('inqueuedir')});
my $mta = new MailScanner::Sendmail;
my $quar = new MailScanner::Quarantine;
$global::MS = new MailScanner(WorkArea => $workarea,
InQueue => $inqueue,
MTA => $mta,
Quarantine => $quar);
# Setup the lock type depending on which MTA we are using
MailScanner::Lock::initialise();
# Clean up the entire outgoing sendmail queue in case I was
# killed off half way through processing some messages.
# JKF Can't do this easily any more as the outgoing queue dir is the
# result of a ruleset.
# And I can't work out which class to put it in :-(
#my($CleanUpList);
#$CleanUpList = $global::MS->{inq}->ListWholeQueue(
# $global::MS->{inq}->{dir});
#Sendmail::ClearOutQueue($CleanUpList, $Config::OutQueueDir);
my $batch; # Looks pretty insignificant, doesn't it? :-)
# Restart periodically, and handle time_t rollover in the year 2038
my($StartTime, $RestartTime);
$StartTime = time;
$RestartTime = $StartTime + MailScanner::Config::Value('restartevery');
my $FirstCheck = MailScanner::Config::Value('firstcheck');
MailScanner::Log::WarnLog("First Check must be set to MCP or spam")
unless $FirstCheck =~ /mcp|spam/i;
my $VirusBeforeSpamMCP = MailScanner::Config::Value('virusbeforespammcp');
while (time>=$StartTime && time<$RestartTime && !$BayesRebuild) {
$workarea->Clear();
$0 = 'MailScanner: waiting for messages';
$batch = new MailScanner::MessageBatch();
$global::MS->{batch} = $batch; # So MailWatch can read the batch properties
#print STDERR "Batch is $batch\n";
# Bail out immediately if we are using the Sophos SAVI library and it
# has been updated since the last batch. This has to be done after the
# batch has been created since it may sit for minutes/hours in
# MailScanner::MessageBatch::new.
if (MailScanner::SweepViruses::SAVIUpgraded()) {
MailScanner::Log::InfoLog("Sophos SAVI library has been " .
"updated, killing this child");
last;
}
# Also bail out if the ClamAV database has been upgraded
if (MailScanner::SweepViruses::ClamUpgraded()) {
MailScanner::Log::InfoLog("ClamAV virus database has been " .
"updated, killing this child");
last;
}
# Also bail out if the LDAP configuration serial number has changed.
if (MailScanner::Config::LDAPUpdated()) {
MailScanner::Log::InfoLog("LDAP configuration has changed, " .
"killing this child");
last;
}
#$batch->print();
# Archive untouched incoming messages to directories
$batch->ArchiveToFilesystem();
# Do this first as it is very cheap indeed. Reject unwanted messages.
$batch->RejectMessages();
# Have to do this very early as it's needed for MCP and spam bouncing
$global::MS->{work}->BuildInDirs($batch);
# Yes I know this isn't elegant, but it's very short so it will do :-)
my $UsingMCP = 0;
$UsingMCP = 1 unless MailScanner::Config::IsSimpleValue('mcpchecks') &&
!MailScanner::Config::Value('mcpchecks');
if ($FirstCheck =~ /mcp/i) {
# Do the MCP checks
if ($UsingMCP) {
$0 = 'MailScanner: MCP checks';
$batch->StartTiming('mcp', 'MCP Checks');
$batch->MCPChecks();
$batch->HandleMCP();
$batch->HandleNonMCP();
$batch->StopTiming('mcp', 'MCP Checks');
}
# Do the spam checks
$0 = 'MailScanner: spam checks';
$batch->StartTiming('spam', 'Spam Checks');
$batch->SpamChecks();
$batch->HandleSpam();
$batch->HandleHam();
$batch->StopTiming('spam', 'Spam Checks');
} else {
# Do the spam checks
$0 = 'MailScanner: spam checks';
$batch->StartTiming('spam', 'Spam Checks');
$batch->SpamChecks();
$batch->HandleSpam();
$batch->HandleHam();
$batch->StopTiming('spam', 'Spam Checks');
# Do the MCP checks
if ($UsingMCP) {
$0 = 'MailScanner: MCP checks';
$batch->StartTiming('mcp', 'MCP Checks');
$batch->MCPChecks();
$batch->HandleMCP();
$batch->HandleNonMCP();
$batch->StopTiming('mcp', 'MCP Checks');
}
}
# Deliver all the messages we are not scanning at all,
# and mark them for deletion.
# Then purge the deleted messages from disk.
$batch->DeliverUnscanned();
$batch->RemoveDeletedMessages();
# Extract all the attachments
$batch->StartTiming('virus', 'Virus Scanning');
# Moved upwards: $global::MS->{work}->BuildInDirs($batch);
$0 = 'MailScanner: extracting attachments';
$batch->Explode();
# Report all the unparsable messages, but don't delete anything
$batch->ReportBadMessages();
# Build all the MIME entities helper structures
$batch->CreateEntitiesHelpers();
#$batch->PrintNumParts();
#$batch->PrintFilenames();
# Do the virus scanning
$0 = 'MailScanner: virus scanning';
$batch->VirusScan();
#$batch->PrintInfections();
$batch->StopTiming('virus', 'Virus Scanning');
# Add the virus stats to the SpamAssassin cache so we know
# to keep this data for much longer.
$batch->AddVirusInfoToCache();
# Strip the HTML tags out of messages which the spam
# settings have asked us to strip.
# We want to do this to both messages for which the config
# option says we should strip, and for messages for which
# the spam actions say we should strip.
$batch->StartTiming('virus_processing', 'Virus Processing');
$0 = 'MailScanner : disarming and stripping HTML';
$batch->StripHTML();
$batch->DisarmHTML();
#$batch->PrintInfectedSections();
# Combine all the infection/problem reports
$batch->CombineReports();
# Quarantine all the infected attachments
$0 = 'MailScanner: quarantining infections';
$batch->QuarantineInfections();
# Quarantine all the disarmed HTML and others
$batch->QuarantineModifiedBody();
# Remove any infected spam from the spam+mcp archives
$batch->RemoveInfectedSpam();
# Find all the messages infected with "silent" viruses
$batch->FindSilentAndNoisyInfections();
# Clean all the infections out of the messages
$0 = 'MailScanner: cleaning messages';
$batch->Clean();
# Zip up all the attachments to compress them
$0 = 'MailScanner: compressing attachments';
$batch->ZipAttachments();
# Encapsulate the messages into message/rfc822 attachments as needed
$batch->Encapsulate();
# Sign all the uninfected messages
$batch->SignUninfected();
# Deliver all the uninfected messages
# and mark them for deletion
$batch->DeliverUninfected();
# Delete cleaned messages that are from a local domain if we
# aren't delivering cleaned messages from local domains,
# by marking them for deletion. This will also stop them being
# disinfected, which is fine. Also mark that they still need
# relevant warnings/notices to be sent about them.
# Then purge the deleted messages from disk.
$batch->DeleteUnwantedCleaned();
$batch->RemoveDeletedMessages();
## Find all the messages infected with "silent" viruses
#$batch->FindSilentAndNoisyInfections();
# Deliver all the "silent" infected messages
# and mark them for deletion
$0 = 'MailScanner: processing silent viruses';
$batch->DeliverOrDeleteSilent();
# Deliver all the cleaned messages
# and mark them for deletion
$0 = 'MailScanner: delivering cleaned messages';
$batch->DeliverCleaned();
$batch->RemoveDeletedMessages();
# Warn all the senders of messages with any non-silent infections
$0 = 'MailScanner: sending warnings';
$batch->WarnSenders();
# Warn all the notice recipents about all the viruses
$batch->WarnLocalPostmaster();
$batch->StopTiming('virus_processing', 'Virus Processing');
# Disinfect all possible messages and deliver to original recipients,
# and delete them as we go.
$batch->StartTiming('disinfection', 'Disinfection');
$0 = 'MailScanner: disinfecting macros';
$batch->DisinfectAndDeliver();
$batch->StopTiming('disinfection', 'Disinfection');
# Do all the time and speed logging
$batch->EndBatch();
# Look up a configuration parameter as the last thing we do so that the
# lookup operation can have side-effects such as logging stats about the
# message.
$0 = 'MailScanner: finishing batch';
$batch->LastLookup();
#print STDERR "\n\n3 times are $StartTime " . time . " $RestartTime\n\n\n";
# Only do 1 batch if debugging
last if $Debug;
}
$0 = 'MailScanner: child dying';
# Destroy the incoming work dir
$global::MS->{work}->Destroy();
# Close down all the user's custom functions
MailScanner::Config::EndCustomFunctions();
# Tear down any LDAP connection
MailScanner::Config::DisconnectLDAP();
if ($BayesRebuild) {
MailScanner::Log::InfoLog("MailScanner child dying after Bayes rebuild");
} else {
MailScanner::Log::InfoLog("MailScanner child dying of old age");
}
# Don't want to leave connections to 514/udp open
MailScanner::Log::Stop();
}
#
# SIGHUP handler. Just make the child exit neatly and the parent
# farmer process will create a new one which will re-read the config.
#
sub ExitChild {
my($sig) = @_; # Arg is signal name
MailScanner::Log::InfoLog("MailScanner child caught a SIG%s", $sig);
# Finish off any incoming queue file deletes that were pending
MailScanner::SMDiskStore::DoPendingDeletes();
# Delete SpamAssassin rebuild signaller
unlink $MailScanner::SA::BayesRebuildStartLock
if $MailScanner::SA::BayesRebuildStartLock;
# Kill off any commercial virus scanner process groups that are still running
kill -15, $MailScanner::SweepViruses::ScannerPID
if $MailScanner::SweepViruses::ScannerPID;
# Destroy the incoming work dir
$global::MS->{work}->Destroy() if $global::MS && $global::MS->{work};
# Close down all the user's custom functions
MailScanner::Config::EndCustomFunctions();
# Close down logging neatly
MailScanner::Log::Stop();
exit 0;
}
sub KillChildren {
my($child, @dirlist);
$0 = 'MailScanner: killing children, bwahaha!';
#print STDERR "Killing child processes...\n";
if ($RunInForeground) {
print STDOUT "Killing child processes ";
print STDOUT join( '/', keys %Children);
}
kill 1, keys %Children;
print STDOUT " and giving them time to die...\n" if $RunInForeground;
sleep 3; # Give them time to die peacefully
print STDOUT "Cleaning up..." if $RunInForeground;
# Clean up after the dying processes in case they left a mess.
foreach $child (keys %Children) {
#push @dirlist, "$WorkDir/$child" if -d "$WorkDir/$child";
rmtree("$WorkDir/$child", 0, 1) if -d "$WorkDir/$child";
}
print STDOUT "Done\n" if $RunInForeground;
}
#
# SIGKILL handler for parent process.
# HUP all the children, then keep working.
#
sub ReloadParent {
my($sig) = @_; # Arg is the signal name
print STDOUT "MailScanner parent caught a SIG$sig - reload\n"
if $RunInForeground;
KillChildren();
print STDOUT "MailScanner reloaded.\n" if $RunInForeground;
}
#
# SIGTERM handler for parent process.
# HUP all the children, then commit suicide.
# Cannot log as no logging in the parent.
#
sub ExitParent {
my($sig) = @_; # Arg is the signal name
print STDOUT "MailScanner parent caught a SIG$sig\n" if $RunInForeground;
KillChildren();
print STDOUT "Exiting MailScanner - Bye.\n" if $RunInForeground;
exit 0;
}
#
# Start logging
#
sub StartLogging {
my($filename) = @_;
# Create the syslog process name from stripping the conf filename down
# to the basename without the extension.
my $procname = $filename;
$procname =~ s#^.*/##;
$procname =~ s#\.conf$##;
my $logbanner = "MailScanner E-Mail Virus Scanner version " .
$MailScanner::Config::MailScannerVersion . " starting...";
MailScanner::Log::Configure($logbanner, 'syslog'); #'stderr');
# Need to know log facility *before* we have read the whole config file!
my $facility = MailScanner::Config::QuickPeek($filename, 'syslogfacility');
MailScanner::Log::Start($procname, $facility);
}
#
# Function to harvest dead children
#
sub Reaper {
1 until waitpid(-1, WNOHANG) == -1;
$SIG{'CHLD'} = \&Reaper; # loathe sysV
}
#
# Fork off and become a daemon so they get their shell back
#
sub ForkDaemon {
my($debug) = @_;
if ($debug) {
print STDERR "In Debugging mode, not forking...\n";
# Get current debugging flag, and invert it:
my $current = config MIME::ToolUtils 'DEBUGGING';
#config MIME::ToolUtils DEBUGGING => !$current;
} elsif ($RunInForeground) {
# PERT-BBY we don't close STDXX neither fork() nor setsid()
# if we want to run in the foreground
print STDOUT "MailScanner $MailScanner::Config::MailScannerVersion " .
"starting in foreground mode - pid is [$$]\n";
} else {
$SIG{'CHLD'} = \&Reaper;
if (fork==0) {
# This child's parent is perl
#print STDERR "In the child\n";
# Close i/o streams to break connection with tty
close(STDIN);
close(STDOUT);
close(STDERR);
# Re-open the stdin, stdout and stderr file descriptors for
# sendmail's benefit. Should stop it squawking!
open(STDIN, "</dev/null");
open(STDOUT, ">/dev/null");
open(STDERR, ">/dev/null");
fork && exit 0;
# This new grand-child's parent is init
#print STDERR "In the grand-child\n";
$SIG{'CHLD'} = 'DEFAULT';
# Auto-reap children
# Causes problems on some OS's when wait is called
#$SIG{'CHLD'} = 'IGNORE';
setsid();
} else {
#print STDERR "In the parent\n";
wait; # Ensure child has exited
exit 0;
}
# This was the old simple code in the 2nd half of the if statement
#fork && exit;
#setsid();
}
}
#
# Set the current UID and GID if they are non-zero
#
#sub SetUidGid {
# my($uid, $gid) = @_;
#
# if ($gid) { # Only do this if setting to non-root
# #print STDERR "Setting GID to $gid\n";
# MailScanner::Log::InfoLog("MailScanner setting GID to $gname ($gid)");
# POSIX::setgid($gid) or MailScanner::Log::DieLog("Can't set GID $gid");
# }
# if ($uid) { # Only do this if setting to non-root
# #print STDERR "Setting UID to $uid\n";
# MailScanner::Log::InfoLog("MailScanner setting UID to $uname ($uid)");
# POSIX::setuid($uid) or MailScanner::Log::DieLog("Can't set UID $uid");
# }
# $) = $(;
# $> = $<;
#}
sub SetUidGid {
my($uid, $gid, $qgid, $igid) = @_;
if ($gid) { # Only do this if setting to non-root
#print STDERR "Setting GID to $gid\n";
MailScanner::Log::InfoLog("MailScanner setting GID to $gname ($gid)");
# assign in parallel to avoid tripping taint mode on
($(, $)) = ($gid, $gid);
$( == $gid && $) == $gid or die "Can't set GID $gid";
# We add 2 copies of the $gid as the second one is ignored by BSD!
$) = "$gid $gid $qgid $igid"; # Set the extra group memberships we need
} else {
$) = $(;
}
if ($uid) { # Only do this if setting to non-root
#print STDERR "Setting UID to $uid\n";
MailScanner::Log::InfoLog("MailScanner setting UID to $uname ($uid)");
# assign in parallel to avoid tripping taint mode on
($<, $>) = ($uid, $uid);
$< == $uid && $> == $uid or die "Can't set UID $uid";
} else {
$> = $<;
}
}
#
# Check the home directory of the user exists and is writable
#
sub CheckHomeDir {
my $home = (getpwuid($<))[7];
MailScanner::Log::WarnLog("User's home directory $home does not exist")
unless -d $home;
unless (-w $home ||
(MailScanner::Config::IsSimpleValue('usespamassassin') &&
!MailScanner::Config::Value('usespamassassin'))) {
MailScanner::Log::WarnLog("User's home directory $home is not writable");
MailScanner::Log::WarnLog("You need to set the \"SpamAssassin User " .
"State Dir\" to a directory that the \"Run As User\" can write to");
}
}
# This is now obsolete as no references to SystemDefs exist any more.
##
## Check all of the programs whose locations are set in SystemDefs.pl
## as some of them might be wrong, which will cause it to fail very
## quietly.
##
#sub CheckSystemDefs {
# my($prog, $errors);
# $errors = 0;
# foreach $prog ($global::rm, $global::cp, $global::cat, $global::sed) {
# next if -x $prog;
# MailScanner::Log::WarnLog("The location of %s in SystemDefs.pm is wrong",
# $prog);
# $errors++;
# }
# MailScanner::Log::DieLog("Aborting due to SystemDefs.pm errors") if $errors;
#}
#
# Check the versions of the MIME and SpamAssassin modules
#
sub CheckModuleVersions {
my($module_version);
# Check the MIME-tools version
MailScanner::Log::DieLog("FATAL: Newer MIME::Tools module needed: " .
"MIME::Tools is only %s -- 5.412 required",
$MIME::Tools::VERSION)
if defined $MIME::Tools::VERSION &&
$MIME::Tools::VERSION<"5.412";
# And check the SpamAssassin version
MailScanner::Log::DieLog("FATAL: Newer Mail::SpamAssassin module needed: " .
"Mail::SpamAssassin is only %s -- 2.1 required",
$Mail::SpamAssassin::VERSION)
if defined $Mail::SpamAssassin::VERSION &&
$Mail::SpamAssassin::VERSION<"2.1";
}
#
# Check the incoming and (default) outgoing queues are on the same filesystem.
# MailScanner cannot work fast enough if they are in different filesystems.
#
#
# Check the incoming and outgoing queues are on the same device.
# Can only check the default outgoing queue, but that will be
# enough for most users.
#
sub CheckQueuesAreTogether {
my($indevice, $outdevice, @instat, @outstat);
my($inuid, $outuid, $ingrp, $outgrp);
my @inqdirs;
my $outqdir = MailScanner::Config::Value('outqueuedir');
push @inqdirs, @{MailScanner::Config::Value('inqueuedir')};
#print STDERR "Queues are \"" . join('","',@inqdirs) . "\"\n";
#MailScanner::Log::WarnLog("Queuedir is %s", $outqdir);
#Outq cannot be split: MailScanner::Sendmail::CheckQueueIsFlat($outqdir);
chdir($outqdir); # This should be the default
@outstat = stat('.');
($outdevice, $outuid, $outgrp) = @outstat[0,4,5];
MailScanner::Log::DieLog("%s is not owned by user %d !", $outqdir, $uid)
if $uid && ($outuid != $uid);
my($inqdir);
foreach $inqdir (@inqdirs) {
# FIXME: $inqdir is somehow tained: work out why!
$inqdir =~ /(.*)/;
$inqdir = $1;
#MailScanner::Log::WarnLog("Inq %s", $inqdir);
MailScanner::Sendmail::CheckQueueIsFlat($inqdir);
chdir($inqdir);
@instat = stat('.');
($indevice, $inuid, $ingrp) = @instat[0,4,5];
MailScanner::Log::DieLog("%s & %s must be on the same filesystem/" .
"partition!", $inqdir, $outqdir)
unless $indevice == $outdevice;
MailScanner::Log::DieLog("%s is not owned by user %d !", $inqdir, $uid)
if $uid && ($inuid != $uid);
}
}
#
# Create and write a PID file for a given process id
#
sub WritePIDFile {
my($process) = @_;
my $pidfh = new FileHandle;
$pidfh->open(">$PidFile")
or MailScanner::Log::WarnLog("Cannot write pid file %s, %s", $PidFile, $!);
print $pidfh "$process\n";
$pidfh->close();
}
##
## Delete the PID file for a given process id
##
#sub DeletePIDFile {
# my($process) = @_;
# unlink("$PidDir/MailScanner.$process");
#}
syntax highlighted by Code2HTML, v. 0.9.1