# -*- Perl -*-
#***********************************************************************
# /path/to/mimedefang/conf/mimedefang-filter
#
# Filter configuration for MIMEDefang
#
# Change Log:
# Who  When        What
# ---- ----------  ----------------------------------------------
#
#
#***********************************************************************

######################
## Global Variables ##
######################

# Set the Filter version (in this example, it matches the version of
#	the paper associated with this file)
$FilterVersion=1.50;

#***********************************************************************
# Set administrator's e-mail address here.  The administrator receives
# quarantine messages and is listed as the contact for site-wide
# MIMEDefang policy.
#***********************************************************************
$AdminAddress = 'postmaster@yourdomain.tld';
$AdminName = "Domain Postmaster";

#***********************************************************************
# Set the e-mail address from which MIMEDefang quarantine warnings and
# user notifications appear to come.
$DaemonAddress = 'mimedefang@fqdn.yourdomain.tld';

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

#***********************************************************************
# Instruct MIMEDefang to use the local3 syslog Facility
#  This is used by the md_syslog routine
#  Within this sample filter file, md_syslog is used *extensively* to
#	track filter progress and logic flow - you may not want such
#	extensive logging in a production environment, but while
#	designing and testing your filter it helps make sure it actually
#	does what you intend
#***********************************************************************
$SyslogFacility = "local3";

#***********************************************************************
# 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;

#***********************************************************************
# Manual Overrides
# Make entries in this section to manully override compile-time
# feature selection (such as AV scanners)
#***********************************************************************
$Features{'Virus:CLAMD'} = 1;
$ClamdSock = "/var/spool/defang/MIMEDefang/clamd.sock";

######################
# WARNING: Do NOT uncomment the "Features" line below! MD will break!
#  Since SA is an auto-detected module, there is no need for "force"
#  MD to detect it. MD will puke and claim SA is not installed
#$Features{'SpamAssassin'} = 1;
######################

###############################
# Declare a Hash of IP addresses we consider internal
#	Key - IP Address
#	Value - Flag indicating if host is allowed to skip AV checks (0=No, 1=Yes)
###############################
@OurHosts=(	"127.0.0.1", 0,
		"192.168.1.1", 1 );
# Flags for program flow checks
$OurHost=0;
$SkipHost=0;

###############################
# Declare a Hash of hosted Domain Names
#	Key - Domain Name
#	Value - Flag indicating as to if Domain accepts mail (0=No, 1=Yes)
###############################
%OurDomains=(	"yourdomain.tld", 1,
		"somedomain.tlf", 0 );
# Variable to hold flag
$InboundDomain=0;

###############################
# Declare an array of RBL servers, timeout (in seconds) for responses, and maximum number
#   of positive RBL response before we don't care any more
###############################
@RBL_list=qw( sbl.spamhaus.org dnsbl.njabl.org bl.spamcop.net cbl.abuseat.org );
$RBL_timeout=8;
$RBL_max=3;
$RBL_filename="RBL";

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

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

#############################
## Initialize SpamAssassin ##
#############################
# Detect and load Perl modules
detect_and_load_perl_modules();

# Remove any existing SA object
undef ($SASpamTester);

# Define the path to the SpamAssassin config for MD
$path_sa_conf = "/opt/mimedefang/conf/sa-mimedefang.cf";

# Initialize SA with the specified config file
spam_assassin_init($path_sa_conf);

# Force the SA rules to be compiled immediately
spam_assassin_init()->compile_now(1);

# Enable auto-whitelisting
#use Mail::SpamAssassin::DBBasedAddrList;
#my $awl = Mail::SpamAssassin::DBBasedAddrList->new();
#$SASpamTester->set_persistent_address_list_factory($awl) if defined($awl);

# Set the max size (in KB) for SpamAssassin scans
# Messages larger than 100KB are extremely unlikely to be spam,
# and SpamAssassin is dreadfully slow on very large messages.
$SAScanSizeLimit = 100 * 1024;

#########################
## Start of Procedures ##
#########################

# 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|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$') and $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);
				}
			}
 		}
	return 0;
	}

