#!/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 - 2003 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
  WEXITSTATUS WIFEXITED WTERMSIG WIFSIGNALED );
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 ( :CONSTANTS :ERROR_CODES );
use File::Basename;
use File::Copy;


#
# main()
#

package main;

#
# We define all variables first; they can be customised in the next section.
#

#
# AV scanner related

# Av scanners and related vars
use vars qw ( $antivir $avp $avpdc $AVPDIR $clamscan $clamd $csav $drweb $fprot
  $fprotd $fsav $ikarus $inocucmd $mks $nod32 $nod32cli $norman $oav $panda
  $rav $sophos $sophos_ide_path $cscmdline $scs_host $scs_port $uvscan $vbengcl
  $vexira $vfind $vscan $sophie_sockname $trophie_sockname );

#
# Logging/debugging/testing related

use vars qw ( $DO_SYSLOG $SYSLOG_LEVEL $FACILITY $PRIORITY
  $LOGDIR $LOGFILE $loghandle $log_level $log_to_stderr
  $myname $nomail );
$SYSLOG_LEVEL = "mail.info";
$log_to_stderr = 0;
$nomail = 0;

#
# Notification etc.

use vars qw ( $QUARANTINEDIR $VIRUSFILE $X_HEADER_TAG $X_HEADER_LINE @virusname
  $warnadmin $warnsender $warnrecip $warn_offsite $requeue_on_scanner_errors
  @local_domains );

#
# External programs - unpackers, file
# (perl modules do not exist for these, or are not usable yet)

use vars qw ( $arc $bunzip $file $lha $uncompress );

#
# MTA and SMTP related

use vars qw ( $SENDER @RECIPS $LDA @LDAARGS $mailfrom $mailto
  $localhost_ip $localhost_name $smtp_port
  $enable_relay $sendmail_cf_orig $sendmail_wrapper $sendmail_wrapper_args
  $QMAILDIR );

#
# resource limits and other internals

use vars qw ( $MAXLEVELS $MAX_ARCHIVE_NESTING $MAXFILES $threshold 
  $TEMPBASE $TEMPDIR
  $some_compression $credits $pkg_home_url $fh );
$TEMPBASE = "/var/spool/amavis/runtime";
$some_compression = 0;
$pkg_home_url = "http://amavis.org/";

################################################################################
# Customisable variable from here on
################################################################################

#
# Av scanners

# NAI AntiVirus (uvscan)
$uvscan = "";

# H+BEDV AntiVir
$antivir = "";

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

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

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

# F-Secure Antivirus
$fsav = "";

# Trend Micro FileScanner
$vscan = "";

# CyberSoft VFind
$vfind = "";

# CAI InoculateIT
$inocucmd = "";

# GeCAD RAV Antivirus 8
$rav = "";

# ESET Software NOD32
$nod32 = "";

# ESET Software NOD32 (Client/Server Version)
$nod32cli = "";

# Command AntiVirus for Linux
$csav = "";

# VirusBuster (Daemon + Client)
$vbengcl = "";

# Symantec CarrierScan via Symantec Command Line Scannner
$cscmdline = "";
$scs_host = "";  # host/IP CarrierScan runs on
$scs_port = "";  # port CarrierScan listens on

# Sophie (Sophos SAVI)
$sophie_sockname = "";

# Trophie (Trend API)
$trophie_sockname = "";

# FRISK F-Prot
$fprot = "";

# FRISK F-Prot Daemon
$fprotd = "";

# Panda Antivirus for Linux
$panda = "";

# CentralCommand Vexira
$vexira = "";

# OpenAntiVirus ScannerDaemon
$oav = "";

# DrWeb Antivirus for Linux/FreeBSD/Solaris
$drweb = "";

# MkS_Vir for Linux (beta)
$mks = "";

# Norman Virus Control 
$norman = "";

# Clam Antivirus
$clamscan = "";

$clamd = "";

# Ikarus AntiVirus
$ikarus = "";

#
# Logging

# yes - syslog, no - file logging
$DO_SYSLOG = "yes";

# Directory to put log entries (if not using syslog)
$LOGDIR = "/var/spool/amavis/runtime";
$LOGFILE = "amavis.log";

# 0: default - startup/exit/failure messages
# 1: args passed from client
# 2: virus scanner output
# 3: server client
# 4: decompose parts
$log_level = 0;

#
# Notification etc.

# Notify admin/sender/recipient?
$warnadmin = "yes";
$warnsender = "no";
$warnrecip = "yes";

# Notify off-site recipients?
$warn_offsite = "no";

# requeue if all virus scanners failed
$requeue_on_scanner_errors = "yes";

# List of local domains
# e.g. @local_domains = qw( dom.ain other.dom.ain );
@local_domains = qw();

if (open LOCALDOMAIN_FILE,'/etc/amavis-localdomains.conf') {
        @local_domains = <LOCALDOMAIN_FILE>;
        chomp @local_domains;
        close LOCALDOMAIN_FILE;
}

# Location to put infected mail - empty for not quarantining
$QUARANTINEDIR = "/var/spool/amavis/virusmails";

# Add X-Virus-Scanned line to mail?
$X_HEADER_TAG = "X-Virus-Scanned";
# Leave empty to add no header
$X_HEADER_LINE = "by AMaViS 0.3.12";

#
# External programs

$arc = "/usr/bin/nomarch";
$bunzip = "/usr/bin/bunzip2";
$file = "/usr/bin/file";
$lha = "/usr/bin/lha";
$uncompress = "/usr/bin/uncompress";

#
# MTA specific stuff

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

# postfix-specific
$smtp_port = "10025";
$localhost_name = "localhost";
$localhost_ip = "127.0.0.1";

# sendmail-specific
# Do we use amavis on a mail relay/gateway type setup?
$enable_relay = "no";

#
$sendmail_cf_orig = "";

# What sendmail wrapper to use
$sendmail_wrapper = "/usr/lib/sendmail";
$sendmail_wrapper_args = "-i -t";

#
# Misc

# The next three are resource limitations - exit with EX_TEMPFAIL if exceeded
# Maximum overall recursion level for extraction/decoding
# default: 20 - DO NOT SET THIS TO 0
$MAXLEVELS = 20;

# Maximum nesting level for compressing archive formats
# default: 3. If set to 0, feature is disabled
$MAX_ARCHIVE_NESTING = 3;

# Maximum number of extracted files
# default: 500. If set to 0, feature is disabled
$MAXFILES =  500;

# Magic number to detect DoS attacks
# default: 14. if set to 0, feature is disabled (change with care!)
$threshold = 14;

# Who reports are sent from
$mailfrom = 'postmaster';

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

# Display AMaViS credits to users
$credits = "no";

################################################################################
# End of customisation section
################################################################################

#
# MTA init section
# Error codes - defined below
use vars qw ( $VIRUSERR $REGERR );
#

# postfix

# error codes
$VIRUSERR = 0;
$REGERR = 75;   # EX_TEMPFAIL from sendmail sysexits.h

# don't run suid

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

# End postfix
#
# End MTA init section
#

use vars qw($BUFSIZE $buf);
use vars qw($recipline);

# MIME entity, av scanner output and return status
use vars qw($entity $output $errval);

