#
# my version 1.34, 11-16-08 michael@bizsystems.com
# -*- Perl -*-
#***********************************************************************
#
# mimedefang-filter
#
# Suggested filter for use with SpamCannibal & SpamAssassin
# to protect Microsoft Windows clients, plus
#
# Copyright (C) 2004 - 2008, Michael Robinton, michael@bizsystems.com
# Copyright (C) 2002 Roaring Penguin Software Inc.
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
#***********************************************************************

#***********************
# our stuff
$NotifyNoPreamble = 1;

#***********************************************************************
# Set administrator's e-mail address here.  The administrator receives
# quarantine messages and is listed as the contact for site-wide
# MIMEDefang policy.  A good example would be 'defang-admin@mydomain.com'
#***********************************************************************
$AdminAddress = 'postmaster';
$AdminName = "Postmaster";

#***********************************************************************
# Set the e-mail address from which MIMEDefang quarantine warnings and
# user notifications appear to come.  A good example would be
# 'mimedefang@mydomain.com'.  Make sure to have an alias for this
# address if you want replies to it to work.
#***********************************************************************
$DaemonAddress = '';

#***********************************************************************
# If you set $AddWarningsInline to 1, then MIMEDefang tries *very* hard
# to add warnings directly in the message body (text or html) rather
# than adding a separate "WARNING.TXT" MIME part.  If the message
# has no text or html part, then a separate MIME part is still used.
#***********************************************************************
$AddWarningsInline = 0;

#***********************************************************************
# To enable syslogging of virus and spam activity, add the following
# to the filter:
# md_graphdefang_log_enable();
# You may optionally provide a syslogging facility by passing an
# argument such as:  md_graphdefang_log_enable('local4');  If you do this, be
# sure to setup the new syslog facility (probably in /etc/syslog.conf).
# An optional second argument causes a line of output to be produced
# for each recipient (if it is 1), or only a single summary line
# for all recipients (if it is 0.)  The default is 1.
# Comment this line out to disable logging.
#***********************************************************************
md_graphdefang_log_enable('mail', 1);

#***********************************************************************
# Uncomment this to block messages with more than 50 parts.  This will
# *NOT* work unless you're using Roaring Penguin's patched version
# of MIME tools, version MIME-tools-5.411a-RP-Patched-02 or later.
#
# WARNING: DO NOT SET THIS VARIABLE unless you're using at least
# MIME-tools-5.411a-RP-Patched-02; otherwise, your filter will fail.
#***********************************************************************
$MaxMIMEParts = 50;

#***********************************************************************
# Set various stupid things your mail client does below.
#***********************************************************************

# Set the next one if your mail client cannot handle nested multipart
# messages.  DO NOT set this lightly; it will cause action_add_part to
# work rather strangely.  Leave it at zero, even for MS Outlook, unless
# you have serious problems.
$Stupidity{"flatten"} = 0;

# Set the next one if your mail client cannot handle multiple "inline"
# parts.
$Stupidity{"NoMultipleInlines"} = 0;

# The next lines force SpamAssassin modules to be loaded and rules
# to be compiled immediately.  This may improve performance on busy
# mail servers.  Comment the lines out if you don't like them.
if ($Features{"SpamAssassin"}) {
    spam_assassin_init()->compile_now(1) if defined(spam_assassin_init());

    # If you want to use auto-whitelisting:
#   if (defined($SASpamTester)) {
#       use Mail::SpamAssassin::DBBasedAddrList;
#       my $awl = Mail::SpamAssassin::DBBasedAddrList->new();
#       $SASpamTester->set_persistent_address_list_factory($awl) if defined($awl);
#   }
}

# This procedure returns true for entities with bad filenames.
sub filter_bad_filename ($) {
    my($entity) = @_;
    my($bad_exts, $re);

    # Bad extensions
    $bad_exts = '(ade|adp|app|asd|asf|asx|bas|bat|chm|cmd|com|cpl|crt|dll|exe|fxp|hlp|hta|hto|inf|ini|ins|isp|jse?|lib|lnk|mdb|mde|msc|msi|msp|mst|ocx|pcd|pif|prg|rar|reg|scr|sct|sh|shb|shs|sys|url|vb|vbe|vbs|vcs|vxd|wmd|wms|wmz|wsc|wsf|wsh|\{[^\}]+\})';

    # Do not allow:
    # - CLSIDs  {foobarbaz}
    # - bad extensions (possibly with trailing dots) at end
    $re = '\.' . $bad_exts . '\.*$';

    return 1 if (re_match($entity, $re));

    # Look inside ZIP files
    if (re_match($entity, '\.zip$')) {
	if ($Features{"Archive::Zip"}) {
	    my $bh = $entity->bodyhandle();
	    if (defined($bh)) {
		my $path = $bh->path();
		if (defined($path)) {
		    return re_match_in_zip_directory($path, $re);
		}
	    }
	}
# clobber zip files if we can't look inside the zip archives
	else {
	    return 1;
	}
    }
    return 0;
}

