#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: Message.pm,v 1.126.2.274 2006/01/20 21:38:29 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
#

package MailScanner::Message;

use strict 'vars';
use strict 'refs';
no  strict 'subs'; # Allow bare words for parameter %'s

use DirHandle;
use Time::localtime qw/ctime/;
use Time::HiRes qw/time/;
use MIME::Parser;
use MIME::Decoder::UU;
use MIME::Decoder::BinHex;
use MIME::WordDecoder;
use POSIX qw(:signal_h setsid);
use HTML::TokeParser;
use HTML::Parser;
use Archive::Zip qw( :ERROR_CODES );
#use MailScanner::BinHex;

# Install an extra MIME decoder for badly-header uue messages.
install MIME::Decoder::UU 'uuencode';
# Install an extra MIME decoder for binhex-encoded attachments.
install MIME::Decoder::BinHex 'binhex','binhex40','mac-binhex40','mac-binhex';

use vars qw($VERSION);

### The package version, both in 1.23 style *and* usable by MakeMaker:
$VERSION = substr q$Revision: 1.126.2.274 $, 10;

# Attributes are
#
# $id			set by new
# $store		set by new (is a SMDiskStore for now)
# #$hpath		set by new
# #$dpath		set by new
# $size			set by new (copy of $store->{size})
# #$inhhandle		set by new
# #$indhandle		set by new
# $from			set by ReadQf
# $fromdomain		set by new
# $fromuser		set by new
# @to			set by new
# @todomain		set by new
# @touser		set by new
# $subject		set by ReadQf
# @headers		set by ReadQf # just the headers, with /^H/ removed
#                       Note @headers is read-only!
# @metadata             set by ReadQf # the entire qf file excluding final "."
# $returnpathflags	set by ReadQf # Only used for sendmail at the moment
# $clientip		set by ReadQf
# $scanme		set by NeedsScanning (from MsgBatch constructor)
# $workarea		set by new
# @archiveplaces	set by new (addresses and dirs)
# @quarantineplaces	set by Quarantine.pm
# $spamwhitelisted      set by IsSpam
# $spamblacklisted      set by IsSpam
# $isspam               set by IsSpam
# $issaspam             set by IsSpam
# $isrblspam            set by IsSpam
# $ishigh               set by IsSpam
# $sascore		set by IsSpam
# $spamreport           set by IsSpam
# $mcpwhitelisted       set by IsMCP
# $ismcp                set by IsMCP
# $issamcp              set by IsMCP
# $ishighmcp            set by IsMCP
# $mcpsascore		set by IsMCP
# $mcpreport            set by IsMCP
# $deleted		set by delivery functions
# $headerspath          set by WriterHeaderFile # file is read-only
# $cantparse		set by Explode
# $toomanyattach	set by Explode
# $cantdisinfect	set by ExplodeArchive
# $entity		set by Explode
# $tnefentity		set by Explode (only set if it's a TNEF message)
# $badtnef		set by Explode
# $entity		set by Explode
# %name2entity		set by Explode
# %file2parent		set by Explode
# $virusinfected	set by new and ScanBatch
# $nameinfected		set by new and ScanBatch
# $otherinfected	set by new and ScanBatch
# %virusreports         set by TryCommercial (key is filename)
# %virustypes           set by TryCommercial (key is filename)
# %namereports		set by filename trap checker
# %nametypes		set by filename trap checker
# %otherreports		set by TryOther (key is filename)
# %othertypes		set by TryOther (key is filename)
# %entityreports        set by TryOther (key is entity)
# %oldviruses		set by DisinfectAndDeliver
# $infected             set by CombineReports
# %allreports		set by CombineReports
# %alltypes		set by CombineReports
# %entity2parent	set by CreateEntitiesHelpers
# %entity2file		set by CreateEntitiesHelpers
# %file2entity		set by CreateEntitiesHelpers (maps original evil names)
# %file2safefile	set by CreateEntitiesHelpers (evil==>safe)
# %safefile2file	set by CreateEntitiesHelpers (safe==>evil)
# $numberparts		set by CreateEntitiesHelpers
# $signed               set by Clean
# $bodymodified         set by Clean and SignUninfected
# $silent		set by FindSilentAndNoisyInfections
#				if infected with a silent virus
# $noisy		set by FindSilentAndNoisyInfections
#				if infected with a noisy virus
# $needsstripping       set by HandleSpam and HandleMCP
# $stillwarn		set by new # Still send warnings even if deleted
# $needsencapsulating	set by HandleSpam and HAndleMCP
# %postfixrecips	set by ReadQf in Postfix support only. Hash of all the
#				'R' addresses in the message to aid rebuilding.
# %originalrecips	set by ReadQf in Postfix support only. Hash of all the
#				'O' addresses in the message to aid rebuilding.
# %deleteattach		set by ScanBatch and CheckFiletypeRules. True if
#                              attachment is to be deleted rather than stored.
# $tagstoconvert	set by ??? is list of HTML tags to dis-arm
# $gonefromdisk		set by calls to DeleteUnlock
# $subjectwasunsafe	set by SweepContent.pm
# $safesubject		set by SweepContent.pm
# $mcpdelivering        set by HandleMCP
# $salongreport		set by SA::Checks (longest version of SA report)
# @spamarchive          set by HandleHamAndSpam, list of places we have
#                              quarantined spam/mcp message. Used later to
#                              delete infected spam from spam quarantine.
# $dontdeliver          set by HandleHamAndSpam, true if the message was put
#                              in the spam/mcp archive, but still needs to be
#                              virus-scanned so we can remove it again if
#                              necessary. But it doesn't need repairing, as we
#                              won't be delivering it anyway.
# $datenumber		set by new
# $datestring		set by new
# $messagedisarmed	set by DisarmHTMLTree
# @disarmedtags                All the HTML tags (incl. phishing) that we found
#                              and disarmed or highlighted.
# $quarantinedinfectionsset by QuarantineInfections, has this message already
#                              been quarantined, so doesn't need quarantining
#                              in QuarantineModifiedBodies.
# $actions		set by HandleHamAndSpam, saves action list.
#

# Constructor.
# Takes id.
# Takes options $fake which is just used for making an object for
# the command-line testing.
# This isn't specific to the MTA at all, so is all done here.
sub new {
  my $type = shift;
  my($id, $queuedirname, $fake) = @_;
  my $this = {};
  my ($queue, $workarea, $mta, $hpath, $dpath, $addr, $user, $domain);
  my ($archiveplaces);
  my $hfile = new FileHandle;

  #print STDERR "Creating message $id\n";

  $this->{id} = $id;
  @{$this->{archiveplaces}}    = ();
  @{$this->{spamarchive}}      = ();
  @{$this->{quarantineplaces}} = ();

  if ($fake) {
    bless $this, $type;
    return $this;
  }

  # Create somewhere to store the message
  $this->{store} = new MailScanner::SMDiskStore($id, $queuedirname);

  # Try to open and exclusive-lock this message. Return undef if failed.
  #print STDERR "Trying to lock message " . $this->{id} . "\n";
  $this->{store}->Lock() or return undef;
  #print STDERR "Locked message\n";

  # Now try to fill as much of the structure as possible
  $this->{size} = $this->{store}->size();
  $global::MS->{mta}->ReadQf($this) or return 'INVALID'; # Return empty if fails

  # Work out the user @ domain components
  ($user, $domain) = address2userdomain($this->{from});
  $this->{fromuser} = $user;
  $this->{fromdomain} = $domain;
  foreach $addr (@{$this->{to}}) {
    ($user, $domain) = address2userdomain($addr);
    push @{$this->{touser}}, $user;
    push @{$this->{todomain}}, $domain;
  }

  # Reset the infection counters to 0
  $this->{virusinfected} = 0;
  $this->{nameinfected}  = 0;
  $this->{otherinfected} = 0;
  $this->{stillwarn}     = 0;

  # Set the date string and number
  $this->{datestring} = scalar localtime;
  my($day, $month, $year, $date);
  ($day, $month, $year) = (localtime)[3,4,5];
  $date = sprintf("%04d%02d%02d", $year+1900, $month+1, $day);
  $this->{datenumber} = $date;

  # Work out where to archive/copy this message.
  # Could do all the archiving in a different separate place.
  $archiveplaces = MailScanner::Config::Value('archivemail', $this);
  if ($archiveplaces =~ /_DATE_/) {
    # Only do the work for the date substitution if we really have to
    $archiveplaces =~ s/_DATE_/$date/g;
    #print STDERR "Archive location is $archiveplaces\n";
  }
  @{$this->{archiveplaces}} = ((defined $archiveplaces)?split(" ", $archiveplaces):());

  # Decide if we want to scan this message at all
  $this->{scanmail} = MailScanner::Config::Value('scanmail', $this);
  $this->{scanmail} = 1 if $this->{scanmail} =~ /1/;

  bless $this, $type;
  return $this;
}


# Take an email address. Return (user, domain).
sub address2userdomain {
  my($addr) = @_;

  my($user, $domain);

  $addr = lc($addr);
  $addr =~ s/^<\s*//; # Delete leading and
  $addr =~ s/\s*>$//; # trailing <>

  $user   = $addr;
  $domain = $addr;

  if ($addr =~ /@/) {
    $user   =~ s/@[^@]*$//;
    $domain =~ s/^[^@]*@//;
  }

  return ($user, $domain);
}


# Print a message
sub print {
  my $this = shift;

  print STDERR "Message " . $this->{id} . "\n";
  print STDERR "  Size = " . $this->{size} . "\n";
  print STDERR "  From = " . $this->{from} . "\n";
  print STDERR "  To   = " . join(',',@{$this->{to}}) . "\n";
  print STDERR "  Subj = " . $this->{subject} . "\n";
}


# Get/Set "scanme" flag
sub NeedsScanning {
  my($this, $value) = @_;

  $this->{scanme} = $value if @_ > 1;
  return $this->{scanme};
}


# Write the file containing all the message headers.
# Called by the MessageBatch constructor.
# Notes: assumes the directories required already exist.
sub WriteHeaderFile {
  my $this = shift;

  #my @headers;
  my $header = new FileHandle;
  my $filename = $global::MS->{work}->{dir} . '/' . $this->{id} . '.header';
  $this->{headerspath} = $filename;

  MailScanner::Lock::openlock($header, ">$filename", "w")
    or MailScanner::Log::DieLog("Cannot create + lock headers file %s, %s",
                                $filename, $!);

  #@headers = $global::MS->{mta}->OriginalMsgHeaders($this);
  #print STDERR "Headers are " . join(', ', @headers) . "\n";
  #foreach (@headers) {
  foreach ($global::MS->{mta}->OriginalMsgHeaders($this)) {
    tr/\r/\n/; # Work around Outlook [Express] bug allowing viruses in headers
    print $header "$_\n";
  }
  print $header "\n";
  MailScanner::Lock::unlockclose($header);

  # Set the owner of the header file
  chown $global::MS->{work}->{uid}, $global::MS->{work}->{gid}, $filename
    if $global::MS->{work}->{changeowner};
}


# Is this message spam? Try to build the spam report and store it in
# the message.
sub IsSpam {
  my $this = shift;
  my($includesaheader, $iswhitelisted, $usegsscanner);

  my $spamheader    = "";
  my $rblspamheader = "";
  my $gsreport      = "";
  my $saspamheader  = "";
  my $RBLsaysspam   = 0;
  my $rblcounter    = 0;
  my $LogSpam = MailScanner::Config::Value('logspam');
  my $LogNonSpam = MailScanner::Config::Value('lognonspam');
  my $LocalSpamText = MailScanner::Config::LanguageValue($this, 'spam');
  my $LocalNotSpamText = MailScanner::Config::LanguageValue($this, 'notspam');

  # Construct a pretty list of all the unique domain names for logging
  my(%todomain, $todomain);
  foreach $todomain (@{$this->{todomain}}) {
    $todomain{$todomain} = 1;
  }
  $todomain = join(',', keys %todomain);
  my $recipientcount = @{$this->{to}};

  # $spamwhitelisted      set by IsSpam
  # $spamblacklisted      set by IsSpam
  # $isspam               set by IsSpam
  # $ishigh               set by IsSpam
  # $spamreport           set by IsSpam

  $this->{spamwhitelisted} = 0;
  $this->{spamblacklisted} = 0;
  $this->{isspam} = 0;
  $this->{ishigh} = 0;
  $this->{spamreport} = "";
  $this->{sascore} = 0;

  ## If it's a blacklisted address, don't bother doing any checks at all
  #if (MailScanner::Config::Value('spamblacklist', $this)) {
  #  $this->{isspam} = 1;
  #  $this->{spamreport} = 'spam (blacklisted)';
  #  MailScanner::Log::InfoLog("Message %s from %s (%s) " .
  #                            " is spam (blacklisted)",
  #                            $this->{id}, $this->{clientip},
  #                            $this->{from});
  #  return 1;
  #}

  # Work out if they always want the SA header
  $includesaheader = MailScanner::Config::Value('includespamheader', $this);
  # If they want the GS scanner then we must carry on too
  $usegsscanner = MailScanner::Config::Value('gsscanner', $this);

  # Do the whitelist check before the blacklist check.
  # If anyone whitelists it, then everyone gets the message.
  # If no-one has whitelisted it, then consider the blacklist.
  $iswhitelisted = 0;
  my $maxrecips = MailScanner::Config::Value('whitelistmaxrecips');
  $maxrecips = 999999 unless $maxrecips;

  if ($recipientcount<=$maxrecips) {
    if (MailScanner::Config::Value('spamwhitelist', $this)) {
      # Whitelisted, so get out unless they want SA header
      #print STDERR "Message is whitelisted\n";
      MailScanner::Log::InfoLog("Message %s from %s (%s) is whitelisted",
                                $this->{id}, $this->{clientip}, $this->{from})
        if $LogSpam || $LogNonSpam;
      $iswhitelisted = 1;
      $this->{spamwhitelisted} = 1;
      # whitelisted and doesn't want SA header so get out
      return 0 unless $includesaheader || $usegsscanner;
    }
  } else {
    # Had too many recipients, ignoring the whitelist
    MailScanner::Log::InfoLog("Message %s from %s (%s) ignored whitelist, " .
                              "had %d recipients (>%d)", $this->{id},
                              $this->{clientip}, $this->{from},
                              $recipientcount, $maxrecips)
      if $LogSpam || $LogNonSpam;
  }

  # If it's a blacklisted address, don't bother doing any checks at all
  if (!$iswhitelisted && MailScanner::Config::Value('spamblacklist', $this)) {
    $this->{spamblacklisted} = 1;
    $this->{isspam} = 1;
    $this->{ishigh} = 1
      if MailScanner::Config::Value('blacklistedishigh', $this);
    $this->{spamreport} = $LocalSpamText . ' (' .
                   MailScanner::Config::LanguageValue($this, 'blacklisted') .
                   ')';
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s" .
                              " is spam (blacklisted)",
                              $this->{id}, $this->{clientip},
                              $this->{from}, $todomain)
      if $LogSpam;
    return 1;
  }

  my $whitelistreport = '';
  if ($iswhitelisted) {
    $whitelistreport = ' (' .
                  MailScanner::Config::LanguageValue($this, 'whitelisted') .
                  ')';
  }

  if (!$iswhitelisted) {
    # Not whitelisted, so do the RBL checks
    $0 = 'MailScanner: checking with Spam Lists';
    ($rblcounter, $rblspamheader) = MailScanner::RBLs::Checks($this);
    my $rblthreshold = MailScanner::Config::Value('normalrbls', $this);
    my $highrblthreshold = MailScanner::Config::Value('highrbls', $this);
    $rblthreshold = 1 if $rblthreshold <= 1;
    $highrblthreshold = 1 if $highrblthreshold <= 1;
    $RBLsaysspam       = 1 if $rblcounter >= $rblthreshold;
    # Add leading "spam, " if RBL says it is spam. This will be at the
    # front of the spam report.
    $this->{isspam}    = 1 if $RBLsaysspam;
    $this->{isrblspam} = 1 if $RBLsaysspam;
    $this->{ishigh}    = 1 if $rblcounter >= $highrblthreshold;
  }
  # rblspamheader is useful start to spamreport if RBLsaysspam.

  # Do the Custom Spam Checker
  my($gsscore, $gsreport);
  #print STDERR "In Message.pm about to look at gsscanner\n";
  if ($usegsscanner) {
    #print STDERR "In Message.pm about to run gsscanner\n";
    ($gsscore, $gsreport) = MailScanner::GenericSpam::Checks($this);
    #print STDERR "In Message.pm we got $gsscore, $gsreport\n";
    $this->{gshits} = $gsscore;
    $this->{gsreport} = $gsreport;
    $this->{sascore} = $gsscore; # Add the score
    MailScanner::Log::InfoLog("Custom Spam Scanner for message %s from %s " .
                              "(%s) to %s report is %s %s",
                              $this->{id}, $this->{clientip},
                              $this->{from}, $todomain, $gsscore, $gsreport)
      if $LogSpam && ($gsscore!=0 || $gsreport ne "");
  }

  # Don't do the SA checks if they have said no.
  unless (MailScanner::Config::Value('usespamassassin', $this)) {
    $this->{spamwhitelisted} = $iswhitelisted;
    $this->{isspam} = 1
      if $gsscore+0.0 >=
         MailScanner::Config::Value('reqspamassassinscore',$this)+0.0;
    $this->{ishigh} = 1
      if $gsscore+0.0 >=
         MailScanner::Config::Value('highspamassassinscore',$this)+0.0;
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
                              $this->{id}, $this->{clientip},
                              $this->{from}, $todomain, $rblspamheader)
      if $RBLsaysspam && $LogSpam;
    # Replace start of report if it wasn't spam from rbl but now is.
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
    $this->{spamreport} .= $whitelistreport;
    $this->{spamreport} .= ', ' if $this->{spamreport};
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
    $this->{spamreport} .= $gsreport if $gsreport ne "";
    $this->{spamreport} = $this->ReflowHeader(
                  MailScanner::Config::Value('spamheader',$this),
                  $this->{spamreport});
    return $this->{isspam};
  }

  # If it's spam and they dont want to check SA as well
  if ($this->{isspam} &&
      !MailScanner::Config::Value('checksaifonspamlist', $this)) {
    $this->{spamwhitelisted} = $iswhitelisted;
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
                              $this->{id}, $this->{clientip},
                              $this->{from}, $todomain, $rblspamheader)
      if $RBLsaysspam && $LogSpam;
    # Replace start of report if it wasn't spam from rbl but now is.
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
    $this->{spamreport} .= $whitelistreport;
    $this->{spamreport} .= ', ' if $this->{spamreport};
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
    $this->{spamreport} .= $gsreport if $gsreport ne "";
    $this->{spamreport} = $this->ReflowHeader(
                  MailScanner::Config::Value('spamheader',$this),
                  $this->{spamreport});
    return $RBLsaysspam;
  }

  # They must want the SA checks doing.

  my $SAsaysspam = 0;
  my $SAHighScoring = 0;
  my $saheader = "";
  my $sascore  = 0;
  my $salongreport = "";
  $0 = 'MailScanner: checking with SpamAssassin';
  ($SAsaysspam, $SAHighScoring, $saheader, $sascore, $salongreport)
    = MailScanner::SA::Checks($this);
  $this->{sascore} += $sascore; # Save the actual figure for use later...
  # Trim all the leading rubbish off the long SA report and turn it back
  # into a multi-line string, then store it in the message properties.
  $salongreport =~ s/^.* pts rule name/ pts rule name/;
  $salongreport =~ tr/\0/\n/;
  $this->{salongreport} = $salongreport;
  #print STDERR $salongreport . "\n";

  # Fix the return values
  $SAsaysspam = 0 unless $saheader;    # Solve bug with empty SAreports
  $saheader =~ s/\s+$//g if $saheader; # Solve bug with trailing space

  #print STDERR "SA report is \"$saheader\"\n";
  #print STDERR "SAsaysspam = $SAsaysspam\n";
  $saheader = MailScanner::Config::LanguageValue($this, 'spamassassin') .
              " ($saheader)" if $saheader;

  # The message really is spam if SA says so (unless it's been whitelisted)
  unless ($iswhitelisted) {
    $this->{isspam} |= $SAsaysspam;
    $this->{issaspam} = $SAsaysspam;
  }

  # If it's spam...
  if ($this->{isspam}) {
    #print STDERR "It is spam\nInclude SA = $includesaheader\n";
    #print STDERR "SAHeader = $saheader\n";
    # If it's SA spam as well, or they always want the SA header
    if ($SAsaysspam || $includesaheader) {
      #print STDERR "Spam or Add SA Header\n";
      $this->{ishigh} = 1 if $SAHighScoring;
      $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
      $this->{spamreport} .= $whitelistreport;
      $this->{spamreport} .= ', ' if $this->{spamreport};
      $this->{spamreport} .= $rblspamheader if $rblspamheader;
      $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
      $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
      $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
      $this->{spamreport} .= $gsreport if $gsreport ne "";
      $this->{spamreport} .= ', ' if $this->{spamreport} && $gsreport;
      $this->{spamreport} .= $saheader if $saheader ne "";
    }
  } else {
    # It's not spam...
    #print STDERR "It's not spam\n";
    #print STDERR "SAHeader = $saheader\n";
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
    $this->{spamreport} .= $whitelistreport;
    $this->{spamreport} .= ', ' if $this->{spamreport};
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
    $this->{spamreport} .= $gsreport if $gsreport ne "";
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsreport;
    $this->{spamreport} .= $saheader if $saheader ne "";
  }

  # Do the spam logging here so we can log high-scoring spam too
  if (($LogSpam && $this->{isspam}) || ($LogNonSpam && !$this->{isspam})) {
    my $ReportText = $this->{spamreport};
    $ReportText =~ s/\s+/ /sg;
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
                              $this->{id}, $this->{clientip},
                              $this->{from}, $todomain, $ReportText);
  }

  # Now just reflow and log the results
  if ($this->{spamreport} ne "") {
    $this->{spamreport} = $this->ReflowHeader(
                  MailScanner::Config::Value('spamheader',$this),
                  $this->{spamreport});
  }

  return $this->{isspam};
}
    

# Do whatever is necessary with this message to deal with spam.
# We can assume the message passed is indeed spam (isspam==true).
# Call it with either 'spam' or 'nonspam'. Don't use 'ham'!
sub HandleHamAndSpam {
  my($this, $HamSpam) = @_;

  my($actions, $action, @actions, %actions);
  my(@extraheaders, $actionscopy, $actionkey);

  # Set default action for DMX/MailWatch reporting
  $this->{actions} = 'deliver';

  # Get a space-separated list of all the actions
  if ($HamSpam eq 'nonspam') {
    #print STDERR "Looking up hamactions\n";
    $actions = MailScanner::Config::Value('hamactions', $this);
    # Fast bail-out if it's just the simple "deliver" case that 99% of
    # people will use
    return if $actions eq 'deliver';
  } else {
    # It must be spam as it's not ham
    if ($this->{ishigh}) {
      #print STDERR "Looking up highscorespamactions\n";
      $actions = MailScanner::Config::Value('highscorespamactions', $this);
    } else {
      #print STDERR "Looking up spamactions\n";
      $actions = MailScanner::Config::Value('spamactions', $this);
    }
  }

  # Find all the bits in quotes, with their spaces
  $actionscopy = $actions;
  #print STDERR "Actions = \'$actions\'\n";
  while ($actions =~ s/\"([^\"]+)\"//) {
    $actionkey = $1;
    #print STDERR "ActionKey = $actionkey and $1\n";
    push @extraheaders, $actionkey;
    MailScanner::Log::WarnLog("Syntax error in \"header\" action in spam " .
                              "actions, missing \":\" in %s", $actionkey)
      unless $actionkey =~ /:/;
  }
  @{$this->{extraspamheaders}} = @extraheaders;
  $actions = lc($actions);
  $actions =~ s/^\s*//;
  $actions =~ s/\s*$//;
  $actions =~ s/\s+/ /g;
  #print STDERR "Actions after = \'$actions\'\n";
  #print STDERR "Extra headers are \"" . join(',',@extraheaders) . "\"\n";

  MailScanner::Log::WarnLog('Syntax error: missing " in spam actions %s',
                            $actionscopy) if $actions =~ /\"/;

  $actions =~ tr/,//d; # Remove all commas in case they put any in
  @actions = split(" ", $actions);
  #print STDERR "Actions are $actions\n";

  # The default action if they haven't specified anything is to
  # deliver spam like normal mail.
  return unless @actions;

  # If they have just specified a filename, then something is wrong
  if ($#actions==0 && $actions[0] =~ /\//) {
    MailScanner::Log::WarnLog('Your spam actions "%s" looks like a filename.' .
        ' If this is a ruleset filename, it must end in .rule or .rules',
        $actions[0]);
    $actions[0] = 'deliver';
  }

  #print STDERR "Message: HandleHamSpam has actions " . join(',',@actions) .
  #             "\n";

  # Save actions for DMX/MailWatch reporting
  $this->{actions} = join(',', @actions);

  foreach $action (@actions) {
    # If the message is a MCP message then don't do the ham/spam "deliver"
    # as the MCP actions will have provided a "deliver" if they want one.
    next if $this->{ismcp} && $action eq 'deliver';

    $actions{$action} = 1;
    #print STDERR "Message: HandleSpam action is $action\n";
    if ($action =~ /\@/) {
      #print STDERR "Message " . $this->{id} . " : HandleSpam() adding " .
      #             "$action to archiveplaces\n";
      push @{$this->{archiveplaces}}, $action;
      $actions{'forward'} = 1;
    }
  }

  # Now we are left with deliver, bounce, delete, store and striphtml.
  #print STDERR "Archive places are " . join(',', keys %actions) . "\n";

  # Split this job into 2.
  # 1) The message is being delivered to at least 1 address,
  # 2) The message is not being delivered to anyone.
  # The extra addresses for forward it to have already been added.
  if ($actions{'deliver'} || $actions{'forward'} || $this->{mcpdelivering}) {
    #
    # Message is going to original recipient and/or extra recipients
    #

    MailScanner::Log::InfoLog("Spam Actions: message %s actions are %s",
                              $this->{id}, join(',', keys %actions))
      if $HamSpam eq 'spam' && MailScanner::Config::Value('logspam');

    # Delete the original recipient if they are only forwarding it
    $global::MS->{mta}->DeleteRecipients($this) if !$actions{'deliver'};

    # Delete action is over-ridden as we are sending it somewhere
    delete $actions{'delete'};

    # Message still exists, so it will be delivered to its new recipients
  } else {
    #
    # Message is not going to be delivered anywhere
    #

    MailScanner::Log::InfoLog("Spam Actions: message %s actions are %s",
                              $this->{id}, join(',', keys %actions))
      if $HamSpam eq 'spam' && MailScanner::Config::Value('logspam');

    # Mark the message so it won't get cleaned up or delivered, but just dropped
    #print STDERR "Setting DontDeliver for " . $this->{id} . "\n";
    $this->{dontdeliver} = 1;
    # Optimisation courtesy of Yavor.Trapkov@wipo.int
    $this->{deleted} = 1 if (keys %actions) == 1 && $actions{'delete'};
    ## Mark the message as deleted, so it won't get delivered
    #$this->{deleted} = 1;
  }

  # All delivery will now happen correctly.

  # Bounce a message back to the sender if they want that
  if ($actions{'bounce'}) {
    if ($HamSpam eq 'nonspam') {
      MailScanner::Log::WarnLog("Does not make sense to bounce non-spam");
    } else {
      #MailScanner::Log::WarnLog('The "bounce" Spam Action no longer exists');
      if ($this->{ishigh}) {
        MailScanner::Log::InfoLog("Will not bounce high-scoring spam")
      } else {
        $this->HandleSpamBounce()
          if MailScanner::Config::Value('enablespambounce', $this);
      }
    }
  }

  # Notify the recipient if they want that
  if ($actions{'notify'}) {
    if ($HamSpam eq 'nonspam') {
      MailScanner::Log::WarnLog("Does not make sense to notify recipient about non-spam");
    } else {
      $this->HandleSpamNotify();
    }
  }
  
  # Store it if they want that
  if ($actions{'store'}) {
    my($dir, $dir2, $spamdir, $uid, $gid, $changeowner);
    $uid = $global::MS->{quar}->{uid};
    $gid = $global::MS->{quar}->{gid};
    $changeowner = $global::MS->{quar}->{changeowner};
    $dir = MailScanner::Config::Value('quarantinedir', $this);
    #$dir2 = $dir . '/' .  MailScanner::Quarantine::TodayDir();
    $dir2 = $dir . '/' .  $this->{datenumber};
    $spamdir = $dir2 . '/' . $HamSpam;
    #print STDERR "dir = $dir\ndir2 = $dir2\nspamdir = $spamdir\n";
    umask $global::MS->{quar}->{dirumask};
    unless (-d $dir) {
      mkdir $dir, 0777;
      chown $uid, $gid, $dir if $changeowner;
    }
    unless (-d $dir2) {
      mkdir $dir2, 0777;
      chown $uid, $gid, $dir2 if $changeowner;
    }
    unless (-d $spamdir) {
    mkdir $spamdir, 0777;
      chown $uid, $gid, $spamdir if $changeowner;
    }
    #print STDERR "Storing spam to $spamdir/" . $this->{id} . "\n";
    #print STDERR "uid=$uid gid=$gid changeowner=$changeowner\n";
    umask $global::MS->{quar}->{fileumask};
    my @paths = $this->{store}->CopyEntireMessage($this, $spamdir, $this->{id},
                                                  $uid, $gid, $changeowner);
    # Remember where we have stored the spam in an archive, so we never
    # archive infected messages
    #print STDERR "Added " . join(',', @paths) . " to spamarchive\n";
    push @{$this->{spamarchive}}, @paths;
    chown $uid, $gid, "$spamdir/" . $this->{id}; # Harmless if this fails
  }
  umask 0077; # Safety net

  # If they want to strip the HTML tags out of it,
  # then just tag it as we can only do this later.
  $this->{needsstripping} = 1 if $actions{'striphtml'};

  # If they want to encapsulate the message in an RFC822 part,
  # then tag it so we can do this later.
  $this->{needsencapsulating} = 1 if $actions{'attachment'};
}


