#!/usr/bin/perl -I/usr/lib/MailScanner
#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: mailscanner,v 1.142.2.7 2003/03/01 13:00:58 jkf Exp $
#
#   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;

use FileHandle;
use IO::Handle;
use MailScanner::Config;
use MailScanner::CustomConfig;
use MailScanner::Lock;
use MailScanner::Log;
use MailScanner::Mail;
use MailScanner::MessageBatch;
use MailScanner::Message;
use MailScanner::Quarantine;
use MailScanner::Queue;
use MailScanner::RBLs;
use MailScanner::SA;
# Now done in a require: use MailScanner::Sendmail;
# Now done in a require: use MailScanner::SMDiskStore;
use MailScanner::SweepContent;
use MailScanner::SweepOther;
use MailScanner::SweepViruses;
use MailScanner::SystemDefs;
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
# a1  1st Alpha release
# Any numbers after a "-" are packaging release numbers. They reflect
# changes in the packaging, not in the MailScanner code itself.
#
# First production release will be 4.00.1.
#
$MailScanner::Config::MailScannerVersion = '4.13-3';

# 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 = '/etc/MailScanner/MailScanner.conf' unless $ConfFile;

# Load the MTA modules we need
my($MTAmod, $MTADSmod);
if (MailScanner::Config::QuickPeek($ConfFile, 'mta') =~ /exim/i) {
  $MTAmod = 'Exim.pm';
  $MTADSmod = 'EximDiskStore.pm';
} else {
  $MTAmod = 'Sendmail.pm';
  $MTADSmod = 'SMDiskStore.pm';
}
require "MailScanner/$MTAmod";
require "MailScanner/$MTADSmod";

# 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.
my($uname, $gname, $uid, $gid);
$uname = MailScanner::Config::QuickPeek($ConfFile, 'runasuser');
$gname = MailScanner::Config::QuickPeek($ConfFile, 'runasgroup');
$uid   = $uname?getpwnam($uname):0;
$gid   = $gname?getgrnam($gname):0;

SetUidGid($uid, $gid);
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
#      PidFile     to be able to manage pid of parent process
#
my $MaxChildren = MailScanner::Config::QuickPeek($ConfFile, 'children');
my $Debug       = MailScanner::Config::QuickPeek($ConfFile, 'debug');
my $WorkDir     = MailScanner::Config::QuickPeek($ConfFile, 'incomingworkdir');
my $PidFile     = MailScanner::Config::QuickPeek($ConfFile, 'pidfile');
# 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;

# 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) {
  # Get current debugging flag, and invert it:
  my $current = config MIME::ToolUtils 'DEBUGGING';
  #config MIME::ToolUtils DEBUGGING => !$current;

  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;

for (;;) {
  while($NumberOfChildren < $MaxChildren) {
    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();
      exit 0;
    }
    # I am the parent process.
    $Children{$born_pid} = 1;
    $NumberOfChildren++;
    sleep 10;
  }

  # I have started enough children. Let's wait for one to die...
  my $dying_pid = wait();
  my $exitstatus = $?;

  #if ($dying_pid == -1) {
  #  warn "We haven't got any child processes, which isn't right!, $!";
  #}
  if ($dying_pid>0 && !exists($Children{$dying_pid})) {
    warn "We have just tried to reap a process which wasn't one of ours!, $!";
  }

  # 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 the child aborted abnormally, gradually make everything stop by
  # not forking new processes to replace the dead ones.
  # Let it be re-created if it died from a SIGHUP
  # $? = (exit_status << 8) | (signal_it_died_from)
  #print STDERR "Exit status from $dying_pid = $exitstatus\n";
  $MaxChildren = 0 if $exitstatus;

  # 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.
  system($global::rm, "-rf", "$WorkDir/$dying_pid")
    if -d "$WorkDir/$dying_pid";

  # Don't start more children if we are debugging.
  #last if $Debug;
}