#***********************************************************************
# %PROCEDURE: filter_relay
# %ARGUMENTS:
#  IP address of remote host; hostname of remote host
# %RETURNS:
#  2 element array (see documentation)
# %DESCRIPTION:
#  Called after SMTP connection has been established but before HELO,
#  MAIL FROM: or RCPT TO:
#***********************************************************************
sub filter_relay ()
	{
	# Read the parameters passed to the function
        my($hostip, $hostname) = @_;
	
	# If the connecting host is our own host, don't bother looking further
	if ( exists($OurHosts{$hostip} ) )
		{
		md_syslog('info', "[FC00] Connection from Internal Host $hostip");
		}
	else
		{
		md_syslog('info', "[FC01] Connection from Foreign Host $hostip");
		}

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

#***********************************************************************
# %PROCEDURE: filter_helo
# %ARGUMENTS:
#  IP address of remote host; hostname of remote host; HELO string
#  presented by remote host
# %RETURNS:
#  2-5 element array (see documentation)
# %DESCRIPTION:
#  Called after SMTP connection has been established and sending host has
#  given a HELO statement, but not MAIL FROM: or RCPT TO:
#***********************************************************************
sub filter_helo ()
        {
	# Read the parameters passed to the function
        my($hostip, $hostname, $helo) = @_;

	# Local variables
	my($testdomain);

	# If the connecting host is our own host, don't bother looking further
	if ( exists($OurHosts{$hostip}) )
		{
		md_syslog('info', "[FH00] Accepted Internal Host $hostip HELO $helo");
		return('CONTINUE', 'ok');
		}
	else
		{
		md_syslog('info', "[FH01] Foreign Host $hostip HELO $helo");
		}

	# Check if the HELO is an IP address or hostname or whatever
	if ($helo =~ /^(\[?)(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})(\]?)$/ )
		{
		# HELO looks like an IP - the comparison will split the string
		#	into 3 variables; $1 will have [ or be undefined, $2 will
		#	have the IP address without any brackets, $3 will have
		#	] or be undefined ($1 and $3 are undefined if HELO lacked
		#	square brackets)
		md_syslog('info', "[FH02] IP HELO $helo");

		# Check #0
		# The IP address portion should *not* be identical to the
		#	original HELO string - if it is, the original HELO lacked
		#	brackets and therefore is invalid (this is "safer" than
		#	trying to evaluate $1 and $3 directly, as they may be
		#	undefined, or have garbage from a previous iteration)
		if ( $2 eq $helo )
			{
			# Reject connection - invalid HELO
			md_syslog('alert', "[FH03] Invalid HELO $helo by Host $hostip");
			return('REJECT', "INVALID HELO/EHLO: $helo is not valid [FH03]");
			}

		# Check #1
		# Since the HELO was an IP address, it should match the host's IP
		if ( $2 ne $ip )
			{
			# Reject connection - fraudulent HELO
			md_syslog('alert', "[FH04] Fraudulent HELO $helo by Host $hostip");
			return('REJECT', "FRAUDULENT HELO/EHLO: $helo is not $hostip [FH04]");
			}
		}
	else
		{
		# HELO looks like a host name string
		md_syslog('info', "[FH05] Non-IP HELO $helo");

		# Check #2
		# If the HELO is a Domain Name, it will contain at least one "."
		if ( index($helo, '.') == -1 )
			{
			# Reject connection - invalid HELO
			md_syslog('alert', "[FH05] Invalid HELO $helo by Host $hostip");
			return('REJECT', "INVALID HELO/EHLO: $helo is not valid [FH05]");
			}

		# Check #3
		# If HELO is an FQDN, it should not contain "localhost"
		if ( $helo =~ /localhost/i )
			{
			# Reject connection - invalid HELO
			md_syslog('alert', "[FH06] Invalid HELO $helo by Host $hostip");
			return('REJECT', "INVALID HELO/EHLO: $helo is not valid [FH06]");
			}

		# Check #4
		# If the HELO is an FQDN, the index and rindex of "." will not be the same
		if ( index($helo, '.') == rindex($helo, '.') )
			{
			# Reject connection - invalid HELO
			md_syslog('alert', "[FH07] Non-FQDN HELO $helo by Host $hostip");
			return('REJECT', "INVALID HELO/EHLO: $helo is not FQDN [FH07]");
			}

		# Check #5
		# HELO should not be a hosted Domain
		if ( exists($OurDomains{$helo}))
			{
			# Reject connection - fraudulent HELO
			md_syslog('alert', "[FH08] Fraudulent HELO $helo by Host $hostip");
			return('REJECT', "FRAUDULENT HELO/EHLO: $hostip is not $helo [FH08]");
			}
		}
		# End of IF

	# At this point, we've eliminated all the obvious fraudulent HELOs

	# HELO has passed all checks
	md_syslog('alert', "[FH09] Accepted Foreign HELO $helo by Host $hostip");
	return('CONTINUE', 'ok');
	}
	# End of filter_helo