# not really a loop ...
sub main_loop() {
    my($which_section) = "initialization";
    my($sts);

    eval {

	# Already set by milter
	make_tempdir() if (!$TEMPDIR);

	mkdir("$TEMPDIR/parts", oct('700'))
	    or die "Can't create directory $TEMPDIR/parts: $!";
	chdir($TEMPBASE) or die "Can't chdir to $TEMPDIR: $!";

	# 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)

	# Save original email, or open file if already exists (milter)
	if (-r "$TEMPDIR/email.txt") {
	    # already created by milter, just open it
	    $fh = IO::File->new("$TEMPDIR/email.txt")
		or die "Can't open file $TEMPDIR/email.txt: $!";
	} else {
	    $fh = IO::File->new("+>$TEMPDIR/email.txt")
		or die "Can't create file $TEMPDIR/email.txt: $!";
	    $BUFSIZE = 8192;
	    $buf = ' ' x $BUFSIZE;
# TODO: safeguard against write errors
	    while (read(\*STDIN, $buf, $BUFSIZE)) {
		print $fh $buf;
	    }

	    # The same file also serves as input to the parser
	    $fh->flush() or die "Can't flush file $TEMPDIR/email.txt: $!";
	    $fh->seek(0,0) or die "Can't rewind file $TEMPDIR/email.txt: $!";

	}
    };

    if ($@ ne '') {
	chomp($@);
	do_log(0,"tmpdir creation failed, retry: $@");
	do_exit($REGERR, __LINE__);
    }

    # Determine sender and recipient(s)
    # For sendmail, also get the "real" local delivery agent
    # Note: for qmail, this must be done after reading the mail message,
    # see http://www.qmail.org/man/man8/qmail-queue.html


# command line parsing, postfix version

# we won't need any of this once amavis
# receives input from SMTP; but then,
# $SENDER and @RECIPS must be initialised
# from the SMTP dialogue

# need two args in any case
if ($#ARGV < 1) {
    do_log(0,"Missing arguments to postfix");
    do_exit($REGERR, __LINE__);
}

# optionally, we allow to use amavis with a -f <sender> flag
# to make invocation similar to sendmail
if ($ARGV[0] eq "-f") {
    # in this case, we need at least three args
    do_exit($REGERR, __LINE__) if ($#ARGV < 2);

    shift @ARGV;
}

$SENDER = shift @ARGV;
@RECIPS = @ARGV;

# End postfix cmd line parsing

    eval {

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

	$which_section = "decoding";	    parse_decode($fh);
	$which_section = "virus scanning";  virus_scan();
	$which_section = "mail forwarding"; $sts = forward_mail();

	$which_section = "finishing";
    };

    if ($@ ne '') {
	chomp($@);
	do_log(0,"$which_section failed, retry: $@ " . get_msg_id());
	do_exit($REGERR, __LINE__);
    }

    do_exit(0, __LINE__) if (!$sts);

    do_exit($REGERR, __LINE__)
}	

#
# Subroutines
#

# Run virus scanner(s)
sub virus_scan {
    # At least one scanner must work!
    #
    # If at least one scanner completes its job (either finding a virus
    # or declaring that files are safe), the value of $scanner_errors
    # will become 0, otherwise it remains true, meaning all of the
    # available scanners failed to run, or returned an error.
    my $scanner_errors = 1;

    #
    # 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.
    #


#
# OpenAntiVirus ScannerDaemon
#
use IO::Socket;
 
if ($oav) {
    do_log(2,"Using $oav");
    my $sock = IO::Socket::INET->new('127.0.0.1:8127');
    if (defined $sock) {
	$sock->print("SCAN $TEMPDIR/parts\n");
	$sock->flush;
	chomp($output = $sock->getline);
	$sock->close;
	do_log(2,$output);
	if ($output =~ /^FOUND: /) {		# no errors, a virus was found
	    $scanner_errors = 0;
	    @virusname = ($output =~ /FOUND: (.+)/g);
	    @virusname = (undef) if !@virusname;  # just in case: make list nonnil
	    do_virus();
	} elsif ($output =~ /^OK/) {		# no errors, no viruses
	    $scanner_errors = 0;
	} elsif ($output =~ /^ERROR/) {
	    do_log(0,"Virus scanner failure: ScannerDaemon - UNKNOWN STATUS (error code: $output)");
	}
    } else {
	do_log(0,"Virus scanner failure: ScannerDaemon - can't connect to daemon");
    }
}



#
# Clam Antivirus
#

if ($clamscan ne "") {
    do_log(2,"Using clamav");
    # --one-virus is only for esthetic reasons.
    chop($output = `$clamscan --stdout -r -w --one-virus $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) { # no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) { # no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /.*: (.+) FOUND/g);
	do_virus($output);
    } else {
	do_log(0,"Virus scanner failure: $clamscan (error code: $errval)");
    }
}

#
# ClamAV Daemon
#
use IO::Socket;

if ($clamd) {
    do_log(2,"Using clamd");
    my $sock = IO::Socket::INET->new('127.0.0.1:3310');
    if (defined $sock) {
	$sock->print("SCAN $TEMPDIR/parts\n");
	$sock->flush;
	chomp($output = $sock->getline);
	$sock->close;
	do_log(2,$output);
	if ($output =~ /FOUND$/) {	# no errors, a virus was found
	    $scanner_errors = 0;
	    @virusname = ($output =~ /: (.+) FOUND/g);
	    return 1;  # 'true' indicates virus found and stops further checking
	} elsif ($output =~ /OK$/) {            # no errors, no viruses
	    $scanner_errors = 0;
	} elsif ($output =~ /ERROR$/) {
	    do_log(0,"Virus scanner failure: ScannerDaemon - UNKNOWN STATUS (error code: $output)");
	}
    } else {
	do_log(0,"Virus scanner failure: Clamd - can't connect to daemon");
    }
}

#
# KasperskyLab AVP
#

if ($avp) {
    do_log(2,"Using $avp");
    chdir($AVPDIR) or die "Can't chdir to $AVPDIR: $!";
    chop($output = `$avp -* -P -B -Y -O- $TEMPDIR/parts`);
    $errval = retcode($?);
    chdir($TEMPBASE) or die "Can't chdir back to $TEMPBASE $!";
    do_log(2,$output);
    if ($errval == 0) {				# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 3 || $errval == 4) {	# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /infected: (.+)/g);
	@virusname = (undef)  if !@virusname;	# just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $avp (error code: $errval)");
    }
}

#
# KasperskyLab AVPDaemonClient
#

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

#
# CAI InoculateIT
#

if ($inocucmd) {
    do_log(2,"Using $inocucmd");
    chop($output = `$inocucmd -sec -nex $TEMPDIR/parts/*`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 100) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /was infected by virus (.+)/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $inocucmd (error code: $errval)");
    }
}

#
# Command AntiVirus for Linux
#

if ($csav) {
    do_log(2,"Using $csav");
    chop($output = `$csav -all -archive -packed $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 50) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval >= 51 || $errval <= 53) {	# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /Infection: (.+)/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $csav (error code: $errval)");
    }
}

#
# CyberSoft VFind
#

if ($vfind) {
    do_log(2,"Using $vfind");
    chop($output = `$vfind -vexit $TEMPDIR/parts/*`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 23) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /##==>>>> VIRUS ID: CVDL (.+)/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $vfind (error code: $errval)");
    }
}

#
# DrWeb for Linux
#

if ($drweb) {
    do_log(2,"Using $drweb");
    chop($output = `$drweb -al -ar -fm -go -ha -ml -ni -ot -sd -up $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /infected with (.+)/g);
	do_virus($output);
    } else {
	do_log(0,"Virus scanner failure: $drweb (error code: $errval)");
    }
}

#
# F-Prot Antivirus/Linux
#

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

#
# FRISK F-Prot Daemon
# (should work now - hopefully ...)
#

use IO::Socket;
$|=1; 	# autoflush on

if ($fprotd) {
	do_log(2, "Using $fprotd");
	opendir(DIR, "$TEMPDIR/parts/")
           or die "Can't open directory $TEMPDIR/parts/: $!";
	my @files = grep { -f "$TEMPDIR/parts/$_" } readdir(DIR);               
	closedir(DIR) or die "Can't close directory: $!";
	chomp(@files);

        foreach my $file (@files) {
	    if ($file =~ /^([\w\d\-.]+)$/) {
		$file = $1;
	    } else {
		die "Unsafe partname $file";
	    }
	    $file = "$TEMPDIR/parts/$file";

	    my $sock;
	    for (my $port = 10200; not defined $sock and $port <= 10204; $port++) {
	         $sock = IO::Socket::INET->new("127.0.0.1:$port");
            }
	    if (!defined $sock) {
		do_log(0, "Virus scanner failure: F-Prot Daemon - can't connect to daemon");
		last;
	    }
	    $sock->print("GET $file?-dumb%20-archive HTTP/1.0\r\n\r\n");
	    chomp($output = join('', $sock->getlines));
	    close($sock);
	    do_log(2, $output);
	    last if ( $output =~ /<summary(.+)>infected|error<\/summary>/i );
	}

	if ( $output =~ /<summary(.+)>infected<\/summary>/i ) {
	    @virusname = ($output =~ /<name>(.+)<\/name>/g);
	    @virusname = (undef) if !@virusname;  # just in case: make list nonnil
	    $scanner_errors = 0;	# no errors, a virus was found
	    do_virus($output);
	} elsif ( $output =~ /<summary(.+)>error<\/summary>/i ) {
	    my @error_reason = ($output =~ /<error>(.+)<\/error>/i);
	    @error_reason = (undef) if !@error_reason;  # just in case: make list nonnil	
	    do_log(0, "Virus scanner failure: F-Prot Daemon - " . shift @error_reason);
	} elsif ( $output =~ /<summary(.+)>clean<\/summary>/i ) {
	    $scanner_errors = 0;        # no errors, no viruses
	}
}

#
# F-Secure Antivirus/Linux
#

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

#
# H+B EDV AntiVir
#

if ($antivir) {
    do_log(2,"Using $antivir");
    chop($output = `$antivir -allfiles -noboot -s -z $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	# AntiVir < 2.0.4
	if ( $output =~ /VIRUS:/ ) {
	    @virusname = ($output =~ /VIRUS: .* virus (.+)/ig);
	# AntiVir > 2.0.4
	} elsif ( $output =~ /ALERT:/ ) {
	    @virusname = ($output =~ /ALERT: \[(\S+)\s.*?\]/g);
	}
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $antivir (error code: $errval)");
    }
}

#
# Ikarus AntiVirus 
#

if ($ikarus) {
    do_log(2,"Using $ikarus");
    chop($output = `$ikarus $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {		# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 40) {	# no errors, viruses/suspicious files discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /Signature (.+) found/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {	# interrupted or some error preventing further execution
	do_log(0,"Virus scanner failure: $ikarus (error code: $errval)");
    }
}

#
# MkS_Vir for Linux (beta)
#

if ($mks) {
    do_log(2,"Using $mks");
    chop($output = `$mks -e -c $TEMPDIR/parts/* 2>&1`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /--(.+)/g);
	do_virus($output);
    } else {
	do_log(0,"Virus scanner failure: $mks (error code: $errval)");
    }
}

#
# McAfee
# 

if ($uvscan) {
    do_log(2,"Using $uvscan");
    chop($output = `$uvscan --secure -rv --summary --noboot $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 13) {		# no errors, viruses discovered
	$scanner_errors = 0;
	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;
	$loutput =~ s/Found trojan or variant (.+) /Found the $1 virus/g;
	@virusname = ($loutput =~ /Found the (.+) virus/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $uvscan (error code: $errval)");
    }
}

#
# ESET Software NOD32
# preliminary support
# tested with NOD32/Linux 1.011
#
if ($nod32) {
    do_log(2,"Using $nod32");
    # as of version 1.011, NOD32 spits out control characters and
    # other screen-oriented garbage even if stdout is *not*
    # connected to a terminal. The log file, however, is clean.
    chop($output = `$nod32 -all -subdir+ $TEMPDIR/parts`);
    $errval = retcode($?);
    # I hope E-SET will correct bugs, so don't mess up with
    # temporary files for logging etc., and hack to filter
    # nonprinting characters in the output.
    $output =~ tr{\r}{\n};
    $output =~ s'[^[:print:]\n]+'';
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	# I also hope they will turn to something a bit more
	# descriptive than just "filename - virusname" ...
	@virusname = ($output =~ m{^$TEMPDIR/parts/.+ - (.+(?:backdoor|joke|trojan|virus|worm))}mg);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
    	# FIXME: Do these error conditions (from `strings nod32`)
	# fall in this category?
	#
        # - password protected file
        # - file compressed using unknown method
        # - wrong file checksum (CRC), may be damaged
        # - broken archive
        # - archive damaged and file can not be extracted
        # - can not find next archive volume
        # - not an archive file
        # - problem encountered while loading an archive
        # - decompression not performed, check available memory and disk space
	#
	do_log(0,"Virus scanner failure: $nod32 (error code: $errval)");
    }
}

# List of Return Codes
#define NOD32_EXIT_CODE_OK               0
#define NOD32_EXIT_CODE_VIRUS            1
#define NOD32_EXIT_CODE_CLEANED          2
#define NOD32_EXIT_INTERNAL_ERROR        10


#
# ESET Software NOD32 - Client/Server Version
#

if ($nod32cli) {
    do_log(2,"Using $nod32cli");
    chop($output = `$nod32cli -a -r -d recurse --heur standard $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 10) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /.* infected: (.+)/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $nod32cli (error code: $errval)");
    }
}

# List of Return Codes
#define NOD32_EXIT_CODE_OK             0
#define NOD32_EXIT_CODE_NO_SERVER      1
#define NOD32_EXIT_CODE_INTERNAL_ERROR 2
#define NOD32_EXIT_CODE_VIRUS          10
#define NOD32_EXIT_CODE_CLEANED        11
#define NOD32_EXIT_CODE_SCANNING_ERROR 12


#
# Norman Virus Control v5 / Linux
# based on Norman Virus Control Version 5.33.00
# -c scan archive files, -l:0 do not generate an extra log file,
# -s scan sub dirs, -u do not stop when infection found 
#


if ($norman) {
    do_log(2,"Using $norman");
    chop($output = `$norman -cl -c -s -u $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /.* virus in .* -> \'(.+)\'/ig);
	@virusname = (undef) if !@virusname;   # just in case: make list nonnil
	do_virus($output);
    } else {
	do_log(0,"Virus scanner failure: $norman (error code: $errval)");
    }
}

#
# Panda
#

if ($panda) {
    do_log(2,"Using $panda");
    $ENV{TERM} = "vt100";
    chop($output = `$panda $TEMPDIR/parts -aut -eng -heu -nso -aex -nor -cmp < /dev/null`);
    $errval = retcode($?);
    # Clean the output file of control chars
    # Clean the escape sequences
    $output =~ s/\e\133(..)G/\n/g;
    $output =~ s/\e(.*?)[A-Z,a-z,>]//g;
    # Clean ^O
    $output =~ s/\017//g;
    # Clean ^H
    $output =~ s/\010(\010+?)\010/\010/g;
    $output =~ s/\010/\n/g;
    # Clean ^M
    $output =~ s/\015//g;
    do_log(2,$output);

    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } else {
	my $loutput = $output;
	my @numVirus = ($loutput =~ /Number of files infected............:(.+)/gm);
	if($numVirus[0] > 0) {
	    $scanner_errors = 0;
	    @virusname = ($output =~ /Found virus :(.+)/g);
	    @virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	    do_virus();
	} else {
	    do_log(0,"Virus scanner failure: $panda (error code: $errval)");
	}
    }
}

#
# GeCAD RAV AntiVirus 8
#
# NOTE: the command line switches changed with scan engine 8.5 !
#

if ($rav) {
    do_log(2,"Using $rav");
    chop($output = `$rav --all --archive --mail $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval && $errval > 1) {	# no errors, viruses discovered
	if ($errval == 2 || $errval == 3) {
	    $scanner_errors = 0;
	    @virusname = ($output =~ /Infected: (.+)/g);
	    do_virus();
	} else {
	    do_log(0,"Virus scanner failure: $rav (error code: $errval)");
	}
    }
}

# List of Return Codes
#FILE_OK              1
#FILE_INFECTED        2
#FILE_SUSPICIOUS      3
#FILE_CLEANED         4
#FILE_CLEAN_FAIL      5
#FILE_DELETED         6
#FILE_DELETE_FAIL     7
#FILE_COPIED          8
#FILE_COPY_FAIL       9
#FILE_MOVED           10
#FILE_MOVE_FAIL       11
#FILE_RENAMED         12
#FILE_RENAMED_FAIL    13

#NO_FILES             20

#ENG_ERROR            30
#SINTAX_ERR           31
#HELP_MSG             32
#VIR_LIST             33


#
# Sophos Anti Virus via Sophie
#
use IO::Socket;
$|=1;


if ($sophie_sockname) {
    do_log(2,"Using Sophie");
    socket(\*sock, AF_UNIX, SOCK_STREAM, 0)
      or die "Can't open socket to Sophie: $!";
    connect(\*sock, pack_sockaddr_un $sophie_sockname)
      or die "Can't connect to Sophie: $!";

    my $chkdir = "$TEMPDIR/parts/\n";
    defined syswrite(\*sock, $chkdir, length($chkdir))
      or die "syswrite to Sophie failed: $!";
    defined sysread(\*sock, $output, 256)
      or die "sysread from Sophie failed: $!";

    chomp($output);
    $output =~ s/[^\w\d\-._:\/]+//g;
    do_log(2,$output);

    close(\*sock) or die "Sophie socket close failed: $!";

    if ($output =~ m/^1/) {
	if ($output =~ m/^1:.*$/) {
	    @virusname = ($output =~ m/^1:'?(.*)'?$/g);
	}
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	$scanner_errors = 0;  # no errors, a virus was found
	do_virus();
    } elsif ($output == 0) {
	$scanner_errors = 0;  # no errors, no viruses
    } elsif ($output == -1) {
	do_log(0,"Virus scanner failure: Sophie - UNKNOWN STATUS (error code: $output)");
    } else {
	do_log(0,"Virus scanner failure: Sophie - OOOPS (error code: $output)");
    }
}

#
# Sophos Anti Virus
#

if ($sophos) {
    do_log(2,"Using $sophos");
    $ENV{SAV_IDE} = $sophos_ide_path if ($sophos_ide_path);
    chop($output = `$sophos -nb -f -all -rec -ss -sc -archive $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {		# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 3) {	# no errors, viruses discovered
	$scanner_errors = 0;
	my $loutput = $output;
	$loutput =~ s/Virus fragment/Virus/g;
	@virusname = ($loutput =~ /Virus (.+) found/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {	# interrupted or some error preventing further execution
	do_log(0,"Virus scanner failure: $sophos (error code: $errval)");
    }
}

#
# Symantec CarrierScan via Symantec CommandLineScanner
# TODO: avoid using CommandLineScanner by writing an own perl client
#

if ($cscmdline) {
    do_log(2, "Using $cscmdline");
    chop($output = `$cscmdline -a scan -i 1 -v -s $scs_host:$scs_port $TEMPDIR/parts`);
    do_log(2,$output);
    if ($output =~ /\nInfected: /) {		# no errors, virus discovered
        $scanner_errors = 0;
        @virusname = ($output =~ /Info:\s+(.+)/g);
	@virusname = (undef) if !@virusname;  # just in case: make list nonnil
	do_virus();
    } elsif ($output =~ /Files Infected: 0/) {	     # no errors, no viruses found
       $scanner_errors = 0;
    } elsif ($output =~ /\n\*+ ERROR!/) {
        my @error_reason = ($output =~ /\n\*+ ERROR!\s+ (.+)/g);
	@error_reason = (undef) if !@error_reason;  # just in case: make list nonnil
	do_log(0, "Virus scanner failure: Symantec Carrier Scan - " . shift @error_reason);
    }
}

#
# Trend Micro FileScan API via Trophie
#
# FIXME: this code is not in sync with sophie - can't trophie
# handle directories?!?

use IO::Socket;
$|=1;


if ($trophie_sockname) {
    do_log(2,"Using Trophie");
    socket(\*sock, AF_UNIX, SOCK_STREAM, 0)
	or die "Can't open socket to Trophie: $!";
    connect(\*sock, pack_sockaddr_un $trophie_sockname)
	or die "Can't connect to Trophie: $!";

    opendir(DIR, "$TEMPDIR/parts/")
	or die "Can't open directory $TEMPDIR/parts/: $!";
    my @files = grep { -f "$TEMPDIR/parts/$_" } readdir(DIR);
    closedir(DIR) or die "Can't close directory: $!";
    chomp(@files);
    foreach my $file (@files) {
	if ($file =~ /^([\w\d\-.]+)$/) {
	    $file = $1;
       	} else {
	    die "Unsafe partname $file";
	}
	# needed "\n", otherwise it won't work
	$file = "$TEMPDIR/parts/$file\n";
	
	syswrite(\*sock, $file, length($file))
	  or die "syswrite to Trophie failed: $!";
	sysread(\*sock, $output, 256)
	  or die "sysread from Trophie failed: $!";

	chomp($output);
	$output =~ s/[^\w\d\-._:\/]+//g;
	do_log(2,"Trophie: $file - $output");
	last if ($output =~ m/^1/); 
    }

    close(\*sock) or die "Trophie socket close failed: $!";

    if ($output =~ m/^1/) {
	if ($output =~ m/^1:.*$/) {
	    @virusname = ($output =~ m/^1:(.*)$/g);
	}
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	$scanner_errors = 0;  # no errors, a virus was found
	do_virus();
    } elsif ($output == 0) {
	$scanner_errors = 0;  # no errors, no viruses
    } elsif ($output == -1) {
	do_log(0,"Virus scanner failure: Trophie - UNKNOWN STATUS (error code: $output)");
    } else {
	do_log(0,"Virus scanner failure: Trophie - OOOPS (error code: $output)");
    }
}

#
# Trend FileScanner/Linux
#

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

#
# VirusBuster (Client + Daemon)
#

if ($vbengcl) {
    do_log(2,"Using $vbengcl");
    chop($output = `$vbengcl -f -log scandir $TEMPDIR/parts 2>&1`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
	$scanner_errors = 0;
    } elsif ($errval == 3) {		# no errors, viruses discovered
	$scanner_errors = 0;
	# HINT: for an infected file it returns always 3,
	# although the man-page tells me a different story ...
	# needs to be FIXED
	@virusname = ($output =~ /Virus found = (.*);/g);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus();
    } else {
	do_log(0,"Virus scanner failure: $vbengcl (error code: $errval)");
    }
}

#
# CentralCommand Vexira
# engine based on H+BEDV AntiVir/X 
#

if ($vexira) {
    do_log(2,"Using $vexira");
    chop($output = `$vexira -allfiles -noboot -s -z $TEMPDIR/parts`);
    $errval = retcode($?);
    do_log(2,$output);
    if ($errval == 0) {			# no errors, no viruses found
        $scanner_errors = 0;
    } elsif ($errval == 1) {		# no errors, viruses discovered
	$scanner_errors = 0;
	@virusname = ($output =~ /VIRUS: .* virus (.+)/ig);
	@virusname = (undef)  if !@virusname;  # just in case: make list nonnil
	do_virus($output);
    } else {
	do_log(0,"Virus scanner failure: $vexira (error code: $errval)");
    }
}

    if ($scanner_errors) {
	if ($requeue_on_scanner_errors eq "yes") {
	    do_log(0,"All virus scanners failed - mail requeued " . get_msg_id());
	    do_exit($REGERR, __LINE__);
	} else {
	    do_log(0,"All virus scanners failed " . get_msg_id());
	}
    }
}

# Forward original message
sub forward_mail {
    my $seen_xheader = ( $X_HEADER_LINE ? 0 : 1 );

    if (!$nomail) {
    
    # sending mail, SMTP version
    # mail is piped back to postfix through a specific port
    # all SMTP methods return true (1) on success

    use Net::SMTP;
    my $SMTP_HANDLE = Net::SMTP->new("$localhost_ip:$smtp_port",
				Hello => "$localhost_name",
				Timeout => 30,
				Debug => 0
				);
    defined($SMTP_HANDLE) or die "Failure to connect to local SMTP port: $!";
    my($sender) = "<" . rfc2821_mailbox_addr($SENDER) . ">";
    if (!$SMTP_HANDLE->mail($sender)) {
	my($smtp_status) = $SMTP_HANDLE->status;
	my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	$SMTP_HANDLE->quit;
	if ($smtp_status == 5) {
	    do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	} else {
            die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				   : "Retry later, MTA said: ") . $smtp_msg);
	}
    }
    # The rfc2821_mailbox_addr() cleanup is necessary because addresses
    # we get from MTA are raw, with stripped-off quoting. To re-insert
    # them back via SMTP, the local-part needs to be quoted again
    # if it contains reserved characters or otherwise does not obey
    # the dot-atom syntax, as required per rfc2821. Failing to do that
    # gets us into trouble: amavis accepts message from MTA,
    # but is unable to hand it back to MTA after checking,
    # receiving '501 Bad address syntax' with every attempt.
    #
    my(@recips_2821) = map { "<".rfc2821_mailbox_addr($_).">" } @RECIPS;
    if (!$SMTP_HANDLE->recipient(@recips_2821)) {
	my($smtp_status) = $SMTP_HANDLE->status;
	my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	$SMTP_HANDLE->quit;
	if ($smtp_status == 5) {
	    do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	} else {
            die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				   : "Retry later, MTA said: ") . $smtp_msg);
	}
    }
    if (!$SMTP_HANDLE->data()) {
	my($smtp_status) = $SMTP_HANDLE->status;
	my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	$SMTP_HANDLE->quit;
	if ($smtp_status == 5) {
	    do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	} else {
            die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				   : "Retry later, MTA said: ") . $smtp_msg);
	}
    }
    my($skip_header_continuation) = 0;
    $fh->seek(0,0) or die "Can't rewind mail file: $!";
    while (<$fh>) {
	last if /^\r?\n$/;  # end-of-header reached
	if ($skip_header_continuation && /^[ \t]/) {
	    # discard
	} else {
	    $skip_header_continuation = 0;
	    $SMTP_HANDLE->datasend($_)
		or die "Net::SMTP::datasend failed: ".
			$SMTP_HANDLE->code() ." ". $SMTP_HANDLE->message();
	}
    }
    $_ = "";
    $_ .= "$X_HEADER_TAG: $X_HEADER_LINE\n" if $X_HEADER_LINE and
					       $X_HEADER_TAG =~ /^[!-9;-\176]+$/;
    $_ .= "\n";
    $SMTP_HANDLE->datasend($_)
	or die "Net::SMTP::datasend failed: ".
		$SMTP_HANDLE->code() ." ". $SMTP_HANDLE->message();
    for (;;) {
	$fh->read($_,16384);  # using fixed-size reads instead of line-by-line
			      # approach by <$fh>, makes feeding mail back to
	last if $_ eq '';     # Postfix more than twice as fast for larger mail
        if (!$SMTP_HANDLE->datasend($_)) {
	    my($smtp_status) = $SMTP_HANDLE->status;
	    my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	    $SMTP_HANDLE->quit;
	    if ($smtp_status == 5) {
		do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	    } else {
		die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				       : "Retry later, MTA said: ") . $smtp_msg);
	    }
	}
    }
    if (!$SMTP_HANDLE->dataend()) {
	my($smtp_status) = $SMTP_HANDLE->status;
	my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	$SMTP_HANDLE->quit;
	if ($smtp_status == 5) {
	    do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	} else {
	    die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				   : "Retry later, MTA said: ") . $smtp_msg);
	}
    }
    if (!$SMTP_HANDLE->quit) {
	my($smtp_status) = $SMTP_HANDLE->status;
	my($smtp_msg) = $SMTP_HANDLE->code ." ". $SMTP_HANDLE->message();
	if ($smtp_status == 5) {
	    do_log(0,"Rejected by MTA: $smtp_msg"); do_exit(1, __LINE__);
	} else {
	    die ( ($smtp_status == 4 ? "Temporary reject by MTA: "
				   : "Retry later, MTA said: ") . $smtp_msg);
	}
    }
    return 0;

# End postfix
    } 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() {

    # early exit in testing mode
    do_exit(2, __LINE__) if ($nomail);

    if ($QUARANTINEDIR) {
	do_quarantine("Virus found " . get_msg_id());
    } else {
	do_log(0,"Virus found - not quarantined " . get_msg_id());
    }

    # 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() if ($warnadmin eq "yes");

    # Finally, we bounce the message or pretend everything was okay,
    # depending on the MTA
    do_exit($VIRUSERR, __LINE__);
}

#
sub do_quarantine(@) {
    my $reason = shift;
    $VIRUSFILE = "virus-" . strftime("%Y%m%d-%H%M%S", localtime) . "-" . "$$";
    if (move ("$TEMPDIR/email.txt", "$QUARANTINEDIR/$VIRUSFILE")) {
	do_log(0,"$reason - quarantined as $VIRUSFILE");
    } else {
	do_log(0,"$reason - FAILED quarantine of $TEMPDIR/email.txt to $QUARANTINEDIR/$VIRUSFILE: $!");
    }
}

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

    open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom")
      or die "warn_sender: open failed: $!, $?";
    my $amavis_url = &amavisCredits();
    printf 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%s

virus%s in your email to the following recipient%s:

EOF
	# [still within printf syntax!]:
	join("\n\t", map(sanitize_str($_),@virusname)),
	(@virusname==1?"":"es"),
	(@RECIPS==1?"":"s") )  or die "warn_sender: printf failed: $!";

    foreach (@RECIPS) {
	printf MAIL ("-> %s\n", sanitize_str($_))
	    or die "warn_sender: printf failed: $!";
    }
    printf MAIL (<<"EOF",

Delivery of the email was stopped!

Please check your system for viruses,
or ask your system administrator to do so.
$amavis_url

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

From %s
------------------------- BEGIN HEADERS -----------------------------
EOF
	# [still within printf syntax!]:
	sanitize_str($SENDER) ) or die "warn_sender: printf failed: $!";

    $entity->print_header(\*MAIL) or die "warn_sender: print_header failed: $!";
    print MAIL <<"EOF" or die "warn_sender: print failed: $!";
-------------------------- END HEADERS ------------------------------

EOF
    close(MAIL) or die "warn_sender: close failed: $?";
}

# Notify admin
sub warn_admin() {
    open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom")
      or die "warn_admin: open failed: $!, $?";
    $SENDER = "(empty address)" if ($SENDER eq "<>");
    printf MAIL (<<"EOF",
From: $mailfrom
To: $mailto
Subject: VIRUS FROM %s (%s)

A virus was found in an email from:

   %s

The message was addressed to: 

EOF
	# [still within printf syntax!]:
	sanitize_str($SENDER),
	join(", ", map(sanitize_str($_),@virusname)),
	sanitize_str($SENDER) )  or die "warn_admin: printf failed: $!";

    foreach (@RECIPS) {
	printf MAIL ("-> %s\n", sanitize_str($_))
	    or die "warn_admin: print failed: $!";
    }

    if ($QUARANTINEDIR) {
	print MAIL <<"EOF" or die "warn_admin: print failed: $!";

The message has been quarantined as:

   $QUARANTINEDIR/$VIRUSFILE
EOF
    }
    print MAIL <<"EOF" or die "warn_admin: print failed: $!";

Here is the output of the scanner:

$output

Here are the headers:

------------------------- BEGIN HEADERS -----------------------------
EOF
    $entity->print_header(\*MAIL) or die "warn_admin: print_header failed: $!";
    print MAIL <<"EOF" or die "warn_admin: print failed: $!";
-------------------------- END HEADERS ------------------------------
EOF
    close(MAIL) or die "warn_admin: close failed: $?";
}

# Notify recipient(s)
# if $warn_offsite is "no", recipient addresses where the domain-part
# is not in @local_domains don't get a notification
sub warn_recip() {
    my %local_domains = ();
    for (@local_domains) { $local_domains{lc($_)} = 1 }
    # hashes are faster than arrays
    foreach my $rcpt (@RECIPS) {
	my $rcpt_domain = ($rcpt =~ /^<([^>]*)>$/ ? $1 : $rcpt);
	$rcpt_domain = ($rcpt_domain =~ /^(.*)\@([^@]*)$/ ? $2 : '');
	my $rcpt_is_local = undef;
	$rcpt_is_local = 1  if $local_domains{lc($rcpt_domain)};
	if ($rcpt_is_local || $warn_offsite eq "yes") {
	    open(MAIL, "|$sendmail_wrapper $sendmail_wrapper_args -f$mailfrom")
	      or die "warn_recip: open failed: $!, $?";
	    my $amavis_url = &amavisCredits();
	    $SENDER = "(empty address)" if ($SENDER eq "<>");
	    printf MAIL (<<"EOF",
From: $mailfrom
To: $rcpt
Subject: VIRUS IN MAIL FOR YOU (from %s)

                           V I R U S  A L E R T

Our viruschecker found the

\t%s

virus%s in an email to you from:

\t%s

Delivery of the email was stopped!
Please contact your system administrator for details.

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

	    if ($QUARANTINEDIR) {
		print MAIL <<"EOF" or die "warn_recip: print failed: $!";
The ID of your quarantined message is: $VIRUSFILE
EOF
	    }
	    if ($amavis_url ne "") {
		print MAIL $amavis_url,"\n" or die "warn_recip: print failed: $!";
	    }
	    close(MAIL) or die "warn_recip: close failed: $?";
	}
    }
}

# amavis credits.  Can be disabled with --no-credits
# Called from the notification routines.
sub amavisCredits {
    if ($credits 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, %selfextract);
    my $previous = 0;
    my $warn_files = 0;
    my $warn_compression = 0;

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

    do_log(4,"Extracting mime components");

    eval { $entity = $parser->parse($fileh) };
    if ($@) {
	# for now - will need to be more specific
	do_log(4,"MIME-tools parse error");
    }

    $fileh->seek(0,0);

    # Extract and decode each part to the extent possible

    for (my $i = 1; $i <= $MAXLEVELS; $i++) {
	my $current = 0;

	if ($i == $MAXLEVELS) {
	    do_log(0,"Maximum recursion depth ($MAXLEVELS) exceeded - requeue");
	    do_exit($REGERR,__LINE__);
	}

	opendir(PARTSDIR, "$TEMPDIR/parts")
	    or die "Can't open directory $TEMPDIR/parts: $!";
	my @parts = grep { !/^\.\.?$/ } readdir(PARTSDIR);
	closedir(PARTSDIR);

	# Determine number of parts
	$current = scalar(@parts);

	do_log(4,"Level: $i, parts: $current");
	do_log(4,"Archive nesting depth: $warn_compression");

	# Attempt to prevent DoS attacks with recursive archives
	# If the number of extracted parts is $threshold times greater
	# than the number of parts at the previous level, set $warn_files
	# If this occurs a second time ($warn_files == 2), refer the message
	# back to the mail system and log the deferral
	# We also quit if the maximum archive nesting depth is reached
	# Both measures are probaby not enough in the case of a small
	# number of highly compressed files

	# Triggers at $warn_files == 2
	# if $MAX_ARCHIVE_NESTING == 0, no maximum archive nesting depth!
	# changed by Rainer Link <link@suse.de>
	if ($warn_files > 1 || ($MAX_ARCHIVE_NESTING && ($warn_compression >= $MAX_ARCHIVE_NESTING))) {
	    die "Possible DoS detected - mail requeued";
	}

	# must delay by one level
	# if $threshold == 0, no DoS detection
	# changed by Rainer Link <link@suse.de>
	if (($previous > 0) && ($threshold && ($current / $previous >= $threshold))) {
	    $warn_files++;
	}
	$previous = $current;

	my $found = 0;
	foreach (@parts) {
	    my $save = $_;
	    unless (defined $atomic{$_} || defined $selfextract{$_}) {
		my $rv = decompose_part($_);

		if ($rv == 1) {
		    $found = 1;
		} elsif ($rv == 2) {
		    do_log(4,"$save is executable");
		    $selfextract{$save} = 1;
		    $found = 1;
		} else {
		    do_log(4,"$save is atomic");
		    $atomic{$save} = 1;
		}
	    }
	}
	last if ($found == 0);

	# must come after calling decompose_part
	if ($some_compression) {
	    $warn_compression++;
	    $some_compression = 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 {
	die "Unsafe partname: $part";
    }

    my ($filetype) = qx($file $TEMPDIR/parts/$part) =~ /:\s*(\S.*)$/;

    do_log(4,"File-type of $part: $filetype");

    # possible return values for eval:
    # 0 - unknown or unarchiver failure; consider atomic
    # 1 - some archiver format, successfully unpacked
    # 2 - self-extracting archive, successfully unpacked
    my($sts) = eval {
	$_ = $filetype;
	/^(?:ASCII|text|uuencoded|xxencoded|binhex)/i && return do_ascii($part);
	/^gzip compressed/i    && return do_gunzip($part);
	/^compress'd/i         && return do_uncompress($part);
	/^bzip2 compressed/i   && return do_bzip2($part);
	/^(?:GNU |POSIX )?tar archive/i && return do_tar($part);
	/^Zip archive/i        && return do_unzip($part,0);
	/^LHA.*archive/i       && return do_lha($part,0);
	/^ARC archive/i        && return do_arc($part);
	/^(?:Transport Neutral Encapsulation Format|TNEF)/i && return do_tnef($part);
	/executable/i          && return do_executable($part);

	# Falling through - no match
	return 0;
    };

    if ($@ ne '') {
	chomp($@);
	do_log(0,"Decoding of $part ($filetype) failed, ".
		 "leaving it unpacked: $@ " . get_msg_id());
    }

    return $sts;
}

# Generate unique filenames
{
    # Persistent and private
    my $filecount = 0;

    sub getfilename(@) {
	# if $MAXFILES set to 0, no file number limitation is active
	# changed by Rainer Link <link@suse.de>
	if ($MAXFILES && ($filecount > $MAXFILES)) {
	    do_log(0,"Maximum number of files ($MAXFILES) exceeded - mail requeued " . get_msg_id());
	    do_exit($REGERR,__LINE__);
	}
	return sprintf("part-%05d", ++$filecount);
    }
}

# copy (binary) command output to a file handle
# args: filehandle to print to, command, command args ...
sub fh_copy(@) {
    my $fileh = shift;
    my $blksize = (stat $fileh)[11] || 16384;
    my $pid = open(FDATA, "-|");  # fork
    defined($pid) or die "Can't fork: $!";
    if (!$pid) {  # child
	exec(@_)
	  or die "Can't exec program: $!";  # this will end up in parent's $?
	# NOTREACHED
    } else {
	my ($len, $buf, $offset, $written);
	while ($len = sysread FDATA, $buf, $blksize) {
	    $offset = 0;
	    while ($len > 0) { # Handle partial writes.
		$written = syswrite $fileh, $buf, $len, $offset;
		defined($written) or die "System write error: $!";
		$len -= $written; $offset += $written;
	    }
	}
	close(FDATA);
	return $?;
    }
}

#
# Uncompression/unarchiving routines
# Possible return codes:
# 0 - cannot extract/unpack further (treat as atomic)
# 1 - decoded/extracted from $part  (continue recursive extraction)
# 2 - $part is self-extracting executable (atomic AND continue extraction)

# if ASCII text, try multiple decoding methods as provided by UUlib
# (includes uuencoding, xxencoding, Base64 and BinHex)
sub do_ascii(@) {
    my $part = shift;
    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);
		$uuerror = 1 if (!$uu->state || !FILE_OK || -z $newpart);
	    }
	}
	return 0 if ($uuerror == 1);

	unlink("$TEMPDIR/parts/$part")
	  or die "Can't unlink $TEMPDIR/parts/$part: $!";
	return 1;
    }
    return 0;
}

# use Archive-Zip
sub do_unzip(@) {
    my $part = shift;
    my $exec = 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(sub{return 5});
    $ziperr = $zip->read("$TEMPDIR/parts/$part");
    Archive::Zip::setErrorHandler(sub{die @_});

    return 0 if ($ziperr != AZ_OK);
    do_log(4,"Unzipping $part");

#   fix for the off-by-one archive nesting error
#   http://marc.theaimsgroup.com/?l=amavis-user&m=102976113020867&w=2
#   shouldn't be needed, as we should have left subroutine by the
#   return 0 if ($ziperr != AZ_OK). But better safe then sorry.
    $some_compression++ if ($zip->numberOfMembers());

    my $compmeth = '';
    foreach ($zip->members()) {
	$compmeth = $_->compressionMethod;
	if ($compmeth == COMPRESSION_DEFLATED ||
	    $compmeth == COMPRESSION_STORED) {
	    my $newpart = "$TEMPDIR/parts/" . getfilename();
	    $zip->extractMember($_,$newpart) unless ($_->isDirectory);
	} else {
	    # FIXME note: per member
	    do_log(0,"$part: unsupported compression method: $compmeth");
	}
    }

    if (!$exec) {
	unlink("$TEMPDIR/parts/$part")
	  or die "Can't unlink $TEMPDIR/parts/$part: $!";
    }
    return 1;
}

# use external bzip program
# there *is* a perl module for bzip2, but it is not ready for prime time
sub do_bzip2(@) {
    my $part = shift;

    return 0 if (!$bunzip);
    do_log(4,"Expanding bzip2 archive $part");

    $some_compression++;

    my $newpart = "$TEMPDIR/parts/" . getfilename();

    system("$bunzip < $TEMPDIR/parts/$part > $newpart");
    if ($?) {
	unlink("$newpart") or die "Can't unlink $newpart: $!";
	return 0;
    }

    unlink("$TEMPDIR/parts/$part")
      or die "Can't unlink $TEMPDIR/parts/$part: $!";
    return 1;
}

# untar any tar archives with Archive-Tar
# extract each file individually
sub do_tar(@) {
    my $part = shift;

    # Work around bug in Archive-Tar
    my $tar = eval { Archive::Tar->new("$TEMPDIR/parts/$part") };

    unless (defined($tar)) {
	do_log(4,"Faulty archive $part");
	return 0;
    }

    do_log(4,"Untarring $part");

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

    foreach (@list) {
	unless (/\/$/) {		# Ignore directories
	    # this is bad (reads whole file into scalar)
	    # need some error handling, too
	    my $data = $tar->get_content($_);
	    my $newpart = "$TEMPDIR/parts/" . getfilename();
	    open(OUTPART, ">$newpart") or die "Can't write to $newpart: $!";
	    print(OUTPART $data);
	    close(OUTPART) or die "Can't close $newpart: $!";
	}
    }
    unlink("$TEMPDIR/parts/$part")
      or die "Can't unlink $TEMPDIR/parts/$part: $!";
    return 1;
}

# use Zlib to inflate
sub do_gunzip(@) {
    my $part = shift;
    my $buffer;
    my $newpart = "$TEMPDIR/parts/" . getfilename();

    do_log(4,"Inflating gzip archive $part");

    $some_compression++;

    my $gz = gzopen("$TEMPDIR/parts/$part", "rb")
		or die "Error opening $TEMPDIR/parts/$part: $!";
    open(OUTPART, ">$newpart") or die "Can't write to $newpart: $!";

    while ($gz->gzread($buffer) > 0) {
	print(OUTPART $buffer);
    }
    close(OUTPART) or die "Can't close $newpart: $!";

    if ($gzerrno != Z_STREAM_END) {
	unlink("$newpart") or die "Can't unlink $newpart: $!";
	return 0;
    }
    unlink("$TEMPDIR/parts/$part")
      or die "Can't unlink $TEMPDIR/parts/$part: $!";
    return 1;
}

# use external "uncompress" program
sub do_uncompress(@) {
    my $part = shift;

    return 0 if (!$uncompress);
    do_log(4,"Uncompressing $part");

    $some_compression++;

    my $newpart = "$TEMPDIR/parts/" . getfilename();

    system("$uncompress < $TEMPDIR/parts/$part > $newpart");
    if ($?) {
	unlink("$newpart") or die "Can't unlink $newpart: $!";
	return 0;
    }
    unlink("$TEMPDIR/parts/$part")
      or die "Can't unlink $TEMPDIR/parts/$part: $!";
    return 1;
}

# use external program to expand LHA archives
sub do_lha(@) {
    my $part = shift;
    my $exec = shift;
    my $checkerr = undef;

    return 0 if (!$lha);

    # Check whether we can really lha it
    open(LHA, "$lha lq $TEMPDIR/parts/$part 2>&1 |")
      or die "Can't run LHA: $!";
    while(<LHA>) {
	$checkerr = 1 if (/Checksum error/i);
    }
    close(LHA) or die "Error running LHA: $?";
    return 0 if ($? || $checkerr);

    do_log(4,"Expanding LHA archive $part");

#   fix for the off-by-one archive nesting error, part 1/2
#   http://marc.theaimsgroup.com/?l=amavis-user&m=102976113020867&w=2
#   shouldn't be needed, as we should have left subroutine by the
#   return 0 if ($? || $checkerr). But better safe then sorry.
#    $some_compression++;

    my @list = ();

    open(INPART, "$lha lq $TEMPDIR/parts/$part|");
    while(chop($_=<INPART>)) {
	next if /\/$/o;
	push(@list, (split(/\s+/))[-1]);
    }
    close(INPART);

#   fix for the off-by-one archive nesting error, part 2/2
#   http://marc.theaimsgroup.com/?l=amavis-user&m=102976113020867&w=2
    if (@list) {
	$some_compression++;
	my $rv = store_mgr(\@list, "$TEMPDIR/parts/$part", $lha, 'pq');
    	do_log(0, sprintf("lha returned status %d (signal %d)",
		      $rv>>8, $rv&255)) if $rv;
    }

    if (!$exec) {
	unlink("$TEMPDIR/parts/$part")
	  or die "Can't unlink $TEMPDIR/parts/$part: $!";
    }
    return 1;
}

# use external program to expand ARC archives
sub do_arc(@) {
    my $part = shift;

    return 0 if (!$arc);
    my($is_nomarch) = $arc =~ /nomarch/i;
    do_log(4,"Unarcing $part, using " . ($is_nomarch ? "nomarch" : "arc") );

    $some_compression++;

    my $cmdargs = ($is_nomarch ? "-l -U" : "ln") . " $TEMPDIR/parts/$part";
    my @list = qx($arc $cmdargs);
    map { s/^([^ \t\n]*).*$/$1/s } @list;   # keep only filenames

    my $rv = store_mgr(\@list, "$TEMPDIR/parts/$part", $arc,
		       ($is_nomarch ? ('-p', '-U') : 'p') );
    do_log(0, sprintf("arc returned status %d (signal %d)",
		      $rv>>8, $rv&255)) if $rv;

    unlink("$TEMPDIR/parts/$part")
      or die "Can't unlink $TEMPDIR/parts/$part: $!";
    return 1;
}

# use Convert-TNEF
sub do_tnef(@) {
    my $part = shift;

    do_log(4,"Extracting TNEF attachment $part");

    chdir("$TEMPDIR/parts") or die "Can't chdir to $TEMPDIR/parts: $!";
    my $tnef = Convert::TNEF->read_in("$TEMPDIR/parts/$part",{ignore_checksum=>"true"});

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

		open(OUTPART, ">$newpart")
		  or die "Can't write to $newpart: $!";
		if (defined(my $file = $handle->path)) {
		    copy($file, \*OUTPART);
		} else {
		    print OUTPART $handle->as_string;
		}
		close(OUTPART) or die "Can't close $newpart: $!";
	    }
	}

	$tnef->purge;

	unlink("$TEMPDIR/parts/$part")
	  or die "Can't unlink $TEMPDIR/parts/$part: $!";
    } else {
	# Not TNEF - treat as atomic
	chdir("$TEMPBASE") or die "Can't chdir to $TEMPBASE: $!";
	return 0;
    }

    chdir("$TEMPBASE") or die "Can't chdir to $TEMPBASE: $!";
    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.
sub do_executable(@) {
    my $part = shift;

    do_log(4,"Check whether $part is a self-extracting archive");

    # ZIP?
    return 2 if eval{do_unzip($part,1)};
    chomp($@);
    do_log(0,"do_executable/do_unzip failed, ignoring: $@") if $@;

    # LHA?
    return 2 if eval{do_lha($part,1)};
    chomp($@);
    do_log(0,"do_executable/do_unlha failed, ignoring: $@") if $@;

    return 0;
}

#
# Utility routines

# extract listed files from archive and store in new file
sub store_mgr(@) {
    my ($list, $archive, $cmd, @args) = @_;
    my $newpart = '';
    my @rv;

    for (@$list) {
	next if (/\/$/);		# Ignore directories
	$newpart = "$TEMPDIR/parts/" . getfilename();

	my $rv;
	open(FH, ">$newpart") or die "Can't create $newpart: $!";
	$rv = fh_copy(\*FH, $cmd, @args, $archive, $_);
#	do_log(4, sprintf('extracting %s to file %s, status %d (signal %d)',
#		  sanitize_str($_), $newpart, $rv>>8, $rv&255));
	push(@rv,$rv);
	close(FH) or die "Can't close $newpart: $!";
    }
    @rv = grep {$_ != 0} @rv;
    return (@rv>0 ? $rv[0] : 0);	# just return the first
					# nonzero status (if any), or 0
}

# Fail temporarily if $TEMPDIR cannot be created
sub make_tempdir() {
    my $count = 0;
    # The chances for this looping infinitely should be quite small, but ...
    MKTMPDIR: {
	if ($count++ > 20) {	# Magic number alert
	    do_log(0,"Cannot create temporary directory - check permissions");
	    do_exit($REGERR,__LINE__);
	}
	$TEMPDIR = sprintf "%s/amavis-%08d", $TEMPBASE, int(rand 2**24-1)+1;
	mkdir($TEMPDIR, oct('700')) || goto MKTMPDIR;
    }
}

#
# Locking/logging/exiting

#
sub setup_logging() {
    if (!$log_to_stderr) {
	if ($DO_SYSLOG eq "yes") {
	    ($FACILITY = $SYSLOG_LEVEL) =~ s/(\w+)\.(\w+)/LOG_\U$1/;
	    ($PRIORITY = $SYSLOG_LEVEL) =~ s/(\w+)\.(\w+)/LOG_\U$2/;
	    openlog("amavisd", LOG_PID, eval "$FACILITY");
	} else {
	    $loghandle = new IO::File;
	    $loghandle->open(">>$LOGDIR/$LOGFILE")
	      or die "Failed to open log file: $!";
	}
    }
}

# Log either to syslog or a file
sub do_log(@) {
    my $level = shift;
    my $errmsg = shift;

    return unless ($errmsg);

    # create syslog-alike
    my $logline = strftime("%b %e %H:%M:%S ", localtime) . (uname)[1] . " $myname\[$$\]: $errmsg\n";

    if ($level <= $log_level) {
	if (!$log_to_stderr) {
	    if ($DO_SYSLOG eq "yes") {
		syslog(eval "$PRIORITY", "%s", $errmsg);
	    } else {
		lock($loghandle);
		print($loghandle $logline);
		unlock($loghandle);
	    }
	} else {
	    print STDERR $logline;
	}
    }
}

# Return Resent-Message-ID: or Message-ID: header
sub get_msg_id(@) {
    my $level = shift;
    my $msgid = $entity->head->get("Resent-Message-ID");
    my $resent = "resent-";

    unless ($msgid) {
	$msgid = $entity->head->get("Message-ID");
	$resent = "";
    }

    chomp ($msgid);
    return "($resent" . "message-id=$msgid)";
}

#
# Produce syntactically correct local part of an e-mail address
# using quoted-string form if needed, as per rfc2821.
sub rfc2821_mailbox_addr {
    my($mailbox) = @_;
    # atext: any character except controls, SP, and specials (rfc2821/rfc2822)
    my($atext) = "a-zA-Z0-9!#\$%&'*/=?^_`{|}~+-";
    # my($specials) = '()<>\[\]\\\\@:;,."';
    my($localpart,$domain);
    if ($mailbox =~ /^(.*)(\@[^@]*)$/o) {
	($localpart,$domain) = ($1,$2)  
    } else {
	($localpart,$domain) = ($mailbox,'');
    }
    if ($localpart !~ /^[$atext]+(\.[$atext]+)*$/o) {  # not dot-atom
	$localpart =~ s/(["\\])/\\$1/g;       # quoted-pair
	$localpart = '"' . $localpart . '"';  # make a qcontent out of it
    }
    $localpart . $domain;
}

#
# Removes a directory, along with its contents
sub rmdir_recursively(@) {
    my $dir = shift;
    my $f;
    local *DIR;
    opendir(DIR, $dir) or die "Can't open directory $dir: $!";
    while (defined($f = readdir(DIR))) { 
	next if $f !~ /^(.+)$/;
	$f = $1;  # untaint
	if (-d "$dir/$f") {
	    rmdir_recursively("$dir/$f")  unless $f =~ /^\.\.?$/;
	} else {
	    unlink("$dir/$f") or die "Can't remove file $dir/$f: $!";
	}
    }
    closedir(DIR) or die "Can't close directory $dir: $!";
    rmdir($dir) or die "Can't remove directory $dir: $!";
    1;
}

#
# Removes a directory, along with its contents
# Does not do it recursively - refuses to delete any subdirectories
sub rmdir_flat($) {
    my $dir = shift;
    my $f;
    opendir(DIR, $dir) or die "Can't open directory $dir: $!";
    while (defined($f = readdir(DIR))) { 
	next if $f !~ /^(.+)$/;
	$f = $1;  # untaint
	if (-d "$dir/$f") {
	    die "Refused to unlink a subdirectory $dir/$f" unless $f =~ /^\.\.?$/;
	} else {
	    unlink("$dir/$f") or die "Can't remove file $dir/$f: $!";
	}
    }
    closedir(DIR) or die "Can't close directory $dir: $!";
    rmdir($dir) or die "Can't remove directory $dir: $!";
    1;
}

#
sub lock(@) {
    my $file = shift;
    flock($file, LOCK_EX) or die "Can't lock $file: $!";
    seek($file, 0, 2) or die "Can't position $file to its tail: $!";
}

#
sub unlock(@) {
    my $file = shift;
    flock($file, LOCK_UN) or die "Can't unlock $file: $!";
}

#
sub retcode($) {
    my $code = shift;

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

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

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

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

    chdir($TEMPBASE);
    rmdir_recursively("$TEMPDIR") if ($TEMPDIR && -d $TEMPDIR);

    if (!$log_to_stderr) {
	closelog if ($DO_SYSLOG eq "yes");
	$loghandle->close() if (defined($loghandle));
    }

    exit($code);
}

#
# Convert nonprintable characters in the argument
# to \[rnftbe], or \octal code, and '\' to '\\',
# returning the sanitized string.
sub sanitize_str {
	my($str) = @_;
	my(%map) = ("\r"=>'\r', "\n"=>'\n', "\f"=>'\f', "\t"=>'\t',
		    "\b"=>'\b', "\e"=>'\e', "\\"=>'\\\\');
	$str =~ s/([\000-\037\177\200-\237\377\134])/
		 exists($map{$1}) ? $map{$1} : sprintf("\\%03o",ord($1))/eg;
	$str;
}

#
# Main program starts here
#

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

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

# Be paranoid
umask(0077);

# Avoid taint bug in some versions of Perl (likely in 5.004, 5.005).
# The 5.6.1 is fine. To test, run this one-liner:
#   perl -Te '"$0 $$"; $r=$$; print eval{kill(0,$$);1}?"OK\n":"BUG\n"'
basename($0) =~ /^(.*)$/; $myname = $1;

setup_logging();

do_log(0,"starting.  $myname 0.3.12 Sun Jun 22 18:24:54 CEST 2003");

main_loop();

# Safeguard - shouldn't get here
do_exit($REGERR, __LINE__);