# We want to send a message back to the sender saying that their junk
# email has been rejected by our site.
# Send a message back to the sender which has the local postmaster as
# the header sender, but <> as the envelope sender. This means it
# cannot bounce.
# Now have 3 different message file settings:
# 1. Is spam according to RBL's
# 2. Is spam according to SpamAssassin
# 3. Is spam according to both
sub HandleSpamBounce {
  my $this = shift;

  my($from,$to,$subject,$date,$spamreport,$longspamreport,$hostname);
  my($emailmsg, $line, $messagefh, $filename, $localpostmaster, $id);
  my($postmastername);

  $from = $this->{from};

  # Don't ever send a message to "" or "<>"
  return if $from eq "" || $from eq "<>";

  # Do we want to send the sender a warning at all?
  # If nosenderprecedence is set to non-blank and contains this
  # message precedence header, then just return.
  my(@preclist, $prec, $precedence, $header);
  @preclist = split(" ",
                  lc(MailScanner::Config::Value('nosenderprecedence', $this)));
  $precedence = "";
  foreach $header (@{$this->{headers}}) {
    $precedence = lc($1) if $header =~ /^precedence:\s+(\S+)/i;
  }
  if (@preclist && $precedence ne "") {
    foreach $prec (@preclist) {
      if ($precedence eq $prec) {
        MailScanner::Log::InfoLog("Skipping sender of precedence %s",
                                  $precedence);
        return;
      }
    }
  }

  # Setup other variables they can use in the message template
  $id = $this->{id};
  #$to = join(', ', @{$this->{to}});
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
  $hostname = MailScanner::Config::Value('hostname', $this);
  $subject = $this->{subject};
  $date = $this->{datestring}; # scalar localtime;
  $spamreport = $this->{spamreport};
  $longspamreport = $this->{salongreport};
  #print STDERR "longspamreport = \"$longspamreport\"\n";
  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  # Delete everything in brackets after the SA report, if it exists
  $spamreport =~ s/(spamassassin)[^(]*\([^)]*\)/$1/i;

  # Work out which of the 3 spam reports to send them.
  $filename = "";
  if ($this->{isrblspam} && !$this->{issaspam}) {
    $filename = MailScanner::Config::Value('senderrblspamreport', $this);
    MailScanner::Log::InfoLog("Spam Actions: (RBL) Bounce to %s", $from)
      if MailScanner::Config::Value('logspam');
  } elsif ($this->{issaspam} && !$this->{isrblspam}) {
    $filename = MailScanner::Config::Value('sendersaspamreport', $this);
    MailScanner::Log::InfoLog("Spam Actions: (SpamAssassin) Bounce to %s",
                              $from)
      if MailScanner::Config::Value('logspam');
  }
  if ($filename eq "") {
    $filename = MailScanner::Config::Value('senderbothspamreport', $this);
    MailScanner::Log::InfoLog("Spam Actions: (RBL,SpamAssassin) Bounce to %s",
                              $from)
      if MailScanner::Config::Value('logspam');
  }

  $messagefh = new FileHandle;
  $messagefh->open($filename)
    or MailScanner::Log::WarnLog("Cannot open message file %s, %s",
                                 $filename, $!);
  $emailmsg = "X-MailScanner-Bounce: yes\n";
  while(<$messagefh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $emailmsg .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $messagefh->close();

  if (MailScanner::Config::Value('bouncespamasattachment', $this)) {
    $this->HandleSpamBounceAttachment($emailmsg);
  } else {
    # Send the message to the spam sender, but ensure the envelope
    # sender address is "<>" so that it can't be bounced.
    $global::MS->{mta}->SendMessageString($this, $emailmsg, '<>')
      or MailScanner::Log::WarnLog("Could not send sender spam bounce, %s", $!);
  }
}


# Like encapsulating and sending a message to the recipient, take the
# passed text as the text and headers of an email message and attach
# the original message as an rfc/822 attachment.
sub HandleSpamBounceAttachment {
  my($this, $plaintext) = @_;

  my $parser = MIME::Parser->new;
  my $explodeinto = $global::MS->{work}->{dir} . '/' . $this->{id};
  #print STDERR "Extracting spam bounce message into $explodeinto\n";
  my $filer  = MIME::Parser::FileInto->new($explodeinto);
  $parser->filer($filer);

  my $bounce = eval { $parser->parse_data(\$plaintext) };
  if (!$bounce) {
    MailScanner::Log::WarnLog("Cannot parse spam bounce report, %s", $!);
    return;
  }
  #print STDERR "Successfully parsed bounce report\n";

  # Now make it multipart and push the report into a child
  $bounce->make_multipart('report');

  # Now turn the original message into a string and attach it
  my(@original);
  #my $original = $this->{entity}->stringify;
  @original = $global::MS->{mta}->OriginalMsgHeaders($this, "\n");
  push(@original, "\n");
  $this->{store}->ReadBody(\@original, MailScanner::Config::Value(
                                          'maxspamassassinsize'));

  $bounce->add_part(MIME::Entity->build(Type        => 'message/rfc822',
                                        Disposition => 'attachment',
                                        Top         => 0,
                                        'X-Mailer'  => undef,
                                        Data        => \@original));
  
  # Prune all the dead branches off the tree
  PruneEntityTree($bounce);
  # Stringify the message and send it -- this could be VERY large!
  my $bouncetext = $bounce->stringify;
  #print STDERR "Spam bounce message is this:\n$bouncetext";
  if ($bouncetext) {
    $global::MS->{mta}->SendMessageString($this, $bouncetext, '<>')
      or MailScanner::Log::WarnLog(
           "Could not send sender spam bounce attachment, %s", $!);
  } else {
    MailScanner::Log::WarnLog(
      "Failed to create sender spam bounce attachment, %s", $!);
  }
}


# We want to send a message to the recipient saying that their spam
# mail has not been delivered.
# Send a message to the recipients which has the local postmaster as
# the sender.
sub HandleSpamNotify {
  my $this = shift;

  my($from,$to,$subject,$date,$spamreport,$hostname,$day,$month,$year);
  my($emailmsg, $line, $messagefh, $filename, $localpostmaster, $id);
  my($postmastername);

  $from = $this->{from};

  # Don't ever send a message to "" or "<>"
  return if $from eq "" || $from eq "<>";

  # Do we want to send the sender a warning at all?
  # If nosenderprecedence is set to non-blank and contains this
  # message precedence header, then just return.
  my(@preclist, $prec, $precedence, $header);
  @preclist = split(" ",
                  lc(MailScanner::Config::Value('nosenderprecedence', $this)));
  $precedence = "";
  foreach $header (@{$this->{headers}}) {
    $precedence = lc($1) if $header =~ /^precedence:\s+(\S+)/i;
  }
  if (@preclist && $precedence ne "") {
    foreach $prec (@preclist) {
      if ($precedence eq $prec) {
        MailScanner::Log::InfoLog("Skipping sender of precedence %s",
                                  $precedence);
        return;
      }
    }
  }

  # Setup other variables they can use in the message template
  $id = $this->{id};
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
  $hostname = MailScanner::Config::Value('hostname', $this);
  $subject = $this->{subject};
  $date = $this->{datestring}; # scalar localtime;
  $spamreport = $this->{spamreport};
  # And let them put the date number in there too
  #($day, $month, $year) = (localtime)[3,4,5];
  #$month++;
  #$year += 1900;
  #my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
  my $datenumber = $this->{datenumber};


  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  # Delete everything in brackets after the SA report, if it exists
  $spamreport =~ s/(spamassassin)[^(]*\([^)]*\)/$1/i;

  # Work out which of the 3 spam reports to send them.
  $filename = MailScanner::Config::Value('recipientspamreport', $this);
  MailScanner::Log::InfoLog("Spam Actions: Notify %s", $to)
    if MailScanner::Config::Value('logspam');

  $messagefh = new FileHandle;
  $messagefh->open($filename)
    or MailScanner::Log::WarnLog("Cannot open message file %s, %s",
                                 $filename, $!);
  $emailmsg = "";
  while(<$messagefh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $emailmsg .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $messagefh->close();

  # Send the message to the spam sender, but ensure the envelope
  # sender address is "<>" so that it can't be bounced.
  $global::MS->{mta}->SendMessageString($this, $emailmsg, $localpostmaster)
    or MailScanner::Log::WarnLog("Could not send sender spam notify, %s", $!);
}

sub RejectMessage {
  my $this = shift;

  my($from,$to,%tolist,$subject,$date,$hostname);
  my($emailmsg, $line, $messagefh, $filename, $localpostmaster, $id);
  my($postmastername);

  $from = $this->{from};

  # Don't ever send a message to "" or "<>"
  return if $from eq "" || $from eq "<>";

  # Setup other variables they can use in the message template
  $id = $this->{id};
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
  $hostname = MailScanner::Config::Value('hostname', $this);
  $subject = $this->{subject};
  $date = $this->{datestring}; # scalar localtime;
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  # Work out which of the 3 spam reports to send them.
  $filename = MailScanner::Config::Value('rejectionreport', $this);
  MailScanner::Log::InfoLog("Reject message %s from %s with report %s",
                            $id, $from, $filename);
  return if $filename eq "";

  #print STDERR "Rejecting message $id with $filename\n";
  $messagefh = new FileHandle;
  $messagefh->open($filename)
    or MailScanner::Log::WarnLog("Cannot open message file %s, %s",
                                 $filename, $!);
  $emailmsg = "X-MailScanner-Rejected: yes\n";

  while(<$messagefh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $emailmsg .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $messagefh->close();

  #print STDERR "Rejection is:\n-----SNIP-----\n$emailmsg-----SNIP-----\n";
  # Send the message to the spam sender, but ensure the envelope
  # sender address is "<>" so that it can't be bounced.
  $global::MS->{mta}->SendMessageString($this, $emailmsg, '<>')
    or MailScanner::Log::WarnLog("Could not send rejection report for %s, %s",
                                 $id, $!);
  $this->{deleted} = 1;
  $this->{dontdeliver} = 1;

}


# Like encapsulating and sending a message to the recipient, take the

# Deliver a message that doesn't want to be touched at all in any way.
# Take an out queue dir.
sub DeliverUntouched {
  my $this = shift;
  my($OutQ) = @_;

  return if $this->{deleted};

  #my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
  my $store = $this->{store};

  # Link the queue data file from in to out
  $store->LinkData($OutQ);

  # Add the headers onto the metadata in the message store
  $global::MS->{mta}->AddHeadersToQf($this);

  # Add the secret archive recipients
  my($extra, @extras);
  foreach $extra (@{$this->{archiveplaces}}) {
    # Email archive recipients include a '@'
    next if $extra =~ /^\//;
    next unless $extra =~ /@/;
    push @extras, $extra;
  }
  $global::MS->{mta}->AddRecipients($this, @extras) if @extras;

  # Write the new qf file, delete originals and unlock the message
  $store->WriteHeader($this, $OutQ);
  unless ($this->{gonefromdisk}) {
    $store->DeleteUnlock();
    $this->{gonefromdisk} = 1;
  }

  # Note this does not kick the MTA into life here any more
}

# Deliver a message that doesn't need scanning at all
# Takes an out queue dir.
sub DeliverUnscanned {
  my $this = shift;
  my($OutQ) = @_;

  return if $this->{deleted};

  #my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
  my $store = $this->{store};

  # Link the queue data file from in to out
  $store->LinkData($OutQ);

  # Add the headers onto the metadata in the message store
  $global::MS->{mta}->AddHeadersToQf($this);

  # Remove duplicate subject: lines
  $global::MS->{mta}->UniqHeader($this, 'Subject:');

  # Add the information/help X- header
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
  if ($infoheader) {
    my $infovalue = MailScanner::Config::Value('infovalue', $this);
    $global::MS->{mta}->ReplaceHeader($this, $infoheader, $infovalue);
  }

  # Add the Unscanned X- header
  if (MailScanner::Config::Value('signunscannedmessages', $this)) {
    $global::MS->{mta}->AddMultipleHeader($this, 'mailheader',
                 MailScanner::Config::Value('unscannedheader', $this), ', ');
  }

  # Remove any headers we don't want in the message
  my(@removeme, $remove);
  @removeme = split(/[,\s]+/, MailScanner::Config::Value('removeheaders', $this));
  foreach $remove (@removeme) {
    # Add a : if there isn't one already, it's needed for DeleteHeader()
    $remove .= ':' unless $remove =~ /:$/;
    $global::MS->{mta}->DeleteHeader($this, $remove);
  }

  # Leave old content-length: headers as we aren't changing body.

  # Add the MCP headers if necessary
  $global::MS->{mta}->AddMultipleHeader($this, 'mcpheader',
                                        $this->{mcpreport}, ', ')
    if $this->{ismcp} ||
       MailScanner::Config::Value('includemcpheader', $this);
  # Add spam header if it's spam or they asked for it
  #$global::MS->{mta}->AddHeader($this,
  #                              MailScanner::Config::Value('spamheader',$this),
  #                              $this->{spamreport})
  # JKF 3/10/2005
  $global::MS->{mta}->AddMultipleHeader($this, 'spamheader',
                                        $this->{spamreport}, ', ')
    if MailScanner::Config::Value('includespamheader', $this) ||
       ($this->{spamreport} && $this->{isspam});

  # Add the spam stars if they want that. Limit it to 60 characters to avoid
  # a potential denial-of-service attack.
  my($stars,$starcount,$scoretext,$minstars,$scorefmt);
  $starcount = int($this->{sascore}) + 0;
  $starcount = 0 if $this->{spamwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{sascore}+0);
  $minstars = MailScanner::Config::Value('minstars', $this);
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
                            $starcount<$minstars;
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
    $stars = $scoretext; # int($starcount);
  } else {
    $starcount = 60 if $starcount>60;
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
  }
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
                                          $stars, ', ');
  }

  # Add the Envelope to and from headers
  AddFromAndTo($this);

  # Repair the subject line
  $global::MS->{mta}->ReplaceHeader($this, 'Subject:', $this->{safesubject})
    if $this->{subjectwasunsafe};

  # Modify the subject line for Disarming
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
  if ($this->{messagedisarmed} &&
      MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
  }
    
  # Modify the subject line for spam
  # if it's spam AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && !$this->{ishigh} &&
      MailScanner::Config::Value('spamprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
  }
  # If it is high-scoring spam, then add a different bit of text
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && $this->{ishigh} &&
      MailScanner::Config::Value('highspamprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
  }

  # Modify the subject line for MCP
  # if it's MCP AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  $starcount = int($this->{mcpsascore}) + 0;
  $starcount = 0 if $this->{mcpwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{mcpsascore}+0);
  my $mcptag = MailScanner::Config::Value('mcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  $mcptag =~ s/_STARS_/$stars/i;
  if ($this->{ismcp} && !$this->{ishighmcp} &&
      MailScanner::Config::Value('mcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
  }
  # If it is high-scoring MCP, then add a different bit of text
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  $mcptag =~ s/_STARS_/$stars/i;
  if ($this->{ismcp} && $this->{ishighmcp} &&
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
  }

  # Add the extra headers they want for MCP and spam messages
  my(@extraheaders, $extraheader);
  my($key, $value);
  @extraheaders = @{$this->{extramcpheaders}} if $this->{extramcpheaders};
  push @extraheaders, @{$this->{extraspamheaders}} if $this->{extraspamheaders};
  foreach $extraheader (@extraheaders) {
    next unless $extraheader =~ /:/;
    ($key, $value) = split(/:\s*/, $extraheader, 2);
    $global::MS->{mta}->AddMultipleHeaderName($this, $key . ':', $value, ', ');
  }

  # Add the secret archive recipients
  my($extra, @extras);
  foreach $extra (@{$this->{archiveplaces}}) {
    # Email archive recipients include a '@'
    next if $extra =~ /^\//;
    next unless $extra =~ /@/;
    push @extras, $extra;
  }
  $global::MS->{mta}->AddRecipients($this, @extras) if @extras;

  # Write the new qf file, delete originals and unlock the message
  $store->WriteHeader($this, $OutQ);
  unless ($this->{gonefromdisk}) {
    $store->DeleteUnlock();
    $this->{gonefromdisk} = 1;
  }

  # Note this does not kick the MTA into life here any more
}

# Add the X-Envelope-From and X-Envelope-To headers
sub AddFromAndTo {
  my $this = shift;

  my($to, %tolist, $from, $envtoheader);

  # Do they all want the From header
  if (MailScanner::Config::Value('addenvfrom', $this) !~ /0/) {
    $from = $this->{from};
    $global::MS->{mta}->ReplaceHeader($this,
                        MailScanner::Config::Value('envfromheader', $this),
                        $from);
  }

  # Do they all want the To header
  if (MailScanner::Config::Value('addenvto', $this) !~ /0/) {
    # Get the actual text for the header value
    foreach $to (@{$this->{to}}) {
      $tolist{$to} = 1;
    }
    $to = join(', ', sort keys %tolist);

    $envtoheader = MailScanner::Config::Value('envtoheader', $this);
    # Now reflow the To list in case it is very long
    $to = $this->ReflowHeader($envtoheader, $to);

    $global::MS->{mta}->ReplaceHeader($this, $envtoheader, $to);
  }
}

# Explode a message into its MIME structure and attachments.
# Pass in the workarea where it should go.
sub Explode {
  my $this = shift;

  # $handle is Sendmail only
  my($entity, $pipe, $handle, $pid, $workarea, $mailscannername);

  return if $this->{deleted};

  # Get the translation of MailScanner, we use it a lot
  $mailscannername = MailScanner::Config::LanguageValue($this, 'mailscanner');

  # Set up something so that the hash exists
  $this->{file2parent}{""} = "";

  # df file is already locked
  $workarea = $global::MS->{work};
  my $explodeinto = $workarea->{dir} . "/" . $this->{id};
  #print STDERR "Going to explode message " . $this->{id} .
  #             " into $explodeinto\n";

  # Setup everything for the MIME parser
  my $parser = MIME::Parser->new;
  my $filer  = MIME::Parser::FileInto->new($explodeinto);

  # Over-ride the default default character set handler so it does it
  # much better than the MIME-tools default handling.
  MIME::WordDecoder->default->handler('*' => \&WordDecoderKeep7Bit);

  #print STDERR "Exploding message " . $this->{id} . " into " .
  #             $explodeinto . "\n";
  $parser->filer($filer);
  $parser->extract_uuencode(1); # uue is off by default
  $parser->output_to_core('NONE'); # everything into files
  
  # The whole parsing thing is totally different for sendmail & Exim for speed.
  # Many thanks for those who know themselves for this great improvement!
  if (MailScanner::Config::Value('mta') =~ /sendmail|exim|postfix/i) {

    #
    # This is for sendmail and Exim systems
    #

    $handle = IO::File->new_tmpfile;
    binmode($handle);
    $this->{store}->ReadMessageHandle($this, $handle) or return;

    ## Do the actual parsing
    my $maxparts = MailScanner::Config::Value('maxparts', $this) || 200;
    MIME::Entity::ResetMailScannerCounter($maxparts);

    # Inform MIME::Parser about our maximum
    $parser->max_parts($maxparts * 3);

    $entity = eval { $parser->parse($handle) };

    # close and delete tmpfile
    close($handle);

    if (!$entity && !MIME::Entity::MailScannerCounter()>=$maxparts) {
      unless ($this->{dpath}) {
        # It probably ran out of disk space, drop this message from the batch
        MailScanner::Log::WarnLog("Failed to create message structures for %s" .
          ", dropping it from the batch", $this->{id});
        my @toclear = ( $this->{id} );
        $workarea->ClearIds(\@toclear); # Delete attachments we might have made
        $this->DropFromBatch();
        return;                                                         
      }

      MailScanner::Log::WarnLog("Cannot parse " . $this->{headerspath} . " and " .
                   $this->{dpath} . ", $@");
      $this->{entity} = $entity; # In case it failed due to too many attachments
      $this->{cantparse} = 1;
      $this->{otherinfected} = 1;
      return;
    }

    # Too many attachments in the message?
    if ($maxparts>0 && MIME::Entity::MailScannerCounter()>=$maxparts) {
      #print STDERR "Found an error!\n";
      #Not with sendmail: $pipe->close();
      #Not with sendmail: kill 9, $pid; # Make sure we are reaping a dead'un
      #Not with sendmail: waitpid $pid, 0;
      MailScanner::Log::WarnLog("Too many attachments (%d) in %s",
                              MIME::Entity::MailScannerCounter(), $this->{id});
      $this->{entity} = $entity; # In case it failed due to too many attachments
      $this->{toomanyattach} = 1;
      $this->{otherinfected} = 1;
      return;
    }

    # Closing the pipe this way will reap the child, apparently!
    #Not with sendmail: $pipe->close;
    #Not with sendmail: kill 9, $pid; # Make sure we are reaping a dead'un
    $this->{entity} = $entity;

  } else {

    #
    # This is for non-sendmail/Postfix systems
    #

    # Create the message stream
    # NOTE: This still uses the real path of the message body file.
    ($pipe,$pid) = $this->{store}->ReadMessagePipe($this) or return;

    # Do the actual parsing
    my $maxparts = MailScanner::Config::Value('maxparts', $this) || 200;
    MIME::Entity::ResetMailScannerCounter($maxparts);

    # Inform MIME::Parser about our maximum
    $parser->max_parts($maxparts * 3);

    $entity = eval { $parser->parse($pipe) };

    if (!$entity && !MIME::Entity::MailScannerCounter()>=$maxparts) {
      #print STDERR "Found an error!\n";
      $pipe->close() if $pipe; # Don't close a pipe that failed to exist
      waitpid $pid, 0;
      unless ($this->{dpath}) {
        # It probably ran out of disk space, drop this message from the batch
        MailScanner::Log::WarnLog("Failed to create message structures for %s" .
          ", dropping it from the batch", $this->{id});
        my @toclear = ( $this->{id} );
        $workarea->ClearIds(\@toclear); # Delete attachments we might have made
        $this->DropFromBatch();
        return;                                                         
      }

       MailScanner::Log::WarnLog("Cannot parse " . $this->{headerspath} .
                                 " and " .  $this->{dpath} . ", $@");
       $this->{entity} = $entity;# In case it failed due to too many attachments
       $this->{cantparse} = 1;
       $this->{otherinfected} = 1;
       return;
    }
    # Too many attachments in the message?
    if ($maxparts>0 && MIME::Entity::MailScannerCounter()>=$maxparts) {
      #print STDERR "Found an error!\n";
      $pipe->close();
      kill 9, $pid; # Make sure we are reaping a dead'un
      waitpid $pid, 0;
      MailScanner::Log::WarnLog("Too many attachments (%d) in %s",
                              MIME::Entity::MailScannerCounter(), $this->{id});
      $this->{entity} = $entity; # In case it failed due to too many attachments
      $this->{toomanyattach} = 1;
      $this->{otherinfected} = 1;
      return;
    }

    # Closing the pipe this way will reap the child, apparently!
    $pipe->close;
    kill 9, $pid; # Make sure we are reaping a dead'un
    $this->{entity} = $entity;
  }

  # Now handle TNEF files. They should be the only attachment to the message.
  $this->{tnefentity} = MailScanner::TNEF::FindTNEFFile($entity)
    if MailScanner::Config::Value('expandtnef');

  # Look for winmail.dat files in each attachment directory $path.
  # When we find one explode it into its files and store the root MIME
  # entity into $IsTNEF{$id} so we can handle it separately later.
  # Pattern to match is actually winmail(digits).dat(digits) as that copes
  # with forwarded or bounced messages from mail packages that download
  # all attachments into 1 directory, adding numbers to their filenames.
  if (MailScanner::Config::Value('tnefexpander') && $this->{tnefentity}) {
    my($tneffile, @tneffiles);
    # Find all the TNEF files called winmail.dat
    my $outputdir = new DirHandle;
    $outputdir->open($explodeinto)
      or MailScanner::Log::WarnLog("Failed to open dir " . $explodeinto .
                      " while scanning for TNEF files, %s", $!);
    @tneffiles = map { /(winmail\d*\.dat\d*)/i } $outputdir->read();
    $outputdir->close();

    #print STDERR "TNEF files are " . join(',',@tneffiles) . "\n";

    foreach $tneffile (@tneffiles) {
      my $result;
      MailScanner::Log::InfoLog("Expanding TNEF archive at %s/%s",
                                $explodeinto, $tneffile);
      $result = MailScanner::TNEF::Decoder($explodeinto, $tneffile, $this);
      unless ($result) {
        MailScanner::Log::WarnLog("Corrupt TNEF %s that cannot be " .
                                  "analysed in message %s", $tneffile,
                                  $this->{id});
        $this->{badtnef} = 1;
        $this->{otherinfected} = 1;
      }
    }
  }

  unless(chdir $explodeinto) {
    MailScanner::Log::WarnLog("Could not chdir to %s just before unpacking " .
                              "extra message parts", $explodeinto);
    return;
  }

  # -------------------------------
  # If the MIME boundary exists and is "" then remove the entire message.
  # The top level must be multipart/mixed
  if ($entity->head) {
    if ($entity->is_multipart || $entity->head->mime_type =~ /^multipart/i) {
      my $boundary = $entity->head->multipart_boundary;
      #print STDERR "Boundary is \"$boundary\"\n";
      if ($boundary eq "" || $boundary eq "\"\"" || $boundary =~ /^\s/) {
        my $cantparse = MailScanner::Config::LanguageValue($this,
                                                           'cantanalyze');
        $this->{allreports}{""} .= "$mailscannername: $cantparse\n";
        $this->{alltypes}{""} .= 'c';
        $this->{otherinfected}++;
        #print STDERR "Found error\n";
      }
    }
  }


  # -------------------------------

  # Now try to extract messages from text files as they might be things
  # we didn't manage to extract first time around.
  # And try to expand .tar.gz .tar.z .tgz .zip files.
  # We will then scan everything from inside them.
  my($allowpasswords, $couldnotreadmesg, $passwordedmesg, $toodeepmesg);
  $allowpasswords = MailScanner::Config::Value('allowpasszips', $this);
  $allowpasswords = ($allowpasswords !~ /0/)?1:0;
  $couldnotreadmesg = MailScanner::Config::LanguageValue($this,
                                                         'unreadablearchive');
  $passwordedmesg = MailScanner::Config::LanguageValue($this,
                                                       'passwordedarchive');
  $toodeepmesg    = MailScanner::Config::LanguageValue($this,
                                                       'archivetoodeep');
  $this->ExplodePartAndArchives($explodeinto,
                                MailScanner::Config::Value('maxzipdepth', $this),
                                $allowpasswords, $couldnotreadmesg,
                                $passwordedmesg, $toodeepmesg,
                                $mailscannername);


  # Set the owner and group on all the extracted files
  chown $workarea->{uid}, $workarea->{gid}, glob "$explodeinto/*"
    if $workarea->{changeowner};
}

# Quietly drop a message from the batch. Used when we run out of disk
# space.
sub DropFromBatch {
  my($message) = @_;
  $message->{deleted} = 1;
  $message->{gonefromdisk} = 1; # Don't try to delete the original
  $message->{store}->Unlock(); # Unlock it so other processes can pick it up
}

# Try to recursively unpack tar (with or without gzip) files and zip files.
# Extracts to a given maximum unpacking depth.
sub ExplodePartAndArchives {
  my($this, $explodeinto, $maxlevels, $allowpasswords,
     $couldnotreadmesg, $passwordedmesg, $toodeepmesg, $msname) = @_;

  my($dir, $file, $part, @parts, $buffer);
  my(%seenbefore, %seenbeforesize, $foundnewfiles);
  my($size, $level, $ziperror, $tarerror, $silentviruses, $noisyviruses);
  my($allziperrors, $alltarerrors, $textlevel, $failisokay);
  my($linenum, $foundheader, $prevline, $line, $position, $prevpos, $nextpos);
  my($cyclecounter, $rarerror);

  $dir = new DirHandle;
  $file = new FileHandle;
  $level = 0; #-1;
  $textlevel = 0;
  $cyclecounter = 0;
  $ziperror = 0;
  $tarerror = 0;

  # Do they only want encryption checking and nothing else?
  my $onlycheckencryption;
  $onlycheckencryption = 0;
  # More robust way of saying maxlevels==0 && allowpasswords==0;
  $onlycheckencryption = 1 if !$maxlevels && !$allowpasswords;

  $silentviruses = ' '. MailScanner::Config::Value('silentviruses', $this) .' ';
  $noisyviruses = ' ' . MailScanner::Config::Value('noisyviruses', $this) .' ';

  $dir->open($explodeinto);

  # $cyclecounter is a sanity check to ensure we don't loop forever
  OUTER: while($cyclecounter<30) {
    $cyclecounter++;
    $textlevel++;
    last if $level>$maxlevels; # && $textlevel>1;
    $foundnewfiles = 0;
    $dir->rewind();
    @parts = $dir->read();
    #print STDERR "Level = $level\n";
    foreach $part (@parts) {
      next if $part eq '.' || $part eq '..';
      # Skip the entire loop if it's not what we are looking for
      # JKF I really haven't the faintest idea why I wrote the next line :-)
      #next unless $part =~
      #  /(^msg.*txt$)|(\.(tar\.g?z|taz|tgz|tz|zip|exe|rar)$)/i;

      $size = -s "$explodeinto/$part";
      #print STDERR "Checking $part $size bytes\n";
      next if $seenbefore{$part} &&
              $seenbeforesize{$part} == $size;
      $seenbefore{$part} = 1;
      $seenbeforesize{$part} = $size;
      #print STDERR "$level/$maxlevels Found new file $part\n";

      #print STDERR "Reading $part\n";
      if ($part =~ /^msg.*txt/ && $textlevel<=2) {
        # Try and find hidden messages in the text files
        #print STDERR "About to read $explodeinto/$part\n";
        $file->open("$explodeinto/$part") or next;

        # Try reading the first few lines to see if they look like mail headers
        $linenum = 0;
        $foundheader = 0;
        $prevline = "";
        $prevpos = 0;
        $nextpos = 0;
        $line = undef;

        for ($linenum=0; $linenum<30; $linenum++) {
          #$position = $file->getpos();
          $line = <$file>;
          last unless defined $line;
          $nextpos += length $line;
          # Must have 2 lines of header
          # prevline looks like Header:
          # line     looks like       setting
          #          or         Header: 
          if ($prevline =~ /^[^:\s]+: / && $line =~ /(^\s+\S)|(^[^:\s]+: )/) { #|(^\s+.*=)/) {
            #print STDERR "Found header start at \"$prevline\"\n and \"$line\"\n";
            $foundheader = 1;
            last;
          }
          $prevline = $line;
          $prevpos  = $position;
          $position = $nextpos;
        }
    
        if ($foundheader) {
          # Check all lines are header lines up to next blank line
          my($num, $reallyfoundheader);
          $reallyfoundheader = 0;
          # Check for a maximum of 30 lines of headers
          foreach $num (0..30) {
            $line = <$file>;
            last unless defined $line;
            # Must have a valid header line
            #print STDERR "Examining: \"$line\"\n";
            next if $line =~ /(^\s+\S)|(^[^:\s]+: )/;
            #print STDERR "Not a header line\n";
            # Or a blank line
            if ($line =~ /^[\r\n]*$/) {
              $reallyfoundheader = 1;
              last;
            }
            #print STDERR "Not a blank line\n";
            # Non-header line, so it isn't a valid message part
            $reallyfoundheader = 0;
            last;
          }
          #print STDERR "Really found header = $reallyfoundheader\n";
          if ($reallyfoundheader) {
            # Rewind to the start of the header
            #$file->setpos($prevpos);
            seek $file, $prevpos, 0;
            #print STDERR "First line is \"" . <$file> . "\"\n";
    
            # Setup everything for the MIME parser
            my $parser = MIME::Parser->new;
            my $filer  = MIME::Parser::FileInto->new($explodeinto);
    
            # Over-ride the default default character set handler so it does it
            # much better than the MIME-tools default handling.
            MIME::WordDecoder->default->handler('*' => \&WordDecoderKeep7Bit);
  
            #print STDERR "Exploding message " . $this->{id} . " into " .
            #             $explodeinto . "\n";
            $parser->filer($filer);
            $parser->extract_uuencode(1); # uue is off by default
            $parser->output_to_core('NONE'); # everything into files
  
            # Do the actual parsing
            #print STDERR "About to parse\n";
            my $entity = eval { $parser->parse($file) };
            #print STDERR "Done the parse\n";

            # We might have created new files that need parsing
            $foundnewfiles = 1;
            next OUTER;
          }
        }
        $file->close;
      }

      # Not got anything to do?
      next if !$maxlevels && $allowpasswords;

      #$level++;
      next if $level > $maxlevels;

      # Find all the zip files
      #print STDERR "Looking at $explodeinto/$part\n";
      #next if MailScanner::Config::Value('filecommand', $this) eq "";
      next unless $file->open("$explodeinto/$part");
      #print STDERR "About to read 4 bytes\n";
      unless (read($file, $buffer, 4) == 4) {
        #print STDERR "Very short file $part\n";
        $file->close;
        next;
      }
      my $uudfilename = "";
      $uudfilename = FindUUEncodedFile($file)
        if MailScanner::Config::Value('lookforuu', $this) =~ /1/;
      #$file->close;
      $failisokay = 0;
      if ($buffer =~ /^MZ/) {
        $failisokay = 1;
      }
      $file->close, next unless $buffer eq "PK\003\004" ||
                  $buffer eq "Rar!"       ||
                  $part =~ /\.rar$/       ||
                  defined($uudfilename) ||
                  $failisokay;
      #print STDERR "Found a zip or rar file\n" ;
      $file->close, next unless MailScanner::Config::Value('findarchivesbycontent', $this) ||
                  $part =~ /\.(tar\.g?z|taz|tgz|tz|zip|exe|rar|uu|uue)$/i;
      $foundnewfiles = 1;
      #print STDERR "Unpacking $part at level $level\n";

      if ($uudfilename ne "") {
        # It cannot be a zip or a rar, so skip the checks for them.
        # Oh yes it can! Do all the checks.
        # Ignore the return value, don't care if uudecode fails, it was
        # probably just a false positive on the uuencoded-data locator.
        #print STDERR "About to unpackuue $part into $uudfilename\n";
        $this->UnpackUUE($part, $explodeinto, $file, $uudfilename);
      }
      $file->close;
      # Is it a zip file, in which case unpack the zip
      $ziperror = "";
      #print STDERR "About to unpackzip $part\n";
      $ziperror = $this->UnpackZip($part, $explodeinto, $allowpasswords,
                                   $onlycheckencryption);
      #print STDERR "* * * * * * * Unpackzip $part returned $ziperror\n";
      # If unpacking as a zip failed, try it as a rar
      $rarerror = "";
      if ($part =~ /\.rar$/i || $buffer eq "Rar!" or $buffer =~ /^MZ[P]?/) {
        $rarerror = $this->UnpackRar($part, $explodeinto, $allowpasswords,
                                     $onlycheckencryption);
      }
      $tarerror = "";
      $tarerror = 0 # $this->UnpackTar($part, $explodeinto, $allowpasswords)
        if $ziperror || $part =~ /(tar\.g?z|tgz)$/i;
      #print STDERR "In inner: \"$part\"\n";
      if ($ziperror eq "password" || $rarerror eq "password") {
        MailScanner::Log::WarnLog("Password-protected archive (%s) in %s",
                                  $part, $this->{id});
        $this->{allreports}{$part} .= "$msname: $passwordedmesg\n";
        $this->{alltypes}{$part} .= 'c';
        $this->{passwordprotected} = 1;
        $this->{otherinfected} = 1;
        $this->{cantdisinfect} = 1; # Don't even think about disinfecting this!
        $this->{silent}=1 if $silentviruses =~ / Zip-Password | All-Viruses /i;
        $this->{noisy} =1 if $noisyviruses  =~ / Zip-Password /i;
      } elsif ($ziperror && $tarerror && $rarerror && !$failisokay) {
        MailScanner::Log::WarnLog("Unreadable archive (%s) in %s",
                                  $part, $this->{id});
        $this->{allreports}{$part} .= "$msname: $couldnotreadmesg\n";
        $this->{alltypes}{$part} .= 'c';
        $this->{otherinfected} = 1;
      }
    }
    #print STDERR "In outer: \"$part\"\n";
    last if !$foundnewfiles || $level>$maxlevels;
    $dir->rewind;
    #print STDERR "Rewinding, Incrementing level from $level to " . ($level+1) . "\n";
    $level++;
  }

  #print STDERR "Level=$level($maxlevels)\n";
  #print STDERR "Onlycheckencryption=$onlycheckencryption\n";
  if ($level>$maxlevels && !$onlycheckencryption && $maxlevels) {
    MailScanner::Log::WarnLog("Files hidden in very deeply nested archive " .
                              "in %s", $this->{id});
    $this->{allreports}{""} .= "$msname: $toodeepmesg\n";
    $this->{alltypes}{""} .= 'c';
    $this->{otherinfected}++;
  }
}

# Search the given filehandle for signs that this could contain uu-encoded data
# Return the filename if found, undef otherwise. Also return the open file
# handle.
sub FindUUEncodedFile {
  my $fh = shift;

  my($mode, $file);
  my $linecounter = 0;

  seek $fh, 0, 0; # Rewind the file to the start
  while (<$fh>) {
    if (/^begin(.*)/) {
      my $modefile = $1;
      if ($modefile =~ /^(\s+(\d+))?(\s+(.*?\S))?\s*\Z/) {
        ($mode, $file) = ($2, $4);
      }
      last;
    }
    $linecounter++;
    seek($fh, 0, 0), return undef if $linecounter>50;
  }
  return $file;
}


# We now have a uuencoded file to decode. We have a target filename we have
# read from the uuencode header.
sub UnpackUUE {
  my $this = shift;
  my($uuencoded, $explodeinto, $uuehandle, $uudecoded) = @_;

  MailScanner::Log::DebugLog("Unpacking UU-encoded file %s", $uuencoded);

  # Set up all the tree structures for cross-referencing
  my $safename = $this->MakeNameSafe($uudecoded,$explodeinto);
  $this->{file2parent}{$uudecoded} = $uuencoded;
  $this->{file2parent}{$safename} = $uuencoded;
  $this->{file2safefile}{$uudecoded} = $safename;
  $this->{safefile2file}{$safename} = $uudecoded;

  $safename = "$explodeinto/$safename";

  my $out = new FileHandle;
  unless ($out->open("> $safename")) {
    MailScanner::Log::WarnLog("Unpacking UU-encoded file %s, could not create target file %s", $this->MakeNameSafe($uuencoded,$explodeinto), $safename);
    return;
  }

  while  (<$uuehandle>) {
    last if /^end/;
    next if /[a-z]/;
    next unless int((((ord() - 32) & 077) + 2) / 3) == int(length() / 4);
    $out->print(unpack('u', $_));
  }
  $out->close;
}


# Unpack a rar file into the named directory.
# Return 1 if an error occurred, else 0.
# Return 0 on success.
# Return "password" if a member was password-protected.
# Very much like UnpackZip except it uses the external "unrar" command.
sub UnpackRar {
  my($this, $zipname, $explodeinto, $allowpasswords, $onlycheckencryption) = @_;

  my($zip, @members, $member, $name, $fh, $safename, $memb, $check, $junk,
     $unrar,$IsEncrypted, $PipeTimeOut, $PipeReturn,$NameTwo, $HasErrors,
     $member2, $Stuff, $BeginInfo, $EndInfo, $ParseLine, $what);

  # Timeout value for unrar is currently the same as that of the file
  # command + 20. Julian, when you add the filetimeout to the config file
  # perhaps you should think about adding a maxcommandexecutetime setting
  # as well
  $PipeTimeOut = MailScanner::Config::Value('unrartimeout');
  $unrar = MailScanner::Config::Value('unrarcommand');
  return 1 unless $unrar && -x $unrar;

  #MailScanner::Log::WarnLog("UnPackRar Testing : %s", $zipname);

  # This part lists the archive contents and makes the list of
  # file names within. "This is a list verbose option"
  $memb = SafePipe("$unrar v '$explodeinto/$zipname' 2>/dev/null",
                   $PipeTimeOut);

  $junk = "";
  $Stuff = "";
  $BeginInfo = 0;
  $EndInfo = 0;
  $ParseLine = 1;
  $memb =~ s/\r//gs;
  my @test = split /\n/, $memb;
  $memb = '';

  # Have to parse the output from the 'v' command and parse the information
  # between the ----------------------------- lines
  foreach $what (@test) {
    # Have we already hit the beginng and now find another ------ string?
    # If so then we are at the end
    $EndInfo = 1 if $what =~ /-{40,}$/ && $BeginInfo;
  
    # if we are after the begning but haven't reached the end,
    # then process this line
    if ($BeginInfo && !$EndInfo) {
      # If we are on line one then it's the file name with full path
      # otherwise we are on the info line containing the attributes
      if ($ParseLine eq 1) {
        $junk = $what;
        $junk =~ s/^\s+|\s+$//g;
        chomp($junk);
        $ParseLine = 2;
      } else {
        $Stuff = $what;
        $Stuff =~ s/^\s+|\s+$//g;
        # Need to remove redundant spaces from our info line and
        # split it into it's components
        chomp($Stuff);
        $Stuff =~ s/\s{2,}/ /g;
        my ($RSize,$RPacked,$RRatio,$RDate,$RTime,$RAttrib,$RCrc,$RMeth,$RVer)
           = split /\s/, $Stuff;
        # If RAttrib doesn't begin with d then it's a file and we
        # add it to our $memb string, otherwise we ignore the directory
        # only entries
        #MailScanner::Log::WarnLog("UnPackRar InfoLine :%s:", $Stuff);
        #MailScanner::Log::WarnLog("UnPackRar Looking at ATTRIB :->%s<-:",
        #                          $RAttrib);
        $memb .= "$junk\n" if $RAttrib !~ /^d|^.D/;
        $junk = '';
        $Stuff = '';
        $ParseLine = 1;
      }
    }
    # If we have a line full of ---- and $BeginInfo is not set then
    # we are at the first and we need to set $BeginInfo so next pass
    # begins processing file information
    if ($what =~ /-{40,}$/ && ! $BeginInfo) {
      $BeginInfo = 1;
    }
  }

  # Remove returns from the output string, exit if the archive is empty
  # or the output is empty

  $memb =~ s/\r//gs;
  return 1 if $memb ne '' &&
              $memb =~ /(No files to extract|^COMMAND_TIMED_OUT$)/si;

  return 0 if $memb eq ''; # JKF If no members it probably wasn't a Rar self-ext
  #MailScanner::Log::DebugLog("Unrar : Archive Testing Completed On : %s",
  #                           $memb);

  @members = split /\n/, $memb;
  $fh = new FileHandle;

  foreach $member2 (@members) {
    $IsEncrypted = 0;
    $HasErrors = 0;
    #MailScanner::Log::InfoLog("Checking member %s",$member2);
    # Test the current file name to see if it's password protected
    # and capture the output. If the command times out, then return

    next if $member2 eq "";
    $member = quotemeta $member2;
    #print STDERR "Member is ***$member***\n";
    $check = SafePipe(
      "$unrar  t -p- -idp '$explodeinto/$zipname' $member 2>&1",
      $PipeTimeOut);
    #print STDERR "Point 1\n";
    return 1 if $check =~ /^COMMAND_TIMED_OUT$/;

    # Check for any error with this file. Format is FileName - Error string
    if ($check =~ /$member\s+-\s/i){
      MailScanner::Log::WarnLog("Unrar: Error in file: %s -> %s",
                                $zipname,$member);
      $HasErrors = 1;
    }

    $check =~ s/\n/:/gsi;
    #MailScanner::Log::WarnLog("Got : %s", $check);

    # If we get the string Encrypted then we have found a password
    # protected archive and we handle it the same as zips are handled

    if ($check =~ /\bEncrypted file:\s.+\(password incorrect/si) {
      $IsEncrypted = 1;
      MailScanner::Log::WarnLog("Password Protected RAR Found");
      #print STDERR "Checking member " . $member . "\n";
      #print STDERR "******** Encryption = " . $IsEncrypted . "\n";
      return "password" if !$allowpasswords && $IsEncrypted;
    }


    # If they don't want to extract, but only check for encryption,
    # then skip the rest of this as we don't actually want the files
    # checked against the file name/type rules
    next if $onlycheckencryption;

    $name = $member2;
    #print STDERR "UnPackRar : Making Safe Name from $name\n";

    # There is no facility to change the output name for a rar file
    # but we can rename rename the files inside the archive
    # prefer to use $NameTwo because there is no path attached
    # $safename is guaranteed not to exist, but NameTwo gives us the
    # filename without any directory information, which we use later.
    $safename = $this->MakeNameSafe($name,$explodeinto);
    $NameTwo = $safename;
    $NameTwo = $1 if $NameTwo =~ /([^\/]+)$/;
    #MailScanner::Log::InfoLog("UnPackRar: Member : %s", $member);
    #print STDERR "UnPackRar : Safe Name is $safename\n";

    #MailScanner::Log::InfoLog("UnPackRar: SafeName : %s", $safename);
    $this->{file2parent}{$name} = $zipname;
    $this->{file2parent}{$safename} = $zipname;
    $this->{file2safefile}{$name} = $safename;
    $this->{safefile2file}{$safename} = $name;
    #print STDERR "Archive member \"$name\" is now \"$safename\"\n";

    #$this->{file2entity}{$name} = $this->{entity};
    $this->{file2safefile}{$name} = $zipname;
    #$this->{safefile2file}{$safename} = $zipname;

    $safename = "$explodeinto/$safename";

    $PipeReturn = '';
    $? = 0;
    if (!$IsEncrypted && !$HasErrors) {
      #print STDERR "Expanding ***$member***\ninto ***$NameTwo***\n";
      $PipeReturn = SafePipe(
                   "$unrar p -y -inul -p- -idp '$explodeinto/$zipname' $member > \"$NameTwo\"",
                   $PipeTimeOut);
      unless ("$?" == 0 && $PipeReturn ne 'COMMAND_TIMED_OUT'){
        # The rename operation failed!, so skip the extraction of a
        # potentially bad file name.
        # JKF Temporary testing code
        #MailScanner::Log::WarnLog("UnPackRar: RC: %s PipeReturn : ",$?,$PipeReturn);
        MailScanner::Log::WarnLog("UnPackRar: Could not rename or use " .
            "safe name in Extract, NOT Unpacking file %s", $safename);
        next;
      }
      #MailScanner::Log::InfoLog("UnPackRar: Done...., got %d and %s", $?, $PipeReturn);
    }
    #MailScanner::Log::WarnLog("RC = %s : Encrypt = %s : PipeReturn = %s",
    #                          $?,$IsEncrypted,$PipeReturn );
    unless ("$?" == 0 && !$HasErrors && !$IsEncrypted &&
            $PipeReturn ne 'COMMAND_TIMED_OUT') {

      # If we got an error, or this file is encrypted create a zero-length
      # file so the filename tests will still work.
      MailScanner::Log::WarnLog("Unrar : Encrypted Or Extract Error Creating" .
                                " 0 length %s",$NameTwo);
      $fh->open(">$safename") && $fh->close();
    }
  }
  return 0;
}

# Modified Julian's code from SweepOther.pm
# Changed to allow execution of any given command line with a time
# control. This could replace any call to system or use of backticks
#
# $Cmd         = command line to execute
# $timeout     = max time in seconds to allow execution
#
sub SafePipe {
  my ($Cmd, $TimeOut) = @_;

  my($Kid, $pid, $TimedOut, $Str);
  $Kid  = new FileHandle;
  $TimedOut = 0;

  #print STDERR "SafePipe : Command : $Cmd\n";
  #print STDERR "SafePipe : TimeOut : $TimeOut\n";

  $? = 0; # Make sure there's no junk left in here

  eval {
    die "Can't fork: $!" unless defined($pid = open($Kid, '-|'));
    if ($pid) {
      # In the parent

      # Set up a signal handler and set the alarm time to the timeout
      # value passed to the function

      local $SIG{ALRM} = sub { $TimedOut = 1; die "Command Timed Out" };
      alarm $TimeOut;

      # while the command is running we will collect it's output
      # in the $Str variable. We don't process it in any way here so
      # whatever called us will get back exactly what they would have
      # gotten with a system() or backtick call

      #MailScanner::Log::DebugLog("SafePipe : Processing %s", $Cmd);

      while(<$Kid>) {
        $Str .= $_;
        #print STDERR "SafePipe : Processing line \"$_\"\n";
      }

      #MailScanner::Log::DebugLog("SafePipe : Completed $Cmd");
      #print STDERR "SafePipe : Returned $PipeReturnCode\n";

      $pid = 0; # 2.54
      alarm 0;
      # Workaround for bug in perl shipped with Solaris 9,
      # it doesn't unblock the SIGALRM after handling it.
      eval {
        my $unblockset = POSIX::SigSet->new(SIGALRM);
        sigprocmask(SIG_UNBLOCK, $unblockset)
          or die "Could not unblock alarm: $!\n";
      };
    } else {
      # In the child
      POSIX::setsid();

      # Execute the command via an exec call, bear in mind this will only
      # capture STDIN so if you need STDERR, or both you have to handle, for
      # example, 2>&1 as part of the command line just as you would with
      # system() or backticks
      #
      #the line following the
      # call should *never* be reached unless the call it's self fails
      #print STDERR "SafePipe in child exec $Cmd\n";

      my @args = ( "$Cmd" );
      #exec $Cmd or print STDERR "SafePipe :  failed to execute $Cmd\n";

      open STDIN, "< /dev/null";

      exec @args
        or MailScanner::Log::WarnLog("SafePipe :  failed to execute %s", $Cmd);
      #MailScanner::Log::DebugLog("SafePipe in Message.pm : exec failed " .
      #                           "for $Cmd");
      exit 1;
    }
  };
  alarm 0; # 2.53

  #MailScanner::Log::DebugLog("SafePipe in Message.pm : Completed $Cmd");
  #MailScanner::Log::WarnLog("Returned Code : %d", $?);
  # Catch failures other than the alarm
  MailScanner::Log::WarnLog("SafePipe in Message.pm : $Cmd failed with real error: $@")
    if $@ and $@ !~ /Command Timed Out/;

  #print STDERR "SafePipe : pid = $pid and \@ = $@\n";

  # In which case any failures must be the alarm
  if ($@ or $pid>0) {
    # Kill the running child process
    my($i);
    kill -15, $pid;
    # Wait for up to 5 seconds for it to die
    for ($i=0; $i<5; $i++) {
      sleep 1;
      waitpid($pid, &POSIX::WNOHANG);
      ($pid=0),last unless kill(0, $pid);
      kill -15, $pid;
    }
    # And if it didn't respond to 11 nice kills, we kill -9 it
    if ($pid) {
      kill -9, $pid;
      waitpid $pid, 0; # 2.53
    }
  }

  # If the command timed out return the string below, otherwise
  # return the command output in $Str
  return $Str unless $TimedOut;

  MailScanner::Log::WarnLog("Safepipe in Message.pm : %s timed out!", $Cmd);
  return "COMMAND_TIMED_OUT";
}


# Unpack a zip file into the named directory.
# Return 1 if an error occurred, else 0.
# Return 0 on success.
# Return "password" if a member was password-protected.
sub UnpackZip {
  my($this, $zipname, $explodeinto, $allowpasswords, $onlycheckencryption) = @_;

  my($zip, @members, $member, $name, $fh, $safename);

  #print STDERR "Unpacking $zipname\n";
  return 1 if -s "$explodeinto/$zipname" == 4_237_4; # zip of death?
  return 1 unless $zip = Archive::Zip->new("$explodeinto/$zipname");
  return 1 unless @members = $zip->members();

  $fh = new FileHandle;

  foreach $member (@members) {
    #print STDERR "Checking member " . $member->fileName() . "\n";
    #print STDERR "******** Encryption = " . $member->isEncrypted() . "\n";
    return "password" if !$allowpasswords && $member->isEncrypted();

    # If they don't want to extract, but only check for encryption,
    # then skip the rest of this as we don't actually want the files.
    next if $onlycheckencryption;

    $name = $member->fileName();
    $safename = $this->MakeNameSafe($name, $explodeinto);
    $this->{file2parent}{$name} = $zipname;
    $this->{file2parent}{$safename} = $zipname;
    $this->{file2safefile}{$name} = $safename;
    $this->{safefile2file}{$safename} = $name;
    #print STDERR "Archive member \"$name\" is now \"$safename\"\n";

    #$this->{file2entity}{$name} = $this->{entity};
    $this->{file2safefile}{$name} = $zipname;
    #$this->{safefile2file}{$safename} = $zipname;

    $safename = "$explodeinto/$safename";

    #print STDERR "About to extract $member to $safename\n";
    unless ($zip->extractMemberWithoutPaths($member, $safename) == AZ_OK) {
      # Create a zero-length file if extraction failed
      # so the filename tests will still work.
      #print STDERR "Done passworded extraction of $member to $safename\n";
      $fh->open(">$safename") && $fh->close();
    }
    #print STDERR "Done extraction of $member to $safename\n";
  }
  return 0;
}

# Is this filename evil?
sub IsNameEvil {
  my($this, $name, $dir) = @_;

  #print STDERR "Testing \"$name\" to see if it is evil\n";
  return 1 if (!defined($name) or ($name eq ''));   ### empty
  return 1 if ($name =~ m{(^\s)|(\s+\Z)});  ### leading/trailing whitespace
  return 1 if ($name =~ m{^\.+\Z});         ### dots
  return 1 if ($name =~ tr{ \%\(\)\+\,\-\.0-9\=A-Z_a-z\{\}\x80-\xFF}{}c);
  return 1 if (length($name) > 50);
  return 'exists' if (-e "$dir/$name");

  #print STDERR "It is okay\n";
  #$self->debug("it's ok");
  0;
}

# Make this filename safe and return the safe version
sub MakeNameSafe {
  my($self, $fname, $dir) = @_;

    ### Isolate to last path element:
    my $last = $fname; $last =~ s{^.*[/\\\[\]:]}{};
    if ($last and !$self->IsNameEvil($last, $dir)) {
        #$self->debug("looks like I can use the last path element");
        #print STDERR "MakeNameSafe: 1 $fname,$last\n";
        return $last;
    }

    # Try removing leading whitespace, trailing whitespace and all
    # dangerous characters to start with.
    $last =~ s/^\s+//;
    $last =~ s/\s+\Z//;
    $last =~ tr/ \%\(\)\+\,\-\.0-9\=A-Z_a-z\{\}\x80-\xFF//cd;
    #print STDERR "MakeNameSafe: 2 $fname,$last\n";
    return $last unless $self->IsNameEvil($last, $dir);

    ### Break last element into root and extension, and truncate:
    my ($root, $ext) = (($last =~ /^(.*)\.([^\.]+)\Z/)
                        ? ($1, $2)
                        : ($last, ''));
    # JKF Delete leading and trailing whitespace
    $root =~ s/^\s+//;
    $ext  =~ s/\s+$//;
    $root = substr($root, 0, ($self->{MPF_TrimRoot} || 14));
    $ext  = substr($ext,  0, ($self->{MPF_TrimExt}  ||  3));
    $ext =~ /^\w+$|^$/ or $ext = "dat";
    my $trunc = $root . ($ext ? ".$ext" : '');
    if (!$self->IsNameEvil($trunc, $dir)) {
        #$self->debug("looks like I can use the truncated last path element");
        #print STDERR "MakeNameSafe: 3 $fname,$trunc\n";
        return $trunc;
    }

    # It is still evil, but probably just because it exists
    if ($self->IsNameEvil($trunc, $dir) eq 'exists') {
      my $counter = 0;
      $trunc = $trunc . '0';
      do {
        $counter++;
        $trunc = $root . $counter . ($ext ? ".$ext" : '');
      } while $self->IsNameEvil($trunc, $dir) eq 'exists';
      return $trunc;
    }
    ### Hope that works:
    #print STDERR "MakeNameSafe: 4 $fname,:-(\n";
    undef;
}

# Unpack a tar file into the named directory.
# Return 1 if an error occurred, else 0.
sub UnpackTar {
  my($this, $tarname, $explodeinto) = @_;

  return 1; # Not yet implemented
}


# Try to parse all the text bits of each message, looking to see if they
# can be parsed into files which might be infected.
# I then throw these sections back to the MIME parser.
sub ExplodePart {
  my($this, $explodeinto) = @_;

  my($dir, $file, $part, @parts);

  $dir = new DirHandle;
  $file = new FileHandle;

  $dir->open($explodeinto);
  @parts = $dir->read();
  $dir->close();

  my($linenum, $foundheader, $prevline, $line, $position, $prevpos, $nextpos);
  foreach $part (@parts) {
    #print STDERR "Reading $part\n";
    next unless $part =~ /^msg.*txt/;

    # Try and find hidden messages in the text files
    #print STDERR "About to read $explodeinto/$part\n";
    $file->open("$explodeinto/$part") or next;

    # Try reading the first few lines to see if they look like mail headers
    $linenum = 0;
    $foundheader = 0;
    $prevline = "";
    $prevpos = 0;
    $nextpos = 0;
    $line = undef;

    for ($linenum=0; $linenum<30; $linenum++) {
      #$position = $file->getpos();
      $line = <$file>;
      last unless defined $line;
      $nextpos += length $line;
      # Must have 2 lines of header
      if ($prevline =~ /^[^:\s]+: / && $line =~ /(^\s+)|(^[^:]+ )|(^\s+.*=)/) {
        #print STDERR "Found header start at \"$prevline\"\n and \"$line\"\n";
        $foundheader = 1;
        last;
      }
      $prevline = $line;
      $prevpos  = $position;
      $position = $nextpos;
    }

    unless ($foundheader) {
      $file->close();
      next;
    }

    # Rewind to the start of the header
    #$file->setpos($prevpos);
    seek $file, $prevpos, 0;
    #print STDERR "First line is \"" . <$file> . "\"\n";

    # Setup everything for the MIME parser
    my $parser = MIME::Parser->new;
    #my $filer  = MIME::Parser::FileInto::MailScanner->new($explodeinto);
    my $filer  = MIME::Parser::FileInto->new($explodeinto);

    # Over-ride the default default character set handler so it does it
    # much better than the MIME-tools default handling.
    MIME::WordDecoder->default->handler('*' => \&WordDecoderKeep7Bit);

    #print STDERR "Exploding message " . $this->{id} . " into " .
    #             $explodeinto . "\n";
    $parser->filer($filer);
    $parser->extract_uuencode(1); # uue is off by default
    $parser->output_to_core('NONE'); # everything into files

    # Do the actual parsing
    my $entity = eval { $parser->parse($file) };

    $file->close;
  }
}


# Print the infection reports for this message
sub PrintInfections {
  my $this = shift;

  my($filename, $report, $type);

  print STDERR "Virus reports for " . $this->{id} . ":\n";
  foreach $filename (keys %{$this->{virusreports}}) {
    print STDERR "    ";
    print STDERR $filename . "\t" . $this->{virusreports}{$filename} . "\n";
    print STDERR "    " . $this->{virustypes}{$filename} . "\n";
  }

  print STDERR "Name reports for " . $this->{id} . ":\n";
  foreach $filename (keys %{$this->{namereports}}) {
    print STDERR "    ";
    print STDERR $filename . "\t" . $this->{namereports}{$filename} . "\n";
    print STDERR "    " . $this->{nametypes}{$filename} . "\n";
  }

  print STDERR "Other reports for " . $this->{id} . ":\n";
  foreach $filename (keys %{$this->{otherreports}}) {
    print STDERR "    ";
    print STDERR $filename . "\t" . $this->{otherreports}{$filename} . "\n";
    print STDERR "    " . $this->{othertypes}{$filename} . "\n";
  }

  print STDERR "Entity reports for " . $this->{id} . ":\n";
  foreach $filename (keys %{$this->{entityreports}}) {
    print STDERR "    ";
    print STDERR $filename . "\t" . $this->{entityreports}{$filename} . "\n";
  }

  print STDERR "All reports for " . $this->{id} . ":\n";
  foreach $filename (keys %{$this->{allreports}}) {
    print STDERR "    ";
    print STDERR $filename . "\t" . $this->{allreports}{$filename} . "\n";
  }

  print STDERR "Message is TNEF? " . ($this->{tnefentity}?"Yes":"No") . "\n";
  print STDERR "Message is bad TNEF? " . ($this->{badtnef}?"Yes":"No") . "\n";
  print STDERR "Message has " . $this->{virusinfected} . " virus infections\n";
  print STDERR "Message has " . $this->{otherinfected} . " other problems\n";

  print STDERR "\n";
}


# Create the Entity2Parent and Entity2File hashes for a message
#    $message->CreateEntitiesHelpers($this->{entity2parent},
#                                    $this->{entity2file});

sub CreateEntitiesHelpers {
  my $this = shift;
  #my($Entity2Parent, $Entity2File) = @_;

  return undef unless $this->{entity};

  $this->{numberparts} = CountParts($this->{entity}) || 1;

  # Put something useless in the 2 hashes so that they exist.
  $this->{entity2file}{""} = 0;
  $this->{entity2parent}{""} = 0;
  $this->{file2entity}{""} = $this->{entity}; # Root of this message
  $this->{name2entity}{""} = 0;
  $this->{file2safefile}{""} = "";
  $this->{safefile2file}{""} = "";
  BuildFile2EntityAndEntity2File($this->{entity},
                                 $this->{file2entity},
                                 $this->{file2safefile},
                                 $this->{safefile2file},
                                 $this->{entity2file},
                                 $this->{name2entity});
  #print STDERR "In CreateEntitiesHelpers, this = $this\n";
  #print STDERR "In CreateEntitiesHelpers, this entity = " .
  #             $this->{entity} . "\n";
  #print STDERR "In CreateEntitiesHelpers, parameters are " .
  #             scalar($this->{entity2file}) . " and " .
  #             scalar($this->{entity2parent}) . "\n";
  BuildEntity2Parent($this->{entity}, $this->{entity2parent}, undef);
}


# For the MIME entity given, work out the number of message parts.
# Recursive. This is a class function, not a normal method.
sub CountParts {
  my($entity) = @_;
  my(@parts, $total, $part);

  return 0 unless $entity;
  @parts = $entity->parts;
  $total += int(@parts);
  foreach $part (@parts) {
    $total += CountParts($part);
  }
  return $total;
}


# Build the file-->entity and entity-->file mappings for a message.
# This will let us replace infected entities later. Key is the filename,
# value is the entity.
# This is recursive. This is a class function, not a normal method.
sub BuildFile2EntityAndEntity2File {
  my($entity, $file2entity, $file2safefile, $safefile2file, $entity2file,
     $name2entity) = @_;

  # Build the conversion hash from scalar(entity) --> real entity object
  # Need to do this as objects cannot be hash keys.
  $name2entity->{scalar($entity)} = $entity;

  my(@parts, $body, $headfile, $part, $path);

  # Find the body for this entity
  $body = $entity->bodyhandle;
  if (defined($body) && defined($body->path)) {   # data is on disk:
    $path = $body->path;
    $path =~ s#^.*/([^/]*)$#$1#;
    $file2entity->{$path} = $entity;
    $entity2file->{$entity} = $path;
    #print STDERR "Path is $path\n";
  }
  # And the head, which is where the recommended filename is stored
  # This is so we can report infections in the filenames which are
  # recommended, even if they are evil and we hence haven't used them.
  $headfile = $entity->head->recommended_filename || $path;
  #print STDERR "rec filename for \"$headfile\" is \"" . $entity->head->recommended_filename . "\"\n";
  #print STDERR "headfile is $headfile\n";
  if ($headfile) {
    $file2entity->{$headfile} = $entity if !$file2entity->{$headfile};
    $file2safefile->{$headfile} = $path;
    $safefile2file->{$path}     = $headfile;
    #print STDERR "File2SafeFile (\"$headfile\") = \"$path\"\n";
  }

  # And for all its children
  @parts = $entity->parts;
  foreach $part (@parts) {
    BuildFile2EntityAndEntity2File($part, $file2entity, $file2safefile,
                                   $safefile2file, $entity2file, $name2entity);
  }
}


# Build a hash that gives the parent of any entity
# (except for root ones which will be undef).
# This is recursive.
sub BuildEntity2Parent {
  my($entity, $Entity2Parent, $parent) = @_;

  my(@parts, $part);

  $Entity2Parent->{$entity} = $parent;
  @parts = $entity->parts;
  foreach $part (@parts) {
    #print STDERR "BuildEntity2Parent: Doing part $part\n";
    $Entity2Parent->{$part} = $entity;
    BuildEntity2Parent($part, $Entity2Parent, $entity);
  }
}


# Combine the virus reports and the other reports, as otherwise the
# cleaning code is really messy. I might combine them when I create
# them some time later, but I wanted to keep them separate if possible
# in case anyone wanted a feature in the future which would be easier
# with separate reports.
# If safefile2file does not map for a filename, ban the whole message
# to be on the safe side.
sub CombineReports {
  my $this = shift;

  my($file, $text, $Name);
  my(%reports, %types);
  #print STDERR "Combining reports for " . $this->{id} . "\n";

  # If they want to include the scanner name in the reports, then also
  # include the translation of "MailScanner" in the filename/type/content
  # reports.
  # If they set "MailScanner = " in languages.conf then this string will
  # *not* be inserted at the start of the reports.
  $Name = MailScanner::Config::LanguageValue($this, 'mailscanner')
    if MailScanner::Config::Value('showscanner', $this);
  $Name .= ': ' if $Name ne "" && $Name !~ /:/;

  # Or the flags together
  $this->{infected} = $this->{virusinfected} |
                      $this->{nameinfected}  |
                      $this->{otherinfected} ;

  # Combine all the reports and report-types
  while (($file, $text) = each %{$this->{virusreports}}) {
    #print STDERR "Adding file $file report $text\n";
    $this->{allreports}{$file} .= $text;
    $reports{$file} .= $text;
  }
  while (($file, $text) = each %{$this->{virustypes}}) {
    #print STDERR "Adding file $file type $text\n";
    $this->{alltypes}{$file} .= $text;
    $types{$file} .= $text;
  }
  while (($file, $text) = each %{$this->{namereports}}) {
    #print STDERR "Adding file \"$file\" report \"$text\"\n";
    # Next line not needed as we prepend the $Name anyway
    #$text =~ s/\n(.)/\n$Name: NEWSTABLE $1/g if $Name; # Make sure name is at the front of this
    #print STDERR "report is now \"$text\"\n";
    $this->{allreports}{$file} .= $Name . $text;
    $reports{$file} .= $Name . $text;
  }
  while (($file, $text) = each %{$this->{nametypes}}) {
    #print STDERR "Adding file $file type $text\n";
    $this->{alltypes}{$file} .= $text;
    $types{$file} .= $text;
  }
  while (($file, $text) = each %{$this->{otherreports}}) {
    #print STDERR "Adding file $file report $text\n";
    $this->{allreports}{$file} .= $Name . $text;
    $reports{$file} .= $Name . $text;
  }
  while (($file, $text) = each %{$this->{othertypes}}) {
    #print STDERR "Adding file $file type $text\n";
    $this->{alltypes}{$file} .= $text;
    $types{$file} .= $text;
  }

  # Now try to map all the reports onto their parents as far as possible
  #print STDERR "About to combine reports\n";
  my($key, $value, $parent, %foundparent);
  while(($key, $value) = each %reports) {
    $parent = $this->{file2parent}{$key};
    #print STDERR "Looking at report for $key (son of $parent)\n";
    #if (defined $parent && exists($this->{safefile2file}{$parent})) {
    #  #print STDERR "Found parent of $key is $parent\n";
    #  $foundparent{$key} = 1;
    #  $this->{allreports}{$parent} .= $value;
    #  $this->{alltypes}{$parent}   .= $types{$key};
    #} else {
    #  #print STDERR "Promoting report for $key\n";
    #  delete $this->{allreports}{$key};
    #  delete $this->{alltypes}{$key};
    #  $this->{allreports}{""} .= $value;
    #  $this->{alltypes}{""} .= $types{$key};
    #}
    if (defined $parent && exists($this->{safefile2file}{$parent}) &&
        $parent ne "") {
      #print STDERR "Found parent of $key is $parent\n";
      $foundparent{$key} = 1;
      $this->{allreports}{$parent} .= $value;
      $this->{alltypes}{$parent}   .= $types{$key};
    } else {
      #print STDERR "Promoting report for $key\n";
      if($parent eq "" and exists($this->{safefile2file}{$key})) {
        $foundparent{$key} = 1;
        delete $this->{allreports}{$key};
        delete $this->{alltypes}{$key};
        $this->{allreports}{$key} .= $value;
        $this->{alltypes}{$key}   .= $types{$key};
      } else {
        delete $this->{allreports}{$key};
        delete $this->{alltypes}{$key};
        $this->{allreports}{""} .= $value;
        $this->{alltypes}{""} .= $types{$key};
      }
    }
  }
  # And delete the records for members we have found.
  #foreach $key (keys %foundparent) {
  #  print STDERR "Deleting report for $key\n";
  #  delete $this->{allreports}{$key};
  #  delete $this->{alltypes}{$key};
  #}

  # Now look for the reports we can't match anywhere and make them
  # map to the entire message.
  #while(($key, $value) = each %reports) {
  #  if (!defined $foundparent{$key} || !exists($this->{safefile2file}{$key})) {
  #    #print STDERR "Promoting report for $key\n";
  #    delete $this->{allreports}{$key};
  #    delete $this->{alltypes}{$key};
  #    $this->{allreports}{""} .= $value;
  #    $this->{alltypes}{""} .= $types{$key};
  #  }
  #}

  #print STDERR "Finished combining reports\n";
  #$this->PrintInfections();
}


# Clean the message. This involves removing all the infected or
# troublesome sections of the message and replacing them with
# nice little text files explaining what happened.
# We do not do true macro-virus disinfection here.
# Also mark the message as having had its body modified.
sub Clean {
  my $this = shift;

  #print STDERR "\n\n\nStart Of Clean\n\n";
  #$this->PrintInfections();
  # Get out if nothing to do
  #print STDERR "Have we got anything to do?\n";
  return unless ($this->{allreports} && %{$this->{allreports}}) ||
                ($this->{entityreports} && %{$this->{entityreports}});
  #print STDERR "Yes we have\n";

  my($file, $text, $entity, $parent, $filename, $everyreport, %AlreadyCleaned);

  # Work out whether infected bits of this message should be stored
  my $storeme = 0;
  $storeme = 1
    if MailScanner::Config::Value('quarantineinfections', $this) =~ /1/;
  # Cancel the storage if it is silent and no-one wants it quarantined
  $storeme = 0 if $this->{silent} && !$this->{noisy} &&
                  MailScanner::Config::Value('quarantinesilent', $this) !~ /1/;

  # Construct a string of all the reports, which is used if there is
  # cleaning needing doing on the whole message
  $everyreport = join("\n", values %{$this->{allreports}});

  # Construct a hash of all the entities we will clean,
  # so we clean parents in preference to their children.
  my(%EntitiesWeClean);
  $EntitiesWeClean{scalar($this->{tnefentity})} = 1 if $this->{tnefentity};
  while(($file, $text) = each %{$this->{allreports}}) {
    $entity = $this->{file2entity}{"$file"};
    # If we are a child, push the parent on the list
    $entity = $this->{file2entity}{$this->{file2parent}{$file}} if !$entity;
    # If there isn't a parent either, push the whole message on the list
    $entity = $this->{entity} if !$entity;
    $EntitiesWeClean{scalar $entity} = 1;
  }

  # Work through each filename-based report in turn, 1 per attachment
  while(($file, $text) = each %{$this->{allreports}}) {
    #print STDERR "Cleaning $file which had a report of $text\n";

    $this->{bodymodified} = 1; # This message body has been changed in memory

    # If it's a TNEF message, then use the entity of the winmail.dat
    # file, else use the entity of the infected file.
    my $tnefentity = $this->{tnefentity};
    #print STDERR "It's a TNEF message\n" if $tnefentity;
    if ($file eq "") {
      #print STDERR "It's a whole body infection, entity = ".$this->{entity}."\n";
      $entity = $this->{entity};
    } else {
      #print STDERR "It's just 1 file, which is $file\n";
      if ($tnefentity) {
        $entity = $tnefentity;
      } else {
        $entity = $this->{file2entity}{"$file"};

        # Skip this report if we are reporting this entity's parent
        $parent = scalar($this->{file2entity}{$this->{file2parent}{$file}});
        next if !$entity && $parent && $EntitiesWeClean{$parent};

        #print STDERR "Cleaning $file which is entity $entity\n";
        # Try to find a matching entity, may involve querying the parent
        if (!$entity) {
          $entity = $parent; #$this->{file2entity}{$this->{file2parent}{$file}};
          #print STDERR "Parent of $file is " . $this->{file2parent}{$file} . "\n";
          #print STDERR "Entity was blank, cleaning $entity\n";
        }
        # Could not find parent, give up and zap whole message
        if (!$entity) {
          $entity = $this->{entity};
          #print STDERR "Could not find entity, doing whole message\n";
        }
      }
    }

    # Avoid cleaning the same entity twice as it will clean the wrong thing!
    next if $AlreadyCleaned{$entity};
    $AlreadyCleaned{$entity} = 1;

    # Work out which message to replace the attachment with.
    # As there may be multiple types for 1 file, find them in
    # in decreasing order of importance.
    my $ModificationOnly = 0; # Is this just an "m" modification?
    my $type = $this->{alltypes}{"$file"};
    #print STDERR "In Clean message, type = $type and quar? = $storeme\n";
    if ($type =~ /v/i) {
      # It's a virus. Either delete or store it.
      if ($storeme) {
        $filename = MailScanner::Config::Value('storedvirusmessage',
                                               $this);
      } else {
        $filename = MailScanner::Config::Value('deletedvirusmessage',
                                               $this);
      }
    } elsif ($type =~ /f/i) {
      # It's a filename trap. Either delete or store it.
      if ($storeme) {
        $filename = MailScanner::Config::Value('storedfilenamemessage',
                                               $this);
      } else {
        $filename = MailScanner::Config::Value('deletedfilenamemessage',
                                               $this);
      }
    } elsif ($type =~ /c/i) {
      # It's dangerous content, either delete or store it.
      if ($storeme) {
        $filename = MailScanner::Config::Value('storedcontentmessage',
                                               $this);
      } else {
        $filename = MailScanner::Config::Value('deletedcontentmessage',
                                               $this);
      }
    } elsif ($type eq 'm') {
      # The only thing wrong here is that the MIME structure has been
      # modified, so the message must be re-built. Nothing needs to
      # be removed from the message.
      $ModificationOnly = 1;
    } else {
      # Treat it like a virus anyway, to be on the safe side.
      if ($storeme) {
        $filename = MailScanner::Config::Value('storedvirusmessage',
                                               $this);
      } else {
        $filename = MailScanner::Config::Value('deletedvirusmessage',
                                               $this);
      }
    }

    # If entity is null then there was a parsing problem with the message,
    # so don't try to walk its tree as it will fail.
    next unless $entity;

    # MIME structure has been modified, so the message must be rebuilt.
    # Nothing needs to be cleaned though.
    next if $ModificationOnly;

    # If it's a silent virus, then only generate the report if anyone
    # wants a copy of it in the quarantine. Or else it won't be quarantined
    # but they will still get a copy of the report.
    #print STDERR "\n\nSilent = " . $this->{silent} . " and Noisy = " . $this->{noisy} . "\n";
    $filename = "" if $this->{silent} && !$this->{noisy} &&
                      !MailScanner::Config::Value('deliversilent', $this); # &&
    #             MailScanner::Config::Value('quarantinesilent', $this) !~ /1/;

    # Do the actual attachment replacement
    #print STDERR "File = \"$file\"\nthis = \"$this\"\n";
    #print STDERR "Entity to clean is $entity\n" .
    #             "root entity is " . $this->{entity} . "\n";
    if ($file eq "") {
      # It's a report on the whole message, so use all the reports
      # This is a virus disinfection on the *whole* message, so the
      # cleaner needs to know not to generate any mime parts.
      #print STDERR "Calling CleanEntity for whole message\n";
      $this->CleanEntity($entity, $everyreport, $filename);
    } else {
      # It's a report on 1 section, so just use the report for that
      #print STDERR "About to call CleanEntity of $filename, $text\n";
      $this->CleanEntity($entity, $text, $filename);
    }
  }

  # Now do the entity reports. These are for things like unparsable tnef
  # files, partial messages, external-body messages, things like that
  # which are always just errors.
  # Work through each report in turn, 1 per attachment
  #print STDERR "Entity reports are " . $this->{entityreports} . "\n";
  while(($entity, $text) = each %{$this->{entityreports}}) {
    #print STDERR "Cleaning $entity which had a report of $text\n";

    # Find rogue entity reports that should point to tnefentity but don't
    $entity = $this->{tnefentity} if $this->{badtnef} && !$entity;
    next unless $entity; # Skip rubbish in the reports

    # Turn the text name of the entity into the object itself
    $entity = $this->{name2entity}{scalar($entity)};

    $this->{bodymodified} = 1; # This message body has been changed in memory

    #print STDERR "In Clean message, quar? = $storeme and entity = $entity\n";
    # It's always an error, so handle it like a virus.
    # Either delete or store it.
    if ($storeme) {
      $filename = MailScanner::Config::Value('storedvirusmessage', $this);
    } else {
      $filename = MailScanner::Config::Value('deletedvirusmessage', $this);
    }

    # Do the actual attachment replacement
    #print STDERR "About to try to clean $entity, $text, $filename\n";
    $this->CleanEntity($entity, $text, $filename);
  }

  # Sign the top of the message body with a text/html warning if they want.
  if (MailScanner::Config::Value('markinfectedmessages',$this) =~ /1/ &&
      !$this->{signed}) {
    #print STDERR "In Clean message, about to sign message " . $this->{id} .
    #             "\n";
    $this->SignWarningMessage($this->{entity});
    $this->{signed} = 1;
  }

  #print STDERR "\n\n\nAfter Clean()\n";
  #$this->PrintInfections();
}


# Do the actual attachment replacing
sub CleanEntity {
  my $this = shift;
  my($entity, $report, $reportname) = @_;

  my(@parts, $Warning, $Disposition, $warningfile, $charset, $i);

  # Find the parent as that's what you have to change
  #print STDERR "CleanEntity: In ".$this->{id}." entity is $entity and " .
  #             "its parent is " . $this->{entity2parent}{$entity} . "\n";
  my $parent = $this->{entity2parent}{$entity};
  $warningfile = MailScanner::Config::Value('attachmentwarningfilename', $this);
  $charset = MailScanner::Config::Value('attachmentcharset', $this);

  #print STDERR "Cleaning entity whose report is $report\n";

  # Infections applying to the entire message cannot be simply disinfected.
  # Have to replace the entire message with a text/plain error.
  unless ($parent) {
    #print STDERR "Doing the whole message\n";
    $Warning = $this->ConstructWarning(
                 MailScanner::Config::LanguageValue($this, 'theentiremessage'),
                 $report, $this->{id}, $reportname);
    #print STDERR "Warning message is $Warning\n";
    #031118 if ($this->{entity} eq $entity) {
    if ($entity->bodyhandle) {
      #print STDERR "Really doing the whole message\n";
      #print STDERR "Really doing Whole message\n";
      # Replacing the whole message as the main body text of the message
      # contained a virus (e.g. the text of EICAR) without any proper
      # MIME structure at all.

      #print STDERR "Entity in CleanEntity is $entity\n";
      #print STDERR "Bodyhandle is " . $entity->bodyhandle . "\n";
      #031118 $entity->bodyhandle or return undef;

      # Output message back into body
      my($io, $filename, $temp);
      $io = $entity->open("w");
      $io->print($Warning . "\n");
      $io->close;
      # Set the MIME type if it was wrong
      $filename = MailScanner::Config::Value('attachmentwarningfilename',
                                             $this);
      $temp = $entity->head->mime_attr('content-type');
      $entity->head->mime_attr('Content-Type', 'text/plain') if
        $temp && $temp ne 'text/plain';
      # Set the charset if there was already a Content-type: header
      $entity->head->mime_attr('Content-type.charset', $charset) if $temp;
      $temp = $entity->head->mime_attr('content-type.name');
      $entity->head->mime_attr('Content-type.name', $filename) if $temp;
      $temp = $entity->head->mime_attr('content-disposition');
      $entity->head->mime_attr('content-disposition', 'inline') if $temp;
      $temp = $entity->head->mime_attr('content-disposition.filename');
      $entity->head->mime_attr('content-disposition.filename', $filename)
        if $temp;
      return;
    } else {
      # If the message is multipart but the boundary is "" then it won't
      # have any parts() which makes it impossible to overwrite without
      # first forcing it to throw away all the structure by becoming
      # single-part.
      $entity->make_singlepart
        if $entity->is_multipart && $entity->head &&
           $entity->head->multipart_boundary eq "";

      $parts[0] = MIME::Entity->build(
                        Type => 'text/plain',
                        Filename => $warningfile,
                        Disposition => 'inline',
                        Data => $Warning,
                        Encoding => 'quoted-printable',
                        Charset => $charset,
                        Top => 0);
      $entity->make_multipart()
        if $entity->head && $entity->head->mime_attr('content-type') eq "";
      $entity->parts(\@parts);
      return;
    }
  }

  # Now know that the infection only applies to one part of the message,
  # so replace that part with an error message.
  @parts = $parent->parts;
  # Find the infected part
  my $tnef = $this->{tnefentity};
  #print STDERR "TNEF entity is " . scalar($tnef) . "\n";
  my $infectednum = -1;
  #print STDERR "CleanEntity: Looking for entity $entity\n";
  for ($i=0; $i<@parts; $i++) {
    #print STDERR "CleanEntity: Comparing " . scalar($parts[$i]) .
    #             " with $entity\n";
    if (scalar($parts[$i]) eq scalar($entity)) {
      #print STDERR "Found it in part $i\n";
      $infectednum = $i;
      last;
    }
    if ($tnef && (scalar($parts[$i]) eq scalar($tnef))) {
      #print STDERR "Found winmail.dat in part $i\n";
      $infectednum = $i;
      last;
    }
  }

  #MailScanner::Log::WarnLog(
  #  "Oh bother, missed infected entity in message %s :-(", $this->{id}), return
  #  if $infectednum<0;

  # Now to actually do something about it...
  #print STDERR "About to constructwarning from $report\n";
  $Warning = $this->ConstructWarning($this->{entity2file}{$entity},
                                     $report, $this->{id}, $reportname);
  #print STDERR "Reportname is \"$reportname\"\n";
  #print STDERR "Warning is \"$Warning\"\n";
  # If the warning is now 0 bytes, don't add it, just remove the virus
  if ($Warning ne "") {
    $Disposition = MailScanner::Config::Value('warningisattachment',$this)
                   ?'attachment':'inline';
    $parts[$infectednum] = build MIME::Entity
                             Type => 'text/plain',
                             Filename => $warningfile,
                             Disposition => $Disposition,
                             Data => $Warning,
                             Encoding => 'quoted-printable',
                             Charset => $charset,
                             Top => 0;
  } else {
    # We are just deleting the part, not replacing it
    # @parts = splice @parts, $infectednum, 1;
    $parts[$infectednum] = undef; # We prune the tree just during delivery
  }
  $parent->parts(\@parts);

  # And make the parent a multipart/mixed if it's a multipart/alternative
  # or multipart/related or message/partial
  $parent->head->mime_attr("Content-type" => "multipart/mixed")
    if ($parent->is_multipart) &&
       ($parent->head->mime_attr("content-type") =~
                                   /multipart\/(alternative|related)/i);
  if ($parent->head->mime_attr("content-type") =~ /message\/partial/i) {
    $parent->head->mime_attr("Content-type" => "multipart/mixed");
  #  $parent->make_singlepart();
  }
}


# Construct a warning message given an attachment filename, a copy of
# what the virus scanner said, the message id and a message filename to parse.
# The id is passed in purely for substituting into the warning message file.
sub ConstructWarning {
  my $this = shift;
  my($attachmententity, $scannersaid, $id, $reportname) = @_;

  # If there is no report file then we create no warning
  return "" unless $reportname;

  my $date = $this->{datestring}; # scalar localtime;
  my $textfh = new FileHandle;
  my $dir = $global::MS->{work}{dir}; # Get the working directory
  my $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  my $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');

  #print STDERR "ConstructWarning for $attachmententity. Scanner said \"" .
  #             "$scannersaid\", message id $id, file = $reportname\n";

  # Reformat the virus scanner report a bit, and optionally remove dirs
  $scannersaid =~ s/^/   /gm;
  if (MailScanner::Config::Value('hideworkdir',$this)) {
    my $pattern = '(' . quotemeta($global::MS->{work}->{dir}) . "|\\\.)/";
    #print STDERR "In replacement, regexp is \"$pattern\"\n";
    $scannersaid =~ s/$pattern//g; #m # Remove the work dir
    $scannersaid =~ s/\/?$id\/?//g; # Remove the message id
  }
  #print STDERR "After replacement, scanner said \"$scannersaid\"\n";

  my $output = "";
  my $result = "";
  # These are all the variables that are allowed to appear
  # in the report template.
  my $filename = ($attachmententity || 
                  MailScanner::Config::LanguageValue($this, 'notnamed'));
  #my $date = scalar localtime; Already defined above
  my $report = $scannersaid;
  my $hostname = MailScanner::Config::Value('hostname',$this);
  my $linkhostname = lc($hostname);
  $linkhostname =~ tr/a-z0-9_-//dc;
  my $quarantinedir = MailScanner::Config::Value('quarantinedir', $this);

  # And let them put the date number in there too
  my($day, $month, $year);
  #($day, $month, $year) = (localtime)[3,4,5];
  #$month++;
  #$year += 1900;
  #my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
  my $datenumber = $this->{datenumber};

#  # Do we want to hide the directory and message id from the report path?
#  if (MailScanner::Config::Value('hideworkdir', $this)) {
#    my $pattern = "(" . quotemeta($global::MS->{work}->{dir}) . "|\.)/$id/";
#    $report =~ s/$pattern//gm;
#  }

  open($textfh, $reportname)
    or MailScanner::Log::WarnLog("Cannot open message file %s, %s",
                                 $reportname, $!);
  my $line;
  while(defined ($line = <$textfh>)) {
    chomp $line;
    #$line =~ s/"/\\"/g; # Escape any " characters
    #$line =~ s/@/\\@/g; # Escape any @ characters
    $line =~ s/([\(\)\[\]\.\?\*\+\^"'@])/\\$1/g; # Escape any regex characters
    # Untainting joy...
    $line =~ $1 if $line =~ /(.*)/;
    $result = eval "\"$line\"";
    $output .= MailScanner::Config::DoPercentVars($result) . "\n";
  }
  $output;
}


# Sign the body of the message with a text or html warning message
# directing users to read the VirusWarning.txt attachment.
# Return 0 if nothing was signed, true if it signed something.
sub SignWarningMessage {
  my $this = shift;
  my $top = shift;

  #print STDERR "Top is $top\n";
  return 0 unless $top;

  # If multipart, try to sign our first part
  if ($top->is_multipart) {
    my $sigcounter = 0;
    #print STDERR "It's a multipart message\n";
    $sigcounter += $this->SignWarningMessage($top->parts(0));
    $sigcounter += $this->SignWarningMessage($top->parts(1))
      if $top->head and $top->effective_type =~ /multipart\/alternative/i;

    if ($sigcounter == 0) {
      # If we haven't signed anything by now, it must be a multipart
      # message containing only things we can't sign. So add a text/plain
      # section on the front and sign that.
      my $text = $this->ReadVirusWarning('inlinetextwarning') . "\n\n";
      my $newpart = build MIME::Entity
                          Type => 'text/plain',
                          Disposition => 'inline',
                          Data => $text,
                          Encoding => 'quoted-printable',
                          Top => 0;
      $top->add_part($newpart, 0);
      $sigcounter = 1;
    }
    return $sigcounter;
  }

  my $MimeType = $top->head->mime_type if $top->head;
  #print STDERR "MimeType is $MimeType\n";
  return 0 unless $MimeType =~ m{text/}i; # Won't sign non-text message.
  # Won't sign attachments.
  return 0 if $top->head->mime_attr('content-disposition') =~ /attachment/i;

  # Get body data as array of newline-terminated lines
  #print STDERR "Bodyhandle is " . $top->bodyhandle . "\n";
  $top->bodyhandle or return undef;
  my @body = $top->bodyhandle->as_lines;

  #print STDERR "Signing message part\n";

  # Output message back into body, followed by original data
  my($line, $io, $warning);
  $io = $top->open("w");
  if ($MimeType =~ /text\/html/i) {
    $warning = $this->ReadVirusWarning('inlinehtmlwarning');
    #$warning = quotemeta $warning; # Must leave HTML tags alone!
    foreach $line (@body) {
      $line =~ s/\<html\>/$&$warning/i;
      $io->print($line);
    }
  } else {
    $warning = $this->ReadVirusWarning('inlinetextwarning');
    $io->print($warning . "\n");
    foreach $line (@body) { $io->print($line) }; # Original body data
  }
  (($body[-1]||'') =~ /\n\Z/) or $io->print("\n"); # Ensure final newline
  $io->close;

  # We signed something
  return 1;
}


# Read the appropriate warning message to sign the top of cleaned messages.
# Passed in the name of the config variable that points to the filename.
# This is also used to read the inline signature added to the bottom of
# clean messages.
# Substitutions allowed in the message are
#     $viruswarningfilename -- by default VirusWarning.txt
#     $from
#     $subject
# and $filename -- comma-separated list of infected attachments
sub ReadVirusWarning {
  my $this = shift;
  my($option) = @_;

  my $file = MailScanner::Config::Value($option, $this);
  my $viruswarningname = MailScanner::Config::Value('attachmentwarningfilename',
                                                    $this);
  my($line);

  #print STDERR "Reading virus warning message from $filename\n";
  my $fh = new FileHandle;
  $fh->open($file)
    or (MailScanner::Log::WarnLog("Could not open inline file %s, %s",
                                  $file, $!),
        return undef);

  # Work out the list of all the infected attachments, including
  # reports applying to the whole message
  my($attach, $text, %infected, $filename, $from, $subject, $id);
  while (($attach, $text) = each %{$this->{allreports}}) {
    # It affects the entire message if the entity of this file matches
    # the entity of the entire message.
    my $entity = $this->{file2entity}{"$attach"};
    #if ($attach eq "") {
    if ($this->{entity} eq $entity) {
      $infected{MailScanner::Config::LanguageValue($this, "theentiremessage")}
        = 1;
    } else {
      $infected{"$attach"} = 1;
    }
  }
  # And don't forget the external bodies which are just entity reports
  while (($attach, $text) = each %{$this->{entityreports}}) {
    $infected{MailScanner::Config::LanguageValue($this, 'notnamed')} = 1;
  }
  $filename = join(', ', keys %infected);
  $id = $this->{id};
  $from = $this->{from};
  $subject = $this->{subject};

  my $result = "";
  while (<$fh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $result .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $fh->close();
  $result;
}


# Sign the bottom of the message with a tag-line saying it is clean
# and MailScanner is wonderful :-)
# Have already checked that message is not infected, and that they want
# clean signatures adding to messages.
sub SignUninfected {
  my $this = shift;

  return if $this->{infected}; # Double-check!

  my($entity, $scannerheader);

  # Use the presence of an X-MailScanner: header to decide if the
  # message will have already been signed by another MailScanner server.
  $scannerheader = MailScanner::Config::Value('mailheader', $this);
  $scannerheader =~ tr/://d;

  #print STDERR "Signing uninfected message " . $this->{id} . "\n";

  # Want to sign the bottom of the highest-level MIME entity
  $entity = $this->{entity};
  if (MailScanner::Config::Value('signalreadyscanned', $this) ||
      !$entity->head->count($scannerheader)) {
    $this->AppendSignCleanEntity($entity);
    #$this->PrependSignCleanEntity($entity)
    #  if MailScanner::Config::Value('signtopaswell', $this);
    $entity->head->add('MIME-Version', '1.0')
      unless $entity->head->get('mime-version');
    $this->{bodymodified} = 1;
  }
}


# Sign the end of a message (which is an entity) with the given tag-line
sub PrependSignCleanEntity {
  my $this = shift;
  my($top) = @_;

  my($MimeType, $signature, @signature);

  return unless $top;

  #print STDERR "In PrependSignCleanEntity, signing $top\n";

  # If multipart, try to sign our first part
  if ($top->is_multipart) {
    my $sigcounter = 0;
    # JKF Signed and encrypted multiparts must not be touched.
    # JKF Instead put the sig in the epilogue. Breaks the RFC
    # JKF but in a harmless way.
    if ($top->effective_type =~ /multipart\/(signed|encrypted)/i) {
      # Read the sig and put it in the epilogue, which may be ignored
      $signature = $this->ReadVirusWarning('inlinetextpresig');
      @signature = map { "$_\n" } split(/\n/, $signature);
      unshift @signature, "\n";
      $top->preamble(\@signature);
      return 1;
    }
    $sigcounter += $this->PrependSignCleanEntity($top->parts(0));
    $sigcounter += $this->PrependSignCleanEntity($top->parts(1))
      if $top->head and $top->effective_type =~ /multipart\/alternative/i;

    if ($sigcounter == 0) {
      # If we haven't signed anything by now, it must be a multipart
      # message containing only things we can't sign. So add a text/plain
      # section on the front and sign that.
      my $text = $this->ReadVirusWarning('inlinetextpresig') . "\n\n";
      my $newpart = build MIME::Entity
                          Type => 'text/plain',
                          Charset =>
                    MailScanner::Config::Value('attachmentcharset', $this),
                          Disposition => 'inline',
                          Data => $text,
                          Encoding => 'quoted-printable',
                          Top => 0;
      $top->add_part($newpart, 0);
      $sigcounter = 1;
    }
    return $sigcounter;
  }

  $MimeType = $top->head->mime_type if $top->head;
  return 0 unless $MimeType =~ m{text/}i; # Won't sign non-text message.
  # Won't sign attachments.
  return 0 if $top->head->mime_attr('content-disposition') =~ /attachment/i;

  # Get body data as array of newline-terminated lines
  $top->bodyhandle or return undef;
  my @body = $top->bodyhandle->as_lines;

  # Output original data back into body, followed by message
  my($line, $io);
  $io = $top->open("w");
  if ($MimeType =~ /text\/html/i) {
    $signature = $this->ReadVirusWarning('inlinehtmlpresig');
    foreach $line (@body) {
      $line =~ s/\<x?html\>/$&$signature/i;
      $io->print($line);
    }
    #(($body[-1]||'') =~ /\n\Z/) or $io->print("\n"); # Ensure final newline
  } else {
    $signature = $this->ReadVirusWarning('inlinetextpresig');
    $io->print("$signature\n");
    foreach $line (@body) { $io->print($line) }; # Original body data
  }
  $io->close;

  # We signed something
  return 1;
}

# Sign the end of a message (which is an entity) with the given tag-line
sub AppendSignCleanEntity {
  my $this = shift;
  my($top) = @_;

  my($MimeType, $signature, @signature);

  return unless $top;

  #print STDERR "In AppendSignCleanEntity, signing $top\n";

  # If multipart, try to sign our first part
  if ($top->is_multipart) {
    my $sigcounter = 0;
    # JKF Signed and encrypted multiparts must not be touched.
    # JKF Instead put the sig in the epilogue. Breaks the RFC
    # JKF but in a harmless way.
    if ($top->effective_type =~ /multipart\/(signed|encrypted)/i) {
      # Read the sig and put it in the epilogue, which may be ignored
      $signature = $this->ReadVirusWarning('inlinetextsig');
      @signature = map { "$_\n" } split(/\n/, $signature);
      unshift @signature, "\n";
      $top->epilogue(\@signature);
      return 1;
    }
    $sigcounter += $this->AppendSignCleanEntity($top->parts(0));
    $sigcounter += $this->AppendSignCleanEntity($top->parts(1))
      if $top->head and $top->effective_type =~ /multipart\/alternative/i;

    if ($sigcounter == 0) {
      # If we haven't signed anything by now, it must be a multipart
      # message containing only things we can't sign. So add a text/plain
      # section on the front and sign that.
      my $text = $this->ReadVirusWarning('inlinetextsig') . "\n\n";
      my $newpart = build MIME::Entity
                          Type => 'text/plain',
                          Charset =>
                    MailScanner::Config::Value('attachmentcharset', $this),
                          Disposition => 'inline',
                          Data => $text,
                          Encoding => 'quoted-printable',
                          Top => 0;
      $top->add_part($newpart, 0);
      $sigcounter = 1;
    }
    return $sigcounter;
  }

  $MimeType = $top->head->mime_type if $top->head;
  return 0 unless $MimeType =~ m{text/(html|plain)}i; # Won't sign non-text message.
  # Won't sign attachments.
  return 0 if $top->head->mime_attr('content-disposition') =~ /attachment/i;

  # Get body data as array of newline-terminated lines
  $top->bodyhandle or return undef;
  my @body = $top->bodyhandle->as_lines;

  # Output original data back into body, followed by message
  my($line, $io, $FoundHTMLEnd);
  $FoundHTMLEnd = 0; # If there is no </html> tag, still append the signature
  $io = $top->open("w");
  if ($MimeType =~ /text\/html/i) {
    $signature = $this->ReadVirusWarning('inlinehtmlsig');
    foreach $line (@body) {
      $FoundHTMLEnd = 1 if $line =~ s/\<\/x?html\>/$signature$&/i;
      $io->print($line);
    }
    $io->print($signature . "\n") unless $FoundHTMLEnd;
    (($body[-1]||'') =~ /\n\Z/) or $io->print("\n"); # Ensure final newline
  } else {
    foreach $line (@body) { $io->print($line) }; # Original body data
    $signature = $this->ReadVirusWarning('inlinetextsig');
    $io->print("\n$signature\n");
  }
  $io->close;

  # We signed something
  return 1;
}


# Deliver an uninfected message. It is already signed as necessary.
# If the body has been modified then we need to reconstruct it from
# the MIME structure. If not modified, then just link it across to
# the outgoing queue.
sub DeliverUninfected {
  my $this = shift;

  if ($this->{bodymodified}) {
    # The body of this message has been modified, so reconstruct
    # it from the MIME structure and deliver that.
    #print STDERR "Body modified\n";
    $this->DeliverModifiedBody('cleanheader');
  } else {
    #print STDERR "Body not modified\n";
    if (MailScanner::Config::Value('virusscan', $this) =~ /1/) {
      #print STDERR "Message is scanned and clean\n";
      $this->DeliverUnmodifiedBody('cleanheader');
    } else {
      #print STDERR "Message is unscanned\n";
      $this->DeliverUnmodifiedBody('unscannedheader');
    }
  }
}


# Deliver a message which has not had its body modified in any way.
# This is a lot faster as it doesn't involve reconstructing the message
# body at all, it is just copied from the inqueue to the outqueue.
sub DeliverUnmodifiedBody {
  my $this = shift;
  my($headervalue) = @_;

  return if $this->{deleted}; # This should never happen

  # Prune the entity tree to remove all undef values
  PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});

  #print STDERR "Delivering Unmodified Body message\n";

  my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
  my $store = $this->{store};

  # Link the queue data file from in to out
  $store->LinkData($OutQ);

  # Set up the output envelope with its (possibly modified) headers
  # Used to do next line but it breaks text-only messages with no MIME
  # structure as the MIME explosion will have created a MIME structure.
  #$global::MS->{mta}->AddHeadersToQf($this, $this->{entity}->stringify_header);
  $global::MS->{mta}->AddHeadersToQf($this);

  # Remove duplicate subject: lines
  $global::MS->{mta}->UniqHeader($this, 'Subject:');

  # Add the information/help X- header
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
  if ($infoheader) {
    my $infovalue = MailScanner::Config::Value('infovalue', $this);
    $global::MS->{mta}->ReplaceHeader($this, $infoheader, $infovalue);
  }

  $global::MS->{mta}->AddMultipleHeader($this, 'mailheader',
               MailScanner::Config::Value($headervalue, $this), ', ');
  # Delete all content length headers anyway. They are unsafe.
  # No, leave them if nothing in the body has been modified.
  #$global::MS->{mta}->DeleteHeader($this, 'Content-length:');

  # Add the MCP header if necessary
  $global::MS->{mta}->AddMultipleHeader($this, 'mcpheader',
                                        $this->{mcpreport}, ', ')
    if $this->{ismcp} ||
       MailScanner::Config::Value('includemcpheader', $this);

  # Add the spam header if they want that
  #$global::MS->{mta}->AddHeader($this,
  #                              MailScanner::Config::Value('spamheader',$this),
  #                              $this->{spamreport})
  # JKF 3/10/2005
  $global::MS->{mta}->AddMultipleHeader($this, 'spamheader',
                                        $this->{spamreport}, ', ')
    if MailScanner::Config::Value('includespamheader', $this) ||
       ($this->{spamreport} && $this->{isspam});

  # Add the spam stars if they want that. Limit it to 60 characters to avoid
  # a potential denial-of-service attack.
  my($stars,$starcount,$scoretext,$minstars,$scorefmt);
  $starcount = int($this->{sascore}) + 0;
  $starcount = 0 if $this->{spamwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{sascore}+0);
  $minstars = MailScanner::Config::Value('minstars', $this);
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
                            $starcount<$minstars;
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
    $stars = $scoretext; # int($starcount);
  } else {
    $starcount = 60 if $starcount>60;
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
  }
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
                                          $stars, ', ');
  }

  # Add the Envelope to and from headers
  AddFromAndTo($this);

  # Repair the subject line
  $global::MS->{mta}->ReplaceHeader($this, 'Subject:', $this->{safesubject})
    if $this->{subjectwasunsafe};

  # Modify the subject line for Disarming
  my $subjectchanged = 0;
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
  my $phishingtag = MailScanner::Config::Value('phishingsubjecttag', $this);
  if ($this->{messagedisarmed}) {
    #print STDERR "Found messagedisarmed = " . join(',',@{$this->{disarmedtags}}) . "\n";
    if(MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
       !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
     $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
     $subjectchanged = 1;
    }
    if (grep /phishing/i, @{$this->{disarmedtags}}) {
      #print STDERR "Found a phishing disarmedtags\n";
      # We found it had a phishing link in it. Are we tagging phishing Subject?
      if (MailScanner::Config::Value('tagphishingsubject',$this) =~ /1/ &&
          !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $phishingtag)
) {
        $global::MS->{mta}->PrependHeader($this, 'Subject:', $phishingtag, ' ');
        $subjectchanged = 1;
      }
    }
  }

  # Modify the subject line for spam
  # if it's spam AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && !$this->{ishigh} &&
      MailScanner::Config::Value('spamprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
    $subjectchanged = 1;
  }
  # If it is high-scoring spam, then add a different bit of text
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && $this->{ishigh} &&
      MailScanner::Config::Value('highspamprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
    $subjectchanged = 1;
  }

  # Modify the subject line for MCP
  # if it's MCP AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  $starcount = int($this->{mcpsascore}) + 0;
  $starcount = 0 if $this->{mcpwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{mcpsascore}+0);
  my $mcptag = MailScanner::Config::Value('mcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  if ($this->{ismcp} && !$this->{ishighmcp} &&
      MailScanner::Config::Value('mcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
    $subjectchanged = 1;
  }
  # If it is high-scoring MCP, then add a different bit of text
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  if ($this->{ismcp} && $this->{ishighmcp} &&
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
    $subjectchanged = 1;
  }

  # Modify the subject line for scanning -- but only do it if the
  # subject hasn't already been modified by MailScanner for another reason.
  my $modifscan = MailScanner::Config::Value('scannedmodifysubject', $this);
  my $scantag   = MailScanner::Config::Value('scannedsubjecttext', $this);
  if ($modifscan eq 'start' && !$subjectchanged &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $scantag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $scantag, ' ');
    $subjectchanged = 1;
  } elsif ($modifscan eq 'end' && !$subjectchanged &&
      !$global::MS->{mta}->TextEndsHeader($this, 'Subject:', $scantag)) {
    $global::MS->{mta}->AppendHeader($this, 'Subject:', $scantag, ' ');
    $subjectchanged = 1;
  }

  # Remove any headers we don't want in the message
  my(@removeme, $remove);
  @removeme = split(/[,\s]+/, MailScanner::Config::Value('removeheaders', $this));
  foreach $remove (@removeme) {
    # Add a : if there isn't one already, it's needed for DeleteHeader()
    $remove .= ':' unless $remove =~ /:$/;
    $global::MS->{mta}->DeleteHeader($this, $remove);
  }

  # Add the extra headers they want for MCP and spam messages
  my(@extraheaders, $extraheader);
  my($key, $value);
  @extraheaders = @{$this->{extramcpheaders}} if $this->{extramcpheaders};
  push @extraheaders, @{$this->{extraspamheaders}} if $this->{extraspamheaders};
  foreach $extraheader (@extraheaders) {
    #print STDERR "Unmod Adding extra header $extraheader\n";
    next unless $extraheader =~ /:/;
    ($key, $value) = split(/:\s*/, $extraheader, 2);
    $global::MS->{mta}->AddMultipleHeaderName($this, $key . ':', $value, ', ');
  }

  # Add the secret archive recipients
  my($extra, @extras);
  foreach $extra (@{$this->{archiveplaces}}) {
    next if $extra =~ /^\//;
    next unless $extra =~ /@/;
    push @extras, $extra;
  }
  $global::MS->{mta}->AddRecipients($this, @extras) if @extras;

  # Write the new qf file, delete originals and unlock the message
  $store->WriteHeader($this, $OutQ);
  unless ($this->{gonefromdisk}) {
    $store->DeleteUnlock();
    $this->{gonefromdisk} = 1;
  }

  # Note this does not kick the MTA into life here any more
}