#***********************************************************************
# %PROCEDURE: filter_sender
# %ARGUMENTS:
#  Sender E-Mail address; IP address of remote host; hostname of remote
#  host; HELO string presented by remote host
# %RETURNS:
#  2-5 element array (see documentation)
# %DESCRIPTION:
#  Called after SMTP connection has been established and sending host has
#  given a HELO statement and MAIL FROM:, but not RCPT TO:
#***********************************************************************
sub filter_sender ()
        {
	# Read the variables passed to the function
        my($sender, $hostip, $hostname, $helo) = @_;

	# Local work variables
	my($domainmismatch_flag) = 0;
	my($testdomain, $workdomain, $workstring, @workarray);

	# Variables for RBL checks
	my($rblserver, $rblresult, $rblfile_ok);
	my($rblscore, $tempfail_flag)=0;
	my($rblhash);

	# If the connecting host is our own host, don't bother looking further
	if ( exists($OurHosts{$hostip}) )
		{
		md_syslog('info', "$MsgID [FS00] Accepted Internal Host $helo Sender $sender");
		return('CONTINUE', 'ok');
		}
	else
		{
		md_syslog('info', "$MsgID [FS01] Foreign Host $helo Sender $sender");

		# Copy the sender address and make it lowercase
		$workstring = lc($sender);
		# Strip out any angle brackets
		$workstring =~ s/^<//;
		$workstring =~ s/>$//;
		# Split it into address and Domain
		@workarray = split(/\@/, $workstring);
		# Extract the Domain
		$testdomain=$workarray[1];
		}

	# Check the Domain against list of our hosted Domains
	if ( exists($OurDomains{$testdomain}) )
		{
		md_syslog('alert', "$MsgID [FS02] Fraudulent Sender $sender from Host $hostip");
		return('REJECT', "FRAUDULENT SENDER ADDRESS: $helo is not $testdomain [FS02]");
		}

	# We need to perform an RBL check for use in filter_recipient
	md_syslog('info', "$MsgID [FS03] Calling RBL checker");
	$rblhash=relay_is_blacklisted_multi($ip, $RBL_timeout, $RBL_max, @RBL_list);
	md_syslog('info', "$MsgID [FS04] Returned from RBL checker");

	# Cycle thru list of RBL server replies and evaluate
	foreach $rblserver (keys(%$rblhash))
		{
		# Extract the result from the hash
		$rblresult=$rblhash->{$rblserver};
		# If the value returned by a specific RBL server is an array,
		#	then the RBL had a listing for this IP
		if (ref($rblresult) eq "ARRAY")
			{
			# Increment counter
			$rblscore=$rblscore + 1;
			md_syslog('info', "$MsgID [FS05] An RBL listed the IP (Score $rblscore - Flag $tempfail_flag)");
			}
		else
			{
			# Value was something else
			if ($rblresult eq "SERVFAIL")
				{
				# A lookup failed - set a flag to TEMPFAIL the
				#	connection if enough other RBLs has
				#	the IP listed
				$tempfail_flag=1;
				md_syslog('info', "$MsgID [FS06] An RBL returned SERVFAIL (Score $rblscore - Flag $tempfail_flag");
				}
			}
			# End of IF
		}
		# End of FOR

	# $rblscore now contains the number of RBLs that have listings
	#	for the connecting IP; $tempfail_flag will be 0, or 1
	#	if any RBL lookup returned SERVFAIL

	# Check to see if HELO is an IP (we know that an IP-based HELO
	#	will have a square bracket - if it didn't, it would
	#	have been rejected in filter_helo)
	if ( index($helo, '[') != -1 )
		{
		# It is a string
		# Is $workdomain a substring of $helo?
		if ( $workdomain =~ /$helo/ )
			{
			# The sender Domain seems to match the HELO
			md_syslog('info', "$MsgID [FS07] $workdomain matched $helo");
			$domainmismatch_flag=0;
			}
		else
			{
			# Hmmm...the sender Domain does not seem to match HELO
			md_syslog('info', "$MsgID [FS08] $workdomain did not match $helo");
			$domainmismatch_flag=1;
			}
		}
	else
		{
		# It is an IP
		# We cannot evaluate Domain - leave $domainmismatch_flag at 0
		md_syslog('info', "$MsgID [FS08] HELO $helo is IP - no Domain check");
		$domainmismatch_flag=0;
		}

	# If the RBL score was only 1 short of the maximum, then if either
	#	the RBL lookup had at least 1 SERVFAIL response OR the
	#	sender Domain doesn't appear to match HELO, or both,
	#	then increase the RBL score to the RBL maximum
	if ($rblscore == ( $RBL_max - 1))
		{
		if ( $tempfail_flag || $domainmismatch_flag )
			{
			$rblscore = $RBL_max;
			}
		}

	# Write the adjusted RBL score to a file in $CWD for later use
	$rblfile_ok = open(RBLFILE, ">$CWD/$RBL_filename");
	if ($rblfile_ok)
		{
		close(RBLFILE);
		md_syslog('info', "$MsgID [FS09] Wrote RBL Score $rblscore to $CWD/$rbl_filename");
		}
	else
		{
		md_syslog('error', "$MsgID [FS10] Unable to write RBL score file $CWD/$rbl_filename");
		}

	md_syslog('info', "$MsgID [FS11] Accepted Foreign MAIL FROM: $sender from Host $hostip");
	return('CONTINUE', 'ok');
	}
	# End of filter_sender

