#!/usr/bin/perl -T

#
# Author:  Chris Mason <cmason@unixzone.com>
# Current maintainer: Lars Hecking <lhecking@users.sourceforge.net>
#
# Based on work by:
#       Mogens Kjaer, Carlsberg Laboratory, <mk@crc.dk>
#       Juergen Quade, Softing GmbH, <quade@softing.com>
#       Christian Bricart <shiva@aachalon.de>
#
# This script is part of the AMaViS package.  For more information see:
#
# http://amavis.org/
#
# Copyright (C) 2000 the people mentioned above
#
#
# This software is licensed under the GNU General Public License (GPL)
# See:  http://www.gnu.org/copyleft/gpl.html
#


use strict;
use MIME::Parser;
use POSIX qw(strftime geteuid setuid uname);
use Fcntl;
use Fcntl ':flock';
use Unix::Syslog qw(:macros :subs);
use IO::File;
use IO::Pipe;
use Convert::TNEF;
use Convert::UUlib ':all';
use Compress::Zlib;
use Archive::Tar;
use Archive::Zip qw ( :ERROR_CODES );
use File::Basename;


#
# main()
#

package main;

# Av scanners init section
# Moved towards the top by popular request.

# NAI AntiVirus (uvscan)
#my $uvscan = "/usr/local/bin/uvscan";
#my $uvscan_args = "--secure -rv --summary --noboot";
#my $uvscan_exitcode = "13";
my $uvscan = "";
my $uvscan_args = "";
my $uvscan_exitcode = "";

# H+BEDV AntiVir
my $antivir = "";

# Sophos Anti Virus (sweep)
my $sophos = "";
my $sophos_ide = "";

# KasperskyLab AntiViral Toolkit Pro (AVP)
my $avp = "";
my $AVPDIR = dirname($avp);

# KasperskyLab AVPDaemon / AvpDaemonClient
#
# use AvpDaemon and AvpDaemonClient
# Note: AvpDaemon must be started before using
# this script! AvpDaemon should be started at
# boot time as AvpDaemon -* /var/tmp
my $avpdc = "";

# F-Secure Antivirus
my $fsav = "";

# Trend Micro FileScanner
my $vscan = "";

# CyberSoft VFind
my $vfind = "";

# CAI InoculateIT
my $inocucmd = "";

# GeCAD RAV Antivirus 8
my $rav = "";

# ESOFT NOD32
my $nod32 = "";

# Command AntiVirus for Linux
my $csav = "";

# FRISK F-Prot
my $fprot = "/usr/local/bin/f-prot";
my $fprot_args = "-DUMB -ARCHIVE";

my $maildrop = 1;

# End av scanners init section

#
# Define various constants
#

# If $TESTING is yes, no mail is sent at all.  MIME decomposition
# and virus scanning will still be done, and the complete message
# is printed to STDOUT if no virus was found. Otherwise, amavis
# returns an exit status of 2.
my $TESTING = "no";

# Create debugging output
my $DEBUG = "no";

#
# Logging related
my $DO_SYSLOG = "yes";
my $LOGDIR = "/var/log/amavis";
my $LOGFILE = "amavis.log";
my $log_level = 4;

use vars '$log';

my $SYSLOG_LEVEL = "mail.info";
my ($FACILITY, $PRIORITY);

# Should infected mail be quarantined?
my $virusbackup = "yes";

# Location to put infected mail
my $QUARANTINE = "/var/spool/quarantine";
#my $QUARANTINE = "";
use vars qw($VIRUSFILE $viruslist @virusname);

# Notification
my $warnadmin = "no";
my $warnrecip = "no";
my $warnsender = "no";

# Add X-Virus-Scanned line to mail?
my $X_HEADER = "yes";
my $X_HEADER_TAG = "X-Virus-Scanned";
my $X_HEADER_LINE = "by AMaViS perl-11";

#
my $pkg_home_url = "http://amavis.org/";

# Do we use amavis on a mail relay/gateway type setup?
my $enable_relay = "yes";

#
# MTA related

# What sendmail wrapper to use
my $sendmail_wrapper = "/usr/sbin/sendmail";
#my $sendmail_wrapper_args = "-C /etc/mail/sendmail.orig.cf -i -t";
my $sendmail_wrapper_args = "-t";

# Qmail-specific
my $QMAILDIR = "/bin";

# postfix-specific
my $enable_smtp = "";
my $smtp_port = "NOT_SET";         