#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 {
  # 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");

  # Read the configuration file and start logging to syslog/stderr
  StartLogging($ConfFile);

  # Check the home directory exists and is writable,
  # otherwise SA will fail
  CheckHomeDir();

  # Setup SIGHUP and SIGTERM handlers
  $SIG{'HUP'}  = \&ExitChild;
  $SIG{'TERM'} = 'DEFAULT';

  # Read the configuration file properly
  MailScanner::Config::Read($ConfFile);

  # Initialise class variables now we are the right user
  CheckQueuesAreTogether(); # Can only do this after reading conf file
  MailScanner::MessageBatch::initialise();
  MailScanner::SA::initialise();
  MailScanner::TNEF::initialise();
  # Setup the Sendmail and Sendmail2 variables if they aren't set yet
  MailScanner::Sendmail::initialise();

  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');

  while (time>=$StartTime && time<$RestartTime) {
    $workarea->Clear();
    $batch = new MailScanner::MessageBatch();
    #print STDERR "Batch is $batch\n";

    #$batch->print();

    # Archive untouched incoming messages to directories
    $batch->ArchiveToDirs();

    # Do the spam checks
    $batch->SpamChecks();
    $batch->HandleSpam();

    # 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
    $global::MS->{work}->BuildInDirs($batch);
    $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
    $batch->VirusScan();
    #$batch->PrintInfections();

    # 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->StripHTML();

    #$batch->PrintInfectedSections();

    # Combine all the infection/problem reports
    $batch->CombineReports();

    # Clean all the infections out of the messages
    $batch->Clean();

    # Quarantine all the infected attachments
    $batch->QuarantineInfections();

    # 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->FindSilentInfections();

    # Deliver all the "silent" infected messages
    # and mark them for deletion
    $batch->DeliverOrDeleteSilent();

    # Deliver all the cleaned messages
    # and mark them for deletion
    $batch->DeliverCleaned();
    $batch->RemoveDeletedMessages();

    # Warn all the senders of messages with any non-silent infections
    $batch->WarnSenders();

    # Warn all the notice recipents about all the viruses
    $batch->WarnLocalPostmaster();

    # Disinfect all possible messages and deliver to original recipients,
    # and delete them as we go.
    $batch->DisinfectAndDeliver();

    # 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.
    $batch->LastLookup();

    #print STDERR "\n\n3 times are $StartTime " . time . " $RestartTime\n\n\n";

    # Only do 1 batch if debugging
    last if MailScanner::Config::Value('debug');
  }

  # Destroy the incoming work dir
  $global::MS->{work}->Destroy();

  # Close down all the user's custom functions
  MailScanner::Config::EndCustomFunctions();

  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();
  # 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;
}


#
# 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
  my($child, @dirlist);

  #print STDERR "Killing child processes...\n";
  kill 1, keys %Children;
  sleep 3; # Give them time to die peacefully

  # Clean up after the dying processes in case they left a mess.
  foreach $child (keys %Children) {
    push @dirlist, "$WorkDir/$child" if -d "$WorkDir/$child";
  }

  system($global::rm . " -rf \"" . join("\" \"", @dirlist) . "\"")
    if @dirlist;

  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, 'logfacility');

  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;
  } 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);
      fork && exit 0;
      # This new grand-child's parent is init
      #print STDERR "In the grand-child\n";
      $SIG{'CHLD'} = 'DEFAULT';
      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");
  }
  $) = $(;
  $> = $<;
}


#
# 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;
  MailScanner::Log::WarnLog("User's home directory $home is not writable")
    unless -w $home;
}


#
# Check the versions of the MIME and SpamAssassin modules
#
sub CheckModuleVersions {
  my($varname, $module_version);

  # These version numbers are what come in the MIME-tools v5.410 package,
  # which I (nwp) use.
  my %mime_required = (
                       Parser     => "5.406",
                       Entity     => "5.404",
                       Tools      => "5.410",
                       Words      => "5.404",
                       Head       => "5.403",
                       Decoder    => "5.403",
                       Body       => "5.403",
  );

  no strict 'refs';

  foreach (keys %mime_required) {
    $varname = "MIME::". ucfirst lc($_) ."::VERSION";
    defined $$varname or next;
    $module_version = $$varname;
    $module_version >= $mime_required{$_} or
      MailScanner::Log::DieLog("FATAL: Newer MIME-tools module needed: %s" .
                               " is only MIME::$_ -- %s required",
                               $module_version, $mime_required{$_});
  }

  # And check the SpamAssassin version
  $varname = "Mail::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 = @{MailScanner::Config::Value('inqueuedir')};
  my $outqdir = MailScanner::Config::Value('outqueuedir');

  #MailScanner::Log::WarnLog("Queuedir is %s", $outqdir);
  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) = @_;

  #mkdir($PidDir, 0700) unless -d $PidDir;
  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");
#}

