#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: TNEF.pm 3677 2006-07-31 21:40:25Z 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::TNEF;

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

use DirHandle;
use POSIX qw(:signal_h setsid); # For Solaris 9 SIG bug workaround

use vars qw($VERSION);

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

my($UseTNEFModule) = 0;

# Attributes are
#

# Install an extra MIME decoder for badly-header uue messages.
install MIME::Decoder::UU 'uuencode';

sub initialise {
  if (MailScanner::Config::Value('tnefexpander') eq 'internal') {
   require Convert::TNEF;
   require File::Copy;
   require File::Temp;
   $UseTNEFModule = 1;
  }
}

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

  #$this->{dir} = shift;

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


# Look through an entity to find a TNEF file. Recursive.
sub FindTNEFFile {
  my($entity) = @_;

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

  # Find the body for this entity
  return undef unless $entity;
  $body = $entity->bodyhandle;
  if (defined($body) && defined($body->path)) {   # data is on disk:
    $path = $body->path;
    return $entity if $path =~ /winmail\d*\.dat\d*$/i;
    #$path =~ s#^.*/([^/]*)$#$1#;
  }
  # 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;
  return $entity
    if (defined($headfile) && $headfile =~ /winmail\d*\.dat\d*$/i);

  # And for all its children
  @parts = $entity->parts;
  foreach $part (@parts) {
    $tnef = FindTNEFFile($part);
    return $tnef if defined($tnef);
  }

  # Must return something.
  return undef;
}


#
# Higher level function which calls the internal or external decoder
# as requested in the .conf file.
#
sub Decoder {
  my($dir, $tnefname, $message) = @_;

  return InternalDecoder($dir, $tnefname, $message) if $UseTNEFModule;
  return ExternalDecoder($dir, $tnefname, $message);
}


# Expand the tnef file stored at $1/$2.
# Use the internal TNEF module.
# Return 1 on success, 0 on failure.
sub InternalDecoder {
  my($dir, $tnefname, $message) = @_;
  my($fh, $filename, %parms);

  # Make the temporary tnef files be created under /tmp for easy removal.
  mkdir "/tmp/tnef.$$", 0777;
  chmod 0700, "/tmp/tnef.$$";
  %parms = ( ignore_checksum => "true",
             output_dir      => "/tmp/tnef.$$",
             output_to_core  => "NONE" );
  my $tnef = Convert::TNEF->read_in("$dir/$tnefname", \%parms);
  if ($tnef) {
    #print STDERR "Parsing returned something\n";
    #print STDERR "Attachment list is \"" . $tnef->attachments . "\"\n";
    #print STDERR "List is \"" . join('","', @{$tnef->attachments}) . "\"\n";
    $message->{entity}->make_multipart;
    my $addcontents = 0;
    $addcontents = 1
      if MailScanner::Config::Value('replacetnef',$message) =~ /[12]/;
    my($safename, @replacements);
    foreach $_ (@{$tnef->attachments}) {
      #print STDERR "Doing attachment $_\n";
      if (my $handle = $_->datahandle) {
        #print STDERR "Have a datahandle $handle\n";
        # There is a method to get the filename from the attachment,
        # but it of course is tainted (and you might end up overwriting
        # attachments with the same name within the same file)
        # so you might just want to generate
        # your own temp file name or use File::Temp
        ($fh, $filename) = File::Temp::tempfile(DIR => $dir);
        #print STDERR "Tempfile = $fh, $filename\ndir = $dir\n";
        $message->{file2parent}{$filename} = $tnefname;
        if (defined(my $file = $handle->path)) {
          $message->{file2parent}{$file} = $tnefname;
          File::Copy::copy($file, $fh)
            or MailScanner::Log::DieLog("Can't copy $file to $filename: $!");
        } else {
          print $fh $handle->as_string;
        }
        close($fh);

        if ($addcontents) {
          # Add the member file to the list of attachments in the message
          #print STDERR "Reading attachment from \"" . $_->name .
          #             "\" and \"" . $_->longname . "\"\n";
          #print STDERR "Attachment \"$filename\" --> \"" .
          #             $_->longname . "\"\n";
          # Save the new names for logging
          $safename = $message->MakeNameSafe($_->longname, $dir);
          push @replacements, $safename;
          #print STDERR "Safe name is \"$safename\"\n";
          $message->{entity}->attach(Type => "application/octet-stream",
                                     Encoding => "base64",
                                     Disposition => "attachment",
                                     Filename => $safename,
                                     Path => $filename);
          $message->{bodymodified} = 1;
          #print STDERR "Message = $message and Message ID = " . $message->{id} . "\n";
        }
      }
    }
    $tnef->purge;
    undef $tnef;
    $message->{foundtnefattachments} = 1;
    #$message->{entity}->dump_skeleton();
    system("rm -rf /tmp/tnef.$$");
    MailScanner::Log::InfoLog("Message %s added TNEF contents %s",
                              $message->{id}, join(',', @replacements))
      if @replacements;
    return 1;
  } else {
    # It failed
    undef $tnef;
    system("rm -rf /tmp/tnef.$$");
    return 1 if MailScanner::Config::Value('deliverunparsabletnef',$message);
    return 0;
  }
}