# sendmail-specific
my $sendmail_cf_orig = "/etc/mail/sendmail.orig.cf";

# Error codes
my ($VIRUSERR, $REGERR);

# Set path explictly.  Don't trust environment
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Seed random generator
srand (time() ^ ($$+($$<<15)));

# Temporary directory
# Moved this above MTA init section because milter init sets TEMPDIR
my $TEMPBASE = "/var/log/amavis";
use vars '$TEMPDIR';

#
# MTA init section
#

# sendmail

# error codes
$VIRUSERR = 0;
#$REGERR = 75;   # EX_TEMPFAIL from sendmail sysexists.h
$REGERR = 0;   # maildorp requires 'xfilters' to return 0

# suid?
if (setuid(0) == -1) {
	exit($REGERR)
}

# set path explicitly
$ENV{PATH} = "/bin:/usr/bin:/usr/local/bin";

# End sendmail
#
# End MTA init section
#

# Where to send virus reports
my $mailto = 'virusalert';

# Who reports are sent from
my $mailfrom = 'postmaster@amigo.net';

# Various external programs
# (perl modules do not exist for these yet)
my $file = "/usr/bin/file";
my $uncompress = "/usr/bin/uncompress";
my $bunzip = "/usr/bin/bunzip2";
my $unrar = "/usr/local/bin/unrar";
my $lha = "/usr/local/bin/lha";
my $arc = "/usr/local/bin/arc";
my $zoo = "/usr/local/bin/zoo";
my $unarj = "/usr/local/bin/unarj";
# need this for local delivery with postfix
my $procmail = "";

# Set maximum recursion level for extraction/decoding
my $MAXLEVELS = 20;

umask(0077);

# Prepare for logging
# Log either to syslog or a file

if ($DO_SYSLOG eq "yes") {
	($FACILITY = $SYSLOG_LEVEL) =~ s/(\w+)\.(\w+)/LOG_\U$1/;
	($PRIORITY = $SYSLOG_LEVEL) =~ s/(\w+)\.(\w+)/LOG_\U$2/;
	openlog("amavis", LOG_PID, eval "$FACILITY");
} else {
	$log = new IO::File;
	$log->open(">>$LOGDIR/$LOGFILE") || do_exit($REGERR, __LINE__);
}

# Already set by milter
if ($TEMPDIR eq "") {
	# The chances for this looping infinitely should be quite small ...
	MKTMPDIR: {
		$TEMPDIR = sprintf "%s/amavis-%08d", $TEMPBASE, int(rand 2**24-1)+1;
		mkdir($TEMPDIR, 0700) || do { do_log(4, "Can't make $TEMPDIR: $!"); goto MKTMPDIR;}
	}
}

mkdir("$TEMPDIR/parts", 0700) || do_exit($REGERR, __LINE__);

do_log(0,"starting.  amavis perl-11 Mon Jan 20 10:32:59 MST 2003");

chdir($TEMPBASE) || do_exit($REGERR, __LINE__);

# Read in mail message and save to file; this file is moved
# to a quarantine area if a virus was found
# Note: to get the qmail config working again, we now read the
# actual message (STDIN) before the envelope information (STDOUT)
use vars qw($fh $BUFSIZE $buf);

if (-r "$TEMPDIR/email.txt") {
	# already created by milter, just open it
	$fh = IO::File->new("$TEMPDIR/email.txt") || do_exit($REGERR, __LINE__);
} else {
	$fh = IO::File->new("+>$TEMPDIR/email.txt") || do_exit($REGERR, __LINE__);
	$BUFSIZE = 8192;
	$buf = ' ' x $BUFSIZE;
	while (read(\*STDIN, $buf, $BUFSIZE)) {
		print $fh $buf;
	}
}

# Determine sender and recipient(s)
# For sendmail, also get the "real" local delivery agent

use vars qw($recipline $SENDER @RECIPS $LDA @LDAARGS);

# command line parsing, sendmail version