# Deliver a message which has had its body modified.
# This is slower as the message has to be reconstructed from all its
# MIME entities.
sub DeliverModifiedBody {
  my $this = shift;
  my($headervalue) = @_;

  return if $this->{deleted}; # This should never happen

  #print STDERR "Delivering Modified Body message with header \"$headervalue\"\n";

  my $store = $this->{store};

  # If there is no data structure at all for this message, then we
  # can't sensibly deliver anything, so just delete it.
  # The parsing must have failed completely.
  my $entity = $this->{entity};
  unless ($entity) {
    #print STDERR "Deleting duff message\n";
    unless ($this->{gonefromdisk}) {
      $store->DeleteUnlock();
      $this->{gonefromdisk} = 1;
    }
    return;
  }

  # Prune the entity tree to remove all undef values
  #PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});
  PruneEntityTree($entity,$this->{entity2file},$this->{file2entity});

  my $OutQ = MailScanner::Config::Value('outqueuedir', $this);

  # Write the new body file
  #print STDERR "Writing the MIME body of $this, " . $this->{id} . "\n";
  $store->WriteMIMEBody($this->{id}, $entity, $OutQ);
  #print STDERR "Written the MIME body\n";

  # Set up the output envelope with its (possibly modified) headers
  $global::MS->{mta}->AddHeadersToQf($this, $this->{entity}->stringify_header);

  # Remove duplicate subject: lines
  $global::MS->{mta}->UniqHeader($this, 'Subject:');

  # Add the information/help X- header
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
  if ($infoheader) {
    my $infovalue = MailScanner::Config::Value('infovalue', $this);
    $global::MS->{mta}->ReplaceHeader($this, $infoheader, $infovalue);
  }

  # Add the clean/dirty header
  #print STDERR "Adding clean/dirty header $headervalue\n";
  $global::MS->{mta}->AddMultipleHeader($this, 'mailheader',
	       MailScanner::Config::Value($headervalue, $this), ', ');

  # Delete all content length headers as the body has been modified.
  $global::MS->{mta}->DeleteHeader($this, 'Content-length:');

  # Add the MCP header if necessary
  $global::MS->{mta}->AddMultipleHeader($this, 'mcpheader',
					$this->{mcpreport}, ', ')
    if $this->{ismcp} ||
       MailScanner::Config::Value('includemcpheader', $this);

  # Add the spam header if they want that
  #$global::MS->{mta}->AddHeader($this,
  #                              MailScanner::Config::Value('spamheader',$this),
  #                              $this->{spamreport})
  # JKF 3/10/2005
  $global::MS->{mta}->AddMultipleHeader($this, 'spamheader',
					$this->{spamreport}, ', ')
    if MailScanner::Config::Value('includespamheader', $this) ||
       ($this->{spamreport} && $this->{isspam});

  # Add the spam stars if they want that. Limit it to 60 characters to avoid
  # a potential denial-of-service attack.
  my($stars,$starcount,$scoretext,$minstars,$scorefmt);
  $starcount = int($this->{sascore}) + 0;
  $starcount = 0 if $this->{spamwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{sascore}+0);
  $minstars = MailScanner::Config::Value('minstars', $this);
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
			    $starcount<$minstars;
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
    $stars = $scoretext; # int($starcount);
  } else {
    $starcount = 60 if $starcount>60;
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
  }
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
					  $stars, ', ');
  }

  # Add the Envelope to and from headers
  AddFromAndTo($this);

  # Repair the subject line
  #print STDERR "Metadata is " . join("\n", @{$this->{metadata}}) . "\n";
  $global::MS->{mta}->ReplaceHeader($this, 'Subject:', $this->{safesubject})
    if $this->{subjectwasunsafe};

  my $subjectchanged = 0;

  # Modify the subject line for viruses or filename traps.
  # Only use the filename trap test if it isn't infected by anything else.
  my $nametag = MailScanner::Config::Value('namesubjecttext', $this);
  my $contenttag = MailScanner::Config::Value('contentsubjecttext', $this);
  #print STDERR "I have triggered a filename trap\n" if $this->{nameinfected};
  if ($this->{nameinfected} &&   # Triggered a filename trap
      !$this->{virusinfected} && # No other reports about it
      !$this->{otherinfected} && # They want the tagging & not already tagged
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $nametag)) {
    if (MailScanner::Config::Value('nameprependsubject',$this)) {
      $global::MS->{mta}->PrependHeader($this, 'Subject:', $nametag, ' ');
      $subjectchanged = 1;
    }
  } elsif ($this->{otherinfected} &&   # Triggered a content trap
      !$this->{virusinfected} && # No other reports about it
      !$this->{nameinfected} && # They want the tagging & not already tagged
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $contenttag)) {
    if (MailScanner::Config::Value('contentprependsubject',$this)) {
      $global::MS->{mta}->PrependHeader($this, 'Subject:', $contenttag, ' ');
      $subjectchanged = 1;
    }
  } else {
    # It may be really virus infected.
    # Modify the subject line for viruses
    # if it's infected AND they want to modify the subject line AND it's not
    # already been modified by another of your MailScanners.
    my $virustag = MailScanner::Config::Value('virussubjecttext', $this);
    #print STDERR "I am infected\n" if $this->{infected};
    if ($this->{infected} &&
	MailScanner::Config::Value('virusprependsubject',$this) &&
	!$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $virustag)) {
      $global::MS->{mta}->PrependHeader($this, 'Subject:', $virustag, ' ');
      $subjectchanged = 1;
    }
  }

  # Modify the subject line for Disarming
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
  my $phishingtag = MailScanner::Config::Value('phishingsubjecttag', $this);
  if ($this->{messagedisarmed}) { 
    #print STDERR "Found messagedisarmed = " . join(',',@{$this->{disarmedtags}}) . "\n";
    if(MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
       !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
     $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
     $subjectchanged = 1;
    }
    if (grep /phishing/i, @{$this->{disarmedtags}}) {
      #print STDERR "Found phishing disarmedtags2\n";
      # We found it had a phishing link in it. Are we tagging phishing Subject?
      if (MailScanner::Config::Value('tagphishingsubject',$this) =~ /1/ &&
          !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $phishingtag)) {
        $global::MS->{mta}->PrependHeader($this, 'Subject:', $phishingtag, ' ');
        $subjectchanged = 1;
      }
    }
  }


  # Modify the subject line for spam
  # if it's spam AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && !$this->{ishigh} &&
	      MailScanner::Config::Value('spamprependsubject',$this) &&
	      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
    $subjectchanged = 1;
  }
  # If it is high-scoring spam, then add a different bit of text
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
  $spamtag =~ s/_SCORE_/$scoretext/;
  $spamtag =~ s/_STARS_/$stars/i;
  if ($this->{isspam} && $this->{ishigh} &&
      MailScanner::Config::Value('highspamprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
    $subjectchanged = 1;
  }

  # Modify the subject line for MCP
  # if it's MCP AND they want to modify the subject line AND it's not
  # already been modified by another of your MailScanners.
  $starcount = int($this->{mcpsascore}) + 0;
  $starcount = 0 if $this->{mcpwhitelisted}; # 0 stars if white-listed
  $scorefmt = MailScanner::Config::Value('scoreformat', $this);
  $scorefmt = '%d' if $scorefmt eq '';
  $scoretext = sprintf($scorefmt, $this->{mcpsascore}+0);
  my $mcptag = MailScanner::Config::Value('mcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  if ($this->{ismcp} && !$this->{ishighmcp} &&
      MailScanner::Config::Value('mcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
    $subjectchanged = 1;
  }
  # If it is high-scoring MCP, then add a different bit of text
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
  $mcptag =~ s/_SCORE_/$scoretext/;
  if ($this->{ismcp} && $this->{ishighmcp} &&
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
    $subjectchanged = 1;
  }

  # Modify the subject line for scanning -- but only do it if the
  # subject hasn't already been modified by MailScanner for another reason.
  my $modifscan = MailScanner::Config::Value('scannedmodifysubject', $this);
  my $scantag   = MailScanner::Config::Value('scannedsubjecttext', $this);
  if ($modifscan eq 'start' && !$subjectchanged &&
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $scantag)) {
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $scantag, ' ');
  } elsif ($modifscan eq 'end' && !$subjectchanged &&
      !$global::MS->{mta}->TextEndsHeader($this, 'Subject:', $scantag)) {
    $global::MS->{mta}->AppendHeader($this, 'Subject:', $scantag, ' ');
  }

  # Remove any headers we don't want in the message
  my(@removeme, $remove);
  @removeme = split(/[,\s]+/, MailScanner::Config::Value('removeheaders', $this));
  foreach $remove (@removeme) {
    # Add a : if there isn't one already, it's needed for DeleteHeader()
    $remove .= ':' unless $remove =~ /:$/;
    $global::MS->{mta}->DeleteHeader($this, $remove);
  }

  # Add the extra headers they want for MCP and spam messages
  my(@extraheaders, $extraheader);
  my($key, $value);
  @extraheaders = @{$this->{extramcpheaders}} if $this->{extramcpheaders};
  push @extraheaders, @{$this->{extraspamheaders}} if $this->{extraspamheaders};
  foreach $extraheader (@extraheaders) {
    #print STDERR "Mod Adding extra header $extraheader\n";
    next unless $extraheader =~ /:/;
    ($key, $value) = split(/:\s*/, $extraheader, 2);
    $global::MS->{mta}->AddMultipleHeaderName($this, $key . ':', $value, ', ');
  }

  # Add the secret archive recipients
  my($extra, @extras);
  foreach $extra (@{$this->{archiveplaces}}) {
    next if $extra =~ /^\//;
    next unless $extra =~ /@/;
    push @extras, $extra;
  }
  $global::MS->{mta}->AddRecipients($this, @extras) if @extras;

  # Write the new qf file, delete originals and unlock the message
  #print STDERR "Writing the new qf file\n";
  $store->WriteHeader($this, $OutQ);
  unless ($this->{gonefromdisk}) {
    $store->DeleteUnlock();
    $this->{gonefromdisk} = 1;
  }

  # Note this does not kick the MTA into life here any more
}