# Expand the tnef file stored at $1/$2.
# Use the external TNEF program.
# Return 1 on success, 0 on failure.
# This can't setup file2parent as it doesn't know the name of the children.
sub ExternalDecoder {
  my($dir, $tnefname, $message) = @_;

  my $cmd = MailScanner::Config::Value('tnefexpander') .
            " -f $dir/$tnefname -C $dir --overwrite";

  my($kid);
  my($TimedOut, $PipeReturn, $pid);
  $kid = new FileHandle;

  $TimedOut = 0;

  eval {
    die "Can't fork: $!" unless defined($pid = open($kid, "-|"));
    if ($pid) {
      # In the parent
      local $SIG{ALRM} = sub { $TimedOut = 1; die "Command Timed Out" }; # 2.53
      alarm MailScanner::Config::Value('tneftimeout');
      close $kid; # This will wait for completion
      $PipeReturn = $?;
      $pid = 0;
      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 {
      POSIX::setsid(); # 2.53
      exec $cmd or die "Can't run tnef decoder: $!";
    }
  };
  alarm 0; # 2.53

  # Note to self: I only close the $kid in the parent, not in the child.

  # Catch failures other than the alarm
  MailScanner::Log::DieLog("TNEF decoder failed with real error: $@")
    if $@ and $@ !~ /Command Timed Out/;

  # In which case any failures must be the alarm
  if ($@ or $pid>0) {
    # Kill the running child process
    my($i);
    kill 'TERM', $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
    }
  }

  # Now the child is dead, look at all the return values

  # Do we want to deliver unparsable TNEF files anyway (like we used to)
  if (MailScanner::Config::Value('deliverunparsabletnef',$message)) {
    return 0 if $TimedOut; # Ignore tnef command exit status
    return 1; # Command terminated
  } else {
    return 0 if $TimedOut || $PipeReturn; # Command failed to exit w'success

    # It all worked, so now add everything back into the message.
    #print STDERR "Dir is \"$dir\" and tnefname is \"$tnefname\"\n";

    return 1
      unless MailScanner::Config::Value('replacetnef',$message) =~ /[12]/;

    my $dirh = new DirHandle $dir;
    return 0 unless defined $dirh;
    my($type, $encoding);
    $message->{entity}->make_multipart;
    my($safename, @replacements);
    while (defined($_ = $dirh->read)) {
      #print STDERR "Directory entry is \"$_\" in \"$dir\"\n";
      next unless -f "$dir/$_";
      next if $_ eq $tnefname;
      #next if /^msg[\d-]+\.txt$/;
      $safename = $message->MakeNameSafe($_, $dir);
      if (/^msg[\d-]+\.txt$/) {
        ($type, $encoding) = ("text/plain", "8bit");
      } else {
        ($type, $encoding) = ("application/octet-stream", "base64");
        if ($safename ne $_ && -f "$dir/$_") {
          #print STDERR "Renaming '$dir/$_' to '$dir/$safename'\n";
          my $dangerous = quotemeta $_;
          rename "$dir/$dangerous", "$dir/$safename";
        }
      }
      push @replacements, $safename;
      $message->{entity}->attach(Type => $type,
                                 Encoding => $encoding,
                                 Disposition => "attachment",
                                 Filename => $safename,
                                 Path => "$dir/$_");
      $message->{bodymodified} = 1;
      $message->{foundtnefattachments} = 1;
    }
    undef $dirh;
    #$message->{entity}->dump_skeleton();

    MailScanner::Log::InfoLog("Message %s added TNEF contents %s",
                              $message->{id}, join(',', @replacements))
      if @replacements;

    return 1; # Command succeded and terminated
  }
}

1;