#***********************************************************************
# %PROCEDURE: filter_recipient
# %ARGUMENTS:
#  Recipient E-Mail address; Sender E-Mail address; IP address of remote host;
#  hostname of remote host; first Recipient E-Mail address; HELO string presented
#  by remote host; sendmail mailer-host-address triple for current Recipient
# %RETURNS:
#  2-5 element array (see documentation)
# %DESCRIPTION:
#  Called after SMTP connection has been established and sending host has
#  given a HELO statement, MAIL FROM: and RCPT TO:
#  Called for *each* RCPT TO:
#***********************************************************************
sub filter_recipient ()
        {
	# Read the variables passed to the function
        my($recipient, $sender, $hostip, $hostname, $first, $helo, $rcpt_mailer, $rcpt_host, $rcpt_addr) = @_;

	# Local work variables
	my($testaddress, $workstring, @workarray, @checkarray);

	# RBL variables
	my($rblscore, $rblfile_ok)=0;

	# If the connecting host is our own host, don't bother looking further
	if ( exists($OurHosts{$hostip}) )
		{
		md_syslog('info', "$MsgID [FR00] Accepted Internal Host $helo Recipient $recipient");
		return('CONTINUE', 'ok');
		}
	else
		{
		# Extract Recipient address for comparison
		md_syslog('info', "$MsgID [FR01] Foreign Host $helo Recipient $recipient");
	
		# Copy the recipient address and make it lowercase
		$workstring = lc($recipient);
		# Strip out any angle brackets
		$workstring =~ s/^<//;
		$workstring =~ s/>$//;
		# Split it into address and Domain
		@workarray = split(/\@/, $workstring);
		# Extract the address
		$testaddress=$workarray[0];
		}

	# If the recipient address is "request.whitelist", accept
	#	and stop all further filtering
	if ( $testaddress == "request.whitelist" )
		{
		md_syslog('alert', "$MsgID [FR02] Accepted Recipient $recipient from Sender $sender at Host $hostip");
		return('ACCEPT_AND_NO_MORE_FILTERING', "ok");
		}

	# Validate recipient address against destination host ($rcpt_host from sendmail triple)
	@checkarray = md_check_against_smtp_server($sender, $recipient, "mimedefang.yourdomain.tld", $rcpt_host);

	# If the address is invalid, reject the mail
	if ( $checkarray[0] == "REJECT" )
		{
		md_syslog('alert', "$MsgID [FR03] Rejected mail to $recipient from $sender as invalid");
		return('REJECT', "INVALID ADDRESS: $recipient is not valid [FR03]");
		}

	# Read the RBL score from the file
	$rblfile_ok = open(RBLFILE, "<$CWD/$RBL_filename");

	if ($rblfile_ok)
		{
		$rblscore=<RBLFILE>;
		md_syslog('info', "$MsgID [FR04] Read RBL Score $rblscore from $CWD/$rbl_filename");
		close(RBLFILE);
		if ($rblscore >= $RBL_max)
			{
			md_syslog('alert', "$MsgID [FR05] Rejected mail from $sender (Host $hostip) due to multiple RBL listings");
			return('REJECT', "Your host is listed on multiple RBL services - see RBL lookup at http://www.dnsstuff.com [FR05]");
			}
		}
	else
		{
		md_syslog('error', "$MsgID [FR06] Error reading RBL Score from $CWD/$rbl_filename");
		$rblscore=0;
		}

	# If destination host responded with TEMPFAIL and there were any RBL
	#	hits, then TEMPFAIL the message
	if ( $checkarray[0] == "TEMPFAIL" )
		{
		if ( $rblscore )
			{
			md_syslog('alert', "$MsgID [FR07] Tempfailed mail to $recipient from $sender; TEMPFAIL from $rcpt_host, RBL score $rblscore");
			return('TEMPFAIL', "Address service for $recipient not available - please try again later [FR07]");
			}
		}
	# If we got here, then accept the E-Mail
	md_syslog('alert', "$MsgID [FR06] Accepted Foreign RCPT TO: $recipient from Host $hostip");
	return('CONTINUE', 'ok');
	}
	# End of filter_recipient