#***********************************************************************
# my filter begins here and is a modified version of one of the examples
#***********************************************************************
#
# flag to discard all tagged mail, none is reported to spamcannibal
#
$SpamCannibalDropAll	= 0;

# flag to discard or report virus mail to spamcannibal
#
$SpamCannibalReportVirus = 1;

# address of spamcannibal processing daemon
#
$SpamCannibalModerator	= 'spamtrap@mydomain.com';

# address of spamcannibal robot reader
#
$SpamCannibalReplyTo	= 'spam@mydomain.com';
$SpamCannibalReason	= '';

# if you want statistics on mail diversions, path to stats file
# DIRECTORY must exist!!, must be writeable by "defang:users"
#
$SpamCannibalStats	= '/etc/mail/sc_stats/sc_mdf_stats.txt';

# white list local networks, localhost, allowed hosts
#
@Relay_whitelist = (
	'127.0.0.1',
	'192.168.1',
	'192.168.20',
);


# if you want the white list filled from the SpamCannibal IGNORE list
# specify the path to the sc_BlackList.conf file. It will be appended to
# any IP's listed above
#
$Relay_Blacklistfile	= '/usr/local/spamcannibal/config/sc_BlackList.conf';

# Relay Whitelist cache file directory
# must be writable by the 'mimedefang' owner
#
$Relay_WhiteCache	= '/etc/mail/sc_stats';

# a hash of domains => primary.mail.server
# where real users might be found
# WARNING:	ip addresses of hosts in this list that have these
#		domain names must appear in the whitelist above
#
%Relay_checklist = (
        'mydomain.com'          => 'mail1.mydomain.com',
        'hosted-domain.com'     => 'mail-outer.mydomain.com',
        'otherdomain.net'       => 'mail1.mydomain.com',
        'anotherdomain.com'     => 'mail1.mydomain.com',
);

# Relay domain list -- domains for which we are responsible
# This list is used to check for bogus HELO
# list is valid domains from inner mail concentrator /etc/mail/sendmail.vh
@Relay_domain_list = qw|
	myhosted.domain.com
	another.hosted.domain.com
	personal.domain.com
	another.valid.domain.net
|;

# Primary mail host for each domain above
# you can set this array up manually or 
# ins a for loop as below. Used in filter_recipient
# below to verify the the recipient is valid
#
$Relay_innerhost = 'inner.mailhost.com';

# add large domain lists to checklist
foreach (@Relay_domain_list) {
  $Relay_checklist{$_} = $Relay_innerhost;
}

use Net::DNSBL::Utilities qw(
	list2NetAddr
	matchNetAddr
	doINCLUDE
);

my $havecache = 0;

if (	$Relay_WhiteCache &&
	-d $Relay_WhiteCache ) {
  $havecache = 1;
  my $metime = (stat($0))[9];
  my $sctime = ($Relay_Blacklistfile && -e $Relay_Blacklistfile)
	? (stat($Relay_Blacklistfile))[9]
	: 0;
  my $cshtim = (-e $Relay_WhiteCache .'/relaywhitelist.cache')
	? (stat($Relay_WhiteCache .'/relaywhitelist.cache'))[9]
	: 1;
  if ($metime > $cshtim || $sctime > $cshtim) {
    my $scSptr = doINCLUDE($Relay_Blacklistfile);	# spamcannibal Stuff pointer
    $scSptr = $scSptr->{IGNORE} if $scSptr;
    $scSptr = [] unless $scSptr;			# must point to some array
    push @Relay_whitelist, @$scSptr;
    local *CACHE;
    if (open (CACHE,'>'. $Relay_WhiteCache .'/relaywhitelist.cache')) {
      print CACHE << 'EOF';
my $cache = [qw(
EOF
      foreach (@Relay_whitelist) {
	print CACHE "\t$_\n";
      }
      print CACHE q|)];
|;
      close CACHE;
    } else {
      die "could not open ${Relay_WhiteCache}/relaywhitelist.cache for write";
    }
  } else {
    $havecache = doINCLUDE($Relay_WhiteCache .'/relaywhitelist.cache');
    die "could not open ${Relay_WhiteCache}/relaywhitelist.cache for read"
	unless $havecache;
    @Relay_whitelist = @$havecache;
  }
}