# Prune all the undef branches out of an entity tree
sub PruneEntityTree {
  my ($entity,$entity2file,$file2entity) = @_;

  #print STDERR "Pruning $entity\n";
  return undef unless $entity;
  return $entity unless $entity->parts;

  my(@newparts, $part, $newpart, $counter);

  # Do a pre-traversal depth-first search of the tree
  #print STDERR "Looking at $entity\n";
  foreach $part ($entity->parts) {
    #$counter++;
    #print STDERR "$counter Going down to $part\n";
    next unless $part;
    #print STDERR "Non null $part\n";
    $newpart = PruneEntityTree($part,$entity2file,$file2entity);
    #$newpart = $newpart?PruneEntityTree($part,$entity2file,$file2entity):$part;
    #print STDERR "Replacement is $newpart\n";
    if ($newpart) {
      #print STDERR "Adding replacement $newpart\n";
      push @newparts, $newpart;
      #print STDERR "Newparts = " . join(',',@newparts) . "\n";
    #} else {
    #  my $file = $entity2file->{$newpart} if $entity2file;
    #  delete $entity2file->{$newpart} if $entity2file && $file;
    #  delete $file2entity->{$file} if $file2entity && $file;
    }
    #print STDERR "Coming up, added $newpart\n";
  }

  #print STDERR "About to return\n";
  # Keep all the parts we found, prune as much as we can
  if (@newparts) {
    #print STDERR "Returning entity $entity with " . join(',',@newparts) . "\n";
    $entity->parts(\@newparts);
    return $entity;
  } else {
    #print STDERR "Returning undef\n";
    return undef;
  }
}