#***********************************************************************
# %PROCEDURE: filter_begin
# %ARGUMENTS:
#  $entity -- the parsed MIME::Entity
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail parts are processed
#***********************************************************************
sub filter_begin
	{
	my($entity) = @_;

        md_syslog('info', "$MsgID [FB00] filter_begin: Filter v$FilterVersion processing from $Sender to $totalrcpts address(es)");

        # Make sure our global variables are initialized
        $OurHost=0;
        $SkipHost=0;

	# If the connecting host is our own host, don't bother with header checks
	if ( exists($OurHosts{$RelayAddr}) )
		{
		$OurHost=1;
		md_syslog('info', "$MsgID [FB01] Internal Host $RelayAddr");
		# Check to see if virus scans should be skipped
		#	(only allowed for our hosts)
		$SkipHost = $OurHosts{$RelayAddr};
		if ($SkipHost)
			{
			md_syslog('info', "$MsgID [FB02] filter_begin: Virus Scan Exempt Host $RelayAddr");
			}
		}
	else
		{
		# ALWAYS drop messages with suspicious chars in headers
		if ($SuspiciousCharsInHeaders)
			{
			md_syslog('alert', "$MsgID [FB03] Discarded from $Sender due to suspicious characters in header");
			# 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 action_discard();
			}
		}
		# End of IF

	# If host is not allowed to skip virus scans, then scan E-Mail
	if ( !$SkipHost )
		{
		# Copy original message into work directory as an
		#	"mbox" file for virus-scanning
		md_copy_orig_msg_to_work_dir_as_mbox_file();

		# md_syslog('info', "$MsgID [FB04] filter_begin: Submitting message to ClamAV");
		# Scan for viruses using ClamAV (clamd)
		my($code, $category, $action) = message_contains_virus_clamd();
		# md_syslog('info', "$MsgID [FB05] ClamAV returned Code $code Category $category Action $action");

		# Initialize flag
		$FoundVirus=0;

		# Look to see if virus was found
		if ($category eq 'virus')
			{
			# Check to see if it is the test virus
			if ($VirusName ne 'Eicar-Test-Signature')
				{
				# Set flag telling us we found a "real" virus
				$FoundVirus=1;
				# Change the Subject: line to note the virus
				action_change_header('Subject', '**Virus** ' . $Subject);
				# Delete all previous virus-scanner headers
				#   (some or all may be fraudulent)
				action_delete_all_headers('X-Virus-Status');
				action_delete_all_headers('X-AntiVirus');
				# Add a virus scanner header with the virus info
				action_add_header('X-Virus-Status', "Yes, name=$VirusName");
				# Log the virus
				md_syslog('emerg', "$MsgID [FB06] clamd detected Virus $VirusName)");
				}
			else
				{
				# Its just the test virus - change the subject
				#   header and continue
				action_change_header('Subject', 'TEST VIRUS FOUND - ' . $Subject);
				}
			}
		elsif ($category ne 'ok')
			{
			# Bad news - the scanner is not working
			# Log the problem
			md_syslog('emerg', "$MsgID [FB07] clamd failed: code=$code, category=$category, action=$action");
			# TEMPFAIL the message
			action_tempfail("Virus scanner unavailable - check back later");
			}
		}
        else
		{
		# md_syslog('info', "$MsgID [FB08] Skipped virus scan for exempt host $RelayAddr");
		}
		# End of IF $SkipHost
	return;
	}
	# End of filter_begin