if ($enable_relay eq "no") {

	if ($#ARGV < 3) {
		do_log(0, "Missing arguments to sendmail");
		do_exit($REGERR, __LINE__);
	}

	# Depending in the F= equate in the local mailer definition,
	# sendmail may prepend -f $g or -r $g to the local mailer
	# cmd line args
	#
	# If so, strip it off, and add it back in front of the remaining
	# arguments after we shift out the sender, recipient and LDA

	my $minusf = "";
	my $minusr = "";
	if ($ARGV[0] eq "-f") {
		if ($#ARGV < 5) {
			do_log(0, "Missing arguments to sendmail"); 
			do_exit($REGERR, __LINE__);
		}

		shift @ARGV;
		$minusf = shift @ARGV;
	} elsif ($ARGV[0] eq "-r") {
                if ($#ARGV < 5) {
                        do_log(0, "Missing arguments to sendmail");
                        do_exit($REGERR, __LINE__);
                }                                       

		shift @ARGV;
		$minusr = shift @ARGV;
	}

	$SENDER = shift @ARGV;
	push(@RECIPS, shift @ARGV);
	$LDA = shift @ARGV;
	@LDAARGS = @ARGV;

	if ($minusf ne "") {
		unshift(@LDAARGS, $minusf);
		unshift(@LDAARGS, "-f");
	} elsif ($minusr ne "") {
		unshift(@LDAARGS, $minusr);
		unshift(@LDAARGS, "-r");
	}

} else {
	# relay config

	if ($#ARGV < 1) {
		do_log(0,"Missing arguments to sendmail");
		do_exit($REGERR, __LINE__);
	}

	$SENDER = shift @ARGV;
	push(@RECIPS, @ARGV);
	$LDA = $sendmail_wrapper;
	push(@LDAARGS, "-i") if not $maildrop;
	push(@LDAARGS, "-C$sendmail_cf_orig") if not $maildrop;
	push(@LDAARGS, "-f<$SENDER>");
	push(@LDAARGS, "@RECIPS");
}

# End sendmail cmd line parsing

# Handle empty sender address
$SENDER = "<>" if ($SENDER eq "");

# The same file also serves as input to the parser!
$fh->flush();
$fh->seek(0,0);

# Must be global
use vars qw($entity $output $errval);

parse_decode($fh);
virus_scan();
forward_mail();

# Shouldn't get here
do_exit($REGERR, __LINE__);

#
# Subroutines
#