# Delete a message from the incoming queue
sub DeleteMessage {
  my $this = shift;

  #print STDERR "DeletingMessage " . $this->{id} . "\n";

  unless ($this->{gonefromdisk}) {
    $this->{store}->DeleteUnlock();
    $this->{gonefromdisk} = 1;
  }
  $this->{deleted} = 1;
}


## Is this message from a local domain?
#sub IsFromLocalDomain {
#  my $this = shift;
#
#  #print STDERR "Deleting cleaned message " . $this->{id} . "\n";
#  $this->{store}->Delete();
#  $this->{store}->Unlock();
#  $this->{deleted} = 1;
#}


# Work out if the message is infected with a "silent" virus such as Klez.
# Set the "silent" flag on all such messages.
# At the same time, find the "noisy" non-spoofing infections such as
# document macro viruses.
sub FindSilentAndNoisyInfections {
  my $this = shift;

  my(@silentin) = split(" ",MailScanner::Config::Value('silentviruses', $this));
  my($silent, $silentin, @silent, $regexp, $allreports, $logstring, $allsilent);
  my($virusreports);

  my(@noisyin) = split(" ",MailScanner::Config::Value('noisyviruses', $this));
  my($noisy, $noisyin, @noisy, $nregexp);

  #print "-1 Silentin = \"" . join(',',@silentin) . "\"\n";
  #print "-1 Noisy in = \"" . join(',',@noisyin) . "\"\n";

  # Get out quickly if there's nothing to do
  return unless @silentin || @noisyin;

  # Turn each silent and noisy report into a regexp
  $allsilent = 0;
  foreach $silent (@silentin) {
    if (lc($silent) eq 'all-viruses') {
      $allsilent = 1;
      next;
    }
    $silentin = quotemeta $silent;
    push @silent, $silentin;
  }
  foreach $noisy (@noisyin) {
    next if lc($noisy) eq 'all-viruses';
    $noisyin = quotemeta $noisy;
    push @noisy, $noisyin;
  }
  # Make 2 big regexps from them all
  $regexp = "";
  $nregexp = "";
  $regexp = '(' . join(')|(', @silent) . ')' if @silent;
  $nregexp = '(' . join(')|(', @noisy) . ')' if @noisy;

  # Make 1 big string from all the reports
  $allreports = join('', values %{$this->{allreports}});
  $virusreports = join(' ', values %{$this->{virusreports}});

  #print STDERR "FindSilentInfection: Looking for \"$regexp\" in \"" .
  #             $allreports . "\"\n";
  #print STDERR "FindNoisyInfection: Looking for \"$nregexp\" in \"" .
  #             $allreports . "\"\n";

  #$this->{silent} = 1 if @silentin && $allreports =~ /$regexp/i;
  #$this->{noisy}  = 1 if @noisyin  && $allreports =~ /$nregexp/i;

  # Do this with grep so I can extract the matching line.
  $this->{silent} = 1 if $regexp && grep {$logstring .= "$_ " if /$regexp/i;}
                                         values %{$this->{allreports}};
  if ($allsilent && $virusreports) {
    $this->{silent} = 1;
    $logstring .= $virusreports;
  }
  $this->{noisy}  = 1 if $nregexp && grep /$nregexp/i,
                                          values %{$this->{allreports}};
  #print STDERR "0 regexp = $nregexp and search = \"" . join('","',values %{$this->{allreports}}) . "\"\n";

  #print STDERR "1 FindSilentInfection: Found it!\n" if $this->{silent};
  #print STDERR "1 FindNoisyInfection: Found it!\n" if $this->{noisy};

  return unless MailScanner::Config::Value('logsilentviruses', $this);

  $logstring = join(',', values %{$this->{allreports}})
    if !$logstring && $allsilent && $this->{silent} == 1;
  $logstring =~ s/[\n,]+(.)/,$1/g;
  MailScanner::Log::InfoLog("Viruses marked as silent: %s", $logstring)
    if $logstring;

  #print STDERR "2 FindSilentInfection: Found it!\n" if $this->{silent};
  #print STDERR "2 FindNoisyInfection: Found it!\n" if $this->{noisy};
}


