#
# 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;
syntax highlighted by Code2HTML, v. 0.9.1