@NAwhitelist = ();  
list2NetAddr(\@Relay_whitelist,\@NAwhitelist);

# check for and pass white listed mail relay sources
#
sub filter_relay {
  my($ip,$name) = @_;
#  if (grep($ip =~ /^$_/,@Relay_whitelist)) {
  if (matchNetAddr($ip,\@NAwhitelist)) {
    sc_profile('WhiteList');
    return ('ACCEPT_AND_NO_MORE_FILTERING','ok')
  }
  return ('CONTINUE','ok');
}

# check for bogus HELO and dynamic IP
#
# regexp for common rDNS PTR entries that are ASSIGNED by ISP's to
# dynamic or non MX static accounts
#
my $pattern =
'pooles|not-active|ipad|unknown|customer|unused|no-dns|no-rdns|'.
'reverse|wlan|user|usr|nat|catv|modem|cable|modemcable|'.
'cdm|cm\d|client|cust|dhcp|dial|dialuol|dialup|dialip|dip|'.
'docsis|(a|c|s|x|v|)dsl|dyn(amic|dsl|)|host|pool|ppp|in\-addr\.arpa';

# pattern for ip address's of the form n+?n+?n+?n+ or 12 n's
# as in 1.2.3.4 => 001002003004
#
my $ipattern = '\d+[a-zA-Z_\-\.]\d+[a-zA-Z_\-\.]\d+[a-zA-Z_\-\.]\d+|\d{12}';

# mark known odd domain patterns
my @dyn_ok_domains = qw(
	dsl-only
	Disetronic
);

my @known_bad_domains = (	# these are dynamic patterns for specific domains
	'^SHASTA\d+',
	'^FL.+mesh\.ad\.jp',
	'^pc.+\d+.+\.comcast\.net',
	'^cncln.online.ln.cn',
	'^s[a-z0-9]+\..+shawcable\.net',
	'^nameservices.net',
	'^no.such',
	'adsl$',
	'dhcp$',
);

