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

use strict;
use MIME::Entity;

# $MessagesInfo works like this:
# foreach $id (@$Ids) {
#   ($from, $to, $subject, $relay) = split(/\0/, $MessagesInfo->{$id});
#   #$from =~ s/^\s*\<(.+)\>\s*$/$1/;
#   #$to   =~ s/^\s*\<(.+)\>\s*$/$1/;
# }
#
# $Ids works like this:
# @$Ids = list of all dirty message ids, which also happens to be a list of directory names
#
# $Reports works like this:
# $Reports->{$id} = Hash of {attachment or ""} = report text from Sophos
#
sub DisinfectAndDeliver {
  my($Reports, $CleanIds, $Ids, $BadTNEF, $MessagesInfo) = @_;

  my(%CleanedUp, $attachment, $id, $parts, $NewReports, @list);
  my($MaxSubjectLen) = 25;

  # If there are no dirty messages, just return
  return unless @$Ids;

  # Delete all the clean messages from the work area, to save double-scanning
  ClearWorkAreaIds($Config::SrcDir, $CleanIds);

  # And delete all the bad TNEF messages, as we don't want to attempt to
  # disinfect them, as the virus scanner will say the winmail.dat files
  # are clean
  ClearWorkAreaIds($Config::SrcDir, $BadTNEF);

  # Do the disinfection pass, ignoring all output from Sophos
  Sweep::CallDisinfector($Config::SrcDir);

  # Virus scan the whole set of messages all over again
  $NewReports = Sweep::VirusScan($Config::SrcDir);

  # Look through original list of reports, find reports missing from new list.
  # Build hash of list of disinfected files.
  foreach $id (keys %$Reports) {
    @list = ();
    $parts = $Reports->{$id};
    foreach $attachment (keys %$parts) {
      # Will never attempt whole-message infections
      next if $attachment eq "";
      # JKF 7/8/2001 Bug fix for Jethro Binks
      # Don't add to the list if the scanner renamed the file
      # or we quietly deleted the message it came from
      Log::InfoLog("Skipping renamed/deleted attachment %s", $attachment),next
        unless -f "$Config::SrcDir/$id/$attachment";
      # Add to the list unless they are in the new report list
      push @list, "$attachment" unless defined $NewReports->{"$id"}{"$attachment"};
    }
    my $logtext = join(", ", @list);
    Log::InfoLog("Disinfected message $id attachments %s", $logtext) if @list;
    $CleanedUp{"$id"} = [ @list ] if @list;
  }

  #
  # Construct message for each member of disinfected list, containing all
  # disinfected attachments.
  #
  my($message, $newsubject, $from , $to, $subject, $relay, $result);
  my($fromdomain);
  local(*TEXT, *SENDMAIL);

  foreach $id (keys %CleanedUp) {
    # Don't do this if we aren't delivering cleaned up mail and the message
    # came from one of the local domains.
    $from = (split(/\0/, $MessagesInfo->{$id}))[0];
    $from = lc($from);
    $from =~ s/^<//; # Delete leading and
    $from =~ s/>$//; # trailing <>
    $fromdomain = $from;
    $fromdomain =~ s/^[^@]*@//; # Delete everything up to and including the @
    next if !$Config::DeliverFromLocal &&
            ($Config::LocalDomains{"$from"} ||
             $Config::LocalDomains{"$fromdomain"});
    
    # Need to be in the directory containing attachments for this message
    chdir($Config::SrcDir . "/$id");

    # Construct a new message containing a text/plain body and
    # a list of attachments $CleanedUp{"$id"}.

    # Need to extract the original envelope recipients here!
    ($from, $to, $subject, $relay) = split(/\0/, $MessagesInfo->{$id});
    #$from =~ s/^\s*\<(.+)\>\s*$/$1/;
    #$to   =~ s/^\s*\<(.+)\>\s*$/$1/;
    $newsubject = "Disinfected: " . substr($subject, 0, $MaxSubjectLen);
    $newsubject .= "..." if length($subject)>$MaxSubjectLen;

    my($top) = MIME::Entity->build(Type => "multipart/mixed",
                                   From => "MailScanner <$Config::LocalPostmaster>",
                                   To   => $to,
                                   Subject    => $newsubject,
                                   'X-Mailer' => 'MailScanner',
                                   "$Config::MailHeader" => "$Config::DisinfectedHeader");

    # Construct the text of the message body
    open(TEXT, $Config::DisinfectedReportText)
      or Log::WarnLog("Cannot open message file $Config::DisinfectedReportText");
    $message = "";
    while(<TEXT>) {
      chomp;
      s#"#\\"#g;
      /(.*)/;
      $result = eval "\"$1\"";
      $message .= $result . "\n";
    }
    close TEXT;
    $top->attach(Data=>$message);

    foreach $attachment (@{$CleanedUp{"$id"}}) {
      # Added "./" to next line to avoid possible DoS attach
      $top->attach(Path        => "./$attachment",
                   Type        => "application/octet-stream",
                   Encoding    => "base64",
                   Disposition => "attachment");
    }

    # Send message
    Sendmail::SendEntity($top);
    #open SENDMAIL, "|$Config::Sendmail -t -oi -oem"
    #  or Log::WarnLog("Could not send disinfected attachments"), return;
    #$top->print(\*SENDMAIL);
    #close SENDMAIL;
  }
}

1;