#***********************************************************************
# %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) = @_;

	# Avoid unnecessary work by skipping this procedure
	#       if a previous procedure has called for rejecting the E-Mail
	return if message_rejected();

	# If a virus was found in filter_begin, then drop the MIME part
	#    that contained it and add a warning message
	if ( $FoundVirus )
		{
		# Make a log entry showing we dropped the part
		md_syslog('alert', "$MsgID [FF00] Dropped MIME part ($fname) containing Virus $VirusName");
		return action_drop_with_warning("WARNING: The mailserver removed a file named $fname ($type) containing virus $VirusName.");
		}

	# Local variables
	my($head, $charset);

	# If the sending host is not ours, check the MIME parts
	if ( !$OurHost )
		{
		# Block message/partial parts
		if (lc($type) eq "message/partial")
			{
			# md_graphdefang_log('message/partial');
                        md_syslog('alert', "$MsgID [FF01] Discarded from $Sender MIME type partial");
			action_bounce("MIME type message/partial not accepted here");
			return action_discard();
			}

		if (filter_bad_filename($entity))
			{
                        md_syslog('alert', "$MsgID [FF02] Dropped MIME part ($fname) bad filename");
			# 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");
			}

		# eml is bad if it's not multipart
		if (re_match($entity, '\.eml'))
			{
                        md_syslog('alert', "$MsgID [FF03] Dropped MIME part ($fname) attachment type .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");
    			}

		# Look at the "charset" of the parts and reject oddball charsets
		$head = $entity->head;
		$charset = lc($head->mime_attr("content-type.charset"));
		if ( defined($charset) )
			{
			if ($charset eq "ks_c_5601-1987" or
				$charset eq "euc-kr" or
				$charset eq "iso-2022-kr" or
				$charset eq "big5" or
				$charset eq "gb2312" or
				$charset eq "gb2312_charset")
				{
				md_syslog('alert',"$MsgID [FF04] Rejected from $Sender using charset $charset");
				return ('REJECT', "CONTENT VIOLATION: Mail using character set $charset not accepted here [FF04]");
				}
			}
		}
		# End of IF !$OurHost

	return action_accept();
	}
	# End of filter

#***********************************************************************
# %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) = @_;

	# Avoid unnecessary work by skipping this procedure
	#       if a previous procedure has called for rejecting the E-Mail
	return if message_rejected();

	if ( !$OurHost )
		{
		if (filter_bad_filename($entity))
			{
			md_syslog('alert', "$MsgID [FM00] Dropped MIME part ($fname) bad filename");
			# md_graphdefang_log('bad_filename', $fname, $type);
			action_notify_administrator("A MULTIPART attachment of type $type, named $fname was dropped.\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");
			}

		# eml is bad if it's not message/rfc822
		if (re_match($entity, '\.eml') and ($type ne "message/rfc822"))
			{
			md_syslog('alert', "$MsgID [FM01] Dropped MIME part ($fname) attachment type .eml");
			# 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");
			}

		# Block message/partial parts
		if (lc($type) eq "message/partial")
			{
			md_syslog('alert', "$MsgID [FM02] Discarded from $Sender MIME type partial");
			# md_graphdefang_log('message/partial');
			action_bounce("MIME type message/partial not accepted here");
			return;
			}
		}
	else
		{
		# md_syslog('notice', "$MsgID [FM03] Skipped attachment checks for internal host $RelayAddr");
		}
		# End of IF
	return action_accept();
	}
	# End of filter_multipart

#***********************************************************************
# %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";
	}