#
# Run virus scanner(s)
sub virus_scan {
	#
	# Okay, now we scan for viruses
	#
	# If we find one, send mail right away and quit.  No point scanning any
	# more once we've found one.
	#



#
# McAfee
# 

if ($uvscan ne "") {
	$output = `$uvscan $uvscan_args $TEMPDIR/parts`;
	$errval = ($? >> 8);
	do_log(2,$output);
	if ($errval != 0) {
		if ($errval == $uvscan_exitcode) {
			my $loutput = $output;
			$loutput =~ s/Found: (.+) NOT a/Found the $1/g;
			$loutput =~ s/Found the (.+) trojan/Found the $1 virus/g;
			$loutput =~ s/Found virus or variant (.+) /Found the $1 virus/g;
			@virusname = ($loutput =~ /Found the (.+) virus/g);
			do_virus($output);
       	 } else {
			do_log(0,"Virus scanner failure: $uvscan (error code: $errval)");
		}
	}
}



#
# F-Prot Antivirus/Linux
#

if ($fprot) {
    do_log(2,"Using $fprot");
    chop($output = `$fprot $fprot_args $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0 || $errval == 8) {		# no errors, no viruses found
	#$scanner_errors = 0;
    } elsif ($errval == 3 || $errval == 6) {	# no errors, viruses discovered
	#$scanner_errors = 0;
	@virusname = ($output =~ /Infection: (.+)/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus($output); # do_virus();
    } else {
	do_log(0,"Virus scanner failure: $fprot (error code: $errval)");
    }
}







}

#
# Forward original message
sub forward_mail {
	my $seen_xheader = 0;
	$seen_xheader = 1 if ($X_HEADER eq "no");

	if ($TESTING ne "yes") {
	
	# sending mail, sendmail version
	# For sendmail, we call the "real" local delivery agent

	#open(MAIL, "|-") || exec($LDA, @LDAARGS);
	while (<$fh>) {
		next if ($seen_xheader == 0 && m/^$X_HEADER_TAG:/o);
		if ($seen_xheader == 0 && m/\A\r?\n\Z/) {
			#print MAIL "$X_HEADER_TAG" . ": " . "$X_HEADER_LINE\n";
		        print STDOUT "$X_HEADER_TAG" . ": " . "$X_HEADER_LINE\n";
			$seen_xheader = 1;
		}
		#print MAIL $_;
		print STDOUT $_;
	}

	#close(MAIL);

	# Pass up the LDA's error code
	do_exit($?, __LINE__);
	# End sendmail
	} else {
		# print complete msg to stdout
		while (<$fh>) {
			next if ($seen_xheader == 0 && m/^$X_HEADER_TAG:/o);
			if ($seen_xheader == 0 && m/\A\r?\n\Z/) {
				print "$X_HEADER_TAG" . ": " . "$X_HEADER_LINE\n";
				$seen_xheader = 1;
			}
			print $_;
		}
		do_exit(0, __LINE__);
	}
}

#
# If virus found
sub do_virus(@) {
	# AV scanner output
	my $output = shift;

	$viruslist = join("\n\t",@virusname),"\n";

	# Quarantine the original email message?
	if ($TESTING ne "yes") {
		if ($virusbackup eq "yes") {
			$VIRUSFILE = "virus-" . strftime("%Y%m%d-%H%M%S", localtime) . "-" . "$$";
			`mv $TEMPDIR/email.txt $QUARANTINE/$VIRUSFILE`;

			do_log(0,"Virus found - quarantined as $VIRUSFILE");
		} else {
			do_log(0,"Virus found - not quarantined");
		}

		# Then we send email
		warn_sender() if ($warnsender eq "yes");

		# warn_recip() is disabled by default because of possible
		# problems with mailing lists. Enable only if you know what
		# you're doing!
		warn_recip() if ($warnrecip eq "yes");

		# Notify admin
		warn_admin($output) if ($warnadmin eq "yes");

		maildrop_replace_message() if ($maildrop);

		# Finally, we bounce the message or pretend everything was okay,
		# depending on the MTA
		do_exit($VIRUSERR, __LINE__);
	} else {
		do_log(0,"Virus found - not quarantined");
		do_exit(2, __LINE__);
	}
}

#
# Notify sender
sub warn_sender() {
	return 0 if ($SENDER eq "<>");
	return 0 if ($entity->head->get("Precedence") =~ /bulk|list/i);

	open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom") || do_exit($REGERR, __LINE__);
	my $amavis_url = &amavisCredits();
	print MAIL <<"EOF";
From: $mailfrom
To: $SENDER
Subject: VIRUS IN YOUR MAIL

                           V I R U S  A L E R T

Our viruschecker found the

\t$viruslist

virus(es) in your email to the following recipient(s):

EOF
	foreach (@RECIPS) {
		print MAIL "-> $_\n";
	}
	print MAIL <<"EOF";

Please check your system for viruses, or ask your system administrator
to do so.
$amavis_url
For your reference, here are the headers from your email:

------------------------- BEGIN HEADERS -----------------------------
EOF
	$entity->print_header(\*MAIL);
	print MAIL <<"EOF";
-------------------------- END HEADERS ------------------------------

EOF
	close(MAIL);
}

#
# Notify admin
sub warn_admin() {
	my $output = shift;

	open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom") || do_exit($REGERR, __LINE__);
	$SENDER = "(empty address)" if ($SENDER eq "<>");
	print MAIL <<"EOF";
From: $mailfrom
To: $mailto
Subject: FOUND VIRUS IN MAIL from $SENDER

A virus was found in an email from:

$SENDER

The message was addressed to: 

EOF
	foreach (@RECIPS) {
		print MAIL "-> $_\n";
	}

	if ($virusbackup eq "yes") {
		print MAIL <<"EOF";

The message has been quarantined as:

$QUARANTINE/$VIRUSFILE
EOF
	}
	print MAIL <<"EOF";

Here is the output of the scanner:

$output

Here are the headers:

------------------------- BEGIN HEADERS -----------------------------
EOF
	$entity->print_header(\*MAIL);
	print MAIL <<"EOF";
-------------------------- END HEADERS ------------------------------

EOF
	close(MAIL);
}

#
# Notify recipient(s)
sub warn_recip() {
	foreach (@RECIPS) {
		open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom") || do_exit($REGERR, __LINE__);
		my $amavis_url = &amavisCredits();
		$SENDER = "(empty address)" if ($SENDER eq "<>");
		print MAIL <<"EOF";
From: $mailfrom
To: $_
Subject: VIRUS IN MAIL FOR YOU FROM $SENDER

                           V I R U S  A L E R T

Our viruschecker found the

\t$viruslist

virus(es) in an email to you from:

$SENDER

Delivery of the email was stopped!

Please contact your system administrator for details.

EOF
		if ($virusbackup eq "yes") {
			print MAIL <<"EOF";
The ID of your quarantined message is:

$VIRUSFILE

EOF
		}
		print MAIL <<"EOF";
$amavis_url
EOF
		close(MAIL);
	}
}

# Self-extracting archives and "data" need special treatment
# This is the final global variable declaration
use vars qw(%selfextract %filedata);

#
# amavis credits.  Can be disabled with --no-credits
# Called from the notification routines.
sub amavisCredits {
	if ("no" eq "yes") {
		return <<EOF;

For further information about this viruschecker see:

$pkg_home_url
AMaViS - A Mail Virus Scanner, licensed GPL

EOF
	}

	return "";
}

#
# Get ready to break up mime parts
sub parse_decode(@) {
	my $fileh = shift;
	my ($parser, $filer, %atomic);

	$parser = new MIME::Parser;
	$filer = MIME::Parser::FileInto->new("$TEMPDIR/parts");
	$filer->ignore_filename(1);
	$parser->filer($filer);
	$parser->extract_nested_messages("NEST");

	do_log(4,"Extracting mime components");

	$entity = $parser->parse($fileh);
	# cheat if input is not a mail message
	# this means that we can feed ordinary files to amavis
	if ($parser->last_error ne "") {
		link "$TEMPDIR/email.txt", "$TEMPDIR/parts/email.txt";
	}
	$fileh->seek(0,0);

	# Extract and decode each part to the extent possible

	for (my $i = 1; $i <= $MAXLEVELS; $i++) {
		do_log(4,"Level: $i");

		my @parts = `ls $TEMPDIR/parts`;
		chop(@parts);

		my $found = 0;
		foreach (@parts) {
			unless (defined $atomic{$_}) {
				if (decompose_part($_) == 1) {
					$found = 1;
				} else {
					$atomic{$_} = 1;
				}
			}
		}
		last if ($found == 0);
	}
}

#
# Decompose the parts
sub decompose_part(@) {
	my $part = shift;

	# $part should be safe because we generated the filenames ourselves
	# but let's be extra paranoid (and make taint happy)
	if ($part =~ /^([\w\d\-.]+)$/) {
		$part = $1;
	} else {
		do_log(0,"Unsafe partname $part");
		do_exit($REGERR, __LINE__);
	}

	my $filetype = `$file $TEMPDIR/parts/$part`;
	chop $filetype;
	do_log(4,"File-type of $part: $filetype");

	#
	if (defined $selfextract{$part}) {
		do_log(4,"Re-discovered self-extracting file $part");
		return 0;
	}

	#
	# If ASCII text, try multiple decoding methods as provided by UUlib
	# (includes uuencoding, xxencoding, Base64 and BinHex)
	#

	if ($filetype =~ /(ASCII|text|uuencoded|xxencoded|binhex)/i) {
		my ($retval, $count) = LoadFile("$TEMPDIR/parts/$part");
		if ($count > 0) {
			do_log(4,"Decoding part $part");

			SetOption (OPT_SAVEPATH, "$TEMPDIR/parts/");
			my $uuerror = 0;
			for (my $i = 0; my $uu = GetFileListItem($i); $i++) {
				if ($uu->state & FILE_OK) {
					my $newpart = "$TEMPDIR/parts/" . getfilename();
					$uu->decode($newpart);
					if (!$uu->state || !FILE_OK || -z $newpart) {
						$uuerror = 1;
					}
				}
			}
			if ($uuerror == 1) {
				return 0;
			} else {
				unlink("$TEMPDIR/parts/$part");
				return 1;
			}
		}
		return 0;
	}

	#
	# if gzipped use Zlib to inflate
	#

	if ($filetype =~ /gzip compressed/i) {
		do_log(4,"Inflating gzip archive $part");

		my $buffer;
		my $newpart = "$TEMPDIR/parts/" . getfilename();
		my $gz = gzopen("$TEMPDIR/parts/$part", "rb") || do_exit($REGERR, __LINE__);
		open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);

		while ($gz->gzread($buffer) > 0) {
			print(OUTPART $buffer);
		}
		close(OUTPART);

		if ($gzerrno != Z_STREAM_END) {
			unlink("$newpart");
			return 0;
		}
		unlink("$TEMPDIR/parts/$part");
		return 1;
	}

	#
	# if compress'd, use external "uncompress" program
	#

	if ($uncompress ne "" && $filetype =~ /compress'd/i) {
		do_log(4,"Uncompressing $part");

		my $newpart = "$TEMPDIR/parts/" . getfilename();
		system("cat $TEMPDIR/parts/$part | $uncompress >$newpart");

		if ($? != 0) {
			unlink($newpart);
			return 0;
		}
		unlink("$TEMPDIR/parts/$part");
		return 1;
	}

	#
	# if bzip'ed, use external bzip program.  There *is* a perl module for
	# bzip2, but it is not ready for prime time.
	#

	if ($bunzip ne "" && $filetype =~ /bzip2 compressed/i) {
		do_log(4,"Expanding bzip2 archive $part");

		my $newpart = "$TEMPDIR/parts/" . getfilename();
		system("cat $TEMPDIR/parts/$part | $bunzip >$newpart");

		if ($? != 0) {
			unlink($newpart);
			return 0;
		}
		unlink("$TEMPDIR/parts/$part");
		return 1;
	}

	#
	# untar any tar archives.  Extract each file individually and use our
	# own filenames.
	#

	if ($filetype =~ /tar archive/i) {
		do_log(4,"Untarring $part");

		my $tar = Archive::Tar->new("$TEMPDIR/parts/$part") ||
			do_exit($REGERR, __LINE__);

		my @list = $tar->list_files();

		foreach (@list) {
			unless (/.*\/$/) {		# Ignore directories
				my $data = $tar->get_content($_);
				my $newpart = "$TEMPDIR/parts/" . getfilename();
				open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
				print(OUTPART $data);
				close(OUTPART);
			}
		}
		unlink("$TEMPDIR/parts/$part");
		return 1;
	}

	#
	# unzip any zip files.
	#

	if ($filetype =~ /Zip archive/i) {
		do_log(4,"Unzipping $part");

		do_unzip($part);
		return 1;
	}

	#
	# Use external program to expand RAR archives
	#

	if ($unrar ne "" && $filetype =~ /RAR archive/i) {
		do_log(4,"Expanding RAR archive $part");

		do_unrar($part);
		return 1;
	}

	#
	# Use external program to expand LHA archives
	#

	if ($lha ne "" && $filetype =~ /LHA.*archive/i) {
		do_log(4,"Expanding LHA archive $part");

		do_lha($part);
		return 1;
	}

	#
	# Use external program to expand ARC archives
	#

	if ($arc ne "" && $filetype =~ /ARC archive/i) {
		do_log(4,"Unarcing $part");

		do_arc($part);
		return 1;
	}

	#
	# Use external program to expand ZOO archives
	#

	if ($zoo ne "" && $filetype =~ /Zoo archive/i) {
		do_log(4,"Expanding ZOO archive $part");

		do_zoo($part);
		return 1;
	}

	# Apparently, file 3.32 has an entry for TNEF

	if ($filetype =~ /Transport Neutral Encapsulation Format/i) {
		do_log(4,"Extracting TNEF attachment $part");

		do_tnef($part);
		return 1;
	}

	# older versions of file report tnef files as data
	if ($filetype =~ /:\sdata$/) {
		# may be tnef

		# checked already?
		if (defined $filedata{$part}) {
			do_log(4,"Re-discovered data file $part");
			return 0;
		} else {
			do_log(4,"Extracting possible TNEF attachment $part");

			do_tnef($part);
			return 1;
		}
	}

	if ($unarj ne "" && $filetype =~ /ARJ archive/i) {
		do_log(4,"Expanding ARJ archive $part");

		do_unarj($part);
		return 1;
	}

	#
	# Check for self-extracting archives.  Note that we don't rely on
	# file magic here since it's not reliable.  Instead we will try each
	# archiver.
	#

	if ($filetype =~ /executable/i) {

		$selfextract{$part} = 1;

		# ZIP?
		return 1 if (do_unzip($part) == 1);

		# RAR?
		system("$unrar t -inul $TEMPDIR/parts/$part");
		if ($? == 0) {
			do_log(4,"Expanding self-extracting RAR file $part");

			do_unrar($part);
			return 1;
		}

		# LHA?
		my $checkerr = 0;
		open(LHA, "$lha lq $TEMPDIR/parts/$part 2>&1 |") || do_exit($REGERR, __LINE__);
		while(<LHA>) {
			if (/Checksum error/i) {
				$checkerr = 1;
			}
		}
		close(LHA);
		if ($? == 0 && $checkerr == 0) {
			do_log(4,"Expanding self-extracting LHA file $part");

			do_lha($part);
			return 1;
		}

		# Okay, nothing to extract.
		undef $selfextract{$part};
		return 0;
	}
}

#
# Generate unique filenames
{
	# Persistent and private
	my $filecount = 0;
	sub getfilename(@) {
		return sprintf("part-%05d", ++$filecount);
	}
}

#
# copy (binary) command output to a file handle
# args: filehandle to print to, command, command args ...
# Code adapted from Camel book, Chapter 3, syswrite
sub fh_copy(@) {
	my $fh = shift;
	my $blksize = (stat $fh)[11] || 16384;
	my ($len, $buf, $offset, $written);
	open(DATA, "-|") || exec @_;

	while ($len = sysread DATA, $buf, $blksize) {
		if (!defined $len) {
			next if $! =~ /^Interrupted/;
			do_log(0,"System read error: $!");
			do_exit($REGERR, __LINE__);
		}
		$offset = 0;
		while ($len) { # Handle partial writes.
			$written = syswrite $fh, $buf, $len, $offset;
			do_log(0,"System write error: $!") unless defined $written;
			$len -= $written;
			$offset += $written;
		}
	}
	close(DATA);
}

#
# minimal local error handler for Archive-Zip
sub myziperr {
	return 5;
}

#
# Uncompression/unarchiving routines

sub do_unzip(@) {
	my $part = shift;
	my $ziperr;
	my $zip = Archive::Zip->new();

	# Need to set up a temporary minimal error handler
	# because we now test inside do_zip whether the $part
	# in question is a zip archive
	Archive::Zip::setErrorHandler(\&myziperr);
	$ziperr = $zip->read("$TEMPDIR/parts/" . "$part");
	Archive::Zip::setErrorHandler(\&Carp::carp);
	$Carp::CarpLevel++;

	return 0 if ($ziperr != AZ_OK);

	my @list = $zip->memberNames();

	foreach (@list) {
		unless (/\/$/) {		# Ignore directories
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			# We don't trust any of the filenames in the zip
			# archive and always use our own.
			$zip->extractMember($_,$newpart);
		}
	}

	unlink("$TEMPDIR/parts/$part") unless (defined $selfextract{$part});
	return 1;
}

sub do_unrar(@) {
	my $part = shift;

	my @list;

	# We have to jump through hoops because there is no simple way to
	# just list all the files

	open(INPART, "unrar v $TEMPDIR/parts/$part|");

	while(<INPART>) {
		last if /^------.*/;
	}
	while(<INPART>) {
		next if /^    .*/;
		last if /^------.*/;
		chop;

		s/^ //;
		push(@list, $_);
	}
	close(INPART);

	foreach (@list) {
		unless (/.*\/$/) {		# Ignore directories
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
			fh_copy(\*OUTPART, "$unrar", "p", "-inul", "$TEMPDIR/parts/$part", "$_");
			close(OUTPART);
		}
	}

	unlink("$TEMPDIR/parts/$part") unless (defined $selfextract{$part});
}

sub do_lha(@) {
	my $part = shift;

	my @list;

	open(INPART, "$lha lq $TEMPDIR/parts/$part|");
	while(<INPART>) {
		chop;
		my @vals = split(/\ \ */);

		push(@list, $vals[7]);
	}
	close(INPART);

	foreach (@list) {
		unless (/.*\/$/) {		# Ignore directories
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
			fh_copy(\*OUTPART, "$lha", "pq", "$TEMPDIR/parts/$part", "$_");
			close(OUTPART);
		}
	}

	unlink("$TEMPDIR/parts/$part") unless (defined $selfextract{$part});
}

sub do_arc(@) {
	my $part = shift;

	my @list = `$arc ln $TEMPDIR/parts/$part`;
	chop @list;

	foreach (@list) {
		unless (/.*\/$/) {		# Ignore directories
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
			fh_copy(\*OUTPART, "$arc", "p", "$TEMPDIR/parts/$part", "$_");
			close(OUTPART);
		}
	}
	unlink("$TEMPDIR/parts/$part");
}

sub do_zoo(@) {
	my $part = shift;

	# Zoo needs extension of .zoo!
	symlink("$TEMPDIR/parts/$part", "$TEMPDIR/parts/$part.zoo");

	my @list = `$zoo lf1q $TEMPDIR/parts/$part`;
	chop @list;

	foreach (@list) {
		unless (/.*\/$/) {		# Ignore directories
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
			fh_copy(\*OUTPART, "$zoo", "xpq:", "$TEMPDIR/parts/$part", "$_");
			close(OUTPART);

		}
	}
	unlink("$TEMPDIR/parts/$part.zoo");
	unlink("$TEMPDIR/parts/$part");
}

sub do_unarj(@) {
	my $part = shift;

	# unarj needs extension of .arj!
	symlink("$TEMPDIR/parts/$part", "$TEMPDIR/parts/$part.arj");

	# unarj has very limited extraction options!  This may not be secure!
	mkdir("$TEMPDIR/arj", 0700);
	chdir("$TEMPDIR/arj");
	system("$unarj e $TEMPDIR/parts/$part > /dev/null");

	my @list = `ls $TEMPDIR/arj`;
	chop(@list);

	foreach (@list) {
		my $newpart = "$TEMPDIR/parts/" . getfilename();
		system("mv", "$_", "$newpart");
	}
	chdir("$TEMPBASE");
	system("rm -rf $TEMPDIR/arj");
	unlink("$TEMPDIR/parts/$part.arj");
	unlink("$TEMPDIR/parts/$part");
}

sub do_tnef(@) {
	my $part = shift;

	chdir("$TEMPDIR/parts");

	my $tnef = Convert::TNEF->read_in($part,{ignore_checksum=>"true"});

	if ($tnef) {
		for ($tnef->attachments) {
			my $newpart = "$TEMPDIR/parts/" . getfilename();

			open(OUTPART, ">$newpart") || do_exit($REGERR, __LINE__);
			print OUTPART $_->data;
			close(OUTPART);
		}

		$tnef->purge;

		unlink("$TEMPDIR/parts/$part");
	} else {
		# Not TNEF
		$filedata{$part} = 1;
	}

	chdir("$TEMPBASE");
}

#
# Locking/logging/exiting

sub do_log(@) {
	my $level = shift;
	my $errmsg = shift;
	# create syslog-alike
	my $datestamp = strftime("%b %e %H:%M:%S", localtime);
	my $hostname = (uname)[1];
	my $line = "$datestamp $hostname amavisd[$$]: $errmsg\n";

	if ($DEBUG ne "yes") {
		if ($level <= $log_level) {
			if ($DO_SYSLOG eq "yes") {
				syslog(eval "$PRIORITY", "%s", $errmsg);
			} else {
				lock($log);
				print($log $line);
				unlock($log);
			}
		}
	} else {
		# Log everything, regardless of level
		print STDERR $line;
	}
}

sub lock(@) {
	my $file = shift;
	flock($file, LOCK_EX) || do_exit($REGERR, __LINE__);
	seek($file, 0, 2) || do_exit($REGERR, __LINE__);
}

sub unlock(@) {
	my $file = shift;
	flock($file, LOCK_UN) || do_exit($REGERR, __LINE__);
}

sub do_exit(@) {
	my $code = shift;
	my $line = shift;

	do_log(0,"do_exit:$line - ending execution with $code");

	$fh->close() if ($fh);

	system("rm -rf $TEMPDIR") if ($TEMPDIR ne "" && -d $TEMPDIR);

	if ($DO_SYSLOG eq "yes") {
		closelog();
	} else {
		$log->close();
	}

	exit($code);
}

#
sub retcode($) {

    use POSIX qw ( strftime geteuid setuid uname setsid
		   WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED );
    my $code = shift;

    return WEXITSTATUS($code) if WIFEXITED($code);
    return 128+WTERMSIG($code) if WIFSIGNALED($code);
    return 255;
}

sub maildrop_replace_message
{
    printf STDOUT (<<"EOF",
From: $mailfrom
Subject: VIRUS DETECTED FROM %s

                           V I R U S  A L E R T

Our virus scanner found the

\t%s

virus%s in a message to you. The message has been deleted.

For your reference, here are the SMTP envelope originator
and headers from the email:

------------------------- BEGIN HEADERS -----------------------------
EOF

		 # [still within printf syntax!]:
		 $SENDER, #sanitize_str($SENDER),
		 join(", ", @virusname), #join(", ", map(sanitize_str($_), @virusname)),
		 (@virusname==1?"":"es")
		 ) or die "maildrop_replace_message: printf failed: $!";

    $entity->print_header(\*STDOUT);

    print STDOUT <<"EOF" or die "maildrop_replace_message: print failed: $!";
-------------------------- END HEADERS ------------------------------

EOF


    close(STDOUT) or die "maildrop_replace_message: close failed: $?";
}