sub filter_sender {
  my($sender,$ip,$hostname,$helo) = @_;
  if ($helo =~ /\d+\.\d+\.\d+\.\d+/) {	# claims to be an IP address
    my $heloIP = $&;
# discard if it claims to be one of our white listed IP addresses
#    return(sc_profile('bogus_helo','REJECT',"bogus HELO $helo")) if grep(/$heloIP/,@Relay_whitelist);
    return(sc_profile('bogus_helo','REJECT',"bogus HELO $helo")) if matchNetAddr($heloIP,\@NAwhitelist);

  } else {
    return(sc_profile('bogus_helo','REJECT',"bogus HELO $helo")) if grep($helo =~ /$_$/i,keys %Relay_checklist);
  }
# discard bogus known hosts
  return(sc_profile('bogus_helo','REJECT',"bogus HELO $helo")) if $helo =~ /localhost/i  && $ip ne '127.0.0.1';
  return(sc_profile('bad_hostname','REJECT',"bogus localhost $ip")) if $hostname eq 'localhost' && $ip ne '127.0.0.1';
  return(sc_profile('bad_hostname','REJECT',"bogus host $hostname")) if $hostname =~ /unassigned/i || $hostname =~ /local$/i;

# fail known dynamic host patterns
  return(sc_profile('bad_hostname','REJECT',"dynamic host $hostname")) if grep($hostname =~ /$_/i,@known_bad_domains);

# return if not possible dynamic host
  return ('CONTINUE','ok') if $hostname =~ /^mail/i;
# return if known non-dynamic host
  return ('CONTINUE','ok') if grep ($hostname =~ /$_/i,@dyn_ok_domains);
# uncomment this to reject hosts of the form nnn.nnn.nnn.nnn or dashes or whatever in between
#  return (sc_profile('reverse_IP','REJECT',"bad reverse IP |$&| $hostname"))
#	if $hostname =~ /$ipattern/o;
  return ('CONTINUE','ok') unless $hostname =~ /([(.\-]|\b)($pattern).?[.\-\d]/io;
  my $match = $&;
# return if definetly not dynamic host, ends in 'match'.org|com|etc...
  return ('CONTINUE','ok') if $hostname =~ /(($match)[\.]?[a-z]+)$/io;
# must be dynamic or at least a customer line with in-appropriate rDNS
  return (sc_profile('dynamic_IP','REJECT',"dynamic IP |$match| $hostname"));
}

# check recipients for our domains
#
sub filter_recipient {
  my($recip, $sender, $ip, $host, $first, $helo,
	$rcpt_mailer, $rcpt_host, $rcpt_addr) = @_;
  my $cleanrecip = sc_clean_email($recip);
# catch email to postmaster and abuse from null sender
#  if ($sender =~ /^<?>?$/ && $cleanrecip =~ /^(postmaster|abuse)\@/i) {
#    return (sc_profile("null_${1}_sender","REJECT','553 5.1.7 null sender not acceptable for $1"));
#  }
  my @match = grep($cleanrecip =~ /\@$_$/i,keys %Relay_checklist);
  if (@match) {
    my($rv,$msg) = md_check_against_smtp_server($sender,
	$cleanrecip,$helo,$Relay_checklist{$match[0]});
# return error if good connection and recip not found
#if($rv eq 'REJECT') {
#  $msg = "RECIP_CHECK $recip -> $sender|$cleanrecip|$helo|$Relay_checklist{$match[0]}|$rv|, ". $msg;
#}
    return (sc_profile('invalid_recip','REJECT',$msg)) if $rv eq 'REJECT';
  }
# else always return OK, even on failed connection
	md_syslog('warning',"DEBUG $recip: mailer=$rcpt_mailer, host=$rcpt_host, addr=$rcpt_addr\n");

  return ('CONTINUE','ok');
}

###################################################
# SpamCannibal specific functions begin with sc_...

# profile the failure reasons in a file
# fails silently if file open fails
#
# input:	count_name,
#		@return_arguments
#
# returns:	@return_arguments
#
sub sc_profile {
  my $reason = shift;
  return @_ unless $SpamCannibalStats;		# profiling must be enabled
  return @_ if -e $CWD.'/stats_counted';	# return if already counted

  require Fcntl;
  import Fcntl qw(O_RDWR O_CREAT O_TRUNC O_RDONLY O_WRONLY LOCK_EX);
  local (*LOCK,*FILE);

  my $perms = 0644;
  umask 022;

# leave trace file when counting stats to prevent duplicates
  close FILE if sysopen FILE, $CWD .'/stats_counted',&O_RDWR|&O_CREAT|&O_TRUNC,$perms;

  unless (sysopen LOCK, $SpamCannibalStats .'.lock', &O_RDWR|&O_CREAT|&O_TRUNC, $perms) {
#    print STDERR "failed to open lock file ${SpamCannibalStats}.lock\n" if $DEBUG;
    return @_;
  }
  unless (flock(LOCK,&LOCK_EX)) {
    close LOCK;
#    print STDERR "failed flock on ${SpamCannibalStats}.lock\n" if $DEBUG;
    return @_;
  }
  unless (sysopen FILE, $SpamCannibalStats, &O_RDONLY|&O_CREAT, $perms) {
    close LOCK;
#    print STDERR "failed to open ${SpamCannibalStats} for read\n" if $DEBUG;
    return @_;
  }

#### read contents of existing file
  my $sti = '# stats since '. localtime(time) ."\n";
  my %counts;
  foreach(<FILE>) {
    $sti = $_ if $_ =~ /# stats since/;			# use old init time if present
    next unless $_ =~ /^(\d+)\s+(.+)/;
    $counts{"$2"} = $1;
  }
  close FILE;

#### increment or create count
  if ($counts{$reason}) {
    $counts{$reason} += 1;
  } else {
    $counts{$reason} = 1;
  }

#### write results and release lock
  unless (sysopen FILE, $SpamCannibalStats .'.tmp', &O_WRONLY|&O_CREAT|&O_TRUNC, $perms) {
    close LOCK;
#    print STDERR "failed to open tmp file ${SpamCannibalStats}.tmp\n" if $DEBUG;
    return @_;
  }
  my $savsel = select FILE;
  $| = 1;
  select $savsel;
  print FILE '# last update '. localtime(time) ."\n". $sti;
  my $total = 0;
  foreach(sort { $counts{$b} <=> $counts{$a} } keys %counts) {
    next if $_ =~ /^(White|Passed)/;
    $total += $counts{$_};
    print FILE $counts{$_}, "\t$_\n";
  }
  print FILE "# $total\ttotal rejects\n#\n";
  foreach(qw(WhiteList Passed)) {
    print FILE $counts{$_},"\t$_\n" if exists $counts{$_};
  }
  close FILE;
  rename $SpamCannibalStats .'.tmp', $SpamCannibalStats;	# atomic update

#### release lock
  close LOCK;
  return @_;
}

sub sc_discard {
  $SpamCannibalReason = shift;
  return action_discard();
}

# strip brackets, etc... from email addy for internal use
sub sc_clean_email {
  my $addy = shift;
  if ($addy =~ /[a-zA-Z0-9\._\-]+\@[a-zA-Z0-9_\-]+\.[a-zA-Z0-9\._\-]+/) {
    return $&;
  }
  return $addy;		# return brackets if that's all there is
}

# routine to discard mail instead of sending to spamcannibal
#
# returns:	undef		to drop all
#		filename	virus attached
#		false		send to SC
#
sub sc_mail_discard {
  return undef if $SpamCannibalDropAll;
  return $1 if $SpamCannibalReportVirus &&
	$SpamCannibalReason =~ /bad_filename\s+(.+)\s+\S+$/i;
  return 0;
}

#***********************************************************************
# %PROCEDURE: filter_begin
# %ARGUMENTS:
#  None
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail parts are processed
#***********************************************************************
sub filter_begin () {
    $SpamCannibalReason = '';				# clear
    # ALWAYS drop messages with suspicious chars in headers
    if ($SuspiciousCharsInHeaders) {
        md_graphdefang_log('suspicious_chars');
	# action_quarantine_entire_message("Message quarantined because of suspicious characters in headers");
	# Do NOT allow message to reach recipient(s)
	return sc_discard('suspicious_chars');
    }

    # Copy original message into work directory as an "mbox" file for
    # virus-scanning
    md_copy_orig_msg_to_work_dir_as_mbox_file();

    # Scan for viruses if any virus-scanners are installed
    my($code, $category, $action) = message_contains_virus();

    # Lower level of paranoia - only looks for actual viruses
    $FoundVirus = ($category eq "virus");

    # Higher level of paranoia - takes care of "suspicious" objects
    # $FoundVirus = ($action eq "quarantine");

    if ($FoundVirus) {
	md_graphdefang_log('virus', $VirusName, $RelayAddr);
	md_syslog('warning', "Discarding because of virus $VirusName");
	return sc_discard('virus');
    }

    if ($action eq "tempfail") {
	action_tempfail("Problem running virus-scanner");
	md_syslog('warning', "Problem running virus scanner: code=$code, category=$category, action=$action");
    }

}

#***********************************************************************
# %PROCEDURE: filter
# %ARGUMENTS:
#  entity -- a Mime::Entity object (see MIME-tools documentation for details)
#  fname -- the suggested filename, taken from the MIME Content-Disposition:
#           header.  If no filename was suggested, then fname is ""
#  ext -- the file extension (everything from the last period in the name
#         to the end of the name, including the period.)
#  type -- the MIME type, taken from the Content-Type: header.
#
#  NOTE: There are two likely and one unlikely place for a filename to
#  appear in a MIME message:  In Content-Disposition: filename, in
#  Content-Type: name, and in Content-Description.  If you are paranoid,
#  you will use the re_match and re_match_ext functions, which return true
#  if ANY of these possibilities match.  re_match checks the whole name;
#  re_match_ext checks the extension.  See the sample filter below for usage.
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  This function is called once for each part of a MIME message.
#  There are many action_*() routines which can decide the fate
#  of each part; see the mimedefang-filter man page.
#***********************************************************************
sub filter ($$$$) {
    my($entity, $fname, $ext, $type) = @_;

    return if message_rejected(); # Avoid unnecessary work

    # Block message/partial parts
    if (lc($type) eq "message/partial") {
        md_graphdefang_log('message/partial');
# don't bounce message, send it to spamcannibal
#	action_bounce("MIME type message/partial not accepted here");
	return sc_discard('message/partial');
    }

    if (filter_bad_filename($entity)) {
        md_graphdefang_log('bad_filename', $fname, $type);
#	return action_drop_with_warning("An attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
# discard and send instead to spamcannibal
	return sc_discard("bad_filename $fname $type");
    }

    # eml is bad if it's not multipart
    if (re_match($entity, '\.eml')) {
        md_graphdefang_log('non_multipart');
#	return action_drop_with_warning("A non-multipart attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
# discard and send instead to spamcannibal
	return sc_discard('non_multipart');
    }
    # Clean up HTML if Anomy::HTMLCleaner is installed.
    if ($Features{"HTMLCleaner"}) {
	if ($type eq "text/html") {
	    return anomy_clean_html($entity);
	}
    }

    return action_accept();
}

#***********************************************************************
# %PROCEDURE: filter_multipart
# %ARGUMENTS:
#  entity -- a Mime::Entity object (see MIME-tools documentation for details)
#  fname -- the suggested filename, taken from the MIME Content-Disposition:
#           header.  If no filename was suggested, then fname is ""
#  ext -- the file extension (everything from the last period in the name
#         to the end of the name, including the period.)
#  type -- the MIME type, taken from the Content-Type: header.
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  This is called for multipart "container" parts such as message/rfc822.
#  You cannot replace the body (because multipart parts have no body),
#  but you should check for bad filenames.
#***********************************************************************
sub filter_multipart ($$$$) {
    my($entity, $fname, $ext, $type) = @_;

    return if message_rejected(); # Avoid unnecessary work

    if (filter_bad_filename($entity)) {
        md_graphdefang_log('bad_filename', $fname, $type);
	action_notify_administrator("A MULTIPART attachment of type $type, named $fname was discarded.\n");
#	return action_drop_with_warning("An attachment of type $type, named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
# discard and send instead to spamcannibal
	return sc_discard("bad_filename $fname $type");
    }

    # eml is bad if it's not message/rfc822
    if (re_match($entity, '\.eml') and ($type ne "message/rfc822")) {
        md_graphdefang_log('non_rfc822',$fname);
#	return action_drop_with_warning("A non-message/rfc822 attachment named $fname was removed from this document as it\nconstituted a security hazard.  If you require this document, please contact\nthe sender and arrange an alternate means of receiving it.\n");
# discard and send instead to spamcannibal
	return sc_discard("non_rfc822 $fname");
    }

    # Block message/partial parts
    if (lc($type) eq "message/partial") {
        md_graphdefang_log('message/partial');
#	action_bounce("MIME type message/partial not accepted here");
#	return;
# discard and send instead to spamcannibal
	return sc_discard('message/partial');
    }

    return action_accept();
}


#***********************************************************************
# %PROCEDURE: defang_warning
# %ARGUMENTS:
#  oldfname -- the old file name of an attachment
#  fname -- the new "defanged" name
# %RETURNS:
#  A warning message
# %DESCRIPTION:
#  This function customizes the warning message when an attachment
#  is defanged.
#***********************************************************************
sub defang_warning ($$) {
    my($oldfname, $fname) = @_;
    return
	"An attachment named '$oldfname' was converted to '$fname'.\n" .
	"To recover the file, right-click on the attachment and Save As\n" .
	"'$oldfname'\n";
}

# If SpamAssassin found SPAM, append report.  We do it as a separate
# attachment of type text/plain
sub filter_end ($) {
    my($entity) = @_;

    # If you want quarantine reports, uncomment next line
    # send_quarantine_notifications();

    # IMPORTANT NOTE:  YOU MUST CALL send_quarantine_notifications() AFTER
    # ANY PARTS HAVE BEEN QUARANTINED.  SO IF YOU MODIFY THIS FILTER TO
    # QUARANTINE SPAM, REWORK THE LOGIC TO CALL send_quarantine_notifications()
    # AT THE END!!!

    # No sense doing any extra work
#    return if message_rejected();
    # Spam checks if SpamAssassin is installed
    my $xspamscore = '';
    if (! message_rejected() && $Features{"SpamAssassin"}) {
	if (-s "./INPUTMSG" < 100*1024) {
	    # Only scan messages smaller than 100kB.  Larger messages
	    # are extremely unlikely to be spam, and SpamAssassin is
	    # dreadfully slow on very large messages.
	    my($hits, $req, $names, $report) = spam_assassin_check();
	    my($score);
	    if ($hits < 40) {
		$score = "*" x int($hits);
	    } else {
		$score = "*" x 40;
	    }
	    # We add a header which looks like this:
	    # X-Spam-Score: 6.8 (******) NAME_OF_TEST,NAME_OF_TEST
	    # The number of asterisks in parens is the integer part
	    # of the spam score clamped to a maximum of 40.
	    # MUA filters can easily be written to trigger on a
	    # minimum number of asterisks...
	    if ($hits >= $req) {
#		action_change_header("X-Spam-Score", "$hits ($score) $names");
		$xspamscore = "$hits ($score) $names";
                md_graphdefang_log('spam', $hits, $RelayAddr);

		# If you find the SA report useful, add it, I guess...
#		action_add_part($entity, "text/plain", "-suggest",
#		                "$report\n",
#				"SpamAssassinReport.txt", "inline");
		sc_discard('spamassassin');
	    } else {
		# Delete any existing X-Spam-Score header?
		action_delete_header("X-Spam-Score");
	    }
	}
    }

# invoke spamcannibal
    if (defined $Actions{discard} && $Actions{discard}) {
      if (defined (my $virus_name = sc_mail_discard())) {
	if ($virus_name) {
	  sc_profile('virus');
	} else {
	  $SpamCannibalReason =~ /\S+/;
	  sc_profile($&);
	}
	md_graphdefang_log('sent to spamcannibal',$xx.$report);

	my $smhelo	= $Helo || '';
	my $origin	= $SendmailMacros{_} || '';
	my $if_name	= $SendmailMacros{if_name} || '';
	my $mail_mailer	= uc $SendmailMacros{mail_mailer} || 'SMTP';
	my $smid	= $SendmailMacros{i} || '';
	my $smfor	= (@Recipients) ? join(',',@Recipients) : '';
	chop $smfor if $smfor =~ /,$/;
	my $smdate	= rfc2822_date();

	local(*R,*I);
	open(R,'>./MY_COPY');

# add current received: from header
	print R qq
|Received: from $smhelo ($origin)
  by $if_name with $mail_mailer id $smid
  for $smfor; $smdate
|;

	open(I,'INPUTMSG');

	foreach(<I>) {
	  print R $_;
	  next unless $virus_name;		# strip virus attachment
	  last if $_ =~ /name.+$virus_name/i;
	}
	close I;
	close R;

	my $new = MIME::Entity->build(
		From		=> 'ns2_defang@localhost',
		To		=> $SpamCannibalModerator,
		Subject		=> '[SPAM] '. $SpamCannibalReason,
		'Reply-To'	=> $SpamCannibalReplyTo,
		Encoding	=> 'quoted-printable',
		Type		=> 'text/plain',
		Path		=> 'MY_COPY',
		'X-Spam-Score'	=> $xspamscore,
		'X-Actions'	=> $xx,
	);

	open(R,'>./MY_REPLACEMENT');
	$new->print(\*R);
	close R;
	rename 'MY_REPLACEMENT', 'INPUTMSG';
	resend_message($SpamCannibalModerator);
	return;
      } # else drop the message
    }
    else {
      sc_profile('Passed');

      # I HATE HTML MAIL!  If there's a multipart/alternative with both
      # text/plain and text/html parts, nuke the text/html.  Thanks for
      # wasting our disk space and bandwidth...

      # If you want to strip out HTML parts if there is a corresponding
      # plain-text part, uncomment the next line.
      # remove_redundant_html_parts($entity);

      md_graphdefang_log('mail_in');

      # Deal with malformed MIME.
      # Some viruses produce malformed MIME messages that are misinterpreted
      # by mail clients.  They also might slip under the radar of MIMEDefang.
      # If you are worried about this, you should canonicalize all
      # e-mail by uncommenting the action_rebuild() line.  This will
      # force _all_ messages to be reconstructed as valid MIME.  It will
      # increase the load on your server, and might break messages produced
      # by marginal software.  Your call.

      # action_rebuild();
    }
}

# DO NOT delete the next line, or Perl will complain.
1;