#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: SweepContent.pm 3698 2006-08-23 09:25:31Z sysjkf $
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#   The author, Julian Field, can be contacted by email at
#      Jules@JulianField.net
#   or by paper mail at
#      Julian Field
#      Dept of Electronics & Computer Science
#      University of Southampton
#      Southampton
#      SO17 1BJ
#      United Kingdom
#

package MailScanner::SweepContent;

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

use MIME::Head;
use DirHandle;

use vars qw($VERSION);

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

# Attributes are
#

# Constructor.
sub new {
  my $type = shift;
  my $this = {};

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

# Do all the message content scanning in here
sub ScanBatch {
  my $batch = shift;
  my $ScanType = shift;

  # Insert your own checking here.

  # In $BaseDir, you will find a directory for each message, which has the
  # same name as the message id. Also there is a messageid.header file
  # containing all the headers for the message.
  # Add entries into %$infections, where they are referenced as
  # $infections->{"message id"}{"filename"} but please don't over-write ones
  # that are already there.
  # If the danger was detected in a header or applies to the whole message
  # then append the error report (and a newline) to
  # $infections->{"message id"}{""}.
  # Return the number of infections/problems you found.
  # Can play with the MIME headers of a message using $mime.

  my($id,$message,$ent,$partialcount);
  my($stripdangerous, $counter, $stripcounter);
  $counter = 0;
  $stripcounter = 0; # No. of messages we need to strip HTML from

  $0 = 'MailScanner: dangerous content scanning';
  while(($id, $message) = each %{$batch->{messages}}) {
    next if $message->{deleted};

    $ent = $message->{entity};

    #
    # Do the partial and external checks even if they don't want
    # dangerous content scanning, as they directly affect our ability
    # to scan for viruses.
    #

    # Search for multipart/partial messages. This is entity-based as
    # the last part of the message (which is what is split into the
    # next message) probably won't have a filename.
    if ((! MailScanner::Config::Value('allowpartial', $message)) &&
        FindPartialMessage($message, $ent)) {
      $message->{otherreports}{""} .=
        MailScanner::Config::LanguageValue($message, 'partialmessage') . "\n";
      $message->{othertypes}{""} .= "e";
      #$message->{otherinfected}++;
      $counter++;
      # Force replacement of the last bit of the MIME message
      #$message->{entityreports}{LastEntity($message, $ent)} .=
      #  "Fragmented messages cannot be reliably scanned\n";
      MailScanner::Log::WarnLog('Content Checks: Detected and rejected ' .
                                'fragmented message section in %s', $id);
    }

    # Search for message/external-body messages. This is entity-based
    # as, almost by definition, we won't have the filename worked out
    # for the file that is external.
    if ((! MailScanner::Config::Value('allowexternal', $message)) &&
        FindExternalBody($message, $ent)) {
      $counter++;
      MailScanner::Log::WarnLog('Content Checks: Detected and rejected ' .
                                'external message body in %s', $id);
    }

    # Do the remaining checks if any recipient wants dangerous content checking
    next unless MailScanner::Config::Value('dangerscan', $message) =~ /1/;

    # Go through the attachments and remove any that are bigger than this
    # user/domain/site is allowed.
    my $maxmessagesize = MailScanner::Config::Value('maxmessagesize', $message);
    if ($maxmessagesize>0 && $message->{size}>$maxmessagesize) {
      MailScanner::Log::WarnLog("Content Checks: Message %s is bigger than " .
                                "%d bytes", $message->{id}, $maxmessagesize);
      $message->{otherreports}{""} .=
        MailScanner::Config::LanguageValue($message, 'toobig') . ": " .
                                           $message->{size} . " bytes\n";
      $message->{othertypes}{""} .= "s";
      $message->{sizeinfected}++;
      $counter++;
    }

    # Check all the files for the attachment-size limit
    $counter += CheckAttachmentSizes($message, $id);

    # Search for Microsoft-specific attacks
    # Disallow both by default. Allow them only if all addresses agree.
    my $iframevalue = MailScanner::Config::Value('allowiframetags', $message);
    my $objectvalue = MailScanner::Config::Value('allowobjecttags', $message);
    my $formvalue   = MailScanner::Config::Value('allowformtags',   $message);
    my $scriptvalue = MailScanner::Config::Value('allowscripttags', $message);
    my $webbugvalue = MailScanner::Config::Value('allowwebbugtags', $message);
    my $phishingvalue = MailScanner::Config::Value('findphishing',  $message);
    my $allowiframes = 0;
    my $allowobjects = 0;
    my $allowforms   = 0;
    my $allowscripts = 0;
    my $allowwebbugs = 0;
    my $convertiframes = 0;
    my $convertobjects = 0;
    my $convertforms   = 0;
    my $convertscripts = 0;
    my $convertwebbugs = 0;
    my $allowphishing = 0;
    # Allow the tags only if everyone allows them
    $allowiframes = 1 if $iframevalue =~ /^[1\s]+$/;
    $allowobjects = 1 if $objectvalue =~ /^[1\s]+$/;
    $allowforms   = 1 if $formvalue   =~ /^[1\s]+$/;
    $allowscripts = 1 if $scriptvalue =~ /^[1\s]+$/;
    $allowwebbugs = 1 if $webbugvalue =~ /^[1\s]+$/;
    $allowphishing =1 if $phishingvalue !~ /1/;
    # Convert the tags if no-one blocks them and someone converts them
    $convertiframes = 1 if $iframevalue !~ /0/ && $iframevalue =~ /convert/i;
    $convertobjects = 1 if $objectvalue !~ /0/ && $objectvalue =~ /convert/i;
    $convertforms   = 1 if $formvalue   !~ /0/ && $formvalue   =~ /convert/i;
    $convertscripts = 1 if $scriptvalue !~ /0/ && $scriptvalue =~ /convert/i;
    $convertwebbugs = 1 if $webbugvalue !~ /0/ && $webbugvalue =~ /convert/i;
    $stripdangerous = MailScanner::Config::Value('stripdangeroustags',$message);

    #print STDERR "WebBugvalue = $webbugvalue\n";
    #print STDERR "Allowforms = $allowforms and convertforms = $convertforms\n";

    #print STDERR "Allowphishing = $allowphishing\n";

    # Shortcut the check completely if they want to allow everything
    # and are not converting nasty tags to text
    if (!($allowiframes && $allowforms && $allowscripts && $allowobjects &&
          $allowphishing && !$stripdangerous) &&
        FindHTMLExploits($message, $id, $ent,
                         $allowiframes, $allowobjects, $allowforms,
                         $allowscripts, $allowwebbugs,
                         $convertiframes, $convertobjects, $convertforms,
                         $convertscripts, $convertwebbugs,
                         $stripdangerous)) {
      $counter++;
      MailScanner::Log::WarnLog('Content Checks: Detected HTML-' .
                                'specific exploits in %s', $id);
    }

    # Look for encrypted messages. They can allow some and block some
    # so we need to find the messages then apply the rules to the result.
    my $reason;
    my $encrypted = EncryptionStatus($message, $ent);
    if ($encrypted && MailScanner::Config::Value('blockencrypted',
                                                 $message) =~ /1/) {
      $reason = 'encrypted';
    }
    if (!$encrypted && MailScanner::Config::Value('blockunencrypted',
                                                  $message) =~ /1/) {
      $reason = 'unencrypted';
    }
    if ($reason) {
      $message->{otherreports}{""} .= MailScanner::Config::LanguageValue(
                                      $message, $reason) . "\n";
      $message->{othertypes}{""} .= "e";
      #$message->{otherinfected}++;
      $counter++;
      MailScanner::Log::WarnLog('Content Checks: Detected and blocked ' .
                                '%s message in %s', $reason, $id);
    }

    # Replace the MIME boundary string, for any multipart/alternative
    # sections inside multipart/mixed sections, where the outer
    # boundary is a substring of the inner boundary. Works around bugs
    # in the Cyrus IMAP server, and some old versions of Eudora.
    FixSubstringBoundaries($message, $id);

    # Check for nasty subject lines and quietly fix them
    FixMaliciousSubjects($message);

    # Find and save all the public keys (X.509 and PGP) in each message.
    #ExtractPublicKeys($message, $ent)
    #  if MailScanner::Config::Value('archivepublickeys', $message);

    # Convert text/html components into text/plain attachments.
    # Do this if any of the recipients need it done.
    # This involves forcing the message to rebuild itself from the
    # MIME structure. We will end up replacing MIME entities in the
    # message with ones pointing to new files/strings.
    if (MailScanner::Config::Value('htmltotext', $message) =~ /1/) {
      $message->{needsstripping} = 1;
      $stripcounter++;
      #MailScanner::Log::InfoLog('Content Checks: Detected and will convert ' .
      #                          'HTML message to plain text in %s', $id);
      #$message->{otherreports}{""} .= "Converted HTML to plain text\n";
      #$message->{othertypes}{""} .= "m"; # Modified body, but no infection
    }
  }

  # Print just a summary of the HTML stripping that needs doing
  MailScanner::Log::InfoLog('Content Checks: Need to convert HTML to plain ' .
                 'text in %s messages', $stripcounter) if $stripcounter>0;
  return $counter;
}


# Remove all trailing space from the subject line and remove any large
# blocks of spaces.
sub FixMaliciousSubjects {
  my($message) = @_;

  my $subject = $message->{subject};
  my $newsubject = $subject;
  $newsubject =~ s/\s{20,}.*\..{1,4}\s*$//; # Delete file extensions at end of filename
  $newsubject =~ s/\s*$//g;
  $newsubject =~ s/\s{20,}//g;

  # If it has changed then force an update
  #print STDERR "Message metadata is:\n" . join("\n", @{$message->{metadata}}) . "\n";
  if ($newsubject ne $subject) {
    $message->{subjectwasunsafe} = 1;
    $message->{safesubject} = $newsubject;
    #$global::MS->{mta}->ReplaceHeader($message, 'Subject:', $newsubject);
  } else {
    $message->{subjectwasunsafe} = 0;
    $message->{safesubject} = $message->{subject};
  }
}

# Check each of the file attachments to make sure they are all within
# the acceptable limit. Replace each one that's too big with a warning
# message.
sub CheckAttachmentSizes {
  my($message, $id) = @_;

  my($BaseDir, $basefh, $safename, $maxsize, $attachsize, $tnefname);
  my($unsafename, $counter, $minsize, $attachentity);

  # Read the configuration setting, value<=0 implies setting not in use.
  $maxsize = MailScanner::Config::Value('maxattachmentsize', $message);
  $minsize = MailScanner::Config::Value('minattachmentsize', $message);
  return 0 if $maxsize<0 && $minsize<0;
  $tnefname = $message->{entity2file}{$message->{tnefentity}};

  # Get into the directory containing all the attachments
  $BaseDir = $global::MS->{work}->{dir} . "/$id";
  chdir $BaseDir or die "Cannot chdir to $BaseDir for file size checking, $!";

  $basefh = new DirHandle;
  $basefh->open('.')
    or MailScanner::Log::DieLog("Could not open attachment dir %s, %s",
                                $BaseDir, $!);
  $counter = 0;
  while ($safename = $basefh->read()) {
    next if $safename eq '.' || $safename eq '..';

    # "Safe" attachment filename is in $safename, this is what we stat
    $attachsize = -s "$BaseDir/$safename";
    $unsafename = $message->{safefile2file}{$safename} || $tnefname;
    $attachentity = $message->{file2entity}{$unsafename};
    next unless $attachentity; # Only check attachment, not contents of zips
    next if $safename =~ /^msg[-\d]+\.(txt|html)$/;
    #print STDERR "\nSafename = $safename\n";
    #print STDERR "Attachsize=$attachsize\nMin=$minsize\nMax=$maxsize\n";
    if ($maxsize>=0 && $attachsize > $maxsize) {
      #print STDERR "$safename is too big $attachsize > $maxsize\n";
      #print STDERR "Unsafename is $unsafename\n";
      MailScanner::Log::NoticeLog("Attachment size check: %s > %s (%s) in %s",
                                $attachsize, $maxsize, $unsafename, $id);
      $message->{otherreports}{$safename} .=
       MailScanner::Config::LanguageValue($message,'attachmenttoolarge') .
         ": $attachsize bytes\n";
      $message->{othertypes}{$safename}   .= "s";
      $counter++;
      $message->{sizeinfected}++;
    }
    if ($minsize>=0 && $attachsize < $minsize) {
      #print STDERR "Attachment is too small\n";
      MailScanner::Log::NoticeLog("Attachment size check: %s < %s (%s) in %s",
                                $attachsize, $minsize, $unsafename, $id);
      $message->{otherreports}{$safename} .=
       MailScanner::Config::LanguageValue($message,'attachmenttoosmall') . "\n";
      $message->{othertypes}{$safename}   .= "s";
      $counter++;
      $message->{sizeinfected}++;
    }
  }

  return $counter;
}



# Walk the entire tree of a message, looking for any
# Content-type: message/partial
# headers.
# Write an entity report about them so we keep the rest of the message.
sub FindPartialMessage {
  my($message, $entity) = @_;

  # Track number of dangerous things found
  my $counter = 0;

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

  # Mark the message as a problem if it's a "message/partial"
  my $type = $entity->head->mime_attr('content-type');
  if ($type && $type =~ /message\/partial/i) {
    #print STDERR "Found partial message at entity $entity\n";
    $message->{otherinfected}++;
    $counter++;
  }

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

  return $counter;
}


# Find the last MIME entity in the tree. This will be the part that
# we need to replace if we found a message/partial.
# This is no longer used. We did try to just clean out the split
# attachments in partial messages, but it isn't feasible to do. Sorry.
sub LastEntity {
  my($message, $entity) = @_;
  my($NumParts);

  #print STDERR "Looking for LastEntity of $message\n";
  #print STDERR "Skeleton is " . $entity->dump_skeleton() . "\n";
  # Is this a nested entity? If so, search the last part of it
  if ($entity && !$entity->bodyhandle) {
    # How many parts?
    $NumParts = $entity->parts;
    #print STDERR "Message is multipart with $NumParts parts\n";
    return LastEntity($message, $entity->parts($NumParts-1)) if $NumParts>0;
    return $entity; # NumParts == 0 so it's not actually multipart at all
  } else {
    # It's not multipart, so I must be at the end
    return $entity;
  }
}

# Look through all the message parts finding text/html entities
# that contain Microsoft-specific exploits.
sub FindHTMLExploits {
  my($message, $id, $entity, $allowiframes, $allowobjects, $allowforms,
     $allowscripts, $allowwebbugs,
     $convertiframes, $convertobjects, $convertforms, $convertscripts,
     $convertwebbugs,
     $stripdangerous) = @_;

  # Track number of dangerous things found
  my $counter = 0;

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

  # Look for text/html sections
  my $type = $entity->head->mime_attr('content-type');
  #my $disposition = $entity->head->mime_attr('content-disposition');
  #$disposition = 'inline' unless $disposition;
  if ($type && $type =~ /text\/html/i &&
      #$disposition !~ /attachment/i &&
      defined($entity->bodyhandle) &&
      defined($entity->body) &&
      defined($entity->bodyhandle->path)) {
    $counter += SearchHTMLBody($message, $id, $entity->bodyhandle->path,
                               $allowiframes, $allowobjects, $allowforms,
                               $allowscripts, $allowwebbugs,
                               $convertiframes, $convertobjects, $convertforms,
                               $convertscripts, $convertwebbugs,
                               $stripdangerous);
  }

  # Now try the same on all the parts
  my(@parts, $part);
  @parts = $entity->parts;
  foreach $part (@parts) {
    $counter += FindHTMLExploits($message, $id, $part,
                               $allowiframes, $allowobjects, $allowforms,
                               $allowscripts, $allowwebbugs,
                               $convertiframes, $convertobjects, $convertforms,
                               $convertscripts, $convertwebbugs,
                               $stripdangerous);
  }

  return $counter;
}


# Search an HTML part of the message body for dangerous HTML
# that either uses the <IFRAME> tag or the <OBJECT CODEBASE=...> tag.
sub SearchHTMLBody {
  my($message, $id, $filename, $allowiframes, $allowobjects, $allowforms,
     $allowscripts, $allowwebbugs,
     $convertiframes, $convertobjects, $convertforms, $convertscripts,
     $convertwebbugs,
     $stripdangerous) = @_;

  my($fh, $counter, $silentviruses);
  $counter = 0;
  $fh = new FileHandle;
  if ($fh->open("$filename")) {

    my $loggingtags = MailScanner::Config::Value('loghtmltags', $message);

    # Search the file
    my $inobject    = 0;
    my $iframefound = 0;
    my $formfound   = 0;
    my $scriptfound = 0;
    my $webbugfound = 0;
    my $phishingfound = 0;
    my $codebasefound = 0;
    my $attach = $filename;
    $attach = $1 if $filename =~ /([^\/]+)$/; # Strip off the path
    while(<$fh>) {
      # Skip whitespace lines
      next if /^\s*$/;

      # Find the iframe tag start, but only if we're not allowed them
      $iframefound = 1 if /\<iframe/i;
        
      # Find the form tag start
      $formfound = 1 if /\<form/i;

      # Find the script tag start
      $scriptfound = 1 if /\<script/i;

      # Find the img tag start
      $webbugfound = 1 if /\<img/i;

      # Find the link tag start
      $phishingfound = 1 if /\<a/i;

      # Find the object tag start
      $inobject = 1 if /\<object/i;

      # Find a codebase or data within an object tag
      $codebasefound = 1 if $inobject && /codebase|data/i;

      # Find the object tag end
      $inobject = 0 if /\<\/object/i;
    }
    $fh->close();

    # Get this so we can set the silent flag if they don't want reports
    # about IGrames or Object-Codebases
    $silentviruses = ' ' .  MailScanner::Config::Value('silentviruses',
                     $message) . ' ';

    if ($phishingfound && MailScanner::Config::Value('findphishing', $message)){
      # Log the <A>
      MailScanner::Log::InfoLog("<A> tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      # Mark the message
      $message->{tagstoconvert} .= 'phishing ';
      #$message->{bodymodified}   = 1;
    }
    if ($iframefound) {
      # Log the <IFrame>
      MailScanner::Log::NoticeLog("HTML-IFrame tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      # Mark the message
      if ($allowiframes) {
        if ($stripdangerous) {
          $message->{needsstripping} = 1;
          $message->{bodymodified}   = 1; # Mark it for rebuilding
          $counter++;
        }
      } elsif ($convertiframes) {
        $message->{tagstoconvert} .= 'iframe ';
        $message->{bodymodified}   = 1;
      } else {
        $message->{otherreports}{"$attach"} .= 
          MailScanner::Config::LanguageValue($message, 'foundiframe') . "\n";
        $message->{othertypes}{"$attach"}   .= "c";
        $message->{otherinfected}++;
        $message->{silent} = 1 if $silentviruses =~ / HTML-IFrame /i;
        $counter++;
      }
    }
    if ($formfound) {
      ## Log the <Form>
      MailScanner::Log::NoticeLog("HTML-Form tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      # Mark the message
      if ($allowforms) {
        if ($stripdangerous) {
          $message->{needsstripping} = 1;
          $message->{bodymodified}   = 1; # Mark it for rebuilding
          $counter++;
        }
      } elsif ($convertforms) {
        $message->{tagstoconvert} .= 'form ';
        $message->{bodymodified}   = 1;
      } else {
        $message->{otherreports}{"$attach"} .=
          MailScanner::Config::LanguageValue($message, 'foundform') . "\n";
        $message->{othertypes}{"$attach"}   .= "c";
        $message->{otherinfected}++;
        $message->{silent} = 1 if $silentviruses =~ / HTML-Form /i;
        $counter++;
      }
    }
    if ($scriptfound) {
      ## Log the <script>
      MailScanner::Log::NoticeLog("HTML-Script tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      # Mark the message
      if ($allowscripts) {
        if ($stripdangerous) {
          $message->{needsstripping} = 1;
          $message->{bodymodified}   = 1; # Mark it for rebuilding
          $counter++;
        }
      } elsif ($convertscripts) {
        $message->{tagstoconvert} .= 'script ';
        $message->{bodymodified}   = 1;
      } else {
        $message->{otherreports}{"$attach"} .=
          MailScanner::Config::LanguageValue($message, 'foundscript') . "\n";
        $message->{othertypes}{"$attach"}   .= "c";
        $message->{otherinfected}++;
        $message->{silent} = 1 if $silentviruses =~ / HTML-Script /i;
        $counter++;
      }
    }
    if ($webbugfound) {
      ## Log the <img>
      MailScanner::Log::NoticeLog("HTML Img tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      #  if MailScanner::Config::Value('logwebbugs', $message);
      # Mark the message
      if ($allowwebbugs) {
        #print STDERR "Web Bug allowed\n";
        if ($stripdangerous) {
          #print STDERR "Web Bug stripped\n";
          $message->{needsstripping} = 1;
          $message->{bodymodified}   = 1; # Mark it for rebuilding
          $counter++;
        }
      } elsif ($convertwebbugs) {
        #print STDERR "Web Bug converted\n";
        $message->{tagstoconvert} .= 'webbug ';
        # Only mark it for rebuilding if we actually found a webbug
        # as we shouldn't rebuild if it was an innocent image
        #$message->{bodymodified}   = 1;
        #print STDERR "Going to disarm web bugs\n";
      } else {
        #print STDERR "Web Bug ignored\n";
        # Web bugs neither allowed nor converted. So must be stopped.
        $message->{otherreports}{"$attach"} .=
          MailScanner::Config::LanguageValue($message, 'foundwebbug') . "\n";
        $message->{othertypes}{"$attach"}   .= "c";
        $message->{otherinfected}++;
        $message->{silent} = 1 if $silentviruses =~ / HTML-WebBug /i;
        $counter++;
        1;
      }
    }
    if ($codebasefound) {
      MailScanner::Log::NoticeLog("HTML-Object tag found in message %s from %s",
        $id, $message->{from}) if $loggingtags;
      if ($allowobjects) {
        if ($stripdangerous) {
          $message->{needsstripping} = 1;
          $message->{bodymodified}   = 1; # Mark it for rebuilding
          $counter++;
        }
      } elsif ($convertobjects) {
        $message->{tagstoconvert} .= 'codebase data ';
        $message->{bodymodified}   = 1;
      } else {
        # Mark the message
        $message->{otherreports}{"$attach"} .=
          MailScanner::Config::LanguageValue($message, 'foundobject') . "\n";
        $message->{othertypes}{"$attach"}   .= "c";
        $message->{otherinfected}++;
        $message->{silent} = 1 if $silentviruses =~ / HTML-Codebase /i;
        $counter++;
      }
    }
  } else {
    MailScanner::Log::WarnLog("Could not search \"%s\" in message %s for " .
                              "dangerous HTML", $filename, $id);
    $counter++;
  }

  return $counter;
}


# Walk the entire tree of a message, looking for any
# Content-type: message/external-body
# headers. If we find any, write a report about them
# as we can't support them.
sub FindExternalBody {
  my($message, $entity) = @_;

  # Track number of dangerous things found
  my $counter = 0;

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

  # Mark the message as a problem if it's a "message/external-body"
  my $type = $entity->head->mime_attr('content-type');
  if ($type && $type =~ /message\/external-body/i) {
    #print STDERR "FindExternalBody: Found one at $entity\n";
    $message->{entityreports}{$entity} .=
      MailScanner::Config::LanguageValue($message, 'externalbody') . "\n";
    $message->{otherinfected}++;
    $counter++;
  }

  # Now try the same on all the parts
  my(@parts, $part);
  @parts = $entity->parts;
  foreach $part (@parts) {
    # Escape out of the tree if we found something
    $counter += FindExternalBody($message, $part);
  }

  return $counter;
}


# Search for any encrypted sections of the message.
# Bail out as soon as I find anything encrypted.
sub EncryptionStatus {
  my($message, $entity) = @_;

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

  my $type = $entity->head->mime_attr('content-type');
  return 1 if ($type =~ /\/encrypted/i);

  # Now try the same on all the parts
  my(@parts, $part);
  @parts = $entity->parts;
  foreach $part (@parts) {
    # Escape out of the tree if we found something
    return 1 if EncryptionStatus($message, $part);
  }

  # Didn't find any trace of encryption
  return 0;
}

# Search for (and save) all the public keys stored in the current message.
# It currently finds PGP and X.509 public keys.
sub ExtractPublicKeys {
  my($message, $entity) = @_;

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

  my $type = $entity->head->mime_attr('content-type');
  if ($type =~ /application\/pgp-signature/i ||
      $type =~ /application\/x-pkcs7-signature/i) {
    SavePublicKey($message, $entity);
  }

  # Now try the same on all the parts
  my(@parts, $part);
  @parts = $entity->parts;
  foreach $part (@parts) {
    # Escape out of the tree if we found something
    ExtractPublicKeys($message, $part);
  }
}

# Save the entity out as a file named after the sender of the message
# and the date.
sub SavePublicKey {
  my($message, $entity) = @_;

  # Create filename of output file for public key
  my($date, $from, $keyfilename);

  # This is the yyyymmddhhmmss timestamp part
  my($sec,$min,$hour,$day,$month,$year);
  ($sec,$min,$hour,$day,$month,$year) = (localtime)[0,1,2,3,4,5];
  $month++;
  $year += 1900;
  $date = sprintf("%04d%02d%02d%02d%02d%02d",
                  $year, $month, $day, $hour, $min, $sec);

  # This is the email address part
  $from = lc($message->{from});
  $from =~ tr/a-z0-9_.\@\-//cd; # Delete all nasty characters

  # Now join it all together
  $keyfilename = MailScanner::Config::Value('publickeyarchivedir', $message) .
                 '/' . $date . '-' . $from;

  # Write the contents of the file out to a key archive
  my($keyfh);
  $keyfh = new FileHandle;
  unless ($keyfh->open(">$keyfilename")) {
    MailScanner::Log::WarnLog('Could not create public key file %s',
                              $keyfilename);
    return;
  }
  $entity->bodyhandle->print($keyfh);
  $keyfh->close();
}


#
# Search for multipart/alternative sections inside multipart/mixed
# sections, where the outer boundary is a substring of the inner boundary.
# This causes a problem for the Cyrus IMAP server and some old versions of
# Eudora, so make sure the 2 boundary strings are distinct.
#
sub FixSubstringBoundaries {
  my($message, $id) = @_;

  # Avoid messages with no MIME structure at all
  my $root = $message->{entity};
  return unless $root;

  # The top level must be multipart/mixed
  return unless $root->is_multipart && $root->head;

  my($topboundary, $innerboundary);

  # Read the top-level multipart boundary
  $topboundary = $root->head->multipart_boundary;
  $topboundary = quotemeta($topboundary); # We're going to use it in a regexp

  # Loop through all the top-level parts
  my($firstlevel, @toplevel, $changedit);
  @toplevel = $root->parts;
  $changedit = 0;
  foreach $firstlevel (@toplevel) {
    # Now look at $toplevel to find multipart sections within it
    next unless $firstlevel->is_multipart && $firstlevel->head;

    # This is a multipart section, so read its boundary
    $innerboundary = $firstlevel->head->multipart_boundary;
    #print STDERR "Inner boundary = \"$innerboundary\"\n";
    #print STDERR "Top   boundary = \"$topboundary\"\n";
    next unless $innerboundary =~ /$topboundary/;
    #print STDERR "top is a substring of inner\n";

    # We now know that topboundary is a substring of innerboundary
    $root->head->mime_attr("Content-type.boundary" =>
                   "__MailScanner_found_Cyrus_boundary_substring_problem__");
    # We need to build a report of it. This is special as it is just
    # a modification to the body, not actually a security problem.
    $changedit = 1;
    #$message->{otherreports}{""} .= "Eudora boundary substring bug\n";
    #$message->{othertypes}{""} .= "m"; # Modified body, but no infection
    #print STDERR "Fixed boundary.\n";
    last;
  }
  if ($changedit) {
    MailScanner::Log::WarnLog('Content Checks: Fixed awkward MIME boundary ' .
         'for Cyrus IMAP server in %s', $id);
    $message->{bodymodified} = 1;
  }
}

1;