# Deliver a cleaned message and remove it from the incoming queue
sub DeliverCleaned {
  my $this = shift;

  # The body of this message has been modified, so reconstruct
  # it from the MIME structure and deliver that.
  #print STDERR "Delivering cleaned up message " . $this->{id} . "\n";
  $this->DeliverModifiedBody('dirtyheader');
}


# Send a warning message to the person who sent this message.
# Need to create variables for from, to, subject, date and report
# for use within the message.
sub WarnSender {
  my $this = shift;

  my($from,$to,$subject,$date,$allreports,$alltypes,$report,$type);
  my($entityreports, @everyreportin, $entitytypes, @everytype);
  my($emailmsg, $line, $messagefh, $msgname, $localpostmaster, $id);
  my($hostname, $postmastername);

  # Do we want to send the sender a warning at all?
  # If nosenderprecedence is set to non-blank and contains this
  # message precedence header, then just return.
  my(@preclist, $prec, $precedence, $header);
  @preclist = split(" ",
                  lc(MailScanner::Config::Value('nosenderprecedence', $this)));
  $precedence = "";
  foreach $header (@{$this->{headers}}) {
    $precedence = lc($1) if $header =~ /^precedence:\s+(\S+)/i;
  }
  if (@preclist && $precedence ne "") {
    foreach $prec (@preclist) {
      if ($precedence eq $prec) {
        MailScanner::Log::InfoLog("Skipping sender of precedence %s",
                                  $precedence);
        return;
      }
    }
  }

  # Now we know we want to send the message, it's not a bulk mail
  $from = $this->{from};

  # Don't ever send a message to "" or "<>"
  return if $from eq "" || $from eq "<>";

  # Setup other variables they can use in the message template
  $id = $this->{id};
  #$to = join(', ', @{$this->{to}});
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
  $hostname = MailScanner::Config::Value('hostname', $this);
  $subject = $this->{subject};
  $date = $this->{datestring}; # scalar localtime;

  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  $allreports    = $this->{allreports};
  $entityreports = $this->{entityreports};
  push @everyreportin, values %$allreports;
  push @everyreportin, values %$entityreports;
  my $reportword = MailScanner::Config::LanguageValue($this, "report");
  my($reportline, @everyreport);
  foreach $reportline (@everyreportin) {
    push @everyreport, map { ((/^$reportword: /m)?$_:"$reportword: $_") . "\n" }
                           split(/\n/, $reportline);
  }
  #print STDERR "Reports are \"" . join('", "', @everyreport) . "\"\n";
  #$report = join('', @everyreport);
  my %seen = ();
  $report = join('', grep { ! $seen{$_} ++ } @everyreport);
  #print STDERR "***Report to sender is***\n$report***END***\n";
  
  $alltypes    = $this->{alltypes};
  $entitytypes = $this->{entitytypes};
  push @everytype, values %$alltypes;
  push @everytype, values %$entitytypes;
  $type  = join('', @everytype);

  # Do we want to hide the directory and message id from the report path?
  if (MailScanner::Config::Value('hideworkdir', $this)) {
    my $pattern = "(" . quotemeta($global::MS->{work}->{dir}) . "|\\\.)/";
    $report =~ s/$pattern//g; # m # Remove the work dir
    $report =~ s/\/?$id\/?//g; # Remove the message id
  }

  # Set the report filename dependent on what triggered MailScanner, be it
  # a virus, a filename trap, a Denial Of Service attack, or an parsing error.
  if ($type =~ /v/i) {
    $msgname = MailScanner::Config::Value('sendervirusreport', $this);
  } elsif ($type =~ /f/i) {
    $msgname = MailScanner::Config::Value('senderfilenamereport', $this);
  } elsif ($type =~ /e/i) {
    $msgname = MailScanner::Config::Value('sendererrorreport', $this);
  } elsif ($type =~ /c/i) {
    $msgname = MailScanner::Config::Value('sendercontentreport', $this);
  } else {
    $msgname = MailScanner::Config::Value('sendervirusreport', $this);
  }

  # Work out the list of all the infected attachments, including
  # reports applying to the whole message
  my($attach, $text, %infected, $filename);
  while (($attach, $text) = each %$allreports) {
    if ($attach eq "") {
      $infected{MailScanner::Config::LanguageValue($this, "theentiremessage")}
        = 1;
    } else {
      $infected{"$attach"} = 1;
    }
  }
  # And don't forget the external bodies which are just entity reports
  while (($attach, $text) = each %$entityreports) {
    $infected{MailScanner::Config::LanguageValue($this, 'notnamed')} = 1;
  }
  $filename = join(', ', keys %infected);

  $messagefh = new FileHandle;
  $messagefh->open($msgname)
    or MailScanner::Log::WarnLog("Cannot open message file %s, %s",
                                 $msgname, $!);
  $emailmsg = "";
  while(<$messagefh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $emailmsg .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $messagefh->close();

  # This did say $localpostmaster in the last parameter, but I changed
  # it to '<>' so that the sender warnings couldn't bounce.
  $global::MS->{mta}->SendMessageString($this, $emailmsg, '<>')
    or MailScanner::Log::WarnLog("Could not send sender warning, %s", $!);
}


# Create the headers for a postmaster notification message.
# This is expensive so don't do it much!
sub CreatePostmasterHeaders {
  my $this = shift;
  my($to)  = @_;

  my($result, $charset);

  # Make sure the Postmaster notice is in the right character set
  $charset = MailScanner::Config::Value('attachmentcharset',$this);

  $result = "From: \"" .
            MailScanner::Config::Value('noticesfrom', $this) . "\" <" .
            MailScanner::Config::Value('localpostmaster',$this) . ">\nTo: ";
  #$to = MailScanner::Config::Value('noticerecipient',$this);
  #$to =~ s/ +/, /g;
  $result .= $to . "\nSubject: " .
             MailScanner::Config::LanguageValue($this, 'noticesubject') . "\n";
  $result .= "Content-type: text/plain; charset=$charset\n" if $charset;

  return $result;
}


# Create the notification text for 1 email message.
sub CreatePostmasterNotice {
  my $this = shift;

  my(@everyrept);
  push @everyrept, values %{$this->{allreports}};
  push @everyrept, values %{$this->{entityreports}};

  foreach (@everyrept) {
      chomp;
      s/\n/\n            /g;
      $_ .= "\n";
  }

  my $reportword = MailScanner::Config::LanguageValue($this, "report");
  my $id   = $this->{id};
  my $from = $this->{from};
  #my $to   = join(', ', @{$this->{to}});
  my $subj = $this->{subject};
  my $ip   = $this->{clientip};
  my $rept = join("    $reportword: ", @everyrept);
  #print STDERR "Rept is\n$rept\n";

  # Build list of unique archive and quarantine storage locations
  my @quarantines = grep /\//, @{$this->{archiveplaces}};
  push @quarantines, grep /\//, @{$this->{quarantineplaces}};
  my($quarantine, %quarantinelist);
  foreach $quarantine (@quarantines) {
    $quarantinelist{$quarantine} = 1;
  }
  $quarantine = join(', ', sort keys %quarantinelist);

  # Build unique list of recipients. Avoids Postfix problem which has
  # separate lists of real recipients and original recipients.
  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  my($result, $headers);

  if (MailScanner::Config::Value('hideworkdirinnotice',$this)) {
    my $pattern = '(' . quotemeta($global::MS->{work}->{dir}) . "|\\\.)/";
    #print STDERR "In replacement, regexp is \"$pattern\"\n";
    $rept =~ s/$pattern//g; #m # Remove the work dir
    $rept =~ s/\/?$id\/?//g; # Remove the message id
  }

  my $reportspaces = 10 - length($reportword);
  $reportword = ' ' x $reportspaces . $reportword if $reportspaces>0;
  $result = "\n" .
            "    Sender: $from\n" .
            "IP Address: $ip\n" .
            " Recipient: $to\n" .
            "   Subject: $subj\n" .
            " MessageID: $id\n" .
            "Quarantine: $quarantine\n" .
            "$reportword: $rept\n";

  if (MailScanner::Config::Value('noticefullheaders', $this)) {
    $headers = join("\n ", $global::MS->{mta}->OriginalMsgHeaders($this));
    $result .= MailScanner::Config::LanguageValue($this, 'fullheadersare') .
               ":\n\n $headers\n\n";
  }

  $result;
}


# Find the attachments that have been disinfected and deliver them all
# in a new MIME message.
sub DeliverDisinfectedAttachments {
  my $this = shift;

  my(@list, $reports, $attachment);

  $reports = $this->{oldviruses};

  # Loop through every attachment in the original list
  foreach $attachment (keys %$reports) {
    #print STDERR "Looking to see if \"$attachment\" has been disinfected\n";
    # Never attempt "whole body" disinfections
    next if $attachment eq "";
    # Skip messages that are in the new report list
    next if defined $this->{virusreports}{"$attachment"};
    # Don't disinfect files the disinfector renamed
    if (!$global::MS->{work}->FileExists($this, $attachment)) {
      #print STDERR "Skipping deleted/renamed attachment $attachment\n";
      next;
    }
    # Add it to the list
    #print STDERR "Adding $attachment to list of disinfected files\n";
    push @list, $attachment;
  }

  # Is there nothing to do?
  return unless @list;

  #print STDERR "Have disinfected attachments " . join(',',@list) . "\n";
  # Deliver a message to the original recipients containing the
  # disinfected attachments. This is really a Sendmail-specific thing.
  $global::MS->{work}->ChangeToMessage($this);
  $this->DeliverFiles(@list);
}


# Create and deliver a new message from MailScanner about the
# disinfected files passed in @list.
sub DeliverFiles {
  my $this = shift;
  my(@files) = @_;

  my($MaxSubjectLength, $from, $to, $subject, $newsubject, $top);
  my($localpostmaster, $postmastername);
  $MaxSubjectLength  = 25;
  $from = $this->{from};
  #$to   = join(', ', @{$this->{to}});
  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  $subject = $this->{subject};
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');

  $newsubject = MailScanner::Config::LanguageValue($this, 'disinfected') .
                ": " . substr($subject, 0, $MaxSubjectLength);
  $newsubject .= '...' if length($subject)>$MaxSubjectLength;

  #print STDERR "About to deliver " . join(',',@files) . " to original " .
  #             "recipients after disinfection\n";

  # Create the top-level MIME entity, just the headers
  $top = MIME::Entity->build(Type       => 'multipart/mixed',
                             From       => "$postmastername <$localpostmaster>",
                             To         => $to,
                             Subject    => $newsubject,
                             'X-Mailer' => 'MailScanner',
                       MailScanner::Config::Value('mailheader', $this) =>
                       MailScanner::Config::Value('disinfectedheader', $this));

  # Construct the text of the message body
  my($textfh, $textfile, $output, $result, $attachment);
  $textfh = new FileHandle;
  $textfile = MailScanner::Config::Value('disinfectedreporttext', $this);
  $textfh->open($textfile)
    or MailScanner::Log::WarnLog("Cannot open disinfected report message " .
                                 "file %s, %s", $textfile, $!);
  $output = "";
  my $line;
  my $ea = qr/([\(\)\[\]\.\?\*\+\^"'@<>:])/;
  while(<$textfh>) {
    $line = chomp;
    #s#"#\\"#g; # Escape any " characters
    #s#@#\\@#g; # Escape any @ characters
    $line =~ s/$ea/\\$1/g; # Escape any regex characters
    # Untainting joy...
    $line =~ /(.*)/;
    $result = eval "\"$1\"";
    $output .= MailScanner::Config::DoPercentVars($result) . "\n";
  }
  $textfh->close();
  $top->attach(Data => $output);

  # Construct all the attachments
  foreach $attachment (@files) {
    # Added "./" to start of next line to avoid potential DoS attack
    $top->attach(Path        => "./$attachment",
                 Type        => "application/octet-stream",
                 Encoding    => "base64",
                 Disposition => "attachment");
  }

  # Now send the message
  $global::MS->{mta}->SendMessageEntity($this, $top, $localpostmaster)
    or MailScanner::Log::WarnLog("Could not send disinfected message, %s",$!);
}


# Archive this message to any directories in its archiveplaces attribute
sub ArchiveToFilesystem {
  my $this = shift;

  my($dir, $todaydir, $target, $didanything);
  $didanything = 0;

  $todaydir = $this->{datenumber}; #MailScanner::Quarantine::TodayDir();

  foreach $dir (@{$this->{archiveplaces}}) {
    #print STDERR "Archive to $dir\n";
    next unless $dir =~ /^\//; # Must be a pathname
    # If it exists, and it's a file, then append the message to it
    # in mbox format.
    if (-f $dir) {
      #print STDERR "It is a file\n";
      $this->AppendToMbox($dir);
      $didanything = 1;
      next;
    }
    $target = "$dir/$todaydir";
    unless (-d "$target") {
      umask $global::MS->{quar}->{dirumask};
      mkdir "$target",0777 or
        MailScanner::Log::WarnLog("Cannot create directory %s", $target);
      umask 0077;
    }
    #print STDERR "It is a dir\n";
    umask $global::MS->{quar}->{fileumask};
    $this->{store}->CopyToDir($target, $this->{id});
    #print STDERR "Stored " . $this->{id} . " to $target\n";
    umask 0077;
    $didanything = 1;
  }
  return $didanything;
}


# Append a message to an mbox file
sub AppendToMbox {
  my($this, $mbox) = @_;

  my $fh = new IO::File "$mbox", "a";
  if ($fh) {
    # Print the mbox message header starting with a blank line and "From"
    # From $from `date "+%a %b %d %T %Y"`
    my($now, $recip);
    $now = ctime();
    $now =~ s/  (\d)/ 0$1/g; # Insert leading zeros where needed

    print $fh "From " . $this->{from} . ' ' . $now . "\n";
    foreach $recip (@{$this->{to}}) {
      print $fh "X-MailScanner-Recipient: $recip\n";
    }
    $fh->flush;

    # Write the entire message to this handle, then close.
    $this->{store}->WriteEntireMessage($this, $fh);
    print $fh "\n"; # Blank line at end of message to separate messages
    $fh->close;
    MailScanner::Log::InfoLog("Archived message %s to mbox file %s",
                              $this->{id}, $mbox);
  } else {
    MailScanner::Log::WarnLog("Failed to append message to pre-existing " .
                              "mbox file %s", $mbox);
  }
}


sub ReflowHeader {
  my($this, $key, $input) = @_;
  my($output, $pos, $len, $firstline, @words, $word);
  $output = "";
  $pos = 0;
  $firstline = 1;

  @words = split(/,\s*/, $input);
  foreach $word (@words) {
    $len = length($word);
    if ($firstline) {
      $output = "$word";
      $pos = $len + length($key)+1; # 1 = space between key and input
      $firstline = 0;
      next;
    }

    # Wrap at column 75 (pretty arbitrary number just less than 80)
    if ($pos+$len < 75) {
      $output .= ", $word";
      $pos += 2 + $len;
    } else {
      $output .= ",\n\t$word";
      $pos = 8 + $len;
    }
  }

  return $output;
}


# Strip the HTML out of this message. All the checks have already
# been done, so just get on with it.
sub StripHTML {
  my $this = shift;

  #print STDERR "Stripping HTML from message " . $this->{id} . "\n";
  $this->HTMLToText($this->{entity});
}


# Disarm some of the HTML tags in this message.
my($DisarmFormTag, $DisarmScriptTag, $DisarmCodebaseTag, $DisarmIframeTag,
   $DisarmWebBug, $DisarmPhishing, $DisarmNumbers, $DisarmHTMLChangedMessage,
   $DisarmWebBugFound, $DisarmPhishingFound, $PhishingSubjectTag,
   $PhishingHighlight);
sub DisarmHTML {
  my $this = shift;

  #print STDERR "Tags to convert are " . $this->{tagstoconvert} . "\n";

  # Set the disarm booleans for this message
  $DisarmFormTag     = 0;
  $DisarmScriptTag   = 0;
  $DisarmCodebaseTag = 0;
  $DisarmCodebaseTag = 0;
  $DisarmIframeTag   = 0;
  $DisarmWebBug      = 0;
  $DisarmPhishing    = 0;
  $DisarmNumbers     = 0;
  $DisarmWebBugFound = 0;
  $PhishingSubjectTag= 0;
  $PhishingHighlight = 0;
  $DisarmFormTag     = 1 if $this->{tagstoconvert} =~ /form/i;
  $DisarmScriptTag   = 1 if $this->{tagstoconvert} =~ /script/i;
  $DisarmCodebaseTag = 1 if $this->{tagstoconvert} =~ /codebase/i;
  $DisarmCodebaseTag = 1 if $this->{tagstoconvert} =~ /data/i;
  $DisarmIframeTag   = 1 if $this->{tagstoconvert} =~ /iframe/i;
  $DisarmWebBug      = 1 if $this->{tagstoconvert} =~ /webbug/i;
  $PhishingSubjectTag= 1
    if MailScanner::Config::Value('tagphishingsubject', $this) =~ /1/;
  #print STDERR "PhishingSubjectTag = $PhishingSubjectTag\n";
  $PhishingHighlight = 1
    if MailScanner::Config::Value('phishinghighlight', $this) =~ /1/;
  #print STDERR "PhishingHighlight = $PhishingHighlight\n";
  $DisarmPhishingFound = 0;
  $DisarmHTMLChangedMessage = 0;
  if (MailScanner::Config::Value('findphishing', $this) =~ /1/) {
    $DisarmPhishing = 1;
    $DisarmNumbers = 1
      if MailScanner::Config::Value('phishingnumbers', $this) =~ /1/;
  }

  my($counter, @disarmedtags);
  ($counter, @disarmedtags) = $this->DisarmHTMLTree($this->{entity});
  #print STDERR "disarmedtags = ". join(', ', @disarmedtags) . "\n";

  # If the HTML checks found a real problem or there really was a phishing
  # attack, only then should we log anything.
  @disarmedtags = ('phishing') if $DisarmPhishingFound && !@disarmedtags;
  #print STDERR "Found DisarmPhishingFound\n" if $DisarmPhishingFound;
  MailScanner::Log::InfoLog('Content Checks: Detected and have disarmed ' .
                            join(', ', @disarmedtags) . ' tags in ' .
                            'HTML message in %s from %s',
                            $this->{id}, $this->{from})
    if $DisarmHTMLChangedMessage || $DisarmPhishingFound;

  # And save the results from the phishing trip
  if ($DisarmPhishingFound) {
    # Do we want this or not? I say no. $this->{otherinfected} = 1;
    $this->{bodymodified} = 1;
    #print STDERR "DisarmPhishingFound = $DisarmPhishingFound\n";
  }
  if ($DisarmHTMLChangedMessage) {
    #print STDERR "Disarm Changed the message\n";
    $this->{bodymodified} = 1;
    $this->{messagedisarmed} = 1;
  } else {
    $this->{messagedisarmed} = 0;
  }
  # Store all the tags we disarmed
  #print STDERR "Storing " . join(',', @disarmedtags) . "\n";
  @{$this->{disarmedtags}} = @disarmedtags;
}


# Search for a multipart/alternative.
# If found, change it to multipart/mixed and make all its members into
# suitable named attachments.
sub EncapsulateAttachments {
  my($message, $searchtype, $entity, $filename) = @_;

  # Reached a leaf node?
  return 0 unless $entity && defined($entity->head);

  my(@parts, $part, $type, $extension, $newname);
  my $counter = 0;

  $type = $entity->head->mime_attr('content-type');
  if (!$searchtype || ($type && $type =~ /$searchtype/i)) {
    #print STDERR "Found alternative message at entity $entity\n";

    # Turn it into a multipart/mixed
    $entity->head->mime_attr('content-type' => 'multipart/mixed')
      if $searchtype;

    # Change the parts into attachments
    @parts = $entity->parts;
    foreach $part (@parts) {
      my $head = $part->head;
      $type = $head->mime_attr('content-type') || 'text/plain';
      $extension = '.dat';
      $type =~ /\/([a-z0-9-]+)$/i and $extension = '.' . lc($1);
      $extension = '.txt'  if $type =~ /text\/plain/i;
      $extension = '.html' if $type =~ /text\/html/i;

      $newname = $filename . $extension;

      $head->mime_attr('Content-Type'                 => $type);
      $head->mime_attr('Content-Disposition'          => 'attachment');
      $head->mime_attr('Content-Disposition.filename' => $newname)
        unless $head->mime_attr('Content-Disposition.filename');
      $head->mime_attr('Content-Type.name'            => $newname)
        unless $head->mime_attr('Content-Type.name');
      
      $counter++;
    }
  } else {
    # Now try the same on all the parts
    foreach $part (@parts) {
      $counter += $message->EncapsulateAttachments($searchtype, $part,
                                                   $filename);
    }
  }

  return $counter;
}


sub EncapsulateMessageHTML {
  my $this = shift;

  my($entity, $filename, $newpart);

  $entity = $this->{entity};

  $filename = MailScanner::Config::Value('originalmessage', $this);

  $entity->make_multipart('mixed');
  $this->EncapsulateAttachments('multipart/alternative', $entity, $filename)
    or $this->EncapsulateAttachments(undef, $entity, $filename);

  # Insert the new message part
  $newpart = MIME::Entity->build(Type => "text/plain",
                                 Disposition => undef,
                                 Data => [ "Hello\n","There\n","Last line\n" ],
                                 Filename => undef,
                                 Top  => 0,
                                 'X-Mailer' => undef
                                );
  $entity->add_part($newpart, 0); # Insert at the start of the message

  # Clean up the message so spammers can't pollute me
  $this->{entity}->preamble(undef);
  $this->{entity}->epilogue(undef);
  $this->{entity}->head->add('MIME-Version', '1.0')
    unless $this->{entity}->head->get('mime-version');
  $this->{bodymodified} = 1;
  return;
}


# Encapsulate the message in an RFC822 structure so that it becomes a
# single atachment of the message. Need to build the spam report to put
# in as the text/plain body of the main message.
sub EncapsulateMessage {
  my $this = shift;

  my($entity, $rfc822, $mimeversion, $mimeboundary, @newparts);
  my($messagefh, $filename, $emailmsg, $line, $charset);
  my($id, $to, $from, $localpostmaster, $hostname, $subject, $date);
  my($fullspamreport, $briefspamreport, $longspamreport, $sascore);
  my($postmastername);

  # For now, if there is no entity structure at all then just return,
  # we cannot encapsulate a message without it.
  # Unfortunately that means we can't encapsulate messages that are
  # Virus Scanning = no ("yes" but also having "Virus Scanners=none" is
  # fine, and works). The encapsulation will merely fail to do anything.
  # Hopefully this will only be used by corporates who are virus scanning
  # everything anyway.
  # Workaround: Instead of using "Virus Scanning = no", use
  # "Virus Scanners = none" and a set of filename rules that pass all files.
  return unless $this->{entity};

  # Construct the RFC822 attachment
  $mimeversion = $this->{entity}->head->get('mime-version');
  # Prune all the dead branches off the tree
  PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});
  $entity = $this->{entity};
  $rfc822 = $entity->stringify;

  # Setup variables they can use in the spam report that is inserted at
  # the top of the message.
  $id = $this->{id};
  #$to = join(', ', @{$this->{to}});
  my($to, %tolist);
  foreach $to (@{$this->{to}}) {
    $tolist{$to} = 1;
  }
  $to = join(', ', sort keys %tolist);

  $from = $this->{from};
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
  $hostname = MailScanner::Config::Value('hostname', $this);
  $subject = $this->{subject};
  $date = $this->{datestring}; # scalar localtime;
  $fullspamreport = $this->{spamreport};
  $longspamreport = $this->{salongreport};
  $sascore = $this->{sascore};
  #$this->{salongreport} = ""; # Reset it so we don't ever insert it twice

  # Delete everything in brackets after the SA report, if it exists
  $briefspamreport = $fullspamreport;
  $briefspamreport =~ s/(spamassassin)[^(]*\([^)]*\)/$1/i;
  $charset = MailScanner::Config::Value('attachmentcharset', $this);

  # Construct the spam report at the top of the message
  $messagefh = new FileHandle;
  $filename  = MailScanner::Config::Value('inlinespamwarning', $this);
  $messagefh->open($filename)
    or MailScanner::Log::WarnLog("Cannot open inline spam warning file %s, %s",
                                 $filename, $!);
  $emailmsg = "";
  while(<$messagefh>) {
    chomp;
    s#"#\\"#g;
    s#@#\\@#g;
    # Boring untainting again...
    /(.*)/;
    $line = eval "\"$1\"";
    $emailmsg .= MailScanner::Config::DoPercentVars($line) . "\n";
  }
  $messagefh->close();


  $newparts[0] = MIME::Entity->build(Type     => 'text/plain',
                                     Disposition => 'inline',
                                     Encoding => 'quoted-printable',
                                     Top      => 0,
                                     'X-Mailer' => undef,
                                     Charset => $charset,
                                     Data     => $emailmsg);

  $newparts[1] = MIME::Entity->build(Type     => 'message/rfc822',
                                     Disposition => 'attachment',
                                     Top      => 0,
                                     'X-Mailer' => undef,
                                     Data     => $rfc822);

  # If there was a multipart boundary, then create a new one so that
  # the main message has a different boundary from the RFC822 attachment.
  # Leave the RFC822 one alone, so we don't corrupt the original message,
  # but make sure we create a new one instead.
  # Keep generating random boundaries until we have definitely got a new one.
  my $oldboundary = $entity->head->multipart_boundary;
  do {
    $mimeboundary = '======' . $$ . '==' . int(rand(100000)) . '======';
  } while $mimeboundary eq $oldboundary;

  # Put the new parts in place, hopefully it will correct all the multipart
  # headers for me. Wipe the preamble and epilogue or else someone will use
  # them to bypass the encapsulation process.
  # Make it a report if it wasn't multipart already.
  $entity->make_multipart("report"); # Used to be digest
  # Try *real* hard to make it a digest.
  $entity->head->mime_attr("Content-type" => "multipart/report"); # Used to be digest
  $entity->head->mime_attr("Content-type.boundary" => $mimeboundary);
  # Delete the "type" subfield which I don't think should be there
  $entity->head->mime_attr("Content-type.type" => undef);
  # JKF 09/11/2005 Added after bug report from Georg@hackt.net
  $entity->head->mime_attr("Content-type.report-type" => 'spam-notification');
  $entity->parts(\@newparts);
  $entity->preamble(undef);
  $entity->epilogue(undef);
  $entity->head->add('MIME-Version', '1.0') unless $mimeversion;
  $this->{bodymodified} = 1; # No infection but we changed the MIIME tree
}

sub DisarmHTMLTree {
  my($this, $entity) = @_;

  my $counter = 0; # Have we modified this message at all?
  my @disarmed; # List of tags we have disarmed

  #print STDERR "Disarming HTML Tree\n";

  # Reached a leaf node?
  return 0 unless $entity && defined($entity->head);

  if ($entity->head->mime_attr('content-disposition') !~ /attachment/i &&
      $entity->head->mime_attr('content-type')        =~ /text\/html/i) {
    #print STDERR "Found text/html message at entity $entity\n";
    @disarmed = $this->DisarmHTMLEntity($entity);
    #print STDERR "Disarmed = " . join(', ',@disarmed) . "\n";
    if (@disarmed) {
      $this->{bodymodified} = 1;
      $DisarmHTMLChangedMessage = 1;
      $counter++;
    }
  }

  # Now try the same on all the parts
  my(@parts, $part, $newcounter, @newtags);
  @parts = $entity->parts;
  foreach $part (@parts) {
    ($newcounter, @newtags) = $this->DisarmHTMLTree($part);
    $counter += $newcounter;
    @disarmed = (@disarmed, @newtags);
  }

  #print STDERR "Returning " . join(', ', @disarmed) . " from DisarmHTMLTree\n";
  return ($counter, @disarmed);
}


# Walk the MIME tree, looking for text/html entities. Whenever we find
# one, create a new filename for a text/plain entity, and replace the
# part that pointed to the filename with a replacement that points to
# the new txt filename.
# Only replace inline sections, don't replace attachments, so that your
# users can still mail HTML attachments to each other.
# Then tag the message to say it has been modified, so that it is
# rebuilt from the MIME tree when it is delivered.
sub HTMLToText {
  my($this, $entity) = @_;

  my $counter; # Have we modified this message at all?

  # Reached a leaf node?
  return 0 unless $entity && defined($entity->head);

  if ($entity->head->mime_attr('content-disposition') !~ /attachment/i &&
      $entity->head->mime_attr('content-type')        =~ /text\/html/i) {
    #print STDERR "Found text/html message at entity $entity\n";
    $this->HTMLEntityToText($entity);
    MailScanner::Log::InfoLog('Content Checks: Detected and will convert ' .
                              'HTML message to plain text in %s',
                              $this->{id});
    $this->{bodymodified} = 1; # No infection but we changed the MIIME tree
    #$this->{otherreports}{""} .= "Converted HTML to plain text\n";
    #$this->{othertypes}{""} .= "m"; # Modified body, but no infection
    #$this->{otherinfected}++;
    $counter++;
  }

  # Now try the same on all the parts
  my(@parts, $part);
  @parts = $entity->parts;
  foreach $part (@parts) {
    $counter += $this->HTMLToText($part);
  }

  return $counter;
}

# HTML::Parset callback function for normal text
my(%DisarmDoneSomething, $DisarmLinkText, $DisarmLinkURL, $DisarmAreaURL,
   $DisarmInsideLink, $DisarmBaseURL);

# Convert 1 MIME entity from html to dis-armed HTML using HTML::Parser.
sub DisarmHTMLEntity {
  my($this, $entity) = @_;

  my($oldname, $newname, $oldfh, $outfh, $htmlparser);

  #print STDERR "Disarming HTML $entity\n";

  # Initialise all the variables we will use in the parsing, so nothing
  # is inherited from old messages
  $DisarmLinkText   = "";
  $DisarmLinkURL    = "";
  $DisarmInsideLink = 0;
  $DisarmBaseURL    = "";
  $DisarmAreaURL    = "";
  %DisarmDoneSomething = ();

  # Replace the filename with a new one
  $oldname = $entity->bodyhandle->path();
  #print STDERR "Path is $oldname\n";
  $newname = $oldname;
  $newname =~ s/\..?html?$//i; # Remove .htm .html .shtml
  $newname .= '2.html'; # This should always pass the filename checks
  $entity->bodyhandle->path($newname);

  $outfh = new FileHandle;
  unless ($outfh->open(">$newname")) {
    MailScanner::Log::WarnLog('Could not create disarmed HTML file %s',
                              $newname);
    return keys %DisarmDoneSomething;
  }

  # Set default output filehandle so we generate the new HTML
  $oldfh = select $outfh;

  # Process the old HTML file into the new one
  if ($DisarmPhishing) {
    HTML::Parser->new(api_version => 3,
      start_h     => [\&DisarmTagCallback,    "tagname, text, attr, attrseq"],
      end_h       => [\&DisarmEndtagCallback, "tagname, text, '" . $this->{id} . "'"],
      text_h      => [\&DisarmTextCallback,   "text"],
      default_h   => [ sub { print @_; },     "text"],
                   )
      ->parse_file($oldname)
      or MailScanner::Log::WarnLog("HTML disarming, can't open file %s: %s",
                                   $oldname, $!);
  } else {
    HTML::Parser->new(api_version => 3,
      start_h     => [\&DisarmTagCallback,    "tagname, text, attr, attrseq"],
      end_h       => [\&DisarmEndtagCallback, "tagname, text, '" . $this->{id} . "'"],
      default_h   => [ sub { print @_; },     "text"],
                   )
      ->parse_file($oldname)
      or MailScanner::Log::WarnLog("HTML disarming, can't open file %s: %s",
                                   $oldname, $!);
  }

  select $oldfh;
  $outfh->close();

  # Tell the caller if we did anything
  #print STDERR "Keys are " . join(', ', keys %DisarmDoneSomething) . "\n";
  return keys %DisarmDoneSomething;
}

# HTML::Parser callback for text so we can collect the contents of links
sub DisarmTextCallback {
  my($text) = @_;

  unless ($DisarmInsideLink) {
    print $text;
    #print STDERR "DisarmText just printed \"$text\"\n";
    return;
  }

  # We are inside a link.
  # Save the original text, we well might need it.
  $DisarmLinkText .= $text;
  #print STDERR "DisarmText just added \"$text\"\n";
}

# HTML::Parser callback function for start tags
sub DisarmTagCallback {
  my($tagname, $text, $attr, $attrseq) = @_;

  #print STDERR "Disarming $tagname\n";

  my $output = "";

  if ($tagname eq 'form' && $DisarmFormTag) {
    #print "It's a form\n";
    $text = substr $text, 1;
    $output .= "<BR><MailScannerForm$$ " . $text;
    $DisarmDoneSomething{'form'} = 1;
  } elsif ($tagname eq 'input' && $DisarmFormTag) {
    #print "It's an input button\n";
    $attr->{'type'} = "reset";
    $output .= '<' . $tagname;
    foreach (@$attrseq) {
      next if /^on/;
      $output .= ' ' . $_ . '="' . $attr->{$_} . '"';
    }
    $output .= '>';
    $DisarmDoneSomething{'form input'} = 1;
  } elsif ($tagname eq 'button' && $DisarmFormTag) {
    #print "It's a button\n";
    $attr->{'type'} = "reset";
    $output .= '<' . $tagname;
    foreach (@$attrseq) {
      next if /^on/;
      $output .= ' ' . $_ . '="' . $attr->{$_} . '"';
    }
    $output .= '>';
    $DisarmDoneSomething{'form button'} = 1;
  } elsif ($tagname eq 'object' && $DisarmCodebaseTag) {
    #print "It's an object\n";
    if (exists $attr->{'codebase'}) {
      $text = substr $text, 1;
      $output .= "<MailScannerObject$$ " . $text;
      $DisarmDoneSomething{'object codebase'} = 1;
    } elsif (exists $attr->{'data'}) {
      $text = substr $text, 1;
      $output .= "<MailScannerObject$$ " . $text;
      $DisarmDoneSomething{'object data'} = 1;
    } else {
      $output .= $text;
    }
  } elsif ($tagname eq 'iframe' && $DisarmIframeTag) {
    #print "It's an iframe\n";
    $text = substr $text, 1;
    $output .= "<MailScannerIFrame$$ " . $text;
    $DisarmDoneSomething{'iframe'} = 1;
  } elsif ($tagname eq 'script' && $DisarmScriptTag) {
    #print "It's a script\n";
    $text = substr $text, 1;
    $output .= "<MailScannerScript$$ " . $text;
    $DisarmDoneSomething{'script'} = 1;
  } elsif ($tagname eq 'a' && $DisarmPhishing) {
    #print STDERR "It's a link\n";
    $output .= $text;
    $DisarmLinkText = ''; # Reset state of automaton
    $DisarmLinkURL = '';
    $DisarmLinkURL = $attr->{'href'} if exists $attr->{'href'};
    $DisarmInsideLink = 1;
    $DisarmInsideLink = 0 if $text =~ /\/\>$/; # JKF Catch /> empty A tags
    #print STDERR "DisarmInsideLink = $DisarmInsideLink\n";
  } elsif ($tagname eq 'img' && $DisarmWebBug) {
    #print STDERR "It's an image\n";
    #print STDERR "The src is \"" . $attr->{'src'} . "\"\n";
    if (exists $attr->{'width'}  && $attr->{'width'}<=2 &&
        exists $attr->{'height'} && $attr->{'height'}<=2 &&
        exists $attr->{'src'}    && $attr->{'src'} !~ /^cid:|^MailScannerWebBug/i) {
      $output .= '<img src="MailScannerWebBug" width="' . $attr->{'width'} .
            '" height="' . $attr->{'height'} . '" alt="';
      $output .= 'Web Bug from ' . $attr->{'src'} if $attr->{'src'};
      $output .= '" />';
      $DisarmWebBugFound = 1;
      $DisarmDoneSomething{'web bug'} = 1;
    } else {
      $output .= $text;
    }
  } elsif ($tagname eq 'base') {
    #print STDERR "It's a Base URL\n";
    $output .= $text;
    #print STDERR "Base URL = " . $attr->{'href'} . "\n";
    $DisarmBaseURL = $attr->{'href'} if exists $attr->{'href'};
  } elsif ($tagname eq 'area' && $DisarmInsideLink && $DisarmPhishing) {
    #print STDERR "It's an imagemap area\n";
    $output .= $text;
    #print STDERR "Area URL = " . $attr->{'href'} . "\n";
    $DisarmAreaURL = $attr->{'href'};
  } else {
    #print STDERR "The tag was a \"$tagname\"\n";
    $output .= $text;
    #print STDERR "output text is now \"$output\"\n";
  }
  # tagname DisarmPhishing
  #    a     0               0 1
  #    a     1               0 0 tagname=a && Disarm=1
  #    b     0               1 1
  #    b     1               1 0 
  #if ($DisarmInsideLink && !($tagname eq 'a' && $DisarmPhishing)) {
  if ($DisarmInsideLink && ($tagname ne 'a' || !$DisarmPhishing)) {
    $DisarmLinkText .= $output;
    #print STDERR "StartCallback: DisarmLinkText now equals \"$DisarmLinkText\"\n";
  } else {
    print $output;
    #print STDERR "StartCallback: Printed2 \"$output\"\n";
  }
}

# HTML::Parser callback function for end tags
sub DisarmEndtagCallback {
  my($tagname, $text, $id) = @_;

  if ($tagname eq 'iframe' && $DisarmIframeTag) {
    print "</MailScannerIFrame$$>";
    $DisarmDoneSomething{'iframe'} = 1;
  } elsif ($tagname eq 'form' && $DisarmFormTag) {
    print "</MailScannerForm$$>";
    $DisarmDoneSomething{'form'} = 1;
  } elsif ($tagname eq 'script' && $DisarmScriptTag) {
    print "</MailScannerScript$$>";
    $DisarmDoneSomething{'script'} = 1;
  } elsif ($tagname eq 'map' && $DisarmAreaURL) {
    # We are inside an imagemap that is part of a phishing imagemap
    $DisarmLinkText .= '</map>';
  } elsif ($tagname eq 'a' && $DisarmPhishing) { # && defined $attr->{'href'}) {
    #print STDERR "Endtag Callback found link, disarmlinktext = \"$DisarmLinkText\"\n";
    my($squashedtext,$linkurl,$alarm,$numbertrap);
    $DisarmInsideLink = 0;
    $squashedtext = lc($DisarmLinkText);
    if ($DisarmAreaURL) {
      $squashedtext = $DisarmLinkURL;
      $DisarmLinkURL = lc($DisarmAreaURL);
      $DisarmAreaURL = ""; # End of a link, so reset this
    } else {
      $squashedtext = lc($DisarmLinkText);
    }

    # Try to filter out mentions of Microsoft's .NET system
    $squashedtext = "" if $squashedtext eq ".net";
    $squashedtext = "" if $squashedtext =~ /(^|\b)(ado|asp)\.net($|\b)/;

    $squashedtext =~ s/\%a0//g;
    $squashedtext =~ s#%([0-9a-f][0-9a-f])#chr(hex('0x' . $1))#gei; # Unescape
    $squashedtext =~ s/\s+//g; # Remove any whitespace
    $squashedtext =~ s/\\/\//g; # Change \ to / as many browsers do this
    $squashedtext =~ s/^\[\d*\]//; # Removing leading [numbers]
    $squashedtext =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
    $squashedtext =~ s/^[^\/:]+\@//; # Remove username of email addresses
    #$squashedtext =~ s/\&\w*\;//g; # Remove things like &lt; and &gt;
    $squashedtext =~ s/^\&lt\;//g; # Remove leading &lt;
    $squashedtext =~ s/\&gt\;$//g; # Remove trailing &gt;
    $squashedtext =~ s/\&lt\;/\</g; # Remove things like &lt; and &gt;
    $squashedtext =~ s/\&gt\;/\>/g; # rEmove things like &lt; and &gt;
    #$squashedtext =~ s/./CharToIntnl("$&")/ge;
    $squashedtext =  StringToIntnl($squashedtext); # s/./CharToIntnl("$&")/ge;
    #print STDERR "Text = \"$text\"\n";
    #print STDERR "1SquashedText = \"$squashedtext\"\n";
    #print STDERR "1LinkURL      = \"$DisarmLinkURL\"\n";
    # If it looks like a link, remove any leading https:// or ftp://
    ($linkurl,$alarm) = CleanLinkURL($DisarmLinkURL);
    #print STDERR "linkurl = $linkurl\nBefore If statement\n";
    #print STDERR "squashedtext = $squashedtext\nBefore If statement\n";

    # Has it fallen foul of the numeric-ip phishing net? Must treat x
    # like a digit so it catches 0x41 (= 'A')
    $numbertrap = ($DisarmNumbers && $linkurl !~ /[<>g-wyz]+/)?1:0;

    if ($alarm ||
        $squashedtext =~ /^(w+|ft+p|fpt+|ma[il]+to)([.,]|\%2e)/i || 
        $squashedtext =~ /[.,](com|org|net|info|biz|ws)/i ||
        $squashedtext =~ /[.,]com?[.,][a-z][a-z]/i ||
        $squashedtext =~ /^(ht+ps?|ft+p|fpt+|mailto)[:;](\/\/)?(.*(\.|\%2e))/i ||
        $numbertrap) {
      $squashedtext =~  s/^(ht+ps?|ft+p|fpt+|mailto)[:;](\/\/)?(.*(\.|\%2e))/$3/i;
      $squashedtext =~ s/\/.*$//; # Only compare the hostnames
      $squashedtext =~ s/[,.]+$//; # Allow trailing dots and commas
      $squashedtext = 'www.' . $squashedtext
        unless $squashedtext =~ /^ww+|ft+p|fpt+|mailto/ || $numbertrap;
      #print STDERR "2SquashedText = \"$squashedtext\"\n";
      # If we have already tagged this link as a phishing attack, spot the
      # warning text we inserted last time and don't tag it again.
      my $possiblefraudstart = MailScanner::Config::LanguageValue(0, 'possiblefraudstart');
      my $squashedpossible = lc($possiblefraudstart);
      my $squashedsearch   = lc($DisarmLinkText);
      $squashedpossible =~ s/\s//g;
      $squashedpossible =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
      $squashedsearch   =~ s/\s//g;
      $squashedsearch   =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
      #$squashedpossible = "www.$squashedpossible\"$linkurl\"";
      $squashedpossible = quotemeta($squashedpossible);
      #print STDERR "NEW CODE: SquashedText     = $squashedtext\n";
      #print STDERR "NEW CODE: DisarmLinkText   = $DisarmLinkText\n";
      #print STDERR "NEW CODE: Text             = $text\n";
      #print STDERR "NEW CODE: SquashedPossible = $squashedpossible\n";
      #print STDERR "NEW CODE: LinkURL          = $linkurl\n";
      if ($squashedtext =~ /$squashedpossible/) {
        #print STDERR "FOUND IT\n";
        #print STDERR "$DisarmLinkText$text\n";
        print "$DisarmLinkText$text";
        $DisarmLinkText = ""; # Reset state of automaton
        return;
      }
      #print STDERR "2LinkURL      = \"$linkurl\"\n";
      # If it is a phishing catch, or else it's not (numeric or IPv6 numeric)
      # then notify.
      #print STDERR "LinkURL is \"$linkurl\"\n";
      #print STDERR "Squashe is \"$squashedtext\"\n";
      #print STDERR "Phishing by numbers is $DisarmNumbers\n";

      #if ($linkurl ne "" && $squashedtext !~ /^(w+\.)?\Q$linkurl\E\/?$/) {
      #   || ($linkurl ne "" && $DisarmNumbers && $linkurl =~ /^\d+\.[^g-z]+/)){
      if ($alarm ||
          ($linkurl ne "" && $squashedtext !~ /^(w+\.)?\Q$linkurl\E\/?$/)
          || ($linkurl ne "" && $numbertrap)) {

        unless (InPhishingWhitelist($linkurl)) {
          use bytes; # Don't send UTF16 to syslog, it breaks!
          if ($linkurl ne "" && numbertrap && $linkurl eq $squashedtext) {
            # It's not a real phishing trap, just a use of numberic IP links
            print MailScanner::Config::LanguageValue(0, 'numericlinkwarning') .
                  ' ' if $PhishingHighlight;
          } else {
            # It's a phishing attack.
            print $possiblefraudstart . ' "' . $linkurl . '" ' .
                  MailScanner::Config::LanguageValue(0, 'possiblefraudend') . ' ' if $PhishingHighlight;
          }
          $DisarmPhishingFound = 1;
          $linkurl = substr $linkurl, 0, 80;
          $squashedtext = substr $squashedtext, 0, 80;
          $DisarmDoneSomething{'phishing'} = 1 if $PhishingSubjectTag;
          if ($numbertrap) {
            MailScanner::Log::InfoLog('Found ip-based phishing fraud from ' .
                                      '%s in %s', $linkurl, $id);
          } else {
            MailScanner::Log::InfoLog('Found phishing fraud from %s ' .
                                      'claiming to be %s in %s',
                                      $linkurl, $squashedtext, $id);
                                      #$DisarmLinkURL);
          }
          #print STDERR "Fake\n";
          no bytes;
        }
      }
      #print STDERR "\n";
    }
    #print STDERR "End tag printed \"$DisarmLinkText$text\"\n";
    print "$DisarmLinkText$text";
    $DisarmLinkText = ""; # Reset state of automaton
    #print STDERR "Reset disarmlinktext\n";
  } else {
    #print STDERR "End tag printed \"$text\"\n";
    print $text;
  }
}

my %CharToInternational = (
160,'nbsp',
161,'iexcl',
162,'cent',
163,'pound',
164,'curren',
165,'yen',
166,'brvbar',
167,'sect',
168,'uml',
169,'copy',
170,'ordf',
171,'laquo',
172,'not',
173,'shy',
174,'reg',
175,'macr',
176,'deg',
177,'plusmn',
178,'sup2',
179,'sup3',
180,'acute',
181,'micro',
182,'para',
183,'middot',
184,'cedil',
185,'sup1',
186,'ordm',
187,'raquo',
188,'frac14',
189,'frac12',
190,'frac34',
191,'iquest',
192,'Agrave',
193,'Aacute',
194,'Acirc',
195,'Atilde',
196,'Auml',
197,'Aring',
198,'AElig',
199,'Ccedil',
200,'Egrave',
201,'Eacute',
202,'Ecirc',
203,'Euml',
204,'Igrave',
205,'Iacute',
206,'Icirc',
207,'Iuml',
208,'ETH',
209,'Ntilde',
210,'Ograve',
211,'Oacute',
212,'Ocirc',
213,'Otilde',
214,'Ouml',
215,'times',
216,'Oslash',
217,'Ugrave',
218,'Uacute',
219,'Ucirc',
220,'Uuml',
221,'Yacute',
222,'THORN',
223,'szlig',
224,'agrave',
225,'aacute',
226,'acirc',
227,'atilde',
228,'auml',
229,'aring',
230,'aelig',
231,'ccedil',
232,'egrave',
233,'eacute',
234,'ecirc',
235,'euml',
236,'igrave',
237,'iacute',
238,'icirc',
239,'iuml',
240,'eth',
241,'ntilde',
242,'ograve',
243,'oacute',
244,'ocirc',
245,'otilde',
246,'ouml',
247,'divide',
248,'oslash',
249,'ugrave',
250,'uacute',
251,'ucirc',
252,'uuml',
253,'yacute',
254,'thorn',
255,'yuml'
);

# Turn any character into an international version of it if it is in the range
# 160 to 255.
sub CharToIntnl {
  my $p = shift @_;
  # Passed in an 8-bit character.
  #print STDERR "Char in is $p\n";
  ($a) = unpack 'C', $p;

  #print STDERR "Char is $a, $p\n";

  # Bash char 160 (space) to nothing
  return '' if $a == 160;
  my $char = $CharToInternational{$a};
  return '&' . $char . ';' if $char ne "";
  return $p;
}

# Like CharToIntnl but does entire string
sub StringToIntnl {
  my $original = shift;

  # Much faster char conversion for whole strings
  my(@newlinkurl, $newlinkurl, $char);
  @newlinkurl = unpack("C*", $original); # Get an array of characters
  foreach (@newlinkurl) {
    next if $_ == 160;
    $char = $CharToInternational{$_};
    if (defined $char) {
      $newlinkurl .= '&' . $char . ';';
    } else {
      $newlinkurl .= chr($_);
    }
  }
  return $newlinkurl;
  #$linkurl = $newlinkurl unless $newlinkurl eq "";
  #$linkurl =~ s/./CharToIntnl("$&")/ge; -- Old slow version
}


# Clean up a link URL so it is suitable for phishing detection
# Return (clean url, alarm trigger value). An alarm trigger value non-zero
# means this is definitely likely to be a phishing trap, no matter what
# anything else says.
sub CleanLinkURL {
  my($DisarmLinkURL) = @_;

  use bytes;

  my($linkurl,$alarm);
  $alarm = 0;
  $linkurl = $DisarmLinkURL;
  $linkurl = lc($linkurl);
  #print STDERR "Cleaning up $linkurl\n";
  #$linkurl =~ s/\%a0//ig;
  #$linkurl =~ s/\%e9/&eacute;/ig;

  $linkurl =~ s#%([0-9a-f][0-9a-f])#chr(hex('0x' . $1))#gei; # Unescape
  #print STDERR "2Cleaning up $linkurl\n";

  $linkurl = StringToIntnl($linkurl);
  #$linkurl =~ s/./CharToIntnl("$&")/ge; -- Old slow version

  #print STDERR "Was $linkurl\n";
  return ("",0) unless $linkurl =~ /[.\/]/; # Ignore if it is not a website at all
  #$linkurl = "" unless $linkurl =~ /[.\/]/; # Ignore if it is not a website at all
  $linkurl =~ s/\s+//g; # Remove any whitespace
  $linkurl =~ s/\\/\//g; # Change \ to / as many browsers do this
  #print STDERR "Is $linkurl\n";
  return ("",0) if $linkurl =~ /\@/ && $linkurl !~ /\//; # Ignore emails
  #$linkurl = "" if $linkurl =~ /\@/ && $linkurl !~ /\//; # Ignore emails
  $linkurl =~ s/^\[\d*\]//; # Remove leading [numbers]
  $linkurl =~ s/^blocked[:\/]+//i; # Remove "blocked::" labels
  $linkurl =~ s/^outbind:\/\/\d+\///i; # Remove "outbind://22/" type labels
  $linkurl = $DisarmBaseURL . '/' . $linkurl
    if $linkurl ne "" && $DisarmBaseURL ne "" &&
       $linkurl !~ /^(https?|ftp|mailto):/i;
  $linkurl =~ s/^(https?|ftp)[:;]\/\///i;
  return ("",0) if $linkurl =~ /^ma[il]+to[:;]/i;
  #$linkurl = "" if $linkurl =~ /^ma[il]+to[:;]/i;
  $linkurl =~ s/[?\/].*$//; # Only compare up to the first '/' or '?'
  $linkurl =~ s/(\<\/?(br|p|ul)\>)*$//ig; # Remove trailing br, p, ul tags
  return ("",0) if $linkurl =~ /^file:/i; # Ignore file: URLs completely
  #$linkurl = "" if $linkurl =~ /^file:/i; # Ignore file: URLs completely
  return ("",0) if $linkurl =~ /^#/; # Ignore internal links completely
  #$linkurl = "" if $linkurl =~ /^#/; # Ignore internal links completely
  $linkurl =~ s/\/$//; # LinkURL is trimmed -- note
  $alarm = 1 if $linkurl =~ s/[\x00-\x1f[:^ascii:]]/_BAD_/g; # /\&\#/;
  $linkurl = 'JavaScript' if $linkurl =~ /^javascript:/i;
  ($linkurl, $alarm);
}

# Return 1 if the hostname in $linkurl is in the safe sites file.
# Return 0 otherwise.
sub InPhishingWhitelist {
  my($linkurl) = @_;

  # Quick lookup
  return 1 if $MailScanner::Config::PhishingWhitelist{$linkurl};

  # Trim host. off the front of the hostname
  while ($linkurl ne "" && $linkurl =~ s/^[^.]+\.//) {
    # And replace it with *. then look it up
    #print STDERR "Looking up *.$linkurl\n";
    return 1 if $MailScanner::Config::PhishingWhitelist{'*.' . $linkurl};
  }

  return 0;
}


# Convert 1 MIME entity from html to text using HTML::Parser.
sub HTMLEntityToText {
  my($this, $entity) = @_;

  my($htmlname, $textname, $textfh, $htmlparser);

  # Replace the MIME Content-Type
  $entity->head->mime_attr('Content-type' => 'text/plain');

  # Replace the filename with a new one
  $htmlname = $entity->bodyhandle->path();
  $textname = $htmlname;
  $textname =~ s/\..?html?$//i; # Remove .htm .html .shtml
  $textname .= '.txt'; # This should always pass the filename checks
  $entity->bodyhandle->path($textname);

  # Create the new file with the plain text in it
  $textfh = new FileHandle;
  unless ($textfh->open(">$textname")) {
    MailScanner::Log::WarnLog('Could not create plain text file %s', $textname);
    return;
  }
  $htmlparser = HTML::TokeParser::MailScanner->new($htmlname);
  # Turn links into text containing the URL
  $htmlparser->{textify}{a} = 'href';
  $htmlparser->{textify}{img} = 'src';

  my $inscript = 0;
  my $instyle  = 0;
  while (my $token = $htmlparser->get_token()) {
    next if $token->[0] eq 'C';
    # Don't output the contents of style or script sections
    if ($token->[1] =~ /style/i) {
      $instyle = 1 if $token->[0] eq 'S';
      $instyle = 0 if $token->[0] eq 'E';
      next if $instyle;
    }
    if ($token->[1] =~ /script/i) {
      $inscript = 1 if $token->[0] eq 'S';
      $inscript = 0 if $token->[0] eq 'E';
      next if $inscript;
    }
    my $text = $htmlparser->get_trimmed_text();
    print $textfh $text . "\n" if $text;
  }
  $textfh->close();
}

#
# This is an improvement to the default HTML-Parser routine for getting
# the text out of an HTML message. The only difference to their one is
# that I join the array of items together with spaces rather than "".
#
package HTML::TokeParser::MailScanner;

use HTML::Entities qw(decode_entities);

use vars qw(@ISA);
@ISA = qw(HTML::TokeParser);

sub get_text
{
    my $self = shift;
    my $endat = shift;
    my @text;
    while (my $token = $self->get_token) {
        my $type = $token->[0];
        if ($type eq "T") {
            my $text = $token->[1];
            decode_entities($text) unless $token->[2];
            push(@text, $text);
        } elsif ($type =~ /^[SE]$/) {
            my $tag = $token->[1];
            if ($type eq "S") {
                if (exists $self->{textify}{$tag}) {
                    my $alt = $self->{textify}{$tag};
                    my $text;
                    if (ref($alt)) {
                        $text = &$alt(@$token);
                    } else {
                        $text = $token->[2]{$alt || "alt"};
                        $text = "[\U$tag]" unless defined $text;
                    }
                    push(@text, $text);
                    next;
                }
            } else {
                $tag = "/$tag";
            }
            if (!defined($endat) || $endat eq $tag) {
                 $self->unget_token($token);
                 last;
            }
        }
    }
    # JKF join("", @text);
    join(" ", @text);
}

# And switch back to the original package we were in
package MailScanner::Message;

#
# This is an improvement to the default MIME character set decoding that
# is done on attachment filenames. It decodes all the character sets it
# knows about, just as before. But instead of warning about character sets
# it doesn't know about (and removing characters in them), it strips
# out all the 8-bit characters (rare) and leaves the 7-bit ones (common).
#
sub WordDecoderKeep7Bit {
    local $_ = shift;
    # JKF 19/8/05 Allow characters with the top bit set.
    # JKF 19/8/05 Still blocks 16-bit characters though, as it should.
    #tr/\x00-\x7F/#/c;
    tr/\x00-\xFF/#/c;
    $_;
}

#
# Create a subclass of MIME::Parser:FileInto so that I can over-ride
# the "evil filename" code with a slightly better one that detects
# filenames made up solely of whitespace, which breaks the Perl open().
# I have also improved exorcise_filename to detect and remove any leading
# or trailing whitespace, which should make life a lot easier for the
# virus scanner output parsers.
#
# For the original version see .../MIME/Parser/Filer.pm

#package MIME::Parser::FileInto::MailScanner;
#
#use vars qw(@ISA);
#@ISA = qw(MIME::Parser::FileInto);
#
## A filename is evil unless it only contains any of the following:
##  \%\(\)\+\,\-\.0-9\=A-Z_a-z\x80-\xFF
## To get the correct pattern match string, do this:
## print '\x00-\x1F\x7F' . quotemeta(' !"£$&') . quotemeta("'") .
##       quotemeta('*/:/<>?@[\]^`{|}~') . "\n";
## print ' ' . quotemeta('%()+,-.') . '0-9' . quotemeta('=') .
##       'A-Z' . quotemeta('_') . 'a-z' . quotemeta('{}') . '\x80-\xFF' . "\n";
##
#sub evil_filename {
#    my ($self, $name) = @_;
#
#    #$self->debug("is this evil? '$name'");
#
#    #print STDERR "Testing \"$name\" to see if it is evil\n";
#    return 1 if (!defined($name) or ($name eq ''));   ### empty
#    return 1 if ($name =~ m{(^\s)|(\s+\Z)});  ### leading/trailing whitespace
#    return 1 if ($name =~ m{^\.+\Z});         ### dots
#    return 1 if ($name =~ tr{ \%\(\)\+\,\-\.0-9\=A-Z_a-z\{\}\x80-\xFF}{}c);
#    return 1 if ($self->{MPF_MaxName} and
#                 (length($name) > $self->{MPF_MaxName}));
#
#    #print STDERR "It is okay\n";
#    #$self->debug("it's ok");
#    0;
#}
#
#sub exorcise_filename {
#    my ($self, $fname) = @_;
#
#    ### Isolate to last path element:
#    my $last = $fname; $last =~ s{^.*[/\\\[\]:]}{};
#    if ($last and !$self->evil_filename($last)) {
#        #$self->debug("looks like I can use the last path element");
#        return $last;
#    }
#
#    # Try removing leading whitespace, trailing whitespace and all
#    # dangerous characters to start with.
#    $last =~ s/^\s+//;
#    $last =~ s/\s+\Z//;
#    $last =~ tr/ \%\(\)\+\,\-\.0-9\=A-Z_a-z\{\}\x80-\xFF//cd;
#    return $last unless $self->evil_filename($last);
#
#    ### Break last element into root and extension, and truncate:
#    my ($root, $ext) = (($last =~ /^(.*)\.([^\.]+)\Z/)
#                        ? ($1, $2)
#                        : ($last, ''));
#    # JKF Delete leading and trailing whitespace
#    $root =~ s/^\s+//;
#    $ext  =~ s/\s+$//;
#    $root = substr($root, 0, ($self->{MPF_TrimRoot} || 14));
#    $ext  = substr($ext,  0, ($self->{MPF_TrimExt}  ||  3));
#    $ext =~ /^\w+$/ or $ext = "dat";
#    my $trunc = $root . ($ext ? ".$ext" : '');
#    if (!$self->evil_filename($trunc)) {
#        #$self->debug("looks like I can use the truncated last path element");
#        return $trunc;
#    }
#
#    ### Hope that works:
#    undef;
#}


#
# Over-ride a function in MIME::Entity that gets called every time a MIME
# part is added to a message. The new version bails out if there were too
# many parts in the message. The limit will be read from the config.
# It just sets the entity to undef and relies on the supporting code to
# actually generate the error.
#

package MIME::Entity;

use vars qw(@ISA $EntityPartCounter $EntityPartCounterMax);
@ISA = qw(Mail::Internet);

# Reset the counter and the limit
sub ResetMailScannerCounter {
    my($number) = @_;
    $EntityPartCounter = 0;
    $EntityPartCounterMax = $number;
} 

# Read the Counter
sub MailScannerCounter {
    return $EntityPartCounter || 0;
}


# Over-rise their add_part function with my own with counting added
sub add_part {
    my ($self, $part, $index) = @_;
    defined($index) or $index = -1;

    # Incrememt the part counter so I can detect messages with too many parts
    $EntityPartCounter++;
    #print STDERR "Added a part. Counter = $EntityPartCounter, Max = " .
    #             $EntityPartCounterMax\n";
    return undef
      if $EntityPartCounterMax>0 && $EntityPartCounter > $EntityPartCounterMax;

    ### Make $index count from the end if negative:
    $index = $#{$self->{ME_Parts}} + 2 + $index if ($index < 0);
    splice(@{$self->{ME_Parts}}, $index, 0, $part);
    $part;
}


#
# Over-ride a function in Mail::Header that parses the block of headers
# at the top of each MIME section. My improvement allows the first line
# of the header block to be missing, which breaks the original parser
# though the filename is still there.
#

package Mail::Header;

sub extract
{
 my $me = shift;
 my $arr = shift;
 my $line;

 $me->empty;

 # JKF Make this more robust by allowing first line of header to be missing
 shift @{$arr} while scalar(@{$arr}) &&
                     $arr->[0] =~ /\A[ \t]+/o &&
                     $arr->[1] =~ /\A$FIELD_NAME/o;
 # JKF End mod here

 while(scalar(@{$arr}) && $arr->[0] =~ /\A($FIELD_NAME|From )/o)
  {
   my $tag = $1;

   $line = shift @{$arr};
   $line .= shift @{$arr}
       while(scalar(@{$arr}) && $arr->[0] =~ /\A[ \t]+/o);

   ($tag,$line) = _fmt_line($me,$tag,$line);

   _insert($me,$tag,$line,-1)
      if defined $line;
  }

 shift @{$arr}
  if(scalar(@{$arr}) && $arr->[0] =~ /\A\s*\Z/o);

 $me;
}

##
## Over-ride the MIME boundary extracting code so that we fail to parse
## messages with an empty MIME boundary. Best I can do for now.
##
#
#package MIME::Parser::Reader;
#
#sub add_boundary {
#    my ($self, $bound) = @_;
#    unshift @{$self->{Bounds}}, $bound;   ### now at index 0
#    # JKF Fix problem with the Britney virus
#    $bound = "" if $bound eq '""';
#    # JKF End
#    $self->{BH}{"--$bound"}   = "DELIM $bound";
#    $self->{BH}{"--$bound--"} = "CLOSE $bound";
#    $self;
#}

#
# Over-ride the hunt-for-uuencoded file code as it now needs to hunt for
# binhex-encoded text as well.
#

#package MIME::Parser;
#
##------------------------------
##
## hunt_for_uuencode ENCODED, ENTITY
##
## I<Instance method.>
## Try to detect and dispatch embedded uuencode as a fake multipart message.
## Returns new entity or undef.
##
#sub hunt_for_uuencode {
#    my ($self, $ENCODED, $ent) = @_;
#    my ($good, $jkfis);
#    local $_;
#    $self->debug("sniffing around for UUENCODE");
#
#    ### Heuristic:
#    $ENCODED->seek(0,0);
#    while (defined($_ = $ENCODED->getline)) {
#        if ($good = /^begin [0-7]{3}/) {
#          $jkfis = 'uu';
#          last;
#        }
#        if ($good = /^\(This file must be converted with/i) {
#          $jkfis = 'binhex';
#          last;
#        }
#    }
#    $good or do { $self->debug("no one made the cut"); return 0 };
#
#    ### New entity:
#    my $top_ent = $ent->dup;      ### no data yet
#    $top_ent->make_multipart;
#    my @parts;
#
#    ### Made the first cut; on to the real stuff:
#    $ENCODED->seek(0,0);
#    my $decoder = MIME::Decoder->new(($jkfis eq 'uu')?'x-uuencode'
#                                                     :'binhex');
#    $self->whine("Found a $jkfis attachment");
#    my $pre;
#    while (1) {
#        my @bin_data;
#
#        ### Try next part:
#        my $out = IO::ScalarArray->new(\@bin_data);
#        eval { $decoder->decode($ENCODED, $out) }; last if $@;
#        my $preamble = $decoder->last_preamble;
#        my $filename = $decoder->last_filename;
#        my $mode     = $decoder->last_mode;
#
#        ### Get probable type:
#        my $type = 'application/octet-stream';
#        my ($ext) = $filename =~ /\.(\w+)\Z/; $ext = lc($ext || '');
#        if ($ext =~ /^(gif|jpe?g|xbm|xpm|png)\Z/) { $type = "image/$1" }
#
#        ### If we got our first preamble, create the text portion:
#        if (@$preamble and
#            (grep /\S/, @$preamble) and
#            !@parts) {
#            my $txt_ent = $self->interface('ENTITY_CLASS')->new;
#
#            MIME::Entity->build(Type => "text/plain",
#                                Data => "");
#            $txt_ent->bodyhandle($self->new_body_for($txt_ent->head));
#            my $io = $txt_ent->bodyhandle->open("w");
#            $io->print(@$preamble);
#            $io->close;
#            push @parts, $txt_ent;
#        }
#
#        ### Create the attachment:
#        ### We use the x-unix-mode convention from "dtmail 1.2.1 SunOS 5.6".
#        if (1) {
#            my $bin_ent = MIME::Entity->build(Type=>$type,
#                                              Filename=>$filename,
#                                              Data=>"");
#            $bin_ent->head->mime_attr('Content-type.x-unix-mode' => "0$mode");
#            $bin_ent->bodyhandle($self->new_body_for($bin_ent->head));
#            $bin_ent->bodyhandle->binmode(1);
#            my $io = $bin_ent->bodyhandle->open("w");
#            $io->print(@bin_data);
#            $io->close;
#            push @parts, $bin_ent;
#        }
#    }
#
#    ### Did we get anything?
#    @parts or return undef;
#
#    ### Set the parts and a nice preamble:
#    $top_ent->parts(\@parts);
#    $top_ent->preamble
#        (["The following is a multipart MIME message which was extracted\n",
#          "from a $jkfis-encoded message.\n"]);
#    $top_ent;
#}

#
# Overload the MIME quoted-printable decoder.
# This version will make lines that end in \n now end in \r\n.
# This hopefully fixes problems with PDF files as they are now extracted
# correctly.
#
#package MIME::QuotedPrint;
#
#sub decode_qp ($)
#{
#    my $res = shift;
#    $res =~ s/[ \t]+?(\r?\n)/$1/g;  # rule #3 (trailing space must be deleted)
#    $res =~ s/=\r?\n//g;            # rule #5 (soft line breaks)
#    $res =~ s/([^\r])\n\Z/$1\r\n/;  # JKF rule to replace trailing \n with \r\n
#    $res =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
#    $res;
#}


1;