#***********************************************************************
# %PROCEDURE: filter_end
# %ARGUMENTS:
#  entity -- a Mime::Entity object (see MIME-tools documentation for details)
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  This is called after each message part has been processed
#***********************************************************************
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();

	# Local variable for creating string-based SPAM score representation
	my($score);

	# Local variable for size of messages
	my($totalsize)=0;

	# Local RBL variables
	my($rblfile_ok);
	my($rblscore)=0;

	# Only bother with SpamAssassin if an E-Mail is *not* originating
	#   from inside our network
	if ( ! $OurHost )
		{
		# Get size of message
		$totalsize = -s "./INPUTMSG";

		# Call SpamAssassin to perform SPAM checking, but only scan
		#   messages that are smaller than the limit defined above
		if ( $totalsize < $SAScanSizeLimit )
			{
			md_syslog('info', "$MsgID [FE00] Message submitted to SpamAssassin");
			# Call SpamAssassin
			# 	hits = E-Mail SPAM score
			# 	req = value of "required_hits" in sa-mimedefang.cf
			# 	names = names of SPAM tests that it failed
			#	report = SA report
			my($hits, $req, $names, $report) = spam_assassin_check();
			md_syslog('info', "$MsgID [FE01] filter_end: SpamAssassin SPAM score $hits");
			}
		else
			{
			md_syslog('warning',"$MsgID [FE02] SpamAssassin size limit $SAScanSizeLimit exceeded by $totalsize");
			my($hits)=0;
			my($req)=10;
			my($names, $report)="SA Size Bypass";
			}

		# Read the RBL score from the file
		$rblfile_ok = open(RBLFILE, "<$CWD/$RBL_filename");

		if ($rblfile_ok)
			{
			$rblscore=<RBLFILE>;
			md_syslog('info', "$MsgID [FE03] Read RBL Score $rblscore from $CWD/$rbl_filename");
			close(RBLFILE);
			}
		else
			{
			md_syslog('error', "$MsgID [FE04] Error reading RBL Score from $CWD/$rbl_filename");
			}

		# Boost SPAM score based on presence of virus and/or RBL score
		if ( $FoundVirus )
			{
			$hits=$hits+5;
			}

		if ( $rblscore )
			{
			$hits=$hits+$rblscore;
			}

		md_syslog('info', "$MsgID [FE05] Adjusted SPAM score $hits");

		# In preparation to add the header below, we make a
		#	string, score, where the number of asterisks in
		#	parens is the integer part of the spam score
		#	clamped to a maximum of 40. MUAs that cannot
		#	filter of numeric scores can usually trigger
		#	on a minimum number of asterisks.
		if ($hits < 40)
			{
			$score = "*" x int($hits);
			}
		else
			{
			$score = "*" x 40;
			}

		# Delete any existing X-Spam-Score header (may be fraudulent)
		action_delete_header("X-Spam-Score");

		# Add a new X-Spam-Score header with the scoring info; which
		#       looks like this:
		#   X-Spam-Score: 6.8 (******) NAME_OF_TEST,NAME_OF_TEST...
		action_add_header("X-Spam-Score", "$hits of $req ($score) $names");

		# Add headers that spell out how we tag SPAM
		action_add_header("X-Spam-Scoring", "Less than 5 not considered SPAMish");
		action_add_header("X-Spam-Scoring", "From 5 to 9.99 may be SPAM");
		action_add_header("X-Spam-Scoring", "10 or more considered SPAM");

		# Does the SPAM score exceed limit in sa-mimedefang.cf?
		if ($hits >= $req)
			{
			# The SA score is over the "definitely SPAM" threshhold
			# Alter the SUBJECT header
			action_change_header("Subject", "**SPAM** $Subject");
			# Log it
			md_syslog('info', "$MsgID [FE04] filter_end: flagged SPAM score $hits");
			# md_graphdefang_log('spam', $hits, $RelayAddr);
			# Add the SpamAssassin report
			action_add_part($entity, "text/plain", "-suggest",
					"$report\n", "SpamAssassinReport.txt", "inline");
			}
		else
			{
			# Check to see how SPAMy this is - at half the
			#	"definitely SPAM" score, we mark it as "Possibly SPAM"
			if ( $hits >= ( $req / 2 ) )
				{
				# The SA score is in the "possibly SPAM" area
				action_change_header("Subject", "Possibly SPAM: $Subject");
				# Add the SpamAssassin report
				action_add_part($entity, "text/plain", "-suggest",
						"$report\n", "SpamAssassinReport.txt", "inline");
				}
			}
			# End of IF
		}
	else
		{
		# md_syslog('notice', "$MsgID [FE06] Skipped all checks for internal host $RelayAddr");
		}
		# End of IF !$OurHost

	# 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.
	# Canonicalize all E-mail not from inside our network
	if ( !$OurHost )
		{
		action_rebuild();
		}
	}
	# End of filter_end

#######################
## End of Procedures ##
#######################

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