#!perl
#***********************************************************************
#
# mimedefang-filter
#
# Spamassassin, antivirus, HELO checks, etc, etc, etc
#
# $Id: mimedefang-filter,v 1.214 2009/06/29 16:23:02 jonas Exp $
#
# Copyright (C)
# Roaring Penguin Software Inc and
# The Swedish Association of the Deafblind (FSDB).
#
# Created by Jonas Eckerman, FSDB, jonas@fsdb.org
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
#***********************************************************************
$FilterVersion = '30';
$FilterRevision = '$Revision: 1.214 $';
$FilterDebug = 'tl39';


#***********************************************************************
# Configuration.
#***********************************************************************

# Add setting to config parser
my %cfgcfg = ();
$cfgcfg{'@i'}{i} = 0;
$cfgcfg{'@i'}{c} = 0;
sub add_cfg_cfg {
	my ($c,$v,$d,$t,$f) = @_;
	$d = '' unless (defined($d));
	$t = 's' unless ($t);
	$f = '' unless ($f);
	$c =~ s/[-_]+//g;
	$c = lc($c);
	$$v = $d;
	$cfgcfg{'@i'}{c} ++;
	$cfgcfg{$c}{v} = $v;
	$cfgcfg{$c}{t} = lc($t);
	$cfgcfg{$c}{f} = lc($f);
	$cfgcfg{$c}{i} = $cfgcfg{'@i'}{c};
	$cfgcfg{$c}{x} = 0;
}

# md: $AdminAddress
use vars qw($AdminContactAddress $MyFilterHostName $MyFilterHostNames $OurDomains $MyFilterHostAddress $MyFilterHostCountry);
use vars qw($NoUserDomains $PassAbuse);
use vars qw($LocalNets $WhiteNets $OurNets $CanAuthenticate $WantsReports $WantsExtraHeaders);
add_cfg_cfg('AdminAddress',\$AdminAddress,'postmaster','a');
add_cfg_cfg('AdminContactAddress',\$AdminContactAddress,'','a','AdminAddress');
add_cfg_cfg('AdminName',\$AdminName,'postmaster','s');
add_cfg_cfg('MyFilterHostName',\$MyFilterHostName,'host.domain.tld','s');
add_cfg_cfg('MyFilterHostNames',\$MyFilterHostNames,'','l','myfilterhostname');
add_cfg_cfg('OurDomains',\$OurDomains,'','l','myfilterhostnames');
add_cfg_cfg('NoUserDomains',\$NoUserDomains,'','l');
add_cfg_cfg('NoCheckUserDomains',\$NoCheckUserDomains,'','l');
add_cfg_cfg('NoCheckUserServers',\$NoCheckUserServers,'','l');
add_cfg_cfg('LocalNets',\$LocalNets,'10\.0\.\d{1,3}\.\d{1,3}','l');
add_cfg_cfg('WhiteNets',\$WhiteNets,'10.0.0.0/255.255.0.0','mn');
add_cfg_cfg('OurNets',\$OurNets,'','mn');
add_cfg_cfg('CanAuthenticate',\$CanAuthenticate,0,'b');
add_cfg_cfg('WantsReports',\$WantsReports,'','l');
add_cfg_cfg('WantsExtraHeaders',\$WantsExtraHeaders,'','l');
add_cfg_cfg('PassAbuse',\$PassAbuse,0,'b');

use vars qw($NoCheckUserDomains $NoCheckUserServers $CheckUserErrorContinue);
add_cfg_cfg('NoCheckUserDomains',\$NoCheckUserDomains,'','l');
add_cfg_cfg('NoCheckUserServers',\$NoCheckUserServers,'','l');
add_cfg_cfg('CheckUserErrorContinue',\$CheckUserErrorContinue,0,'b');

use vars qw($SRSDomain $SRSSecret $SRSCopyBounce $GSNDExpire $SRSDSNCaptureNet $SRSDSNCaptureHost $SRSDSNCaptureRcpt $SRSDSNCaptureSndr $SRSDSNCapture $SRSDSNCaptureFrom $SRSDSNCaptureTo $SRSDSNCaptureSubj);
add_cfg_cfg('SRSDomain',\$SRSDomain,'','s');
add_cfg_cfg('SRSSecret',\$SRSSecret,'','ms');
add_cfg_cfg('SRSCopyBounce',\$SRSCopyBounce,'','s');
add_cfg_cfg('SRSDSNCaptureRelayNet',\$SRSDSNCaptureNet,'','l');
add_cfg_cfg('SRSDSNCaptureRelayHost',\$SRSDSNCaptureHost,'','l');
add_cfg_cfg('SRSDSNCaptureRecipient',\$SRSDSNCaptureRcpt,'','l');
add_cfg_cfg('SRSDSNCaptureSender',\$SRSDSNCaptureSndr,'','l');
add_cfg_cfg('SRSDSNCaptureFrom',\$SRSDSNCaptureFrom,'','l');
add_cfg_cfg('SRSDSNCaptureTo',\$SRSDSNCaptureTo,'','l');
add_cfg_cfg('SRSDSNCaptureSubject',\$SRSDSNCaptureSubj,'','l');
add_cfg_cfg('GSNDMaxReturns',\$GSNDMaxReturns,0,'i');
add_cfg_cfg('GSNDExpire',\$GSNDExpire,30*24*60*60,'i');

use vars qw($sendmailconfdir $sm_domains);
add_cfg_cfg('SendmailConfig',\$sendmailconfdir,'/etc/mail','p');
add_cfg_cfg('SM_Domains',\$sm_domains,'local-host-names;mailertable;virtdomains','mpsm');

use vars qw($StreamBlack);
add_cfg_cfg('StreamBlack',\$StreamBlack,'-','s');

# md: $SALocalTestsOnly
use vars qw($SASizeLimit $SAMaxScanTime $SAPreInit $SAPreCompile $SARemember $SATimeout);
use vars qw($SASuspiciousScore $SASuspiciousBodyScore $SASuspiciousHeadScore);
use vars qw($SAScanOutbound $SAOutboundMaxLoad $SAOutboundMaxSwap);
use vars qw($SAScanLocal $SAPassLocal $SAReportLocal $SAReportLocalScore $SALocalMaxLoad $SALocalMaxSwap);
add_cfg_cfg('SALocalTestsOnly',\$SALocalTestsOnly,0,'b');
add_cfg_cfg('SASizeLimit',\$SASizeLimit,200*1024,'i');
add_cfg_cfg('SAMaxScanTime',\$SAMaxScanTime,25*60,'i');
add_cfg_cfg('SAPreInit',\$SAPreInit,0,'b');
add_cfg_cfg('SAPreCompile',\$SAPreCompile,0,'b');
add_cfg_cfg('SASuspiciousScore',\$SASuspiciousScore,1,'i');
add_cfg_cfg('SASuspiciousBodyScore',\$SASuspiciousBodyScore,0,'i');
add_cfg_cfg('SASuspiciousHeadScore',\$SASuspiciousHeadScore,0,'i');
add_cfg_cfg('SARemember',\$SARemember,0,'i');
add_cfg_cfg('SAScanOutbound',\$SAScanOutbound,1,'b');
add_cfg_cfg('SAScanLocal',\$SAScanLocal,0,'b');
add_cfg_cfg('SAPassLocal',\$SAPassLocal,1,'b');
add_cfg_cfg('SAReportLocal',\$SAReportLocal,1,'b');
add_cfg_cfg('SAReportLocalScore',\$SAReportLocalScore,5,'i');
add_cfg_cfg('SAOutboundMaxLoad',\$SAOutboundMaxLoad,0,'i');
add_cfg_cfg('SAOutboundMaxSwap',\$SAOutboundMaxSwap,0,'i');
add_cfg_cfg('SALocalMaxLoad',\$SALocalMaxLoad,0,'i');
add_cfg_cfg('SALocalMaxSwap',\$SALocalMaxSwap,0,'i');
add_cfg_cfg('SATimeout',\$SATimeout,5*60,i);

use vars qw($BncCollect $BncExpire);
add_cfg_cfg('BncCollect',\$BncCollect,0,'b');
add_cfg_cfg('BncExpire',\$BncExpire,7*24*60*60,'i');

use vars qw($spamdsocket $spamdhost $spamdport);
add_cfg_cfg('SpamdSocket',\$spamdsocket,'','s');
add_cfg_cfg('SpamdHost',\$spamdhost,'','s');
add_cfg_cfg('SpamdPort',\$spamdport,0,'i');

use vars qw($AVMaxScanTime $vircache_local $vircache_external);
add_cfg_cfg('AVMaxScanTime',\$AVMaxScanTime,25*60,'i');
add_cfg_cfg('AVCacheLocal',\$vircache_local,0,'i');
add_cfg_cfg('AVCacheExternal',\$vircache_external,0,'i');

# md: $DaemonAddress
use vars qw($MailResultAddress $MailResultMailer $MailResulAttachOriginal $MailResulAttachDefanged $MailResultVerify);
add_cfg_cfg('DaemonAddress',\$DaemonAddress,'mailer-daemon','a');
add_cfg_cfg('MailResultAddress',\$MailResultAddress,'','a');
add_cfg_cfg('MailResultMailer',\$MailResultMailer,'127.0.0.1:25','s');
add_cfg_cfg('MailResulAttachOriginal',\$MailResulAttachOriginal,1,'b');
add_cfg_cfg('MailResulAttachDefanged',\$MailResulAttachDefanged,1,'b');
add_cfg_cfg('MailResultVerify',\$MailResultVerify,1,'b');

use vars qw($SpamReportSpool $SpamReportAddress $SpamReportFoward $HamReportSpool $HamReportAddress);
add_cfg_cfg('SpamReportSpool',\$SpamReportSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('SpamReportAddress',\$SpamReportAddress,'','a');
add_cfg_cfg('SpamReportForward',\$SpamReportForward,'','ms');
add_cfg_cfg('HamReportSpool',\$HamReportSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('HamReportAddress',\$HamReportAddress,'','a');

use vars qw($SpamTrapSpool $SpamTrapAddresses $SpamTrapReportRelay);
use vars qw($trap_maxload $trap_maxswap $trap_chance $trap_keep $trap_timewindow $trap_maxwindow);
add_cfg_cfg('SpamTrapSpool',\$SpamTrapSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('SpamTrapAddresses',\$SpamTrapAddresses,'','l');
add_cfg_cfg('SpamTrapReportRelay',\$SpamTrapReportRelay,0,'b');
add_cfg_cfg('trap_maxload',\$trap_maxload,0,'i');
add_cfg_cfg('trap_maxswap',\$trap_maxswap,0,'i');
add_cfg_cfg('trap_chance',\$trap_chance,0,'i');
add_cfg_cfg('trap_keep',\$trap_keep,24*60*60,'i');
add_cfg_cfg('trap_timewindow',\$trap_timewindow,60*60,'i');
add_cfg_cfg('trap_maxwindow',\$trap_maxwindow,60,'i');

use vars qw($RelayOptionsDomain);
add_cfg_cfg('RelayOptionsDomain',\$RelayOptionsDomain,'','l');

# md: $AddWarningsInline $GeneralWarning
add_cfg_cfg('AddWarningsInline',\$AddWarningsInline,1,'b');
add_cfg_cfg('GeneralWarning',\$GeneralWarning,'WARNING: This e-mail has been altered by MIMEDefang at %s.','t');

use vars qw($debug_loglevel $where_log $where_log_mt $address_list_log);
add_cfg_cfg('DebugLogLevel',\$debug_loglevel,0,'i');
add_cfg_cfg('WhereLog',\$where_log,0,'b');
add_cfg_cfg('WhereLogTime',\$where_log_mt,0,'i');
add_cfg_cfg('AddressListLog',\$address_list_log,0,'b');

# md: $MaxMIMEParts
use vars qw($mailtoobig);
add_cfg_cfg('MaxMIMEParts',\$MaxMIMEParts,-1,'i');
add_cfg_cfg('mail_too_big',\$mailtoobig,32*1024*1024,'i');

use vars qw($bad_exts $office_exts $bad_css_exts $del_bad_ext);
add_cfg_cfg('RemoveFileBadExtension',\$del_bad_ext,1,'b');
add_cfg_cfg('BadExtensions',\$bad_exts,'(ade|adp|app|asd|asf|asx|bas|bat|chm|cmd|com|cpl|crt|dll|fxp|hlp|hta|hto|ins|isp|jse?|lib|lnk|mde|msc|msi|msp|mst|ocx|pcd|pif|prg|scr|sct|sh|shb|shs|sys|vb|vbe|vbs|vcs|vxd|wmd|wms|wmz|wsc|wsf|wsh|\{[^\}]+\})','l');
add_cfg_cfg('OfficeExtensions',\$office_exts,'(doc|xml|dot|rtf|wps|xls|xlt|csv|xlw|wk4|wk3|wk1|wks|xla|mdb|adp|dbf|ppt|pot|pps|ppa|wmf|emf|mpp|mpt|mpd|pub)','l');
add_cfg_cfg('BadCSSExtensions',\$bad_css_exts,'(java|jscript|js|jar|exe)','l');

use vars qw($SuspiciousHeadDiscard $SuspiciousBodyDiscard $VirusDiscard);
add_cfg_cfg('SuspiciousHeadDiscard',\$SuspiciousHeadDiscard,0,'b');
add_cfg_cfg('SuspiciousBodyDiscard',\$SuspiciousBodyDiscard,0,'b');
add_cfg_cfg('VirusDiscard',\$VirusDiscard,0,'b');

use vars qw($disable_bad_html $dbh_sizelimit $dbh_report $dbh_report_diff $RemoveRedundantHTMLFor);
add_cfg_cfg('DisableBadHTML',\$disable_bad_html,1,'b');
add_cfg_cfg('DBH_SizeLimit',\$dbh_sizelimit,1024*1024,'i');
add_cfg_cfg('DBH_Report',\$dbh_report,1,'b');
add_cfg_cfg('DBH_ReportDiff',\$dbh_report_diff,1,'b');
add_cfg_cfg('RemoveRedundantHTMLFor',\$RemoveRedundantHTMLFor,'','l');

use vars qw($fix_headers $check_received);
add_cfg_cfg('FixHeaders',\$fix_headers,1,'b');
add_cfg_cfg('CheckReceived',\$check_received,0,'b');

use vars qw($smtp_cache_good $smtp_cache_fail $smtp_cache_bad $smtp_cache_good_error);
add_cfg_cfg('smtp_cache_good',\$smtp_cache_good,60*60,'i');
add_cfg_cfg('smtp_cache_fail',\$smtp_cache_fail,10*60,'i');
add_cfg_cfg('smtp_cache_bad',\$smtp_cache_bad,60,'i');
add_cfg_cfg('smtp_cache_good_error',\$smtp_cache_good_error,6*60*60,'i');

use vars qw($expn_cache $expnservers $expn_local $expn_cache_error);
add_cfg_cfg('expn_servers',\$expnservers,'','l');
add_cfg_cfg('expn_cache',\$expn_cache,20*60,'i');
add_cfg_cfg('expn_cache_error',\$expn_cache_error,6*60*60,'i');
add_cfg_cfg('expn_localonly',\$expn_local,0,'b');

use vars qw($sc_cache_valid $sc_cache_invalid $sc_cache_unknown $sc_cache_invalid_add $sc_cache_invalid_max);
add_cfg_cfg('sc_cachevalid',\$sc_cache_valid,7*24*60*60,'i');
add_cfg_cfg('sc_cacheinvalid',\$sc_cache_invalid,60*60,'i');
add_cfg_cfg('sc_cacheunknown',\$sc_cache_unknown,7*24*60*60,'i');
add_cfg_cfg('sc_cacheinvalidadd',\$sc_cache_invalid_add,60*60,'i');
add_cfg_cfg('sc_cacheinvalidmax',\$sc_cache_invalid_max,24*60*60,'i');

use vars qw($relaydb $rdb_touch $rdb_stamp_grey $rdb_black_list $rdb_white_list $rdb_min_black $rdb_max_white $rdb_ratio $rdb_sender $rdb_domain $rdb_expire $rdb_virus);
add_cfg_cfg('relaydb',\$relaydb,0,'b');
add_cfg_cfg('rdb_touch',\$rdb_touch,0,'b');
add_cfg_cfg('rdb_stampgrey',\$rdb_stamp_grey,0,'b');
add_cfg_cfg('rdb_blacklist',\$rdb_black_list,12,'i');
add_cfg_cfg('rdb_whitelist',\$rdb_white_list,3,'i');
add_cfg_cfg('rdb_minblack',\$rdb_min_black,100,'i');
add_cfg_cfg('rdb_maxwhite',\$rdb_max_white,0,'i');
add_cfg_cfg('rdb_ratio',\$rdb_ratio,100,'i');
add_cfg_cfg('rdb_sender',\$rdb_sender,0,'b');
add_cfg_cfg('rdb_domain',\$rdb_domain,0,'b');
add_cfg_cfg('rdb_expire',\$rdb_expire,30*24*60*60,'i');
add_cfg_cfg('rdb_virus',\$rdb_virus,0,'b');

use vars qw($spamdb $sdb_expire);
add_cfg_cfg('spamdb',\$spamdb,0,'b');
add_cfg_cfg('sdb_expire',\$sdb_expire,7*24*60*60,'i');

use vars qw($nospamdb $nsdb_black_list $nsdb_white_list $nsdb_sender_count $nsdb_relay_count $nsdb_domain_count $nsdb_expire $nsdb_remember_spam);
add_cfg_cfg('nospamdb',\$nospamdb,0,'b');
add_cfg_cfg('nsdb_blacklist',\$nsdb_black_list,5,'i');
add_cfg_cfg('nsdb_whitelist',\$nsdb_white_list,0,'i');
add_cfg_cfg('nsdb_sendercount',\$nsdb_sender_count,1000,'i');
add_cfg_cfg('nsdb_relaycount',\$nsdb_relay_count,0,'i');
add_cfg_cfg('nsdb_domaincount',\$nsdb_domain_count,0,'i');
add_cfg_cfg('nsdb_expire',\$nsdb_expire,7*24*60*60,'i');
add_cfg_cfg('nsdb_remember_spam',\$nsdb_remember_spam,1,'b');

use vars qw($greylist $gdb_black $gdb_grey $gdb_white $gdb_host_white $gdb_host_black $gdb_reset $gdb_host_reset $gdb_reset_host $gdb_subnet $gdb_from_domain $gdb_from_strip $gdb_to_domain $gdb_to_strip $gdb_log);
add_cfg_cfg('greylist',\$greylist,0,'mbs');
add_cfg_cfg('gdb_black',\$gdb_black,3*60,'i');
add_cfg_cfg('gdb_grey',\$gdb_grey,72*60*60,'i');
add_cfg_cfg('gdb_white',\$gdb_white,36*24*60*60,'i');
add_cfg_cfg('gdb_hostwhite',\$gdb_host_white,7*24*60*60,'i');
add_cfg_cfg('gdb_hostblack',\$gdb_host_black,30,'i');
add_cfg_cfg('gdb_reset',\$gdb_reset,20,'i');
add_cfg_cfg('gdb_hostreset',\$gdb_host_reset,5,'i');
add_cfg_cfg('gdb_resethost',\$gdb_reset_host,0,'b');
add_cfg_cfg('gdb_subnet',\$gdb_subnet,1,'b');
add_cfg_cfg('gdb_fromdomain',\$gdb_from_domain,0,'b');
add_cfg_cfg('gdb_fromstrip',\$gdb_from_strip,1,'b');
add_cfg_cfg('gdb_todomain',\$gdb_to_domain,0,'b');
add_cfg_cfg('gdb_tostrip',\$gdb_to_strip,1,'b');
add_cfg_cfg('gdb_log',\$gdb_log,1,'b');

use vars qw($sentoutdb $out_expire);
add_cfg_cfg('sentoutdb',\$sentoutdb,0,b);
add_cfg_cfg('out_expire',\$out_expire,30*24*60*60,'i');

use vars qw($sc_cache_valid $sc_cache_invalid $sc_cache_unknown $sc_cache_invalid_add $sc_cache_invalid_max);
add_cfg_cfg('sc_cachevalid',\$sc_cache_valid,7*24*60*60,'i');
add_cfg_cfg('sc_cacheinvalid',\$sc_cache_invalid,60*60,'i');
add_cfg_cfg('sc_cacheunknown',\$sc_cache_unknown,7*24*60*60,'i');
add_cfg_cfg('sc_cacheinvalidadd',\$sc_cache_invalid_add,60*60,'i');
add_cfg_cfg('sc_cacheinvalidmax',\$sc_cache_invalid_max,24*60*60,'i');

use vars qw($mxcheck $mx_tempfail $mx_cache_valid $mx_cache_invalid);
add_cfg_cfg('mxcheck',\$mxcheck,0,'b');
add_cfg_cfg('mx_tempfail',\$mx_tempfail,1,'b');
add_cfg_cfg('mx_cache_valid',\$mx_cache_valid,7*24*60*60,'i');
add_cfg_cfg('mx_cache_invalid',\$mx_cache_invalid,60,'i');

use vars qw($authfailwarning $dkcheck $dkimcheck $spfcheck $AuthPassNets $smimecheck);
add_cfg_cfg('authfailwarning',\$authfailwarning,1,'b');
add_cfg_cfg('dkcheck',\$dkcheck,0,'b');
add_cfg_cfg('dkimcheck',\$dkimcheck,0,'b');
add_cfg_cfg('spfcheck',\$spfcheck,0,'b');
add_cfg_cfg('smimecheck',\$smimecheck,0,'b');
add_cfg_cfg('authpassnets',\$AuthPassNets,'','mn');

use vars qw($pgpcheck $pgp_expire $pgp_expire_bad $pgp_keyserver);
add_cfg_cfg('pgpcheck',\$pgpcheck,0,'b');
add_cfg_cfg('pgp_expire',\$pgp_expire,14*24*60*60,'i');
add_cfg_cfg('pgp_expire_bad',\$pgp_expire_bad,1*24*60*60,'i');
add_cfg_cfg('pgp_keyserver',\$pgp_keyserver,'wwwkeys.pgp.net','s');

use vars qw($hashcash $hc_maxrecipients $hc_worktime $hc_maxtime $hc_size $hc_maxload $hc_maxswap);
add_cfg_cfg('hashcash',\$hashcash,0,'b');
add_cfg_cfg('hc_maxrecipients',\$hc_maxrecipients,20,'i');
add_cfg_cfg('hc_worktime',\$hc_worktime,10,'i');
add_cfg_cfg('hc_maxtime',\$hc_maxtime,240,'i');
add_cfg_cfg('hc_size',\$hc_size,0,'i');
add_cfg_cfg('hc_maxload',\$hc_maxload,0,'i');
add_cfg_cfg('hc_maxswap',\$hc_maxswap,0,'i');

use vars qw($dc_keep $dc_grey_new $dc_unknown_user $dc_invalid_mx $dc_time_window $dc_per_time_window $dc_limit $dc_bad_helo $dc_black_host $dc_virus $dc_abuse $dc_trap $dc_limit_time);
add_cfg_cfg('dc_keep',\$dc_keep,5*60,'i');
add_cfg_cfg('dc_grey_new',\$dc_grey_new,0,'b');
add_cfg_cfg('dc_unknown_user',\$dc_unknown_user,0,'b');
add_cfg_cfg('dc_invalid_mx',\$dc_invalid_mx,0,'b');
add_cfg_cfg('dc_bad_helo',\$dc_bad_helo,0,'b');
add_cfg_cfg('dc_time_window',\$dc_time_window,3*60,'i');
add_cfg_cfg('dc_limit',\$dc_limit,10,'i');
add_cfg_cfg('dc_per_time_window',\$dc_per_time_window,3*60,'i');
add_cfg_cfg('dc_limit_per_time',\$dc_limit_time,100,'f');
add_cfg_cfg('dc_black_host',\$dc_black_host,0,'b');
add_cfg_cfg('dc_virus',\$dc_virus,0,'b');
add_cfg_cfg('dc_abuse',\$dc_abuse,0,'b');
add_cfg_cfg('dc_trap',\$dc_trap,1,'b');

use vars qw($hilo_keep $hilo_entries $hilo_margin);
add_cfg_cfg('hilo_keep',\$hilo_keep,366*24*60*60,'i');
add_cfg_cfg('hilo_entries',\$hilo_entries,0,'i');
add_cfg_cfg('hilo_margin',\$hilo_margin,0,'i');

use vars qw($attachments_path $attachments_meta $attachments_url);
use vars qw($attachments_max_size $attachments_max_mail_size $attachments_min_size $attachments_hard_limit $attachments_hard_mail_limit);
use vars qw($attachments_domain $attachments_recipients);
add_cfg_cfg('attachments_path',\$attachments_path,'','p');
add_cfg_cfg('attachments_meta',\$attachments_meta,'.meta','s');
add_cfg_cfg('attachments_url',\$attachments_url,'','s');
add_cfg_cfg('attachments_max_size',\$attachments_max_size,10*1024*1024,'i');
add_cfg_cfg('attachments_max_mail_size',\$attachments_max_mail_size,-1,'i');
add_cfg_cfg('attachments_min_size',\$attachments_min_size,512*1024,'i');
add_cfg_cfg('attachments_domain',\$attachments_domain,'','s');
add_cfg_cfg('attachments_recipients',\$attachments_recipients,'','l');
add_cfg_cfg('attachments_hard_limit',\$attachments_hard_limit,0,'i');
add_cfg_cfg('attachments_hard_mail_limit',\$attachments_hard_mail_limit,-1,'i');

use vars qw($silly_fortunes $silly_oneliners $silly_exclaim);
add_cfg_cfg('silly_fortunes',\$silly_fortunes,'');
add_cfg_cfg('silly_oneliners',\$silly_oneliners,'');
add_cfg_cfg('silly_exclaim',\$silly_exclaim,'');

use vars qw($database_spec $database_user $database_pass);
add_cfg_cfg('database_spec',\$database_spec,'dbi:SQLite:dbname=%s/filterdata.db','p');
add_cfg_cfg('database_user',\$database_user,'','s');
add_cfg_cfg('database_pass',\$database_pass,'','s');

use vars qw($ts_keep);
add_cfg_cfg('ts_keep',\$ts_keep,24*60*60,'i');

use vars qw($block_relay $block_sender);
add_cfg_cfg('block_relay',\$block_relay,0,'mbs');
add_cfg_cfg('block_sender',\$block_sender,0,'mbs');


#***********************************************************************
# Code.
#***********************************************************************

# Note: Lot's of modules are loaded dynamically.
# Search for "load_modules" to find them.
use DBI;
use Text::CSV_XS;

# :-/
use MIME::Decoder;
MIME::Decoder::install('MIME::Decoder::NBit','us-ascii');

$Features{"SpamAssassin"} = 0; # Reload dynamically later.
$Features{"HTMLCleaner"} = 0; # Reload dynamically later.
$Features{"HTML::Parser"} = 0; # Reload dynamically later.
$Features{"HTML::TokeParser"} = 0; # Reload dynamically later.
$Features{"Net::DNS"} = 0; # Reload dynamically later.
$Features{"File::Scan"} = 0; # Never use this.

# Some initialization
{
	if ($FilterRevision =~ /^\$\S+:?\s?(\d+)(\.\S*)?\s?\$$/) {
		$FilterVersion += $1;
		$FilterVersion .= $2;
	}
	if ($FilterDebug =~ /^\.?(.+)$/) {
		$FilterVersion .= ".$1";
	}
}
md_syslog('info',"Filter $FilterVersion loaded");
$sqldb = undef;
$sqldbd = '?';
#md_log_enable('mail');
#md_graphdefang_log_enable('mail', 1);
$Stupidity{"flatten"} = 0;
$Stupidity{"NoMultipleInlines"} = 0;
%storingservers = ();
detect_and_load_perl_modules();
read_cfg_cfg();
read_sendmail_config_stuff();
read_antivirus_feature_config();
$Features{"File::Scan"} = 0; # Never use this.
$is_result_query = 0;
$is_xam_report = 0;
$MailResultAddress = lc($MailResultAddress) if ($MailResultAddress);
$SpamReportAddress = lc($SpamReportAddress) if ($SpamReportAddress);
$HamReportAddress = lc($HamReportAddress) if ($HamReportAddress);
$MailResultMailer = '127.0.0.1' unless ($MailResultMailer);
$SpamReportSpool = '/var/spool/spam-reports' unless ($SpamReportSpool);
$HamReportSpool = '/var/spool/spam-reports' unless ($HamReportSpool);
$RelayOptionsDomain =~ s/\./\\./g;
$hc_maxrecipients = 20 unless ($hc_maxrecipients);
$hc_worktime = 10 unless ($hc_worktime);
$attachments_max_mail_size = $attachments_max_size + 4*1024 if ($attachments_max_mail_size<0 && $attachments_max_size>0);
$attachments_max_mail_size = 0 if ($attachments_max_mail_size<0);
$attachments_hard_mail_limit = $attachments_hard_limit + 4*1024 if ($attachments_hard_mail_limit<0 && $attachments_hard_limit>0);
$attachments_hard_mail_limit = 0 if ($attachments_hard_mail_limit<0);
$attachments_min_size = 0 if ($attachments_max_size>0 && $attachments_min_size > $attachments_max_size);
$MyFilterHostAddress = get_hostip($MyFilterHostName) unless ($MyFilterHostAddress);
$MyFilterHostCountry = get_ip_country($MyFilterHostAddress) unless ($MyFilterHostCountry);
#debug_log(0,'%s %s %s',$MyFilterHostName,$MyFilterHostAddress,$MyFilterHostCountry);
#debug_log(0,'My location: %s',get_ip_location($MyFilterHostAddress));

#$pgpcheck = 0; # Just testing?
my %modhead;
my %warnhead;
$lastwhere = 0;
$herewhere = 0;
$wherelast = '';
$hirestime = 0;

cfg_log();

# Maybe log to syslog
sub debug_log {
	my $level = shift;
	return if ($level>$debug_loglevel);
	my $msg = shift;
	my $mid = $MsgIDs;
	$mid = '-' if (!$mid || $mid eq 'NOQUEUE');
	my $ll = 'info';
	$ll = 'err' if ($level < 0);
	my $ls = sprintf("MDFDBG: %s $msg",$mid,@_);
	$ls =~ s/[\s\r\n]+$//;
	md_syslog($ll,$ls);
}

sub finish_log {
	my ($fll,$where,$what) = @_;
	return if ($fll>$debug_loglevel);
	#debug_log($fll,'??? %s',$what);
	my %nnl = ();
	if (opendir(D,'.')) {
		my @fl = ();
		my @dl = ();
		while (my $f = readdir(D)) {
			next if ($f =~ /^\.\.?$/);
			if (-d $f) {
				push @dl, sprintf('%10s %s','',$f) if ($what =~ /D/i);
			} else {
				push @fl, sprintf('%10u %s',(stat(_))[7],$f) if ($what =~ /D/i);
				$nnl{$f} = (stat(_))[7] if ((stat(_))[7]);
			}
		}
		closedir(D);
		foreach my $f (@dl) {
			debug_log($fll,'finish %s d %s',$where,$f);
		}
		foreach my $f (@fl) {
			debug_log($fll,'finish %s f %s',$where,$f);
		}
	}
	foreach my $fn (('COMMANDS','RESULTS')) {
		my $fns = substr($fn,0,1);
		#debug_log($fll,'??? %s %s',$fns,$fn);
		next unless ($what =~ /$fns/i);
		next unless ($nnl{$fn});
		if ($fn eq 'RESULTS' && load_modules('IO::Handle')) {
			IO::Handle::flush(RESULTS);
		}
		next unless (open(F,'<',$fn));
		my @rl = <F>;
		close(F);
		next unless (@rl);
		foreach my $l (@rl) {
			$l =~ s/[\r\n]+//gs;
			debug_log($fll,'finish %s %s %s',$where,$fns,$l) unless ($l eq '');
		}
	}
}

sub xyz_log {
	my $frc = shift;
	my $def = shift;
	debug_log($frc?-1:$def,@_);
}

sub where_log_i {
	my $frc = shift;
	my $msg = shift;
	my $n;
	my $fs;
	if ($hirestime) {
		$n = Time::HiRes::time();
		$fs = '%7s';
	} else {
		$n = time();
		$fs = '%3s';
	}
	my $h = '-';
	my $e = '-';
	my $l = '';
	if ($lastwhere) {
		$e = $n - $lastwhere;
		$h = $n - $herewhere;
		if ($hirestime) {
			$e = sprintf('%05.3f',$e);
			$h = sprintf('%05.3f',$h);
		}
		$l = "| $wherelast";
	}
	my $w = sprintf($msg,@_);
	xyz_log($where_log,3,"T: $fs $fs   %-30s %s",$h,$e,$w,$l) unless (!$frc && $where_log_mt && $e < $where_log_mt);
	$lastwhere = $n;
	$wherelast = $w
}
sub here_log {
	$herewhere = $hirestime ? Time::HiRes::time() : time();
	$lastwhere = 0;
	$wherelast = '';
	where_log_i(0,@_);
}
sub where_log {
	where_log_i(0,@_);
}
sub there_log {
	where_log_i(1,@_);
}

sub address_list_log {
	xyz_log($address_list_log,5,@_);
}

# Log for event analyzing
$logcsv = Text::CSV_XS->new({sep_char=>',',quote_char=>"'",binary=>1});
$logssv = Text::CSV_XS->new({sep_char=>';',quote_char=>'"',binary=>1});
sub stats_log {
	if (@_ == 5 && $_[4] eq '*') {
		my @add = ($RelayAddr,$RelayHostname,$Helo,$Sender,\@Recipients,$Subject);
		splice @_, 4, 1, @add;
	}
	my $mid = splice(@_,1,1);
	my @lst = ();
	foreach my $fld (@_) {
		if (ref($fld) eq 'ARRAY') {
			push @lst, $logcsv->string() if ($logcsv->combine(@{$fld}));
		} elsif (ref($fld) eq 'HASH') {
			my @sl = ();
			while (my ($k,$v) = each %{$fld}) {
				push @sl, "$k=$v";
			}
			push @lst, $logcsv->string() if ($logcsv->combine(@sl));
		} elsif (ref($fld) eq 'SCALAR') {
			push @lst, $$fld;
		} elsif (ref($fld) eq '') {
			push @lst, $fld;
		}
	}
	return unless (@lst);
	$lst[0] = '-' unless ($lst[0]);
	$lst[0] = lc($lst[0]);
	unshift @lst, 'mdstats';
	return unless ($logssv->combine(@lst));
	my $ls = $logssv->string();
	$ls =~ s/([%\x00-\x1F\x7F-\xFF])/sprintf('%%%02x',ord($1))/gse;
	$mid = '?' if ($mid =~ /^(|NOQUEUE)$/i);
	md_syslog('info',"$mid: $ls");
	shift @lst;
	$ls = shift @lst;
	return unless ($logssv->combine(@lst));
	sql_execute('INSERT INTO logs (logs_stamp,logs_type,logs_cont,logs_mqid,logs_line) VALUES (?,?,?,?,?)',
			time(),'stats',$ls,$mid,$logssv->string());
}

# Log for spam rules analyzing
sub spam_log {
	my $h = shift;
	if ($h ne '-') {
		my $r = shift;
		my $nl = shift;
		unshift @{$nl}, $r;
		unshift @{$nl}, $h;
		stats_log('spaminfo',$MsgIDs,$nl,@_);
	} else {
		stats_log('spaminfo',$MsgIDs,$h,@_);
	}
}

# Maybe log for greylist analyzing
sub greylist_log {
	my $e = shift @_;
	stats_log('greylist',$MsgIDs,$e,@_) if (defined($gdb_log) && $gdb_log);
}

sub cfg_log {
	my $lvl = shift;
	my $w = shift;
	$lvl = 1 unless (defined($lvl));
	$w = 'cs' unless ($w);
	if ($w =~ /c/i) {
		foreach my $c (sort { $cfgcfg{$a}{i} <=> $cfgcfg{$b}{i} } keys %cfgcfg) {
			next if ($c =~ /^\@/);
			debug_log($lvl,'config: %s = %s',$c,${$cfgcfg{$c}{v}});
		}
	}
	if ($w =~ /s/i) {
		while (my ($srv,$hst) = each %storingservers) {
			debug_log($lvl,'server: %s > %s',$srv,$hst);
		}
	}
	if ($w =~ /f/i) {
		foreach my $f (sort keys %Features) {
			debug_log($lvl,'feature: %s = %s',$f,$Features{$f});
		}
	}
}

sub milter_log {
	my $lvl = shift;
	my $w = shift;
	my $p = shift;
	$lvl = 1 unless (defined($lvl));
	$w = 'c' unless ($w);
	$p = '' unless ($p);
	$p = " [$p]" if ($p);
	if ($w =~ /c/i) {
		if (open(CF,'<','COMMANDS')) {
			while (my $l = <CF>) {
				$l =~ s/[\r\n]+//gs;
				debug_log($lvl,'milter command%s: %s',$p,$l);
			}
			close(CF);
		}
	}
	if ($w =~ /r/i) {
		if (open(CF,'<','RESULTS')) {
			while (my $l = <CF>) {
				$l =~ s/[\r\n]+//gs;
				debug_log($lvl,'milter result%s: %s',$p,$l);
			}
			close(CF);
		}
	}
	if ($w =~ /d/i) {
		if (opendir(D,'.')) {
			while (my $f = readdir(D)) {
				next if ($f =~ /^\.\.?$/);
				debug_log($lvl,'milter file%s: %s',$p,$f);
			}
			closedir(D);
		}
	}
}

%loaded_modules = ();
sub load_modules{
	foreach my $mn (@_) {
		my $mnk = $mn;
		$mnk =~ s/^\s+//;
		$mnk =~ s/[\s\(].*$//;
		return 0 if (defined($loaded_modules{$mnk}) && !$loaded_modules{$mnk});
		unless (defined($loaded_modules{$mnk}) && $loaded_modules{$mnk}) {
			debug_log(1,'load_modules %s (%s)',$mn,$mnk);
			eval("use $mn");
			if ($@) {
				debug_log(-1,'load_modules %s ! %s',$mn,$!);
				$loaded_modules{$mnk} = 0;
				return 0;
			}
			$loaded_modules{$mnk} = 1;
		}
	}
	return 1;
}

# Get a file path name 
sub get_file_path_name {
	my $f = shift;
	return $f if ($f =~ /[\/\\]/);
	foreach my $d ((sprintf('%s/%s',$Features{'Path:CONFDIR'},'filter'),$Features{'Path:CONFDIR'},
			'/usr/local/etc/mimedefang/filter','/etc/mimedefang/filter',
			'/usr/local/etc/mimedefang','/etc/mimedefang',
			'/usr/local/etc/mail','/etc/mail', )) {
		if ($d =~ /mimedefang/) {
			return "$d/$f" if (-f "$d/$f");
			return "$d/mimedefang-$f" if (-f "$d/mimedefang-$f");
		} else {
			return "$d/mimedefang-$f" if (-f "$d/mimedefang-$f");
			return "$d/$f" if (-f "$d/$f");
		}
	}
	return '';
}

# Read file into array
sub read_a_file {
	my ($fn,$match,$noclean) = @_;
	my @l = ();
	if ($fn && (-f $fn) && (open(CF,'<',$fn))) {
		while (my $l = <CF>) {
			unless ($noclean) {
				next if ($l =~ /^[;#]/);
				next if ($l =~ /^[\s\r\n]*$/s);
				next if ($match && $l !~ /^$match/i);
			}
			push @l, $l;
		}
		close(CF);
	}
	return \@l;
}

# read the configuration file
sub read_cfg_cfg {
	my $cfgfn = get_file_path_name('filter.conf');
	die('No filter config!') unless ($cfgfn);
	die('Cannot read filter config!') unless (open(F,'<',$cfgfn));
	md_syslog('info',"Filter config: $cfgfn");
	while (my $l = <F>) {
		$l =~ s/[\r\n]+//gs;
		next unless ($l);
		next if ($l =~ /^\s*[#;]/);
		if ($l =~ /^\$(\S+):\s*(.*?)\s*\$?$/) {
			md_syslog('info',"Config $1: $2");
		} elsif ($l =~ /^\s*(\S+)\s*?[\s:=]\s*(\S.*?)\s*$/) {
			my $c = lc($1);
			my $v = $2;
			$c =~ s/[-_]+//g;
			next unless ($c);
			next if ($c =~ /^\@/);
			if (defined($cfgcfg{$c})) {
				if ($cfgcfg{$c}{x} && $cfgcfg{$c}{t} =~ /^m/i) {
					${$cfgcfg{$c}{v}} .= ';' if (${$cfgcfg{$c}{v}} ne '');
					${$cfgcfg{$c}{v}} .= $v;
				} elsif (($cfgcfg{$c}{t} eq 'l' || $cfgcfg{$c}{t} =~ /^m/i) && $v =~ /^\s*\@\{\s*(.*?)\s*\}\s*$/) {
					my $lst = read_a_file(get_file_path_name($1,'.*\S'));
					if ($cfgcfg{$c}{t} eq 'l') {
						${$cfgcfg{$c}{v}} = '';
						foreach my $le (@{$lst}) {
							$le =~ s/[\r\n]+//gs;
							unless ($le =~ /\\[.@]/) {
								$le =~ s/\./\\./g;
								$le =~ s/\@/\\\@/g;
							}
							next unless ($le);
							${$cfgcfg{$c}{v}} .= '|' if (${$cfgcfg{$c}{v}} ne '');
							${$cfgcfg{$c}{v}} .= $le
						}
					} elsif ($cfgcfg{$c}{t} =~ /^m/i) {
						foreach my $le (@{$lst}) {
							$le =~ s/[\r\n]+//gs;
							${$cfgcfg{$c}{v}} .= ';' if (${$cfgcfg{$c}{v}} ne '');
							${$cfgcfg{$c}{v}} .= $le;
						}
					}
				} else {
					${$cfgcfg{$c}{v}} = $v;
					$cfgcfg{$c}{x} = 1;
				}
			}
		}
	}
	close(F);
	#return;
	my @ck = sort { $cfgcfg{$a}{i} <=> $cfgcfg{$b}{i} } keys %cfgcfg;
	foreach my $c (@ck) {
		next if ($c =~ /^\@/);
		${$cfgcfg{$c}{v}} = ${$cfgcfg{$cfgcfg{$c}{f}}{v}} if ($cfgcfg{$c}{f} && !${$cfgcfg{$c}{v}});
	}
	foreach my $c (@ck) {
		next if ($c =~ /^\@/);
		if ($cfgcfg{$c}{t} eq 'l') {
			${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} =~ s/\s//g;
			unless (${$cfgcfg{$c}{v}} =~ /\\[.@]/) {
				${$cfgcfg{$c}{v}} =~ s/\./\\./g;
				${$cfgcfg{$c}{v}} =~ s/\@/\\\@/g;
			}
			${$cfgcfg{$c}{v}} =~ s/,/\|/g if (${$cfgcfg{$c}{v}} !~ /[\(\)\|\{\}]/ && ${$cfgcfg{$c}{v}} =~ /\,/);
			${$cfgcfg{$c}{v}} = sprintf('(?:%s)',${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /^\(.*\)$/ && ${$cfgcfg{$c}{v}} =~ /\|/);
		} elsif ($cfgcfg{$c}{t} eq 'a') {
			${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
			next unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} .= '@'.${$cfgcfg{'myfilterhostname'}{v}} if (${$cfgcfg{$c}{v}} =~ /^[^@]+$/);
		} elsif ($cfgcfg{$c}{t} eq 't') {
			${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = sprintf(${$cfgcfg{$c}{v}},${$cfgcfg{'myfilterhostname'}{v}});
			${$cfgcfg{$c}{v}} =~ s/[\r\n]*$/\n\n/s;
		} elsif ($cfgcfg{$c}{t} eq 'b') {
			${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = 0 if (${$cfgcfg{$c}{v}} =~ /^\s*(false|no?|off|0+)\s*$/);
			${$cfgcfg{$c}{v}} = 1 if (${$cfgcfg{$c}{v}});
		} elsif ($cfgcfg{$c}{t} eq 'i') {
			${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = eval(${$cfgcfg{$c}{v}});
		} elsif ($cfgcfg{$c}{t} eq 'f') {
			${$cfgcfg{$c}{v}} = 0.0 unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = eval(${$cfgcfg{$c}{v}});
		} elsif ($cfgcfg{$c}{t} eq 'ps') {
			${$cfgcfg{$c}{v}} = $Features{'Path:SPOOLDIR'} unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = sprintf('%s/%s',$Features{'Path:SPOOLDIR'},${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /[\/\\]/);
		} elsif ($cfgcfg{$c}{t} eq 'pc') {
			${$cfgcfg{$c}{v}} = $Features{'Path:CONFDIR'} unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = sprintf('%s/%s',$Features{'Path:CONFDIR'},${$cfgcfg{$c}{v}}) if (${$cfgcfg{$c}{v}} !~ /[\/\\]/);
		} elsif ($cfgcfg{$c}{t} eq 'p') {
			${$cfgcfg{$c}{v}} = $Features{'Path:CONFDIR'} unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = sprintf(${$cfgcfg{$c}{v}},$Features{'Path:SPOOLDIR'},$Features{'Path:CONFDIR'});
		} elsif ($cfgcfg{$c}{t} eq 'mpsm') {
			my @pil = split(/\s*;\s*/,${$cfgcfg{$c}{v}});
			for (my $i=0;$i<@pil;$i++) {
				my ($fn,$ft,$fo,$x) = split(/\s*,\s*/,$pil[$i]);
				$fn = sprintf('%s/%s',${$cfgcfg{'sendmailconfig'}{v}},$fn) if ($fn !~ /[\/\\]/);
				$fo = '?' unless ($fo);
				unless ($ft) {
					if ($fn =~ /table/i) {
						$ft = 'table'
					} else {
						$ft = 'list';
					}
				}
				$pil[$i] = join(',',$fn,lc($ft),lc($fo));
			}
			${$cfgcfg{$c}{v}} = join(';',@pil);
		} elsif ($cfgcfg{$c}{t} eq 'mbs') {
			${$cfgcfg{$c}{v}} = 0 unless (${$cfgcfg{$c}{v}});
			${$cfgcfg{$c}{v}} = 0 if (${$cfgcfg{$c}{v}} =~ /^\s*(false|no|n|off|0+)\s*$/);
			${$cfgcfg{$c}{v}} = 1 if (${$cfgcfg{$c}{v}} =~ /^\s*(true|yes|y|on|\d*[1-9]\d*)\s*$/);
		} else {
			${$cfgcfg{$c}{v}} = '' unless (${$cfgcfg{$c}{v}});
		}
	}
	if ($database_spec =~ /sqlite/i) {
		$sqldbd = 'L';
	} elsif ($database_spec =~ /mysql/i) {
		$sqldbd = 'M';
	}
}

# Virus check disabling
my %AntiVirusConfig = ();
sub read_antivirus_feature_config {
	my $vfn = get_file_path_name('antivirus');
	return unless ($vfn);
	debug_log(3,'read_antivirus_feature_config %s',$vfn);
	if (open(CF,'<',$vfn)) {
	#if (open(CF,'<','/etc/mail/mimedefang-antivirus')) {
		while (my $l = <CF>) {
			$l =~ s/[\r\n]+//gs;
			next if ($l =~ /^[;#\@=]/);
			#debug_log(0,'read_antivirus_feature_config %s',$l);
			if ($l =~ /^\s*(\d+)\s*:\s*(\S+)\s*$/) {
				$AntiVirusConfig{$2}{la} = $1;
				#debug_log(0,'read_antivirus_feature_config la %s = %s',$2,$1);
			} elsif ($l =~ /^\s*(\d+)\s*\%\s*:\s*(\S+)\s*$/) {
				$AntiVirusConfig{$2}{sp} = $1;
				#debug_log(0,'read_antivirus_feature_config sp %s = %s',$2,$1);
			} elsif ($l =~ /^\s*!\s*(\S+)\s*$/) {
				$Features{"Virus:$1"} = 0;
				debug_log(4,'$Features{Virus:%s} = 0',$1);
			} elsif ($l =~ /^\s*(\S+)\s*(.*?)\s*$/) {
				$Features{"Virus:$1"} = $2;
				debug_log(4,'$Features{Virus:%s} = %s',$1,$2);
			}
		}
		close(CF);
	}
	foreach my $av (keys %AntiVirusConfig) {
		$AntiVirusConfig{$av}{fn} = $Features{"Virus:$av"};
	}
}

# Initialize some stuff from the sendmail config
sub read_sendmail_config_stuff {
	return unless ($sm_domains);
	my $dl = $OurDomains;
	$dl =~ s/^\(\?:(.*)\)$/$1/;
	$dl =~ s/\\\././g;
	foreach my $smd (split(/;/,$sm_domains)) {
		my ($smdfn,$smdft,$smdfo,$xxx) = split(/,/,$smd);
		next unless ($smdfn);
		unless (open(CF,'<',$smdfn)) {
			debug_log(-1,'Cannot read sendmail file %s',$smdfn);
			die("Cannot read sendmail file $smdfn!") if ($smdfo =~ /\!/);
			next;
		}
		my $mdfignore = 0;
		if ($smdft eq 'table') {
			while (my $l = <CF>) {
				$l =~ s/[\r\n]+//g;
				if ($l =~ /^\s*\#\s*mdf-?ignore\s+begin\s*$/i) {
					$mdfignore ++;
				} elsif ($l =~ /^\s*\#\s*mdf-?ignore\s+end\s*$/i) {
					$mdfignore --;
				} elsif ($mdfignore < 1) {
					next if ($l =~ /^\s*#/);
					if ($l =~ /^(\S+)\s+smtp:\[(\S+)\]\s*$/) {
						my $d = $1;
						my $h = $2;
						next if (!$d || !$h);
						if ($dl !~ /^(|.*\|)$d(|\|.*)/) {
							$dl .= '|' if ($dl);
							$dl .= '*' if ($d =~ /^\./);
							$dl .= $d;
						}
						#next if ($h !~ /^10\./);
						next if ($h !~ /^$LocalNets$/i);
						next if ($NoCheckUserDomains && $d =~ /$NoCheckUserDomains$/i);
						next if ($NoCheckUserServers && $d =~ /^$NoCheckUserServers$/i);
						$storingservers{lc($d)} = $h;
						debug_log(1,"mailertable: $d -> $h");
					}
				}
			}
			close(CF);
		} elsif ($smdft eq 'list') {
			while (my $l = <CF>) {
				$l =~ s/[\r\n]+//g;
				if ($l =~ /^\s*\#\s*mdf-?ignore\s+begin\s*$/i) {
					$mdfignore ++;
				} elsif ($l =~ /^\s*\#\s*mdf-?ignore\s+end\s*$/i) {
					$mdfignore --;
				} elsif ($mdfignore < 1) {
					next if ($l =~ /^\s*#/);
					$l =~ s/\s+$//;
					next if (!$l || $l =~ /\s/);
					if ($dl !~ /^(|.*\|)$l(|\|.*)/) {
						$dl .= '|' if ($dl);
						$dl .= $l;
					}
				}
			}
			close(CF);
		} else {
			debug_log(-1,'Unknown file type %s (%s)',$smdft,$smdfn);
			die("Unknown file type $smdft ($smdfn)") if ($smdfo =~ /\!/);
			close(CF);
		}
	}
	$dl =~ s/(\.)/\\$1/g;
	$dl =~ s/\*/.*/g;
	$dl =~ s/\?/./g;
	debug_log(1,"domains: ($dl)");
	$OurDomains = "($dl)";
}

# create file
sub create_file {
	my ($fn) = @_;
	return 1 if (-f $fn);
	return 0 unless (open(NF,'>>',$fn));
	close(NF);
	return 1;
}

# Get 1 minute load average
sub get_load_average {
	return undef unless (load_modules('Sys::Load'));
	#debug_log(0,'get_load_average');
	my @la = Sys::Load::getload();
	#debug_log(0,'get_load_average %s',join(' ',@la));
	return undef unless (@la && $#la == 2);
	return $la[0];
}

# Get swap uasge percentage of real mem
sub get_swap_percentage {
	return undef unless (load_modules('Sys::MemInfo'));
	#debug_log(0,'get_swap_percentage');
	my $us;
	eval {
		my $ts = Sys::MemInfo::totalswap();
		my $fs = Sys::MemInfo::freeswap();
		$us = ($ts-$fs) if (defined($ts) && defined($fs));
	};
	return undef unless (defined($us));
	#debug_log(0,'get_swap_percentage us %i',$us);
	return 0 unless ($us>0);
	my $tm;
	eval { $tm = Sys::MemInfo::totalmem(); };
	return undef unless (defined($tm));
	#debug_log(0,'get_swap_percentage tm %i',$tm);
	return undef unless ($tm>0);
	#debug_log(0,'get_swap_percentage %f',$us/$tm);
	return ($us/$tm)*100;
}

# Strip strings
sub address_strip_nc($) {
	my ($a) = @_;
	$a = '' unless (defined($a));
	$a =~ s/[\r\n]+//gs;
	$a =~ s/^[<\[]//;
	$a =~ s/[>\]]$//;
	#$a =~ s/^(.*\@)?\s*(\S+)(\s.*)?$/$1$2/;
	return $a;
}
sub address_strip($) {
	my ($a) = @_;
	return lc(address_strip_nc($a));
}
sub address_strip_p($) {
	my ($a) = @_;
	$a = '' unless (defined($a));
	$a =~ s/^<(.*?)>$/$1/;
	return $a;
}
sub address_strip_opt($) {
	my $a = address_strip(shift);
	$a =~ s/^(.+)[-+=][^\@]+(\@[^\@]+)$/$1$2/;
	return $a;
}

sub address_split_nc($) {
	my $a = address_strip_nc(shift);
	my $usr = '';
	my $dom = '';
	if ($a =~ /^\s*(\S*)\@(\S+?)\s*$/) {
		$usr = $1;
		$dom = $2;
	} else {
		$usr = $a;
		$usr =~ s/^\s+//;
		$usr =~ s/\s+$//;
	}
	my $inf = '';
	my $pinf = '';
	if ($usr =~ /^(.*)\+(.*)$/) {
		$inf = $2;
		$usr = $1;
		$pinf = "+$inf";
	}
	return ($usr,$dom,$inf,$pinf);
}
sub address_split($) {
	my ($usr,$dom,$inf,$pinf) = address_split_nc(shift);
	return (lc($usr),lc($dom),$inf,$pinf);
}

# is $a a sub domain of $b?
sub is_sub_domain($$) {
	my $a = address_strip(shift);
	my $b = address_strip(shift);
	$a =~ s/^.*\@//;
	$b =~ s/^.*\@//;
	$b =~ s/\./\\./g;
	return 0 unless ($a && $b);
	return 1 if ($a =~ /^(|.*\.)$b$/);
	return 0;
}
sub is_sub_domains {
	my ($al,$bl) = @_;
	return 0 unless ($al && @{$al} && $bl && @{$bl});
	foreach my $a (@{$al}) {
		my $ok = 0;
		foreach my $b (@{$bl}) {
			if (is_sub_domain($a,$b)) {
				$ok = 1;
				last;
			}
		}
		return 0 unless ($ok);
	}
	return 1;
}

# address in expression?
sub address_match {
	my $regex = shift;
	return 0 unless ($regex);
	for (my $i=0;$i<@_;$i++) {
		return $i+1 if ($_[$i] =~ /^<?$regex>?$/i);
	}
	return 0;
}

# return a time string...
sub time_string {
	my ($time,$ss) = @_;
	my $h = int($time / (60*60));
	$time = $time % (60*60);
	my $m = int($time / 60);
	my $s = $time % 60;
	my $r = "";
	if ($ss) {
		return sprintf('%u:%02u:%02u',$h,$m,$s) if ($h);
		return sprintf('%u:%02u',$m,$s) if ($m);
		return "$s";
	}
	if ($h) {
		$r .= "$h hour";
		$r .= 's' if ($h != 1);
	}
	if ($m || $h) {
		if ($h && !$s) {
			$r .= ' and ';
		} elsif ($h) {
			$r .= ', ';
		}
		$r .= "$m minute";
		$r .= 's' if ($m != 1);
	}
	if ($s) {
		$r .= ' and ' if ($h || $m);
		$r .= "$s second";
		$r .= 's' if ($s != 1);
	}
	return $r;
}

sub hashstring {
	my ($hash,$r) = @_;
	my @str = ();
	if ($hash) {
		foreach my $key (sort { lc($a) cmp lc($b) } keys %{$hash}) {
			my $val = $hash->{$key};
			next unless (defined($val));
			while (ref($val) eq 'SCALAR') {
				$val = $$val;
			}
			if (ref($val) eq 'ARRAY') {
				if ($r) {
					$val = '['.join(',',@{$val}).']';
				} else {
					my @val = ();
					foreach my $itm (@{$val}) {
						if (ref($itm) eq 'HASH') {
							push @val, hashstring($itm,1);
						} else {
							push @val, $itm;
						}
					}
					$val = '['.join(',',@val).']';
				}
				$val = '[...]' if (length($val)>32);
			} elsif (ref($val) eq 'HASH') {
				if ($r) {
					$val = '{...}';
				} else {
					$val = '{'.hashstring($val,1).'}';
					$val = '{...}' if (length($val)>32);
				}
			} elsif (ref($val) && $val =~ /^(\S+)=/) {
				$val = "<$1>";
			} elsif (ref($val)) {
				$val = '<'.ref($val).'>';
			} else {
				$val = '' unless (defined($val));
				$val = '(...)' if (length($val)>128);
			}
			$val =~ s/[\s\r\n]+/ /s;
			push @str, $r ? "$key:$val" : "$key=$val" unless ($val eq '');
		}
	}
	return join($r ? ',' : '; ',@str);
}

# This procedure returns true for entities with bad filenames.
sub check_bad_filename($) {
	my($entity) = @_;
	return 0 unless ($del_bad_ext);
	my $re = '\.' . $bad_exts . '\.*([^-A-Za-z0-9_.,;]|$)';
	return re_match($entity,$re);
}

$filetype = undef;
sub check_file_type {
	my ($f) = @_;
	unless ($filetype) {
		return '' unless (load_modules('File::Type'));
		$filetype = File::Type->new();
		return '' unless ($filetype);
	}
	return $filetype->checktype_filename($f);
}

my $geoip = undef;
sub init_geoip {
	return 1 if ($geoip);
	return 0 unless (load_modules('Geo::IP'));
	$geoip = {};
	$geoip->{oc} = Geo::IP->open('/usr/local/share/GeoIP/GeoIPCity.dat',GEOIP_INDEX_CACHE|GEOIP_CHECK_CACHE) if (-e '/usr/local/share/GeoIP/GeoIPCity.dat');
	$geoip->{oc} = Geo::IP->open('/usr/local/share/GeoIP/GeoLiteCity.dat',GEOIP_INDEX_CACHE|GEOIP_CHECK_CACHE) if (!$geoip->{city} && (-e '/usr/local/share/GeoIP/GeoLiteCity.dat'));
	$geoip->{od} = Geo::IP->new(GEOIP_INDEX_CACHE|GEOIP_CHECK_CACHE);
	$geoip->{cn} = {'AF'=>'Africa','AS'=>'Asia','EU'=>'Europe','NA'=>'North America','OC'=>'Oceania','SA'=>'South America'} if ($geoip->{oc});
	return 1 if ($geoip->{od} || $geoip->{oc});
	return 0;
}
sub get_ip_geo {
	my $a = shift;
	my $i = shift;
	my $o = shift;
	unless ($o) {
		return '' if (check_black_nets($a));
		return '' unless (init_geoip());
	}
	if ($geoip->{oc}) {
		my $ir;
		if ($geoip->{rc} && $geoip->{rc}->{w} eq $a) {
			#debug_log(0,'get_ip_geo: CC %s',$a);
			$ir = $geoip->{rc}->{v};
		} else {
			$ir = eval('$geoip->{oc}->record_by_addr($a)');
			$geoip->{rc}->{w} = $a;
			$geoip->{rc}->{v} = $ir;
		}
		if ($ir) {
			my $r = eval(sprintf('$ir->%s',($i eq 'continent_name') ? 'continent_code' : $i));
			if ($r) {
				if ($i eq 'continent_name') {
					debug_log(0,'get_ip_geo: GC %s %s %s',$a,$i,$r);
					$r = $geoip->{cn}->{uc($r)} if ($geoip->{cn}->{uc($r)});
				}
				#debug_log(0,'get_ip_geo: RC %s %s %s',$a,$i,$r);
				return $r;
			}
		}
	}
	if ($geoip->{od} && $i =~ /^country_(?:name|code3?)$/) {
		my $r = eval(sprintf('$geoip->{od}->%s_by_addr($a)',$i));
		if ($r) {
			#debug_log(0,'get_ip_geo: RD %s %s %s',$a,$i,$r);
			return $r;
		}
	}
	return '';
}
sub get_ip_country {
	my $a = shift;
	return get_ip_geo($a,'country_name',0) unless (@_);
	my @r = ();
	return @r if (check_black_nets($a));
	return @r unless (init_geoip());
	my $o = '';
	foreach my $c (@_) {
		if ($c =~ /^\?/i) {
			$o .= $c;
			next;
		}
		my $x;
		if (length($c) == 3 || $c =~ /3/) {
			$x = get_ip_geo($a,'country_code3',1);
		} elsif (length($c) == 2 || $c =~ /2/) {
			$x = get_ip_geo($a,'country_code',1);
		} else {
			$x = get_ip_geo($a,'country_name',1);
		}
		next unless ($x);
		push @r, $x;
		$r[$#r] = lc($r[$#r]) if ($o =~ /l/i);
	}
	return @r;
}
sub get_ip_location {
	my $a = shift;
	return '' if (check_black_nets($a));
	return '' unless (init_geoip());
	my @r = ();
	my $l;
	push @r, $l if ($l = get_ip_geo($a,'city',1));
	push @r, $l if ($l = get_ip_geo($a,'region_name',1));
	push @r, $l if ($l = get_ip_geo($a,'country_name',1));
	push @r, $l if ($l = get_ip_geo($a,'continent_name',1));
	return join(', ',@r);
}

sub get_ip_os {
	# IP2OS header
	my $ip = shift;
	$ip = $RelayAddr unless ($ip);
	my $ipos = '';
	my $iposver = '';
	my $iposhead = '';
	unless (check_black_nets($ip)) {
		if (load_modules('p0fIP2OS')) {
			($ipos,$iposver) = ip2osver($ip);
			#debug_log(0,'get_ip_os: %s %s',$ipos,$iposver);
			$ipos = '' unless ($ipos);
			$iposver = '' unless ($iposver);
			if ($ipos) {
				$iposhead = $ipos;
				$iposhead .= " $iposver" if ($iposver);
				debug_log(1,"ipos: $iposhead");
			}
		}
	}
	return ($ipos,$iposver,$iposhead);
}

sub get_ip_os_head {
	my ($ipos,$iposver,$iposhead) = get_ip_os(@_);
	return $iposhead;
}

sub make_answer {
	my $def = shift;
	my $msg = join('; ',@_);
	$msg = $def unless ($msg);
	$msg = "<$MsgIDs> $msg" if ($MsgIDs);
	return $msg;
}
sub reject_answer {
	return make_answer('Rejected',@_);
}
sub tempfail_answer {
	return make_answer('Try again later',@_);
}

@removed_parts = ();
sub removed_part_note($$) {
	my ($what,$why) = @_;
	push @removed_parts, "$what was removed from this document as it $why.";
	debug_log(1,'removed_part_note %i, %s', $#removed_parts, "$what was removed from this document as it $why.");
}

sub note_footer {
	my $foot = "Please give the following information to any technician or administrator you contact about this mail:\n";
	unshift @_, 'QDir: '.get_quarantine_dir() if ($did_quarantine);
	unshift @_, "MsgID: $MsgIDs";
	unshift @_, "Filter: $FilterVersion";
	unshift @_, "Gateway: $MyFilterHostName";
	foreach my $infs (@_) {
		next unless ($infs);
		next if ($infs =~ /^\S+:\s*$/);
		$infs =~ s/^([^\s:]+)[\s:]*(.*)$/$1: $2/;
		$infs =~ s/^(QDir: ).*\/([^\/]+)/$1$2/i;
		$foot .= "$infs\n";
		debug_log(2,"note_footer: info: $infs");
	}
	return $foot;
}

# Dirty mime word encoding...
sub mqpcs {
	my $cs = shift;
	$cs = 'iso-8859-1' unless ($cs);
	while (@_ && $_[0] eq '') { shift @_; }
	while (@_ && $_[$#_] eq '') { pop @_; }
	my $v = join('; ',@_);
	$v = '' unless (defined($v) && $v ne '');
	if ($v =~ /[\x00-\x1F\x7F-\xFF]/ && load_modules('MIME::Words ()','Encode')) {
		$v = MIME::Words::encode_mimeword(encode($cs,$v),'Q',$cs);
		$v =~ s/\s/_/g;
	}
	return $v;
}
sub mqp {
	return mqpcs('',@_);
}
sub mqpma {
	my $ia = shift;
	return mqp(@_) unless ($ia);
	while (@_ && $_[0] eq '') { shift @_; }
	while (@_ && $_[$#_] eq '') { pop @_; }
	my $v = join(', ',@_);
	$v = '' unless (defined($v) && $v ne '');
	my $r = '';
	while ($v =~ /^(.*?)(\s*<[^>\x00-\x1F\x7F-\xFF]*>\s*)(.*)$/) {
		$r .= mqp('',$1).$2;
		$v = $3;
	}
	return $r.mqp('',$v);
}

# retrieve mail addresses...
sub get_addresses_from_value {
	my ($adr,$al,$lo,$hn) = @_;
	return 0 unless (load_modules('Mail::Address'));
	$al = '' unless (defined($al));
	$hn = '?' unless ($hn);
	my $c = 0;
	my @a = Mail::Address->parse($adr);
	return 0 unless (@a);
	foreach my $a (@a) {
		next unless ($a->address);
		my $aa = address_strip_nc($a->address);
		next unless ($aa);
		if ($al =~ /^HASH\(0x[a-zA-Z0-9]+\)$/) {
			$al->{lc($aa)} = $aa;
		} else {
			$aa = lc($aa) if ($lo eq 'lc');
			if ($al =~ /^ARRAY\(0x[a-zA-Z0-9]+\)$/) {
				if ($lo eq 'all') {
					my $usr = lc($aa);
					my $dom = '';
					if ($usr =~ /^(.*)\@(.*?)$/) {
						$dom = $2;
						$usr = $1;
					}
					my %i = (
						header	=> lc($hn),
						object	=> $a,
						address	=> $aa,
						name	=> $a->name,
						addr	=> lc($aa),
						user	=> $usr,
						domain	=> $dom,
					);
					push @{$al}, \%i;
				} else {
					push @{$al}, $aa;
				}
			} elsif ($al =~ /^SCALAR\(0x[a-zA-Z0-9]+\)$/) {
				$$al .= "|$aa";
			} else {
				$al .= "|$aa";
			}
		}
		$c ++;
	}
	return $c;
}

# retrieve mail addresses from entity, header or string
sub get_addresses_from_header {
	my ($head,$hnl,$al,$lo) = @_;
	return 0 unless ($head);
	if ($head =~ /^(?:MIME::Entity|Mail::Internet)=/) {
		$head = $head->head;
		return 0 unless ($head);
	}
	if ($head =~ /^(?:MIME::Head|Mail::Header)=/) {
		my $c = 0;
		foreach my $hn (split(/:/,$hnl)) {
			my @hl = $head->get($hn);
			next unless (@hl);
			foreach my $h (@hl) {
				$c += get_addresses_from_value($h,$al,$lo,$hn);
			}
		}
		return $c;
	}
	if ($hnl eq '?') {
		if ($head =~ /^\s*(\S*):\s+(.*?)\s*$/) {
			return get_addresses_from_value($2,$al,$lo,$1);
		}
		return get_addresses_from_value($head,$al,$lo);
	}
	return get_addresses_from_value($head,$al,$lo,$hnl);
}

# retrieve first mail address
sub get_address_from_header {
	my ($entity,$hn,$lo) = @_;
	my @al = ();
	return $al[0] if (get_addresses_from_header($entity,$hn,\@al,$lo));
	return undef if ($lo eq 'all');
	return '';
}

sub get_addresses_string_from_header {
	my ($entity,$hn) = @_;
	my @al = ();
	return '?' unless (get_addresses_from_header($entity,$hn,\@al));
	return join(', ',@al);
}

# Get a fortune cookie...
%fortunehandlers = ();
sub get_fortune_cookie {
	my ($fn,$l1,$d) = @_;
	$d = '' unless ($d);
	return $d unless ($fn);
	debug_log(5,'get_fortune_cookie %s %u %s',$fn,$l1,$d);
	return $d unless (load_modules('Fortune'));
	if ($fortunehandlers{$fn} && $fortunehandlers{$fn}{f}) {
		$fortunehandlers{$fn} = undef if ((stat($fn))[9] != $fortunehandlers{$fn}{d} || (stat($fn))[7] != $fortunehandlers{$fn}{z});
	}
	my $fo = 0;
	if ($fortunehandlers{$fn} && $fortunehandlers{$fn}{f}) {
		debug_log(5,'get_fortune_cookie open %s',$fn);
		eval { $fortunehandlers{$fn}{f}->open_file; $fo = 1; };
	} else {
		return $d unless (-f $fn);
		$fortunehandlers{$fn}{d} = (stat(_))[9];
		$fortunehandlers{$fn}{z} = (stat(_))[7];
		debug_log(1,'get_fortune_cookie create %s',$fn);
		eval { $fortunehandlers{$fn}{f} = new Fortune($fn); };
		return $d unless ($fortunehandlers{$fn}{f});
		if (-f "$fn.dat") {
			eval { $fortunehandlers{$fn}{f}->read_header(); $fo = 1; };
		} else {
			eval { $fortunehandlers{$fn}{f}->compute_header(); $fo = 1; };
		}
	}
	unless ($fo) {
		debug_log(-1,'get_fortune_cookie error %s',$fn);
		delete $fortunehandlers{$fn};
		return $d;
	}
	my $t = 0;
	debug_log(5,'get_fortune_cookie get %u',$t);
	while ($t < 10) {
		$t ++;
		debug_log(3,'get_fortune_cookie get %u',$t);
		my $c = $fortunehandlers{$fn}{f}->get_random_fortune;
		next unless ($c);
		$c =~ s/^[\r\n\s]+//s;
		if ($l1) {
			$c =~ s/[\r\n\s]+$//s;
			next if ($c =~ /[\r\n]/);
			$c =~ s/\s+/ /gs;
		}
		next unless ($c);
		next if ($c =~ /[^\r\n\s\x20-\x7E]/);
		$fortunehandlers{$fn}{f}->close_file;
		debug_log(5,'get_fortune_cookie got %u',$t);
		return $c;
	}
	$fortunehandlers{$fn}{f}->close_file;
	debug_log(3,'get_fortune_cookie default %s',$fn);
	return $d;
}

# Get a fortune
sub get_fortune {
	return get_fortune_cookie($silly_fortunes);
}

# Get a one-liner
sub get_oneliner {
	return get_fortune_cookie($silly_oneliners,1);
}


#***********************************************************************
# SQL.
#***********************************************************************
my $sql_did;

sub sql_translate {
	my ($cmd) = @_;
	if ($sqldbd eq 'M') {
		$cmd =~ s/^INSERT OR IGNORE /INSERT IGNORE /;
	}
	return $cmd;
}

sub sql_do_commands {
	$sql_did = 0;
	for (my $i=0;$i<@_;$i++) {
		my $cmd = sql_translate($_[$i]);
		#debug_log(0,'sql_do_commands: %s ',$cmd);
		return 0 unless ($cmd);
		my $did = $sqldb->do($cmd);
		return 0 unless (defined($did));
		$sql_did += $did;
	}
	return 1;
}

sub sql_exec_commands {
	$sql_did = 0;
	for (my $i=0;$i<@_;$i++) {
		my @pars = @{$_[$i]};
		my $cmd = sql_translate(shift @pars);
		return 0 unless ($cmd);
		my $st = $sqldb->prepare_cached($cmd);
		return 0 unless ($st);
		#debug_log(0,'sql_exec_commands: %s : %s',$cmd,join(' | ',@pars));
		my $res = $st->execute(@pars);
		$st->finish;
		unless ($res) {
			debug_log(-1,'sql_exec_commands error: %s : %s',$cmd,join(' | ',@pars));
			return 0;
		}
		$sql_did += $res;
	}
	return 1;
}

sub sql_disconnect {
	$sqldb->disconnect() if ($sqldb);
	$sqldb = undef;
}

sub sql_connect {
	my $f = shift;
	sql_disconnect() if ($f);
	if ($sqldb) {
		return 1 if ($sqldbd eq 'L');
		sql_disconnect() unless (eval { $sqldb->ping });
		return 1 if ($sqldb);
		debug_log(0,'SQL Connect Old (%s)',$sqldbd);
	}
	$sqldb = DBI->connect($database_spec,$database_user,$database_pass,{RaiseError=>0});
	unless ($sqldb) {
		debug_log(-1,'SQL Connect Failed (%s) %s',$sqldbd,$DBI::errstr);
		return 0;
	}
	if ($sqldbd eq 'L') {
		sql_do_commands('PRAGMA SYNCHRONOUS=OFF');
	}
	#debug_log(0,'SQL Connect Ok (%s)',$sqldbd);
	return 1;
}

sub sql_quote {
	my $s = shift;
	sql_connect() unless ($sqldb);
	return $s unless ($sqldb);
	return $sqldb->quote($s);
}
sub sql_quotes {
	my @r = ();
	while (my $s = shift @_) {
		push @r, sql_quote($s);
	}
	return @r;
}

sub sql_do {
	return 0 unless (sql_connect());
	my $ok = sql_do_commands(@_);
	return $ok if ($sqldb->{AutoCommit});
	if ($ok) {
		#debug_log(0,'sql_do: commit');
		return $sqldb->commit;
	}
	debug_log(-1,'sql_do: rollback');
	$sqldb->rollback;
	return 0;
}

sub sql_execute_multi {
	return 0 unless (sql_connect());
	$sqldb->begin_work if ($sqldb->{AutoCommit});
	my $ok = sql_exec_commands(@_);
	return $ok if ($sqldb->{AutoCommit});
	return $sqldb->commit if ($ok);
	debug_log(-1,'sql_exec: rollback');
	$sqldb->rollback;
	return 0;
}
sub sql_execute {
	return sql_execute_multi(\@_);
}

sub sql_select {
	my $cmd = shift;
	return undef unless (sql_connect());
	return undef unless ($cmd);
	my $st;
	if (@_) {
		debug_log(7,'sql_select: %s : %s',$cmd,join(' | ',@_));
		$st = $sqldb->prepare_cached($cmd);
		$st->execute(@_) if ($st);		
	} else {
		debug_log(7,'sql_select: %s',$cmd);
		$st = $sqldb->prepare_cached("$cmd");
		$st->execute if ($st);
	}
	debug_log(-1,'sql prepare error: %s',$cmd) unless ($st);
	return $st;
}

sub sql_select_one_row {
	my $st = sql_select(@_);
	return undef unless ($st);
	my @res = $st->fetchrow_array;
	$st->finish;
	return \@res;
}

sub sql_select_one {
	my $res = sql_select_one_row(@_);
	return undef unless ($res && @{$res});
	return $res->[0];
}


#***********************************************************************
# More code.
#***********************************************************************

$overlongheader = 0;
sub check_header_length {
	my ($h,$s) = @_;
	return 0 unless (defined($h) && defined($s) && $h ne '' && $s ne '');
	if (length($h)>127 || length($s)>7*1024) {
		debug_log(-1,'overlong header %s: %s',$h,$s);
		$overlongheader ++;
		return 0;
	}
	return 1;
}

sub u7shv {
	my $v = join('; ',@_);
	$v =~ s/(\r?\n)(\r?\n)*/$1/g;
	$v =~ s/\n(\S)/\n\t$1/g;
	return $v unless ($v =~ /[\x7F-\xFF]/ && load_modules('Encode'));
	return encode('UTF-7',$v);
}

sub do_action_change_header_stnl {
	my ($h,$s,$i) = @_;
	return unless ($h && defined($s));
	$s =~ s/[\r\n\s]+$//s;
	return if ($s eq '');
	$s = u7shv($s);
	return unless (check_header_length($h,$s));
	debug_log(5,'do_action_change_header_stnl %s: %s',$h,$s);
	return action_change_header($h,$s,$i) if (defined($i));
	return action_change_header($h,$s);
}

sub do_action_insert_header {
	my ($ent,$h,$s,$i) = @_;
	return unless ($h && defined($s));
	$s =~ s/[\r\n\s]+$//s;
	return if ($s eq '');
	$s = u7shv($s);
	$i = 0 unless (defined($i));
	$ent->head->add($h,$s,$i) if (defined($ent) && defined($ent->head));
	return unless (check_header_length($h,$s));
	debug_log(5,'do_action_insert_header %s: %s',$h,$s);
	return action_insert_header($h,$s,$i);
}

sub do_action_change_header {
	my ($ent,$h,$v,$i) = @_;
	return unless ($h && defined($v));
	$v =~ s/[\r\n\s]+$//s;
	return if ($v eq '');
	$v = u7shv($v);
	if (defined($i)) {
		$ent->head->replace($h,$v,$i-1) if (defined($ent) && defined($ent->head));
		action_change_header($h,$v,$i) if (check_header_length($h,$v));
	} else {
		$ent->head->replace($h,$v) if (defined($ent) && defined($ent->head));
		action_change_header($h,$v) if (check_header_length($h,$v));
	}
	return undef;
}

sub do_action_insert_or_change_header {
	my ($entity,$header,$value,$fch,$pos) = @_;
	return unless ($header && defined($value));
	$value =~ s/[\r\n\s]+$//s;
	return if ($value eq '');
	$value = u7shv($value);
	$fch = 0 unless ($fch);
	unless ($fch && defined($entity) && defined($entity->head) && defined($entity->head->get($header))) {
		$pos = 0 unless ($pos);
		$entity->head->add($header,$value,$pos);
		debug_log(5,'do_action_insert_or_change_header %s: %s',$header,$value);
		return action_insert_header($header,$value,$pos) if (check_header_length($header,$value));
		return;
	}
	unless ($fch<0) {
		$entity->head->replace($header,$value) if (defined($entity) && defined($entity->head));
		return action_change_header($header,$value) if (check_header_length($header,$value));
	}
	return undef;
}

sub do_action_delete_header {
	my ($ent,$h,$i) = @_;
	if (defined($i)) {
		$ent->head->delete($h,$i-1) if (defined($ent) && defined($ent->head));
		action_delete_header($h,$i);
		return;
	}
	$ent->head->delete($h) if (defined($ent) && defined($ent->head));
	action_delete_header($h);
}

sub do_action_add_header {
	my ($ent,$h,$s) = @_;
	return unless ($h && defined($s));
	$s =~ s/[\r\n\s]+$//s;
	return if ($s eq '');
	$s = u7shv($s);
	$ent->head->add($h,$s,-1) if (defined($ent) && defined($ent->head));
	if (length($s)>7*1024) {
		$overlongheader ++;
		return;
	}
	return action_insert_add($h,$s);
}

# Decode a MIME encoded header value
sub decode_header {
	my $r = join('',@_);
	$r =~ s/[\r\n]+$//;
	#debug_log(0,'decode_header < %s',$r);
	if ($r =~ /=\?(\S+?)\?[QBqb]\?.*\?=/ && load_modules('MIME::Words ()','Encode')) {
		my $x = $r; $r = '';
		while ($x =~ /^(.*?)(=\?[^\?]*\?[QqBb]\?)(.*?)(\?=)(.*)$/) {
			$r .= "$1$2";
			my $d = $3; my $e = $4;
			$x = $5;
			$d =~ s/\?/=3F/gs;
			$r .= "$d$e";
		}
		$r .= $x;
		my @vl; eval { @vl = MIME::Words::decode_mimewords($r); };
		if (@vl) {
			$r = '';
			foreach my $v (@vl) {
				if ($v->[1]) {
					$v->[1] =~ s/^unicode-\d-\d-(utf-\d)$/$1/;
					my $dd;
					eval { $dd = decode($v->[1],$v->[0]); };
					unless (defined($dd)) {
						eval { $dd = decode('iso-8859-1',$v->[0]); };
						unless (defined($dd)) {
							$dd = $v->[0];
							$dd =~ s/=\?\S+?\?[QBqb]\?//gs;
							$dd =~ s/\?=//gs;
							$dd =~ s/=[A-Fa-f0-9][A-Fa-f0-9]/?/gs;
						}
					}
					$r .= $dd;
				} else {
					$r .= $v->[0];
				}
			}
			#debug_log(0,'decode_header > %s',$r);
		}
	}
	$r =~ s/[\s\r\n\t]+/ /gs;
	$r =~ s/^\s+//;
	$r =~ s/\s+$//;
	return $r;
}

# Remove paths and drive from part name header
# Just testing for now...
sub fix_entity_filename_header {
	my ($head,$hn,$ha,$hch) = @_;
	my $fn = $head->mime_attr("$hn.$ha");
	if (defined($fn)) {
		my $cs = '';
		if ($fn =~ /=\?(\S+?)\?[QBqb]\?.*\?=/) {
			$cs = $1;
			$fn = decode_header($fn);
		}
		my $nn = $fn;
		$nn =~ s/\s+/ /gs;
		$nn =~ s/^[\s]*(.*?)[\s\.]*/$1/;
		$nn =~ s/^\S+:\/\///;
		$nn =~ s/^\S+://;
		$nn =~ s/^[A-Z][\|:](.*[\\\/])?//;
		$nn =~ s/[\?\*\'\"]//g;
		$nn =~ s/^[\s]*(.*?)[\s\.]*/$1/;
		$nn =~ s/\s+/ /gs;
		$nn =~ s/[\\\/]/!/g;
		$nn =~ s/^\.+/./;
		if ($nn =~ /^(\..*)?$/) {
			$nn = "missing$1";
		}
		my $xn = $fn;
		$xn =~ s/([^ ]) +([^ ])/$1 $2/gs;
		if ($nn ne $xn) {
			debug_log(3,"fefh: $hn.$ha $fn -> $nn");
			# Only testing for now?
			#return 0;
			$head->mime_attr("$hn.$ha",mqpcs($cs,$nn));
			$hch->{lc($hn)} = $hn;
			return 1;
		}
	}
	return 0;
}

# Checks for some bad header stuff...
sub fix_entity_headers {
	my ($entity,$isroot) = @_;
	#debug_log(2,"feh 1");
	return unless ($fix_headers);
	#debug_log(2,"feh 2");
	my $head = $entity->head;
	my $r = 0;
	if ($head) {
		#debug_log(2,"feh 3");
		my %hch = ();
		debug_log(7,"feh: ".$entity->effective_type);
		my $csc = 0;
		my $fnc = 0;
		my $hbc = 0;

		# Misconfed MS Outlook Express sometimes uses strange charset,
		# but MS Outlook croaks on that. :-/
		# Replace it and hope for the best...
		if ($entity->effective_type =~ /^text\/(plain|html)$/) {
			my $cs = $head->mime_attr('content-type.charset');	
			if ($cs && lc($cs) eq 'x-user-defined') {		
				debug_log(4,"feh: cs $cs");
				$head->mime_attr('Content-Type.Charset' => 'iso-8859-1');
				$hch{'content-type'} = 'Content-Type';
				$csc ++;
			}
		}
		my @tl = $head->tags;
		foreach my $tn (@tl) {
			my $tc = $head->count($tn);
			debug_log(7,"feh: head $tn $ti");
			for (my $ti=0;$ti<$tc;$ti++) {
				my $tv = $head->get($tn,$ti);
				next unless ($tv);
				debug_log(7,"feh: head o $tn\[$ti\] $tv");
				my $tx = $tv;
				# We don't like high bit chars in headers, but only check a couple of commonly bad headers
				if ($isroot && $tn =~ /^(From|To|Reply-To|Subject)$/i && $tv =~ /[^\t\r\n\x20-\x7E]/) {
					my $fia = ($tn =~ /^(From|To|Reply-To)$/i);
					my $txt = $tx;
					$tx = '';
					while ($txt =~ /^(\s*)(.*?)(\s*[\r\n]+\s*)(.*)$/s) {
						$txt = $4;
						$tx .= $1.mqpma($fia,$2).$3;
					}
					$tx .= mqpma($fia,$txt);
					debug_log(2,'feh: hb %s %s %s',$tn,$tv,$tx);
				}
				$tx =~ s/=\?x-user-defined\?/=?iso-8859-1?/gsi;
				if ($tx ne $tv) {
					debug_log(4,"feh: head n $tn\[$ti\] $tx");
					$head->replace($tn,$tx,$ti);
					$hch{lc($tn)} = $tn;
					$csc ++;
				}
			}
		}
		$r += $csc;

		# We don't like paths and protocols/drives in filenames. Remove them.
		$fnc ++ if (fix_entity_filename_header($head,'Content-Type','filename',\%hch));
		$fnc ++ if (fix_entity_filename_header($head,'Content-Type','name',\%hch));
		$fnc ++ if (fix_entity_filename_header($head,'Content-Disposition','filename',\%hch));
		$fnc ++ if (fix_entity_filename_header($head,'Content-Disposition','name',\%hch));
		
		$r += $fnc;
		# If we're at the root, headers must be changed through milter stuff...
		if ($isroot) {
			foreach my $hn (keys %hch) {
				next unless ($hch{$hn});
				do_action_change_header_stnl($hch{$hn},$head->get($hn));
			}
		}

		#debug_log(2,"feh e1");
		if ($csc) {
			$modhead{'Replaced bad charset.'} ++;
			debug_log(2,"header, bad charset");
			#md_graphdefang_log('modified_entity', 'charset');
			stats_log('modified',$MsgIDs,'modified_entity','charset');
			#do_action_add_header($entity,'X-MIME-Fixed',"replaced bad charset with 'iso-8859-1' at $MyFilterHostName") if ($isroot);
		}
		if ($fnc) {
			$modhead{'Changed bad part name.'} ++;
			debug_log(2,"header, bad part name");
			#md_graphdefang_log('modified_entity', 'name');
			stats_log('modified',$MsgIDs,'modified_entity','name');
		}
	}
	#debug_log(2,"feh ee");
	return $r;
}

# saves time stamp
sub save_time_stamp() {
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO times (ts_id,ts_stamp) VALUES (?,?) '.
			    'ON DUPLICATE KEY UPDATE ts_stamp=VALUES(ts_stamp)',
			    $MsgIDs,time());
	} else {
		sql_execute('REPLACE INTO times (ts_id,ts_stamp) VALUES (?,?)',$MsgIDs,time());
	}
}

sub time_since_stamp() {
	my $time = sql_select_one('SELECT ts_stamp FROM times WHERE ts_id=?',$MsgIDs);
	return time()-$time if ($time);
	return -1;
}

sub end_time_stamp() {
	return unless ($MsgIDs);
	my $start = sql_select_one('SELECT ts_stamp FROM times WHERE ts_id=?',$MsgIDs);
	my $now = time();
	my $time = $now-$start if ($start);
	$time = 0 unless ($time);
	sql_execute('UPDATE times SET ts_end=?,ts_time=? WHERE ts_id=?',$now,$time,$MsgIDs);
	stats_log('time',$MsgIDs,$time,get_load_average(),get_swap_percentage()) if ($start);
}

sub clean_time_stamps {
	return 0 unless ($ts_keep);
	debug_log(0,'%u ts rec(s) removed',$sql_did) if (sql_execute('DELETE FROM times WHERE (ts_stamp<?)',time()-$ts_keep) && $sql_did>0);
	return $sql_did;
}

my %resolvers = ();
sub get_resolver {
	my ($to) = @_;
	$to = 5 unless ($to);
	return $resolvers{$to} if (defined($resolvers{$to}));
	return undef unless (load_modules('Net::DNS'));
	$resolvers{$to} = Net::DNS::Resolver->new;
	$resolvers{$to}->persistent_tcp(0);
	$resolvers{$to}->tcp_timeout($to);
	$resolvers{$to}->udp_timeout($to);
	return $resolvers{$to};
}
sub get_rdnses {
	my $ip = address_strip_nc(shift);
	my $to = shift;
	return () unless($ip);
	return ($ip) unless ($ip =~ /^\d+\.\d+\.\d+\.\d+$/);
	my $dns = get_resolver($to?$to:5);
	return () unless (defined($dns));
	#debug_log(0,'get_rdnses < %s',$ip);
	my $ptr = $dns->query($ip,'PTR');
	return () unless ($ptr);
	my %rnl = ();
	foreach my $r ($ptr->answer) {
		next unless ($r->type eq 'PTR');
		next unless ($r->ptrdname);
		#debug_log(0,'get_rdnses > %s %s',$ip,$r->ptrdname);
		$rnl{$r->ptrdname} = 1;
	}
	return wantarray ? keys %rnl : [keys %rnl];
}
sub get_rdns {
	foreach my $rn (get_rdnses(@_)) {
		return $rn if ($rn);
	}
	return '['.address_strip_nc($_[0]).']';
}

sub get_hostips {
	my $host = address_strip_nc(shift);
	my $to = shift;
	my $ma = shift;
	return () unless($host);
	return ($host) if ($host =~ /^\d+\.\d+\.\d+\.\d+$/);
	my $dns = get_resolver($to?$to:5);
	return () unless (defined($dns));
	#debug_log(0,'get_hostip < %s',$host);
	my $adr = $dns->query($host,'A');
	return () unless ($adr);
	my %ipl = ();
	my $ic = 0;
	foreach my $r ($adr->answer) {
		next unless ($r->type eq 'A');
		next unless ($r->address);
		#debug_log(0,'get_hostip > %s %s',$host,$r->address);
		$ipl{$r->address} = 1;
		$ic ++;
		last if ($ma && $ic >= $ma);
	}
	return wantarray ? keys %ipl : [keys %ipl];
}
sub get_hostip {
	my ($host,$to) = @_;
	my @ipl = get_hostips($host,$to,1);
	return @ipl ? $ipl[0] : '';
}

sub get_full_circle_dnses {
	my $ip = address_strip_nc(shift);
	my $to = shift;
	return () unless($ip && $ip =~ /^\d+\.\d+\.\d+\.\d+$/);
	debug_log(8,'get_full_circle_dnses < %s',$ip);
	my %fcnl = ();
	my $dns;
	foreach my $rn (get_rdnses($ip,$to)) {
		next unless ($rn && $rn !~ /^\d+\.\d+\.\d+\.\d+$/);
		foreach my $an (get_hostips($rn,$to)) {
			debug_log(5,'get_full_circle_dnses > %s %s',$ip,$rn);
			$fcnl{$rn} = 1 if ($an eq $ip);
		}
	}
	return wantarray ? keys %fcnl : [keys %fcnl];
}
sub get_full_circle_dns {
	foreach my $fcn (get_full_circle_dnses(@_)) {
		return $fcn if ($fcn);
	}
	return '';
}

sub get_mxes {
	my ($d,$to,$rip) = @_;
	my $dns = get_resolver($to?$to:15);
	return () unless (defined($dns));
	my @mx = ();
	my $mx = $dns->query($d,'MX');
	if ($mx) {
		foreach my $r ($mx->answer) {
			next unless ($r->type eq 'MX');
			next unless ($r->exchange);
			#debug_log(0,'get_mxes %s %s',$d,$r->exchange);
			push @mx, {p=>$r->preference,x=>$r->exchange};
		}
	}
	push @mx, {p=>0,x=>$d} unless (@mx);
	if ($rip) {
		foreach my $mxr (@mx) {
			#debug_log(0,'get_mxes ip %s',$mxr->{x});
			$mxr->{a} = [get_hostips($mxr->{x})];
		}
	}
	return wantarray ? @mx : \@mx;
}

sub server_is_mx {
	my ($ip,$host,$addr) = @_;
	#debug_log(0,'server_is_mx %s %s %s',$ip,$host,$addr);
	$addr = address_strip($addr);
	if ($addr && $addr =~ /^.*\@([^\@]+)$/) {
		my $dom = $1;
		foreach my $mx (get_mxes($dom,5,1)) {
			foreach my $aa (@{$mx->{a}}) {
				#debug_log(0,'server_is_mx a %s %s',$dom,$aa);
				if ($aa eq $ip) {
					debug_log(3,'server_is_mx %s %s',$dom,$aa);
					return $dom;
				}
			}
		}
	}
	return 0 if ($host =~ /^\[?\d+\.\d+\.\d+\.\d+\]?$/);
	my @hosts;
	if ($host) {
		#debug_log(0,'server_is_mx h %s',$host);
		@hosts = ($host);
	} else {
		#debug_log(0,'server_is_mx q %s',$ip);
		@hosts = get_rdnses($ip);
	}
	my %doms = ();
	foreach $host (@hosts) {
		my @hnl = split(/\./,$host);
		while ($#hnl > 2) { shift @hnl; }
		while ($#hnl > 0) {
			$doms{lc(join('.',@hnl))} = 1;
			shift @hnl;
		}
	}
	foreach my $dom (keys %doms) {
		#debug_log(0,'server_is_mx d %s',$dom);
		foreach my $mx (get_mxes($dom,5,1)) {
			foreach my $aa (@{$mx->{a}}) {
				#debug_log(0,'server_is_mx d %s %s',$dom,$aa);
				if ($aa eq $ip) {
					debug_log(3,'server_is_mx %s %s',$dom,$aa);
					return $dom;
				}
			}
		}
	}
	#debug_log(0,'server_is_mx -');
	return 0;
}

sub check_dnsls {
	my $addr = shift;
	my $to = shift;
	my $wans = shift;
	my @hits = ();
	$to = 15 unless ($to);
	$wans = 1 unless ($wans && $wans > 0);
	debug_log(3,'check_dnsls ? %u %s %s',$wans,$addr,join(' ',@_));
	my %domains = ();
	while (@_) {
		my $chk = lc(shift @_);
		my $tst = 0;
		if ($chk =~ /^(.*)[:=](.*)$/) {
			$chk = $1;
			$tst = $2;
		}
		$chk =~ s/^[\.\s]+//;
		$chk =~ s/[\.\s]+$//;
		$tst =~ s/^\s+//;
		$tst =~ s/\s+$//;
		$domains{$chk} = {tl=>[]} unless ($domains{$chk});
		push @{$domains{$chk}->{tl}}, $tst;
	}
	return wantarray ? (0,\@hits) : 0 unless (%domains);
	my $dns = get_resolver($to);
	return wantarray ? (0,\@hits) : 0 unless ($dns);
	my $caddr = $addr;
	if ($caddr =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { $caddr = "$4.$3.$2.$1"; }
	my $doms = 0;
	debug_log(7,'check_dnsls > %u %s',scalar keys %domains,join(' ',keys %domains));
	foreach my $dom (keys %domains) {
		$domains{$dom}->{qs} = $dns->bgsend("$caddr.$dom",'A');
		$doms ++ if ($domains{$dom}->{qs});
		debug_log(1,'check_dnsls > %u %s',$doms,"$caddr.$dom");
	}
	debug_log(7,'check_dnsls = %u %s',$doms,join(' ',keys %domains));
	$to = time() + $to;
	my $pans = 0;
	while ($doms) {
		foreach my $dom (keys %domains) {
			next unless ($domains{$dom}->{qs});
			next unless ($dns->bgisready($domains{$dom}->{qs}));
			my $pkt = $dns->bgread($domains{$dom}->{qs});
			$domains{$dom}->{qs}->close;
			delete $domains{$dom};
			$doms --;
			unless (defined($pkt)) {
				last unless ($doms);
				next;
			}
			debug_log(1,'check_dnsls < %s',$dom);
			my %ga = ();
			foreach my $ans ($pkt->answer) {
				next unless ($ans->class eq 'IN');
				next unless ($ans->type eq 'A');
				next unless ($ans->address);
				next if ($ga{$ans->address});
				foreach my $tst (@{$domains{$dom}->{tl}}) {
					next unless (!(%ga || $tst) || ($tst eq $ans->address));
					debug_log(1,'check_dnsls @ %s %s %s %s',$dom,$ans->address,$tst,$addr);
					push @hits, $dom;
					$pans ++;
				}
				$ga{$ans->address} = 1;
				last if ($pans >= $wans);
			}
			last if ($pans >= $wans);
			last unless ($doms);
		}
		last if ($pans >= $wans);
		last unless ($doms);
		last if (time() > $to);
		sleep(1);
	}
	foreach my $inf (values %domains) {
		$inf->{qs}->close if ($inf->{qs});
	}
	debug_log(3,'check_dnsls ! %u %u %s %s',$wans,$pans,$addr,join(' ',keys %domains));
	return wantarray ? ($pans,\@hits) : $pans if ($pans >= $wans);
	return wantarray ? (0,\@hits) : 0;
}

sub trim_host_part {
	my $addr = address_strip(shift @_);
	my $toboundary = shift @_;
	return $addr unless (load_modules('Mail::SpamAssassin::Util::RegistrarBoundaries'));
	my $dn = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($addr);
	return $addr unless ($dn);
	return $dn if ($toboundary);
	#debug_log(0,'trim_host_part < %s %s',$addr,$dn);
	$addr =~ s/^(.*?\.)([^.]+\.$dn)$/$2/;
	#debug_log(0,'trim_host_part > %s %s',$addr,$dn);
	return $addr;
}

sub trim_hosts_parts_i {
	my $toboundary = shift;
	my %dnl = ();
	while (@_) {
		my $addr = address_strip(shift @_);
		if ($addr =~ /^\d+\.\d+\.\d+\.\d+$/) {
			push @_, get_rdnses($addr);
		} elsif ($addr) {
			$dnl{trim_host_part($addr,$toboundary)} = 1;
		}
	}
	return wantarray ? keys %dnl : [keys %dnl];
}

sub get_hosts_parts_names {
	my %hpl = ();
	while (@_) {
		my $addr = address_strip(shift @_);
		if ($addr =~ /^\d+\.\d+\.\d+\.\d+$/) {
			push @_, get_full_circle_dnses($addr);
		} elsif ($addr) {
			$hpl{$addr} = 1;
			$hpl{trim_host_part($addr)} = 1;
		}
	}
	return wantarray ? keys %hpl : [keys %hpl];
}
sub trim_hosts_parts {
	return trim_hosts_parts_i(0,@_);
}
sub get_domains_parts {
	return trim_hosts_parts_i(1,@_);
}

#***********************************************************************
# Dynamic host name checks.
#***********************************************************************

sub check_ip_parts {
	my $x = shift;
	return 0 if ($x && @_ != 4);
	my $ic = 0;
	my $hc = 0;
	foreach my $p (@_) {
		unless ($x) {
			my @pp = split(/-/,$p);
			return 3 if (check_ip_parts(1,@pp));
			@pp = split(/_/,$p);
			return 3 if (check_ip_parts(1,@pp));
		}
		my $i = ($p =~ /^\d{1,3}$/ && $p >= 0 && $p <= 255);
		my $h = 0;
		if ($p =~ /^[0-9A-Fa-f]{1,2}$/) {
			my $i = hex $p;
			$h = ($i >= 0 && $i <= 255);
		}
		$ic ++ if ($i);
		$hc ++ if ($h);
		return 2 if ($ic == 4);
		return 1 if ($hc == 4);
	}
	return 0;
}

sub check_ip_fqdn {
	my $fqdn = shift;
	my $ip = shift;
	return 0 if ($fqdn =~ /^\[$ip\]$/);
	if ($ip =~ /^\d+\.\d+\.\d+\.\d+$/) {
		my $rip = join('.',reverse split(/\./,$ip));
		$ip =~ s/(\d+)/sprintf('(%1$u|%1$x|%1$02u|%1$02x|%1$03u)',$1)/ge;
		$rip =~ s/(\d+)/sprintf('(%1$u|%1$x|%1$02u|%1$02x|%1$03u)',$1)/ge;
		$ip =~ s/\./[-._]/g;
		$rip =~ s/\./[-._]/g;
		return 5 if ($fqdn =~ /(|.*\.)$ip\./i);
		return 5 if ($fqdn =~ /(|.*\.)$rip\./i);
		$ip =~ s/\[-\._\]//g;
		$rip =~ s/\[-\._\]//g;
		return 4 if ($fqdn =~ /(|.*\.)$ip\./i);
		return 4 if ($fqdn =~ /(|.*\.)$rip\./i);
	}
	return check_ip_parts(0,split(/\./,$fqdn));
}

sub check_user_fqdn {
	my $fqdn = shift;
	return 3 if ($fqdn =~ /^(|.*[._-])(a?dsl|cable|dial[-._]?up|dynamic|dynamicip|customer|dhcp)(|[._-].*)$/i);
	return 2 if ($fqdn =~ /^(|.*[._-])(cust|kund)(|[._-].*)$/i);
	return 1 if ($fqdn =~ /^(|.*[._-])(a?dsl[a-z]|cable)\d*(|[._-].*)$/i);
	return 0;
}

sub check_muser_fqdn {
	my $fqdn = shift;
	return 1 if ($fqdn =~ /\d+[-_.]\d+[-_.]\d+/);
	return 1 if ($fqdn =~ /^\d+[-_.]\d+[-_.]/);
	return 1 if ($fqdn =~ /(cust|ppp|cable|dsl|user|pool|\d{8})/i);
	return 0 if ($fqdn =~ /(^|[-_.])\d*(mta|mx)\d*[-_.]/i);
	return 1 if ($fqdn =~ /(^|[-_.])\d*(kund|cust|dyn|nat|pop|\d{5})\d*[-_.]/i);
	return 1 if ($fqdn !~ /\./);
	return 1 if ($fqdn =~ /\[.*\]/);
	return 0;
}

sub check_mail_fqdn {
	my $fqdn = shift;
	my $xxx = '(barracuda|ironport|mail|relay|smtp|out|exch|mx|mta)';
	return 3 if ($fqdn =~ /^(|.*[._-])$xxx\d{0,5}(|[._-].*)$/i);
	return 2 if ($fqdn =~ /^(|.*[._-])$xxx[-._]?$xxx\d{0,5}(|[._-].*)$/i);
	return 1 if ($fqdn =~ /(mail|smtp|relay|exchange)/i);
	return 0;
}

sub check_server_fqdn {
	my $fqdn = shift;
	return 1 if ($fqdn =~ /^(|.*[._-])(server|gateway|gate|gw)\d{0,5}(|[._-].*)$/i);
	return 0;
}

sub check_no_fqdn {
	my $fqdn = shift;
	my $ip = shift;
	return 1 if ($fqdn =~ /^\[$ip\]$/);
	return 0;
}

sub check_maybe_dynamic_fqdn {
	my ($fqdn,$ip) = @_;
	return 1 unless ($fqdn);
	return 0 unless ($ip);
	return 1 if (check_no_fqdn($fqdn,$ip) || check_ip_fqdn($fqdn,$ip));
	return 0 if (check_mail_fqdn($fqdn));
	return 1 if (check_muser_fqdn($fqdn) || check_user_fqdn($fqdn));
	return 0;
}

sub check_maybe_server_fqdn {
	my ($fqdn,$ip) = @_;
	return 0 unless ($fqdn);
	return 0 unless ($ip);
	return 0 if (check_no_fqdn($fqdn,$ip) || check_ip_fqdn($fqdn,$ip));
	return 1 if (check_mail_fqdn($fqdn));
	return 0 if (check_muser_fqdn($fqdn) || check_user_fqdn($fqdn));
	return 1 if (check_server_fqdn($fqdn));
	return 0;
}

#***********************************************************************
# Misc (lists etc) checks.
#***********************************************************************

$SpamTrapAddresses =~ s/[:>]+/>/;
sub trap_this {
	my $traps = shift;
	my $sender = address_strip(shift);
	my $recipient = address_strip(shift);
	return 0 unless ($traps);
	#debug_log(0,'trap> <%s> <%s> /%s/',$sender,$reipient,$traps);
	return 1 if ($recipient =~ /^$traps$/i);
	return 1 if ("$sender>$recipient" =~ /^$traps$/i);
	return 0;
}
sub spam_trap_this {
	return trap_this($SpamTrapAddresses,@_);
}

sub trap_clean {
	return 0 unless ($trap_keep);
	debug_log(0,'%u trap rec(s) removed',$sql_did) if (sql_execute('DELETE FROM trapper WHERE (trap_stamp<?)',time()-$trap_keep) && $sql_did>0);
	return $sql_did;
}

sub trap_add {
	my $host = shift;
	sql_execute('INSERT INTO trapper (trap_stamp,trap_host) VALUES (?,?)',time(),address_strip($host));
}

sub trap_many {
	return 0 unless ($trap_maxwindow && $trap_timewindow);
	my $cnt = sql_select_one('SELECT COUNT(trap_stamp) FROM trapper WHERE trap_stamp>?',time()-$trap_timewindow);
	return $cnt if ($cnt && $cnt>$trap_maxwindow);
	return 0;
}

# Retrieves the storing server
sub storing_server {
	my ($dom) = @_;
	$dom = address_strip($dom);
	$dom =~ s/^.*\@//;
	return undef if ($dom =~ /^\./);
	while ($dom) {
		return $storingservers{$dom} if ($storingservers{$dom});
		$dom =~ s/^\.//;
		$dom =~ s/^[^.]*//;
	}
	return undef;
}

sub address_is_local {
	my ($a,$css,$crm,$crt,$ncssrm) = @_;
	$css = 1 unless (defined($css));
	$crm = 0 unless (defined($crm));
	$crt = 1 unless (defined($crt));
	$ncssrm = 0 unless (defined($ncssrm));
	unless ($a =~ /\@/) {
		return 1 if ($a =~ /^$LocalNets$/i);
		return 1 if (check_black_nets($a));
		return 0;
	}
	unless ($ncssrm) {
		if ($css) {
			return 1 if ($a =~ /\@$OurDomains>?$/i);
			my $hst = storing_server($a);
			return 1 if ($hst =~ /^$LocalNets$/i);
			return 1 if (check_black_nets($hst));
		}
		if ($crm && defined($RecipientMailers{$a}) && ${RecipientMailers{$a}}[0] =~ /^e?smtp$/i && ${RecipientMailers{$a}}[1] !~ /\.$/) {
			return 1 if (${RecipientMailers{$a}}[1] =~ /^$LocalNets$/i);
			return 1 if (check_black_nets(${RecipientMailers{$a}}[1]));
		}
	}
	if ($crt && defined($RecipientMailers{$a}) && ${RecipientMailers{$a}}[0]) {
		return address_is_local($RecipientMailers{$a}->[2],$css,$crm,0);
	}
	return 0;
}

sub mail_is_outbound {
	my $hrm = (defined($RecipientMailers) && $RecipientMailers && %{$RecipientMailers}) ? 1 : 0;
	foreach my $a (@_) {
		return 1 unless (address_is_local($a,1,$hrm,$hrm));
	}
	return 0;
}

# Checks authentication
sub check_authenticated {
	my ($checkmanual) = @_;
	return 0 unless ($CanAuthenticate);
	if ($checkmanual) {
		open(COMM, "<./COMMANDS") or return 0;
		while(<COMM>) {
			if (/^=auth_authen/) {
				close(COMM);
				return 1;
			}
		}
		close(COMM);
		return 0;
	}
	return 0 unless ($SendmailMacros{auth_authen});
	return $SendmailMacros{auth_authen};
}

# Checks against a small internal list
sub check_ip_in_list($$) {
	my $ip = address_strip(shift);
	return 0 unless ($ip && $ip =~ /^\d+\.\d+\.\d+\.\d+$/);
	my $addr = inet_aton($ip);
	return 0 unless ($addr);
	foreach my $lst (@_) {
		next unless ($lst);
		foreach my $net (split(/;/,$lst)) {
			$net =~ s/\s+//g;
			next unless ($net);
			my ($na_s,$nm_s) = split(/\//,$net);
			$nm_s = '255.255.255.255' unless ($nm_s);
			my $na = inet_aton($na_s);
			my $nm = inet_aton($nm_s);
			next unless ($na && $nm);
			return 1 if (($addr & $nm) eq ($na & $nm));
		}
	}
	return 0;
}

# Checks against a small internal IP address white list
sub check_internal_whitelist($) {
	my($ip) = @_;
	return check_ip_in_list($ip,"127.0.0.1/255.255.255.255;$WhiteNets");
}

# Checks if IP is a black net
sub check_black_nets($) {
	my($ip) = @_;
	return check_ip_in_list($ip,'10.0.0.0/255.0.0.0;172.16.0.0/255.240.0.0;192.168.0.0/255.255.0.0;127.0.0.0/255.255.255.0');
}

# Checks if IP is considered verified
sub check_auth_pass_nets($) {
	my($ip) = @_;
	return 0 unless ($AuthPassNets);
	return check_ip_in_list($ip,$AuthPassNets);
}

# Check if HELO pretends to be ours.
sub check_our_helo($) {
	my ($helo) = @_;
	debug_log(4,"Checking helo: $helo");
	#return 0 if ($helo =~ /^[<\[]?localhost(\.localdomain)?[\]>]?(\s.*)?$/i);
	return 0 if ($helo =~ /^[<\[]?localhost(\.localdomain)?[\]>]?$/i);
	#if ($helo =~ /^[<\[]?\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}[\]>]?(\s.*)?$/) {
	if ($helo =~ /^[<\[]?\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}[\]>]?$/) {
		return 1 if (check_ip_in_list($helo,$OurNets));
	}
	$helo = address_strip($helo);
	return 1 if ($helo =~ /(^|^.*\.)$OurDomains$/i);
	return 0;
}

# check verification
sub check_verification {
	my ($verified,$what,$sender) = @_;
	$sender = address_strip($sender);
	return unless ($verified && @{$verified});
	foreach my $snd (@{$verified}) {
		if ($snd =~ /^(.*):(.*)$/) {
			my $vp = $1;
			my $va = $2;
			next unless ($vp =~ /^$what$/);
			return 1 if (address_strip($va) eq $sender);
		}
	}
	return 0;
}

# check mail from verification
sub check_sender_verification {
	my ($verified,$sender) = @_;
	return 0 unless ($sender =~ /\@/);
	return check_verification($verified,'SPF',$sender);
}

# Check mail address against list
sub check_mail_address_list($$$) {
	my ($what,$addr,$list) = @_;
	return 0 if (!($list && @{$list}));
	$what = '*' unless ($what);
	$what = '*' if ($what eq '?');
	$addr = address_strip($addr);
	debug_log(3,"Checking for $what, $addr");
	foreach $l (@{$list}) {
		my $line = $l;
		my $x = '*';
		$line =~ s/^(\n?\s*)(.*)(\s*\n?)$/$2/;
		$line = lc($line);
		if ($line =~ /^(\S+)\s+(\S+.*)$/) {
			$x = $1;
			$line = $2;
		}
		$x = '*' if ($x eq '?');
		$x =~ s/gray/grey/g;
		next unless ($x && $line);
		debug_log(3,"Checking against $x, $line");
		debug_log(3,"whatmatch") if ($what eq '*' || $x eq '*' || $x =~ /$what/);
		debug_log(3,"addrmatch") if ($addr =~ /^$line$/);
		if (($what eq '*' || $x eq '*' || $x =~ /$what/) && $addr =~ /^$line$/) {
			debug_log(3,"Matched $what, $addr against $et $addr");
			return 1 
		}
	}
	return 0;
}

# Checks against a list of addresses.
sub check_address_list {
	# The list may be in three formats, specified with the first parameter.

	# If the first parameter is "P", the list is a plain list with one host address
	# (IP or domain) per line. The adresses may not be regular expressions.

	# If the first parameter is "L", the list contains one address specifier
	# per line. An adress specifier consists of a keyword followed by an address
	# (or two addresses in some instances).
	# The addresses are regular expressions.
	# The parameter can be specified as "L:prefix" to require a prefix in front of
	# keywords.
	
	# If the first parameter is "R", the list contains the output from relaydb -vl.

	# A sample blacklist (note that ^ and $ will allways be used around each entry):
	# Sender big@boss\.com
	# Host (.*\.|)artprice\.com
	# Host (.*\.|)artmarket\.com
	# Host (.*\.|)artinvestment\.com
	# Host (.*\.|)serveur\.com
	# Host (.*\.|)servergroup\.com
	# Host (.*\.|)serveurgroup\.com
	# Host (.*\.|)artists-server\.com

	return (0,"","") unless (@_);
	my %lcfg = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
	
	return (0,"","") if (!($lcfg{list} && @{$lcfg{list}}));

	$lcfg{ip}	= address_strip($lcfg{ip});
	$lcfg{hostname}	= address_strip($lcfg{hostname});
	$lcfg{helo}	= address_strip($lcfg{helo});
	$lcfg{from}	= address_strip($lcfg{from});
	$lcfg{sender}	= address_strip($lcfg{sender});
	$lcfg{format}	= '' unless ($lcfg{format});
	$lcfg{plain}	= ($format =~ /^[PR]/i) unless (defined($lcfg{plain}));
	$lcfg{comment}	= $lcfg{file} if (!defined($lcfg{comment}) && defined($lcfg{file}));
	if ($lcfg{recipient}) {
		$lcfg{recipients} = [] unless ($lcfg{recipients});
		push @{$lcfg{recipients}}, $lcfg{recipient};
	}
	unless (defined($lcfg{prefix})) {
		$lcfg{prefix} = '';
		if ($lcfg{format} =~ /^L:(.*)$/i) {
			$lcfg{prefix} = $1;
		}
	}
	$lcfg{prefix} =~ s/^(.)(.*?)_*$/$1(?:$2)?_?/;
	address_list_log('check_address_list %s',hashstring(\%lcfg));
	#debug_log(0,'CALPar %s',hashstring(\%lcfg));

	my $hit = "";
	my $log = "";
	my $mp = '.+@';
	#debug_log(0,"aldbg $lcfg{comment} ^ $lcfg{prefix}");
	foreach $l (@{$lcfg{list}}) {
		my $line = $l;
		my $et = '';
		my $addr = '';
		my $retval = 1;
		$line =~ s/^(\n?\s*)(.*)(\s*\n?)$/$2/;
		if ($line =~ /^!\s*(.*)$/) {
			$retval = 0;
			$line = $1;
		}
		if (defined($line) && $line ne "") {
			debug_log(4,"Line $line");
			if ($lcfg{format} =~ /^P/i) {
				$et = "HOST";
				$addr = $line;
			} elsif ($lcfg{format} =~ /^R/i) {
				my $wc;
				my $bc;
				my $xxx;
				($addr,$wc,$bc,$xxx) = split(/\s/,$line,4);
				if (($rdb_ratio == -1) || (($bc > 0) && ($wc == 0))) {
					$et = "HOST";
				} elsif ($wc != 0) {
					if ($bc/$wc > $rdb_ratio) {
						$et = "HOST";
					}
				}
			} elsif ($lcfg{format} =~ /^L/i) {
				($et,$addr) = split(/\s+/,$line,2);
			}
			my $etp = (defined($et) && $et ne "" && defined($addr) && $addr ne "");
			#debug_log(0,"aldbg $lcfg{comment} < $etp $et");
			if ($etp && $lcfg{prefix} ne '') {
				if ($et =~ /^$lcfg{prefix}(.*)$/i) {
					$et = $1;
				} else {
					$etp = 0;
				}
			}
			#debug_log(0,"aldbg $lcfg{comment} > $etp $et");
			if ($etp) {
				#address_list_log('check_address_list ? "%s"=~"%s..." "%s"',$et,$lcfg{prefix},$addr);
				if ($et =~ /^S(?:ender)?[-_]?R(?:elay)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s_%s"',$et,$prefix,'S(ender)?','R(elay)?');
					my ($addr1,$addr2) = split(/\s+/,$addr,2);
					if (($lcfg{sender} =~ /^$addr1$/i) && ($lcfg{ip} =~ /^$addr2$/i)) {
						$hit = "$lcfg{sender}!$lcfg{ip}";
						$log = "sender_host";
					}
				} elsif ($et =~ /^S(?:ender)?[-_]?H(?:ost)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s_%s"',$et,$prefix,'S(ender)?','H(ost)?');
					my ($addr1,$addr2) = split(/\s+/,$addr,2);
					if ($lcfg{sender} =~ /^$addr1$/i) {
						if ($lcfg{hostname} =~ /^$addr2$/i) {
							$hit = "$lcfg{sender}!$lcfg{hostname}";
							$log = "sender_host";
						} elsif ($lcfg{helo} =~ /^$addr2$/i) {
							$hit = "$lcfg{sender}!$lcfg{helo}";
							$log = "sender_helo";
						} elsif ($lcfg{ip} =~ /^$addr2$/i) {
							$hit = "$lcfg{sender}!$lcfg{ip}";
							$log = "sender_host";
						}
					}
				} elsif ($et =~ /^S(?:ender)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s"',$et,$prefix,'S(ender)?');
					if ($lcfg{sender} =~ /^$addr$/i) {
						$hit = $lcfg{sender};
						$log = "mail_from";
					}
				} elsif ($et =~ /^H(?:ost)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s"',$et,$prefix,'H(ost)?');
					if (($lcfg{plain} && $lcfg{hostname} eq $addr) || 
					   (!$lcfg{plain} && $lcfg{hostname} =~ /^$addr$/i)) {
						$hit = $lcfg{hostname};
						$log = "host";
					} elsif (($lcfg{plain} && $lcfg{helo} eq $addr) ||
					        (!$lcfg{plain} && $lcfg{helo} =~ /^$addr$/i)) {
						$hit = $lcfg{helo};
						$log = "helo";
					} elsif (($lcfg{plain} && $lcfg{from} eq $addr) ||
					        (!$lcfg{plain} && $lcfg{from} =~ /^$addr$/i)) {
						$hit = $lcfg{from};
						$log = "from";
					} elsif (($lcfg{plain} && $lcfg{ip} eq $addr) || 
					        (!$lcfg{plain} && $lcfg{ip} =~ /^$addr$/i)) {
						$hit = $lcfg{ip};
						$log = "host";
					} elsif (($lcfg{plain} && $lcfg{sender} eq $addr) ||
					        (!$lcfg{plain}&& $lcfg{sender} =~ /^$mp$addr$/i)) {
						$hit = $lcfg{sender};
						$log = "mail_from";
					}
				} elsif ($et =~ /^R(?:elay)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s"',$et,$prefix,'R(elay)?');
					if (($lcfg{plain} && $lcfg{ip} eq $addr) || 
					   (!$lcfg{plain} && $lcfg{ip} =~ /^$addr$/i)) {
						$hit = $lcfg{ip};
						$log = "host";
					}
				} elsif ($et =~ /^He(?:ll?o)?$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s"',$et,$prefix,'He(ll?o)?');
					if (($lcfg{plain} && $lcfg{helo} eq $addr) ||
					   (!$lcfg{plain} && $lcfg{helo} =~ /^$addr$/i)) {
						$hit = $lcfg{helo};
						$log = "helo";
					}
				} elsif ($et =~ /^(?:To?|R(?:[ce]|cpt|ecipient))$/i) {
					#address_list_log('check_address_list + "%s"=~"%s%s"',$et,$prefix,'R(cpt|ecipient)?');
					if ($lcfg{recipients}) {
						foreach my $val (@{$lcfg{recipients}}) {
							next unless (address_strip($val) =~ /^$addr$/i);
							$hit = $val;
							$log = 'rcpt';
							last;
						}
					}
				} elsif ($et =~ /^B(?:ounc(?:e|es|ing)|nc)?$/i) {
					#debug_log(0,'CAL Bounce ?');
					if ((defined($lcfg{sender}) && $lcfg{sender} eq '') &&
					   ($lcfg{recipients} && (@{$lcfg{recipients}} == 1)) &&
					   (address_strip($lcfg{recipients}->[0]) =~ /^$addr$/i) &&
					   out_check_for_bounce($ip,$lcfg{recipients}->[0])) {
						debug_log(0,'CAL Bounce ! <> <%s> ~ %s',$lcfg{recipients}->[0],$addr);
						$hit = $lcfg{recipients}->[0];
						$log = 'bounce';
					}
				} elsif ($et =~ /^Hash$/i) {
					debug_log(0,"aldbg $lcfg{comment} # $lcfg{hash} $addr");
					address_list_log('check_address_list + "%s"=~"%s%s"',$et,$lcfg{prefix},'Hash');
					if ($lcfg{hash} eq $addr) {
						$hit = $lcfg{hash};
						$log = "hash";
					}
				} elsif ($et =~ /^M(?:ulti)?$/i) {
					#debug_log(0,'AL Multi L %s',$addr);
					address_list_log('check_address_list + "%s"=~"%s%s"',$et,$lcfg{prefix},'M(ulti)?');
					my @hits = ();
					my $miss = 0;
					foreach my $mon (split(/\s+/,$addr)) {
						#debug_log(0,'AL Multi T %s',$mon);
						my ($var,$val,$tst,$rev,$asv);
						if ($mon =~ /^(\!)(.*)$/) {
							$rev = $1;
							$mon = $2;
						}
						if ($mon =~ /^([-_A-Za-z0-9]+):(.*)$/) {
							$var = $1;
							$tst = $2;
							$val = ($lcfg{entity} && $lcfg{entity}->head) ? $lcfg{entity}->head->get($var) : undef;
							if (defined($val)) {
								$val =~ s/[\s\r\n]+/ /gs;
								$val =~ s/^\s+//;
								$val =~ s/\s+$//;
							}
							$var .= ':';
							address_list_log('check_address_list + multi H %s "%s" /^%s$/',$var,$val,$tst);
						} elsif ($mon =~ /^([-_A-Za-z0-9]+)=(.*)$/) {
							$var = $1;
							$tst = $2;
							address_list_log('check_address_list + multi v %s "%s"',$var,$tst);
							if ($var =~ /^R(?:elay)?$/i) {
								$val = address_strip($lcfg{ip});
								$var = 'relay';
							} elsif ($var =~ /^S(?:ender)?$/i) {
								$val = address_strip($lcfg{sender});
								$var = 'sender';
							} elsif ($var =~ /^H(?:ost)?n?(?:ame)?$/i) {
								$val = address_strip($lcfg{hostname});
								$var = 'host';
							} elsif ($var =~ /^He(?:ll?o)?$/i) {
								$val = address_strip($lcfg{helo});
								$var = 'helo';
							} elsif ($var =~ /^(?:To?|R(?:[ce]|cpt|ecipient))$/i) {
								$val = [];
								foreach $vlc (@{$lcfg{recipients}}) {
									#debug_log(0,'AL Multi v rcpt:%s',$vlc);
									push @{$val}, address_strip($vlc);
								}
								$var = 'rcpt';
							} else {
								$var = lc($var);
								if (defined($lcfg{$var})) {
									$val = $lcfg{$var};
								} else {
									$miss ++;
									last;
								}
							}
							$var .= '=';
							address_list_log('check_address_list + multi V %s "%s" /^%s$/',$var,$val,$tst);
						}
						#debug_log(0,'AL Multi V rev:%s tst:%s var:%s val:%s',
						#	!defined($rev) ? '-' : $rev,
						#	!defined($tst) ? '-' : "/^$tst\$/i",
						#	!defined($var) ? '-' : $var,
						#	!defined($val) ? '-' : !ref($val) ? $val : ref($val) ne 'ARRAY' ? ref($val) : join('; ',@{$val}),
						#);
						if ($rev && !(defined($val) && $val ne '')) {
							$miss ++;
							last;
						}
						if ((ref($val) eq '') && ($rev xor ((!defined($val) && $tst eq '') || ($val =~ /^$tst$/i)))) {
							push @hits, "$rev$var$val";
							address_list_log('check_address_list + multi * %s "%s" /^%s$/',$var,$val,$tst);
							next;
						}
						if (ref($val) eq 'ARRAY') {
							if (!@{$val} && ($rev xor ($tst eq ''))) {
								push @hits, "$rev$var$val";
								address_list_log('check_address_list + multi * %s "%s" /^%s$/',$var,$val,$tst);
								next;
							}
							my $ahit = 0;
							foreach my $vali (@{$val}) {
								next unless ($rev xor (address_strip($vali) =~ /^$tst$/i));
								address_list_log('check_address_list + multi * %s "%s" /^%s$/',$var,$vali,$tst);
								push @hits, "$rev$var$vali";
								$ahit ++;
								last;
							}
							next if ($ahit);
						}
						$miss ++;
						last;
					}
					#debug_log(0,'AL Multi %s %i %s',$miss?'M':@hits?'H':'R',$miss,join(' & ',@hits));
					if (@hits && !$miss) {
						debug_log(0,'AL Multi H %s',join(' & ',@hits));
						$hit = join(' & ',@hits);
						$log = 'multi';
					}
				}
				if ($hit ne '') {
					address_list_log('check_address_list HIT %s @ %s %s',$lcfg{comment}?$lcfg{comment}:'-',$log,$hit);
					$retval = ($retval ? 0 : 1) if ($lcfg{reverse});
					return ($retval,$hit,$log);
				}
			}
		}
	}
	return (0,$hit,$log);
}

# Checks against a list of addresses.
sub check_address_list_filtered {
	return (0,"","") unless (@_);
	my %lcfg = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;

	# All lines where the first parameter does not match $filter will be stripped.
	# The remaining stuff will be handle by check_address_list above.

	return (0,"","") if (!($lcfg{list} && @{$lcfg{list}}));
	my @flst = ();
	foreach $l (@{$list}) {
		my $line = $l;
		debug_log(4,"FLineX: '$line'");
		$line =~ s/^(\n?\s*)(.*)(\s*\n?)$/$2/;
		if (defined($line) && $line ne "") {
			debug_log(4,"FLineL: '$line'");
			if ($line =~ /^(\S+)\s+(.*?)$/) {
				my $x = $1;
				my $l = $2;
				if ($x =~ /^(!\s*)(.*)$/) {
					$l = "$1$l";
					$x = $2;
				}
				debug_log(4,"FLineT: '$x' = '$lcfg{filter}' ?");
				if ($lcfg{filter} =~ /^$x$/i) {
					debug_log(3,"FLineA: '$l'");
					push @flst, $l;
				}
			}
		}
	}
	return (0,"","") unless (@flst);
	$lcfg{list} = \@flst;
	return check_address_list(\%lcfg);
}

# Read file into array (with cache)
%listcache = ();
sub get_file_path_name_and_fx {
	my ($fn,$match,$noclean) = @_;
	my $vfn = get_file_path_name($fn);
	my $id = sprintf("%s:%i:%s",$match,$noclean,$fn);
	my $fx = '!';
	if ($vfn && (-f $vfn)) {
		my @fs = stat(_);
		$fx = join(';',$fs[0],$fs[1],$fs[7],$fs[9],$vfn);
	}
	return ($vfn,$id,$fx);
}
sub read_list_file {
	my ($fn,$match,$noclean) = @_;
	my ($vfn,$id,$fx) = get_file_path_name_and_fx($fn,$match,$noclean);
	#debug_log(0,'read_list_file c %s %s %s %s',$fn,$vfn,$fx,$listcache{$id}{x}) if ($listcache{$id});
	return $listcache{$id}{d} if (defined($listcache{$id}) && $listcache{$id}{x} eq $fx);
	address_list_log('read_list_file %s %s %s %s',$fn,$vfn,$id,$fx);
	#debug_log(0,'read_list_file c %s %s',$fn,$fx);
	#debug_log(0,'read_list_file r %s',$vfn) unless ($fx eq '!');
	$listcache{$id}{x} = $fx;
	$listcache{$id}{d} = ($fx eq '!') ? undef : read_a_file($vfn,$match,$noclean);
	#debug_log(0,'read_list_file R %s %u',$vfn,scalar @{$listcache{$id}{d}}) unless ($fx eq '!');
	return $listcache{$id}{d};
}
sub list_file_changed {
	my ($fn,$match,$noclean) = @_;
	my ($vfn,$id,$fx) = get_file_path_name_and_fx($fn,$match,$noclean);
	return 1 if (defined($listchache{$id}) && $listcache{$id}{x} ne $fx);
	return 0;
}
sub read_text_file {
	my ($fn) = @_;
	return read_list_file($fn,0,1);
}

sub read_delivery_file {
	my $ldal = read_list_file(@_);
	#debug_log(0,'read_delivery_file: %s',@_);
	return undef unless ($ldal);
	my @dl = ();
	for my $lda (@{$ldal}) {
		#debug_log(0,'read_delivery_file? %s',$lda);
		next unless ($lda =~ /^(\S+)([-+=>\s]+)(.+)$/);
		my $ai = {a=>$1,w=>$2,d=>$3};
		$ai->{w} =~ s/\s+//gs;
		$ai->{w} = '=' unless ($ai->{w});
		if ($ai->{d} =~ /\/$/) {
			$ai->{d} =~ s/\/+$//;
			$ai->{f} = 'd';
		} else {
			next;
		}
		debug_log(7,'read_delivery_file! "%s" "%s" "%s:%s"',$ai->{a},$ai->{w},$ai->{f},$ai->{d});
		push @dl, $ai;
	}
	return \@dl;
}

# Check if recipient(s) address is in white list
sub check_recipient_white ($$) {
	my ($what,$addr) = @_;
	#my $cfdata = read_list_file('/etc/mail/recipient-whitelist');
	my $cfdata = read_list_file('recipient-whitelist');
	return check_mail_address_list($what,$addr,$cfdata)
}
sub check_recipients_white ($$) {
	my ($what,$addrs) = @_;
	return 0 if (!($addrs && @{$addrs}));
	#my $cfdata = read_list_file('/etc/mail/recipient-whitelist');
	my $cfdata = read_list_file('recipient-whitelist');
	foreach my $addr (@{$addrs}) {
		return 0 unless (check_mail_address_list($what,$addr,$cfdata));
	}
	return 1;
}

# Check if sender address is in white list
sub check_sender_white ($$) {
	my ($what,$addr) = @_;
	#my $cfdata = read_list_file('/etc/mail/sender-whitelist');
	my $cfdata = read_list_file('sender-whitelist');
	return check_mail_address_list($what,$addr,$cfdata)
}

# Check if listed as a mail backup
sub check_mail_backup($$) {
	my ($ip,$hostname) = @_;
	#my $cfdata = read_list_file('/etc/mail/mimedefang-backups');
	my $cfdata = read_list_file('backups');
	my ($found,$hit,$log) = check_address_list(
		format		=> 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		list		=> $cfdata,
		comment		=> 'backup',
	);
	return 1 if ($found);
	return 0;
}

# Check if whitelisted in whitelist file
sub check_external_whitelist {
	my ($ip,$hostname,$sender) = @_;
	return 1 if (check_mail_backup($ip,$hostname));
	#my  $cfdata = read_list_file('/etc/mail/mimedefang-whitelist');
	my  $cfdata = read_list_file('whitelist');
	my ($found,$hit,$log) = check_address_list(
		format		=> 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		sender		=> $sender,
		list		=> $cfdata,
		comment		=> 'whitelist',
	);
	return 1 if ($found);
	return 0;
}

# Check if blacklisted in blacklist file
sub check_external_blacklist {
	my ($ip,$hostname,$helo,$from,$sender) = @_;
	#my $cfdata = read_list_file('/etc/mail/mimedefang-blacklist');
	my $cfdata = read_list_file('blacklist');
	my($found,$hit,$log) = check_address_list(
		format		=> 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		helo		=> $helo,
		from		=> $from,
		sender		=> $sender,
		list		=> $cfdata,
		comment		=> 'blacklist',
	);
	return ($found,$hit,$log);
	return (0,"","");
}

# Check if whitelisted in whitelist-by-recipient file
sub check_external_whitelist_by_recipient($$$$$$) {
	my ($ip,$hostname,$helo,$from,$sender,$recipient) = @_;
	return 1 if (check_mail_backup($ip,$hostname));
	#my  $cfdata = read_list_file('/etc/mail/mimedefang-whitelist-by-recipient');
	my  $cfdata = read_list_file('whitelist');
	my %cfinfo = (
		format		=> 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		from		=> $from,
		sender		=> $sender,
		recipient	=> $recipient,
		list		=> $cfdata,
		comment		=> 'whitelist',
	);
	my ($found,$hit,$log) = check_address_list(%cfinfo);
	return 1 if ($found);
	$cfdata = read_list_file('whitelist-by-recipient');
	$cfinfo{filter}		= address_strip($recipient);
	$cfinfo{helo}		= $helo;
	$cfinfo{list}		= $cfdata;
	$cfinfo{comment}	= 'whitelist-by-recipient';
	($found,$hit,$log) = check_address_list_filtered(%cfinfo);
	return 1 if ($found);
	return 0;
}

# Check if blacklisted in blacklist-by-recipient file
sub check_external_blacklist_by_recipient($$$$$$) {
	my ($ip,$hostname,$helo,$from,$sender,$recipient) = @_;
	#my $cfdata = read_list_file('/etc/mail/mimedefang-blacklist-by-recipient');
	my $cfdata = read_list_file('blacklist');
	my %cfinfo = (
		format		=> 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		helo		=> $helo,
		from		=> $from,
		sender		=> $sender,
		recipient	=> $recipient,
		list		=> $cfdata,
		comment		=> 'blacklist',
	);
	my($found,$hit,$log) = check_address_list(%cfinfo);
	return ($found,$hit,$log) if ($found);
	my $cfdata = read_list_file('blacklist-by-recipient');
	$cfinfo{filter}		= address_strip($recipient);
	$cfinfo{list}		= $cfdata;
	$cfinfo{comment}	= 'blacklist-by-recipient';
	($found,$hit,$log) = check_address_list_filtered(%cfinfo);
	return ($found,$hit,$log) if ($found);
	return (0,"","");
}

# Check if listed in bypass file
sub check_something_bypass {
	my ($file,$prefix,$ip,$hostname,$sender,$recipients,$verified,$entity,$hash) = @_;
	debug_log(7,'check_something_bypass: %s:%s p %s %s %s',$file,$prefix,$ip,$hostname,$sender);
	my $cfdata = read_list_file($file);
	my %params = (
		format		=> $prefix ? "L:$prefix" : 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		sender		=> $sender,
		recipients	=> $recipients,
		entity		=> $entity,
		hash		=> $hash,
		list		=> $cfdata,
		file		=> $file
	);
	my ($found,$hit,$log) = check_address_list(\%params);
	if ($found) {
		debug_log(1,'check_something_bypass: %s:%s P %s %s',$file,$prefix,$hit,$log);
		return 1;
	}
	return 0 unless ($verified && @{$verified});
	$prefix = $prefix ? 'L:'.$prefix.'_' : 'L:';
	foreach my $snd (@{$verified}) {
		my ($vt,$sndx) = split(/:/,$snd,2);
		debug_log(7,'check_something_bypass: %s:%s v %s %s',$file,$prefix,$vt,$sender);
		if ($sndx =~ /\@/) {
			$params{sender} = $sndx;
		} else {
			$params{helo} = $sndx;
		}
		$params{format} = "$prefix$vt";
		($found,$hit,$log) = check_address_list(\%params);
		unless ($found) {
			$params{format} = $prefix.'verified';
			($found,$hit,$log) = check_address_list(\%params);
		}
		if ($found) {
			debug_log(1,'check_something_bypass: %s:%s V %s %s',$file,$prefix,$hit,$log);
			return 1;
		}
	}
	return 0;
}
# Check if unlisted in bypass file
sub check_something_not_bypass {
	my ($file,$prefix,$ip,$hostname,$sender,$recipients,$entity,$hash) = @_;
	debug_log(7,'check_something_not_bypass: %s:%s p %s %s %s',$file,$prefix,$ip,$hostname,$sender);
	my $cfdata = read_list_file($file);
	my %params = (
		format		=> $prefix ? "L:$prefix" : 'L',
		ip		=> $ip,
		hostname	=> $hostname,
		sender		=> $sender,
		recipients	=> $recipients,
		entity		=> $entity,
		hash		=> $hash,
		list		=> $cfdata,
		reverse		=> 1,
		file		=> $file
	);
	my ($found,$hit,$log) = check_address_list(\%params);
	if ($found) {
		debug_log(3,'check_something_not_bypass: %s:%s P %s %s',$file,$prefix,$hit,$log);
		return 1;
	}
	return 0 unless ($entity);
	my @from = ();
	get_addresses_from_header($entity,'Reply-To:From:Sender',\@from);
	foreach my $snd (@from) {
		debug_log(7,'check_something_not_bypass: %s:%s f %s',$file,$prefix,$snd);
		$params{sender} = $snd;
		($found,$hit,$log) = check_address_list(\%params);
		if ($found) {
			debug_log(3,'check_something_not_bypass: %s:%s F %s %s',$file,$prefix,$hit,$log);
			return 1;
		}
	}
	return 0;
}

# Check if listed in spamassassin-bypass file
sub check_spamassassin_bypass {
	return check_something_bypass('spamassassin-bypass','',@_);
}

# Check if unlisted in spamassassin-bypass file
sub check_spamassassin_not_bypass {
	return check_something_not_bypass('spamassassin-bypass','',@_);
}

# Check if listed in virus-bypass file
sub check_virus_bypass {
	my ($scanner,$ip,$hostname,$sender,$recipients,$entity,$hash) = @_;
	$scanner =~ s/[^a-zA-Z0-9]+//gs;
	return 0 if (check_something_not_bypass('virus-bypass','',$ip,$hostname,$sender,$recipients,$entity));
	return 0 if ($scanner && check_something_not_bypass('virus-bypass',$scanner,$ip,$hostname,$sender,$recipients,$entity));
	return 1 if (check_something_bypass('virus-bypass','',$ip,$hostname,$sender,$recipients,0,$entity));
	return 1 if ($scanner && check_something_bypass('virus-bypass',$scanner,$ip,$hostname,$sender,$recipients,0,$entity));
}

sub check_virus_time_exceeded {
	my ($ip,$host) = @_;
	debug_log(1,"cvte 1: $ip, $host");
	return 0 unless ($AVMaxScanTime && ($AVMaxScanTime > 0));
	my $t = time() - $ScanStartedAt;
	debug_log(1,"cvte 2: $t");
	return 0 unless ($t > $AVMaxScanTime);
	debug_log(1,"cvte 3");
	return 0 unless (check_internal_whitelist($ip) || check_external_whitelist($ip,$host) || check_authenticated());
	debug_log(1,'Virus time exceeded: %u > %u',$t,$AVMaxScanTime);
	return 1;
}

sub check_virus_entity_no_scan {
	my ($entity) = @_;
	return 0 unless (check_internal_whitelist($RelayAddr));
	return -1 unless ($entity);
	my $bdy = $entity->bodyhandle;
	return -2 unless ($bdy);
	my $path = $entity->bodyhandle->path;
	return -3 unless (defined($path));
	my $size = (stat($path))[7];
	return 0 unless ($size);
	return 1 if ($size > $mailtoobig);
	return 0;
}

sub check_spam_time_exceeded {
	debug_log(1,'cste 1');
	return 0 unless ($SAMaxScanTime && ($SAMaxScanTime > 0));
	my $t = time() - $ScanStartedAt;
	debug_log(1,"cste 2: $t");
	return 0 unless ($t > $SAMaxScanTime);
	debug_log(1,'Spam time exceeded: %u > %u',$t,$SAMaxScanTime);
	return 1;
}

sub check_options_relay {
	my ($ip,$helo,$anyone) = @_;
	return 0 unless ($RelayOptionsDomain);
	return 0 unless ($anyone || check_internal_whitelist($ip));
	if ($helo =~ /^(|.*\.)$RelayOptionsDomain$/i) {
		return $1 if ($1);
		return '-';
	}
	return 0;
}

sub check_relay_option_ex {
	my $ip = shift;
	my $helo = shift;
	my $anyone = shift;
	my $optl = check_options_relay($ip,$helo,$anyone);
	$optl =~ s/[-_]//g;
	debug_log(1,'Relay Options: %s',$optl);
	return 0 unless ($optl);
	while (my $o = shift @_) {
		next unless ($o);
		debug_log(1,'Relay Option Check: %s',$o);
		if ($optl =~ /^(|.*\.)$o(|\..*)$/i) {
			debug_log(1,'Relay Option True: %s',$o);
			return 1;
		}
	}
	return 0;
}

sub check_relay_option {
	my $ip = shift;
	my $helo = shift;
	return check_relay_option_ex($ip,$helo,0,@_);
}

sub check_any_relay_option {
	my $helo = shift;
	return check_relay_option_ex('0.0.0.0',$helo,1,@_);
}

sub check_user_in_domain {
	my $usr = address_strip(shift @_);
	my $dom = $usr;
	$usr =~ s/\@[^@]*$//;
	$dom =~ s/^.*\@//;
	my $cfdata = read_list_file("users\@$dom");
	return (0,0) unless (defined($cfdata));
	debug_log(7,'check_user_in_domain ? %s %s',$usr,$dom);
	my $delim = chr(0);
	my $default = 0;
	my $definitive = 1;
	foreach my $l (@{$cfdata}) {
		my $line = $l;
		$line =~ s/[\r\n\s]+$//;
		$line =~ s/^\s+//;
		next if ($line =~ /^[;#]/);
		if ($l =~ /^\s*\@(.*)$/) {
			my $c = $1;
			next unless ($c =~ /^\s*(\S+)[\s=:]+(.*)$/);
			my $v = $2;
			$c = lc($1);
			if ($c eq 'delimiter') {
				$delim = $v;
			} elsif ($c eq 'default') {
				$default = $v;
			} elsif ($c eq 'definitive') {
				$definitive = $v;
			}
			next;
		}
		debug_log(5,'check_user_in_domain l %s %s %s',$usr,$dom,$line);
		my $retval = 1;
		if ($line =~ /^!\s*(.*)$/) {
			$retval = 0;
			$line = $2;
		}
		$line =~ s/$delim.*$//;
		debug_log(5,'check_user_in_domain c %s %s %s',$usr,$dom,$line);
		next unless ($usr =~ /^$line$/i);
		debug_log(3,'check_user_in_domain + %s %s %i',$usr,$dom,$retval);
		return ($retval?$definitive:1,$retval);
	}
	debug_log(7,'check_user_in_domain - %s %s',$usr,$dom);
	return ($default?$definitive:1,$default);
}

#***********************************************************************
# RelayDB stuff.
#***********************************************************************

# Check if blacklisted by relaydb
sub check_relay_blacklist {
	my ($ip,$what) = @_;
	return (0,'','') unless ($ip);
	return (0,'','') unless ($relaydb);
	return (0,'','') unless (defined($rdb_ratio) || $rdb_min_black);
	$what = 'relay' unless ($what);
	debug_log(3,"check_relay_blacklist: a:$ip");
	my $rinf = sql_select_one_row('SELECT rl_touch,rl_spam,rl_ham FROM relaylist WHERE rl_host=?',$ip);
	debug_log(3,"check_relay_blacklist: ap:$ip t:%s s:%s h:%s",$rinf->[0],$rinf->[1],$rinf->[2]);
	return (0,'','') unless ($rinf && $rinf->[0]);
	return (0,'','') unless (($rdb_expire<=0) || ($rinf->[0] > time()-$rdb_expire));
	$rinf->[1] = 0 unless ($rinf->[1]);
	$rinf->[2] = 0 unless ($rinf->[2]);
	return (0,'','') unless (($rdb_min_black<0) || ($rinf->[1] && ($rinf->[1] >= $rdb_min_black)));
	return (0,'','') unless (($rdb_max_white<0) || !$rinf->[2] || $rinf->[2] <= $rdb_max_white);
	if ($rdb_ratio > -1) {
		return (1,$ip,$what) if ($rinf->[2] == 0 && $rinf->[1] > 0);
		return (1,$ip,$what) if ($rinf->[1]/$rinf->[2] > $rdb_ratio);
		return (0,'','');
	}
	return (1,$ip,$what);
}

# Check if relay has sent spam
sub check_relay_spam {
	my ($ip) = @_;
	return 0 unless ($ip);
	return 0 unless ($relaydb);
	my $rinf = sql_select_one_row('SELECT rl_touch,rl_spam FROM relaylist WHERE rl_host=?',$ip);
	return 0 unless ($rinf && $rinf->[0] && $rinf->[1]);
	return 0 unless (($rdb_expire<=0) || ($rinf->[0] > time()-$rdb_expire));
	return $rinf->[1];
}

# Report to relaydb
sub report_address_relay_xam {
	my ($xam,$ip) = @_;
	my $now = time();
	if ($sqldbd eq 'M') {
		sql_execute("INSERT INTO relaylist (rl_host,rl_stamp,rl_touch,rl_$xam) VALUES(?,?,?,?) ".
			    "ON DUPLICATE KEY UPDATE rl_stamp=VALUES(rl_stamp),rl_touch=VALUES(rl_touch),rl_$xam=rl_$xam+1",
			    $ip,$now,$now,1);
	} else {
		sql_execute_multi(
			['INSERT OR IGNORE INTO relaylist (rl_host) VALUES (?)',$ip],
			["UPDATE relaylist SET rl_stamp=?,rl_touch=?,rl_$xam=rl_$xam+1 WHERE rl_host=?",$now,$now,$ip],
		);
	}
}
sub report_address_relay($$) {
	my ($ip,$hits) = @_;
	return unless ($relaydb);
	return unless (defined($rdb_ratio) || $rdb_min_black);
	if ($hits > $rdb_black_list) {
		debug_log(3,"report_relay: spam $ip");
		report_address_relay_xam('spam',$ip);
	} elsif ($hits < $rdb_white_list) {
		debug_log(3,"report_relay: ham $ip");
		report_address_relay_xam('ham',$ip);
	} elsif ($rdb_stamp_grey) {
		debug_log(3,"report_relay: grey stamp $ip");
		my $now = time();
		sql_execute('UPDATE relaylist SET rl_stamp=?,rl_touch=? WHERE rl_host=?',$now,$now,$ip);
	} elsif ($rdb_touch) {
		debug_log(3,"report_relay: grey touch $ip");
		my $now = time();
		sql_execute('UPDATE relaylist SET rl_touch=? WHERE rl_host=?',$now,$ip);
	}
}
sub report_address_relay_spam($) {
	my ($ip) = @_;
	return unless ($relaydb);
	return unless (defined($rdb_ratio) || $rdb_min_black);
	my $now = time();
	debug_log(3,"report_relay: spam $ip");
	report_address_relay_xam('spam',$ip);
}
sub report_address_relay_virus($) {
	my ($ip) = @_;
	return unless ($relaydb);
	return unless ($rdb_virus);
	my $now = time();
	debug_log(0,"report_relay: virus $ip");
	report_address_relay_xam('spam',$ip);
}

# Report verified address to relaydb
sub report_verified_relay {
	my ($verified,$hits) = @_;
	return unless ($rdb_sender || $rdb_domain);
	return unless ($verified && @{$verified});
	debug_log(3,'report_verified: %03.1f %s',$hits,join(' ',@{$verified}));
	foreach my $snd (@{$verified}) {
		if ($snd =~ /^(SPF|DKIM|DK|DomainKey):(.*)$/i) {
			my $sa = address_strip($2);
			if ($sa =~ /^.*\@(.+)$/) {
				report_address_relay($1,$hits) if ($rdb_domain);
				report_address_relay($sa,$hits) if ($rdb_sender);
			} else {
				report_address_relay($sa,$hits) if ($rdb_domain);
			}
		}
	}
}

sub report_relay($$$) {
	my ($ip,$verified,$hits) = @_;
	report_address_relay(address_strip($ip),$hits);
	report_verified_relay($verified,$hits);
}

# Update relaydb stamp for IP address
sub touch_relay($) {
	my ($ip) = @_;
	return unless ($relaydb);
	return unless ($rdb_touch);
	return unless (defined($rdb_ratio) || $rdb_min_black);
	my $now = time();
	debug_log(3,"report_relay: touch $ip");
	sql_execute('UPDATE relaylist SET rl_touch=? WHERE rl_host=?',$now,$ip);
}

# Check if sender blacklisted by relaydb
sub check_sender_blacklist {
	my $sender = address_strip(shift);
	return (0,'','') unless ($sender);
	my ($bad,$hit,$log) = (0,'','');
	($bad,$hit,$log) = check_relay_blacklist($sender,'sender') if ($rdb_sender);
	if ($rdb_domain && !$bad) {
		$sender =~ s/^.*\@//;
		($bad,$hit,$log) = check_relay_blacklist($sender,'domain');
	}
	return ($bad,$hit,$log);
}

# Checks a relay against the blacklists
sub check_relay($$$$$$) {
	my($msgid,$ip,$hostname,$failcode,$log_prepend,$from_received) = @_;
	# Check if blacklisted by relaydb
	my ($bad,$hit,$log) = check_relay_blacklist($ip);
	if ($bad) {
		touch_relay($ip) if (defined($rdb_touch) && $rdb_touch);
		debug_log(3, $log_prepend."check_relay: Blacklisted by relaydb, $hostname [$ip], " . $log);
		#return ('CONTINUE', "We currently do not want mail from $hit, but go head anyway.");
		#md_syslog('info', "MDLOG,$msgid,$log_prepend$hit,$log,?,?,?");
		if ($from_received) {
			stats_log($failcode,$MsgIDs,"$log_prepend$log",$hit,'*');
		} else {
			stats_log($failcode,$msgid,"$log_prepend$log",$hit,$ip,$hostname);
		}
		return ($failcode, make_answer('Denied',"At the moment we do not want mail from $hit."));
	}
	return ('CONTINUE', "Ok, go ahead.");
}


#***********************************************************************
# NoSPamDB stuff.
#***********************************************************************

# Get the no spam count
sub get_no_spam_count {
	my ($ip) = @_;
	return 0 unless ($ip);
	return 0 unless ($nospamdb);
	debug_log(3,"get_no_spam_count: a:$ip");
	my $rinf = sql_select_one_row('SELECT ns_touch,ns_count FROM nospamlist WHERE ns_host=?',$ip);
	debug_log(3,"get_no_spam_count: ap:$ip t:%s r:%s",$rinf->[0],$rinf->[1]);
	return 0 unless ($rinf && $rinf->[0]);
	return 0 unless ($rinf->[1] && $rinf->[1] != 0);
	return 0 unless (($nsdb_remember_spam && ($rinf->[1]<0)) || ($nsdb_expire<=0) || ($rinf->[0] > time()-$nsdb_expire));
	debug_log(3,"check_address_no_spam_has_spam: ap:$ip r:%s",$rinf->[1]);
	return $rinf->[1];
}

# Report address to nospamdb
sub report_address_no_spam($$$) {
	my ($ip,$hits,$count) = @_;
	return unless ($nospamdb);
	return unless ($count);
	return unless ($hits eq 'spam' || $hits < $nsdb_white_list || $hits > $nsdb_black_list);
	return if ($nsdb_remember_spam && (get_no_spam_count($ip) < 0));
	my $now = time();
	if ($hits eq 'spam' || $hits > $nsdb_black_list) {
		debug_log(3,"report_address_no_spam: spam $ip");
		if ($nsdb_remember_spam) {
			debug_log(3,"report_address_no_spam: remember spam $ip");
			if ($sqldbd eq 'M') {
				sql_execute('INSERT INTO nospamlist (ns_host,ns_stamp,ns_touch,ns_count) VALUES (?,?,?,?) '.
					    'ON DUPLICATE KEY UPDATE ns_stamp=VALUES(ns_stamp),ns_touch=VALUES(ns_touch),ns_count=VALUES(ns_count)',
					    $ip,$now,$now,-1);
			} else {
				sql_execute_multi(
					['INSERT OR IGNORE INTO nospamlist (ns_host) VALUES (?)',$ip],
					['UPDATE nospamlist SET ns_stamp=?,ns_touch=?,ns_count=? WHERE ns_host=?',$now,$now,-1,$ip],
				);
			}
		} else {
			debug_log(3,"report_address_no_spam: spam $ip");
			sql_execute('UPDATE nospamlist SET ns_stamp=?,ns_touch=?,ns_count=? WHERE ns_host=?',$now,$now,0,$ip);
		}
	} elsif ($hits < $nsdb_white_list) {
		debug_log(3,"report_address_no_spam: ham $ip");
		sql_execute_multi(
			['INSERT OR IGNORE INTO nospamlist (ns_host) VALUES (?)',$ip],
			['UPDATE nospamlist SET ns_stamp=?,ns_touch=?,ns_count=ns_count+1 WHERE ns_host=? AND ns_count>=0',$now,$now,$ip],
		);
	}
}

# Report verified address to nospam db
sub report_verified_no_spam {
	my ($verified,$hits) = @_;
	return unless ($nospamdb);
	return unless ($verified && @{$verified});
	foreach my $snd (@{$verified}) {
		if ($snd =~ /^(SPF|DKIM|DK|DomainKey):(.*)$/i) {
			my $sa = address_strip($2);
			if ($sa =~ /^.*\@(.+)$/) {
				report_address_no_spam($1,$hits,$nsdb_domain_count);
				report_address_no_spam($sa,$hits,$nsdb_sender_count);
			} else {
				report_address_no_spam($sa,$hits,$nsdb_domain_count);
			}
		}
	}
}

# Report to nospamdb
sub report_no_spam {
	my ($ip,$verified,$hits) = @_;
	return unless ($nospamdb);
	debug_log(3,'report_no_spam: %03.1f %s %s',$hits,$ip,join(' ',@{$verified}));
	report_address_no_spam($ip,$hits,$nsdb_relay_count);
	report_verified_no_spam($verified,$hits);
	#foreach my $hpn (get_hosts_parts_names($ip)) {
	#	debug_log(0,'report_no_spam: %f hpn %s %s',$hits,$ip,$hpn);
	#}
}
sub report_no_spam_spam {
	my ($ip) = @_;
	return unless ($nospamdb);
	debug_log(3,'report_no_spam: spam %s',$ip);
	report_address_no_spam($ip,'spam',$nsdb_relay_count);
}

# Check if address white listed by nospamdb
sub check_address_no_spam {
	my ($ip,$count) = @_;
	return 0 unless ($nospamdb);
	return 0 unless ($ip);
	return 0 unless ($count && $count>0);
	my $nsc = get_no_spam_count($ip);
	return 0 unless ($nsc > $count);
	debug_log(1,"check_address_no_spam: ap:$ip true");
	return 1;
}

# Get the no spam status for addresses
sub get_no_spam_bad {
	foreach my $ip (@_) {
		#debug_log(0,'get_no_spam_bad a %s',$ip);
		my $r = get_no_spam_count($ip);
		return 1 if ($r < 0);
		next unless ($ip =~ /\@/);
		my $ad = $ip;
		$ad =~ s/^.*\@//;
		#debug_log(0,'get_no_spam_bad d %s',$ip);
		$r = get_no_spam_count($ad);
		return 1 if ($r < 0);
	}
	#debug_log(0,'get_no_spam_bad %s',join(' ',@_));
	return 0;
}

# Get the no spam counts for addresses
sub get_no_spam_counts {
	my ($min,$max);
	foreach my $ip (@_) {
		my $r = get_no_spam_count($ip);
		$min = $r if (!defined($min) || $r<$min);
		$max = $r if (!defined($max) || $r>$max);
		next unless ($ip =~ /\@/);
		my $ad = $ip;
		$ad =~ s/^.*\@//;
		$r = get_no_spam_count($ad);
		$min = $r if (!defined($min) || $r<$min);
		$max = $r if (!defined($max) || $r>$max);
	}
	return ($min,$max);
}

# Checks if verified sender should bypass SpamAssassin
sub check_verified_no_spam {
	my ($verified,$all) = @_;
	return 0 unless ($nospamdb);
	return 0 unless ($verified && @{$verified});
	debug_log(3,'check_verified_no_spam: %u %u %s',$nsdb_sender_count,$nsdb_domain_count,join(' ',@{$verified}));
	my $nsc = 0;
	foreach my $snd (@{$verified}) {
		if ($snd =~ /^(SPF|DKIM|DK|DomainKey):(.*)$/i) {
			my $sa = address_strip($2);
			if ($sa =~ /^.*\@(.+)$/) {
				$nsc ++ if (check_address_no_spam($1,$nsdb_domain_count));
				return 1 if ($nsc && !$all);
				return 0 if ($all && !$nsc);
				$nsc ++ if (check_address_no_spam($sa,$nsdb_sender_count));
			} else {
				$nsc ++ if (check_address_no_spam($sa,$nsdb_domain_count));
			}
			return 1 if ($nsc && !$all);
			return 0 if ($all && !$nsc);
		}
	}
	return 1 if ($nsc);
	return 0;
}

# Check if white listed by nospamdb
sub check_no_spam {
	my ($ip,$verified,$all) = @_;
	my $nsi = check_address_no_spam($ip,$nsdb_relay_count);
	return 1 if ($nsi && !$all);
	return 0 if ($all && !$nsi);
	return check_verified_no_spam($verified,$all);
}


#***********************************************************************
# Spam Hash DB stuff
#***********************************************************************

sub remember_spam_hash {
	my ($hash,$report) = @_;
	return unless ($spamdb && $hash && $report);
	my $rcpts = join(',',sort { $a cmp $b } @Recipients);
	debug_log(0,'remember_spam_hash: <%s> %s %s %s %03.1f %i',$MsgIDs,$hash,$Sender,$rcpts,$report->{hits},$report->{req});
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO spamresults (spam_hash,spam_sender,spam_recipients,spam_count,spam_stamp,spam_score,spam_required,spam_id) VALUES (?,?,?,?,?,?,?,?) '.
			    'ON DUPLICATE KEY UPDATE spam_count=spam_count+1,spam_stamp=VALUES(spam_stamp),spam_score=VALUES(spam_score),spam_required=VALUES(spam_required),spam_id=VALUES(spam_id)',
			    $hash,$Sender,$rcpts,1,time(),sprintf('%i',$report->{hits}*100),sprintf('%i',$report->{req}*100),$MsgIDs);
	} else {
		sql_execute_multi(
			['INSERT OR IGNORE INTO spamresults (spam_hash,spam_sender,spam_recipients) VALUES (?,?,?)',$hash,$Sender,$rcpts],
			['UPDATE spamresults SET spam_count=spam_count+1,spam_stamp=?,spam_score=?,spam_required=?,spam_id=? WHERE spam_hash=? AND spam_sender=? AND spam_recipients=?',
				time(),
				sprintf('%i',$report->{hits}*100),
				sprintf('%i',$report->{req}*100),
				$MsgIDs,$hash,$Sender,$rcpts],
		);
	}
};

sub check_spam_hashes {
	my ($hash) = @_;
	return 0 unless ($spamdb && $hash);
	my $rcpts = join(',',sort { $a cmp $b } @Recipients);
	my $rinf = sql_select_one_row('SELECT spam_stamp,spam_id,spam_score,spam_required FROM spamresults WHERE spam_hash=? AND spam_recipients=? AND spam_sender=?',$hash,$rcpts,$Sender);
	return 0 unless ($rinf && @{$rinf});
	#sql_execute_multi(['UPDATE spamresults SET spam_count=spam_count+1 WHERE spam_hash=? AND spam_recipients=? AND spam_sender=?',$hash,$rcpts,$Sender]);
	my $spam = (time() - $rinf->[0] < $sdb_expire) ? 1 : 0;
	$rinf->[2] = sprintf('%03.1f',$rinf->[2]/100);
	$rinf->[3] = sprintf('%03.1f',$rinf->[3]/100);
	debug_log(0,'check_spam_hashes: <%s> %u %s %s %s %i %i',$rinf->[1],$spam,$hash,$Sender,$rcpts,$rinf->[2],$rinf->[3]);
	return ($spam,$rinf->[0],$rinf->[1],$rinf->[2],$rinf->[3]);
}

sub inc_spam_hash {
	my ($hash) = @_;
	my $rcpts = join(',',sort { $a cmp $b } @Recipients);
	sql_execute_multi(['UPDATE spamresults SET spam_count=spam_count+1 WHERE spam_hash=? AND spam_recipients=? AND spam_sender=?',$hash,$rcpts,$Sender]) if ($hash);
}

#***********************************************************************
# Dictionary and Greylisting stuff.
#***********************************************************************

# Add message to list of messages
sub msgl_add {
	my $mid = address_strip_nc(shift);
	return unless ($mid);
	my $spam = shift;
	my $sndr = address_strip(shift);
	$spam = $spam ? ",msg_spam=?" : '';
	my $now = time();
	while (@_) {
		my $rcpt = address_strip(shift @_);
		if ($sqldbd eq 'M') {
			if ($spam) {
				sql_execute('INSERT INTO messages (msg_id,msg_sender,msg_recipient,msg_stamp,msg_spam) VALUES (?,?,?,?,?) '.
					    'ON DUPLICATE KEY UPDATE msg_spam=VALUES(msg_spam)',
					    $mid,$sndr,$rcpt,$now,$now);
			} else {
				sql_execute('INSERT INTO messages (msg_id,msg_sender,msg_recipient,msg_stamp,msg_count) VALUES (?,?,?,?,?) '.
					    'ON DUPLICATE KEY UPDATE msg_count=msg_count+1',
					    $mid,$sndr,$rcpt,$now,1);
			}
		} else {
			sql_execute_multi(
				['INSERT OR IGNORE INTO messages (msg_id,msg_sender,msg_recipient,msg_stamp) VALUES (?,?,?,?)',$mid,$sndr,$rcpt,$now],
				$spam
					? ["UPDATE messages SET msg_spam=? WHERE msg_id=? AND msg_sender=? AND msg_recipient=?",$now,$mid,$sndr,$rcpt]
					: ["UPDATE messages SET msg_count=msg_count+1 WHERE msg_id=? AND msg_sender=? AND msg_recipient=?",$mid,$sndr,$rcpt]
			);
		}
	}
}

# Get time since first seen messages
sub msgl_info {
	my $mid = address_strip_nc(shift);
	return unless ($mid);
	my $sndr = address_strip(shift);
	my $now = time();
	my @r = ();
	while (@_) {
		my $rcpt = address_strip(shift @_);
		my $msgf = sql_select_one_row('SELECT msg_stamp,msg_count FROM messages WHERE msg_id=? AND msg_sender=? AND msg_recipient=?',$mid,$sndr,$rcpt);
		next unless ($msgf && $#$msgf > 0 && $msgf->[0] && $msgf->[1]);
		push @r, {r=>$rcpt,t=>$msgf->[0],e=>$now-$msgf->[0],c=>$msgf->[1]};
	}
	return sort { $a->{c} <=> $b->{c} } @r if (@r);
	return @r;
}

# Get time since first seen messages
sub msgl_info_str {
	my @mi = msgl_info(@_);
	return '' unless (@mi);
	my @rs = ();
	my %rs = ();
	foreach my $mri (@mi) {
		my $rs = sprintf('%u,%s',$mri->{c},time_string($mri->{e},1));
		next if ($rs{$rs});
		$rs{$rs} = 1;
		push @rs, $rs;
	}
	return join('; ',@rs);
}

sub msgl_spam {
	my $mid = address_strip_nc(shift);
	return unless ($mid);
	my $sndr = address_strip(shift);
	my $r = 0;
	my $n = 0;
	my $t = 0;
	my $age = $SARemember ? time()-$SARemember : 0;
	while (@_) {
		my $rcpt = address_strip(shift @_);
		my $spam = sql_select_one('SELECT msg_spam FROM messages WHERE msg_id=? AND msg_sender=? AND msg_recipient=?',$mid,$sndr,$rcpt);
		unless ($spam) {
			$n ++;
			next;
		}
		debug_log(0,'msgl_spam a %s %u %u',$mid,$age,$spam);
		$n ++ if ($age == 0 || $spam<$age);
		$t = $spam if ($spam>$t);
		$r ++;
	}
	$r = -$r if ($n);
	debug_log(1,'msgl_spam r %s %i %u',$mid,$r,$t);
	return ($r,$t);
}

sub out_subject {
	my $subj = decode_header(join(' ',@_));
	$subj =~ s/[^\x20-\x7E]/?/g;
	$subj =~ s/^(?:\[\S+\]\s*)?(?:\S{1,5}:\s*)?(?:\[\S+\]\s*)?(\S)/$1/;
	return $subj;
}

sub out_add {
	my $entity = shift;
	my $sender = shift;
	return unless ($sentoutdb);
	return unless ($entity && $entity->head);
	my $now = time();
	my $id = address_strip_nc($entity->head->get('Message-Id'));
	my $subj = out_subject($entity->head->get('Subject'));
	my @from = ();
	push @from, address_strip($sender);
	get_addresses_from_header($entity,'Reply-To:From',\@from,'lc');
	my @sql = ();
	my %rh = ();
	while (@_) {
		my $rcpt = address_strip(shift @_);
		next if ($rcpt =~ /\@$OurDomains>?$/i);
		next if ($rh{$rcpt});
		$rh{$rcpt} = 1;
		my $rcptu = $rcpt;
		my $rcptd = '';
		if ($rcptu =~ /^(.*)\@(.*?)$/) {
			$rcptd = $2;
			$rcptu = $1;
		}
		my %fh = ();
		foreach my $from (@from) {
			next unless ($from =~ /\@$OurDomains>?$/i);
			next if ($fh{$from});
			$fh{$from} = 1;
			push @sql, ['INSERT INTO sentout (out_id,out_sender,out_rcpt_usr,out_rcpt_dom,out_subject,out_stamp) VALUES (?,?,?,?,?,?)',
					$id,$from,$rcptu,$rcptd,$subj,$now];
		}
	}
	sql_execute_multi(@sql) if (@sql);
}

sub out_check_for_bounce {
	my ($relay,$recipient) = @_;
	return 1 if (check_internal_whitelist($relay));
	return 0 unless ($recipient =~ /\@$OurDomains>?$/i);
	return 1 if (sql_select_one("SELECT out_stamp FROM sentout WHERE (out_sender=?) AND (out_stamp>?) LIMIT 1",
					address_strip($recipient),$out_expire ? time() - $out_expire : 0));
	return 0;
}

sub out_check {
	my $head = shift;
	my $sender = shift;
	return 0 unless ($sentoutdb);
	return 0 unless ($head);
	if ($head =~ /^(?:MIME::Entity|Mail::Internet)=/) {
		$head = $head->head;
		return 0 unless ($head);
	}
	my $now = time();
	my $et = 0;
	$et = $now-$out_expire if ($out_expire);
	my @from = ();
	get_addresses_from_value($sender,\@from,'all') if ($sender);
	get_addresses_from_header($head,'From:Sender:Reply-To',\@from,'all');
	my @domp = ();
	my $domq = '';
	my @usrp = ();
	my $usrq = '';
	my %xq = ();
	my %yq = ();
	foreach my $fi (@from) {
		if ($fi->{domain} && !$xq{$fi->{domain}}) {
			$xq{$fi->{domain}} = 1;
			$domq .= ' OR ' if ($domq);
			$domq .= 'out_rcpt_dom=?';
			push @domp, $fi->{domain};
		}
		next unless ($fi->{user});
		my $ud = sprintf('%s@%s',$fi->{user},$fi->{domain});
		next if ($yq{$ud});
		$yq{$ud} = 1;
		$usrq .= ' OR ' if ($usrq);
		$usrq .= '(out_rcpt_dom=? AND out_rcpt_usr=?)';
		push @usrp, $fi->{domain};
		push @usrp, $fi->{user};
	}
	my @top = ();
	my $toq = '';
	%xq = ();
	while (@_) {
		my $rcpt = address_strip(shift @_);
		next unless ($rcpt);
		next if ($xq{$rcpt});
		$xq{$rcpt} = 1;
		$toq .= ' OR ' if ($toq);
		$toq .= 'out_sender=?';
		push @top, $rcpt;
	}
	my @idp = ();
	my $idq = '';
	%xq = ();
	foreach my $hn(('References','In-Reply-To')) {
		my @hl = $head->get($hn);
		next unless (@hl);
		foreach my $hv (@hl) {
			foreach my $hid (split(/\s+/,$hv)) {
				next unless ($hid =~ /^\s*<.*>\s*$/);
				$hid = address_strip_nc($hid);
				next unless ($hid);
				next if ($xq{$hid});
				$xq{$hid} = 1;
				$idq .= ' OR ' if ($idq);
				$idq .= 'out_id=?';
				push @idp, $hid;
			}
		}
	}
	return 0 unless ($domq && $toq);
	if ($idq) {
		my $cc = sql_select_one("SELECT out_stamp FROM sentout WHERE ($idq) AND ($domq) AND ($toq) AND (out_stamp>?) LIMIT 1",
					@idp,@domp,@top,$et);
		debug_log(2,'out_check: %u - (%s) AND (%s) AND (%s)',$cc,$idq,$domq,$toq);
		return 1 if ($cc);
	}
	return 0 unless ($usrq);
	my $subj = out_subject($head->get('Subject'));
	my $cc = sql_select_one("SELECT out_stamp FROM sentout WHERE ($toq) AND ($usrq) AND (out_subject=?) AND (out_stamp>?) LIMIT 1",
				@top,@usrp,$subj,$et);
	debug_log(2,'out_check: %u - (%s) AND (%s) AND (out_subject=%s)',$cc,$usrq,$toq,$subj);
	return 1 if ($cc);
	return 0;
}

# Strip strings for use in the greylist.
sub greylist_strip($) {
	my($a) = @_;
	#$a =~ s/;/:/g;
	return $a;
}

sub greylist_strip_mail($$$) {
	my($a,$d,$s) = @_;
	$a = address_strip($a);
	my $au = $a;
	my $ad = $a;
	$ad =~ s/.*@([^@]*)$/$1/;
	$au =~ s/@[^@]*$//;
	if ($d) {
		$au = "*";
	} elsif ($s) {
		$au =~ s/(.+)\+.*$/$1/;
		my $aut;
		my $autt = $au;
		do {
			$aut = $autt;
			$autt =~ s/^(|.*[^a-z0-9])[a-f0-9]*\d[a-f0-9]*(|[^a-z0-9].*)$/$1#$2/;
		} until ($autt eq $aut);
		$au = $aut if ($aut =~ /[a-z0-9]/);
		#$au =~ s/[^-a-z0-9_.#]/?/g;
	}
	return greylist_strip($au."@".$ad);
}

sub greylist_strip_ip($) {
	my ($a) = @_;
	$a =~ s/(.*)\.[0-9]+$/$1\.*/ if (defined($gdb_subnet) && $gdb_subnet);
	return greylist_strip(address_strip($a));
}

sub greylist_strip_host {
	my ($a) = @_;
	return greylist_strip(address_strip($a));
}

sub greylist_strip_triplet(@) {
	my ($i,$s,$r) = @_;
	$s = greylist_strip_mail($s,(defined($gdb_from_domain) && $gdb_from_domain),(defined($gdb_from_strip) && $gdb_from_strip));
	$r = greylist_strip_mail($r,(defined($gdb_to_domain) && $gdb_to_domain),(defined($gdb_to_strip) && $gdb_to_strip));
	$i = greylist_strip_ip($i);
	return ($i,$s,$r);
}

sub greylist_strip_dataset(@) {
	my ($i,$s,$r) = greylist_strip_triplet(@_);
	my $h = greylist_strip_host(@_);
	return ($h,$i,$s,$r);
}

sub dc_clean {
	return 0 unless ($dc_keep);
	debug_log(0,'%u dc rec(s) removed',$sql_did) if (sql_execute('DELETE FROM dictionary WHERE (dc_stamp<?)',time()-$dc_keep) && $sql_did>0);
	return $sql_did;
}

# Add host to dictionary list
sub dc_add {
	my ($host) = @_;
	my $now = time();
	sql_execute('INSERT INTO dictionary (dc_stamp,dc_host) VALUES (?,?)',$now,$host);
}
sub dict_add_grey {
	return 0 unless ($dc_grey_new);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_unknown_user {
	return 0 unless ($dc_unknown_user);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_invalid_mx {
	return 0 unless ($dc_invalid_mx);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_bad_helo {
	return 0 unless ($dc_bad_helo);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_black_host {
	return 0 unless ($dc_black_host);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_virus {
	return 0 unless ($dc_virus);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_abuse {
	return 0 unless ($dc_abuse);
	return dc_add(greylist_strip_host(@_));
}
sub dict_add_trap {
	return 0 unless ($dc_trap);
	return dc_add(greylist_strip_host(@_));
}

# Greylist exemption stuff.
sub test_exemptions {
	my $comment = shift;
	my $exlist = shift;
	my $ip = address_strip(shift);
	my $fqdn = shift;
	my $hlo = shift;
	my $oh = '';
	$oh = '_host' unless (@_);
	my $snd = address_strip(shift);
	my $rcpt = shift;
	my $entity = shift;
	return wantarray ? (1,'','') : 1 unless ($exlist);
	return wantarray ? (0,'set',$exlist) : 0 if ($exlist && $exlist =~ /^\d+$/s);
	#debug_log(0,'%s_exempt %s %s %s',$comment,$fqdn,$ip,$exlist);
	foreach my $gck (split(/\s*;\s*/,$exlist)) {
		my @mis = ();
		my ($gc,$gv) = split(/\s*:\s*/,$gck,2);
		my $rv = 0;
		if ($gc =~ /^(\?|except )\s*(.*)$/) {
			$gc = $2;
			$rv = 1;
			push @mis, '?';
		}
		my $gn = 1;
		if ($gc =~ /^(!|not )\s*(.*)$/) {
			$gc = $2;
			$gn = 0;
			push @mis, '!';
		}
		$gc =~ s/[-_\s]+//g;
		$gc = lc($gc);
		push @mis, $gc;
		my $tm = 0;
		#debug_log(0,'%s_exempt %s %s %u %s %s',$comment,$fqdn,$ip,$gn,$gc,$gv);
		if ($gc =~ /^r(ev|everse)?dns$/) {
			push @mis, $fqdn;
			$tm = 1 if ($fqdn !~ /^\[?$ip\]?$/ && $fqdn =~ /\S+\.\S+/);
		} elsif ($gc =~ /^d(yn|ynamic)?$/) {
			push @mis, ($fqdn,$ip);
			$tm = 1 if (check_maybe_dynamic_fqdn($fqdn,$ip));
			#debug_log(0,'%s_exempt dynamic %s %s',$comment,$fqdn,$ip) if ($tm);
		} elsif ($gc =~ /^s(tatic|server|rv)?$/) {
			push @mis, ($fqdn,$ip);
			$tm = 1 if (check_maybe_server_fqdn($fqdn,$ip));
			#debug_log(3,'%s_exempt server %s %s',$comment,$fqdn,$ip) if ($tm);
		} elsif ($gc =~ /^f(ull)?c(ircle)?dns$/) {
			push @mis, $ip;
			$tm = 1 if (get_full_circle_dns($ip));
			#debug_log(0,'%s_exempt fcdns %s',$comment,$ip) unless ($tm);
		} elsif ($gc =~ /^(ip|rhs|d|dom|domain)?dns(bl|blacklist|wl|whitelist)?s?$/) {
			$Features{"Net::DNS"} = load_modules('Net::DNS') unless ($Features{"Net::DNS"});
			next unless ($Features{"Net::DNS"});
			my $chadr;
			$gv =~ s/\s+//;
			if ($gc =~ /^(rhs|d|dom|domain)dns/) {
				next unless ($snd);
				$chadr = $snd;
				$chadr =~ s/^.*\@//;
				next unless ($chadr);
				$gv = 'nomail.rhsbl.sorbs.net' unless ($gv);
			} else {
				$chadr = $ip;
				$gv = 'combined.njabl.org,dnsbl.sorbs.net' unless ($gv);
			}
			my @dnsbl = split(/,/,$gv);
			my $blaw = 1;
			$blaw = shift @dnsbl if (@dnsbl && $dnsbl[0] =~ /^\d+$/);
			my $tmtm = $tm;
			if (@dnsbl && $dnsbl[0]) {
				push @mis, $chadr;
				my ($cdr,$cdh) = check_dnsls($chadr,15,$blaw,@dnsbl);
				#debug_log(0,'%s_exempt dnsbl %s %s',$comment,$cdr,join(',',@{$cdh}));
				push @mis, $blaw;
				if ($cdr) {
					$tm = 1 if ($cdr);
					push @mis, @{$cdh};
				} else {
					foreach my $odl (@dnsbl) {
						my $dlo = $odl;
						$dlo =~ s/:.*$//;
						push @mis, $dlo;
					}
				}
			}
			#debug_log(0,'%s_exempt dnsbl %i %i<>%i %s',$comment,$blaw,$tm,$tmtm,join('|',@dnsbl)) if ($tm != $tmtm);
			#debug_log(0,'%s_exempt dnsbl %s %s',$comment,$ip,$gv) if ($tm);
		} elsif ($gc =~ /^c(ountry)?$/) {
			my @cc = ();
			push @cc, lc($fqdn) if ($fqdn);
			$cc[0] =~ s/^.*\.//;
			push @cc, get_ip_country($ip,'?lr','f','c3','c2');
			$gv =~ s/\s+//;
			next unless (@cc);
			foreach my $cv (split(/,/,lc($gv))) {
				next unless ($cv);
				$cv = ".*$cv.*" if (length($cv)>3);
				push @mis, $cv;
				for (my $c=0;$c<@cc && !$tm;$c++) {
					$tm = 1 if ($cc[$c] =~ /^$cv$/);
					#debug_log(0,'%s_exempt country %s %s',$comment,$cc[$c],$cv) if ($tm);
				}
				last if ($tm);
			}
		} elsif ($gc =~ /^h(ost)?$/) {
			next unless ($fqdn);
			$gv =~ s/\s+//;
			next unless ($gv);
			$gv =~ s/,+/,/g;
			$gv =~ s/\./\\./g unless ($gv =~ /(\\|\.[\*\?])/);
			$gv =~ s/(^|,)(.)/$1.*\\.$2/g;
			$gv =~ s/,/|/g;
			push @mis, $gv;
			$gv = "($gv)";
			$tm = 1 if ($fqdn =~ /^$gv$/i);
			#debug_log(0,'%s_exempt host %s %s',$comment,$fqdn,$gv) if ($tm);
		} elsif ($gc =~ /^r(elay)?(db)?$/) {
			$tm = 1 if (check_relay_spam($ip));
			push @mis, $ip;
			#debug_log(0,'%s_exempt relay %s',$comment,$ip) if ($tm);
		} elsif ($gc =~ /^no?s(pam)?(db)?$/) {
			my @gnsa = ($ip);
			push @gnsa, $snd unless ($oh);
			push @mis, @gnsa;
			if ($gv && $gv > 0) {
				my ($nsl,$nsh) = get_no_spam_counts(@gnsa);
				$tm = 1 if ($nsl < $gv);
			} else {
				$tm = 1 if (get_no_spam_bad(@gnsa));
			}
		} elsif ($gc =~ /^o(perating)?s(ystem)?$/) {
			next unless ($gv);
			next unless (load_modules('p0fIP2OS'));
			my ($os,$osv) = ip2osver($ip);
			next unless ($os || $osv);
			$os = "$os $osv";
			$os =~ s/\s+/ /g;
			$os =~ s/\s+$//;
			$os =~ s/^\s+//;
			next unless ($os);
			$gv =~ s/,+/,/g;
			$gv =~ s/\|+/\|/g;
			$gv =~ s/\./\\./g unless ($gv =~ /(\\|\.[\*\?])/);
			$gv =~ s/,/|/g unless ($gv =~ /\|/);
			$gv =~ s/\s+/\\s+/g;
			push @mis, $gv;
			$gv = "($gv)";
			$tm = 1 if ($os =~ /$gv/i);
		} elsif ($gc =~ /^s(ent)?o(ut)?(db)?$/) {
			next if ($oh);
			next unless ($entity);
			push @mis, ('*',$snd,@{$rcpt});
			$tm = 1 if (out_check($entity,$snd,@{$rcpt}));
		} elsif ($gc =~ /^m(ail)?e?x(change)?$/i) {
			push @mis, ($ip,$fqdn,$snd);
			$tm = 1 if (server_is_mx($ip,$fqdn,$snd));
		} elsif ($gc =~ /^spfp(ass)?$/i) {
			if ($snd && $snd !~ /^<>$/) {
				push @mis, $snd;
				$tm =1 if (check_spf_mfrom($snd)>0);
			} elsif ($hlo) {
				push @mis, $hlo;
				$tm =1 if (check_spf_helo($hlo)>0);
			}
		} elsif ($gc =~ /^spff(ail)?$/i) {
			if ($snd && $snd !~ /^<>$/) {
				push @mis, $snd;
				$tm =1 if (check_spf_mfrom($snd)<0);
			} elsif ($hlo) {
				push @mis, $hlo;
				$tm =1 if (check_spf_helo($hlo)<0);
			}
		} elsif ($gc =~ /^h(ell?o)?fqdn$/) {
			next unless ($hlo);
			push @mis, $hlo;
			$tm = 1 if ($hlo =~ /\./ && $hlo !~ /^\[.*\]$/ && $hlo !~ /^\d+\.\d+\.\d+\.\d+$/);
		} elsif ($gc =~ /^a(ll)?$/) {
			$tm = 1;
			#debug_log(0,'%s_exempt all',$comment);
		} else {
			debug_log(-1,'%s_exempt%s unknown exemption: "%s"',$comment,$oh,$gc);
			next;
		}
		if ($tm == $gn) {
			debug_log(2,'%s_exempt%s %u %s %s %s %s',$comment,$oh,$rv,$gck,$ip,$fqdn,$snd);
			if ($comment eq 'greylist') {
				greylist_log($rv?"exempted$oh":"check$oh",[0,$ip,$hlo?$hlo:'',$oh?'':$snd,'',$fqdn],\@mis);
			}
						push @lst, $logcsv->string() if ($logcsv->combine(@sl));

			return wantarray ? ($rv,"$gc:$gv",$logcsv->combine(@mis)?$logcsv->string():join(',',@mis)) : $rv;
		}
	}
	debug_log(2,'%s_exempt%s 1 - %s %s %s',$comment,$oh,$ip,$fqdn,$snd);
	if ($comment eq 'greylist') {
		greylist_log("exempted$oh",[0,$ip,$oh?$snd:'','',$fqdn]);
	}
	return wantarray ? (1,'','') : 1;
}
sub greylist_exempt {
	return test_exemptions('greylist',$greylist,@_);
}
sub check_blockrelay {
	return test_exemptions('relay',$block_relay,@_);
}
sub check_blocksender {
	return test_exemptions('sender',$block_sender,@_);
}

# Checks if host IP is white in the grey-list.
sub greylist_check_host {
	my ($ip) = greylist_strip_host(@_);
	my $white = 0;
	my $black = 0;
	$white = $gdb_host_white if (defined($gdb_host_white) && ($gdb_host_white > 0));
	$black = $gdb_host_black if (defined($gdb_host_black) && ($gdb_host_black > 0));
	return (-1,'') unless ($white || $black);
	debug_log(4,"greylist_check_host: $ip");
	my $now = time();
	my $stamps = sql_select_one_row('SELECT hl_stamp,hl_touch FROM hostlist WHERE hl_host=?',$ip);
	return (-1,'') unless ($stamps);
	my $stamp = 0;
	my $touch = 0;
	if (@$stamps) {
		$stamp = $stamps->[0] if ($stamps->[0]);
		$touch = $stamps->[1] if ($stamps->[1]);
	}
	debug_log(4,'greylist_check_host: %s %u %u',$ip,$stamp,$touch);
	return (0,'white') if ($white && $touch && ($touch > $now - $white));
	return (-1,'') unless ($black);
	unless ($stamp) {
		sql_execute('INSERT OR IGNORE INTO hostlist (hl_host,hl_stamp) VALUES (?,?)',$ip,$now);
		dict_add_black_host(@_);
		return ($black,'new');
	}
	my $rr = ($stamp+$black)-$now;
	if ($rr > 0) {
		dict_add_black_host(@_);
		return ($rr,'black');
	}
	return (-1,'');
}

# Checks if a triplet is in the grey-list.
# Returns seconds until the triplet will be accepted, or -1 for error.
sub greylist_update {
	my ($reset,$accept,$ip,$sender,$recipient) = @_;
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO greylist (gl_reset,gl_accepted,gl_host,gl_sender,gl_recipient) VALUES (?,?,?,?,?) '.
			    'ON DUPLICATE KEY UPDATE gl_reset=VALUES(gl_reset),gl_accepted=VALUES(gl_accepted)',
			    $reset,$accept,$ip,$sender,$recipient);
	} else {
		sql_execute('REPLACE INTO greylist (gl_reset,gl_accepted,gl_host,gl_sender,gl_recipient) VALUES (?,?,?,?,?)',$reset,$accept,$ip,$sender,$recipient);
	}
}
sub greylist_check($$$) {
	my ($hip,$ip,$sender,$recipient) = greylist_strip_dataset(@_);

	my ($hresult,$hevent) = greylist_check_host(@_);
	debug_log(3,'greylist_check: %u %s host',$hresult,$hevent) if ($hresult >= 0);
	unless ($hresult) {
		greylist_log('white_host',[0,$hip,$sender,$recipient]);
		return (0,'White Host');
	}

	my $now = time();
	my $reset = 0;
	my $accepted = 0;
	my $stamps = sql_select_one_row('SELECT gl_reset,gl_accepted FROM greylist WHERE gl_host=? AND gl_sender=? AND gl_recipient=?',$ip,$sender,$recipient);
	if ($stamps) {
		if (@$stamps) {
			$reset = $stamps->[0] if ($stamps->[0]);
			$accepted = $stamps->[1] if ($stamps->[1]);
		}
		if ($now < $reset+$gdb_black) {
			$result = ($reset+$gdb_black)-$now;
			$event = 'black';
		} elsif (($now < $reset+$gdb_grey) || (($accepted > 0) && ($now < $accepted + $gdb_white))) {
			greylist_update($reset,$now,$ip,$sender,$recipient);
			$result = 0;
			$event = 'white';
		} elsif ($reset || $accepted) {
			greylist_update($now,0,$ip,$sender,$recipient);
			dict_add_grey(@_);
			$result = $gdb_black;
			$event = 'old';
		} else {
			greylist_update($now,0,$ip,$sender,$recipient);
			dict_add_grey(@_);
			$result = $gdb_black;
			$event = 'new';
		}
		#md_syslog('info', "greylist: $event; $result; $ip; $sender; $recipient") if (defined($gdb_log) && $gdb_log);
		greylist_log($event,[$result,$ip,$sender,$recipient]);
	}
	debug_log(3,'greylist_check: %u %s',$result,$event) if ($result >= 0);
	
	return ($result,ucfirst($event));
}

# White-lsits host in greylist db.
sub greylist_white_host($) {
	my ($ip) = @_;
	return 0 if (check_internal_whitelist($ip));
	return 0 unless (defined($gdb_host_white) && ($gdb_host_white > 0));
	$ip = greylist_strip_host($ip);
	debug_log(1,"greylist_white_host: $ip");
	my $now = time();
	my $t = ($now - $gdb_host_white) + 1;
	sql_execute_multi(
		['INSERT OR IGNORE INTO hostlist (hl_host,hl_stamp) VALUES (?,?)',$ip,$now],
		['UPDATE hostlist SET hl_touch=? WHERE hl_host=? AND hl_touch<?',$now,$ip,$t],
	);
}

# Resets host record(s) in the grey list.
sub greylist_reset_host($) {
	my $ip = greylist_strip_host(@_);
	debug_log(1,"greylist_reset_host: $ip");
	sql_execute('UPDATE hostlist SET hl_touch=0 WHERE hl_host=?',$ip);
}

# Resets record(s) in the grey list.
sub greylist_reset {
	my ($ip,$sender,$recipient) = @_;
	my $r = greylist_reset_host($ip);
	my $now = time();
	if ($sender || $recipient) {
		$r += sql_execute('UPDATE greylist SET gl_reset=?,gl_accepted=? WHERE gl_host=? AND gl_sender=? AND gl_recipient=?',$now,0,$ip,$sender,$recipient);
	} else {
		$r += sql_execute('UPDATE greylist SET gl_reset=?,gl_accepted=? WHERE gl_host=?',$now,0,$ip);
	}
	return $r;
}

# Check if host currently exceeds limits in dictionary list
sub dict_check_host {
	return 0 unless ($dc_time_window && ($dc_limit || $dc_limit_time));
	my $host = greylist_strip_host(@_);
	my $now = time();
	if ($dc_limit) {
		my $time = $now - $dc_time_window;
		my $cnt = sql_select_one('SELECT COUNT(dc_stamp) FROM dictionary WHERE dc_host=? AND dc_stamp>?',$host,$time);
		return $cnt if ($cnt && $cnt > $dc_limit);
	}
	if ($dc_limit_time) {
		my ($lth,$ltl,$ltt);
		foreach my $winh ((-1,24,12,6,3,1,0.5,0.25,0.125)) {
			my $res;
			if ($winh>0) {
				my $win = int($winh*60*60);
				#debug_log(0,'dict_check_host limitpertime ?1 %s %u %u (%f)',$host,$win,$ltt,$winh);
				last unless ($win > $dc_time_window);
				next unless ($win < $ltt);
				$win = $now - $win;
				#debug_log(0,'dict_check_host limitpertime ?2 %s %u %u %u (%f)',$host,$win,$lth,$ltl,$winh);
				last if ($win > $lth);
				next if ($win < $ltl);
				$res = sql_select_one_row('SELECT MIN(dc_stamp),MAX(dc_stamp),COUNT(dc_stamp) FROM dictionary WHERE dc_host=? AND dc_stamp>?',$host,$win);
			} else {
				$res = sql_select_one_row('SELECT MIN(dc_stamp),MAX(dc_stamp),COUNT(dc_stamp) FROM dictionary WHERE dc_host=? AND dc_stamp>0',$host);
			}
			#debug_log(0,'dict_check_host limitpertime %s (%f)',$host,$winh);
			last unless ($res && $#$res==2 && $res->[0] && $res->[1] && $res->[2]);
			my $time = $now - $res->[0];
			last unless ($time && $time>$dc_time_window);
			$ltl = $res->[0];
			$lth = $res->[1];
			$ltt = $time;
			#debug_log(0,'dict_check_host limitpertime %s %i %i (%f)',$host,$time,$res->[2],$winh);
			my $calc = $time ? $res->[2]/$time : $res->[2];
			next unless ($calc && $calc > $dc_limit_time);
			#debug_log(0,'dict_check_host limitpertime %s %s %u / %u = %f (%f)',
			#	($calc && $calc > $dc_limit_time) ? '!' : '-',
			#	$host,$res->[2],$time,$calc,$winh);
			return $calc;
		}
	}
	return 0;
}


#***********************************************************************
# Received-lines checks.
#***********************************************************************

# Check if received line says someones HELO pretended to be ours or our backups IP
sub check_received_helo($$$$) {
	my ($bip,$bhost,$ip,$helo) = @_;
	$bip = address_strip($bip);
	$bhost = address_strip($bhost);
	$ip = address_strip($ip);
	$helo = address_strip($helo);
	debug_log(3,"check_received_helo: $bip, $bhost, $ip, $helo");
	if (!check_internal_whitelist($ip) && !check_external_whitelist($ip) && 
			!check_black_nets($helo) && !check_black_nets($ip) &&
			(check_mail_backup($helo,'') || check_our_helo($helo)) && check_mail_backup($bip,$bhost)) {
		debug_log(3,"check_received_helo: Bad HELO $helo [$ip] at $bhost");
		return 1;
	}
	return 0;
}

# Checks hosts found in receive-headers
sub check_received_lines($$) {
	my ($sender,$head) = @_;
	debug_log(3, "check_received_lines: $sender");
	return (0,'','') unless ($head);
	return (0,'','') unless (load_modules('Mail::Field','Mail::Field::Received'));
	#my @rr = ();
	#foreach my $rl ($head->get('Received')) { push @rr, $rl; }
	#my @pr = ();
	my $st = time();
	my @recheads = Mail::Field->extract('Received',$head);
	debug_log(4, "check_received_lines: %u",$#recheads+1);
	foreach my $rechead (@recheads) {
		if (time() - $st > 120) {
			debug_log(-1,'check_received_lines: timeout');
			last;
		}
		my %rec = %{$rechead->parse_tree()};
		debug_log(5,'check_received_lines: = '.$rec{'whole'});
		#push @pr, $rec{'whole'}."\n";
		next if (!defined($rec{'from'}));
		my $ip = "";
		my $host = "";
		my $helo = "";
		my $from = "";
		my $byhost = "";
		my $byip = "";
		$ip = $rec{'from'}{'address'} if (defined($rec{'from'}{'address'}));
		$host = $rec{'from'}{'domain'} if (defined($rec{'from'}{'domain'}));
		$helo = $rec{'from'}{'HELO'} if (defined($rec{'from'}{'HELO'}));
		$from = $rec{'from'}{'from'} if (defined($rec{'from'}{'from'}));
		#$pr[$#pr] = "'$ip' > '$byip'\n$pr[$#pr]";
		if (defined($rec{'by'})) {
			$byhost = $rec{'by'}{'domain'} if (defined($rec{'by'}{'domain'}));
			if (defined($rec{'by'}{'comments'})) {
				foreach my $cm (@{$rec{'by'}{'comments'}}) {
					if ($cm =~ /^\((\d+\.\d+\.\d+\.\d+)\)$/) {
						$byip = $1;
						last;
					}
				}
			}
		}
		debug_log(5,"speci_received_helo: rec $rec{'whole'}");
		if ($ip =~ /^\[?\d+\.\d+\.\d+\.\d+\]?$/ && check_mail_backup('',$byhost) &&
				$rec{'whole'} =~ /^\s*from\s+([^\(\)\[\]\s]+\s+)?\(([^\)]+)\)\s+\[(\d+\.\d+\.\d+\.\d+)\]\s+by\s+(\S+)\s+with\s+e?smtp\s+id\s+\S+;\s+[A-Z][a-z][a-z],\s+\d\d?\s+[A-Z][a-z][a-z]\s+\d+\s+\d\d?\:\d\d:\d\d\s+[+-]?\d+/) {
			debug_log(5,"speci_received_helo: was helo=$helo ip=$ip byhost=$byhost");
			$host = $1;
			$helo = $2;
			$ip = $3;
			$byhost = $4;
			$host =~ s/\s+$//;
			debug_log(5,"speci_received_helo: has helo=$helo ip=$ip byhost=$byhost");
		}
		debug_log(5,"speci_received_helo...");
		if (check_received_helo($byip,$byhost,$ip,$helo)) {
			debug_log(5, "check_received_lines: helo, $ip, $host, $helo, $from, $buip, $byhost");
			#md_syslog('info', "MDLOG,$MsgIDs,received_helo,$helo,$ip,?,?,?");
			stats_log('reject',$MsgIDs,'received_helo',[$helo,$ip],'*');
			return (1,"Forged HELO/EHLO ($helo) is not appreciated!");
		}
		debug_log(5, "check_received_lines: chk, $ip, $host, $helo, $from, $byip, $byhost");
		# Should we really check this line?
		if ((!$ip || !check_black_nets($ip)) && ($ip || $host || $from) &&
		    !check_internal_whitelist($ip) && !check_external_whitelist($ip,$host)) {
			my ($ok,$msg) = check_relay($MsgIDs,$ip,$host,'REJECT','received_',1);
			debug_log(5, "check_received_lines: rlc, $ok, $ip, $host, $helo, $from");
			return (1,$msg) if ($ok eq 'REJECT');
			my($bad, $hit, $log) = check_external_blacklist($ip,$host,'',$from,$sender);
			if ($bad) {
				debug_log(2, "check_received_lines: blc, $ip, $host, $from, ".$log);
				#md_syslog('info', "MDLOG,$MsgIDs,received_$log,$ip,$sender,?,?");
				stats_log('reject',$MsgIDs,"received_$log",$hit,'*');
				return (1,"We do not want mail from $hit!");
			}
		}
		debug_log(5,'check_received_lines: -');
	}
	#if (load_modules('File::Temp qw(tempfile unlink0)')) {
	#	my ($tfh,$tfn) = tempfile($MsgIDs.'_XXXXX',DIR=>'/tmp',SUFFIX=>'.recvrep',UNLINK=>0);
	#	print $tfh $head->as_string;
	#	print $tfh join("\n",'',"================",@rr,"================",@pr,'');
	#	close($tfh);
	#}
	return (0,'');
}

my @countries;
sub add_a_country {
	my ($country,$unc) = @_;
	return unless ($country);
	if (@countries && $countries[$#countries] =~ /^\(?$country\)?$/i) {
		$countries[$#countries] = $country unless ($unc);
		return;
	}
	push @countries, $unc ? "($country)" : $country;
}

# Get countries from headers
sub get_received_countries($) {
	my ($entity) = @_;
	my $st = time();
	@countries = ();
	my $head = $entity->head;
	return scalar @countries unless ($head);
	my $mod = $head->modify(0);
	my $hdrs = $head->header;
	$head->modify($mod);
	return scalar @countries unless ($hdrs && @{$hdrs});
	while (@{$hdrs}) {
		if (time() - $st > 120) {
			debug_log(-1,'get_received_countries: timeout');
			last;
		}
		my $hdrl = pop @{$hdrs};
		$hdrl =~ s/[\r\n]+//gs;
		my $olog = 0;
		my $unc = 0;
		#debug_log(0, "get_received_countries: H %s",$hdrl);
		if ($hdrl =~ /^(?:X-)?Received:\s*from[\s\r\n]+([^\r\n]*?)[\s\r\n]+by/i) {
			$hdrl = $1;
		} elsif ($hdrl =~ /^(?:X-)?Received:\s*from[\s\r\n]+([^\r\n]*?)(?:\([^\)]*\))?\s*;/i) {
			$hdrl = $1;
		} elsif ($hdrl =~ /^(?:X-)?(?:OB-)?(?:Received|Facebook):\s*from[\s\r\n]+([^\r\n]*?)[\s\r\n]+by/i) {
			$hdrl = $1;
			$unc = 1;
		} elsif ($hdrl =~ /^(?:X-)?(?:Client|(?:[a-z]+-?)?[a-z]{4,5}-?posting-?host|(?:Originating|(?:MD)?Remote|Note-?Sending|Yahoo-?Post|Mailer)-?IP):\s*(.*?)[\s\r\n]*$/i) {
			$hdrl = $1;
			$unc = 1;
		} elsif ($hdrl =~ /^(?:X-)?PHP-Script: \S+\.php for (.*)$/i) {
			$hdrl = $1;
			$unc = 1;
		} elsif ($hdrl =~ /^(?:X-)?Loom-IP: (\S+)/i) {
			$hdrl = $1;
			$unc = 1;
		} else {
			next;
			#next if ($hdrl =~ /^(?:X-)?(?:Received(?:-SPF)?|Authentication-Results|X-SpamAssassin|References|In-Reply-To|(?:HTTP-)?User-?Agent|SMTP-From|Message-ID|Mailer(?:-Component)?|Scanned-By|Geo|Gr[ae]ylist|\S+Version):/i);
			#$olog = $hdrl;
		}
		my $country;
		foreach my $brd (['\[','\]'],['\(','\)'],['(?:^|[\s,;])','(?:[\s,;]|$)'],['<','>'],['\{','\}'],['\b','\b']) {
			while ($hdrl =~ /^(.*$brd->[0])(\d+\.\d+\.\d+\.\d+)($brd->[1].*?)$/) {
				my $ip = $2;
				$hdrl = "$1?$3";
				if ($olog && $olog ne '-') {
					debug_log(0, "get_received_countries: h %s",$olog);
					$olog = '-';
				}
				#debug_log(0, "get_received_countries: m %s#%s",$brd->[0],$brd->[1]);
				#debug_log(0, "get_received_countries: A %s",$ip);
				next if ($olog);
				$country = get_ip_country($ip);
				last if ($country);
			}
			last if ($country);
		}
		next unless ($country);
		#debug_log(0, "get_received_countries: C %s",$country);
		add_a_country($country,$unc);
	}
	return scalar @countries;
}


#***********************************************************************
# Mail address checks +.
#***********************************************************************

sub check_against_smtp_server {
	my ($sender,$rcpt_addr,$rcpt_host) = @_;
	return md_check_against_smtp_server($sender,$rcpt_addr,$MyFilterHostName,$rcpt_host);
}

sub check_against_smtp_server_cached {
	my ($sender,$rcpt_addr,$rcpt_host) = @_;
	my $snd = address_strip($sender);
	my $rcpt = address_strip($rcpt_addr);
	my $host = address_strip($rcpt_host);
	my $now = time();
	my $res = sql_select_one_row('SELECT smtp_stamp,smtp_result,smtp_text FROM smtpcheck WHERE smtp_from=? AND smtp_to=? AND smtp_host=?',
					$snd,$rcpt,$host);
	if ($res && $res->[0] && $res->[1]) {
		#debug_log(0,'check_against_smtp_server_cached %u %s %s %s %s %s',$now-$res->[0],$snd,$rcpt,$host,$res->[1],$res->[2]);
		return ($res->[1],$res->[2]) if ($res->[1] eq 'CONTINUE' && $res->[0] > $now-$smtp_cache_good);
		return ($res->[1],$res->[2]) if ($res->[1] eq 'TEMPFAIL' && $res->[0] > $now-$smtp_cache_fail);
		return ($res->[1],$res->[2]) if ($res->[1] eq 'REJECT' && $res->[0] > $now-$smtp_cache_bad);
	}
	my ($ok,$msg) = check_against_smtp_server($sender,$rcpt_addr,$rcpt_host);
	if ($ok ne 'CONTINUE' && $ok ne 'REJECT' &&
	    $res && $res->[0] && $res->[1] &&
	    $res->[1] eq 'CONTINUE' && $res->[0] > $now-$smtp_cache_good_error) {
	    	debug_log(-1,'check_against_smtp_server_cached: Returning cached CONTINUE due to error checking <%s> against [%s]: %s %s',$rcpt_addr,$rcpt_host,$ok,$msg);
		return ($res->[1],$res->[2]);
	}
	#debug_log(0,'check_against_smtp_server_cached - %s %s %s %s %s',$snd,$rcpt,$host,$ok,$msg);
	#sql_command("INSERT OR IGNORE INTO smtpcheck (smtp_from,smtp_to,smtp_host) VALUES ($snd,$rcpt,$host)");
	#sql_command("UPDATE smtpcheck SET smtp_stamp=$now,smtp_result=$result,smtp_text=$text WHERE smtp_from=$snd AND smtp_to=$rcpt AND smtp_host=$host");
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO smtpcheck (smtp_from,smtp_to,smtp_host,smtp_stamp,smtp_result,smtp_text) VALUES (?,?,?,?,?,?) '.
			    'ON DUPLICATE KEY UPDATE smtp_stamp=VALUES(smtp_stamp),smtp_result=VALUES(smtp_result),smtp_text=VALUES(smtp_text)',
			    $snd,$rcpt,$host,$now,$ok,$msg);
	} else {
		sql_execute('REPLACE INTO smtpcheck (smtp_from,smtp_to,smtp_host,smtp_stamp,smtp_result,smtp_text) VALUES (?,?,?,?,?,?)',
			    $snd,$rcpt,$host,$now,$ok,$msg);
	}
	return ($ok,$msg);
}

sub expand_against_smtp_servers {
	my @addrs = ();
	debug_log(9,'expand_against_smtp_server collect');
	foreach my $ao (@_) {
		my %ai = (addr=>$ao,server=>'',done=>0,expn=>0,expanded=>0,cache=>0);
		my $aa = address_strip_p($ao);
		$ai{oldaddress} = $aa;
		if ($RecipientMailers{$ao} && @{$RecipientMailers{$ao}} && ${$RecipientMailers{$ao}}[2] =~ /^e?smtp$/i) {
			$ai{server} = ${$RecipientMailers{$ao}}[1];
			$ai{address} = ${$RecipientMailers{$ao}}[2];
		}
		if ($aa =~ /^(.*)\@([^@]*)$/) {
			my $adomain = lc($2);
			$ai{address} = $aa unless ($ai{address});
			$ai{server} = $storingservers{$adomain} unless ($ai{server} || !defined($storingservers{$adomain}));
		}
		push @addrs, \%ai;
	}
	return @addrs unless ($expnservers);
	return @addrs unless (load_modules('Net::SMTP'));
	debug_log(5,'expand_against_smtp_server check');
	my $smtp;
	my $server;
	my $did = 0;
	my $start = time();
	my $now = time();
	my $elc = 0;
	do {
		foreach my $ai (sort { $a->{server} cmp $b->{server} } @addrs) {
			next if ($ai->{done});
			$ai->{done} = 1;
			next if ($ai->{expanded} >= 5);
			next unless ($ai->{server});
			next unless ($ai->{server} =~ /^$expnservers$/i);
			debug_log(5,'expand_against_smtp_server check %s %s',$ai->{address},$ai->{server});
			my $res = sql_select_one_row('SELECT expn_stamp,expn_newaddress FROM expncheck WHERE expn_address=?',lc($ai->{address}));
			#debug_log(0,'expand_against_smtp_server %i (%s) <%s> <%s>',$now-$res->[0],$ai->{oldaddress},$ai->{address},$res->[1]) if ($res && $res->[0]);
			my ($adomain,$aaddress);
			if ($res && $res->[0] && ($now-$res->[0]<$expn_cache)) {
				$ai->{cache} ++;
				next unless ($res->[1]);
				next if (lc($ai->{address}) eq lc($res->[1]));
				next unless ($res->[1] =~ /^(.*)\@(.*)$/);
				$adomain = $2;
				$aaddress = $res->[1];
				debug_log(2,'expand_against_smtp_server cached %s %s %s',$ai->{oldaddress},$ai->{address},$aaddress);
			} else {
				my $eerr = 1;
				last if (time()-$start > 20);
				if (!$smtp || $server ne $ai->{server}) {
					$smtp->quit if ($smtp);
					$server = $ai->{server};
					debug_log(1,'expand_against_smtp_server connect %s',$server);
					$smtp = Net::SMTP->new(Host=>$server,Hello=>$MyFilterHostName,Timeout=>10);
					debug_log(-1,'expand_against_smtp_server connect failed: %s',$server) unless ($smtp);
				}
				if ($smtp) {
					debug_log(2,'expand_against_smtp_server expand %s %s %s',$ai->{oldaddress},$server,$ai->{address});
					my @expansions = $smtp->expand($ai->{address});
					if ($smtp->ok) {
						$eerr = 0;
						next unless (@expansions);
						$ai->{expn} ++;
						next if ($#expansions);
						next unless ($expansions[0] =~ /<(\S+)\@(\S+)>/);
						my $auser = $1;
						$adomain = $2;
						$aaddress = "$auser\@$adomain";
						next if (lc($ai->{address}) eq lc($aaddress));
						$now = time();
						debug_log(2,'expand_against_smtp_server expanded %s %s %s %s',$ai->{oldaddress},$server,$ai->{address},$aaddress);
					}
				}
				if ($eerr) {
					debug_log(-1,'expand_against_smtp_server: error checking <%s> (%s) against [%s]',$ai->{address},$ai->{oldaddress},$ai->{server});
					next unless ($res && $res->[0] && ($now-$res->[0]<$expn_cache_error));
					$ai->{cache} ++;
					next unless ($res->[1]);
					next if (lc($ai->{address}) eq lc($res->[1]));
					next unless ($res->[1] =~ /^(.*)\@(.*)$/);
					$adomain = $2;
					$aaddress = $res->[1];
					debug_log(-1,'expand_against_smtp_server: Returning cached <%s> due to error checking <%s> (%s) against [%s]',$aaddress,$ai->{address},$ai->{oldaddress},$ai->{server});
				}
			}
			debug_log(1,'expand_against_smtp_server expn %s %s %s %s',$ai->{oldaddress},$server,$ai->{address},$aaddress);
			debug_log(1,'expand_against_smtp_server stat %u %s %u %u',$expn_local,$adomain,($adomain !~ /^$OurDomains$/i),($expn_local && $adomain !~ /^$OurDomains$/i));
			next if ($expn_local && $adomain !~ /^$OurDomains$/i);
			$adomain = lc($adomain);
			#next if ($storingservers{$adomain} && lc($storingservers{$adomain}) eq lc($ai->{server}));
			$ai->{expanded} ++;
			$ai->{address} = $aaddress;
			$ai->{domain} = $adomain;
			if (defined($storingservers{$adomain})) {
				$did ++;
				$ai->{done} = 0;
				$ai->{server} = $storingservers{$adomain};
			}
		}
		$elc ++;
	} while ($did && (time()-$start<20) && $elc<20);
	$now = time();
	foreach my $ai (@addrs) {
		$ai->{expanded} = 0 if (lc($ai->{oldaddress}) eq lc($ai->{address}));
		$ai->{address} = '' unless ($ai->{expanded});
		next unless ($ai->{expn});
		debug_log(5,'expand_against_smtp_server cache %s %s',$ai->{oldaddress},$ai->{address});
		if ($sqldbd eq 'M') {
			sql_execute('INSERT INTO expncheck (expn_address,expn_newaddress,expn_stamp) VALUES (?,?,?) '.
				    'ON DUPLICATE KEY UPDATE expn_newaddress=VALUES(expn_newaddress),expn_stamp=VALUES(expn_stamp)',
				    lc($ai->{oldaddress}),$ai->{address},$now);
		} else {
			sql_execute('REPLACE INTO expncheck (expn_address,expn_newaddress,expn_stamp) VALUES (?,?,?)',lc($ai->{oldaddress}),$ai->{address},$now);
		}
	}
	$smtp->quit if ($smtp);
	return @addrs;
}

# Check a mail address against a mail server
sub check_mail_address {
	my ($a,$s) = @_;
	my ($ok,$msg,$code,$dsn) = check_against_smtp_server('<>',$a,$s);
	return (-1,'') unless ($ok);
	my $txt = "$code $dsn $msg";
	$txt =~ s/\s\s+/ /g;
	$txt =~ s/^\s+//;
	$txt =~ s/\s+$//;
	# Disregard some REJECTs because they aren't really rejecting the recipient address.
	return (3,$txt) if ($ok eq 'REJECT' && ($code !~ /^55[0134]$/ || $msg =~ /(sender|mail from|return|<>)/i));
	return (1,'') if ($ok eq 'CONTINUE');
	return (0,$txt) if ($ok eq 'REJECT');
	return (2,'');
}

# Check a mail address against it's MX server(s)
sub check_mail_address_mx_i($) {
	my ($ra) = @_;
	return (4,'') if ($ra =~ /^<?>?$/);
	return (-1,'') unless (load_modules('Net::DNS'));
	my $d = lc($ra);
	$d =~ s/^.*@([^@>]*)>?$/$1/;
	return (5,'') if (!$d);
	my @mx = get_mxes($d);
	my @rinfs = ();
	foreach my $mp (sort { $a->{p} <=> $b->{p} } @mx) {
		my ($ok,$rinf) = check_mail_address($ra,$mp->{x});
		return (0,$rinf) unless ($ok);
		return (1,$rinf) if ($ok == 1);
		push @rinfs, $rinf if ($rinf);
	}
	return (8,join('; ',@rinfs));
}

# Caches the result in the greylist database.
sub check_mail_address_mx($) {
	my ($a) = @_;
	debug_log(5,'check_mail_address_mx: ini, %s',$a);
	my $addr = address_strip($a);
	my $rc = 1;
	my $now = time();
	my $cache = sql_select_one_row('SELECT sc_stamp,sc_result,sc_text,sc_count FROM sendercheck WHERE sc_address=?',$addr);
	my ($ores,$res,$txt) = (-1,0,'');
	if ($cache && @{$cache} && $cache->[0]) {
		my $ct;
		$cache->[1] = 0 unless ($cache->[1]);
		if (!$cache->[1]) {
			$cache->[3] = 0 unless ($cache->[3]);
			$ct = $sc_cache_invalid + ($sc_cache_invalid_add * ($cache->[3] - 1));
			$ct = $sc_cache_invalid_max if ($ct > $sc_cache_invalid_max);
		} elsif ($cache->[1] == 1) {
			$ct = $sc_cache_valid;
		} else {
			$ct = $sc_cache_unknown;
		}
		$rc = ($now - $cache->[0] > $ct);
		$res = $cache->[1];
		$txt = $cache->[2];
		$txt = '' unless ($txt);
		$ores = $res;
		debug_log(2,'check_mail_address_mx: gfc, %u, %u, %u, %u, %s, %s',$rc,$ct,$cache->[3],$res,$txt,$addr);
	}
	if ($rc) {
		($res,$txt) = check_mail_address_mx_i($a);
		$res = 0 unless ($res);
		$txt = '' unless ($txt);
		debug_log(1,'check_mail_address_mx: cas, %u, %s, %s',$res,$txt,$addr);
		my $cnts = '1';
		$cnts = 'sc_count+1' if ($ores == $res);
		if ($sqldbd eq 'M') {
			sql_execute('INSERT INTO sendercheck (sc_address,sc_stamp,sc_result,sc_text,sc_count) VALUES (?,?,?,?,?) '.
				    "ON DUPLICATE KEY UPDATE sc_stamp=VALUES(sc_stamp),sc_result=VALUES(sc_result),sc_text=VALUES(sc_text),sc_count=$cnts",
				    $addr,$now,$res,$txt,1);
		} else {
			sql_execute_multi(
				['INSERT OR IGNORE INTO sendercheck (sc_address) VALUES (?)',$addr],
				["UPDATE sendercheck SET sc_stamp=?,sc_result=?,sc_text=?,sc_count=$cnts WHERE sc_address=?",$now,$res,$txt,$addr],
			);
		}
	}
	return ($res,$txt);
}

# Check mail address according to map
sub check_mail_address_mx_map {
	my $map = shift;
	my $a = address_strip_nc(shift);
	debug_log(5,'check_mail_address_mx_map: 1 %s %s',$a,$map);
	my $mf = read_list_file($map);
	return (-1,'unchecked') unless ($mf && @{$mf});
	foreach my $l (@{$mf}) {
		my $line = $l;
		$line =~ s/[\r\n]+//gs;
		next unless ($line);
		next if ($line =~ /^[#;]/);
		debug_log(5,'check_mail_address_mx_map: 2 %s %s',$a,$line);
		if ($line =~ /^\s*(\S+)\s+(\S+)\s*$/s) {
			my $o = $1;
			my $n = $2;
			$o = ".*\\\@$o" if ($o !~ /\@/);
			debug_log(4,'check_mail_address_mx_map: 3 %s %s %s',$a,$o,$n);
			next unless ($a =~ /^$o$/i);
			my $a1 = $a;
			my $a2 = $a;
			$a1 =~ s/\@[^@]*$//;
			$a2 =~ s/^.*\@//;
			my $c = sprintf($n,$a1,$a2);
			my ($res,$txt) = check_mail_address_mx($c);
			debug_log(1,'check_mail_address_mx_map: 4 %s %s %u %s',$a,$c,$res,$txt);
			return ($res,$txt);
		}
	}
	return (-1,'unchecked');
}

# Check if sender has valid MX
# Cache result in database
sub mail_address_mx_check {
	my ($a) = @_;
	return 0 if ($sender !~ /^<?>?$/);
	return 0 unless (load_modules('Net::validMX'));
	my $msd = address_strip($a);
	$msd =~ s/^.*\@//;
	return 0 unless ($msd);
	my $now = time();
	my $cache = sql_select_one_row('SELECT mx_stamp,mx_error FROM mxcheck WHERE mx_domain=?',$msd);
	if ($cache && @{$cache} && $cache->[0]) {
		my $age = $now-$cache->[0];
		if ($cache->[1]) {
			debug_log(3,'mail_address_mx_check: %s, %s, %s, %u, %s','Nac',$a,$msd,$age,$cache->[1]);
			return (1,$cache->[1]) if ($age <= $mx_cache_invalid);
		} else {
			debug_log(3,'mail_address_mx_check: %s, %s, %s, %u','Acc',$a,$msd,$age);
			return 0 if ($age <= $mx_cache_valid);
		}
	}
	debug_log(3,'mail_address_mx_check: %s, %s, %s','Chk',$a,$msd);
	my ($vmx,$vmxr) = Net::validMX::check_valid_mx($a);
	$vmxr = '' if ($vmx);
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO mxcheck (mx_domain,mx_stamp,mx_error) VALUES (?,?,?) '.
			    'ON DUPLICATE KEY UPDATE mx_stamp=VALUES(mx_stamp),mx_error=VALUES(mx_error)',
			    $msd,$now,$vmxr);
	} else {
		sql_execute_multi(
			['INSERT OR IGNORE INTO mxcheck (mx_domain) VALUES (?)',$msd],
			['UPDATE mxcheck SET mx_stamp=?,mx_error=? WHERE mx_domain=?',$now,$vmxr,$msd],
		);
	}
	return 0 if ($vmx);
	debug_log(3,'mail_address_mx_check: %s, %s, %s, %s','Bad',$a,$msd,$vmxr);
	return (2,$vmxr);
}

@new_recipients = ();
sub list_recipients {
	@new_recipients = @Recipients unless (defined(@new_recipients));
	return @new_recipients;
}
sub recipients_hash {
	my %rh = ();
	foreach my $rcpt (@_) {
		$rh{lc(address_strip_p($rcpt))} = $rcpt;
	}
	return \%rh;
}
sub do_add_recipients {
	@new_recipients = @Recipients unless (defined(@new_recipients));
	my $rh = recipients_hash(@new_recipients);
	my $ch = 0;
	foreach my $rcpt (@_) {
		next if ($rh->{lc(address_strip_p($rcpt))});
		my $rs = $rcpt;
		$rs =~ s/^([^<].*?[^>])$/<$1>/;
		push @new_recipients, $rs;
		$ch ++;
		stats_log('modified',$MsgIDs,'modified_recipients',['',$rcpt]);
	}
	return $ch;
}
sub do_del_recipients {
	@new_recipients = @Recipients unless (defined(@new_recipients));
	my $rh = recipients_hash(@new_recipients);
	my $ch = 0;
	foreach my $rcpt (@_) {
		my $rs = lc(address_strip_p($rcpt));
		next unless (defined($rh->{$rs}));
		delete $rh->{$rs};
		$ch ++;
		stats_log('modified',$MsgIDs,'modified_recipients',[$rcpt,'']);
	}
	return 0 unless ($ch);
	@new_recipients = values %{$rh};
	return $ch;
}
sub do_replace_recipients_ex {
	@new_recipients = @Recipients unless (defined(@new_recipients));
	my $rh = recipients_hash(@new_recipients);
	my $ch = 0;
	my $opts = shift @_;
	while (@_) {
		my $oldp;
		my $delp = shift @_;
		my $addp = shift @_;
		my $cc = 0;
		if ($opts->{rcpex}) {
			foreach my $del (keys %{$rh}) {
				next unless ($del =~ /^$delp$/i);
				delete $rh->{$del};
				$cc ++;
				$oldp = $del unless ($oldp);
			}
		} else {
			my $del = lc(address_strip_p($delp));
			if (defined($rh->{$del})) {
				delete $rh->{$del};
				$cc ++;
				$oldp = $del;
			}
		}
		next unless ($cc || $opts->{oradd});
		if ($addp =~ /(?:^\@|\@$|\%)/) {
			unless ($oldp) {
				debug_log(-1,'do_replace_recipients_ex <> -> <%s>',$addp);
				next;
			}
			my ($au,$ad,$ai,$ap) = address_split_nc($oldp);
			if ($addp =~ /^\@/) {
				$addp = "$au$ap$addp";
			} elsif ($addp =~ /\@$/) {
				$addp = "$addp\@$ad";
			} elsif ($addp =~ /\%/) {
				$addp = sprintf($addp,$au,$ad,$ai,$ap);
			}
		}
		debug_log(1,'do_replace_recipients_ex <%s> =~ "%s" -> <%s>',$oldp,$delp,$addp);
		my $add = lc(address_strip_p($addp));
		unless (defined($rh->{$add})) {
			$addp =~ s/^([^<].*?[^>])$/<$1>/;
			$rh->{$add} = $addp;
			$cc ++;
		}
		$ch += $cc;
		stats_log('modified',$MsgIDs,'modified_recipients',[$delp,$addp]) if ($cc);
	}
	return 0 unless ($ch);
	return $ch if ($opts->{dbg});
	@new_recipients = values %{$rh};
	return $ch;
}
sub do_replace_recipients {
	return do_replace_recipients_ex({},@_);
}
sub forward_recipients {
	my $fwdl = read_list_file('forwards');
	return 0 unless ($fwdl && @{$fwdl});
	@new_recipients = @Recipients unless (defined(@new_recipients));
	my $rh = recipients_hash(@new_recipients);
	my $ch = 0;
	foreach my $l (@{$fwdl}) {
		next unless ($l =~ /^\s*(\S+?)[\s:=]+(\S+?)[\s\r\n]*$/);
		my $alias = $1;
		my $forward = $2;
		$alias .= "\@$OurDomains" unless ($alias =~ /\@/);
		my $cc = do_replace_recipients_ex({rcpex=>1},$alias=>$forward);
		debug_log(1,'forward_recipients %s %s',$alias,$forward) if ($cc);
		$ch += $cc;
	}
	return $ch;
}
sub expand_recipients {
	return 0 unless ($expnservers);
	return 0 unless (load_modules('Net::SMTP'));
	@new_recipients = @Recipients unless (defined(@new_recipients));
	my $rh = recipients_hash(@new_recipients);
	my $ch = 0;
	foreach my $expn (expand_against_smtp_servers(@new_recipients)) {
		next unless ($expn->{expanded});
		debug_log(1,'expand_recipients %s %s',$expn->{addr},$expn->{address});
		do_replace_recipients_ex({},$expn->{addr}=>$expn->{address});
	}
}
sub sync_recipients {
	my ($entity) = @_;
	return 1 unless (defined(@new_recipients));
	#foreach my $rcpt (@Recipients) { debug_log(0,'sync_recipients O %s',$rcpt); }
	#foreach my $rcpt (@new_recipients) { debug_log(0,'sync_recipients N %s',$rcpt); }
	my $orh = recipients_hash(@Recipients);
	my $nrh = recipients_hash(@new_recipients);
	my $ch = 0;
	while (my ($rx,$rs) = each %{$orh}) {
		next if (defined($nrh->{$rx}));
		debug_log(1,'sync_recipients del %s',$rs);
		delete_recipient($rs);
		$ch ++;
	}
	while (my ($rx,$rs) = each %{$nrh}) {
		next if (defined($orh->{$rx}));
		debug_log(1,'sync_recipients add %s',$rs);
		add_recipient($rs);
		$ch ++;
	}
	return 1 unless ($ch);
	if ($#Recipients || $#new_recipients) {
		do_action_insert_header($entity,"X-Redirected",sprintf('%u -> %u',$#Recipients+1,$#new_recipients+1));
	} else {
		do_action_insert_header($entity,"X-Redirected",sprintf('%s -> %s',address_strip_p($Recipients[0]),address_strip_p($new_recipients[0])));
	}
	return 1 if (@new_recipients);
	return 0;
}
sub has_recipient_in {
	my @res = ();
	my $res = 0;
	for (my $i=0;$i<@_;$i++) {
		$re[$i] = 0
	}
	my $rcptl = defined(@new_recipients) ? \@new_recipients : \@Recipients;
	foreach my $rcpt (@{$rcptl}) {
		for (my $i=0;$i<@_;$i++) {
			debug_log(7,'has_recipient_in ? %s %u %s',$rcpt,$i,$_[$i]);
			if ($rcpt =~ /^<?$_[$i]>?$/i) {
				debug_log(5,'has_recipient_in ! %s %u %s',$rcpt,$i,$_[$i]);
				$res[$i] ++;
				$res ++;
			}
		}
	}
	return wantarray ? @res : $res;
}

sub pass_abuse {
	return 0 unless ($PassAbuse);
	return 0 unless (has_recipient_in('abuse\@[^\@]+'));
	return 1;
}

sub wants_extra_headers {
	return has_recipient_in($WantsExtraHeaders) unless ($PassAbuse);
	return has_recipient_in($WantsExtraHeaders,'abuse\@[^\@]+');
}

sub wants_reports_or_headers {
	my @res = has_recipient_in($WantsReports,$WantsExtraHeaders,'abuse\@[^\@]+');
	$res[1] = ($res[1] || ($PassAbuse && $res[2]));
	return ($res[0],$res[1]);
}

#***********************************************************************
# HTML CLeaning stuff.
#***********************************************************************

# All the ready made cleaners/sanitizers/whatever are probably more
# efficient than this. OTH, they are also more harmful, removing way
# too much for our users tastes.
# Hopefully this custom stuff can strike a better balance...

# Variables...
my $hc_base_href;
my $hc_last_href;
my $hc_changed;
my @hc_reports;
my $hc_htmlout;
my $hc_styleout;
my @hc_skip = ();
my $hc_style;
my $hc_main_entity;
my %hc_cids = undef;

#sub hc_elog {
#	my $x1 = shift;
#	my $e = shift;
#	my $mid = '?';
#	my $cid = '?';
#	my $ct = '?';
#	if ($e && $e->head) {
#		$mid = $e->head->get('Message-ID') if ($e->head->get('Message-ID'));
#		$cid = $e->head->get('Content-ID') if ($e->head->get('Content-ID'));
#		$ct = $e->head->mime_attr('Content-Type') if ($e->head->mime_attr('Content-Type'));
#	}
#	debug_log(0,"hgpt: ($x1) '$mid/$cid' = '$ct'");
#}

# Note correct, but it'll (hopefully) do...
sub hc_find_part_type {
	my $cid = shift;
	my $entity = shift;
	return undef unless ($cid && $$cid && $entity && $entity->head);
	#hc_elog('hfpte',$entity);
	my $c = $entity->head->get('Content-ID');
	$c =~ s/^\s*(.*?)\s*$/$1/s;
	$c = address_strip_nc($c);
	#debug_log(0,"hgpt: (hfpt) 'cid:$$cid' = '$c' ?");
	if ($c && ($c eq $$cid)) {
		my $ct = $entity->head->mime_attr('Content-Type');
		my $et = $entity->effective_type;
		my $fn = $entity->head->recommended_filename;
		#debug_log(0,"hgpt: (hfptf) 'cid:$$cid' -> ct='$ct' et='$et' fn='$fn'");
		$ct = $et unless ($ct);
		return ($ct,$fn);
	}
	foreach my $pe ($entity->parts) {
		#hc_elog('hfptp',$entity);
		#debug_log(0,"hgpt: (hfpt) p?");
		next unless ($pe->head);
		#next if ($pe->head->get('Message-ID'));
		#debug_log(0,"hgpt: (hfpt) p!");
		my ($r,$f) = hc_find_part_type($cid,$pe);
		return ($r,$f) if (defined($r));
	}
	return undef;
}
sub hc_get_part_type {
	my $cid = shift;
	return '' unless ($cid && $hc_main_entity);
	#hc_elog('hgpt',$hc_main_entity);
	my ($rt,$rf) = hc_find_part_type(\$cid,$hc_main_entity);
	$rt = '' unless ($rt);
	$rf = '' unless ($rf);
	return ($rt,$rf);
}

# Splits URL into parts
sub hc_split_url {
	my $u = shift;
	my $nb = shift;
	$nb = 0 unless ($nb);
	$u = '' unless(defined($u));
	$u =~ s/^\s*(.*?)\s*$/$1/s;
	my $p = 0;
	my ($lp,$lh,$ld,$lf,$lq) = ('','','','');
	if ($u =~ /^\#/) {
		$lf = $u;
		$u = '';
	} else {
		$u = "$hc_base_href$u" if ($hc_base_href && !$nb && $u !~ /^[^\s:]+:/);
		if ($u =~ /^([^\s:]+):(.*)$/) {
			$lp = $1;
			$u = $2;
			$p = 1;
		}
		if ($u =~ /^(.*?)\?(.*)$/) {
			$lq = $2;
			$u = $1;
		} elsif ($u =~ /^(.*?)\/\*(.*)$/) {
			$lq = $2;
			$u = $1;
		}
		if ($p) {
			if ($u =~ /^\/\/([^\/]*)(\/.*|)$/) {
				$lh = $1;
				$u = $2;
			}
		} else {
			if ($u =~ /^([^\/]*)(\/.*|)$/) {
				$lh = $1;
				$u = $2;
			}
		}
		if ($u =~ /^(.*)\/([^\/]*)$/) {
			$ld = $1;
			$lf = $2;
		} else {
			$lf = $u;
		}
	}
	return ($lp,$lh,$ld,$lf,$lq);
}

# Used for validating a URL
sub hc_validate_url_i {
	my ($text,$what) = @_;
	$text =~ s/\\/\//gs;
	$text =~ s/^[\r\n\t]*(.*?)[\r\n\t]*$/$1/s;
	$text =~ s/[\r\n]+//gs;
	return undef if ($text eq '#');
	return undef if ($text =~ /[\x00-\x1F\x7F\xFF]/);
	return undef if ($text =~ /\"/); #"
	return undef if (($what =~ /c/) && ($text =~ /[\(\)\{\}\'\"]/)); #"
	my $extx = '([^-A-Z0-9_.,;?%\/]|$)';
	my ($ulp,$ulh,$uld,$ulf,$ulq) = hc_split_url($text);
	#print "$ulp|$ulh|$uld|$ulf|$ulq\n";
	return $text if ($what =~ /l/ && $ulp eq '' && $ulh eq '' && $uld eq '' && $ulq eq '' && $ulf =~ /^\#\S+$/);
	return undef unless ($ulp =~ /^(mailto|news|https?|ftp|cid)$/i);
	if ($what =~ /l/) {
		return $text if (lc($ulp) eq 'mailto' && $ulf =~ /^\s*<?[^\@]+\@[^\@]+>?\s*$/);
		return $text if (lc($ulp) eq 'news' && $ulq eq '');
	}
	if ($what =~ /[Mic]/ && $ulq eq '') {
		if ($ulp =~ /^([cm])id$/i) {
			my $us = $1;
			my $ud = $uld;
			$ud = '' if (lc($us) eq 'm');
			my $uf = "$ud$ulf";
			#print "? cid:$uf\n";
			if ($uf =~ /^[-_.:;()\$\@\/!%0-9a-zA-Z]+$/) {
				my ($cidt,$cidf) = hc_get_part_type($uf);
				#debug_log(0,"hvu: 'cid:$uf' -> '$cidt' @ '$cidf'");
				if ($cidt) {
					return undef if ($cidt =~ /^application\//i);
					return undef if ($cidt =~ /(java|script)/i);
					return "cid:$uf" if ($what =~ /i/ && $cidt =~ /^image\//i);
					return "cid:$uf" if ($what =~ /c/ && $cidt =~ /^text\//i);
				}
				if ($cidf) {
					return undef if (($what =~ /l/) && ($cidf =~ /\..*\.$bad_exts\.*$extx/i));
					return undef if (($what =~ /[ic]/) && ($cidf =~ /\.$bad_exts\.*$extx/i));
					return undef if (($what =~ /[ci]/) && ($cidf =~ /\.$bad_css_exts\.*$extx/i));
				}
				return "cid:$uf" if ($what =~ /l/);
				return undef if ($cidt);
				return "cid:$uf";
			}
			return undef;
			#return "cid:$uf" if (($uf =~ /^[-_.:;()\$\@\/!%0-9a-zA-Z]+$/) &&
			#		     ($uf !~ /\.$bad_exts\.*$extx/i) &&
			#		     (($what !~ /c/) || ($uf !~ /\.$bad_css_exts\.*$extx/i)));
		}
	}
	return undef if ($what =~ /M/);
	if ($ulf ne '' & $ulq eq '') {
		return undef if (($what =~ /l/) && ($ulf =~ /\..*\.$bad_exts\.*$extx/i));
		return undef if (($what =~ /[ic]/) && ($ulf =~ /\.$bad_exts\.*$extx/i));
		return undef if (($what =~ /[ci]/) && ($ulf =~ /\.$bad_css_exts\.*$extx/i));
	}
	return $text if ($ulp =~ /^(https?|ftp)$/i);
	return undef;
}

sub hc_validate_url {
	my $r = hc_validate_url_i(@_);
	if (defined($r) && $r =~ /^cid:(.+)$/i) {
		$hc_cids{lc($1)} = $r;
	}
	return $r;
}

# Used for validating style definitions
sub hc_validate_css {
	my ($text,$what) = @_;
	my $css;
	my $pre = '';
	my $suf = '';
	if ($what =~ /a/i) {
		$css = CSS::Tiny->read_string("x { $text }");
	} else {
		my $txt = $text;
		if ($txt =~ /^(\s*<!-*\s*)(.*?)$/s) {
			$pre = $1;
			$txt = $2;
		}
		if ($txt =~ /^(.*?)(\s*-*>\s*)$/s) {
			$txt = $1;
			$suf = $2;
		}
		$css = CSS::Tiny->read_string($txt);
	}
	return (0,$text) unless ($css);
	my $ch = 0;
	while (my ($t,$ah) = each %{$css}) {
		while (my ($a,$v) = each %{$ah}) {
			if ($v =~ /^\s*url\s*\((.*)\)(.*?)$/) {
				my $u = $1;
				my $y = $2;
				$u =~ s/^\"(.*)\"$/$1/s;
				$u =~ s/^\'(.*)\'$/$1/s;
				my $l = hc_validate_url($u,'lic');
				$ch = 1 if (!$l || $l ne $u);
				if ($l) {
					$css->{$t}->{$a} = "url(\"$l\")$y";
				} else {
					delete $css->{$t}->{$a};
				}
			}
		}
	}
	if ($ch) {
		$text = $css->write_string;
		if ($what =~ /a/i) {
			$text =~ s/^\s*x\s+\{\s*//s;
			$text =~ s/\s*\}\s*$//s;
			$text =~ s/\n\s*/ /gs;
		}
		$text = "$pre$text$suf";
		$text =~ s/\n*$/\n/s if ($what !~ /a/i);
	}
	return ($ch,$text);
}

# outputs to result
sub hc_output {
	return 0 if (@hc_skip);
	if ($hc_style) {
		$hc_styleout .= join('',@_);
	} else {
		$hc_htmlout .= join('',@_);
	}
	return 1;
}

# outputs accumulated css
sub hc_output_css {
	my ($ch,$css) = hc_validate_css($hc_styleout,'b');
	$hc_styleout = '';
	$hc_changed ++ if ($ch);
	hc_output($css);
}

# outputs and inc changed
sub hc_output_changed {
	$hc_changed ++;
	return hc_output(@_);
}

# Hook for plain text
sub hc_handle_text {
	my $self = shift;
	my $text = shift;
	return hc_output($text) if ($hc_style);
	return 0 if (@hc_skip);
	return hc_output($text) unless ($hc_last_href);
	my $hrx = $hc_last_href;
	my $hrxt = HTML::Entities::encode_entities($hrx);
	my $txt = HTML::Entities::decode_entities($text);
	$hc_last_href = undef;
	$txt =~ s/^\s*//s;
	$txt =~ s/\s.*$//s;
	return hc_output($text) unless ($txt);
	return hc_output($text) unless ($txt =~ /^(ftp:|https?:|www\.)/);
	#return hc_output($text) if ($txt =~ /^\s*$hrx(\s|$)/i);
	#return hc_output($text) if ($text =~ /^\s*$hrxt(\s|$)/i);
	my ($ulp,$ulh,$uld,$ulf,$ulq) = hc_split_url($hrx);
	#print "$ulp|$ulh|$uld|$ulf|$ulq\n";
	my ($tlp,$tlh,$tld,$tlf,$tlq) = hc_split_url($txt,1);
	if ($tlf && lc("$tld/$tlf") eq lc($uld)) {
		$tld .= '/'.$tlf;
		$tlf = '';
	}
	$tlp = $ulp if ($tlp eq '');
	if (($ulp =~ /^https?$/i) && ($tlp =~ /^https?$/i) && (lc($tlp) ne lc($ulp))) {
		$text =~ s/^(\s*)$tlp/$1$ulp/i;
		$tlp = $ulp;
		$hc_changed ++;
	}
	#print "$tlp|$tlh|$tld|$tlf|$tlq\n";
	return hc_output_changed("[obs: $hrxt] $text") if ($ulq && !$tlq && ($ulq =~ /(ftp|https?):/i));
	return hc_output_changed("[obs: $hrxt] $text") if (lc($tlp) ne lc($ulp));
	return hc_output_changed("[obs: $hrxt] $text") if (lc($tlh) ne lc($ulh));
	return hc_output($text) if ($tld eq '' && $tlf eq '' && $tlq eq '');
	return hc_output_changed("[obs: $hrxt] $text") if (lc($tld) ne lc($uld));
	return hc_output_changed("[obs: $hrxt] $text") if (lc($tlf) ne lc($ulf) && $ulf !~ /^(index|default)\.(html?|php\d?|pl|cgi|fcgi)$/i);
	return hc_output($text) if ($tlq eq '' && $tlf eq '');
	return hc_output($text) if (lc($tlq) eq lc($ulq) && $tlf eq '');
	return hc_output_changed("[obs: $hrxt] $text") if (lc($tlf) ne lc($ulf));
	return hc_output($text) if ($tlq eq '');
	return hc_output($text) if (lc($tlq) eq lc($ulq));
	return hc_output_changed("[obs: $hrxt] $text");
}

# Hook for start tags
sub hc_handle_start {
	my $self = shift;
	my $text = shift;
	my $tag = shift;
	my $attr = shift;
	my $rar = 0;
	my $rnc = 0;
	my $skip = 0;
	my $style = 0;
	if ($hc_style) {
		$hc_style ++ if ($tag eq 'style');
		return;
	}
	if ($tag =~ /^(embed|bgsound|object|applet|link)$/) {
		$hc_changed ++;
		return;
	}
	#if ($tag eq 'link') {
	#	my $xx = 1;
	#	if (defined($attr->{href}) && ($attr->{href} ne '')) {
	#		my $href = hc_validate_url($attr->{href},'M');
	#		if ($href) {
	#			$xx = 0;
	#			$rar = 1 if ($href ne $attr->{href});
	#		}
	#	}
	#	if ($xx) {
	#		$hc_changed ++;
	#		return;
	#	}
	#}
	return if ($tag =~ /^(noscript)$/);
	if ($tag =~ /^(script|frameset|iframe|frame|styledef)$/) {
		$skip = 1;
	}
	unless (@hc_skip || $skip) {
		if (($tag eq 'a' || $tag eq 'area' || $tag eq 'base') &&
		    defined($attr->{href}) && ($attr->{href} ne '')) {
			my $href = hc_validate_url($attr->{href},'l');
			if (!$href || $href ne $attr->{href}) {
				$rar ++;
				$rnc ++ if ($tag eq 'base');
				if ($href) {
					$attr->{href} = $href;
				} else {
					delete $attr->{href};
				}
			}
			if ($tag eq 'a') {
				$hc_last_href = $href;
			} elsif ($tag eq 'base') {
				$hc_base_href = $href;
				delete $attr->{href};
				$rar ++;
				$rnc ++;
			}
		} elsif ($attr->{href}) {
			delete $attr->{href};
			$rar ++;
		}
		if (($tag eq 'img' || ($tag eq 'input' && $attr->{type} && lc($attr->{type}) eq 'image')) &&
		    defined($attr->{src}) && ($attr->{src} ne '')) {
			my $src = hc_validate_url($attr->{src},'i');
			if (!$src || $src ne $attr->{src}) {
				$rar ++;
				if ($src) {
					$attr->{src} = $src;
				} else {
					$attr->{alt} = sprintf('[%s]',$attr->{src}) unless ($attr->{alt});
					delete $attr->{src};
				}
			}
		} elsif ($attr->{src}) {
			delete $attr->{src};
			$rar ++;
		}
		if ($tag eq 'style') {
			if ($attr->{type} && lc($attr->{type}) ne 'text/css') {
				$skip = 1;
			} else {
				foreach my $a (keys %{$attr}) {
					if ($a ne 'type') {
						$rar ++;
						my %a = (type=>'text/css');
						$attr = \%a;
						last;
					}
				}
				$style = 1;
			}
		}
	}
	if ($skip) {
		$hc_changed ++;
		push @hc_skip, $tag unless ($text =~ /\/>\s*$/);
		return;
	}
	return if (@hc_skip);
	if ($attr->{style}) {
		my ($cc,$ct) = hc_validate_css($attr->{style},'a');
		if ($cc) {
			$rar ++;
			$attr->{style} = $ct;
		}
	}
	foreach my $a (keys %{$attr}) {
		if ($a =~ /^(on|cite)/i) {
			$rar ++;
			delete $attr->{$a};
		}
	}
	if ($rar) {
		$hc_changed ++ if ($rar > $rnc);
		my $e = ($text =~ /\/>\s*$/);
		$text = "<$tag";
		while (my ($a,$v) = each %{$attr}) {
			$a = HTML::Entities::encode_entities($a);
			$text .= " $a";
			if ($v ne "\x01") {
				$v = HTML::Entities::encode_entities($v);
				if ($v =~ /^[a-zA-Z0-9]+$/) {
					$text .= "=$v";
				} else {
					$text .= "=\"$v\"";
				}
			}
		}
		$text .= ' /' if ($e);
		$text .= '>';
	}
	hc_output($text);
	$hc_style += $style;
}

# Hook for end tags
sub hc_handle_end {
	my $self = shift;
	my $text = shift;
	my $tag = shift;
	if (@hc_skip && $tag eq $hc_skip[$#hc_skip]) {
		pop @hc_skip;
		return;
	}
	return if (@hc_skip);
	if ($tag =~ /^(embed|bgsound|object|applet|link)$/) {
		$hc_changed ++;
		return;
	}
	return if ($tag =~ /^(noscript)$/);
	if ($tag eq 'a') {
		$hc_last_href = undef;
	} elsif ($tag eq 'style') {
		$hc_style -- if ($hc_style);
		hc_output_css() unless ($hc_style);
	}
	return if ($hc_style);
	$hc_changed ++ if ($text !~ /^<\s*\/$tag\s*>$/i);
	return hc_output($text) if ($text =~ /^<\/$tag>$/i);
	return hc_output("</$tag>");
}

# Hook for declarations
sub hc_handle_declaration {
	my $self = shift;
	my $text = shift;
	my $tag = shift;
	return if (@hc_skip);
	if (($tag ne 'doctype') || ($hc_htmlout !~ /^\s*$/s)) {
		$hc_changed ++;
		return;
	}
	hc_output($text);
}

# Hook for comments
sub hc_handle_comment {
	my $self = shift;
	my $text = shift;
	my $txt = $text;
	$txt =~ s/^\s*<!?-*(.*?)-*>\s*$/$1/s;
	hc_output($text) if ($hc_style || $txt !~ /[<>]/);
}

# The actual HTML cleaning
sub html_cleaning_thingy {
	my $html = join("\n",@_);
	$hc_changed = 0;
	$hc_last_href = undef;
	$hc_htmlout = '';
	$hc_styleout = '';
	$hc_style = 0;
	@hc_skip = ();
	my $hssp = HTML::Parser->new();
	return (0,$html) unless ($hssp);
	$hssp->unbroken_text(1);
	$hssp->closing_plaintext(1);
	$hssp->boolean_attribute_value("\x01");
	$hssp->handler(	text		=> \&hc_handle_text,'self, text');
	$hssp->handler(	start		=> \&hc_handle_start,'self, text, tagname, attr');
	$hssp->handler(	end		=> \&hc_handle_end,'self, text, tagname');
	$hssp->handler(	declaration	=> \&hc_handle_declaration,'self, text, tagname');
	$hssp->handler(	comment		=> \&hc_handle_comment,'self, text');
	if ($html =~ /^\s*[^<\s]{1,5}\s*(<!DOCTYPE.*)$/s) {
		$html = $1;
		$hc_changed ++;
	}
	if ($hssp->parse($html)) {
		$hssp->eof;
		$html = $hc_htmlout if ($hc_changed);
	}
	$hc_last_href = undef;
	$hc_htmlout = '';
	$hc_styleout = '';
	$hc_style = 0;
	@hc_skip = ();
	return ($hc_changed,$html);
}

# Creates a cleaning report in temp dir
sub html_cleaning_report {
	return unless (defined($dbh_report) && $dbh_report);
	my $html = shift;
	my $nhtm = shift;
	my $octeh = shift;
	my $ncteh = shift;
	my $diffs = '';
	if ($dbh_report_diff && load_modules('Text::Diff')) {
		my $x1 = $html;
		my $x2 = $nhtm;
		$x1 =~ s/^\s*(.*?)\s*$/$1\n/s;
		$x2 =~ s/^\s*(.*?)\s*$/$1\n/s;
		eval {
			my $diff = diff(\$x1,\$x2,{STYLE=>'Unified',CONTEXT=>0});
			$diffs .= "\n$diff" if ($diff);
		};
		eval {
			my $diff = diff(\$x1,\$x2,{STYLE=>'Table',CONTEXT=>0});
			$diffs .= "\n$diff" if ($diff);
		};
	}
	my $tfn = './HTML_CLEANING_REPORT.'.@hc_reports;
	return unless (open(TFH,'>',$tfn));
	debug_log(2,'html_cleaning_report %s',$tfn);
	push @hc_reports, $tfn;
	print TFH "Content-Transfer-Encoding: '$octeh' -> '$ncteh'\n" if ($ncteh);
	print TFH "==========================\nOriginal\n--------------------------\n$html\n";
	print TFH "==========================\nNew\n--------------------------\n$nhtm\n";
	print TFH "==========================\nDiff\n--------------------------$diffs\n" if ($diffs);
	close(TFH);
}

sub move_html_cleaning_reports {
	my ($todir) = @_;
	debug_log(7,'move_html_cleaning_reports %s',$todir);
	foreach my $rf (@hc_reports) {
		my $nf = $rf;
		$nf =~ s/^.*\///;
		debug_log(3,'move_html_cleaning_reports %s %s',$nf,$todir);
		copy_or_link($rf,"$todir/$nf");
		unlink($rf);
	}
	@hc_reports = ();
}

# Clears some vars and optionally deletes cleaning reports
sub html_cleaning_clear {
	my ($delrep) = @_;
	debug_log(7,'html_cleaning_clear');
	if ($delrep) {
		foreach my $rf (@hc_reports) {
			unlink($rf);
		}
	}
	$hc_last_href = undef;
	@hc_reports = ();
	$hc_htmlout = '';
	$hc_styleout = '';
	@hc_skip = ();
	$hc_main_entity = undef;
	%hc_cids = undef;
}


#***********************************************************************
# Attachment replacement stuff.
#***********************************************************************

my @replaced_attachments = ();
my $replace_attachments_path = '';
my $replace_all_attachments = 0;
my $do_replace_attachments = 0;

sub catch_replace_attachments {
	my ($recipient,$chkdom) = @_;
	debug_log(7,'catch_replace_attachments cd:%i %s',$chkdom,$recipient);
	return undef unless ($chkdom);
	return undef unless ($attachments_domain);
	#debug_log(0,'catch_replace_attachments %s =~ %s',$recipient,"/^<?(.+)\%(.+)\@$attachments_domain>?$/i");
	return undef unless ($recipient =~ /^<?(.+)\%(.+)\@$attachments_domain>?$/i);
	my $naddr = "$1\@$2";
	debug_log(0,'catch_replace_attachments %s -> %s',$recipient,$naddr);
	return $naddr;
}

sub check_replace_attachments {
	my ($entity,$chkdom) = @_;
	my @dra = $do_replace_attachments ? split(/;/,$do_replace_attachments) : ();
	$do_replace_attachments = 0;
	my %chrcpt = ();
	foreach my $rcpt (@Recipients) {
		if (my $naddr = catch_replace_attachments($rcpt,$chkdom)) {
			my $oaddr = lc($rcpt);
			$oaddr =~ s/^<//;
			$oaddr =~ s/>$//;
			do_replace_recipients($rcpt,$naddr);
			$chrcpt{$oaddr} = $naddr;
			debug_log(0,'check_replace_attachments d %s -> %s',$rcpt,$naddr);
			push @dra, 'domain,all';
		} elsif ($attachments_recipients && $rcpt =~ /^<?$attachments_recipients>?$/i) {
			push @dra, 'rcpt';
			debug_log(0,'check_replace_attachments r %s',$rcpt);
		} else {
			debug_log(7,'check_replace_attachments - %s',$rcpt);
		}
	}
	if (%chrcpt && $entity && $entity->head && load_modules('Email::Address')) {
		debug_log(0,'check_replace_attachments H');
		foreach my $hn ('To','Cc') {
			my $hv = $entity->head->get($hn);
			next unless ($hv);
			my @ao = Email::Address->parse($hv);
			next unless (@ao);
			my @an = ();
			my $ch = 0;
			foreach my $a (@ao) {
				next unless ($a);
				#debug_log(0,'check_replace_attachments < %s',$a->format);
				if ($chrcpt{lc($a->address)}) {
					$a->address($chrcpt{lc($a->address)});
					$ch ++;
				}
				if ($chrcpt{lc($a->phrase)}) {
					$a->phrase($chrcpt{lc($a->phrase)});
					$ch ++;
				}
				if ($chrcpt{lc($a->comment)}) {
					$a->comment($chrcpt{lc($a->comment)});
					$ch ++;
				}
				#debug_log(0,'check_replace_attachments > %s',$a->format);
				push @an, $a->format;
			}
			next unless ($ch);
			my $hr = join(', ',@an);
			debug_log(0,'check_replace_attachments %s: %s -> %s',$hn,$hv,$hr);
			do_action_change_header($entity,$hn,$hr);
		}
	}
	$do_replace_attachments = join(';',@dra) if (@dra);
	debug_log(0,'check_replace_attachments %s',$do_replace_attachments) if ($do_replace_attachments);
	return $do_replace_attachments;
}

# Save attachment to uniquely named (for msg) dir.
sub save_replaced_attachment {
	my ($entity,$fname,$type) = @_;
	return 0 unless ($entity);
	return 0 unless ($attachments_path && $attachments_url);
	return 0 unless (-d $attachments_path);
	my $grp = (stat(_))[5];
	debug_log(0,'sra: %s',$fname);
	unless ($replace_attachments_path) {
		do {
			$replace_attachments_path = sprintf('%x.%x.%x.%s.%x',rand(0xFFFF),time(),$$,$MsgIDs,rand(0xFFFF));
		} while (-e "$attachments_path/$replace_attachments_path");
		return 0 unless (mkdir("$attachments_path/$replace_attachments_path"));
		chown(-1,$grp,"$attachments_path/$replace_attachments_path");
		chmod(0755,"$attachments_path/$replace_attachments_path");
	}
	return 0 unless ($replace_attachments_path && (-d "$attachments_path/$replace_attachments_path"));
	debug_log(0,'sra: %s -> %s/',$fname,$replace_attachments_path);
	$fname = '' unless (defined($fname));
	$fname =~ s/^.*[\/\\]//s;
	$fname =~ s/\r\n+//gs;
	$fname =~ s/^\s+//;
	$fname =~ s/\s+$//;
	my $sname = $fname;
	$fname =~ s/\s+/_/g;
	$fname =~ s/[^-_.,;=a-zA-Z0-9]//g;
	$fname =~ s/^\.+//;
	$fname = 'unknown' if ($fname eq '');
	$sname =~ s/[\x00-\x19\x7E-\xFF]/#/g;
	$sname =~ s/"/'/g;
	if ($fname =~ /^(index|default)\./i || (-e "$attachments_path/$replace_attachments_path/$fname")) {
		my $fcnt = 0;
		my $fext = '';
		if ($fname =~ /^(.*)(\.[-_a-zA-Z0-9]+?)$/) {
			$fext = $2;
			$fname = $1;
		}
		do {
			$fcnt++
		} while ((-e "$attachments_path/$replace_attachments_path/$fname$fcnt$fext") ||
		         (-e "$attachments_path/$replace_attachments_path/$fname$fcnt$fext.meta") ||
		         (-e "$attachments_path/$replace_attachments_path/$fname$fcnt$fext.head"));
		$fname .= "$fcnt$fext";
	}
	debug_log(0,'sra: %s -> %s/%s',$fname,$replace_attachments_path,$fname);
	my $path = $entity->bodyhandle->path;
	return 0 unless (defined($path));
	return 0 unless (copy_or_link($path,"$attachments_path/$replace_attachments_path/$fname"));
	chmod(0644,"$attachments_path/$replace_attachments_path/$fname");
	chown(-1,$grp,"$attachments_path/$replace_attachments_path/$fname");
	if ($attachments_meta) {
		my $mpath = "$attachments_path/$replace_attachments_path";
		$mpath .= "/$attachments_meta" if ($attachments_meta !~ /^\.[\/\\]?$/);
		unless (-e $mpath) {
			mkdir($mpath);
			chmod(0755,$mpath);
			chown(-1,$grp,$mpath);
		}
		if (($type || $sname) && open(AMF,'>',"$mpath/$fname.meta")) {
			if ($type && $sname) {
				print AMF "Content-Type: $type; name=\"$sname\"\r\n";
				print AMF "Content-Disposition: attachment; filename=\"$sname\"\r\n";
			} elsif ($type) {
				print AMF "Content-Type: $type\r\n";
			} elsif ($sname) {
				print AMF "Content-Disposition: attachment; filename=\"$sname\"\r\n";
			}
			close(AMF);
			chmod(0644,"$mpath/$fname.meta");
			chown(-1,$grp,"$mpath/$fname.meta");
		}
		if (open(AMF,'>',"$mpath/$fname.head")) {
			print AMF $entity->head->as_string;
			close(AMF);
			chmod(0644,"$mpath/$fname.head");
			chown(-1,$grp,"$mpath/$fname.head");
		}
	}
	debug_log(0,'sra: %s -> %s',"$attachments_path/$replace_attachments_path/$fname");
	return $fname;
}

# Move attachment to disk and make a note of it.
sub replace_attachment {
	my ($entity,$fname,$type) = @_;
	return 0 unless ($entity);
	return 0 unless ($attachments_path && $attachments_url);
	return undef unless (load_modules('MIME::Entity','Encode'));
	my $newname = save_replaced_attachment($entity,$fname,$type);
	return 0 unless ($newname);
	my %att = (
		orgname=>$fname,
		newname=>$newname
	);
	$att{entname} = HTML::Entities::encode_entities($fname) if (load_modules('HTML::Entities'));
	debug_log(0,'ra: %s -> %s = %s',$fname,$newname,$att{entname});
	$modhead{'Replaced attachment(s).'} ++;
	push @replaced_attachments, \%att;
	return action_drop();
}

# Move attachment to disk if it should be done.
sub maybe_replace_attachment {
	my($entity,$fname,$type) = @_;
	return 0 unless ($do_replace_attachments);
	return 0 unless ($entity);
	return 0 if ($type =~ /^multipart\//i);
	my $bdyh = $entity->bodyhandle;
	return 0 unless ($bdyh && $bdyh->path);
	my $size = (stat($bdyh->path))[7];
	return 0 unless ($size);
	#debug_log(0,'maybe_replace_attachment hard limit: %u %u',$attachments_hard_limit,$size);
	unless (($attachments_hard_limit && $size > $attachments_hard_limit) || 
		($do_replace_attachments && $do_replace_attachments =~ /hard/i)) {
		debug_log(0,'maybe_replace_attachment %s',$do_replace_attachments) if ($do_replace_attachments);
		return 0 unless ($do_replace_attachments);
		return 0 if ($attachments_min_size && $size <= $attachments_min_size);
		unless ($attachments_max_size && $size > $attachments_max_size) {
			return 0 unless ($replace_all_attachments || $do_replace_attachments =~ /all/i);
			if (defined(%hc_cids)) {
				my $cid = $entity->head ? $entity->head->get('Content-ID') : 0;
				return 0 if ($cid && $hc_cids{lc($cid)});
			}
		}
	}
	if ($entity->head) {
		my $disp = lc($entity->head->mime_attr("Content-Disposition"));
		$disp = 'attachment' if (!$disp && $entity->head->recommended_filename);
		return 0 if ($disp eq 'inline');
		unless ($type =~ /^application\/octet-?stream$/i || $disp eq 'attachment') {
			return 0 if ($entity->head->get('Content-ID'));
			return 0 if ($type =~ /^text\//i && !$disp);
		}
	}
	debug_log(5,'maybe_replace_attachment !',$do_replace_attachments);
	return 1 if (replace_attachment($entity,$fname,$type));
	debug_log(-1,'maybe_replace_attachment: error saving attachment (%s)',$fname);
	return 0;
}

# Make a note with URLs to attachments moved to disk.
sub make_attachment_replacement_note {
	my ($dotext,$dohtml) = @_;
	return undef unless ($attachments_path && $attachments_url);
	return undef unless ($replace_attachments_path);
	return undef unless (@replaced_attachments);
	unless (defined($dotext) || defined($dohtml)) {
		$dotext = 1;
		$dohtml = 1;
	}
	return undef unless ($dotext || $dohtml);
	return undef unless (load_modules('MIME::Entity','Encode'));
	my $text = "Bifogade filer / Attached files:\n\n";
	my $html = "<html><head><title>Bifogade filer / Attached files:</title></head>\<body><b>Bifogade filer / Attached files:</b><ul>\n";
	foreach my $att (@replaced_attachments) {
		my $url = sprintf("%s/%s/%s",$attachments_url,$replace_attachments_path,$att->{newname});
		$text .= "$url\n";
		$html .= sprintf("<li><a href=\"%s\">%s</a></li>\n",$url,$att->{entname}?$att->{entname}:$att->{orgname});
	}
	$html .= '</ul><hr /></body></html>';
	my ($msgtext,$msghtml);
	if ($dotext) {
		$msgtext = MIME::Entity->build(
			Type		=> 'text/plain',
			Data		=> encode('iso-8859-1',$text),
			Encoding	=> '-SUGGEST',
			Charset		=> 'iso-8859-1',
			Top		=> 0,
			Disposition	=> 'inline',
		);
		debug_log(0,'marn: t=%u',length($msgtext));
		return $msgtext unless ($dohtml);
	}
	if ($dohtml) {
		$msghtml = MIME::Entity->build(
			Type		=> 'text/html',
			Data		=> encode('iso-8859-1',$html),
			Encoding	=> '-SUGGEST',
			Charset		=> 'iso-8859-1',
			Top		=> 0,
			Disposition	=> 'inline',
		);
		debug_log(0,'marn: h=%u',length($msghtml));
		return $msghtml unless ($dotext);
	}
	my $msg = MIME::Entity->build(
			Type		=> 'multipart/alternative',
			Top		=> 0,
			Disposition	=> 'inline',
			'X-ID'		=> $replace_attachments_path,
	);
	return undef unless ($msg);
	$msg->add_part($msgtext);
	$msg->add_part($msghtml);
	$msg->preamble([]);
	$msg->epilogue([]);
	debug_log(0,'marn: m');
	return $msg;
}

# Add a part with URLs to attachments moved to disk.
sub add_attachment_replacement_note {
	my ($entity,$dotext,$dohtml,$offset) = @_;
	my $msg = make_attachment_replacement_note($dotext,$dohtml);
	return undef unless ($msg);
	my $grp = (stat("$attachments_path/$replace_attachments_path"))[5];
	if (open(AMF,'>',"$attachments_path/$replace_attachments_path/.envelope")) {
		print AMF "MsgID:     $MsgIDs\n".
		          "RelayAddr: $RelayAddr\n".
			  "RelayHost: $RelayHostname\n".
			  "RelayHelo: $Helo\n".
			  "Sender:    $Sender\n".
			  "Recipients:\n\t".join("\n\t",@Recipients)."\n";
		close(AMF);
		chown(-1,$grp,"$attachments_path/$replace_attachments_path/.envelope") if ($grp);
		chmod(0644,"$attachments_path/$replace_attachments_path/.envelope");
	}
	if (open(AMF,'>',"$attachments_path/$replace_attachments_path/.header")) {
		print AMF $entity->head->as_string;
		close(AMF);
		chown(-1,$grp,"$attachments_path/$replace_attachments_path/.header") if ($grp);
		chmod(0644,"$attachments_path/$replace_attachments_path/.header");
	}
	if (open(AMF,'>',"$attachments_path/$replace_attachments_path/.note")) {
		print AMF $msg->as_string;
		close(AMF);
		chown(-1,$grp,"$attachments_path/$replace_attachments_path/.note") if ($grp);
		chmod(0644,"$attachments_path/$replace_attachments_path/.note");
	}
	$offset = -1 unless (defined($offset));
	debug_log(0,'aarn: %u %s',$offset,$replace_attachments_path);
	push @AddedParts, [$msg,$offset];
	action_rebuild();
	return $msg;
}


#***********************************************************************
# Misc content checking/changing.
#***********************************************************************

$did_quarantine = 0;

sub quarantine_misc_info {
	my $qd = shift;
	$qd = get_quarantine_dir() unless ($qd);
	if (defined($info) && $info && open(QIF,'>>',"$qd/MSG.$QuarantineCount")) {
		print QIF "$info\n";
		close(QIF);
	}
	if (!(-f "$qd/HASH") && open(QIF,'>',"$qd/HASH")) {
		my $hash = make_message_hash();
		print QIF "$hash\n";
		close(QIF);
	}
	if (!(-f "$qd/RELAY") && open(QIF,'>',"$qd/RELAY")) {
		my $country = get_ip_location($RelayAddr);
		my $iposhead = get_ip_os_head($RelayAddr);
		print QIF "Addr: $RelayAddr\n";
		print QIF "Host: $RelayHostname\n";
		print QIF "Helo: $Helo\n";
		print QIF "Orig: $country\n";
		print QIF "Syst: $iposhead\n";
		print QIF synthesize_received_header();
		close(QIF);
	}
}

sub do_action_quarantine {
	my ($flag,$entity,$info,$msg) = @_;
	$msg = '' unless (defined($msg));
	my $r = action_quarantine($entity,$msg);
	pop @Warnings unless ($msg);
	my $qd = get_quarantine_dir();
	$did_quarantine = 1;
	quarantine_misc_info($qd,$info);
	copy_or_link('./INPUTMSG', "$qd/INPUTMSG") unless (-f "$qd/INPUTMSG");
	create_file("$qd/FLAG.$flag");
	$qd =~ s/^.*\///;
	stats_log('quarantine',$MsgIDs,$flag,$qd,make_message_hash());
	return $r;
}

sub do_action_quarantine_entire_message {
	my ($flag,$msg) = @_;
	my $r = action_quarantine_entire_message($msg);
	my $qd = get_quarantine_dir();
	$did_quarantine = 1;
	quarantine_misc_info($qd);
	create_file("$qd/FLAG.$flag");
	$qd =~ s/^.*\///;
	stats_log('quarantine',$MsgIDs,$flag,$qd,make_message_hash());
	return $r;
}

sub do_action_bounce {
	return action_bounce(reject_answer(@_));
}

sub do_action_tempfail {
	return action_tempfail(tempfail_answer(@_));
}

# make hash of message
sub update_line_hash {
	my ($h,$he,$nt,$hashes,$sha,$md5) = @_;
	$h =~ s/[\r\n]+//gs;
	if ($$he) {
		$hashes->[0] .= 'B' unless ($he>1);
		$$he ++;
		$md5->add("$h\n") if ($md5);
		$sha->add("$h\n") if ($sha);
	} elsif ($h eq '') {
		$$he ++;
		$md5->add("$h\n") if ($md5);
		$sha->add("$h\n") if ($sha);
	} elsif ($h =~ /^\s/) {
		next if ($$nt);
		#debug_log(0,'make_data_hash h %s',$h);
		$md5->add("$h\n") if ($md5);
		$sha->add("$h\n") if ($sha);
	} elsif ($h =~ /^(Content-\S+|Subject):.*$/) {
		#debug_log(0,'make_data_hash H %s',$h);
		$md5->add("$h\n") if ($md5);
		$sha->add("$h\n") if ($sha);
		$h = $1;
		$h =~ s/(^|[-_])(.)[^-_]*/$2/gs;
		$hashes->[0] .= ucfirst(lc($h));
	} else {
		$$nt = 1;
	}	
}
sub make_data_hash {
	my ($md5,$sha);
	$sha = Digest::SHA->new() if (load_modules('Digest::SHA'));
	$md5 = Digest::MD5->new() if (load_modules('Digest::MD5'));
	return '' unless ($md5 || $sha);
	my @hashes = ('');
	my $nt = 0;
	my $he = 0;
	while ($#_>0) {
		my $hh = shift @_;
		my $ha = ref($hh) eq 'ARRAY' ? $hh : [$hh];
		while (@{$ha}) {
			my $h = shift @{$ha};
			#debug_log(0,'make_data_hash l %s',$h);
			update_line_hash($h,\$he,\$nt,\@hashes,$sha,$md5);
		}
	}
	return '' unless (@_);
	my $dfn = shift @_;
	return '' unless (open(F,'<',$dfn));
	#debug_log(0,'make_data_hash f %s',$dfn);
	while (my $h = <F>) {
		update_line_hash($h,\$he,\$nt,\@hashes,$sha,$md5);
	}
	close(F);
	push @hashes, $sha->hexdigest if ($sha);
	push @hashes, $md5->hexdigest if ($md5);
	#debug_log(0,'make_data_hash h %s',join('|',@hashes));
	return join('|',@hashes);
}
my $input_message_hash;
sub make_message_hash {
	#debug_log(0,'make_data_hash m');
	$input_message_hash = make_data_hash('./INPUTMSG') unless ($input_message_hash);
	return join('|',$input_message_hash,@_) if (@_);
	return $input_message_hash;
}
sub make_entity_hash {
	my ($entity) = @_;
	#debug_log(0,'make_data_hash e?');
	return '' unless ($entity && $entity->bodyhandle && $entity->bodyhandle->path);
	#debug_log(0,'make_data_hash e');
	my @head = ();
	if ($entity->head) {
		my $mod = $entity->head->modify(0);
		@head = @{$entity->head->header};
		$entity->head->modify($mod);
	}
	return make_data_hash(@head,'',$entity->bodyhandle->path);
}
sub make_spam_hash {
	return make_message_hash(check_internal_whitelist($RelayAddr) ? 'L' : "RA$RelayAddr");
}

# Handle boilerplates... Hopefully there aren't any...
sub handle_boilerplates {
	my $entity = shift;
	my $abpbp = 0;
	my $bpfl = read_list_file('boilerplates');
	if ($bpfl && @{$bpfl}) {
		my $snda = address_strip($Sender);
		my @bpa = ();
		foreach my $l (@{$bpfl}) {
			my $line = $l;
			$line =~ s/[\r\n]+//g;
			next if ($line =~ /^\#/);
			if ($line =~ /^(\S+\@\S+)\s+(\S.*?)\s*$/i) {
				my $pat = lc($1);
				my $tbi = $2;
				if ($snda =~ /^$pat$/) {
					#debug_log(1,"Boilerplate: '$snda' =~ '$pat'!");
					push @bpa, $tbi;
				}
			}
		}
		if (@bpa) {
			my $dabp = 0;
			foreach my $tbi (@bpa) {
				my $tbpf = '';
				#debug_log(1,"Boilerplate: X '$tbi'");
				if ($tbi =~ /^\s*(.*?)\s*\:\s*(.*?)\s*$/) {
					$tbpf = $1;
					$tbi = $2;
				}
				my $aatb = 0;
				if ($entity->head) {
					my @bphs = $entity->head->get('X-Boiler');
					foreach my $bph (@bphs) {
						$bph =~ s/[\r\n]+//g;
						#debug_log(1,"Boilerplate: H '$bph'?");
						if ($bph =~ /^\s*\[$MyFilterHostName\]\s+[BHTbht]\s*,\s+(\S+)\s*$/) {
							#debug_log(1,"Boilerplate: H '$bph'.");
							if ($1 == $tbi) {
								#debug_log(1,"Boilerplate: H '$bph'!");
								$aatb = 1;
								last;
							}
						}
					}
				}
				next if ($aatb);
				$tbpf =~ s/a//gi;
				#debug_log(1,"Boilerplate: R $tbpf /etc/mail/$tbi");
				my $tbifl = read_text_file($tbi);
				next unless ($tbifl && @{$tbifl});
				my $tb = '';
				my $th = '';
				foreach my $l (@{$tbifl}) {
					my $line = $l;
					$line =~ s/[\r\n]+//g;
					$tb .= "$line\n";
					$th .= "$line\n";
				}
				#debug_log(1,"Boilerplate: C $tbi");
				next unless ($tb && $th);
				if ($tbi =~ /^\.html?$/i) {
					$tbpf .= 'h';
					$tb =~ s/<br ?\/?>/\n/gsi;
					$tb =~ s/<hr =\/?>/-----------------------------------\n/gsi;
					$tb =~ s/<[^>]*>//gs;
				} else {
					$tbpf .= 't';
					$th =~ s/&/&amp;/gs;
					$th =~ s/</&lt;/gs;
					$th =~ s/>/&gt;/gs;
					while ($th =~ s/^(|.*\n)---+(|\n.*)$/$1<hr>$2/gs) {}
					$th =~ s/[\r\n]+$//;
					$th =~ s/^[\r\n]+//;
					$th =~ s/\n/<br>\n/gs;
					while ($th =~ s/<br>[\s\r\n]*<hr>/\n<hr>/gs) {};
					while ($th =~ s/<hr>[\s\r\n]*<br>[\s\r\n]*/<hr>\n/gs) {};
					$th = "<p>$th<\/p>";
					$th =~ s/^<p>[\s\r\n]*<hr>/<hr><p>/si;
				}
				#debug_log(1,"Boilerplate: A $tbpf $tbi ");
				my $bprt;
				if ($tbpf =~ /b/i) {
					#if ($tpbf =~ /h/i) {
					#	append_text_boilerplate($entity,$tb,0) unless (append_html_boilerplate($entity,$th,0));
					#} else {
					#	append_html_boilerplate($entity,$th,0) unless (append_text_boilerplate($entity,$tb,0));
					#}
					my $abpbpt = append_text_boilerplate($entity,$tb,0);
					my $abpbph = append_html_boilerplate($entity,$th,0);
					$abpbp = (($abpbpt || $abpbph) && !($abpbpt && $abpbph));
					do_action_insert_header($entity,'X-Boiler',"[$MyFilterHostName] B, $tbi",0);
					$dabp = 1;
					$rbm = 1;
				} elsif ($tbpf =~ /h/i) {
					$bprt = action_add_part($entity, "text/html", "-suggest",$th,'','inline');
					do_action_insert_header($entity,'X-Boiler',"[$MyFilterHostName] H, $tbi",0);
					$dabp = 1;
				} elsif ($tbpf =~ /t/i) {
					$bprt = action_add_part($entity, "text/plain", "-suggest",$tb,'','inline');
					do_action_insert_header($entity,'X-Boiler',"[$MyFilterHostName] T, $tbi",0);
					$dabp = 1;
				}
				if ($bprt) {
					$bprt->head->mime_attr("Content-Type.name" => undef);
					$bprt->head->mime_attr("Content-Type.charset" => 'ISO-8859-1');
					$bprt->head->mime_attr("Content-Disposition.filename" => undef);
					$bprt->head->delete('X-Mailer');
					$bprt->head->delete('MIME-Version');
				}
			}
			if ($dabp) {
				$modhead{'Added boiler plate(s).'} ++;
				debug_log(1,"Boilerplate: added boiler plate(s).");
			}
		}
	}
	if ($abpbp && $entity->is_multipart && ($entity->parts <= 1)) {
		# Make into singlepart.
		if ($entity->make_singlepart() == 'DONE') {
			action_rebuild();
			debug_log(1,"Boilerplate: made singlepart.");
		}
	}
	return $abpbp;
}

# Wave flags
sub wave_flags {
	my ($entity) = @_;
	return unless ($entity && $entity->head);
	my %flags = ();
	my $flagdefs = read_list_file('flags');
	return unless ($flagdefs && @{$flagdefs});
	foreach my $l (@{$flagdefs}) {
		my $line = $l;
		next if ($line =~ /^\s*[#;]/);
		next if ($line =~ /^[\s\r\n]*$/);
		debug_log(7,'wave_flags < "%s"',$line);
		my $flg = '';
		my $hdrn = '';
		my $hdrv = '';
		my $fdef = '';
		if ($line =~ /^\s*(\S+):\s*(\S+)\s+(.*?)[\s\r\n]*$/s) {
			$hdrn = $1;
			$hdrv = $2;
			$fdef = $3;
			$hdrv =~ s/_+/ /g;
			$hdrv =~ s/^\s+//;
			$hdrv =~ s/\s+$//;
		} elsif ($line =~ /^\s*(\S+)\s+(.*?)[\s\r\n]*$/s) {
			$flg = $1;
			$fdef = $2;
		} else {
			next;
		}
		debug_log(5,'wave_flags $ %s "%s"',$flg,$fdef);
		next if ($flags{lc($flg)});
		if ($fdef =~ /^header\s+(\S+)\s+(.*?)\s*$/i) {
			my $expr = $2;
			my $htag = $1;
			my $hval = '';
			if ($htag =~ /^envelope[-_]to$/i) {
				foreach my $rcpt (@Recipients) {
					$hval .= address_strip_nc($rcpt)."\n";
				}
			} elsif ($htag =~ /^envelope[-_]from$/i) {
				$hval = address_strip_nc($Sender);
			} elsif ($htag =~ /^(\S+):(\S*)$/) {
				$hval = decode_header($entity->head->mime_attr("$1.$2"));
				$hval =~ s/[\r\n]+//gs;
				$hval =~ s/\s+/ /g;
			} else {
				foreach my $hv ($entity->head->get($htag)) {
					$hv =~ s/[\r\n]+//gs;
					$hv =~ s/\s+/ /g;
					$hv =~ s/^\s+//;
					$hv =~ s/\s+$//;
					$hval .= "$hv\n";
				}
			}
			$hval =~ s/^[s\r\n]+//;
			$hval =~ s/[s\r\n]+$//;
			next if ($hval eq '');
			debug_log(4,'wave_flags = "%s" ? "%s"',$hval,$expr);
			if (!$expr) {
				next if ($hval);
				if ($flg) {
					debug_log(3,'wave_flags + %s',$flg);
					$flags{lc($flg)} = $flg;
				}
				if ($hdrn && $hdrv ne '') {
					debug_log(3,'wave_heads + %s: %s',$hdrn,$hdrv);
					do_action_insert_header($entity,$hdrn,$hdrv);
				}
				next;
			}
			next unless ($hval);
			$expr = "/$expr/si" unless ($expr =~ /^\/.*\/\S*$/);
			debug_log(4,'wave_flags = "%s" ~ "%s"',$hval,$expr);
			next unless eval("\$hval =~ $expr");
			if ($flg) {
				debug_log(3,'wave_flags + %s',$flg);
				$flags{lc($flg)} = $flg;
			}
			if ($hdrn && $hdrv ne '') {
				debug_log(3,'wave_heads + %s: %s',$hdrn,$hdrv);
				do_action_insert_header($entity,$hdrn,$hdrv);
			}
		}
	}
	return unless (%flags);
	debug_log(5,'wave_flags > %s',join(', ',values %flags));
	do_action_insert_header($entity,'X-Filter-Flags',join(',',values %flags));
}

sub replace_overlong_headers {
	my ($entity,$sender) = @_;
	return 0 unless ($fix_headers);
	my @prepend = ();
	my @append = ();
	my @tags = $entity->head->tags;
	my %tagmax = (
		''		=> 8192,
		'subject'	=> 512,
		'from'		=> 4096,
		'reply-to'	=> 4096,
		'to'		=> 6144,
		'cc'		=> 6144,
	);
	my $ch = 0;
	foreach my $tag (@tags) {
		my @ahl = $entity->head->get($tag);
		next unless (@ahl);
		for (my $i=$#ahl;$i>=0;$i--) {
			my $max = $tagmax{lc($tag)};
			$max = $tagmax{''} unless ($max);
			#debug_log(0,'replace_overlong_headers %u %s[%u] %u',$max,$tag,$i,length($ahl[$i]));
			next unless (length($ahl[$i])>$max);
			debug_log(1,'replace_overlong_headers %u %s[%u]: %s',$max,$tag,$i,$ahl[$i]);
			if ($tag =~ /^(To|Cc)$/i) {
				do_action_change_header($entity,$tag,'...:;',$i+1);
				push @append, "$tag: ".decode_header($ahl[$i]);
			} elsif ($tag =~ /^(From|Reply-To|Sender|Errors-To)$/i) {
				debug_log(1,'replace_overlong_headers from 1');
				my $addr = get_address_from_header($entity,$tag);
				$addr = $sender if (!$addr || $addr !~ /^<?.+\@[^\@]+>?$/ || length($addr)>$max);
				$addr = '? <>' unless ($addr);
				do_action_change_header($entity,$tag,mqpcs('UTF-8',$addr),$i+1);
				push @prepend, "$tag: ".decode_header($ahl[$i]);
			} elsif ($tag =~ /^(Subject|Date)$/i) {
				my $dval = decode_header($ahl[$i]);
				do_action_change_header($entity,$tag,mqpcs('UTF-8',substr($dval,0,76).'...'),$i+1);
				push @prepend, "$tag: ".$dval;
			} elsif ($tag =~ /^(Received)$/i) {
				do_action_change_header($entity,$tag,'(header too long)',$i+1);
			} else {
				my $dval = decode_header($ahl[$i]);
				do_action_delete_header($entity,$tag,$i+1);
				do_action_insert_header($entity,"X-$tag",mqpcs('UTF-8',substr($dval,0,76).'...'));
				push @append, "$tag: ".$dval;
			}
			$ch ++;
		}
	}
	if ($ch) {
		debug_log(1,'replace_overlong_headers %u',$ch);
		if (@prepend) {
			debug_log(1,'replace_overlong_headers prepend');
			action_add_part($entity,"text/plain","-suggest",join("\n",@prepend),"LongHeadersP.txt","inline",0);
			action_rebuild();
		}
		if (@append) {
			debug_log(1,'replace_overlong_headers append');
			action_add_part($entity,"text/plain","-suggest",join("\n",@append),"LongHeadersA.txt","inline",-1);
			action_rebuild();
		}
		stats_log('modified',$MsgIDs,'modified_headers','overlong');
	}
	return $ch;
}

my %macros_long_name = ('_'=>'mail_relay','j'=>'domain','i'=>'QID','c'=>'hop_count','p'=>'pid','r'=>'protocol');
my $macros_hide = '(mail_mailer|j|i|p|r|daemon_name|if_name|mail_addr|if_addr|_)';
my $macros_head = '(c|r|total_rate|client_rate|load_avg|msg_size)';
my $macros_log = '(msg_size|load_avg|c|p|r|nbadrcpts|client_connections|client_rate|total_rate)';
my $macros_nlog = '(daemon_name|if_name|mail_host|_|if_addr|mail_relay|j|mail_mailer|i|mail_addr)';
sub macros_text {
	my ($fmt) = @_;
	my $txt = '';
	my @log = ();
	while (my ($omac,$oval) = each %SendmailMacros) {
		#debug_log(0,'macros_text %s = %s',$omac,$oval);
		next unless (defined($oval) && $oval ne '' && defined($omac) && $omac ne '');
		next if ($omac =~ /^$macros_hide$/i && $fmt !~ /[AaLl]/);
		next if ($fmt =~ /[Hh]/ && $omac !~ /^$macros_head$/i);
		next if ($fmt =~ /[Ll]/ && $omac =~ /^$macros_nlog$/i);
		#next if ($fmt =~ /[Ll]/ && $omac !~ /^$macros_log$/i);
		my $mac = $omac;
		my $val = $oval;
		$mac = $macros_long_name{$mac} if (defined($macros_long_name{$mac}));
		$val =~ s/^[\s\r\n]+//s;
		$val =~ s/[\s\r\n]+$//s;
		if ($fmt =~ /[Ll]/) {
			push @log, [$mac,$val];
		} else {
			next if ($mac =~ /^$macros_hide$/i && $fmt !~ /[Aa]/);
			next if ($mac =~ /^.$/ && $fmt !~ /[Aa]/);
			$mac =~ s/_+/ /g unless ($mac =~ /^_+$/);
			$mac = ucfirst($mac);
			$mac = "SM $mac" if ($fmt =~ /[Pp]/);
			if ($fmt =~ /[Hh]/) {
				$txt .= "; " if ($txt);
				$txt .= "$mac: ".mqp($val);
			} else {
				$txt .= "$mac: $val";
				$txt .= "\n";
			}
		}
	}
	return @log if ($fmt =~ /[Ll]/);
	return $txt;
}
sub macros_stats_log {
	my @log = macros_text('L');
	stats_log('sendmail_macros',$MsgIDs,@_,@log) if (@log);
}

#***********************************************************************
# Anti-virus stuff.
#***********************************************************************

# dynamically configure virus scanners to be used
my %AntiVirusBypass = ();
sub set_antivirus_features {
	foreach my $fk (keys %AntiVirusBypass) {
		next unless ($AntiVirusBypass{$fk});
		$Features{$fk} = $AntiVirusBypass{$fk};
		$AntiVirusBypass{$fk} = 0;
		$VirusScannerRoutinesInitialized = 0;
		undef @VirusScannerMessageRoutines;
		undef @VirusScannerEntityRoutines;
	}
	my $la;
	my $sp;
	while (my ($vf,$vv) = each %AntiVirusConfig) {
		my $vd = 0;
		if ($vv->{la} && !$vd) {
			#debug_log(0,'set_antivirus_features Virus:%s la=%s',$vf,$vv->{la});
			$la = get_load_average() unless (defined($la));
			if (defined($la) && $la >= $vv->{la}) {
				md_syslog('info', "Virus scanner $vf disabled due to load average $la >= $vv->{la}!");
				$vd ++;
			}
		}
		if ($vv->{sp} && !$vd) {
			#debug_log(0,'set_antivirus_features Virus:%s sp=%s',$vf,$vv->{sp});
			$sp = get_swap_percentage() unless (defined($sp));
			if (defined($sp) && $sp >= $vv->{sp}) {
				md_syslog('info', "Virus scanner $vf disabled due to swap percentage $sp >= $vv->{sp}!");
				$vd ++;
			}
		}
		if ($vd) {
			$warnhead{"Virus scanner $vf disabled."} ++;
			#debug_log(0,'set_antivirus_features Virus:%s = 0',$vf);
			if ($Features{"Virus:$vf"}) {
				$Features{"Virus:$vf"} = 0;
				$VirusScannerRoutinesInitialized = 0;
				undef @VirusScannerMessageRoutines;
				undef @VirusScannerEntityRoutines;
			}
		} else {
			#debug_log(0,'set_antivirus_features Virus:%s = %s',$vf,$vv->{fn});
			unless ($Features{"Virus:$vf"}) {
				$Features{"Virus:$vf"} = $vv->{fn};
				if ($Features{"Virus:$vf"}) {
					md_syslog('info', "Virus scanner $vf reenabled.");
					$VirusScannerRoutinesInitialized = 0;
					undef @VirusScannerMessageRoutines;
					undef @VirusScannerEntityRoutines;
				}
			}
		}
	}
	foreach my $fk (keys %Features) {
		next unless ($fk =~ /^Virus:(.+)$/);
		my $vf = $1;
		next unless ($Features{$fk});
		next unless (check_virus_bypass($vf,$RelayAddr,$RelayHostname,$Sender,\@Recipients));
		md_syslog('info', "Virus scanner $vf disabled due to bypass setting!");
		$AntiVirusBypass{$fk} = $Features{$fk};
		$Features{$fk} = 0;
		$VirusScannerRoutinesInitialized = 0;
		undef @VirusScannerMessageRoutines;
		undef @VirusScannerEntityRoutines;
	}
	$Features{"Virus:FileScan"} = 0; # Never allow this!
	my $on = 0;
	while (my ($vf,$vv) = each %Features) {
		next unless ($vf =~ /^Virus:.+/);
		next unless ($vv);
		$on ++;
	}
	return $on;
}

sub get_cached_virus_result {
	my ($hash,$aloc,$ent,$vsc,$vircache) = @_;
	return (0,'','','') unless ($hash && $vircache);
	if (list_file_changed('antivirus','\s*\=') || list_file_changed('antivirus','\s*\=')) {
		debug_log(0,'get_cached_virus_result clear');
		sql_execute('DELETE FROM virusresults');
	}
	debug_log(7,'get_cached_virus_result find %u %u %u',$aloc,$ent,$vsc,$hash);
	my $start = time();
	my $now = time();
	while ($now-$start<30) {
		my $res = sql_select_one_row(
				'SELECT vir_code,vir_category,vir_action,vir_name FROM virusresults WHERE vir_hash=? AND vir_local=? AND vir_entity=? AND vir_scanners>=? AND vir_stamp>? AND (vir_stamp>? OR vir_action!=?)',
				$hash,$aloc,$ent,$vsc,$now-$vircache,$now-60,'tempfail');
		return (0,'','','') unless ($res && @{$res});
		return ($res->[0],$res->[1],$res->[2],$res->[3]) if ($res->[1] && $res->[2]);
		debug_log(0,'get_cached_virus_result wait');
		sleep(2);
		$now = time();
	}
	return (0,'','','');
}
# Check message or entity for virus
sub remember_virus_thingy {
	my ($hash,$aloc,$ient,$vsc,$scode,$scat,$sact,$vnam) = @_;
	if ($sqldbd eq 'M') {
		sql_execute('INSERT INTO virusresults (vir_hash,vir_local,vir_entity,vir_scanners,vir_stamp,vir_code,vir_category,vir_action,vir_name) VALUES (?,?,?,?,?,?,?,?,?) '.
			    'ON DUPLICATE KEY UPDATE vir_stamp=VALUES(vir_stamp),vir_code=VALUES(vir_code),vir_category=VALUES(vir_category),vir_action=VALUES(vir_action),vir_name=VALUES(vir_name)',
			    $hash,$aloc,$ient,$vsc,time(),$scode,$scat,$sact,$vnam);
	} else {
		sql_execute_multi(
			['INSERT OR IGNORE INTO virusresults (vir_hash,vir_local,vir_entity,vir_scanners) VALUES (?,?,?,?)',
				$hash,$aloc,$ient,$vsc],
			['UPDATE virusresults SET vir_stamp=?,vir_code=?,vir_category=?,vir_action=?,vir_name=? WHERE vir_hash=? AND vir_local=? AND vir_entity=? AND vir_scanners=?',
				time(),$scode,$scat,$sact,$vnam,$hash,$aloc,$ient,$vsc],
		);
	}
	return 1;
}
sub thingy_contains_virus {
	my ($entity) = @_;
	my $vsc = set_antivirus_features();
	return (wantarray ? (0,'ok','ok','') : 0) unless ($vsc);
	my $aloc = address_is_local($RelayAddr);
	my $vircache = $aloc ? $vircache_local : $vircache_external;
	my $hash = !$vircache ? '' : defined($entity) ? make_entity_hash($entity) : make_message_hash();
	my ($code,$category,$action,$virname) = get_cached_virus_result($hash,$aloc,defined($entity)?1:0,$vsc,$vircache);
	if ($category && $action && $category ne 'swerr') {
		debug_log(3,'thingy_contains_virus %s cached %s %s %s %s',defined($entity)?'entity':'message',$code,$category,$action,$virname);
		return (wantarray ? ($code,$category,$action,$virname) : $code);
	}
	initialize_virus_scanner_routines();
	my $vsr = defined($entity) ? \@VirusScannerEntityRoutines : \@VirusScannerMessageRoutines;
	return (wantarray ? (0,'ok','ok','') : 0) unless ($vsr && @{$vsr});
	debug_log(5,'thingy_contains_virus %s scan',defined($entity)?'entity':'message');
	$code = 0;
	$category = 'ok';
	$action = 'ok';
	$virname = '';
	push_status_tag("Running virus scanner");
	my ($scode,$scat,$sact);
	for (my $i=0;$i<@{$vsr};$i++) {
		if (defined($entity)) {
			($scode,$scat,$sact) = $vsr->[$i]->($entity); #$scanner($entity);
		} else {
			($scode,$scat,$sact) = $vsr->[$i]->(); #&$scanner();
		}
		debug_log(3,'thingy_contains_virus %u %i %s %s %s',$i+1,$scode,$scat,$sact,$VirusName?$VirusName:'-');
		if ($scat eq "virus") {
			pop_status_tag();
			remember_virus_thingy($hash,$aloc,defined($entity)?1:0,$vsc,$scode,$scat,$sact,$VirusName) if ($hash);
			return (wantarray ? ($scode,$scat,$sact,$VirusName) : $scode);
		}
		#next if ($scode == 1 && $scat eq 'not-installed' && $sact eq 'tempfail');
		if ($scat ne 'ok' && $action ne 'quarantine') {
			$code = $scode;
			$category = $scat;
			$action = $sact;
			$virname = $VirusName;
		}
	}
	pop_status_tag();
	debug_log(3,'thingy_contains_virus * %i %s %s',$code,$category,$action);
	return (wantarray ? ($code,$category,$action,$virname) : $code) unless ($hash);
	remember_virus_thingy($hash,$aloc,defined($entity)?1:0,$vsc,$code,$category,$action,$virname) if ($hash);
	return (wantarray ? ($code,$category,$action,$virname) : $code);
}

# string with enabled virus scanners
sub get_antivirus_string {
	my $avs = '';
	foreach my $vscan (keys %Features) {
		next unless ($vscan =~ /^Virus:(.*)$/);
		next unless ($Features{$vscan});
		my $vs = $1;
		next if ($vs eq 'CLAMAV' && $Features{'Virus:CLAMD'});
		next if ($vs eq 'FPROT' && $Features{'Virus:FPROTD'});
		$avs .= ', ' if ($avs);
		$avs .= $vs;
	}
	$avs =~ s/, ([^,]+)$/ & $1/;
	return $avs;
}

sub antivirus_map_init_vals {
	my %vals = ();
	($vals{type},$vals{code},$vals{category},$vals{action},$vals{virusname}) = @_;
	$vals{clean} = ($vals{category} eq 'ok' && $vals{action} eq 'ok') ? 1 : 0;
	$vals{vals} = '';
	while (my ($k,$v) = each %vals) {
		next unless ($k && $v);
		next if ($k eq 'vals');
		$vals{vals} .= ' ' if ($vals{vals});
		$vals{vals} .= "$k:$v";
	}
	#debug_log(0,'amiv c %s',$vals->{vals});
	return \%vals;
}
sub antivirus_map_check_line {
	my ($l,$vals) = @_;
	#debug_log(0,'amcl l %s',$l) unless ($vals->{clean});
	while ($l =~ /^\s*(\S+?):(\S+)\s*(.*?)$/) {
		my $what = lc($1);
		my $regex = $2;
		$l = $3;
		my $matchx = 0;
		#debug_log(0,'amcl s %s %s',$what,$regex) unless ($vals->{clean});
		if ($what eq 'map') {
			my ($mapf,$mapn);
			if ($regex =~ /^(\S+):(.*)$/) {
				$mapf = $1;
				$mapn = $2;
			} else {
				$mapf = $regex;
				$mapn = '\S+';
			}
			$mapn =~ s/\*$/*?/;
			#debug_log(0,'amcl x %s %s',$mapf,$mapn) unless ($vals->{clean});
			my $maps = read_list_file($mapf);
			if ($maps && @{$maps}) {
				foreach my $ll (@{$maps}) {
					my $mapl = $ll;
					$mapl =~ s/^\s+//;
					$mapl =~ s/\s+$//;
					#debug_log(0,'amcl xl %s %s',$mapn,$mapl) unless ($vals->{clean});
					if ($mapl =~ /^$mapn\s+(.+?)$/i) {
						$regex = $1;
						#debug_log(0,'amcl lx r:"%s" n:"%s" l:%s',$regex,$mapn,$mapl) unless ($vals->{clean});
						if ($vals->{virusname} =~ /$regex/) {
							#debug_log(0,'amcl e %s %s %s',$mapf,$mapn,$regex) unless ($vals->{clean});
							$matchx ++;
							last;
						}
					}
				}
			}
		} elsif (defined($vals->{$what}) && $vals->{$what} ne '' && $vals->{$what} =~ /^$regex$/i) {
			$matchx ++;
		}
		unless ($matchx) {
			$match = 0;
			last;
		}
		$match += $matchx;
	}
	#debug_log(0,'amcl r %u %s',$match,$l) unless ($vals->{clean});
	return ($match,$l);
}
sub antivirus_map_catact {
	my $vals = antivirus_map_init_vals(@_);
	#return (0,'ok','ok') if ($vals->{code} == 1 && $vals->{virusname} eq '' && 
	#			 $vals->{action} eq 'tempfail' && $vals->{category} eq 'not-installed');
	debug_log(1,'amca %s',$vals->{vals}) unless ($vals->{clean});
	#return (0,$vals->{category},$vals->{action}); # Not ready? Or just useless? Who knows?
	my $virmap = read_list_file('antivirus','\s*\=');
	return (0,$vals->{category},$vals->{action}) unless ($virmap && @{$virmap});
	my $category;
	my $action;
	my $hits = 0;
	foreach my $ll (@{$virmap}) {
		my $line = $ll;
		debug_log(1,'amca l %s',$line) unless ($vals->{clean});
		next unless ($line =~ /^\s*\=\s*(.*?)[\r\n\s]*$/);
		my ($match,$l) = antivirus_map_check_line($1,$vals);
		next unless ($match);
		debug_log(1,'amca m %s',$l);
		$l =~ s/^\s*//s;
		$l =~ s/\s*$//s;
		my ($ncat,$nact,$l) = split(/\s*,\s*/,$l,3);
		if ($ncat && !$category) {
			$category = $ncat;
			debug_log(1,'amca nc %s',$ncat);
		}
		if ($nact && !$action) {
			$action = $nact;
			debug_log(1,'amca na %s',$nact);
		}
		debug_log(-1,'antivirus_map_catact ? %s',$l) if (defined($l) && $l ne '');
		$hits ++;
		last if ($action && $category);
	}
	$category = $vals->{category} unless ($category);
	$action = $vals->{action} unless ($action);
	debug_log(1,'amca %u %s %s',$hits,$category,$action) unless ($vals->{clean});
	return ($hits,$category,$action);
}

#***********************************************************************
# SpamAssassin stuff.
#***********************************************************************

sub spam_scanned_header {
	my ($results,$pass) = @_;
	$spimfo = $MyFilterHostName;
	if (defined($results)) {
		$spimfo .= ' using SpamAssassin '.$results->{saver} if ($results->{saver});
		my @spimfo = ();
		push @spimfo, 'hard limit '.$results->{req} if (defined($results->{req}) && !$pass);
		#push @spimfo, 'learned as '.$results->{learned} if ($results->{learned});
		push @spimfo, 'calculated on bounce' if ($results->{bounced});
		$spimfo .= ' ('.join(', ',@spimfo).')' if (@spimfo);
	}
	return $spimfo;
}

sub spam_info_header {
	my ($results,$spampass) = @_;
	return '-' unless (defined($results));
	my $namehead = '';
	if ($results->{snames} && (length($results->{snames}) > 44) && load_modules('Text::Wrap')) {
		my $twco = $Text::Wrap::columns; my $twbo = $Text::Wrap::break; my $twho = $Text::Wrap::huge; my $twso = $Text::Wrap::separator;
		$Text::Wrap::columns	= 74;
		$Text::Wrap::break	= ',';
		$Text::Wrap::huge	= 'overflow';
		$Text::Wrap::separator	= ",\n";
		my $nht = wrap("\t","\t",$results->{snames});
		$nht = "\t$nht" if ($nht !~ /^\t/);
		$namehead = ";\n$nht";
		$Text::Wrap::columns = $twco; $Text::Wrap::break = $twbo; $Text::Wrap::huge = $twho; $Text::Wrap::separator = $twso;
	} elsif ($results->{snames}) {
		$namehead = '; '.$results->{snames};
	}
	my @basehead = (sprintf('%03.1f',$results->{hits}));
	push @basehead, @{$spampass} if ($spampass && @{$spampass});
	return sprintf('%s%s',join(', ',@basehead),$namehead);
}

sub spamassassin_header {
	my ($results,$fmt) = @_;
	my @hdr1 = ();
	push @hdr1, $results->{sa_version}.'/'.$results->{sa_subversion} if ($results->{sa_version} || $results->{sa_subversion});
	push @hdr1, 'Score: '.$results->{sa_score} if ($results->{sa_score});
	push @hdr1, 'AWL: '.$results->{sax_awl} if ($results->{sax_awl});
	push @hdr1, 'Languages: '.$results->{sa_languages} if ($results->{sa_languages});
	push @hdr1, 'Learned: '.$results->{learned} if ($results->{learned});
	push @hdr1, 'Bayes: '.$results->{sa_bayes} if ($results->{sa_bayes});
	my @hdr = ();
	push @hdr, join('; ',@hdr1) if (@hdr1);
	push @hdr, $results->{sa_tokensummary} if ($results->{sa_tokensummary} && $results->{sa_tokensummary} !~ /^\s*Bayes not run.?\s*$/i);
	push @hdr, 'Ham tokens: '.mqp($results->{sa_hammytokens}) if ($results->{sa_hammytokens} && $results->{sa_hammytokens} !~ /^\s*Tokens not available.?\s*$/i);
	push @hdr, 'Spam tokens: '.mqp($results->{sa_spammytokens}) if ($results->{sa_spammytokens} && $results->{sa_hammytokens} !~ /^\s*Tokens not available.?\s*$/i);
	push @hdr, 'VirScan: '.mqp($results->{sah_virus}) if ($results->{sah_virus} && lc($results->{sah_virus}) ne 'no');
	@hdr1 = ();
	push @hdr1, sprintf('%uc %uw',$results->{sa_extracttextchars},$results->{sa_extracttextwords}) if ($results->{sa_extracttextchars});
	push @hdr1, sprintf('<%s>',$results->{sa_extracttextflags}) if ($results->{sa_extracttextflags});
	push @hdr1, sprintf('[%s]',$results->{sa_extracttexttools}) if ($results->{sa_extracttexttools});
	push @hdr, join(' ','Extracted:',@hdr1) if (@hdr1);
	return '-' unless (@hdr);
	return join("\n\t",@hdr);
}

sub spamassassin_report {
	my ($results,$type) = @_;
	#debug_log(0,'spamassassin_report');
	return '' unless (defined($results) && @{$results->{results}});
	my @results = sort { $a->[0] <=> $b->[0] } @{$results->{results}};
	my $tit = sprintf('Spam test results (%u hits, %05.3f points)',scalar @results,$results->{hits});
	debug_log(3,'spamassassin_report %s %u %s',$type,scalar @results,$tit);
	if ($type =~ /^[Hh]/ && load_modules('HTML::Entities')) {
		#debug_log(0,'spamassassin_report H');
		my $tab = "<table border=1 cellpadding=1><caption>$tit</caption><tr valign=\"baseline\"><th>Score</th><th>Rule</th><th>Description</th></tr>";
		for (my $i=0;$i<@results;$i++) {
			$results[$i]->[1] =~ s/[\r\n]+//gs;
			$results[$i]->[2] =~ s/^[\r\n]+//s;
			$results[$i]->[2] =~ s/[\r\n]+$//s;
			$tab .= sprintf('<tr valign="top" class="%s"><td align="right">%03.1f</td><td align="left">%s</td><td align="left">%s</td></tr>',
				,$i%2?'even':'odd',$results[$i]->[0],
				HTML::Entities::encode_entities($results[$i]->[1]),
				HTML::Entities::encode_entities($results[$i]->[2]),
			);
		}
		$tab =~ s/[\r\n]+/<br>/gs;
		$tab .= "</table>\n";
		#debug_log(0,'spamassassin_report H %s',$tab);
		return $tab;
	}
	#debug_log(0,'spamassassin_report ?');
	return '' unless (load_modules('Text::ASCIITable'));
	#debug_log(0,'spamassassin_report A');
	my $tab = Text::ASCIITable->new();
	return '' unless ($tab);
	#debug_log(0,'spamassassin_report T');
	$tab->setCols('Score','Rule','Description');
	$tab->setOptions({headingText=>$tit,drawRowLine=>1}) if ($type =~ /^[Ff]/);
	$tab->setOptions({hide_HeadRow=>1,hide_HeadLine=>1,hide_FirstLine=>1,hide_LastLine=>1,drawRowLine=>0}) if ($type =~ /^[Cc]/);
	foreach my $row (@results) {
		$row->[0] = sprintf('%05.3f',$row->[0]);
		#debug_log(0,'spamassassin_report row %s',join('|',@{$row}));
		$tab->addRow($row);
	}
	my $out = ($type =~ /^[Cc]/) ? $tab->draw(undef,undef,undef,[' ',' ',' ']) : $tab->draw;
	$out =~ s/[\r\n]+$/\n/s;
	#debug_log(0,'spamassassin_report %s %s',$type,$out);
	return $out;
}

sub spamassassin_info_report {
	my ($results,$spec,$pre) = @_;
	return '' unless (defined($results) && @{$results->{results}});
	$spec = '' unless (defined($spec));
	my $pre = 'SA ' unless (defined($pre));
	my $info = '';
	$info .= $pre.'Result: '.$results->{result}."\n" if (defined($results->{result}));
	$info .= $pre.'Score: '.$results->{hits}."\n" if (defined($results->{hits}));
	$info .= $pre.'Limit: '.$results->{req}."\n" if (defined($results->{req}));
	$info .= $pre.'Languages: '.$results->{sa_languages}."\n" if ($results->{sa_languages});
	$info .= $pre.'Learned: '.$results->{learned}."\n" if ($results->{learned});
	my @binfo = ();
	push @binfo, $results->{sa_bayes} if ($results->{sa_bayes});
	push @binfo, $results->{sa_tokensummary} if ($results->{sa_tokensummary});
	$info .= $pre.'Bayes: '.join('; ',@binfo)."\n" if (@binfo);
	$info .= $pre.'Ham tokens: '.$results->{sa_hammytokens}."\n" if ($results->{sa_hammytokens});
	$info .= $pre.'Spam tokens: '.$results->{sa_spammytokens}."\n" if ($results->{sa_spammytokens});
	$info .= $pre.'VirScan: '.$results->{sah_virus}."\n" if ($results->{sah_virus} && lc($results->{sah_virus}) ne 'no');
	$info .= $pre."Bounced: yes\n" if ($results->{bounced});
	$info .= $pre.'Names: '.join(', ',@{$results->{names}})."\n" if ($spec =~ /[Hh]/ && @{$results->{names}});
	$info .= $pre.'Extract count: '.sprintf('%u chars, %u words',$results->{sa_extracttextchars},$results->{sa_extracttextwords})."\n" if ($results->{sa_extracttextchars});
	$info .= $pre.'Extract flags: '.$results->{sa_extracttextflags}."\n" if ($results->{sa_extracttextflags});
	$info .= $pre.'Extract tools: '.$results->{sa_extracttexttools}."\n" if ($results->{sa_extracttexttools});
	$info .= $pre.'Extract types: '.$results->{sa_extracttexttypes}."\n" if ($results->{sa_extracttexttypes});
	$info .= $pre.'Extract extensions: '.$results->{sa_extracttextextensions}."\n" if ($results->{sa_extracttextextensions});
	return $info;
}

sub hiloscore_report {
	my ($entity,$report,$iposhead,$authresults) = @_;
	return unless ($hilo_entries);
	return if (defined($hilo_keep) && $hilo_keep<1);
	my $hits = defined($report->{hits}) ? $report->{hits} : 0;
	my $req = defined($report->{req}) ? $report->{req} : 0;
	my $names = defined($report->{names}) ? join(',',@{$report->{names}}) : '';
	return if ($names =~ /^(|.*,)GTUBE(|,.*)$/);
	if ($hilo_entries > 0) {
		my $km = $hilo_entries+$hilo_margin;
		my @tmp = ($hits);
		my $tmq = '';
		if ($hilo_keep) {
			$tmq = ' AND hilo_stamp>?';
			push @tmp, (time()-$hilo_keep);
		}
		my $cc = sql_select_one("SELECT count(hilo_score) FROM hiloscores WHERE hilo_score>?$tmq",@tmp);
		$cc = 0 unless ($cc);
		$cc = sql_select_one("SELECT count(hilo_score) FROM hiloscores WHERE hilo_score<?$tmq",@tmp) if ($cc > $km);
		$cc = 0 unless ($cc);
		return if ($cc > $km);
	}
	return unless (open(MF,'<','./INPUTMSG'));
	my $eml = '';
	while (my $l = <MF>) {
		$l =~ s/[\r\n]+//gs;
		$eml .= "$l\n";
		last if (length($l) > 1024*1024);
	}
	close(MF);
	debug_log(3,'hiloscore_report %03.1f %u',$hits,$cc);
	my $info = '';
	my $country = get_ip_location($RelayAddr);
	my $time = time_string(time_since_stamp());
	$info .= "MF Version: $FilterVersion\n";
	$info .= "MD Version: ".md_version()."\n";
	eval { $info .= "SA Version: ".Mail::SpamAssassin->Version()."\n"; };
	$info .= "\n";
	$info .= "Relay Addr: $RelayAddr\n" if ($RelayAddr);
	$info .= "Relay Host: $RelayHostname\n" if ($RelayHostname && $RelayHostname !~ /^\[$RelayAddr\]$/);
	$info .= "Relay Helo: $Helo\n" if ($Helo);
	$info .= "Relay Orig: $country\n" if ($country);
	$info .= "Relay OS:   $iposhead\n" if ($iposhead);
	$info .= "\n";
	$info .= "Mail From:  $Sender\n" if ($Sender);
	foreach my $rcpt (@Recipients) {
		$info .= "Rcpt To:    $rcpt\n" if ($rcpt);
	}
	if ($entity && $entity->head) {
		my $subj = $entity->head->get('Subject');
		if (defined($subj) && $subj !~ /^\s*$/) {
			$subj = mqpcs('utf8',decode_header($subj));
			$info .= "Subject:    $subj\n";
		}
	}
	if ($GreyListAction) {
		my $msgi = msgl_info_str($entity->head->get('Message-ID'),$Sender,@Recipients) if ($entity && $entity->head);
		$msgi = " ($msgi)" if ($msgi);
		$info .= "Grey List:  $GreyListAction$msgi\n";
	}
	if ($FoundSuspected || $FoundVirus) {
		$info .= "\n";
		$info .= "Scan Found: Virus\n" if ($FoundVirus);
		$info .= "Scan Found: Suspect\n" unless ($FoundVirus);
	}
	if (@$authresults) {
		$info .= "\n";
		foreach my $ari (@{$authresults}) {
			$info .= "Auth Check: $ari\n";
		}
	}
	$info .= "\n";
	$info .= spamassassin_info_report($report);
	$info .= "\n";
	$info .= "Msg Size:   ".(-s './INPUTMSG')."\n";
	$info .= "Check Time: $time\n" if ($time);
	sql_execute('INSERT INTO hiloscores (hilo_stamp,hilo_score,hilo_spam,hilo_names,hilo_report,hilo_info,hilo_message) VALUES (?,?,?,?,?,?,?)',
			time(),$hits,($hits>$req),$names,spamassassin_report($report,'compact'),$info,$eml);
}

# run spamassassin
my $nospamassassin = 0;
my %spamassassin_extra_hits = ();
my $forcespamcheck = 0;
my $wantsspamcheck = 0;
sub spamassassin_hit {
	my ($name,$score,$desc) = @_;
	return 0 unless ($name);
	$score = 0 unless ($score);
	debug_log(1,'spamassassin_hit %s %04.2f %s',$name,$score,$desc);
	$spamassassin_extra_hits{uc($name)} = {score=>$score,desc=>$desc,name=>$name};
	return scalar keys %spamassassin_extra_hits;
}
sub spamassassin_virus_hit {
	my $vals = antivirus_map_init_vals(@_);
	#debug_log(0,'savh %s',$vals->{vals}) unless ($vals->{clean});
	my $virmap = read_list_file('antivirus','\s*\@');
	return 0 unless ($virmap && @{$virmap});
	#debug_log(0,'spamassassin_virus_hit r %u',scalar @{$virmap}) unless ($vals->{clean});
	my $hits = 0;
	foreach my $ll (@{$virmap}) {
		my $line = $ll;
		debug_log(1,'spamassassin_virus_hit l %s',$ll) unless ($vals->{clean});
		next unless ($line =~ /^\s*\@\s*(.*?)[\r\n\s]*$/);
		my $l = $1;
		my $match = 0;
		my ($match,$l) = antivirus_map_check_line($1,$vals);
		next unless ($match);
		debug_log(1,'spamassassin_virus_hit m %s',$l);
		next unless ($l =~ /^\s*(=?)([-0-9.]*)(\s.*)?$/);
		my $scpre = $1;
		my $score = $2;
		$l = $3;
		$line =~ s/[\r\n]+//gs;
		debug_log(1,'spamassassin_virus_hit m %s',$line);
		my ($rule,$desc);
		if ($l && $l =~ /^\s*(\S+)(\s.*)?$/) {
			$rule = $1;
			$desc = $2;
			$desc =~ s/^\s+//s;
			$desc =~ s/\s+$//s;
		}
		$rule = $vals->{virusname} unless ($rule);
		$rule = 'VirusScanHit' unless ($rule);
		$desc = "Virus scanner found something." unless ($desc);
		$rule =~ s/[\s\/]/./g;
		debug_log(1,'spamassassin_virus_hit r %03.1f %s %s',$score,$rule,$desc);
		spamassassin_hit($rule,$score,$desc) unless ($score eq '-');
		$wantsspamcheck ++;
		$hits ++;
		last if ($scpre eq '=');
	}
	return $hits;
}
sub spamassassin_log_callback {
	my ($level,$msg) = @_;
	debug_log(0,'SALog: < %s %s',$level,$msg);
	if ($level =~ /warn/i) {
		$level = 'warning';
	} elsif ($level =~ /err/i) {
		$level = 'err';
	} elsif ($level =~ /info/i) {
		$level = 'info';
	} elsif ($level =~ /de?bu?g/i) {
		$level = 'debug';
	} else {
		$level = 'notice';
	}
	debug_log(0,'SALog: > "%s" "%s"',$level,$msg);
	md_syslog($level,"SA: $MsgIDs $msg");
}
sub init_spamassassin_module {
	unless ($nospamassassin || $Features{"SpamAssassin"}) {
		$Features{"SpamAssassin"} = load_modules('Mail::SpamAssassin ()') unless ($Features{"SpamAssassin"});
		$nospamassassin = 1 unless ($Features{"SpamAssassin"});
		if (!$nospamassassin && load_modules('Mail::SpamAssassin::Logger::Callback','Mail::SpamAssassin::Logger')) {
			Mail::SpamAssassin::Logger::Callback::SetCallback(\&spamassassin_log_callback);
			eval {
				Mail::SpamAssassin::Logger::remove('stderr');
				Mail::SpamAssassin::Logger::add(method=>'Callback');
				Mail::SpamAssassin::Logger::add_facilities('info');
			};
		}
	}
	return spam_assassin_init();
}
sub init_spamassassin_client {
	return load_modules('Mail::SpamAssassin::Client');
}
sub init_spamassassin {
	return ($spamdsocket || ($spamdhost && $spamdport))
		? init_spamassassin_client(@_)
		: init_spamassassin_module(@_);
}
my %saclient = ();
sub check_with_spamassassin_client {
	my ($call,$notdefault,$message) = @_;
	debug_log(5,'spam: SpamAssassin Client %s',$call);
	my $user = $notdefault ? $call : 'mdf';
	my $salarm;
	unless (defined($saclient{$user})) {
		return {errmsg=>'sc load error',errlev=>'f'} unless (load_modules('Mail::SpamAssassin::Client'));
		$salarm = 0;
		eval {
			$saclient{$user} = new Mail::SpamAssassin::Client({username=>$user,socketpath=>$spamdsocket,port=>$spamdport,host=>$spamdhost});
			local $SIG{ALRM} = sub { die "timeout\n" };
			$salarm = alarm($SATimeout?$SATimeout:15*60);
			$saclient{$user} = 0 unless ($saclient{$user} && $saclient{$user}->ping);
		};
		alarm($salarm) if (defined($salarm));
	}
	return {errmsg=>'sc connect failure',errlev=>'t'} unless ($saclient{$user});
	unless ($message) {
		return {errmsg=>'sc internal error',errlev=>'t'} unless (open(MSG,'<','./INPUTMSG'));
		my @msg = <MSG>;
		close(MSG);
		my @sah = ();
		push @sah, "Return-Path: $Sender\n";
		push @sah, split(/^/m,synthesize_received_header());
		push @sah, sprintf("Apparently-To: %s\n",join(", ",@Recipients));
		unshift @msg, @sah;
		my $msg = join('',@msg);
		$message = \$msg;
	}
	#my $tmpfn = sprintf('/tmp/%010u%010u',time(),$$);
	#if (open(TMPF,'>',"$tmpfn.eml")) {
	#	print TMPF $$message;
	#	close(TMPF);
	#	debug_log(0,'> %s',"$tmpfn.eml");
	#}
	debug_log(2,'spam: SpamAssassin Client process');
	my $sares;
	my $salarm = 0;
	eval {
		local $SIG{ALRM} = sub { die "timeout\n" };
		$salarm = alarm($SATimeout?$SATimeout:15*60);
		$sares = $saclient{$user}->process($$message);
	};
	alarm($salarm) if (defined($salarm));
	if ($@) {
		my $msg = $@;
		$msg =~ s/[\r\n\s]+$//s;
		$msg =~ s/^[\r\n\s]+//s;
		$msg =~ s/[\r\n]+$/; /s;
		$msg =~ s/\s+/ /;
		do_action_quarantine_entire_message('error',"Copied to quarantine due to SpamAssassin error.");
		return {errmsg=>"sc $msg",errlev=>'t'};
	}
	return {errmsg=>'no result',errlev=>'t'} unless ($sares && %{$sares});
	my %scanresults = ();
	$scanresults{hits} = $sares->{score};
	$scanresults{req} = $sares->{threshold};
	$sares->{message} =~ s/\r?\n\r?\n.*$//s;
	my $ch;
	foreach my $l (split/\r?\n/,$sares->{message}) {
		if ($l =~ /^\s+.*/) {
			next unless ($ch);
			$l =~ s/^\t// unless ($ch eq 'summary');
			$l = "$l\n" if ($ch eq 'summary');
			$scanresults{"sa_$ch"} .= $l;
			next;
		}
		$ch = 0;
		next unless ($l =~ /^X-Spam-([a-z]+):\s*(.*)$/i);
		next if (defined($scanresults{"sa_$1"}));
		$ch = lc($1);
		$l = $2;
		$l = "$l\n" if ($ch eq 'summary');
		$scanresults{"sa_$ch"} = $l;
	}
	$scanresults{sa_summary} =~ s/\s+(-?\d\.\d \S)/\n$1/gs;
	foreach my $k (keys %scanresults) {
		$scanresults{$k} =~ s/[ \t]+/ /gs if ($k =~ /^sa_/);
	}
	$scanresults{hits} = $scanresults{'sa_score'} if (defined($scanresults{'sa_score'}));
	$scanresults{req} = $scanresults{'sa_required'} if (defined($scanresults{'sa_required'}));
	$scanresults{'sah_clamav-result'} = $scanresults{'sa_virus'} if ($scanresults{'sa_virus'});
	$scanresults{saver} = $scanresults{'sa_version'} if (defined($scanresults{'sa_version'}));
	if (defined($scanresults{'sa_autolearn'})) {
		$scanresults{learned} = $scanresults{'sa_autolearn'};
		$scanresults{learned} = '' unless ($scanresults{learned} =~ /^(?:h|sp)am$/i);
	}
	#if (open(TMPF,'>',"$tmpfn.res")) {
	#	foreach my $k (keys %scanresults) {
	#		print TMPF "$k: $scanresults{$k}\n";
	#	}
	#	close(TMPF);
	#	debug_log(0,'> %s',"$tmpfn.res");
	#}
	delete $scanresults{errlev} if (exists $scanresults{errlev});
	return \%scanresults;
}
sub check_with_spamassassin_module {
	my ($call,$noautolearn,$message) = @_;
	debug_log(5,'spam: SpamAssassin Module %s',$call);
	my $sao = init_spamassassin_module();
	return {errmsg=>'sa init error',errlev=>'f'} unless ($sao);
	if ($message) {
		return {errmsg=>'sa internal error',errlev=>'t'} unless (open(MF,'>','./INPUTMSG.sax'));
		debug_log(1,'spam: displace INPUTMSG');
		print MF $$message;
		close(MF);
		return {errmsg=>'sa internal error',errlev=>'t'} unless (rename('./INPUTMSG','./INPUTMSG.real'));
		unless (rename('./INPUTMSG.sax','./INPUTMSG')) {
			rename('./INPUTMSG.real','./INPUTMSG');
			return {errmsg=>'sa internal error',errlev=>'t'};
		}
	}
	my %scanresults = (req=>$sao->{conf}->{required_score});
	my $orgautolearn;
	if ($noautolearn) {
		$orgautolearn = $sao->{conf}->{bayes_auto_learn};
		$sao->{conf}->{bayes_auto_learn} = 0;
	}
	debug_log(2,'spam: SpamAssassin Module run');
	my ($sastatus,$sam);
	my $salarm = 0;
	eval {
		local $SIG{ALRM} = sub { die "timeout\n" };
		$salarm = alarm($SATimeout?$SATimeout:15*60);
		$sam = spam_assassin_mail();
		$sastatus = $sao->check($sam) if ($sam);
	};
	alarm($salarm) if (defined($salarm));
	if ($@) {
		my $msg = $@;
		$msg =~ s/[\r\n\s]+$//s;
		$msg =~ s/^[\r\n\s]+//s;
		$msg =~ s/[\r\n]+$/; /s;
		$msg =~ s/\s+/ /;
		return {errmsg=>"sa $msg",errlev=>'t'};
	}
	if (defined($sastatus)) {
		$scanresults{hits} = $sastatus->get_hits;
		$scanresults{req} = $sastatus->get_required_hits();
		$scanresults{learned} = $sastatus->get_autolearn_status();
		$scanresults{learned} = '' unless ($scanresults{learned} =~ /^(?:h|sp)am$/i);
		foreach my $tga (('summary','score','version','subversion','tests','testsscores','languages','bayes','hammytokens:10','spammytokens:10','tokensummary')) {
			my $tag = $tga;
			my $val;
			if ($tag =~ /^(.+?):(.+)$/) {
				$tag = $1;
				my $par = $2;
				$val = $sastatus->get_tag($tag,$par);
			} else {
				$val = $sastatus->get_tag($tag);
			}
			next unless ($val);
			next if ($val =~ /\snot\s(run|available)\.?$/);
			$scanresults{"sa_$tag"} = $val if ($val);
		}
		foreach my $tga (('ClamAV-Result')) {
			my $val = $sastatus->get($tga);
			next unless (defined($val));
			next if ($val =~ /^[\s\r\n]*$/);
			my $tag = lc($tga);
			$scanresults{"sah_$tag"} = $val;
		}
		$sastatus->finish();
	}
	$scanresults{saver} = Mail::SpamAssassin->Version();
	$sam->finish() if ($sam);
	$sao->{conf}->{bayes_auto_learn} = $orgautolearn if (defined($orgautolearn));
	if ($message) {
		debug_log(1,'spam: restore INPUTMSG');
		unlink('./INPUTMSG');
		rename('./INPUTMSG.real','./INPUTMSG');
	}
	delete $scanresults{errlev} if (exists $scanresults{errlev});
	return \%scanresults;
}
sub check_with_spamassassin_ex {
	my ($call,$noautolearn,$message,$noassassin) = @_;
	return undef if ($noassassin && !%spamassassin_extra_hits);
	my $scanresults = $noassassin ? {} : ($spamdsocket || ($spamdhost && $spamdport))
		? check_with_spamassassin_client($call,$noautolearn,$message,$noassassin)
		: check_with_spamassassin_module($call,$noautolearn,$message,$noassassin);
	return {errmsg=>'internal error',errlev=>'f'} unless ($scanresults);
	debug_log(5,'spam: SpamAssassin done');
	$scanresults->{hits}	= 0	unless (defined($scanresults->{hits}));
	$scanresults->{req}	= 999	unless (defined($scanresults->{req}));
	$scanresults->{names}	= []	unless (defined($scanresults->{names}));
	$scanresults->{snames}	= ''	unless (defined($scanresults->{snames}));
	$scanresults->{saver}	= 0	unless (defined($scanresults->{saver}));
	$scanresults->{learned}	= ''	unless (defined($scanresults->{learned}));
	$scanresults->{results}	= []	unless (defined($scanresults->{results}));
	$scanresults->{stars}	= ''	unless (defined($scanresults->{stars}));
	my %scores = ();
	if ($scanresults->{sa_testsscores}) {
		foreach my $score (split(/,/,$scanresults->{sa_testsscores})) {
			if ($score =~ /^(.*)=(.*?)$/) {
				$scores{$1} = $2;
			}
		}
	}
	if ($scanresults->{sa_summary}) {
		$scanresults->{sa_summary} =~ s/\n\s+/ /gs;
		foreach my $l (split(/[\r\n]+/,$scanresults->{sa_summary})) {
			if ($l =~ /^\s*(-?\d+\.\d+)\s+(\S+)\s*(.*?)\s*$/) {
				my $score = $1;
				my $rule = $2;
				my $desc = $3;
				$score = $scores{$rule} if (defined($scores{$rule}));
				push @{$scanresults->{results}}, [$score,$rule,$desc];
				$scanresults->{results}->[$#{$scanresults->{results}}]->[2] = '' unless ($scanresults->{results}->[$#{$scanresults->{results}}]->[2]);
			} elsif ($l =~ /^\s*(\S+.*?)\s*$/) {
				$scanresults->{results}->[$#{$scanresults->{results}}]->[2] .= "\n" if ($scanresults->{results}->[$#{$scanresults->{results}}]->[2]);
				$scanresults->{results}->[$#{$scanresults->{results}}]->[2] .= $1;
			}
		}
	}
	$scanresults->{'sax_awl'} = $scores{'AWL'} if ($scores{'AWL'} && !defined($scanresults->{'sax_awl'}));
	push @{$scanresults->{names}}, split(/\s*,\s*/,$scanresults->{sa_tests}) if ($scanresults->{sa_tests});
	debug_log(2,'spam: SpamAssassin %05.3f %u %s',$scanresults->{hits},$scanresults->{req},$scanresults->{sa_testsscores});
	if (%spamassassin_extra_hits) {
		$scanresults->{hits} = 0 unless (defined($scanresults->{hits}));
		foreach my $sehi (values %spamassassin_extra_hits) {
			$scanresults->{hits} += $sehi->{score};
			push @{$scanresults->{names}}, $sehi->{name};
			push @{$scanresults->{results}}, [$sehi->{score},$sehi->{name},$sehi->{desc}];
			debug_log(1,'spam: extra hit %s %05.3f %s',$sehi->{name},$sehi->{score},$sehi->{desc});
		}
	}
	if ($scanresults->{hits} >= 40) {
		$scanresults->{stars} = "*" x 40;
	} elsif (int($scanresults->{hits}) > 0) {
		$scanresults->{stars} = "*" x int($scanresults->{hits});
	}
	$scanresults->{snames} = join(',',@{$scanresults->{names}}) if (@{$scanresults->{names}});
	$scanresults->{result} = ($scanresults->{hits} > $scanresults->{req}) ? 'spam' : 'ham';
	return $scanresults;
}
sub check_with_spamassassin {
	my ($noautolearn,$call) = @_;
	$call = 'check' unless ($call);
	return check_with_spamassassin_ex($call,$noautolearn);
}
sub check_with_spamassassin_bounced {
	my ($message) = @_;
	spamassassin_hit('SCORED_ON_BOUNCED',0,'Calculated on bounced message');
	my $scanresults = check_with_spamassassin_ex('bounce',1,$message);
	$scanresults->{bounced} = 1;
	delete $spamassassin_extra_hits{'SCORED_ON_BOUNCED'};
	return $scanresults;
}
sub check_without_spamassassin {
	spamassassin_hit('NO_SPAMASSASSIN',0,'SpamAssassin was not used');
	my $scanresults = check_with_spamassassin_ex('without',1,undef,1);
	$scanresults->{noassassin} = 1;
	delete $spamassassin_extra_hits{'NO_SPAMASSASSIN'};
	return $scanresults;
}

# read and parse a bounce
my $bounceo;
my $bouncef;
sub read_bounce_msg {
	my ($msgf) = @_;
	$msgf = './INPUTMSG' unless (defined($msgf));
	return $bounceo if ($bouncef && $bouncef eq $msgf);
	$bounceo = undef;
	$bouncef = $msgf;
	return $bounceo unless (load_modules('Mail::DeliveryStatus::BounceParser'));
	my $imbfh;
	return undef unless (open($imbfh,'<',$msgf));
	debug_log(5,'bounce: parse');
	$bounceo = eval { Mail::DeliveryStatus::BounceParser->new($imbfh); };
	close($imbfh);
	debug_log(5,'bounce: parsed %s',$bounceo ? 'ok' : 'fail');
	return $bounceo;
}
sub collect_bouncing_addresses {
	return 0 unless ($BncCollect);
	return 0 unless ($Sender =~ /^<?>?$/);
	my $bounce = read_bounce_msg();
	return 0 unless ($bounce && $bounce->is_bounce);
	my $bc = 0;
	foreach my $rep ($bounce->reports) {
		next unless ($rep);
		my $prob = $rep->get('std_reason');
		next unless ($prob && $prob !~ /no_problem/i);
		my $errm = $rep->get('reason');
		my $seve = 1;
		if ($prob eq 'user_unknown') {
			$seve = 4;
		} elsif ($prob eq 'domain_error') {
			$seve = 3;
		} elsif ($prob eq 'unknown') {
			if ($errm eq '550 unrouteable address') {
				$seve = 3;
			} else {
				$seve = 2
			}
		}
		next unless ($seve > 0);
		my $addr = lc($rep->get('email'));
		stats_log('bounce',$MsgIDs,[@Recipients],$Subject,$addr,$prob,$errm,$bounce->orig_message_id,$seve);
		my $now = time();
		my @cmds = ();
		push @cmds, ['INSERT OR IGNORE INTO bouncing (bnc_address,bnc_stamp) VALUES (?,?)',$addr,$now];
		push @cmds, $BncExpire ?
			    ['UPDATE bouncing SET bnc_severity=?,bnc_problem=?,bnc_reason=?,bnc_stamp=? WHERE bnc_address=? AND (bnc_severity<=? OR bnc_stamp<?)',$seve,$prob,$errm,$now,$addr,$seve,$now-$BncExpire] :
			    ['UPDATE bouncing SET bnc_severity=?,bnc_problem=?,bnc_reason=?,bnc_stamp=? WHERE bnc_address=? AND bnc_severity<=?',$seve,$prob,$errm,$now,$addr,$seve];
		push @cmds, ['UPDATE bouncing SET bnc_count=bnc_count+1,bnc_stamp=? WHERE bnc_address=?',$now,$addr];
		sql_execute_multi(@cmds);
		debug_log(3,'bounce: coll %s %s %s "%s"',$seve,$addr,$prob,$errm);
		my $hinf = "$seve <$addr> $prob ($errm)";
		$hinf =~ s/\r\n]+/; /gs;
		do_action_insert_header($entity,"X-Bounce",$hinf);
		$bc ++;
	}
	return $bc;
}
sub extract_bounced_msg {
	my ($bounce) = @_;
	return '' unless ($bounce);
	debug_log(4,'bounce: extract');
	return $bounce->orig_message->as_string if ($bounce->orig_message);
	return $bounce->orig_header->as_string."\n*\n" if ($bounce->orig_header);
	debug_log(4,'bounce: fake');
	my $orig = '';
	$orig .= 'To: '.join(',',$bounce->addresses)."\n" if ($bounce->addresses);
	$orig .= 'Message-Id: '.$bounce->orig_message_id."\n" if ($bounce->orig_message_id);
	foreach my $rep ($bounce->reports) {
		foreach my $tag ($rep->tags) {
			next if ($tag eq 'Raw');
			my @val = $rep->get($tag);
			foreach my $v (@val) {
				$tag = ucfirst(lc($tag));
				$tag =~ s/_/-/g;
				$tag =~ s/(-[a-z])/uc($1)/ge;
				$orig .= "X-Bounce-$tag: $v\n";
			}
		}
	}
	if ($orig) {
		$orig .= 'From: '.$Recipients[0]."\n";
		$orig .= "\n*\n";
	}
	return $orig;
}

# Report SA results.
sub spamassassin_result_report {
	my ($report) = @_;
	my $resrep = spamassassin_info_report($report,'h');
	push @result_reports, $resrep if ($resrep);
	$resrep = spamassassin_report($report,'fancy');
	push @result_reports, $resrep if ($resrep);
}
sub spamassassin_quarantine_report {
	my ($results) = @_;
	return unless (open OUTFILE, ">" . get_quarantine_dir() . "/SPAM_REPORT" );
	print OUTFILE spamassassin_info_report($results,'h','');
	print OUTFILE macros_text('AP');
	print OUTFILE "Report:\n";
	print OUTFILE spamassassin_report($results,'compact');
	close OUTFILE;
}

sub not_check_for_spam_wrtsl {
	my ($ds,$sst,$sml,$sms) = @_;
	return 1 unless ($sst);
	if ($sml) {
		my $lav = get_load_average();
		if ($lav > $sml) {
			md_syslog('info', "SpamAssassin scan of $ds mail disabled due to load average >= $sml!");
			return 1;
		}
	}
	if ($sms) {
		my $spv = get_swap_percentage();
		if ($spv > $sms) {
			md_syslog('info', "SpamAssassin scan of $ds mail disabled due to swap percentage >= $sms!");
			return 1;
		}
	}
	return 0;
}
sub not_check_for_spam {
	my ($entity,$verified) = @_;
	return 0 if ($is_result_query || $forcespamcheck);
	my $relay_host_name = defined($RelayHostname) ? $RelayHostname : '';
	$wantsspamcheck = 1 if (!$wantsspamcheck &&
				check_spamassassin_not_bypass($RelayAddr,$relay_host_name,$Sender,\@Recipients,$entity,make_spam_hash()));
	return 'internal' if (check_internal_whitelist($RelayAddr) && !check_any_relay_option($Helo,'outsider') &&
				not_check_for_spam_wrtsl('internal',$SAScanLocal,$SALocalMaxLoad,$SALocalMaxSwap) &&
				(!mail_is_outbound(@Recipients) || not_check_for_spam_wrtsl('outbound',$SAScanOutBound,$SAOutboundMaxLoad,$SAOutboundMaxSwap)));
	return 'white' if (check_recipients_white('spam',\@Recipients));
	return 'bypass' if (check_spamassassin_bypass($RelayAddr,$relay_host_name,$Sender,\@Recipients,$verified,$entity,make_spam_hash()));
	return 'auth' if (check_authenticated() &&
				not_check_for_spam_wrtsl('authenticated',$SAScanLocal,$SALocalMaxLoad,$SALocalMaxSwap) &&
				(!mail_is_outbound(@Recipients) || not_check_for_spam_wrtsl('outbound',$SAScanOutBound,$SAOutboundMaxLoad,$SAOutboundMaxSwap)));
	return 'history' if (!($wantsspamcheck || check_internal_whitelist($RelayAddr) || mail_is_outbound(@Recipients)) && check_no_spam($RelayAddr,$verified,0));
	return 0;
}

# Check if message is spam.
sub check_for_spam {
	my $entity = shift;
	my $verified = shift;
	my $ipos = shift;
	my $iposver = shift;
	my $iposhead = shift;
	my $ipcountry = shift;
	my $authresults = shift;
	$ipos = '' unless ($ipos);
	$iposver = '' unless ($iposver);
	my $noassassin = 0;
	my $gdbhostreset = 0;
	my $all_recipients = "";
	foreach my $currecipient(@Recipients) {
		$all_recipients .= "," if ($all_recipients ne "");
		$all_recipients .= $currecipient;
	}
	if ((-s './INPUTMSG' > $SASizeLimit) ||
	    (-s './INPUTMSG' > $mailtoobig)) {
		$noassassin = 'size';
		$forcespamcheck = 0;
	} elsif (check_spam_time_exceeded()) {
		$noassassin = 'time';
	}
	my $nospamcheck = not_check_for_spam($entity,$verified);
	# Spam checks if SpamAssassin is installed
	unless ($nospamcheck || $noassassin) {
		$noassassin = 'noassassin' unless (init_spamassassin());
	}
	#$nospamcheck = 0; #Force for debug...
	if ($nospamcheck) {
		debug_log(1,'nospamcheck %s %s',$nospamcheck,$noassassin) unless ($nospamcheck eq 'internal');
		push @result_reports, 'Not checked for SPAM.' if ($is_result_query);
		spam_log('-',[$nospamcheck,$noassassin],[$ipos,$iposver],$ipcountry);
		do_action_insert_header($entity,"X-Spam-Info","passed ($nospamcheck)") if (wants_extra_headers());
	} else {
		my $report;
		if ($noassassin && !$forcespamcheck) {
			debug_log(0,'noassassin %s',$noassassin);
			$report = check_without_spamassassin();
		} else {
			if ($is_result_query) {
				debug_log(1,'spam: running spamassassin query');
				$report = check_with_spamassassin(1);
			} else {
				debug_log(2,"spam: running spamassassin");
				if (check_internal_whitelist($RelayAddr)) {
					$report = check_with_spamassassin(1,'local');
				} else {
					$report = check_with_spamassassin();
				}
				if (defined($report) && $report->{hits} <= $report->{req} && $Sender =~ /^<?>?$/ && $report->{snames} =~ /ANY_BOUNCE_MESSAGE/) {
					my $bmsg = extract_bounced_msg(read_bounce_msg('./INPUTMSG'));
					if ($bmsg) {
						debug_log(2,"spam: running spamassassin bounce");
						my $breport = check_with_spamassassin_bounced(\$bmsg);
						if (defined($breport) && $breport->{hits} > $report->{hits}) {
							$report = $breport;
							debug_log(1,'spam: scored bounced');
						}
					}
				}
			}
		}
		if ($report && $report->{errlev} && !$is_result_query) {
			debug_log(0,'Spam check error: %s, %s',$report->{errlev},$report->{errmsg});
			if ($report->{errlev} eq 't') {
				do_action_tempfail($report->{errmsg});
			} elsif ($report->{errlev} eq 'r') {
				do_action_bounce($report->{errmsg});
			}
			return (1,0);
		}
		return (1,0) unless (defined($report) && defined($report->{hits}) && defined($report->{req}));
		spamassassin_result_report($report);
		unless ($is_result_query) {
			hiloscore_report($entity,$report,$iposhead,$authresults);
			unless (check_internal_whitelist($RelayAddr)) {
				# Report to releydb
				report_relay($RelayAddr,$verified,$report->{hits});
				# Report to nospamdb
				report_no_spam($RelayAddr,$verified,$report->{hits});
				# Reset greylist triplet(s)?
				if (defined($greylist) && $greylist && defined($gdb_reset) && $report->{hits} > $gdb_reset) {
					if ($gdb_reset_host) {
						debug_log(2,"check_for_spam, reset greylist for data $RelayAddr");
						greylist_reset($RelayAddr,"","");
					} else {
						foreach my $currecipient(@Recipients) {
							debug_log(2,"check_for_spam, reset greylist for data $Sender at $RelayAddr to $currecipient");
							greylist_reset($RelayAddr,$Sender,$currecipient);
						}
					}
				} elsif ($report->{hits} > $gdb_host_reset) {
					$gdbhostreset = 0;
					greylist_reset_host($RelayAddr);
				}
			}
			my $insider = (check_internal_whitelist($RelayAddr) && !check_any_relay_option($Helo,'outsider'));
			if ($insider && $SAReportLocal && $report->{hits} > ((defined($SAReportLocalScore) && $SAReportLocalScore =~ /^[+-]?\d+$/) ? $SAReportLocalScore : $report->{req})) {
				debug_log(0,'check_for_spam: report locally generated spam (%03.1f, %i, %i)',$report->{hits},$SAReportLocalScore,$report->{req});
				report_spam_result($entity,'Local Spam');
			}
			my @spampass = ();
			push @spampass, 'abuse', if (pass_abuse());
			push @spampass, 'local', if ($insider && $SAPassLocal);
			debug_log(0,'check_for_spam: spam pass (%s)',join(',',@spampass)) if (@spampass);
			if (($report->{hits} > $report->{req}) && !@spampass) {
				stats_log('reject',$MsgIDs,'spam',[$report->{hits},$report->{req}],'*');
				if ($report->{hits} < $report->{req}*2) {
					debug_log(3,"check_for_spam: quarantine message");
					do_action_quarantine_entire_message('stopped',"Message seems to be SPAM.");
					spamassassin_quarantine_report($report);
				}
				debug_log(3,"check_for_spam: bounce message");
				msgl_add($entity->head->get('Message-ID'),1,$Sender,@Recipients) if ($entity && $entity->head);
				remember_spam_hash(make_spam_hash(),$report) if ($spamdb && ($insider || $report->{hits} > $report->{req}*2));
				do_action_bounce(sprintf("Message seems to be spam (%03.1f/%i)",$report->{hits},$report->{req}));
			} else {
				do_action_insert_header($entity,"X-Spam-Scanned-By",spam_scanned_header($report,scalar @spampass));
				do_action_insert_header($entity,"X-Spam-Info",spam_info_header($report,\@spampass));
				#my $addsareport = 0;
				#my $addsaheader = 0;
				#foreach my $currecipient(@Recipients) {
				#	$addsareport ++ if ($currecipient =~ /^<?$WantsReports>?$/i);
				#	$addsaheader ++ if ($currecipient =~ /^<?$WantsExtraHeaders>?$/i);
				#}
				#if (defined(@new_recipients)) {
				#	foreach my $currecipient(@new_ecipients) {
				#		$addsareport ++ if ($currecipient =~ /^<?$WantsReports>?$/i);
				#		$addsaheader ++ if ($currecipient =~ /^<?$WantsExtraHeaders>?$/i);
				#	}
				#}
				my ($addsareport,$addsaheader) = wants_reports_or_headers();
				#debug_log(0,'check_for_spam sar=%u sah=%u',$addsareport,$addsaheader);
				do_action_insert_header($entity,"X-SpamAssassin",spamassassin_header($report)) if ($addsareport || $addsaheader);
				if ($report->{hits} > 0) {
					# We add a header which looks like this:
					# X-Spam-Score: 6.8 (******)
					#do_action_insert_or_change_header($entity,"X-Spam-Score", "$hits ($score)",1);
					do_action_insert_or_change_header($entity,"X-Spam-Score",sprintf('%03.1f (%s)',$report->{hits},$report->{stars},1)) unless ($insider);
					# If you find the SA report useful, add it, I guess...
					if ($addsareport) {
						$modhead{'Added SA report.'} ++;
						action_add_part($entity, "text/html", "-suggest",
							spamassassin_report($report,'html'),
							"SpamAssassinReport.html", "inline");
					}
				} else {
					# Delete any existing X-Spam-Score header?
					do_action_delete_header($entity,"X-Spam-Score") unless ($insider);
				}
				remember_spam_hash(make_spam_hash(),$report) if ($spamdb && $insider);
			}
			spam_log($report->{hits},$report->{req},$report->{names},[$ipos,$iposver,@spampass],$ipcountry,[$report->{learned},$report->{bounced},$report->{sax_awl}]);
		}
	}
	return ($nospamcheck,$gdbhostreset);
}

#***********************************************************************
# Authenticity verification stuff.
#***********************************************************************

my @verified_results = ();
sub set_verified_result {
	my $ent = shift;
	my $msg = shift;
	my $res = sprintf($msg,@_);
	push @verified_results, sprintf('%s:%s %s',$MyFilterHostName,$MsgIDs,mqp($res));
	return $res;
}
sub add_verified_results {
	my $ent = shift;
	my $c = 0;
	my %had = ();
	my $dad = (wants_extra_headers());
	foreach my $vh (@verified_results) {
		next if ($had{$vh});
		$had{$vh} = 1;
		do_action_insert_header($ent,'X-Auth-Result',$vh) if ($dad);
		$c ++;
	}
	@verified_results = ();
	return $c;
}

sub put_verified_header_ex {
	my $c = shift;
	my $h = shift;
	return $h unless (@_);
	$h =~ s/^\s*\((.*)\)\s*$/$1/s;
	my $x = '';
	if ($c eq ',' && $h =~ /^(.*?)(;.*)$/) {
		$x = $2;
		$h = $1;
	}
	my @h = ();
	foreach my $i (split(/$c/,$h)) {
		$i =~ s/^\s+//;
		$i =~ s/\s+$//;
		push @h, $i unless ($i eq '-');
	}
	while (@_) {
		my $a = shift @_;
		$a =~ s/[\r\n]+//gs;
		$a =~ s/^\s*\(\s*(.*?)\s*\)\s*$/$1/s;
		$a =~ s/^\s+//s;
		$a =~ s/\s+$//s;
		next unless ($a);
		next if (grep(/$a/i,@h));
		push @h, $a;
	}
	$c .= ' ' if ($c eq ';');
	return sprintf(' (%s%s)',join($c,@h),$x) if (@h);
	return " (-$x)" if ($x);
	return '';
}
sub set_verified_header_ex {
	return put_verified_header_ex(',',@_);
}
sub add_verified_header_ex {
	return put_verified_header_ex(';',@_);
}

sub find_out_pra {
	my ($entity) = @_;
	my $mod = $entity->head->modify(0);
	my %vals = ();
	foreach my $hl (@{$entity->head->header}) {
		#debug_log(0,'find_out_pra l "%s"',$hl);
		if ($hl =~ /^Resent-From:\s*(\S.*?)\s*$/si) {
			unless ($vals{'Resent-From'}) {
				$vals{'Resent-From'} = $1;
				debug_log(5,'find_out_pra h Resent-From="%s"',$1);
			}
		} elsif ($hl =~ /^(Received|Return-Path):/i) {
			if ($vals{'Resent-From'}) {
				debug_log(5,'find_out_pra h $1',$1);
				last;
			}
		} elsif ($hl =~ /^Resent-Sender:\s*(\S.*?)\s*$/si) {
			$vals{'Resent-Sender:'} = $1;
			debug_log(5,'find_out_pra h Resent-Sender="%s"',$1);
			last;
		} elsif ($hl =~ /^(Sender|From):\s*(\S.*?)\s*$/si) {
			my $hdr = ucfirst(lc($1));
			if ($vals{$hdr}) {
				$vals{"!$hdr"} = 1;
				debug_log(5,'find_out_pra h %s=!',$hdr);
			} else {
				$vals{$hdr} = $2;
				debug_log(5,'find_out_pra h %s="%s"',$hdr,$2);
			}
		}
	}
	$entity->head->modify($mod);
	return wantarray ? ('','') : '' unless (load_modules('Mail::Address'));
	foreach my $hdr (('Resent-Sender','Resent-From','Sender','From')) {
		next unless ($vals{$hdr});
		next if ($vals{"!$hdr"});
		debug_log(5,'find_out_pra a %s="%s"',$hdr,$vals{$hdr});
		my @a = Mail::Address->parse($vals{$hdr});
		last unless (@a);
		foreach my $a (@a) {
			next unless ($a && $a->address);
			debug_log(5,'find_out_pra r %s=%s',$hdr,$a->address);
			return wantarray ? ($hdr,$a->address) : $a->address;
		}
		last;
	}
	return wantarray ? ('','') : '';
}

sub get_verify_check_header_ex {
	my ($entity,$h) = @_;
	$h = '' unless ($h);
	return $h unless (defined($entity) && defined($entity->head));
	my %tf = ();
	foreach my $tag ($entity->head->tags) {
		if ($tag =~ /^(X-)?(list-.*|.*mailing-?list.*)$/i) {
			$tf{'list'} = 1;
		} elsif ($tag =~ /^(X-)?(.*newsgroups.*|path)$/i) {
			$tf{'news'} = 1;
		} elsif ($tag =~ /^(X-)?(Delivered-To|Envelope-To|BeenThere|Return-Path)$/i) {
			$tf{'forward'} = 1;
		}
	}
	my $val = $entity->head->get('Precedence');
	$tf{$val} = 1 if ($val && $val =~ /^(junk|bulk|list)[\s\r\n]*$/i);
	return set_verified_header_ex($h,keys %tf);
}

my $dkimsignature = undef;
sub verify_dk_dkim_signature_init {
	return $dkimsignature if ($dkimsignature);
	return undef if (-s './INPUTMSG' > $mailtoobig);
	#debug_log(0,'verify_dk_dkim_signature_init');
	return undef unless (load_modules('Mail::DKIM::Verifier'));
	$dkimsignature = Mail::DKIM::Verifier->new();
	unless ($dkimsignature) {
		debug_log(-1,'verify_dk_dkim_signature: create error%s',$tstex);
		return undef;
	}
	unless (open(DFH,'<','./INPUTMSG')) {
		debug_log(-1,'verify_dk_dkim_signature: open error%s',$tstex);
		return undef;
	}
	while (my $l = <DFH>) {
		$l =~ s/[\r\n]+//gs;
		eval { $dkimsignature->PRINT("$l\015\012"); };
	}
	close(DFH);
	eval { $dkimsignature->CLOSE; };
	return $dkimsignature;
}
sub verify_dk_dkim_signature_do {
	my ($ws) = @_;
	#debug_log(0,'verify_dk_dkim_signature_do: %s',$ws);
	my $dkv = verify_dk_dkim_signature_init();
	return (undef) unless ($dkv);
	my $dkr = 'error';
	my $dkd = 'error';
	eval { $dkr = $dkv->result; };
	eval { $dkd = $dkv->result_detail; };
	#debug_log(5,'verify_dk_dkim_signature_do: %s %s',$ws,$dkd);
	my $sig = ($dkr eq 'none') ? undef : $dkv->signature;
	my $dkp;
	my $dka;
	my $dkh;
	if ($ws eq 'dkim' && (!defined($sig) || $sig->isa('Mail::DKIM::Signature'))) {
		$dkh = 'from';
		$dka = $dkv->message_originator;
		eval { $dkp = $dkv->fetch_author_policy unless ($dkr eq 'pass'); };
	} elsif ($ws eq 'dk' && (!defined($sig) || $sig->isa('Mail::DKIM::DkSignature'))) {
		$dkh = 'sender';
		$dka = $dkv->message_sender;
		eval { $dkp = $dkv->fetch_sender_policy unless ($dkr eq 'pass'); };
	} else {
		return ($dkv,$dkr,$dkd);
	}
	return ($dkv,$dkr,$dkd,$ws,$dka?$dka->address:'',$dkh) unless ($dkp);
	my $flg = $dkp->flags;$flg = '' unless ($flg);
	my $plr = '';
	eval { $dkp->apply($dkv); };
	#debug_log(3,'verify_dk_dkim_signature_do: %s %s %s (%s)',$ws,$dkd,$plr,$dkp->policy);
	return ($dkv,$dkr,$dkd,$ws,$dka?$dka->address:'',$dkh,$dkp,$dkp->policy,$plr,$flg =~ /y/i?1:0,$dkp->is_implied_default_policy);
}
sub verify_dk_dkim_signature {
	my ($ws,$wss,$entity,$reslog,$checkthis) = @_;
	#debug_log(0,'verify_dk_dkim_signature: %s %s',$ws,$wss);
	return ('unchecked','',[]) unless ($checkthis);
	return ('unchecked','',[]) if (-s './INPUTMSG' > $mailtoobig);
	my ($dkv,$dkr,$dkd,$dkw,$dka,$dkh,$dkp,$pls,$plr,$plt,$pln) = verify_dk_dkim_signature_do($ws);
	return ('temperror','',[]) unless ($dkv);
	return ('nothing','',[]) unless ($dkw && $dkw eq $ws);
	return ('nothing','',[]) if ($pln && $ws ne 'dkim' && $dkr eq 'none');
	my @src = ();
	if ($dkh && $dka) {
		debug_log(5,'verify_dk_dkim_signature: %s %s %s',$ws,$dkh,$dka);
		push @src, {source=>"header.$dkh",address=>$dka};
	}
	my $tstex = get_verify_check_header_ex($entity);
	$tstex = set_verified_header_ex($tstex,'testing') if ($plt);
	if ($plr) {
		debug_log(3,'verify_dk_dkim_signature: %s %s %s%s',$ws,$dkr,$plr,$tstex);
		push @{$reslog}, set_verified_result($entity,'%s%s %s %s',$wss,$tstex,$plr,$dkd);
		return ('pass',$tstex,\@src,0,"$plr $dkd",$pls) if ($plr eq 'accept');
		return ('fail',$tstex,\@src,0,"$plr $dkd",$pls) if ($plr eq 'fail');
		if ($plr eq 'neutral') {
			return ('pass',$tstex,\@src,0,"$plr $dkd",$pls) if ($dkr eq 'pass');
			return ('permerror',$tstex,\@src,0,"$plr $dkd",$pls) if ($dkr eq 'invalid');
			return ('softfail',$tstex,\@src,0,"$plr $dkd",$pls) if ($dkr eq 'fail');
			return ('neutral',$tstex,\@src,0,"$plr $dkd",$pls);
		}
	} else {
		debug_log(3,'verify_dk_dkim_signature: %s %s%s',$ws,$dkr,$tstex);
		push @{$reslog}, set_verified_result($entity,'%s%s %s',$wss,$tstex,$dkd);
		return ('pass',$tstex,\@src,0,$dkd) if ($dkr eq 'pass');
		return ('fail',$tstex,\@src,0,$dkd) if ($dkr eq 'fail');
		return ('permerror',$tstex,\@src,0,$dkd) if ($dkr eq 'invalid');
		return ('neutral',$tstex,\@src,0,$dkd) if ($dkr eq 'none');
	}
	debug_log(-1,'verify_dk_dkim_signature: unhandled result(s) %s %s %s',$ws,$dkr,$plr);
	return ('temperror',$tstex,\@src);
}

sub verify_dk_signature {
	my ($entity,$reslog) = @_;
	return verify_dk_dkim_signature('dk','DomainKey',$entity,$reslog,$dkcheck);
}

sub verify_dkim_signature {
	my ($entity,$reslog) = @_;
	return verify_dk_dkim_signature('dkim','DKIM',$entity,$reslog,$dkimcheck);
}

# Seems to be PGP signed?
sub verify_pgp_signature_signed {
	my ($entity,$recurse) = @_;
	my $met = $entity->effective_type;
	if ($met eq 'multipart/signed') {
		my $p = $entity->head->mime_attr('content-type.protocol');
		if (defined($p) && $p =~ /^application\/pgp/i) {
			debug_log(3,'verify_pgp_signature_signed: MIME signature',$p);
			return 'm';
		} else {
			debug_log(3,'verify_pgp_signature_signed: no MIME signature (%s)',$p);
		}
	} elsif ($met eq 'text/plain') {
		my $bh = $entity->bodyhandle;
		if ($bh) {
			my $bio = $bh->open('r');
			if ($bio) {
				my $bbl = 0;
				my $ael = 0;
				my $ddl = 0;
				my $fpt = 0;
				my $olr = 0;
				my $slr = 0;
				while (my $l = $bio->getline) {
					if ($fpt == 0 && $l =~ /^-+BEGIN PGP SIGNED MESSAGE-+[\r\n]*$/) {
						$fpt ++;
					} elsif ($fpt == 1 && $l =~ /^-+BEGIN PGP SIGNATURE-+[\r\n]*$/) {
						$fpt ++;
					} elsif ($fpt == 2 && $l =~ /^-+END PGP SIGNATURE-+[\r\n]*$/) {
						$slr = 0;
						$olr = 0;
						$fpt ++;
					} elsif ($fpt == 0 || $fpt == 3) {
						$ddl ++ if ($l =~ /^-{5,5}.*?-{5,5}$/ || $l =~ /^_{5,5}.*?_{5,5}$/);
						if ($fpt == 0) {
							$bbl++;
						} else {
							$ael ++;
						}
						if ($l =~ /^[\r\n]*$/) {
							$slr ++;
							if ($slr > 99) {
								$fpt = 4;
								last;
							}
						} else {
							$olr ++;
							if ($olr > 29) {
								$fpt = 5;
								last;
							}
						}
					}
				}
				$bio->close;
				if ($fpt == 3) {
					debug_log(3,'verify_pgp_signature_signed: ASCII signature?');
					return  ($ddl || $bblk>10 || $ael>10) ? 't?' : 't';
				} else {
					debug_log(3,'verify_pgp_signature_signed: no ascii signature (%u)',$fpt);
				}
			} else {
				debug_log(-1,'verify_pgp_signature_signed: body open error');
			}
		} else {
			debug_log(-1,'verify_pgp_signature_signed: no body');
		}
	} elsif ($recurse && $met eq 'multipart/mixed') {
		debug_log(3,'verify_pgp_signature_signed: multipart (%s) <%s>',$met,$entity->mime_type);
		foreach my $part ($entity->parts) {
			debug_log(3,'verify_pgp_signature_signed: part (%s) <%s>',$met,$part->mime_type);
			my $signed = verify_pgp_signature_signed($part,0);
			return $signed if ($signed);
		}
	} else {
		debug_log(3,'verify_pgp_signature: other mime type (%s) <%s>',$met,$entity->mime_type);
	}
	return 0;
}

# Get a key from database or server and parse it.
sub verify_pgp_signature_encode_data {
	my $res = '';
	for (my $i=0;$i<@_;$i++) {
		my $x = $_[$i];
		$x =~ s/([^-_ .,;@<>a-zA-Z0-9])/sprintf('#%02x',ord($1))/ges;
		$res .= '/' if ($res);
		$res .= $x;
	}
	return $res;
}
sub verify_pgp_signature_decode_data {
	my ($str) = @_;
	my @res = ();
	foreach my $x (split(/\//,$str)) {
		$x =~ s/\#([\da-fA-F][\da-fA-F])/chr(hex($1))/ges;
		push @res, $x;
	}
	return @res;
}
sub verify_pgp_signature_ad_kl {
	my ($xla,$xha,$xln,$xhn,$xv,$xa) = @_;
	$xv =~ s/^[\s<]+//;
	$xv =~ s/[\s>]+$//;
	return unless ($xv);
	return if ($xa && $xv !~ /^\S+\@\S+$/);
	$xa = 1 if ($xv =~ /^\S+\@\S+$/);
	my $xc = lc($xv);
	if ($xa) {
		return if ($xha->{$xc});
		push @$xla, $xv;
		$xha->{$xc} = 1;
		return;
	}
	return if ($xhn->{$xc});
	push @$xln, $xv;
	$xhn->{$xc} = 1;
}
sub verify_pgp_signature_fetch_key {
	my ($keyid,$gk) = @_;
	return (0,'','unchecked','') unless (load_modules('LWP::UserAgent','HTTP::Request'));
	debug_log(2,'verify_pgp_signature_fetch_key: %s',$keyid);
	my $ua = LWP::UserAgent->new;
	$ua->agent(sprintf('MDF/%s/%s (MIMEDefang with local filter at %s)',md_version(),$FilterVersion,$MyFilterHostName));
	$ua->timeout(15);
	my $url = sprintf('http://%s:11371/pks/lookup?op=get&search=0x%s',$pgp_keyserver,$keyid);
	debug_log(2,'verify_pgp_signature_fetch_key: GET %s'.$url);
	my $req = HTTP::Request->new(GET=>$url);
	my $res = $ua->request($req);
	my $key = $res->content;
	return (1,'','temperror',sprintf('HTTP error: %s',$res->status_line)) unless ($key);
	return (1,'','temperror',sprintf('HTTP error: %s',$res->status_line)) if ($key =~ /^500 Can't connect to/i);
	if ($key =~ /(-----BEGIN PGP PUBLIC KEY BLOCK-----.*?-----END PGP PUBLIC KEY BLOCK-----)/s) {
		$key = $1;
		return (1,$key);
	}
	if ($key =~ /^<html>.*?<h1>(.*?)<\/h1>(.*?)<\/body>/s) {
		my $h = $1;
		my $b = $2;
		$b = "$h: $b" unless ($b =~ /$h/i);
		$b =~ s/[\t\r\n]+/ /gs;
		$b =~ s/\s+/ /g;
		unless ($gk) {
			if ($sqldbd eq 'M') {
				sql_execute('INSERT INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?) '.
					    'ON DUPLICATE KEY UPDATE pgp_stamp=VALUES(pgp_stamp),pgp_key=VALUES(pgp_key),pgp_person=VALUES(pgp_person),pgp_mail=VALUES(pgp_mail),pgp_note=VALUES(pgp_note)',
					    time(),$keyid,'#','','',verify_pgp_signature_encode_data($b));
			} else {
				sql_execute('REPLACE INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?)',
					    time(),$keyid,'#','','',verify_pgp_signature_encode_data($b));
			}
			return (1,'','softfail',"Key not found [$b]");
		}
		return (1,'');
	}
	unless ($gk) {
		if ($sqldbd eq 'M') {
			sql_execute('INSERT INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?) '.
				    'ON DUPLICATE KEY UPDATE pgp_stamp=VALUES(pgp_stamp),pgp_key=VALUES(pgp_key),pgp_person=VALUES(pgp_person),pgp_mail=VALUES(pgp_mail),pgp_note=VALUES(pgp_note)',
				    time(),$keyid,'#','','','');
		} else {
			sql_execute('REPLACE INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?)',
				    time(),$keyid,'#','','','');
		}
		return (1,'','softfail','Key not found');
	}
	return (1,'');
}
sub verify_pgp_signature_parse_uid {
	my ($xla,$xha,$xln,$xhn,$uid) = @_;
	my @al = ();
	if (get_addresses_from_value($uid,\@al,'all')) {
		foreach my $aa (@al) {
			verify_pgp_signature_ad_kl($xla,$xha,$xln,$xhn,$aa->{address},1);
			verify_pgp_signature_ad_kl($xla,$xha,$xln,$xhn,$aa->{name},0);
		}
		return;
	}
	if ($uid =~ /^\s*(.*?)\s*<(.*?)>\s*$/) {
		my $kp = $1;
		my $ma = $2;
		verify_pgp_signature_ad_kl($xla,$xha,$xln,$xhn,$ma,1);
		verify_pgp_signature_ad_kl($xla,$xha,$xln,$xhn,$kp,0);
	}
}
sub verify_pgp_signature_fetch_info {
	my ($keyid,$xla,$xha,$xln,$xhn) = @_;
	return (0,'') unless (load_modules('HTML::Entities'));
	debug_log(3,'verify_pgp_signature_fetch_info: %s',$keyid);
	my $ua = LWP::UserAgent->new;
	$ua->agent(sprintf('MDF/%s/%s (MIMEDefang with local filter at %s)',md_version(),$FilterVersion,$MyFilterHostName));
	$ua->timeout(15);
	my $url = sprintf('http://%s:11371/pks/lookup?op=index&search=0x%s',$pgp_keyserver,$keyid);
	my $req = HTTP::Request->new(GET=>$url);
	my $res = $ua->request($req);
	if ($res->is_success) {
		my $ki = $res->content;
		if ($ki && $ki =~ /<pre>(.*?)<\/pre>/s) {
			$ki = $1;
			$ki =~ s/<[^>]*>//gs;
			$ki = HTML::Entities::decode_entities($ki);
			$ki =~ s/\r\n/\n/gs;
			$ki =~ s/\r/\n/gs;
			my @ki = split(/\n+/,$ki);
			shift @ki if (@ki);
			my $keynote = shift @ki if (@ki);
			$keynote =~ s/\s+/ /;
			if ($keynote !~ /REVOKED/ && $keynote =~ /(\S+\s+\S+\s+\S+)\s+(.*)$/) {
				my $uid = $2;
				$keynote = $1;
				verify_pgp_signature_parse_uid($xla,$xha,$xln,$xhn,$uid);
			}
			while (my $x = shift @ki) {
				verify_pgp_signature_parse_uid($xla,$xha,$xln,$xhn,$x);
			}
			return (1,$keynote);
		}
	}
	return (0,'');
}
sub verify_pgp_signature_find_key {
	my ($id) = @_;
	my $keyid = unpack('H*',$id);
	debug_log(4,'verify_pgp_signature_find_key: %s',$keyid);
	my %keymail = ();
	my %keyperson = ();
	my @keymail = ();
	my @keyperson = ();
	my $keynote = '';
	my $cert;
	my $key;
	my $keyvals = sql_select_one_row('SELECT pgp_stamp,pgp_key,pgp_person,pgp_mail,pgp_note FROM pgpring WHERE pgp_id=?',$keyid);
	my $gk = ($keyvals && @$keyvals > 1 && $keyvals->[1]);
	$gk = 0 if ($keyvals->[1] eq '#' && $keyvals->[0] > time() - $pgp_expire_bad);
	unless ($gk && $keyvals->[0] > time() - $pgp_expire) {
		my ($ok,$fkr,$fkes);
		($ok,$key,$fkr,$fkes) = verify_pgp_signature_fetch_key($keyid,$gk);
  		return (0,$fkr,$fkes,$keyid,\@keymail,\@keyperson,$keynote,$cert) unless ($gk || ($ok && $key));
  	}
	my $savethis = 0;
	if ($key) {
		debug_log(2,'verify_pgp_signature_find_key: %s downloaded',$keyid);
		$savethis = 1;
	} elsif ($gk) {
		debug_log(2,'verify_pgp_signature_find_key: %s in ring',$keyid);
		($key) = verify_pgp_signature_decode_data($keyvals->[1]);
		@keyperson = verify_pgp_signature_decode_data($keyvals->[2]) if ($keyvals->[2]);
		@keymail = verify_pgp_signature_decode_data($keyvals->[3]) if ($keyvals->[3]);
		($keynote) = verify_pgp_signature_decode_data($keyvals->[4]) if ($keyvals->[4]);
	} elsif ($keyvals && @$keyvals > 1 && $keyvals->[1] && $keyvals->[1] eq '#') {
		if ($keyvals->[4]) {
			my ($b) = verify_pgp_signature_decode_data($keyvals->[4]) if ($keyvals->[4]);
			return (1,'softfail',"Key not found [$b]",$keyid,\@keymail,\@keyperson,$keynote,$cert) if ($b);
		}
		return (1,'softfail',"Key not found",$keyid,\@keymail,\@keyperson,$keynote,$cert);
	} else {
		debug_log(2,'verify_pgp_signature_find_key: %s not found',$keyid);
		return (0,'temperror','Key not found',$keyid,\@keymail,\@keyperson,$keynote,$cert);
	}
	my $ring = Crypt::OpenPGP::KeyRing->new(Data=>$key);
	return (0,'softfail',sprintf('Key error: %s',Crypt::OpenPGP::KeyRing->errstr),$keyid,\@keymail,\@keyperson,$keynote,$cert) unless ($ring);
	$cert = $ring->find_keyblock_by_index(0);
	if ($cert) {
		my $uid = $cert->primary_uid;
		verify_pgp_signature_parse_uid(\@keymail,\%keymail,\@keyperson,\%keyperson,$uid) if ($uid);
		$cert = $cert->signing_key;
	}
	if ($savethis) {
		my $ok;
		($ok,$keynote) = verify_pgp_signature_fetch_info($keyid,\@keymail,\%keymail,\@keyperson,\%keyperson);
		if ($sqldbd eq 'M') {
			sql_execute('INSERT INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?) '.
				    'ON DUPLICATE KEY UPDATE pgp_stamp=VALUES(pgp_stamp),pgp_key=VALUES(pgp_key),pgp_person=VALUES(pgp_person),pgp_mail=VALUES(pgp_mail),pgp_note=VALUES(pgp_note)',
				    time(),$keyid,verify_pgp_signature_encode_data($key),
				    verify_pgp_signature_encode_data(@keyperson),
				    verify_pgp_signature_encode_data(@keymail),
				    verify_pgp_signature_encode_data($keynote)
			);
		} else {
			sql_execute('REPLACE INTO pgpring (pgp_stamp,pgp_id,pgp_key,pgp_person,pgp_mail,pgp_note) VALUES (?,?,?,?,?,?)',
				    time(),$keyid,verify_pgp_signature_encode_data($key),
				    verify_pgp_signature_encode_data(@keyperson),
				    verify_pgp_signature_encode_data(@keymail),
				    verify_pgp_signature_encode_data($keynote),
			);
		}
	}
	return (0,'softfail','No key?',$keyid,\@keymail,\@keyperson,$keynote,$cert) unless ($cert);
	return (0,'unchecked','',$keyid,\@keymail,\@keyperson,$keynote,$cert);
}

# Verify a PGP signature
my $openpgp;
sub verify_pgp_signature_verify {
	my ($signature,$content) = @_;
	debug_log(5,'verify_pgp_signature_verify');
	$openpgp = Crypt::OpenPGP->new() unless ($openpgp);
	return (0,'temperror','Error allocating OpenPGP object!') unless ($openpgp);
	my ($data,$sig);
	my $msg = Crypt::OpenPGP::Message->new(Data=>$signature);
	return (0,'temperror',sprintf('Reading signature failed: %s',Crypt::OpenPGP::Message->errstr)) unless ($msg);
	my @pieces = $msg->pieces;
	if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') {
		$data = $pieces[0]->decompress;
		return (0,'temperror',sprintf('Decompression error: %s',$pieces[0]->errstr)) unless ($data);
		$msg = Crypt::OpenPGP::Message->new(Data=>$data);
		return (0,'temperror',sprintf('Reading decompressed data failed: %s',Crypt::OpenPGP::Message->errstr)) unless ($msg);
		@pieces = $msg->pieces;
	}
	if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig') {
		($data,$sig) = @pieces[1,2];
	} elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') {
		($sig,$data) = @pieces[0,1];
	} else {
		return (0,'temperror','SigFile contents are strange');
	}
	my ($fkd,$fkr,$fkes,$keyid,$keymail,$keyperson,$keynote,$cert) = verify_pgp_signature_find_key($sig->key_id);
	return ($fkd,$fkr,$fkes,$keyid,$keymail,$keyperson,$keynote) unless ($cert);
	my @modes = (0);
	@modes = ('b','t') unless ($data);
	for my $mode (@modes) {
		if ($mode) {
			$data = Crypt::OpenPGP::Plaintext->new(Mode=>$mode,Data=>$content);
			return (1,'softfail','Bad message content?',$keyid,$keymail,$keyperson,$keynote) unless ($data);
		}
		my($dgst,$found);
		for (1,0) {
			my $hok;
			eval {
				local $Crypt::OpenPGP::Globals::Trim_trailing_ws = $_;
				$dgst = $sig->hash_data($data);
				$hok = 1;
			};
			return (1,'temperror','Hashing error',$keyid,$keymail,$keyperson,$keynote) unless ($hok);
			return (1,'softfail',sprintf('Signature error: %s',$sig->errstr)) unless ($dgst);
			if (substr($dgst, 0, 2) eq $sig->{chk}) {
				$found++;
				last;
			}
		}
		if ($found) {
			my ($valid,$vok);
			eval {
				$valid = $cert->key->public_key->verify($sig,$dgst);
				$vok = 1;
			};
			return (1,'temperror','Verification error',$keyid,$keymail,$keyperson,$keynote) unless ($vok);
			return (1,'fail','Bad signature',$keyid,$keymail,$keyperson,$keynote,$openpgp->errstr) unless ($valid);
			return (1,'pass','Good signature',$keyid,$keymail,$keyperson,$keynote,$openpgp->errstr);
		}
	}
	return (1,'fail','Message hash does not match signature checkbytes',$keyid,$keymail,$keyperson,$keynote);
}

# Decode a PGP signed message part
sub verify_pgp_signature_decode_part {
	my ($partbody,$parthead) = @_;
	debug_log(5,'verify_pgp_signature_decode_part');
	my $head;
	my $body = '';
	if ($parthead) {
		$head = new MIME::Head($parthead);
		$body = $$partbody;
	} else {
		if ($$partbody =~ /^(.*?\n)\n(.*)$/s) {
			$head = $1;
			$body = $2;
		} else {
			$head = $$partbody;
		}
		my @head = split(/\n/,$head);
		$head = new MIME::Head(\@head);
	}
	my $mt = lc($head->mime_type);
	my $ct = lc($head->mime_encoding);
	if ($ct eq 'base64') {
		$body = decode_base64($body);
	} elsif ($ct eq 'quoted-printable') {
		$body = decode_qp($body);
	}
	return ($mt,$body);
}

# Verify PGP signed mail?
sub verify_pgp_signature {
	#return 0;
	my ($entity,$reslog) = @_;
	my @src = ();
	return ('unchecked','',\@src) unless (defined($pgpcheck) && $pgpcheck);
	return ('unchecked','',\@src) unless (defined($entity) && defined($entity->head));
	return ('unchecked','',\@src) if (-s './INPUTMSG' > $mailtoobig);
	my $st = verify_pgp_signature_signed($entity,1);
	return ('unchecked','',\@src) unless ($st);
	return ('unchecked','',\@src) unless (load_modules('MIME::Head','MIME::QuotedPrint','MIME::Base64'));
	return ('unchecked','',\@src) unless (load_modules('Crypt::OpenPGP','Crypt::OpenPGP::Message','Crypt::OpenPGP::KeyRing','Crypt::OpenPGP::Plaintext'));
	debug_log(5,'verify_pgp_signature: %s',$st);
	my $ex = get_verify_check_header_ex($entity);
	unless (open(DFH,'<','./INPUTMSG')) {
		debug_log(-1,'verify_pgp_signature: open error');
		return ('temperror',$ex,\@src);
	}
	my @head = ();
	my $msg = '';
	while (my $l = <DFH>) {
		$l =~ s/[\r\n]+//gs;
		last if ($l eq '');
		push @head, "$l\n";
	}
	while (my $l = <DFH>) {
		$l =~ s/[\r\n]+//gs;
		$msg .= "$l\n";
	}
	close(DFH);
	my $head = new MIME::Head(\@head);
	unless (@head && $msg && $head) {
		debug_log(-1,'verify_pgp_signature: bad input message');
		return ('temperror',$ex,\@src);
	}
	my ($dv,$vr,$rs,$kid,$kml,$kprs,$kxn,$es);
	if ($st =~ /^m/) {
		my $bnd = $head->mime_attr('content-type.boundary');
		my $alg = $head->mime_attr('content-type.micalg');
		$bnd =~ s/([^_a-zA-Z0-9])/\\$1/gs;
		$alg =~ s/^pgp-//;
		$msg =~ s/\n--$bnd--\n.*$/\n/s;
		$msg =~ s/^(|.*?\n)--$bnd\n//s;
		my @parts = split(/\n--$bnd\n/,$msg);
		$msg = '';
		unless (@parts) {
			debug_log(-1,'verify_pgp_signature: no parts in input message');
			return ('temperror',$ex,\@src);
		}
		while ($#parts > 1) { pop @parts; }
		my ($smt,$sig) = verify_pgp_signature_decode_part(\$parts[1]);
		unless ($smt =~ /^application\/pgp/) {
			debug_log(-1,'verify_pgp_signature: not PGP signed (%s)',$smt);
			return ('unchecked',$ex,\@src);
		}
		$parts[0] =~ s/\n/\r\n/gs;
		($dv,$vr,$rs,$kid,$kml,$kprs,$kxn,$es) = verify_pgp_signature_verify($sig,$parts[0]);
	} elsif ($st =~ /^t/) {
		my $smt;
		my ($smt,$msg) = verify_pgp_signature_decode_part(\$msg,\@head);
		($dv,$vr,$rs,$kid,$kml,$kprs,$kxn,$es) = verify_pgp_signature_verify($msg);
	} else {
		debug_log(-1,'verify_pgp_signature: strange message type');
		return ('unchecked',$ex,\@src);
	}
	$ex = set_verified_header_ex($ex,'ambiguous') if ($st =~ /\?/);
	$ex = set_verified_header_ex($ex,'revoked') if ($kxn =~ /REVOKED/);
	debug_log(0,'verify_pgp_signature: ex="%s"',$ex);
	$rs =~ s/[\r\n]$/ /gs; $rs =~ s/\s+/ /g; $rs =~ s/\s+$//; $rs =~ s/^\s+//;
	unless ($dv) {
		debug_log(-1,'verify_pgp_signature: %s',$rs);
		return ($vr,$ex,\@src);
	}
	debug_log(4,'verify_pgp_signature: %s',$rs) if ($rs);
	if ($kml && @$kml) {
		foreach my $ma (@$kml) {
			push @src, {source=>'key.emailaddress',address=>$ma};
		}
	}
	if ($kid && !@src) {
		push @src, {source=>'signature.keyid',address=>$kid};
	}
	if ($kml && @$kprs) {
		foreach my $ma (@$kprs) {
			push @src, {source=>'key.person',display=>$ma};
		}
	}
	$rs = '' unless ($rs);
	$rs = " ($rs)" if ($rs);
	if ($vr eq 'pass' || $vr eq 'ok') {
		push @{$reslog}, set_verified_result($entity,'PGP%s verified%s',$ex,$rs);
		$vr = 'accept' if ($kxn =~ /REVOKED/);
	} elsif ($vr eq 'fail') {
		push @{$reslog}, set_verified_result($entity,'PGP%s bad%s',$ex,$rs);
	} elsif ($vr eq 'softfail') {
		push @{$reslog}, set_verified_result($entity,'PGP%s unverified%s',$ex,$rs);
	} else {
		push @{$reslog}, set_verified_result($entity,'PGP%s unknown%s',$ex,$rs);
	}
	return ($vr,$ex,\@src,0,$rs);
}

my $spfserver;
sub verify_spf_identity {
	#return 0;
	my ($entity,$reslog,$scope,$source,$identity,$to) = @_;
	my @src = ();
	push @src, {source=>$source,address=>$identity};
	return (wantarray ? ('unchecked','',\@src) : 0) unless ($spfcheck);
	$identity = address_strip_nc($identity);
	return (wantarray ? ('unchecked','',\@src) : 0) unless ($identity);
	return (wantarray ? ('unchecked','',\@src) : 0) unless (load_modules('Mail::SPF'));
	debug_log(7,'verify_spf_identity: %s=%s',$scope,$identity);
	my $ex = get_verify_check_header_ex($entity);
	$spfserver = Mail::SPF::Server->new(
		hostname			=> $MyFilterHostName,
		dns_resolver			=> get_resolver($to?$to:10),
		default_authority_explanation	=> '',
	) unless ($spfserver);
	unless ($spfserver) {
		debug_log(-1,'verify_spf_identity server errror');
		return (wantarray ? ('temperror',$ex,\@src) : 0);
	}
	my $req = Mail::SPF::Request->new(
		scope		=> $scope,
		identity	=> $identity,
		ip_address	=> $RelayAddr,
		helo_identity	=> address_strip_nc($Helo),
	);
	unless ($req) {
		debug_log(-1,'verify_spf_identity query errror');
		return (wantarray ? ('temperror',$ex,\@src) : 0);
	}
	my $res = $spfserver->process($req);
	unless ($req) {
		debug_log(-1,'verify_spf_identity result errror');
		return (wantarray ? ('temperror',$ex,\@src) : 0);
	}
	my $spfr = $res->code;
	my $spfa = ($spfr eq 'fail' && $res->authority_explanation) ? $res->authority_explanation : '';
	my $spfl = $res->local_explanation;
	my $spft = $res->text;
	if ($spfa) {
		debug_log(0,,'verify_spf_identity: a %s=%s %s ae: %s',$scope,$identity,$spfr,$spfa) ;
		debug_log(0,,'verify_spf_identity: l %s=%s %s ae: %s',$scope,$identity,$spfr,$spfl);
		debug_log(0,,'verify_spf_identity: t %s=%s %s ae: %s',$scope,$identity,$spfr,$spft);
	}
	$spfl = $spfa if ($spfa || !$spfl);
	#debug_log(0,'verify_spf_identity: %s=%s%s "%s" "%s" "%s" "%s"',$scope,$identity,$ex,$spfr,$spft,$spfl,$spfa);
	#debug_log(0,'verify_spf_identity: 1 "%s" "%s"',$spft,$spfl);
	$spfl =~ s/$spft//gsi;
	#debug_log(0,'verify_spf_identity: 2 "%s" "%s"',$spft,$spfl);
	$spfl =~ s/\s+/ /gs;
	$spfl =~ s/\(\s*\)//g;
	$spfl =~ s/\s+$//;
	$spfl =~ s/^\s+//;
	$spfl = '' if ($spfl =~ /^\S+:\s*$/);
	#debug_log(0,'verify_spf_identity: 3 "%s" "%s"',$spft,$spfl);
	#debug_log(0,'verify_spf_identity: %s=%s%s "%s" "%s" "%s" "%s"',$scope,$identity,$ex,$spfr,$spft,$spfl,$spfa);
	if (lc($spfr) eq 'none') {
		#debug_log(0,'verify_spf_identity: none %s %s %s',$scope,$source,$identity);
		$spfr = ($scope eq 'mfrom') ? 'neutral' : 'nothing';
	}
	$spfr = 'temperror' unless ($spfr =~ /^(?:pass|(?:soft)?fail|neutral|nothing|(?:temp|perm)error)$/i);
	debug_log(7,'verify_spf_identity: %s=%s%s "%s"',$scope,$identity,$ex,$spfr);
	if ($entity) {
		#debug_log(0,'verify_spf_identity: (...,...,"s%","%s","%s","%s")',$ex,$spfr,$spfc,$spft);
		my $spfc = "$spfl; $spft";
		$spfc =~ s/^\s*;\s*//;
		$spfc =~ s/\s*;\s*$//;
		$spfc = " ($spfc)" if ($spfc);
		my $spfe = set_verified_header_ex($ex,$scope);
		push @{$reslog}, set_verified_result($entity,'SPF%s %s%s',$spfe,$spfr,$spfc) unless ($spfr eq 'nothing');
		if ($res->code ne 'none' && wants_extra_headers()) {
			my $hdr = $res->received_spf_header;
			if ($hdr =~ /^(Received-SPF): (.+)$/) { do_action_insert_header($entity,$1,$2); }
		}
	}
	#debug_log(0,'verify_spf_identity: ("%s","%s",[...],0,"%s")',$spfr,$ex,$spft);
	return (wantarray ? ($spfr,$ex,\@src,0,$scope,$spft) : ($spfr eq 'fail') ? -1 : ($spfr eq 'pass') ? 1 : 0);
}
sub verify_spf_mfrom {
	my ($entity,$reslog,$to) = @_;
	return verify_spf_identity($entity,$reslog,'mfrom','smtp.mail',$Sender,$to);
}
sub check_spf_mfrom {
	my ($identity,$to) = @_;
	return scalar verify_spf_identity(undef,undef,'mfrom','smtp.mail',$identity,$to);
}
sub verify_spf_helo {
	my ($entity,$reslog,$to) = @_;
	return verify_spf_identity($entity,$reslog,'helo','smtp.helo',$Helo,$to);
}
sub check_spf_helo {
	my ($identity,$to) = @_;
	return scalar verify_spf_identity(undef,undef,'helo','smtp.helo',$identity,$to);
}
sub verify_spf_pra { # RFC 4407, not implemented yet...
	my ($entity,$reslog,$to) = @_;
	my ($header,$identity) = find_out_pra($entity);
	return verify_spf_identity($entity,$reslog,'pra',"mail.$header",$identity,$to);
}

sub verify_relay_network {
	my ($entity,$reslog) = @_;
	my @src = ();
	return ('ignore','',\@src) if (check_any_relay_option($Helo,'outsider'));
	#debug_log(0,'verify_relay_network %s',$AuthPassNets);
	return ('ignore','',\@src) unless (check_auth_pass_nets($RelayAddr));
	my $too = 0;
	foreach my $rcpt (@Recipients) {
		$too =1 if ($rcpt =~ /^.+\@$OurDomains>?$/i);
		last if ($too);
		my $hst = storing_server($rcpt);
		$too = 1 if ($hst =~ /^$LocalNets$/i);
		last if ($too);
		$too = 1 if (check_black_nets($hst));
		last if ($too);
	}
	return ('ignore','',\@src) unless ($too);
	push @src, {source=>'smtp.relay',address=>$RelayAddr,display=>'AuthPass'};
	push @{$reslog}, set_verified_result($entity,'Relay trusted');
	return ('ok','',\@src);
}

sub verify_authenticated {
	my ($entity,$reslog) = @_;
	my @src = ();
	my $ae = check_authenticated();
	return ('ignore','',\@src) unless ($ae);
	push @src, {source=>'smtp.auth',address=>$ae};
	push @{$reslog}, set_verified_result($entity,'User authenticated');
	return ('ok','',\@src);
}

# Seems to be S/MIME signed?
sub verify_smime_signature_signed {
	my ($entity,$recurse) = @_;
	my $met = $entity->effective_type;
	if ($met eq 'multipart/signed') {
		my $p = $entity->head->mime_attr('content-type.protocol');
		if (defined($p) && $p =~ /^application\/(x-)?pkcs\d+/i) {
			debug_log(1,'verify_smime_signature_signed: MIME signature',$p);
			return 1;
		} else {
			debug_log(3,'verify_smime_signature_signed: no MIME signature (%s)',$p);
		}
	} elsif ($met =~ /^application\/(x-)?pkcs\d+(-mime)?$/i) {
		debug_log(1,'verify_smime_signature_signed: MIME part',$p);
		return 1;
	} elsif ($met =~ /^application\/octet-stream$/i) {
		foreach my $hn (('Content-Type.filename','Content-Type.name','Content-Disposition.filename','Content-Disposition.name')) {
			my $hv = $entity->head->mime_attr;
			return 1 if ($hv && $hv =~ /\.(p7m|p7s|aps|p7c|p10)$/i);
		}
	} elsif ($recurse && $met eq 'multipart/mixed') {
		debug_log(3,'verify_smime_signature_signed: multipart (%s) <%s>',$met,$entity->mime_type);
		foreach my $part ($entity->parts) {
			debug_log(3,'verify_smime_signature_signed: part (%s) <%s>',$met,$part->mime_type);
			my $signed = verify_smime_signature_signed($part,0);
			return $signed if ($signed);
		}
	} else {
		debug_log(3,'verify_smime_signature: other mime type (%s) <%s>',$met,$entity->mime_type);
	}
	return 0;
}

# Verify S/MIME signed mail?
my $openssl;
sub verify_smime_signature {
	#return 0;
	my ($entity,$reslog) = @_;
	my @src = ();
	return ('unchecked','',\@src) unless (defined($smimecheck) && $smimecheck);
	return ('unchecked','',\@src) unless (defined($entity) && defined($entity->head));
	return ('unchecked','',\@src) if (-s './INPUTMSG' > $mailtoobig);
	my $st = verify_smime_signature_signed($entity,1);
	return ('unchecked','',\@src) unless ($st);
	return ('unchecked','',\@src) unless (load_modules('File::Which','IPC::Run3'));
	debug_log(1,'verify_smime_signature: %s',$st);
	my $ex = get_verify_check_header_ex($entity);
	unless($openssl) {
		$openssl = which('openssl');
		unless ($openssl) {
			debug_log(-1,'verify_smime_signature: openssl not found in path');
			return ('temperror',$ex,\@src);
		}
	}
	my (@verout,$verres,$vererr,$siginf);
	my $verret = 'temperror';
	run3([$openssl,'smime','-verify','-in','./INPUTMSG','-signer','./SMIME_SIGNER'],\undef,\undef,\@verout);
	if (-f './SMIME_SIGNER') {
		my $sigerr;
		run3([$openssl,'x509','-in','./SMIME_SIGNER','-noout','-subject','-issuer'],\undef,\$siginf,\$sigerr);
		$siginf = '' if ($sigerr);
		unlink('./SMIME_SIGNER');
	}
	$verres = shift @verout;
	$verres =~ s/[\r\n]+//s;
	if ($verres eq 'Verification successful') {
		push @{$reslog}, set_verified_result($entity,'S/MIME%s verified',$ex);
		$verret = 'pass';
	}
	if (@verout) {
		$vererr = pop @verout;
		$vererr =~ s/[\r\n]+//s;
		my $verset = 'unknown';
		if ($vererr =~ /:((?:wrong|no|invalid) (?:content|mime) type):/) {
			$vererr = $1;
			$verret = 'unchecked';
			$verset = '';
		} elsif ($vererr =~ /:(certificate verify error):/) {
			my $ee = $1;
			if ($vererr =~ /(Verify error:)([ a-zA-Z]+)/) {
				$vererr = "$1 $2";
				$verret = 'softfail';
			} else {
				$vererr = $ee;
			}
			$verset = 'unverified';
		} elsif ($vererr =~ /:((?:signature|digest) failure):/) {
			$vererr = $1;
			$verret = 'fail';
			$verset = 'bad';
		} elsif ($vererr =~ /^[^:]+:[^:]+:[^:]+:[^:]+:[^:]+:([^:]+):/) {
			$vererr = $1;
		}
		$vererr =~ s/^[\s:]+//;
		$vererr =~ s/[\s:]+$//;
		if ($verset) {
			my $vertxt = '';
			if ($verres && $vererr) {
				$vertxt = " ($verres ($vererr))";
			} elsif ($verres) {
				$vertxt = " ($verres)";
			} elsif ($vererr) {
				$vertxt = " ($vererr)";
			}
			push @{$reslog}, set_verified_result($entity,'S/MIME%s %s%s',$ex,$verset,$vertxt);
		}
	}
	debug_log(1,'verify_smime_signature: %s %s (%s)',$verret,$verres,$vererr);
	foreach my $sigx (split(/[\r\n]+/,$siginf)) {
		if ($sigx =~ /^\s*([a-z]+)\s*=\s*\/(.*)$/) {
			my $sigy = $1;
			$sigx = $2;
			$sigx =~ s/(=[a-zA-Z]{1,10}:)\/\//$1\\\\/g;
			foreach my $ss (split(/\//,$sigx)) {
				if ($ss =~ /^(.*?)=(.*)$/i) {
					my $sigf = $1;
					my $sigv = $2;
					next if ($sigf =~ /^\s*$/ || $sigv =~ /^\s*$/);
					$sigv =~ s/^([a-zA-Z]{1,10}:)\\\\/$1\/\//g;
					debug_log(1,'verify_smime_signature: %s.%s=%s',$sigy,$sigf,$sigv);
					$sigf = lc($sigf);
					if ($sigf eq 'emailaddress') {
						push @src, {source=>"key.$sigy.$sigf",address=>$sigv};
					} elsif ($sigf eq 'cn') {
						push @src, {source=>"key.$sigy.name",display=>$sigv};
					}
				}
			}
		}
	}
	return ($verret,$ex,\@src,0,$vererr);
}

sub check_verified_check {
	my ($name,$failures,$results,$passed,$forged,$result,$tstex,$sources,$failex,@msgex) = @_;
	return 1 unless ($result);
	return 1 if ($result eq 'ignore');
	if ($sources) {
		foreach my $src (@$sources) {
			$src->{address} =~ s/^<//;
			$src->{address} =~ s/>$//;
			$src->{display} = $src->{address} unless (defined($src->{display}));
			debug_log(5,'check_verified_check: %s %s=%s (%s)',$name,$src->{source},$src->{address},$src->{display});
		}
	}
	#debug_log(0,'check_verified_check: %s %s',$name,$result);
	return 1 if ($result eq 'unchecked' || $result eq 'nothing');
	debug_log(3,'check_verified_check: %s %s%s',$name,$result,$tstex);
	if ($result eq 'fail') {
		$$failures .= ', ' if ($$failures);
		$$failures .= "$name$tstex";
		unless ($tstex && !$failex) {
			foreach my $src (@$sources) {
				#debug_log(0,'check_verified_check: forged %s:%s (%s)',$name,$src->{display},$src->{address});
				push @$forged, sprintf('%s:%s',$name,mqp($src->{display}));
			}
		}
	} elsif (($result eq 'pass' || $result eq 'ok') && $sources) {
		foreach my $src (@$sources) {
			next if ($src->{source} =~ /(issuer|author)/i);
			debug_log(5,'check_verified_check: passed %s:%s (%s)',$name,$src->{display},$src->{address});
			push @$passed, sprintf('%s:%s',$name,mqp($src->{display}));
		}
	}
	return 1 if ($result eq 'ok');
	$result = 'pass' if ($result eq 'accept');
	$name =~ s/[^-_a-zA-Z0-9]//;
	$name = "X-$name" unless ($name =~ /^(auth|dkim|domainkeys|senderid|spf)$/i);
	my $exex = add_verified_header_ex($tstex,$failex);
	foreach my $msgex (@msgex) {
		$exex = add_verified_header_ex($exex,$msgex);
	}
	my %ri = (
		check	=> $name,
		sources => $sources,
		result	=> "$result$exex",
	);
	push @$results, \%ri;
	return ($result ne 'fail' || ($tstex && !$failex));
}

sub will_verify {
	return 1 if ($AuthPassNets || $CanAuthenticate);
	return 0 if (check_internal_whitelist($RelayAddr));
	return 1 if ($dkcheck || $dkimcheck || $pgpcheck || $spfcheck || $smimecheck);
	return 0;
}

my $keptauthresult;
sub add_authentication_results {
	#return;
	my $ent = shift;
	my $results = shift;
	my $ah = '';
	foreach my $ar (@$results) {
		my $srs = '';
		foreach my $src (@{$ar->{sources}}) {
			next unless ($src);
			next unless ($src->{address});
			$srs .= sprintf(' %s=%s',$src->{source},mqp($src->{address}));
		}
		next unless ($srs);
		$ah .= sprintf(";\n\t%s=%s%s",$ar->{check},$ar->{result},$srs);
	}
	$ah .= ";\n\t$keptauthresult" if ($keptauthresult);
	do_action_insert_header($ent,'Authentication-Results',"$MyFilterHostName$ah") if ($ah);
}
sub list_authentication_failures {
	my $results = shift;
	my @ah = ();
	foreach my $ar (@$results) {
		next unless ($ar->{result} =~ /^fail/i);
		my $srs = '';
		foreach my $src (@{$ar->{sources}}) {
			next unless ($src);
			next unless ($src->{address});
			$srs .= sprintf(' %s=%s',$src->{source},mqp($src->{address}));
		}
		next unless ($srs);
		push @ah, sprintf('AuthFail: %s %s%s',$ar->{check},$ar->{result},$srs);
	}
	return @ah;
}

sub del_authentication_results {
	my ($entity,$justkeep) = @_;
	$keptauthresult = '';
	return 0 unless (defined($entity) && defined($entity->head));
	my $dc = 0;
	foreach my $hh ($entity->head->tags()) {
		#debug_log(0,'del_authentication_results: %s %s?',$MsgIDs,$hh);
		next unless ($hh =~ /^(Authentication-Results|X-Auth-[A-Z]+)$/i);
		#debug_log(0,'del_authentication_results: %s %s!',$MsgIDs,$hh);
		my @ahl = $entity->head->get($hh);
		next unless (@ahl);
		my $arhn = check_auth_pass_nets($RelayAddr) ? -1 : 0;
		for (my $i=$#ahl;$i>=0;$i--) {
			debug_log(7,'del_authentication_results: chk %s',$ahl[$i]);
			if ($ahl[$i] =~ /^\s*$MyFilterHostNames[;:\s]/i) {
				if ($hh =~ /^Authentication-Results$/i) {
					$arhn ++;
					unless ($arhn) {
						$keptauthresult = $ahl[$i];
						$keptauthresult =~ s/^\s*$MyFilterHostNames[;:\s]*//;
						$keptauthresult =~ s/^\s+//;
						$keptauthresult =~ s/\s+$//;
						next unless ($keptauthresult);
						debug_log(3,'del_authentication_results: keep "%s" "%s"',$ahl[$i],$keptauthresult);
						do_action_delete_header($entity,$hh,$i+1);
						next;
					}
				}
				next if ($justkeep);
				debug_log(3,'del_authentication_results: del %s',$ahl[$i]);
				do_action_delete_header($entity,$hh,$i+1);
				$dc ++;
			}
		}
	}
	return $dc;
}

sub clean_auth_passed {
	my $entity = shift;
	my @cap = ();
	my @doms = ();
	my @adom = ();
	my %adrs = ();
	my @adrs = ();
	my $wdom = 0;
	my %hdrs = (address_strip_opt($Sender)=>1);
	foreach my $ap (@_) {
		if ($ap =~ /^([^:]*):(.*)$/) {
			my $vp = $1;
			my $d = address_strip_opt($2);
			if ($vp =~ /^(Relay|Auth)$/i) {
				push @cap, $ap;
				debug_log(5,'clean_auth_passed: = %s',$ap);
				next;
			}
			debug_log(5,'clean_auth_passed: cr %s',$ap);
			if ($d =~ /^\S+\@\S+\.[a-z]+$/) {
				$adrs{$d} = 1;
				$d =~ s/^.*\@//;
				push @adom, $d;
			} elsif ($d =~ /^\S+\.[a-z]+$/ && $d !~ /\@/) {
				push @adom, $d;
				push @doms, $d;
			}
		} else {
			debug_log(5,'clean_auth_passed: n %s',$ap);
			return ();
		}
	}
	@adrs = keys %adrs;
	debug_log(3,'clean_auth_passed: d %s %s',join(',',@doms),join(',',@adrs));
	my @al = ();
	my $alc = get_addresses_from_header($entity,'From:Sender:Reply-To',\@al,'all');
	if (@alc) {
		my @ald;
		my $alac = 0;
		my $alao = 0;
		foreach my $aa (@al) {
			next unless ($aa->{address});
			my $aa = address_strip_opt($aa->{address});
			$hdrs{$aa} = 1;
			$alac ++;
			$alao ++ if ($adrs{$aa});
			push @ald, $aa->{domain};
		}
		unless (($alao || !@adrs) && ($alac == $alao || is_sub_domains(\@ald,\@adom))) {
			debug_log(5,'clean_auth_passed: nsd %s %s',join(',',@ald),join(',',@adom));
			return @cap;
		}
	}
	debug_log(3,'clean_auth_passed: a %s',join(',',keys %hdrs));
	foreach my $ap (@_) {
		if ($ap =~ /^([^:]*):(.*)$/) {
			my $vp = $1;
			my $a = $2;
			debug_log(5,'clean_auth_passed: ? %s %s',$vp,$a);
			next if ($vp =~ /^(Relay|Auth)$/i);
			debug_log(10,'clean_auth_passed: 1 %s',$ap);
			next unless ($a =~ /^.*\@\S+\.[a-zA-Z]+$/);
			debug_log(10,'clean_auth_passed: 2 %s',$ap);
			next unless ($hdrs{address_strip_opt($a)});
			#next if (@dom && !is_sub_domains([$a],\@dom));
			debug_log(5,'clean_auth_passed: = %s',$ap);
			push @cap, $ap;
		}
	}
	debug_log(3,'clean_auth_passed: e');
	return @cap;
}

sub add_hashcashes {
	#return 0;
	my ($entity) = @_;
	return 0 unless (defined($hashcash) && $hashcash);
	return 0 unless (check_internal_whitelist($RelayAddr));
	return 0 unless (defined($entity) && defined($entity->head));
	return 0 unless ($Sender =~ /\@$OurDomains>?$/i);
	return 0 unless (load_modules('Digest::Hashcash'));
	if ($hc_maxload && get_load_average() > $hc_maxload) {
		md_syslog('info', "Hashcash disabled due to load average >= $hc_maxload!");
		return 0;
	}
	if ($hc_maxswap && get_swap_percentage() > $hc_maxswap) {
		md_syslog('info', "Hashcash disabled due to swap percentage >= $hc_maxswap!");
		return 0;
	}
	my $hst = time();
	my %ah;
	get_addresses_from_header($entity,'To',\%ah);
	get_addresses_from_header($entity,'Cc',\%ah);
	my %aa;
	my @al = ();
	foreach my $a (@Recipients) {
		next if (address_is_local($a,1,1));
		my $aj = address_strip_nc($a);
		next unless ($aj);
		my $la = lc($aj);
		next if ($aa{$la});
		push @al, $aj if ($ah{$la});
		$aa{$la} = 1;
	}
	return 0 unless (@al);
	return 0 if (@al > $hc_maxrecipients);
	my $siz = $hc_size;
	unless ($siz) {
		eval { $siz = Digest::Hashcash::estimate_size($hc_worktime,5); };
		$siz = 20 unless ($siz);
	}
	debug_log(3,'add_hashcashes: %u %u %u',$#al+1,$siz,$hc_worktime);
	my $hc;
	eval { $hc = new Digest::Hashcash(size=>$siz,extension=>"host=$MyFilterHostName",uid=>$QueueID); };
	unless ($hc) {
		debug_log(-1,'add_hashcashes: create error');
		return 0;
	}
	my $c = 0;
	my $tt = time();
	foreach my $a (@al) {
		my $h;
		my $t = time();
		eval { $h = $hc->hash($a); };
		$t = time() - $t;
		unless ($h) {
			debug_log(-1,'add_hashcashes: hash error: %s',$a);
			return 0;
		}
		debug_log(3,'add_hashcashes: %u %u %s',$siz,$t,$h);
		do_action_insert_header($entity,'X-Hashcash',$h);
		$c ++;
		last if (time()-$hst>$hc_maxtime);
	}
	$tt = time() - $tt;
	debug_log(1,'add_hashcashes: %u %u %u',$siz,$tt,$c);
	return $c;
}

#***********************************************************************
# Return-path changing.
#***********************************************************************

sub gsnd_add {
	my ($a,$r) = @_;
	$a = address_strip($a);
	return 0 unless ($a);
	my $now = time();
	$r = 0 unless ($r);
	if ($sqldbd eq 'M') {
		sql_execute('INSERT generatedsenders (gsnd_address,gsnd_stamp,gsnd_rcpts) VALUES (?,?,?) '.
			    'ON DUPLICATE KEY UPDATE gsnd_stamp=VALUES(gsnd_stamp),gsnd_rcpts=(gsnd_rcpts+?)',
			    $a,$now,$r,$r);
	} else {
		return sql_execute_multi(
			['INSERT OR IGNORE INTO generatedsenders (gsnd_address,gsnd_stamp) VALUES (?,?)',$a,$now],
			['UPDATE generatedsenders SET gsnd_stamp=?,gsnd_rcpts=(gsnd_rcpts+?) WHERE gsnd_address=?',$now,$r,$a],
		);
	}
}

sub gsnd_check {
	my ($a,$b) = @_;
	$a = address_strip($a);
	return 0 unless ($a);
	debug_log(0,'gsnd_check %s ? %s',$t,$a);
	my $res = sql_select_one_row('SELECT gsnd_stamp,gsnd_rcpts,gsnd_bounces FROM generatedsenders WHERE gsnd_address=? AND gsnd_stamp>=?',$a,time()-$GSNDExpire);
	return 0 unless ($res && @{$res});
	debug_log(0,'gsnd_check %s ? %s',$t,$a);
	sql_execute('UPDATE generatedsenders SET gsnd_bounces=(gsnd_bounces+1) WHERE gsnd_address=?',$a) if ($b);
	return 0 unless ($res->[0]);
	return 1 unless ($GSNDMaxReturns);
	return 0 if ($res->[3] && ($res->[3]+($b?1:0)>$res->[2]*$GSNDMaxReturns));
	debug_log(0,'gsnd_check %s ! %s',$t,$a);
	return 1;
}

sub srs_domain {
	my ($rcpt) = @_;
	return 0 unless ($SRSDomain);
	return 1 if ($rcpt =~ /\@$SRSDomain>?$/i);
	return 0;
}

sub srs_sender {
	return 0 unless ($RelayAddr =~ /^$LocalNets$/i || check_black_nets($RelayAddr));
	return 0 unless ($SRSDomain && $SRSSecret);
	return 0 if ($Sender =~ /\@$OurDomains>?$/i);
	return 0 if ($Sender =~ /\@$SRSDomain>?$/i);
	return 0 unless (load_modules('Mail::SRS'));
	my $out = 0;
	my $tot = 0;
	foreach my $a (@Recipients) {
		next if (address_is_local($a,0,1));
		$out ++;
		$tot ++;
		last;
	}
	return 0 unless ($out);
	my $srs; eval { $srs = new Mail::SRS({Secret=>split(/\s*;\s*/,$SRSSecret)}); }; #*
	return 0 unless ($srs);
	my $sender;
	eval { $sender = $srs->forward(address_strip_nc($Sender),$SRSDomain); };
	return 0 unless ($sender);
	return 0 if (address_strip($sender) eq address_strip($Sender));
	debug_log(0,'srs_sender %s %s',$Sender,$sender);
	gsnd_add($sender,$tot);
	#return 0;
	do_action_insert_header($entity,"X-SRS-F",sprintf('%s -> %s',$Sender,$sender));
	do_action_insert_header($entity,'Resent-Message-ID',sprintf('<srs.%s.%x.%x.%x@%s>',$MsgIDs,time(),$$,rand(65535),$MyFilterHostName));
	do_action_insert_header($entity,'Resent-Date',rfc2822_date());
	do_action_insert_header($entity,'Resent-Sender',$sender);
	do_action_insert_header($entity,'X-Return-Path',$Sender);
	#do_action_insert_header($entity,'Resent-From',"mailer-daemon\@$MyFilterHostName");
	change_sender($sender);
	$Sender = $sender;
	return $sender;
}

sub srs_recipient {
	my ($rcpt,$b) = @_;
	#debug_log(0,'srs_recipient ?? %s %s',$rcpt,$b);
	return 0 unless ($SRSDomain && $SRSSecret);
	return 0 unless ($rcpt =~ /\@$SRSDomain>?$/i);
	return 0 unless (load_modules('Mail::SRS'));
	debug_log(7,'srs_recipient g? %s',$rcpt);
	return 0 unless (gsnd_check($rcpt,$b));
	debug_log(5,'srs_recipient s? %s',$rcpt);
	my $srs; eval { $srs = new Mail::SRS({MaxAge=>sprintf('%u',$GSNDExpire/(24*60*60)),Secret=>split(/\s*;\s*/,$SRSSecret)}); }; #*
	return 0 unless ($srs);
	debug_log(5,'srs_recipient r? %s',$rcpt);
	my $rwrcpt = '';
	eval { $rwrcpt = $srs->reverse(address_strip_nc($rcpt)); };
	return 0 unless ($rwrcpt);
	debug_log(5,'srs_recipient e? %s %s',$rcpt,$rwrcpt);
	return 0 if (lc($rwrcpt) eq lc($rcpt));
	debug_log(0,'srs_recipient !! %s %s',$rcpt,$rwrcpt);
	return $rwrcpt;
}

sub srs_recipients {
	my ($entity) = @_;
	return 0 unless (load_modules('Mail::SRS'));
	my @rwrcpts = ();
	$many = -1;
	foreach my $rcpt (list_recipients) {
		$many ++;
		my $rwrcpt = srs_recipient($rcpt,1);
		next unless ($rwrcpt);
		push @rwrcpts, {o=>$rcpt,n=>$rwrcpt};
	}
	return 0 unless (@rwrcpts);
	foreach my $rcpt (@rwrcpts) {
		do_action_insert_header($entity,"X-SRS-T",sprintf('%s -> %s',$rcpt->{o},$rcpt->{n})) unless ($many);
		do_replace_recipients($rcpt->{o},$rcpt->{n});
	}
	do_action_insert_header($entity,"X-SRS-T",sprintf('%u',scalar @rwrcpts)) if ($many);
	return scalar @rwrcpts unless ($SRSCopyBounce && $Sender =~ /^<?>?$/);
	if ($SRSCopyBounce =~ /^\S+\@\S+$/) {
		debug_log(0,'srs_recipients cb %s',$SRSCopyBounce);
		do_add_recipients($SRSCopyBounce);
	} else {
		debug_log(0,'srs_recipients cb %s',$AdminAddress);
		do_add_recipients($AdminAddress);
	}
	return scalar @rwrcpts;
}

sub srs_capture_dsn {
	my ($entity) = @_;
	return 0 unless ($entity && $entity->head);
	return 0 unless ($SRSDSNCaptureNet || $SRSDSNCaptureHost || $SRSDSNCaptureRcpt || $SRSDSNCaptureSndr || $SRSDSNCaptureFrom || $SRSDSNCaptureTo || $SRSDSNCaptureSubj);
	return 0 if ($mailtoobig);
	debug_log(7,'srs_capture_dsn ?');
	return 0 if ($SRSDSNCaptureNet && $RelayAddr !~ /^$SRSDSNCaptureNet$/);
	return 0 if ($SRSDSNCaptureHost && $RelayHostName !~ /^$SRSDSNCaptureHost$/i);
	return 0 if ($SRSDSNCaptureRcpt && ($#Recipients != 0 || $Recipients[0] !~ /^<?$SRSDSNCaptureRcpt>?$/i));
	return 0 if ($Sender !~ /^<?$SRSDSNCaptureSndr>?$/i);
	return 0 unless (lc($entity->mime_type) eq 'multipart/report');
	return 0 unless (lc($entity->head->mime_attr('content-type.report-type')) eq 'delivery-status');
	if ($SRSDSNCaptureFrom) {
		my @al = ();
		return 0 unless (get_addresses_from_header($entity,'From:Sender:Reply-To',\@al));
		return 0 unless (address_match($$SRSDSNCaptureFrom,@al));
	}
	if ($SRSDSNCaptureTo) {
		my @al = ();
		return 0 unless (get_addresses_from_header($entity,'To',\@al));
		return 0 unless (address_match($$SRSDSNCaptureFrom,@al));
	}
	if ($SRSDSNCaptureSubj) {
		my $subj = $entity->head->get('Subject');
		return 0 unless (defined($subj) && $subj ne '');
		return 0 unless ($subj =~ /^$SRSDSNCaptureSubj$/i);
	}
	debug_log(0,'srs_capture_dsn r %s',join(',',@Recipients));
	my $bounce = read_bounce_msg('./INPUTMSG');
	return 0 unless ($bounce);
	return 0 unless ($bounce->is_bounce);
	debug_log(5,'srs_capture_dsn b');
	my $bmsg = $bounce->orig_message;
	return unless ($bmsg && $bmsg->head);
	return 0 unless (lc($bmsg->mime_type) eq 'multipart/report');
	return 0 unless (lc($bmsg->head->mime_attr('content-type.report-type')) eq 'delivery-status');
	debug_log(5,'srs_capture_dsn m');
	my $addr = '';
	my $srsa = '';
	foreach my $rep ($bounce->reports) {
		my $ea = $rep->get('email');
		next unless ($ea);
		return 0 if ($srsa && lc($ea) ne lc($srsa));
		$srsa = $ea unless ($srsa);
		my $aa = srs_recipient($ea);
		return 0 unless ($aa);
		return 0 if ($addr && lc($aa) ne lc($addr));
		$addr = $aa unless ($addr);
	}
	return 0 unless ($srsa && $addr);
	debug_log(0,'srs_capture_dsn a %s %s',$srsa,$addr);
	#$addr = $AdminAddress;
	send_mail('','',$srsa,$bmsg->as_string);
	return 1;
}

#***********************************************************************
# Mail sending stuff.
#***********************************************************************

# Like stream by domain, but only splits between our and not our
sub stream_by_our () {
	return 0 if (!in_message_context("stream_by_our"));
	my @our = ();
	my @their = ();
	foreach $rcpt (@Recipients) {
		if ($rcpt =~ /\@$OurDomains>?$/) {
			push @our, $rcpt;
		} else {
			push @their, $rcpt;
		}
	}
	return 0 unless (@our && @their);
	debug_log(2,'stream_by_our o %s',join(', ',@our));
	debug_log(2,'stream_by_our t %s',join(', ',@their));
	unless (resend_message(@our) && resend_message(@their)) {
		md_syslog('crit', 'stream_by_our: COULD NOT RESEND MESSAGE - PLEASE INVESTIGATE');
		action_bounce("Unable to stream message");
		return 1;
	}
	$TerminateAndDiscard = 1;
	return 1;
}

sub smtp_send_entity {
	my ($msg,$address) = @_;
	return 0 unless ($MailResultMailer && $msg && $address && load_modules('Net::SMTP'));
	my $smtp = Net::SMTP->new($MailResultMailer);
	return 0 unless ($smtp);
	debug_log(0,'smtp_send_entity: %s',$address);
#	my $sok = ($smtp->mail($DaemonAddress) && $smtp->recipient($address) && $smtp->data($msg->as_string));
#	$smtp->quit;
#	md_syslog('err',"Error sending entity to $address!") unless ($sok);
#	return $sok;
}


@result_reports = ();
# Create and send a result report in answer to result query

sub clear_result_report {
	@result_reports = ();
}

sub make_result_report {
	my $entity = shift;
	my $adress = shift;
	my $subject = shift;
	my $attent = shift;
	my $attorg = shift;
	push @result_reports, @_ if (@_);
	$subject = 'Result Report' unless ($subject);
	return undef unless (@result_reports && load_modules('MIME::Entity','Encode'));
	my @resreps = ();
	{
		my $fc = get_fortune();
		push @resreps, $fc if ($fc);
	}
	push @resreps, sprintf('Time: %u',time_since_stamp());
	my $text = '';
	foreach my $tp ((@result_reports,@resreps)) {
		$tp =~ s/^\n*(.*?)\n*$/$1/s;
		if ($tp) {
			$text .= "\n---8<---\n\n" if ($text);
			$text .= "$tp\n";
		}
	}
	return undef unless ($text);
	debug_log(2,'make_result_report: length=%u',length($text));
	$subect .= ': '.$entity->head->get('Subject') if (defined($entity) && defined($entity->head));
	$subject =~ s/:\s*$//;
	my $msg = MIME::Entity->build(
		Type		=> 'text/plain',
		From		=> $DaemonAddress,
		To		=> $address,
		Subject		=> $subject,
		Data		=> encode('iso-8859-1',$text),
		Encoding	=> '-SUGGEST',
		Charset		=> 'iso-8859-1',
		'Message-ID:'	=> sprintf('<rr.%s.%x.%x.%x@%s>',$MsgIDs,time(),$$,rand(65535),$MyFilterHostName),
	);
	unless ($msg) {
		md_syslog('err','Error making result report!');
		return undef;
	}
	if ($attent && defined($entity)) {
		$msg->attach(
			Data		=> $entity->as_string,
			Type		=> 'message/rfc822',
			Encoding	=> '-SUGGEST',
			Dispostion	=> 'attachment',
			Filename	=> 'DefangedMessage.eml',
		);
	}
	if ($attorg && (-f './INPUTMSG')) {
		$msg->attach(
			Path		=> './INPUTMSG',
			Type		=> 'message/rfc822',
			Encoding	=> '-SUGGEST',
			Dispostion	=> 'attachment',
			Filename	=> 'OriginalMessage.eml',
		);
	}
	return $msg;
}

sub report_spam_result {
	my $entity = shift;
	my $subject = shift;
	my $msg = make_result_report($entity,$AdminAddress,$subject,0,1,@_);
	return 0 unless ($msg);
	debug_log(0,'report_spam_result: %s %s',$AdminAddress,$subject);
	smtp_send_entity($msg,$AdminAddress);
}

sub do_result_report {
	my $entity = shift;
	my $attachmsg = shift;
	if ($is_result_query) {
		$msg = make_result_report($entity,$Sender,'Mail Filter Result Report',$attachmsg && $MailResulAttachDefanged,$attachmsg && $MailResulAttachOriginal,@_);
		if ($msg) {
			debug_log(0,'do_result_report: %s',$Sender);
			smtp_send_entity($msg,$Sender);
		}
	}
	clear_result_report();
}

sub do_xam_report {
	my ($shs,$spool,$raddr,$matched) = @_;
	if ($shs =~ /spam/i) {
		$raddr = $SpamReportAddress unless ($raddr);
		$spool = $SpamReportSpool unless ($spool);
	} elsif ($shs =~ /ham/i) {
		$raddr = $HamReportAddress unless ($raddr);
		$spool = $HamReportSpool unless ($spool);
	} elsif ($shs =~ /(eml|deliver)/i) {
		$raddr = $spool unless ($raddr);
	} else {
		debug_log(-1,'do_xam_report unknown report type: %s',$shs);
		return;
	}
	debug_log(3,'do_xam_report %s %s',$shs,$spool);
	return unless ($spool);
	return unless (-d $spool);
	my $id = sprintf('iMDFa%Xp%Xt%Xq%s',inet_aton($RelayAddr),$$,time(),$MsgIDs);
	$id =~ s/\./_/g;
	my $bn = sprintf('%s/%s',$spool,$id);
	my $ext = lc($shs);
	$ext =~ s/[^a-z0-9]+//gs;
	$ext = ".$ext";
	unless (open(RF,'>',"$bn.tmp")) {
		debug_log(-1,'do_xam_report error creating msg in %s',$spool);
		return;
	}
	print RF sprintf("X-Matched: %s\n",$matched) if ($matched);
	print RF sprintf("Delivered-To: %s\n",$raddr);
	print RF sprintf("Sent-To: %s\n",join(' ',@Recipients));
	print RF sprintf("Received-From: %s %s\n",$RelayAddr,$RelayHostname);
	print RF sprintf("Return-Path: %s\n",$Sender);
	print RF synthesize_received_header() if ($shs =~ /(auto?|tra?p|deliver)/i);
	unless (open(F,'<','./INPUTMSG')) {
		debug_log(-1,'do_xam_report error opening input msg');
		close(RF);
		unlink("$bn.tmp");
	}
	while (my $l = <F>) {
		$l =~ s/[\r\n]+//gs;
		print RF "$l\n";
	}
	close(F);
	close(RF);
	unless (rename("$bn.tmp","$bn$ext")) {
		debug_log(-1,'do_xam_report error inserting msg');
		unlink("$bn.tmp") if (-e "$bn.tmp");
		return;
	}
	debug_log(1,'do_xam_report %s %s',$shs,$id);
}

sub handle_xam_report {
	my ($shs) = @_;
	return 0 unless ($shs);
	stats_log('deliver',$MsgIDs,$is_xam_report.'_report','','*');
	where_log('handle_xam_report');
	do_xam_report($shs);
	debug_log(2,'Discarding xam report message.');
	return 1;
#	unless ($SpamReportForward && $shs =~ /spam/i) {
#		debug_log(2,'Discarding xam report message.');
#		return 1;
#	}
#	foreach my $rcpt (@Recipients) { delete_recipient($rcpt); }
#	@Recipients = ();
	#foreach my $rcpt (split(/\s*;\s*/,$SpamReportForward)) {
	#	next unless ($rcpt =~ /^\S+\@\S+$/);
	#	add_recipient($rcpt);
	#	push @Recipients, $cpt;
	#}
	#if (@Recipients) {
	#	stats_log('deliver',$MsgIDs,$is_xam_report.'_forward','','*');
	#	return 0;
	#}
#	return 1;
}

#***********************************************************************
# Filter callbacks.
#***********************************************************************

sub return_this {
	my $what = shift;
	my $code = shift;
	my $dsn = shift;
	my $msg = reject_answer(@_);
	end_time_stamp();
	return ($what,$msg,$code,$dsn);
}

sub reject_this_ex {
	return return_this('REJECT',@_);
}
sub reject_this {
	return reject_this_ex(undef,undef,@_);
}

sub tempfail_this_ex {
	return return_this('TEMPFAIL',@_);
}
sub tempfail_this {
	return tempfail_this_ex(undef,undef,@_);
}

sub clear_from_filter_end {
	$bounceo = undef;
	$bouncef = '';
	$is_result_query = 0;
	$is_xam_report = 0;
	@removed_parts = ();
	%spamassassin_extra_hits = ();
	@countries = ();
	@verified_results = ();
	$dkimsignature = undef;
	undef @new_recipients;
	clear_result_report();
	html_cleaning_clear(1);
	end_time_stamp();
	finish_log(20,'filter','R');
}

sub parse_headers {
	return undef unless load_modules('MIME::Head');
	return undef unless (open(HF,'<','./HEADERS'));
	my $head = MIME::Head->read(\*HF);
	close(HF);
	return $head;
}

#***********************************************************************
# %PROCEDURE: filter_initialize
# %ARGUMENTS:
# %RETURNS:
#  nothing
# %DESCRIPTION:
#  Called just before a slave begins processing messages.
#***********************************************************************
sub filter_initialize {
	$MsgIDs = '';
	$hirestime = load_modules('Time::HiRes');
	here_log('filter_initialize begin');
	sql_connect(1);
	if ($SAPreInit || $SAPreCompile) {
		my $sao = init_spamassassin_module();
		if ($sao) {
			debug_log(1,'filter_initialize SA init');
			$sao->compile_now(1) if ($SAPreCompile);
		} else {	
			debug_log(-1,'filter_initialize SA init error');
		}
	}
	where_log('filter_initialize end');
}

#***********************************************************************
# %PROCEDURE: filter_cleanup
# %ARGUMENTS:
# %RETURNS:
#  nothing
# %DESCRIPTION:
#  Called when a slave is about to exit.
#***********************************************************************
sub filter_cleanup {
	$MsgIDs = '';
	here_log('filter_cleanup begin');
	sql_disconnect(1);
	while (my ($mod,$pth) = each %INC) {
		debug_log(2,'Module: %s',$mod,$pth);
	}
	where_log('filter_cleanup end');
	return 0;
}

#***********************************************************************
# %PROCEDURE: filter_§
# %ARGUMENTS:
#  type
# %RETURNS:
#  nothing
# %DESCRIPTION:
#  Called every now and then.
#***********************************************************************
sub filter_tick {
	$MsgIDs = '';
	my ($ttype) = @_;
	here_log('filter_tick begin');
	debug_log(0,'filter_tick %u',$ttype);
	sql_connect();
	dc_clean();
	trap_clean();
	clean_time_stamps();
	where_log('filter_tick end');
}

#***********************************************************************
# %PROCEDURE: filter_map
# %ARGUMENTS:
#  mapname, key
# %RETURNS:
#  code, value
# %DESCRIPTION:
#  Called when for sendmail socket maps.
#***********************************************************************
sub filter_map {
	$MsgIDs = '';
	my ($map,$key) = @_;
	debug_log(0,'filter_map ??? %s %s',$map,$key);
	return ('PERM',"Unknown map: $map");
}

#***********************************************************************
# %PROCEDURE: filter_relay
# %ARGUMENTS:
#  ip, host
# %RETURNS:
#  action
# %DESCRIPTION:
#  Called just after contact
#  Requires -r
#***********************************************************************
sub filter_relay ($$) {
	$MsgIDs = '';
	my($ip, $hostname) = @_;
	$hostname = get_rdns($hostname);

	here_log('filter_relay begin');
	stats_log('info',$MsgIDs,'filter_relay',$ip,$hostname);
	#read_commands_file() if (-f 'COMMANDS');
	#macros_stats_log('filter_relay');

	unless (check_black_nets($ip)) {
		my @fcdns = get_full_circle_dnses($ip);
		stats_log('relay_info',$MsgIDs,$ip,$hostname,'',\@fcdns,scalar get_domains_parts(@fcdns),scalar trim_hosts_parts(@fcdns));
	}

	# Check if the host is whitelisted
	if (check_internal_whitelist($ip)) {
		debug_log(2, "filter_relay: Internally whitelisted, $ip");
		return ('CONTINUE', "Ok friend, go ahead.");
	}

	if (check_authenticated(1) || check_external_whitelist($ip,$hostname)) {
		debug_log(2, "filter_relay: Whitelisted, $hostname [$ip]");
		return ('CONTINUE', "Ok, I know you, go ahead.");
	}
	
	# Check if blacklisted
	my ($bad,$hit,$log) = check_external_blacklist($ip,$hostname);
	if ($bad) {
		debug_log(2, "filter_relay: Blacklisted, $hostname [$ip], $log");
		stats_log('reject','',$log,$hit,$ip,$hostname);
		return reject_this("We do not want mail from $hit!");
	}

	where_log('filter_relay greylist');
	my ($ghr,$ghe) = greylist_check_host($ip);
	debug_log(3,'filter_relay: gch %i %s %s',$ghr,$ghe,$ip);
	if ($gdb_host_black && $ghr > 0 && !greylist_exempt($ip,$hostname)) {
		my $greys = time_string($ghr);
		debug_log(3,"check_relay: $ghe host in Greylist, $hostname [$ip]");
		stats_log('tempfail','','grey_host',$ghr,$ip,$hostname);
		return tempfail_this("We might accept the connection in $greys.");
	}

	where_log('filter_relay host');
	#if ($ghr && dict_check_host($ip)) {
	if (dict_check_host($ip)) {
		debug_log(2,"check_relay: Black in Dictionary list, $hostname [$ip]");
		#return ('CONTINUE', "We currently do not want mail from $ip, but go head anyway.");
		#md_syslog('info', "MDLOG,NOQUEUE,dict,$ip,?,?,?");
		stats_log('tempfail','','dict',$ip,$ip,$hostname);
		return tempfail_this("At the moment we do not want mail from $ip.");
	}

	where_log('filter_relay block');
	if ($block_relay) {
		my ($nobl,$rule,$match) = check_blockrelay($ip,$hostname);
		unless ($nobl) {
			debug_log(1,"filter_relay: Blocked, $hostname [$ip],$match");
			#dict_add_?
			stats_log('tempfail','','block',[$ip,$match,$rule],$ip,$hostname);
			return tempfail_this("Currently we do not want mail from $ip!");
		}
	}

	# Reject if blacklisted with relaydb(p)
	# TEMPFAIL is used because the relaydb(p) based blocking
	# can change automatically?
	#return check_relay('NOQUEUE',$ip, $hostname, 'TEMPFAIL', "", 0);
	where_log('filter_relay relay');
	return check_relay('NOQUEUE',$ip, $hostname, 'REJECT', "", 0);
}

#***********************************************************************
# %PROCEDURE: filter_helo
# %ARGUMENTS:
#  ip, host, helo
# %RETURNS:
#  action
# %DESCRIPTION:
#  Called just after HELO
#  Requires -H
#***********************************************************************
sub filter_helo ($$$) {
	$MsgIDs = '';
	my($ip, $hostname, $helo) = @_;
	$hostname = get_rdns($hostname);

	here_log('filter_helo begin');
	stats_log('info',$MsgIDs,'filter_helo',$ip,$hostname,$helo);
	#read_commands_file() if (-f 'COMMANDS');
	#macros_stats_log('filter_helo');

	#unless (check_black_nets($ip)) {
	#	#my @fcdns = get_full_circle_dnses($ip);
	#	#my @dndns = get_domains_parts(@fcdns);
	#	#stats_log('relay_info',$MsgIDs,$ip,$hostname,$helo,\@fcdns,\@dndns);
	#}

	# Check if the host is in internal whitelist
	if (check_internal_whitelist($ip)) {
		debug_log(2, "filter_helo: Internally whitelisted, $ip");
		return ('CONTINUE', "Ok friend, go ahead.");
	}

	# Check if the host is in external whitelist
	if (check_external_whitelist($ip,$hostname)) {
		debug_log(2, "filter_helo: Whitelisted, $sender at $hostname [$ip]");
		return ('CONTINUE', "Ok, I now you, go ahead.");
	}

	# Reject if HELO pretends to be ours but isn't.
	if (check_our_helo($helo)) {
		dict_add_bad_helo($ip);
		#md_syslog('info', "MDLOG,$MsgIDs,helo,$helo,$ip,?,?,?");
		stats_log('reject','','helo',$helo,$ip,$hostname,$helo);
		#return ('CONTINUE', "We do not like your HELO/EHLO, but go head anyway.");
		#return ('REJECT', "Forged HELO/EHLO ($helo) is not appreciated!");
		return reject_this("Forged HELO/EHLO ($helo) is not appreciated!");
	}
	
	# Check if the host is in external blacklist
	my ($bad,$hit,$log) = check_external_blacklist($ip,$hostname,$helo);
	if ($bad) {
		dict_add_bad_helo($ip);
		debug_log(2, "filter_helo: Blacklisted, $hostname [$ip] ($helo), $log");
		stats_log('reject','',$log,$hit,$ip,$hostname,$helo);
		return reject_this("We do not want mail from '$hit'!");
	}
	
	where_log('filter_helo end');
	return ('CONTINUE', "Ok, go ahead.");
}

#***********************************************************************
# %PROCEDURE: filter_sender
# %ARGUMENTS:
#  sender, ip, host, helo
# %RETURNS:
#  action
# %DESCRIPTION:
#  Called just after MAIL FROM
#  Requires -s
#***********************************************************************
sub filter_sender ($$$$) {
	$MsgIDs = $MsgID;

	# Reject if blacklisted sender/host in /etc/mail/mimedefang-blacklist

	# This is the first called function with id, so we save the stamp here.
	save_time_stamp();

	my($sender, $ip, $hostname, $helo) = @_;
	$hostname = get_rdns($hostname);

	here_log('filter_sender begin');
	stats_log('info',$MsgIDs,'filter_sender',$ip,$hostname,$helo,$sender);
	read_commands_file() if (-f 'COMMANDS');
	macros_stats_log('filter_sender');
	stats_log('notice',$MsgIDs,'external_local',$ip,$hostname,address_strip($sender)) if ($sender =~ /\@$OurDomains>?$/i && !address_is_local($ip));

	# If SRS sender, check if valid?
	if (srs_domain($sender)) {
		my $srsrcpt = srs_recipient($sender);
		if (!$srsrcpt) {
			debug_log(-1,'Faked SRS? %s %s %s',$sender,$ip,$hostname);
			stats_log('reject',$MsgIDs,'bad_sender',$sender,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Invalid SRS sender.");
		} elsif (address_is_local($ip)) {
			debug_log(-1,'Resent SRS? %s %s %s',$sender,$ip,$hostname);
			return ('CONTINUE', "Ok, resend it.");
		} else {
			debug_log(-1,'External SRS? %s %s %s',$sender,$ip,$hostname);
			return ('CONTINUE', "Ok, resend it.");
		}
	}

	# If local sender, check if valid?
	if ($sender =~ /\@$OurDomains>?$/i && 
	    !($NoCheckUserDomains && $sender =~ /\@(|.*\.)$NoCheckUserDomains$/i) &&
	    !check_sender_white('ouraddress',$sender)) {
		my $srv = storing_server($sender);
		if ($srv && $srv !~ /^$NoCheckUserServers$/i) {
			my ($ok, $msg) = check_against_smtp_server_cached('<>',$sender,$srv);
			#debug_log(0,'filter_sender %s local sender %s %s %s %s',$MsgIDs,$sender,$srv,$ok,$msg);
			if ($ok eq "REJECT") {
				dict_add_unknown_user($ip);
				#debug_log(0,'filter_sender %s bad local sender %s %s %s',$MsgIDs,$sender,$srv,$msg);
				stats_log('reject',$MsgIDs,'unknown_local_user',[$sender,$srv],$ip,$hostname,$helo,$sender,$recipient);
				return reject_this("Sender $sender not ok. Server said: $msg");
			}
		}
	}

	# Check if the host is in internal whitelist
	if (check_internal_whitelist($ip)) {
		if ($Sender =~ /\@$NoUserDomains>?$/i) {
			# This is not supposed to happen...
			debug_log(1,"no_user_domain: $sender, $ip, $hostname, $helo");
		}
		debug_log(2, "filter_sender: Internally whitelisted, $ip");
		return ('CONTINUE', "Ok friend, go ahead.") unless (check_any_relay_option($helo,'outsider'));
	}

	# Check if user is authenticated?
	#if (check_authenticated(1)) {
	#	return ('CONTINUE', "You've got the key, go ahead.")
	#}

	# Check if blacklisted in /etc/mail/mimedefang-blacklist
	my ($bad,$hit,$log) = check_external_blacklist($ip,$hostname,$helo,"",$sender);
	if ($bad) {
		debug_log(2, "filter_sender: Blacklisted, $sender at $hostname [$ip] ($helo), " . $log);
		#return ('CONTINUE', "We do not want mail from $hit, but go head anyway.");
		#md_syslog('info', "MDLOG,$MsgIDs,$log,$ip,$sender,?,?");
		dict_add_abuse($ip);
		stats_log('reject',$MsgIDs,$log,$hit,$ip,$hostname,$helo,$sender);
		return reject_this("We do not want mail from $hit!");
		#return tempfail_this("We do not want mail from $hit.");
	}
	
	# Check if blacklisted by relaydb
	unless (check_sender_white('relaydb',$sender)) {
		($bad,$hit,$log) = check_sender_blacklist($sender);
		if ($bad) {
			debug_log(1, "filter_sender: Blacklisted, $sender at $hostname [$ip] ($helo), " . $log);
			#return ('CONTINUE', "We do not want mail from $hit, but go head anyway.");
			#md_syslog('info', "MDLOG,$MsgIDs,$log,$ip,$sender,?,?");
			dict_add_abuse($ip);
			stats_log('reject',$MsgIDs,$log,$hit,$ip,$hostname,$helo,$sender);
			return reject_this("Currently we do not want mail from $hit!");
			#return tempfail_this("We do not want mail from $hit.");
		}
	}

	where_log('filter_sender mx');
	# Check if sender has valid MX
	if ($mxcheck && !check_sender_white('mx',$sender)) {
		my ($mxe,$mxr) = mail_address_mx_check($sender);
		if ($mxe) {
			dict_add_invalid_mx($ip);
			#md_syslog('info', "MDLOG,$MsgIDs,mx,$ip,$sender,?,?");
			if ($mx_tempfail && !check_any_relay_option($helo,'notempfail')) {
				stats_log('tempfail',$MsgIDs,'mx',[$sender,$mxr],$ip,$hostname,$helo,$sender);
				return tempfail_this($mxr);
			} else {
				stats_log('reject',$MsgIDs,'mx',[$sender,$mxr],$ip,$hostname,$helo,$sender);
				return reject_this($mxr);
			}
		}
	}

	where_log('filter_sender block');
	if ($block_sender && !check_sender_white('block',$sender)) {
		my ($nobl,$rule,$match) = check_blocksender($ip,$hostname,$helo,$sender);
		unless ($nobl) {
			debug_log(0,"filter_sender: Blocked, $sender, $match");
			stats_log('tempfail',$MsgIDs,'block',[$sender,$match,$rule],$ip,$hostname,$helo,$sender);
			return tempfail_this("Currently we do not want mail from $sender!");
		}
	}

	where_log('filter_sender end');
	return ('CONTINUE', "Ok, go ahead.");
}

#***********************************************************************
# %PROCEDURE: filter_recipient
# %ARGUMENTS:
#  recipient, sender, ip, host, first, helo, rcpt_mailer, rcpt_host, rcpt_addr
# %RETURNS:
#  action
# %DESCRIPTION:
#  Called just after RCPT TO
#  Requires -t
#***********************************************************************
sub filter_recipient ($$$$$$$$$) {
	$MsgIDs = $MsgID;

	my($recipient, $sender, $ip, $hostname, $first, $helo, $rcpt_mailer, $rcpt_host, $rcpt_addr) = @_;
	$hostname = get_rdns($hostname);

	here_log('filter_recipient begin');
	stats_log('info',$MsgIDs,'filter_recipient',$ip,$hostname,$helo,$sender,$recipient,$rcpt_mailer,$rcpt_host,$rcpt_addr);
	read_commands_file() if (-f 'COMMANDS');
	#macros_stats_log('filter_recipient');
	#debug_log(0,'filter_recipient ph %s|%s|%s|%s|%u',$recipient,$rcpt_mailer,$rcpt_host,$rcpt_addr,$rloc);

	if ($SpamTrapAddresses && !check_internal_whitelist($RelayAddr) && spam_trap_this($sender,$recipient)) {
		dict_add_trap($ip) if ($SpamTrapReportRelay);
		if ($trap_chance && rand(100) >= $trap_chance) {
			stats_log('reject',$MsgIDs,'no_trap',['chance',$trap_chance],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("I am not in the mood.");
		}
		if (trap_many()) {
			stats_log('reject',$MsgIDs,'no_trap',['amount',$trap_maxwindow,$trap_timewindow],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("I am currently fed up.");
		}
		if ($trap_maxload && get_load_average() > $trap_maxload) {
			stats_log('reject',$MsgIDs,'no_trap',['load',$trap_maxload],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("I have too much to do at the moment.");
		}
		if ($trap_maxswap && get_swap_percentage() > $trap_maxswap) {
			stats_log('reject',$MsgIDs,'no_trap',['swap',$trap_maxswap],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("I have too much to do at the moment.");
		}
		stats_log('trap',$MsgIDs,$sender,$recipient);
		return ('CONTINUE', "Ok, spam ahead.");
	}

	for (my $ri=0;$ri<$#Recipients;$ri++) {
		#debug_log(0,'filter_recipient ri %s|%u',$Recipients[$ri],$oloc);
		if ($sender =~ /^<?>?$/) {
			debug_log(0,"filter_recipient: bad <>, r=$recipient, f=$first");
			if (check_internal_whitelist($ip)) {
				stats_log('tempfail',$MsgIDs,'bad_sender','<>',$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this_ex('452','4.5.3',"Sender <> is not allowed to send to multiple recipients.");
			} else {
				dict_add_abuse($ip);
				stats_log('reject',$MsgIDs,'bad_sender','<>',$ip,$hostname,$helo,$sender,$recipient);
				return reject_this("Sender <> is not allowed to send to multiple recipients.");
			}
		} elsif ($oloc) {
			my $ria = address_strip($Recipients[$ri]);
			if ($ria eq $MailResultAddress) {
				stats_log('tempfail',$MsgIDs,'bad_user',[$MailResultAddress,$recipient],$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this_ex('452','4.5.3',"Combining result query address with other addresses is not allowed!");
			} elsif ($ria eq $SpamReportAddress) {
				stats_log('tempfail',$MsgIDs,'bad_user',[$SpamReportAddress,$recipient],$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this('452','4.5.3',"Combining spam report adress with other addresses is not allowed!");
			} elsif ($ria eq $HamReportAddress) {
				stats_log('tempfail',$MsgIDs,'bad_user',[$HamReportAddress,$recipient],$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this('452','4.5.3',"Combining ham report adress with other addresses is not allowed!");
			} elsif ($PassAbuse && $ria =~ /^abuse\@[^\@]+$/) {
				stats_log('tempfail',$MsgIDs,'bad_user',[$Recipients[$ri],$recipient],$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this_ex('452','4.5.3',"Abuse must be solo here.");
			} elsif (srs_recipient($Recipients[$ri])) {
				stats_log('tempfail',$MsgIDs,'bad_user',[$Recipients[$ri],$recipient],$ip,$hostname,$helo,$sender,$recipient);
				return tempfail_this_ex('452','4.5.3',"SRS recipients must be solo here.");
			}
		}
	}

	# <>
	if ($sender =~ /^<?>?$/ && $first && $first ne $recipient) {
		debug_log(3,"filter_recipient: bad <>, r=$recipient, f=$first");
		if (check_internal_whitelist($ip)) {
			stats_log('tempfail',$MsgIDs,'bad_sender','<>',$ip,$hostname,$helo,$sender,$recipient);
			return tempfail_this_ex('452','4.5.3',"Sender <> is not allowed to send to multiple recipients.");
		} else {
			stats_log('reject',$MsgIDs,'bad_sender','<>',$ip,$hostname,$helo,$sender,$recipient);
			dict_add_abuse($ip);
			return reject_this("Sender <> is not allowed to send to multiple recipients.");
		}
	}

	# abuse...
	if ($PassAbuse && $recipient =~ /^<?abuse\@[^\@]+>?$/i && $#Recipients) {
		stats_log('tempfail',$MsgIDs,'bad_user',$recipient,$ip,$hostname,$helo,$sender,$recipient);
		return tempfail_this_ex('452','4.5.3',"Abuse must be solo here.");
	}

	# Result-tester address?
	my $irq = 0;
	if ($MailResultAddress && (address_strip($recipient) eq $MailResultAddress)) {
		unless (check_sender_white('result',$sender)) {
			#md_syslog('info', "MDLOG,$MsgIDs,bad_user,$MailResultAddress,$ip,$sender,$recipient,?");
			dict_add_unknown_user($ip);
			stats_log('reject',$MsgIDs,'bad_user',$MailResultAddress,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Cannot deliver to $recipient!");
		}
		if ($#Recipients) {
			#md_syslog('info', "MDLOG,$MsgIDs,bad_user,$MailResultAddress,$ip,$sender,$recipient,?");
			stats_log('tempfail',$MsgIDs,'bad_user',$MailResultAddress,$ip,$hostname,$helo,$sender,$recipient);
			return tempfail_this_ex('452','4.5.3',"Combining result query address with other addresses is not allowed!");
		}
		$irq = 1;
	}

	# Spam/ham report address?
	my $ixr = '';
	my $ixa = '';
	if ($SpamReportAddress && (address_strip($recipient) eq $SpamReportAddress)) {
		$ixa = $SpamReportAddress;
		$ixr = 'spam';
	} elsif ($HamReportAddress && (address_strip($recipient) eq $HamReportAddress)) {
		$ixa = $HamReportAddress;
		$ixr = 'ham';
	}
	if ($ixr) {
		unless (check_internal_whitelist($ip) || check_authenticated(1)) {
			dict_add_unknown_user($ip);
			stats_log('reject',$MsgIDs,'bad_user',$ixa,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Cannot deliver to $recipient!");
		}
		if ($#Recipients) {
			stats_log('tempfail',$MsgIDs,'bad_user',$ixa,$ip,$hostname,$helo,$sender,$recipient);
			return tempfail_this('452','4.5.3',"Combining $ixr report adress with other addresses is not allowed!");
		}
		$ixr = 1;
	}
	
	# Special cases.
	my $dom = '';
	my $usr = '';
	if ($rcpt_mailer =~ /^e?smtp$/i) {
		$usr = address_strip($rcpt_addr);
	} else {
		$usr = address_strip($recipient);
	}
	if ($usr =~ /^(.*)\@(.*)$/) {
		$dom = $2;
		$usr = $1;
	}
	debug_log(7,'filter_recipient ud "%s" "%s" "%s" "%s" "%s" "%s"',$usr,$dom,$recipient,$rcpt_mailer,$rcpt_host,$rcpt_addr);

	if ($dom =~ /[^-_.a-zA-Z0-9].*\.$OurDomains$/ || $dom =~ /\%/) {
		#md_syslog('info', "MDLOG,$MsgIDs,unknown_user,$rcpt_host,$ip,$sender,$recipient,?");
		dict_add_unknown_user($ip);
		stats_log('reject',$MsgIDs,'bad_domain',$dom,$ip,$hostname,$helo,$sender,$recipient);
		return reject_this("Invalid domain.");
	}
	unless (check_internal_whitelist($ip)) {
		if ($dom =~ /^\[?\d+\.\d+\.\d+\.\d+\]?$/) {
			dict_add_unknown_user($ip);
			debug_log(0,'filter_recipient ip_domain %s %s %s',$rcpt_mailer,$rcpt_addr,$dom);
			stats_log('reject',$MsgIDs,'unknown_user',[$recipient,$rcpt_host],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("IP address domains not accepted.");
		}
	}

	if ($dom =~ /^$NoUserDomains$/i ||
	    ($dom =~ /^$MyFilterHostNames$/i && $ip ne '127.0.0.1') ||
	    !($dom || $usr eq 'postmaster') ||
	    $dom =~ /^[^\.]+$/) {
		dict_add_unknown_user($ip);
		#debug_log(0,'filter_recipient no_user_domain %s %s %s %s %s',$rcpt_mailer,$rcpt_addr,$dom,$NoUserDomains,$MyFilterHostNames);
		stats_log('reject',$MsgIDs,'unknown_user',[$recipient,$rcpt_host],$ip,$hostname,$helo,$sender,$recipient);
		return reject_this("No users at that domain.");
	}

	# Blacklist by recipient
	if(!check_external_whitelist_by_recipient($ip,$hostname,"","",$sender,$recipient)) {
		my($bad, $hit, $log) = check_external_blacklist_by_recipient($ip,$hostname,$helo,"",$sender,$recipient);
		if ($bad) {
			$log = "by_recipient_$log";
			#md_syslog('info', "MDLOG,$MsgIDs,$log,$ip,$hostname,$helo,$sender,$recipient");
			dict_add_unknown_user($ip);
			stats_log('reject',$MsgIDs,$log,$hit,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Mail not accepted for $recipient.");
		}

	}

	return ('CONTINUE', "Ok, go ahead with result query.") if ($irq);
	return ('CONTINUE', "Ok, go ahead with $ixr report.") if ($ixr);
	return ('CONTINUE', "Ok, attach away.") if (catch_replace_attachments($recipient,(check_internal_whitelist($ip)||check_authenticated(1))));

	# Check SRS recipient
	if (srs_domain($recipient)) {
		my $srsrcpt = srs_recipient($recipient);
		if (!$srsrcpt) {
			stats_log('reject',$MsgIDs,'bad_user',$recipient,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Invalid SRS recipient.");
		} elsif ($#Recipients) {
			stats_log('tempfail',$MsgIDs,'bad_user',$recipient,$ip,$hostname,$helo,$sender,$recipient);
			return tempfail_this_ex('452','4.5.3',"SRS recipients must be solo here.");
		} else {
			return ('CONTINUE', "Ok, react ahead.");
		}
	}

	where_log('filter_recipient mx');
	# Check special rcpt mx map
	{
		#my ($res,$ok) = check_mail_address_mx_map('/etc/mail/mimedefang-rcpt-map',$recipient);
		my ($res,$txt) = check_mail_address_mx_map('rcpt-map',$recipient);
		unless ($res) {
			debug_log(3,'filter_recipient: bad recipient from map %s %s',$recipient,$txt);
			dict_add_unknown_user($ip);
			stats_log('reject',$MsgIDs,'bad_recipient_map',$recipient,$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Cannot deliver to $recipient. Server check result: $txt");
		}
	}

	where_log('filter_recipient local/prog');
	return ('CONTINUE', "Ok, pipe ahead.") if ($rcpt_mailer eq 'prog');
	return ('CONTINUE', "Ok, save ahead.") if ($rcpt_mailer eq 'local');

	#where_log('filter_recipient host');
	#if (!(check_internal_whitelist($ip) || check_external_whitelist($ip,$hostname)) && dict_check_host($ip)) {
	#	debug_log(2,"check_recipient: Black in Dictionary list, $hostname [$ip]");
	#	#return ('CONTINUE', "We currently do not want mail from $ip, but go head anyway.");
	#	#md_syslog('info', "MDLOG,NOQUEUE,dict,$ip,?,?,?");
	#	stats_log('tempfail','$MsgIDs','dict',$ip,$ip,$hostname,$helo,$sender,$recipient);
	#	return tempfail_this("At the moment we do not want mail from $ip.");
	#}

	where_log('filter_recipient local');
	my $ldal = read_delivery_file('local-delivery');
	if ($ldal) {
		for my $ai (@{$ldal}) {
			debug_log(7,'filter recipient ld? %s %s %s %s:%s',$recipient,$ai->{a},$ai->{w},$ai->{f},$ai->{d});
			next unless ($recipient =~ /^<?$ai->{a}?>$/);
			next unless ($ai->{w} =~ /[->]/ && $ai->{w} !~ /[=+]/);
			debug_log(2,'filter recipient ld! %s %s %s %s:%s',$recipient,$ai->{a},$ai->{w},$ai->{f},$ai->{d});
			return ('CONTINUE',"Address $rcpt_addr local, go ahead.");
		}
	}

	where_log('filter_recipient user');
	# If mail will be delivered to one of our hosts, check the user.
	unless ($NoCheckUserDomains && $rcpt_addr =~ /\@(|.*\.)$NoCheckUserDomains$/i) {
		my ($df,$uf) = check_user_in_domain($rcpt_addr);
		if ($df) {
			debug_log(0,'filter_recipient user in domain %s %i',$rcpt_addr,$uf);
			return ('CONTINUE',"Address $rcpt_addr ok, go ahead.") if ($uf);
			dict_add_unknown_user($ip);
			stats_log('reject',$MsgIDs,'unknown_user',[$recipient],$ip,$hostname,$helo,$sender,$recipient);
			return reject_this("Cannot deliver to $rcpt_addr. User unknown.");
		}
		my $cassh;
		if ($rcpt_mailer =~ /^e?smtp$/ && $rcpt_host =~ /^\[$LocalNets\]$/i) {
			$cassh = $rcpt_host;
		} elsif ($rcpt_addr =~ /\@$OurDomains>?$/i) {
			$cassh = storing_server($rcpt_addr);
		}
		if ($cassh && $cassh !~ /^$NoCheckUserServers$/i) {
			$cassh =~ s/^(\[)(.*)(\])$/$2/;
			#debug_log(0,'filter_recipient cassc %s %s %s',$sender,$rcpt_addr,$cassh);
			my ($ok, $msg) = check_against_smtp_server_cached($sender,$rcpt_addr,$cassh);
			#debug_log(0,'filter_recipient cassc %s %s',$ok,$msg);
			return ('CONTINUE',"Address $rcpt_addr ok, go ahead.") if ($ok eq "CONTINUE");
			if ($ok eq "REJECT") {
				dict_add_unknown_user($ip);
				stats_log('reject',$MsgIDs,'unknown_user',[$recipient,$rcpt_host],$ip,$hostname,$helo,$sender,$recipient);
				return reject_this("Cannot deliver to $rcpt_addr. Server said: $msg");
			}
			debug_log(-1,"filter_recipient: unhandled answer from storing host ('%s','%s')",$ok,$msg);
			return ('CONTINUE',"Not sure wether the user is ok or not, so go ahead") if ($CheckUserErrorContinue);
			stats_log('tempfail',$MsgIDs,'unknown_user',[$recipient,$rcpt_host],$ip,$hostname,$helo,$sender,$recipient);
			return tempfail_this("Error checking $rcpt_addr: $msg");
		}
	}

	where_log('filter_recipient end');
	return ('CONTINUE', "Ok, go ahead.");
}

#***********************************************************************
# %PROCEDURE: filter_before
# %ARGUMENTS:
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail is parsed
#***********************************************************************
sub filter_before($) {
	$MsgIDs = $MsgID;

	here_log('filter_before begin');
	if ($RelayHostname eq $RealRelayHostname) {
		$RelayHostname = get_rdns($RelayHostname);
		$RealRelayHostname = $RelayHostname;
	} else {
		$RelayHostname = get_rdns($RelayHostname);
		$RealRelayHostname = get_rdns($RealRelayHostname);
	}
	stats_log('info',$MsgIDs,'filter_before',$RelayAddr,$RelayHostName,$Helo,$Sender,\@Recipients,$RealRelayHostname);
	#macros_stats_log('filter_before');
	#die('Missing modules!') unless (load_modules('Mail::Header'));
	
	#debug_log(0,'filter_before %s %s %s',$RealRelayHostname,$Sender,join(',',@Recipients));
	$ScanStartedAt = time();
	$ModifiedHTML = 0;
	%modhead = ();
	%warnhead = ();
	$FoundVirus = 0;
	$FoundSuspected = 0;
	$GreyListAction = '';
	$forcespamcheck = 0;
	$wantsspamcheck = 0;
	%spamassassin_extra_hits = ();
	@verified_results = ();
	@removed_parts = ();
	@warningtexts = ();
	@countries = ();
	$dkimsignature = undef;
	undef @new_recipients;
	$did_quarantine = 0;
	$input_message_hash = undef;
	$bounceo = undef;
	$bouncef = '';

	my $size = (stat('./INPUTMSG'))[7];
	stats_log('size',$MsgIDs,$size);
	@replaced_attachments = ();
	$replace_attachments_path = '';
	$replace_all_attachments = 0;
	$do_replace_attachments = 0;
	#debug_log(0,'filter_before attachment hard mail limit: %u %u',$attachments_hard_mail_limit,$size);
	$do_replace_attachments = 'hard' if ($attachments_hard_mail_limit && $size > $attachments_hard_mail_limit);
	$replace_all_attachments = 1 if ($attachments_max_mail_size && $size > $attachments_max_mail_size);
	
	$is_result_query = 0;
	$is_xam_report = 0;
	@result_reports = ();

	my $head; # Might get initialized from parse_header later...
	my $hostn = '';
	$hostn = $RelayHostname if (defined($RelayHostname));

	#$warnhead{"Debug filter ($FilterVersion)."} ++ if ($FilterDebug);
	#$warnhead{"Dummy warning."} ++ if ($FilterDebug);
	if (pass_abuse()) {
		debug_log(0,'filter_before abuse');
		$warnhead{'Sent to Abuse address.'} ++;
	}

	# To a trap?
	here_log('filter_before trap');
	if ($SpamTrapAddresses && !check_internal_whitelist($RelayAddr)) {
		my $trapped = 0;
		foreach my $rcpt (@Recipients) {
			next unless (spam_trap_this($Sender,$rcpt));
			if ($SpamTrapReportRelay && defined($gdb_reset)) {
				if ($gdb_reset_host) {
					greylist_reset($RelayAddr,'','');
				} else {
					greylist_reset($RelayAddr,$Sender,$rcpt);
				}
			}
			$trapped ++;
			stats_log('trapped',$MsgIDs,$rcpt,'','*');
			do_xam_report('spam-trap',$SpamTrapSpool,$rcpt);
			do_del_recipients($rcpt);
			trap_add($RelayAddr);
			stats_log('deliver',$MsgIDs,'spam_report','','*');
		}
		if ($trapped) {
			report_no_spam_spam($RelayAddr);
			if ($SpamTrapReportRelay) {
				report_address_relay_spam($RelayAddr);
				greylist_reset_host($RelayAddr) if (defined($gdb_host_reset));
			}
			unless (list_recipients()) {
				stats_log('discard',$MsgIDs,'trapped',\@Recipients);
				return action_discard();
			}
		}
	}

	where_log('filter_before spam hash');
	if ($spamdb && !(check_internal_whitelist($RelayAddr) || pass_abuse())) {
		my $mhash = make_spam_hash();
		my ($spam,$stamp,$mid,$hits,$req) = check_spam_hashes($mhash);
		if ($spam) {
			my $when = load_modules('Date::Format') ? time2str('%Y-%m-%d %H:%M',$stamp) : sprintf('%u',$stamp);
			dict_add_abuse($RelayAddr);
			debug_log(0,'filter_before: remembered spam %s <%s> %03.1f/%i',$when,$mid,$hits,$req);
			stats_log('reject',$MsgIDs,'spam',[$hits,$req,$mid,$stamp],'*');
			inc_spam_hash($mhash);
			return do_action_bounce(sprintf("Message seems to be spam (%03.1f/%i) [%s] {%s}",$hits,$req,$when,$mid));
		}
	}

	# Split locally generated mail by whatever?
	where_log('filter_before stream');
	if ($StreamBlack && check_black_nets($RelayAddr) && $#Recipients>0) {
		if ($StreamBlack =~ /^r(?:ecipient|cpt)?$/i && stream_by_recipient()) {
			stats_log('stream',$MsgIDs,'black',['recipient',$StreamBlack,@Recipients]);
			return;
		}
		if ($StreamBlack =~ /^d(?:om(?:ain)?)?$/i && stream_by_domain()) {
			stats_log('stream',,$MsgIDs,'black',['domain',$StreamBlack,@Recipients]);
			return;
		}
		if ($StreamBlack =~ /^o(?:ur)?(?:d(?:om(?:ain)?)?)?$/i && stream_by_our()) {
			stats_log('stream',,$MsgIDs,'black',['our',$StreamBlack,@Recipients]);
			return;
		}
	}

	# Result-tester or report address?
	here_log('filter_before query/report');
	if ($MailResultAddress || $SpamReportAddress || $HamReportAddress) {
		my %xamr = ('spam'=>$SpamReportAddress,'ham'=>$HamReportAddress);
		my $spad = 0;
		for (my $ri=0; $ri<@Recipients; $ri++) {
			my $rea = address_strip($Recipients[$ri]);
			if ($spad) {
				stats_log('reject',$MsgIDs,'bad_user',$rea,'*');
				return do_action_bounce("Combining spam/ham report or result query adress with other addresses is not allowed!");
			}
			if ($MailResultAddress && $rea eq $MailResultAddress) {
				$spad ++;
				$is_result_query = 1;
				spamassassin_hit('RESULT_QUERY',0,'Mail is a filter result query');
			}
			while (my ($xamt,$xama) = each %xamr) {
				if ($xama && $rea eq $xama) {
					$spad ++;
					$is_xam_report = $xamt;
					spamassassin_hit(uc($xamt).'_REPORT',0,"Mail is a $xam report");
				}
			}
			if ($spad > 1 || ($spad && $ri)) {
				stats_log('reject',$MsgIDs,'bad_user',$rea,'*');
				return do_action_bounce("Combining spam/ham report or result query adress with other addresses is not allowed!");
			}
		}
	}
	debug_log(1,"filter_before: result query from $Sender") if ($is_result_query);
	debug_log(1,"filter_before: spam/ham report from $Sender") if ($is_xam_report);

	# Spam/ham report?
	return action_accept() if ($is_xam_report);

	# Dictionary list...
	#where_log('filter_before host');
	#if (!(check_internal_whitelist($RelayAddr) || check_external_whitelist($RelayAddr,$RelayHostname)) && dict_check_host($RelayAddr)) {
	#	debug_log(0,"filter_before: Black in Dictionary list, $RelayHostname [$RelayAddr]");
	#	#return ('CONTINUE', "We currently do not want mail from $ip, but go head anyway.");
	#	#md_syslog('info', "MDLOG,NOQUEUE,dict,$ip,?,?,?");
	#	stats_log('tempfail',$MsgIDs,'dict',$RelayAddr);
	#	return tempfail_this("At the moment we do not want mail from $RelayAddr.");
	#}

	# Check greylist here instead of in filter_recipient in order to handle
	# stupid mailers...
	where_log('filter_before greylist');
	if ($greylist && !(check_internal_whitelist($RelayAddr))) {
		$head = parse_headers() unless ($head);
		msgl_add($head->get('Message-ID'),0,$Sender,@Recipients) if ($head);
		if (greylist_exempt($RelayAddr,$hostn,$Helo,$Sender,\@Recipients,$head)) {
			$GreyListAction = 'Exempted'
		} else {
			my $greylistwait = 0;
			foreach my $crec (@Recipients) {
				if (!(check_external_whitelist($RelayAddr,$hostn,$Sender) || check_recipient_white('grey',$crec))) {
					#Check greylist
					my $grey;
					($grey,$GreyListAction) = greylist_check($RelayAddr,$Sender,$crec);
					if ($grey > 0) {
						my $greys = time_string($grey);
						debug_log(2, "filter_before: Greylisted ($greys), $Sender at $RelayAddr to $crec");
						$greylistwait = $grey if ($grey > $greylistwait);
					} elsif ($grey < 0) {
						md_syslog('warning', "filter_before: greylist_check returned error!");
						return do_action_tempfail("Something is not working right here. Please try again.");
					}
				}
			}
			if ($greylistwait) {
				my $greys = time_string($greylistwait);
				stats_log('tempfail',$MsgIDs,'grey',$greylistwait,'*');
				return do_action_tempfail("We might accept the mail in $greys.");
			}
		}
	}

	# Do a relay check on received lines as well. We do this because spammers
	# often send through backup servers. I know, the headers could be forged, but if
	# someone forges a received header so it looks like a mail is from a blacklisted
	# host I don't really mind if it gets rejected.
	# If the message gets here, we're not actually upset with the relay contacting us,
	# so we give a permanent error instead of tempfailing.
	where_log('filter_before received');
	if ($check_received && !((check_internal_whitelist($RelayAddr) && !check_any_relay_option($Helo,'outsider')) || check_recipients_white('relay',\@Recipients))) {
		$head = parse_headers() unless ($head);
		if ($head) {
			where_log('filter_before received.');
			my ($hit,$msg,$rcs)=check_received_lines($Sender,$head);
			where_log('filter_before received..');
			#debug_log(0,"filter_before: This mail would have been blocked becase of received lines: $msg") if ($hit);
			if ($hit) {
				dict_add_abuse($RelayAddr);
				return do_action_bounce($msg);
			}
			where_log('filter_before received...');
		}
	}

	where_log('filter_before end');
	#debug_log(0,'filter_before senders: %s',get_addresses_string_from_header($head,'From:Sender:Reply-To')) if ($head);
}

#***********************************************************************
# %PROCEDURE: filter_begin
# %ARGUMENTS:
#  entity -- a Mime::Entity object (see MIME-tools documentation for details)
# %RETURNS:
#  Nothing
# %DESCRIPTION:
#  Called just before e-mail parts are processed
#***********************************************************************
sub filter_begin($) {
	$MsgIDs = $MsgID;
	my($entity) = @_;

	return if message_rejected(); # Avoid unnecessary work
	here_log('filter_begin begin');
	#debug_log(0,'filter_begin senders: %s',get_addresses_string_from_header($entity,'From:Sender:Reply-To'));
	#debug_log(0,'filter_begin %s %s %s',$RealRelayHostname,$Sender,join(',',@Recipients));

	# Spam/ham report?
	return action_accept() if ($is_xam_report);

	$Features{"HTML::Parser"} = load_modules('HTML::Parser') unless ($Features{"HTML::Parser"});
	$Features{"HTML::TokeParser"} = load_modules('HTML::TokeParser') unless ($Features{"HTML::TokeParser"});
	$Features{"Archive::Zip"} = load_modules('Archive::Zip qw(:ERROR_CODES)') unless ($Features{"Archive::Zip"});
	
	html_cleaning_clear(1);
	$hc_main_entity = $entity;

	my $hostn = '';
	$hostn = $RelayHostname if (defined($RelayHostname));

	where_log('filter_begin srsdsn');
	return action_discard if (srs_capture_dsn($entity));
	#srs_capture_dsn($entity);
	
	if (pass_abuse() || check_recipients_white('security',\@Recipients)) {
		md_syslog('info', "Security-checking FB1 of message bypassed: $RelayAddr; ".join(', ',@Recipients));
		$warnhead{'Security-checking bypassed.'} ++;
	} else {
		# Always drop messages with suspicious chars in headers
		where_log('filter_begin chars');
		if ($SuspiciousCharsInHeaders) {
			if ($SASuspiciousHeadScore) {
				spamassassin_hit('SUSPECT_HEAD',$SASuspiciousHeadScore,'Suspicious characters in header.');
			} else {
				stats_log($SuspiciousHeadDiscard?'discard':'reject',$MsgIDs,'suspicious_chars','','*');
				do_action_quarantine_entire_message('stopped',"Message quarantined because of suspicious characters in headers.");
				return action_discard() if ($SuspiciousHeadDiscard);
				return do_action_bounce('Bad data: suspicious chars in header');
			}
		}
		if ($SuspiciousCharsInBody) {
			if ($SASuspiciousBodyScore) {
				spamassassin_hit('SUSPECT_BODY',$SASuspiciousBodyScore,'Suspicious characters in body.');
			} else {
				stats_log($SuspiciousBodyDiscard?'discard':'reject',$MsgIDs,'suspicious_chars','','*');
				do_action_quarantine_entire_message('stopped',"Message quarantined because of suspicious characters in body.");
				return action_discard() if ($SuspiciousBodyDiscard);;
				return do_action_bounce('Bad data: suspicious chars in body');
				#debug_log(0,'suspicious_chars in body');
			}
		}
	}

	# Check is spam
	where_log('filter_begin spam');
	if ($entity && $entity->head && !not_check_for_spam($entity,$verified)) {
		my ($spam,$when) = msgl_spam($entity->head->get('Message-ID'),$Sender,@Recipients);
		if ($spam) {
			debug_log(0,'filter_begin: spam %u',abs($spam));
			dict_add_abuse($RelayAddr);
			if ($spam>0) {
				$when = load_modules('Date::Format') ? time2str('%Y-%m-%d %H:%M:%S',$when) : sprintf('%u',$when);
				debug_log(0,'filter_begin: spam %u %s',$spam,$when);
				stats_log('reject',$MsgIDs,'spam_repeat',[$entity->head->get('Message-ID'),$spam,$when],'*');
				return do_action_bounce(sprintf("Message seemed to be spam (%u, %s)",$spam,time2str('%Y-%m-%d %H:%M:%S',$when)));
			}
		}
	}

	where_log('filter_begin virus');
	if (check_virus_bypass('',$RelayAddr,$RelayHostname,$Sender,\@Recipients) && !check_any_relay_option($Helo,'outsider')) {
		md_syslog('info', "Virus-checking bypassed for: $RelayAddr");
		$warnhead{'Virus-checking bypassed.'} ++;
	} elsif (check_virus_time_exceeded($RelayAddr,$hostn)) {
		md_syslog('info', "Virus-checking bypassed because of time limit for: $RelayAddr");
		$warnhead{'Virus-checking bypassed.'} ++;
	} else {
		# Copy original message into work directory as an "mbox" file for
		# virus-scanning
		#md_copy_orig_msg_to_work_dir();
		md_copy_orig_msg_to_work_dir_as_mbox_file();

		# Scan for viruses if any virus-scanners are installed
		debug_log(2,"Virus Scan Start Mail");
		my ($code,$ocategory,$oaction,$virname) = thingy_contains_virus();
		debug_log(2,"Virus Scan End Mail"); 
		my ($catact,$category,$action) = antivirus_map_catact('message',$code,$ocategory,$oaction,$virname);
		$forcespamcheck ++ if ($action eq 'quarantine');
		if (spamassassin_virus_hit('message',$code,$ocategory,$oaction,$virname) && !$catact) {
			$category = 'ok';
			$action = 'ok';
		}
		# Lower level of paranoia - only looks for actual viruses
		$FoundVirus ++ if($category eq "virus");
		$FoundSuspected ++ if ($action eq "quarantine");
		# Higher level of paranoia - takes care of "suspicious" objects
		#$FoundVirus = ($action eq "quarantine");
	
		my $vscanner = get_antivirus_string();
		do_action_insert_or_change_header($entity,"X-Virus-Scanned-By", "$MyFilterHostName, using $vscanner");
		if ($action eq "tempfail") {
			# Find out wich virus-scanner(s) we're using...
			md_syslog('warning', "Problem running virus scanner: code=$code, category=$category, action=$action, scanners=$vscanner");
			return do_action_tempfail("Problem running virus-scanner");
		} elsif ($FoundVirus) {
			$virname =~ s/, ?/ /g;
			# Discard the entire message.
			spamassassin_hit('VIRUS_MAIL',$SASuspiciousScore,'A virus-scanner found a virus.');
			do_result_report($entity,0,"Message contained virus: $virname");
			dict_add_virus($RelayAddr);
			report_address_relay_virus($RelayAddr);
			if (pass_abuse()) {
				debug_log(-1,'filter_begin virus-scan: %s %s','virus',$virname);
			} else {
				#md_graphdefang_log('virus', $virname, $RelayAddr);
				stats_log($VirusDiscard?'discard':'reject',$MsgIDs,'virus',$virname,'*');
				return action_discard() if ($VirusDiscard);
				return do_action_bounce("Message contained virus: $virname");
			}
		} else {
			if ($FoundSuspected) {
				debug_log(1,'filter_begin virus-scan: %s %s','suspected',$virname);
				spamassassin_hit('SUSPECT_MAIL',$SASuspiciousScore,'A virus-scanner found this mail suspicious.');
			} elsif ($category ne 'ok') {
				debug_log(-1,'filter_begin virus-scan: %s %s %s',$category,$action,$code);
			}
		}
	}

	where_log('filter_begin check replace attachments');
	check_replace_attachments($entity,(check_internal_whitelist($RelayAddr)||check_authenticated()));

	where_log('filter_begin end');
}

#***********************************************************************
# %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) = @_;
	#die('Missing modules!') unless (load_modules('Mail::Header'));

	return if message_rejected(); # Avoid unnecessary work
	where_log('filter begin');
	#debug_log(0,"filter fn:'$fname' fe:'$ext' mt:'$type'") if ($fname || $ext);# || ($type && $type !~ /^text\/(plain|html)$/));
	
	# Spam/ham report?
	return action_accept() if ($is_xam_report);

	# Fix headers?
	if (fix_entity_headers($entity)) {
		action_rebuild();
	}

	# Security checks 1
	if (pass_abuse() || check_recipients_white('security',\@Recipients)) {
		md_syslog('info', "Security-checking F1 of entity bypassed: $RelayAddr; ".join(', ',@Recipients));
		$warnhead{'Security-checking bypassed.'} ++;
	} else {
		# Block message/partial parts
		if (lc($type) eq "message/partial") {
			#md_graphdefang_log('message/partial');
			stats_log('reject',$MsgIDs,'partial','','*');
			return do_action_bounce("MIME type message/partial not accepted here");
			return action_discard();
		}
	}

	# Virus scan
	if (check_virus_bypass('',$RelayAddr,$RelayHostname,$Sender,\@Recipients)) {
		md_syslog('info', "Virus-checking of entity bypassed for: $RelayAddr");
		$warnhead{'Virus-checking bypassed.'} ++;
	} else {
		my $hostn = '';
		$hostn = $RelayHostname if (defined($RelayHostname));

		where_log('filter virus');
		if (check_virus_time_exceeded($RelayAddr,$hostn)) {
			md_syslog('info', "Virus-checking for entity bypassed because of time limit for: $RelayAddr");
			$warnhead{'Virus-checking bypassed.'} ++;
		} elsif (check_virus_entity_no_scan($entity)) {
			md_syslog('info', "Virus-checking bypassed because of entity size: $RelayAddr");
			$warnhead{'Virus-checking bypassed.'} ++;
		} else {
			debug_log(2,"Virus Scan Start Entity");
			my ($code,$ocategory,$oaction,$virname) = thingy_contains_virus($entity);
			debug_log(2,"Virus Scan End Entity");
			my ($catact,$category,$action) = antivirus_map_catact('entity',$code,$ocategory,$oaction,$virname);
			$forcespamcheck ++ if ($action eq 'quarantine');
			if (spamassassin_virus_hit('entity',$code,$ocategory,$oaction,$virname) && !$catact) {
				$category = 'ok';
				$action = 'ok';
			}

			# If you are more paranoid, change to: if ($action eq "quarantine") {
			if ($category eq "virus") {
				$FoundVirus ++;
				$virname =~ s/, ?/ /g;
				#md_graphdefang_log('virus', $virname, $RelayAddr);
				stats_log('discard',$MsgIDs,'virus',$virname,'*');
				#action_add_header("X-Virus-Scan", "Found and deleted $virname");
				# Discard the entire message.
				spamassassin_hit('VIRUS_ENTITY',$SASuspiciousScore,'A virus-scanner found a virus.');
				do_result_report(0,0,"Message contained virus: $virname");
				dict_add_virus($RelayAddr);
				report_address_relay_virus($RelayAddr);
				if (pass_abuse()) {
					debug_log(-1,'filter virus-scan: %s %s','virus',$virname);
				} else {
					stats_log($VirusDiscard?'discard':'reject',$MsgIDs,'virus',$virname);
					return action_discard() if ($VirusDiscard);
					return do_action_bounce("Entity contained virus: $virname");
				}
			} elsif ($action eq "quarantine") {
				$FoundSuspected ++;
				# But quarantine the part for examination later.  Comment
				# the next line out if you don't want to bother.
				if (pass_abuse()) {
					debug_log(-1,'filter_begin: %s %s','suspected',$virname);
				} else {
					debug_log(1,'filter_begin: %s %s','suspected',$virname);
					$modhead{'Quarantined suspicious entity.'} ++;
					#md_graphdefang_log('suspect_entity', $fname, $type);
					stats_log('modified',$MsgIDs,'suspect_entity',$fname);
					removed_part_note("An attachment named \"$fname\"",'was suspected of being a virus');
					spamassassin_hit('SUSPECT_ENTITY',$SASuspiciousScore,'A virus-scanner found suspicious content.');
					return do_action_quarantine('removed',$entity,"Suspected virus: \"$fname\"");
				}
			} elsif ($action eq "tempfail") {
				return do_action_tempfail("Problem running virus-scanner");
				md_syslog('warning', "Problem running virus scanner: code=$code, category=$category, action=$action");
			} elsif ($category ne 'ok') {
				debug_log(-1,'filter virus-scan: %s %s %s',$category,$action,$code);
			}
		}
	}

	# Security checks 2
	if (pass_abuse() || check_recipients_white('security',\@Recipients)) {
		md_syslog('info', "Security-checking F2 of entity bypassed: $RelayAddr; ".join(', ',@Recipients));
		$warnhead{'Security-checking bypassed.'} ++;
	} else {
		where_log('filter filename');
		if (check_bad_filename($entity) && !(check_recipients_white('filename',\@Recipients) && check_sender_white('filename',$Sender))) {
			$modhead{'Quarantined file with bad name.'} ++;
			#md_graphdefang_log('bad_filename', $fname, $type);
			stats_log('modified',$MsgIDs,'bad_filename',[$fname,$type]);
			removed_part_note("An attachment named \"$fname\"",'constituted a security hazard');
			return do_action_quarantine('removed',$entity,"Bad file name: \"$fname\"");
		}

		# eml is bad if it's not multipart
		#if (re_match($entity, '\.eml')) {
		#	$modhead{'Quarantined bad eml attachment.'} ++;
		#	#md_graphdefang_log('non_multipart');
		#	stats_log('modified',$MsgIDs,'non_multipart',$fname);
		#	return action_quarantine($entity,
		#		removed_part_note("A non-multipart attachment named \"$fname\"",'constituted a security hazard').
		#		note_footer('QDir:'.get_quarantine_dir())
		#	);
		#}

		# Check that office files aren't executables (thanks again M$)
		where_log('filter office');
		my $re = '\.' . $office_exts;
		if ((re_match_ext($entity, $re) || $type =~ /\/(ms|microsoft)-?(word|access|powerpoint|excel)$/i) &&
				(defined($entity->bodyhandle) && defined($entity->bodyhandle->path))) {
			my $ft = check_file_type($entity->bodyhandle->path);
			if ($ft && $ft =~ /executable/i) {
				dict_add_virus($RelayAddr);
				$modhead{'Quarantined hidden executable.'} ++;
				#debug_log(0,"filter: This attach would have been quarantined because it is executable: $fname");
				#md_graphdefang_log('hidden_executable');
				stats_log('modified',$MsgIDs,'hidden_executable',$fname);
				removed_part_note("A probable MS Office attachment named \"$fname\"",'seemed to be an executable file');
				return do_action_quarantine('removed',$entity,"Hidden executable: \"$fname\"");
			}
		}

		#Cleaning HTML code
		where_log('filter clean');
		if ($type eq "text/html" && $disable_bad_html && load_modules('HTML::Parser','HTML::Entities','CSS::Tiny')) {
			# Clean up HTML if Anomy::HTMLCleaner is installed.
			# $Features{"HTMLCleaner"} = load_modules('Anomy::HTMLCleaner');
			#if ($Features{"HTMLCleaner"}) {
			#	if ($type eq "text/html") {
			#		$ModifiedHTML = 1;
			#		return anomy_clean_html($entity);
			#	}
			#}

			my($currentline, $output, $badtag, $delimiter_backup);
			$badtag = 0;
			$output = "";
			if (defined($entity->bodyhandle) && defined($entity->bodyhandle->path) &&
			    (-s $entity->bodyhandle->path <= $dbh_sizelimit) &&
			    (-s $entity->bodyhandle->path <= $mailtoobig)) {
				if ($io = $entity->open("r")) {
					{
						local $/;
						$output = $io->getline;
						$io->close;
					}
					# Test the experimental stuff and report
					debug_log(4,"filter: HTML Check");
					my ($ch,$nh) = html_cleaning_thingy($output);
					if ($ch) {
						debug_log(1,"filter: HTML Changed");
						my ($octeh,$ncteh) = ('','');
						if ($entity->head) {
							$octeh = $entity->head->mime_attr('Content-transfer-encoding');
							$octeh = '' unless (defined($octeh));
							if ($octeh !~ /^(base64|quoted-printable)$/i) {
								debug_log(1,"filter: HTML Transfer Encoding Changed");
								$ncteh = 'quoted-printable';
								$entity->head->mime_attr('Content-transfer-encoding',$ncteh);
							}
						}
						html_cleaning_report($output,$nh,$octeh,$ncteh) if (defined($dbh_report) && $dbh_report);
						if ($io = $entity->open("w")) {
							$io->print($nh);
							$io->close;
							$ModifiedHTML = 1;
							#md_graphdefang_log('modified_entity', 'html');
							#md_graphdefang_log('modified_entity', 'encoding') if ($ncteh);
							stats_log('modified',$MsgIDs,'modified_entity','html');
							stats_log('modified',$MsgIDs,'modified_entity','encoding') if ($ncteh);
							action_rebuild();
						}
					}
					# KAM stuff currently disabled...
					# Based on work by Columbia University / Joseph Brennan
					# Thanks KAM (Kevin A. McGrail)
					#$badtag = $output =~ s/<(iframe|script|object)\b/<no-$1 /igs;
					#if ($badtag) {
					#	if ($io = $entity->open("w")) {
					#		$io->print($output);
					#		$io->close;
					#	}
					#	$ModifiedHTML = 1;
					#	#md_graphdefang_log('badhtml',$badtag);
					#	stats_log('modified',$MsgIDs,'badhtml',$badtag);
					#	#action_change_header("X-Warning", "$badtag Iframe/Object/Script tag(s) deactivated by MIMEDefang");
					#	action_rebuild();
					#}
				}
			}
		}
	}

	unless (pass_abuse() || check_recipients_white('attachments',\@Recipients)) {
		where_log('filter attach');
		if (maybe_replace_attachment($entity,$fname,$type)) {
			stats_log('modified',$MsgIDs,'replaced_attachment',$fname);
			return 1;
		}
	}

	where_log('filter end');
	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 ($$$$) {
	$MsgIDs = $MsgID;

	my($entity, $fname, $ext, $type) = @_;
	#die('Missing modules!') unless (load_modules('Mail::Header'));

	return if message_rejected(); # Avoid unnecessary work
	where_log('filter_multipart begin');

	# Spam/ham report?
	return action_accept() if ($is_xam_report);

	# Fix headers?
	if (fix_entity_headers($entity)) {
		action_rebuild();
	}

	# Check recipient white list
	return action_accept() if (pass_abuse() || check_recipients_white('security',\@Recipients));

	where_log('filter_multipart filename');
	if (check_bad_filename($entity) && !(check_recipients_white('filename',\@Recipients) && check_sender_white('filename',$Sender))) {
		$modhead{'Quarantined file with bad name.'} ++;
		#md_graphdefang_log('bad_filename', $fname, $type);
		stats_log('modified',$MsgIDs,'bad_filename',[$fname,$type]);
		#action_notify_administrator("A MULTIPART attachment of type \"$type\", named \"$fname\" was dropped.\n");
		removed_part_note("An attachment of type \"$type\", named \"$fname\"",'constituted a security hazard');
		return do_action_quarantine('removed',$entity,"Bad file name: \"$fname\" (\"$type\")");
	}

	# eml is bad if it's not message/rfc822
	if (re_match($entity, '\.eml') and ($type ne "message/rfc822" && $type ne "text/plain")) {
		$modhead{'Quarantined bad eml attachment.'} ++;
		#md_graphdefang_log('non_rfc822', $fname);
		stats_log('modified',$MsgIDs,'non_rfc822',$fname);
		removed_part_note("A non-message/rfc822 attachment named \"$fname\"",'constituted a security hazard');
		return do_action_quarantine('removed',$entity,"Non RFC822 eml: \"$fname\"");
	}

	# Block message/partial parts
	if (lc($type) eq "message/partial") {
		#md_graphdefang_log('message/partial');
		stats_log('reject',$MsgIDs,'partial','','*');
		do_result_report(0,0,"Message contained part of type message/partial.");
		do_action_bounce("MIME type message/partial not accepted here");
		return;
	}

	where_log('filter_multipart end');
	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";
}

#***********************************************************************
# %PROCEDURE: filter_end
# %DESCRIPTION:
#  The last of the filter functions.
#  is defanged.
#
# If SpamAssassin found SPAM, append report.  We do it as a separate
# attachment of type text/plain
#***********************************************************************
sub filter_end ($) {
	$MsgIDs = $MsgID;

	my($entity) = @_;
	#die('Missing modules!') unless (load_modules('Mail::Header'));

	# No sense doing any extra work
	if (message_rejected()) {
		clear_from_filter_end();
		return;
	}
	where_log('filter_end begin');
	
	# Spam report?
	if (handle_xam_report($is_xam_report)) {
		clear_from_filter_end();
		return action_discard();
	}
	
	my $versions = 'MIMEDefang '.md_version()." with local filter $FilterVersion";

	where_log('filter_end verify');
	my @AuthPassed = ();
	my $AuthFail = 0;
	my @AuthResults = ();
	my @warninginfos = ();
	if (will_verify()) {
		my @AuthForged = ();
		my @results = ();
		my $failures = '';
		my $isint = (check_internal_whitelist($RelayAddr) || check_black_nets($RelayAddr));
		$AuthFail ++ unless (check_verified_check('Relay',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_relay_network($entity,\@AuthResults)));
		$AuthFail ++ unless (check_verified_check('Auth',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_authenticated($entity,\@AuthResults)));
		$AuthFail ++ unless (check_verified_check('PGP',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_pgp_signature($entity,\@AuthResults)));
		$AuthFail ++ unless (check_verified_check('S/MIME',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_smime_signature($entity,\@AuthResults)));
		del_authentication_results($entity,$isint);
		unless ($isint) {
			$AuthFail ++ unless (check_verified_check('DomainKeys',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_dk_signature($entity,\@AuthResults)));
			$AuthFail ++ unless (check_verified_check('DKIM',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_dkim_signature($entity,\@AuthResults)));
			$AuthFail ++ unless (check_verified_check('SPF',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_spf_mfrom($entity,\@AuthResults)));
			$AuthFail ++ unless (check_verified_check('SPF',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_spf_helo($entity,\@AuthResults)));
			$AuthFail ++ unless (check_verified_check('SPF',\$failures,\@results,\@AuthPassed,\@AuthForged,verify_spf_pra($entity,\@AuthResults)));
		}
		add_verified_results();
		if ($failures) {
			debug_log(3,'filter_end: %s auth failures: <%u> %s',$MsgIDs,$AuthFail,$failures);
			do_action_insert_header($entity,'X-Auth-Failed',sprintf('%s:%s %s',$MyFilterHostName,$MsgIDs,$failures));
		}
		unless ($failures || @AuthForged || $AuthFail) {
			my @cap = clean_auth_passed($entity,@AuthPassed);
			do_action_insert_header($entity,'X-Auth-Passed',sprintf('%s:%s %s',$MyFilterHostName,$MsgIDs,join(' ',@cap))) if (@cap);
		}
		do_action_insert_header($entity,'X-Auth-Forged',sprintf('%s:%s %s',$MyFilterHostName,$MsgIDs,join(' ',@AuthForged))) if (@AuthForged);
		add_authentication_results($entity,\@results);
		push @warninginfos, list_authentication_failures(\@results);
		if ($is_result_query && $MailResultVerify && !$isint) {
			my $rqok = 0;
			foreach $vfy (@AuthPassed) {
				my ($vt,$snd) = split(/:/,$vfy,2);
				next unless ($vt =~ /^(SPF|DKIM|DK|DomainKey)$/i);
				debug_log(1,"filter_end: verify result %s",$snd);
				if (check_sender_white('result',$snd)) {
					$rqok = 1;
					last;
				}
			}
			unless ($rqok) {
				debug_log(1,"filter_end: bounce unverified result query");
				stats_log('reject',$MsgIDs,'unverified_query','','*');
				clear_from_filter_end();
				return do_action_bounce("Result queries must be from verified sender!");
			}
		}
	}

	where_log('filter_end bouncecoll');
	collect_bouncing_addresses();
	
	where_log('filter_end spam');
	my ($ipos,$iposver,$iposhead) = get_ip_os();
	my $country = get_ip_country($RelayAddr);
	my ($nospamcheck,$gdbhostreset) = check_for_spam($entity,\@AuthPassed,$ipos,$iposver,$iposhead,$country,\@AuthResults);
	$iposhead = '' if ($ipos =~ /^\s*unknown\s*$/is);

	if (message_rejected()) {
		clear_from_filter_end();
		return;
	}

	# Whitelist host in greylist...
	greylist_white_host($RelayAddr) unless ($gdbhostreset || check_internal_whitelist($RelayAddr));

	# Local bypassing delivery?
	my $ldal = read_delivery_file('local-delivery');
	if ($ldal) {
		my $trapped = 0;
		for my $ai (@{$ldal}) {
			foreach my $rcpt (@Recipients) {
				next unless ($rcpt =~ /^<?$ai->{a}?>$/);
				$trapped ++;
				stats_log('trapped',$MsgIDs,$rcpt,'','*');
				do_xam_report('local-delivery',$ai->{d},$rcpt,$ai->{a});
				do_del_recipients($rcpt) if ($ai->{w} =~ /[->]/ && $ai->{w} !~ /[=+]/);
				trap_add($RelayAddr);
				stats_log('deliver',$MsgIDs,'local','','*');
			}
		}
		if ($trapped && !list_recipients()) {
			stats_log('discard',$MsgIDs,'trapped',\@Recipients);
			clear_from_filter_end();
			return action_discard();
		}
	}

	# Fix headers?
	where_log('filter_end headers');
	fix_entity_headers($entity,1);

	# Exclaim?
	where_log('filter_end exclaim');
	do_action_insert_or_change_header($entity,"X-Exclamation",$silly_exclaim,-1);
	do_action_insert_or_change_header($entity,'X-Fortune',get_oneliner(),-1);

	# Add hashcashes
	where_log('filter_end hashcash');
	add_hashcashes($entity);

	# Add an easy to read envelope header and write a log.
	where_log('filter_end envelope header');
	if ($is_result_query) {
		$logas = 'result_query';
	} elsif ($nospamcheck) {
		$logas = 'passed';
	} else {
		$logas = 'accepted';
	}
	my $rsmtpfrom = "Mail From: $Sender\n";
	my $xsmtpfrom = "$logas $Sender";
	if ($RelayHostname) {
		$xsmtpfrom .= " $RelayHostname";
		$rsmtpfrom .= "Relay Name: $RelayHostname\n";
	}
	$xsmtpfrom .= " [$RelayAddr] ($Helo)";
	$rsmtpfrom .= "Relay Addr: $RelayAddr\n";
	$rsmtpfrom .= "Relay Helo: $Helo\n";
	get_received_countries($entity);
	my $location = get_ip_location($RelayAddr);
	add_a_country($country) if ($country);
	if ($location) {
		$xsmtpfrom .= " {$location}";
		$rsmtpfrom .= "Relay Location: $location\n";
	} elsif ($country) {
		$xsmtpfrom .= " {$country}";
		$rsmtpfrom .= "Relay Country: $country\n";
	}
	if ($iposhead) {
		$xsmtpfrom .= " [$iposhead]";
		$rsmtpfrom .= "Relay OS: $iposhead\n";
	}
	do_action_insert_header($entity,"X-SMTP-From", $xsmtpfrom,0);
	if (@countries) {
		add_a_country($MyFilterHostCountry) if ($MyFilterHostCountry);
		#debug_log(0,'Countries: %s',join(', ',@countries));
		do_action_insert_header($entity,"X-Countries", mqpma(1,@countries),0);
	}

	unshift @result_reports, $rsmtpfrom if ($is_result_query);
	#if (defined($RelayHostname) && $RelayHostname ne "") {
	#	md_graphdefang_log($logas, $RelayHostname, $RelayAddr);
	#} else {
	#	md_graphdefang_log($logas, $Helo, $RelayAddr);
	#}
	stats_log('deliver',$MsgIDs,$logas,'','*');

	# If you don't mind HTML mail, comment out the next lines.
	# Remove redundant HTML if mail to *.frukt.org.
	where_log('filter_end remove redundant');
	if ($RemoveRedundantHTMLFor && !(pass_abuse() || check_recipients_white('html',\@Recipients))) {
		foreach my $currecipient (@Recipients) {
			#md_syslog('info',"RRHP: R=$currecipient");
			if ($currecipient =~ /^<?$RemoveRedundantHTMLFor>?$/i) {
				debug_log(5,'remove redundant "%s" "%s"',$currecipient,$RemoveRedundantHTMLFor);
				#md_syslog('info',"RRHP: R!");
				if (remove_redundant_html_parts($entity)) {
					stats_log('modified',$MsgIDs,'removed_redundant','html');
					debug_log(2,"filter_end: Removing redundant HTML");
					$modhead{'Removed redundant HTML part(s).'} ++;
					append_text_boilerplate($entity, "---------------------------------------------------------\nGateway notice:\nRedundant HTML parts have been removed from this message.", 0);
					$ModifiedHTML = 0;
				}
				last;
			}
		}
	}

	where_log('filter_end warnings 1');
	if (@removed_parts) {
		$modhead{'Removed parts.'} ++;
		push @warningtexts, join("\n",@removed_parts,'',"If you require the removed content, please contact the sender or $AdminName <$AdminContactAddress> and arrange an alternate means of receiving it.",'');
		debug_log(3,"filter_end, added part removal warning.");
	}
	if ($FoundVirus || $FoundSuspected) {
		my $warntxt;
		$modhead{'Added warning about bad content.'} ++;
		if ($FoundVirus) {
			$warntxt = "WARNING: A virus was found in this message, but for some unfathomable reason it was allowed to pass the gate.";
		} else {
			$warntxt = "Warning: This message was considered suspicious by at least one virus-scanner.";
		}
		push @warningtexts, "$warntxt\nBe careful of what you do with it!\n";
		debug_log(2,"filter_end, added content modification warning.");
	}
	if ($AuthFail && $authfailwarning) {
		$modhead{'Added warning about failed authenticity check(s).'} ++;
		push @warningtexts, "WARNING: This message failed $AuthFail authenticity check(s). It might be a forgery.\n";
		debug_log(1,"filter_end, added authenticity modification warning.");
	}
	if ($ModifiedHTML) {
		$modhead{'Cleansed HTML code.'} ++;
		#action_add_part($entity, "text/plain", "-suggest",
		#	"The HTML code in this mail was modified for security reasons.\n" . note_footer(),
		#	'', #"Modified.txt",
		#	"inline",0);
		do_action_quarantine_entire_message('modified','Modified HTML code in message.');
		action_rebuild();
		move_html_cleaning_reports(get_quarantine_dir());
		push @warningtexts, "HTML in this message code was modified for security reasons.\n" if (@warningtexts);
		debug_log(1,"filter_end, added HTML modification warning.");
	}

	where_log('filter_end attachments');
	if (add_attachment_replacement_note($entity,1,1,0)) {
		debug_log(0,'added attachment replacement note');
		$modhead{'Added attachment replacement note.'} ++;
		push @warningtexts, "Attachment(s) in this message was replaced because of size.\n" if (@warningtexts);
	}

	where_log('filter_end warnings 2');
	if (@warningtexts) {
		$modhead{'Added warning.'} ++;
		action_add_part($entity,"text/plain","-suggest",join("\n",@warningtexts,note_footer(@warninginfos)),"Important.txt","inline",0);
		action_rebuild();
		debug_log(1,"filter_end, added warnings.");
	}
	if (replace_overlong_headers($entity)) {
		$modhead{'Replaced overlong header(s).'} ++;
	}

	do_action_insert_header($entity,"X-Scanned-By", "$MyFilterHostName, using $versions");
	do_action_insert_header($entity,"X-Hash", $input_message_hash) if ($input_message_hash);

	# Handle boilerplates... Hopefully there aren't any...
	my $abpbp = handle_boilerplates($entity);
	
	# Handle recipient forwards
	unless ($is_result_query) {
		srs_recipients();
		forward_recipients();
		expand_recipients();
	}

	do_action_insert_header($entity,'X-Warnings',join("\n\t",keys %warnhead)) if (%warnhead);

	if (%modhead) {
		if ($did_quarantine) {
			my $qdirn = get_quarantine_dir();
			$qdirn =~ s/^.*\///;
			$modhead{"QDir: $qdirn"} ++;
		}
		foreach my $mht (keys %modhead) {
			delete($modhead{$mht}) unless ($modhead{$mht});
		}
		do_action_insert_header($entity,"X-Modified",join("\n\t",keys %modhead),0) if (%modhead);
	}

	html_cleaning_clear(1);

	if ($GreyListAction && wants_extra_headers()) {
		my $msgi = msgl_info_str($entity->head->get('Message-ID'),$Sender,@Recipients) if ($entity && $entity->head);
		$msgi = " ($msgi)" if ($msgi);
		do_action_insert_header($entity,'X-Greylist',"$GreyListAction$msgi");
	}

	# Whatever...
	do_action_insert_header($entity,"X-Sendmail-Macros",macros_text('H')) if (wants_extra_headers());

	# Almost all mods done, so flag waving is possible here
	wave_flags($entity);

	# Now we're finished, so we can read the stamp...
	my $time = time_string(time_since_stamp());
	#md_syslog('info', "$MsgIDs: Time=$time");
	do_action_insert_header($entity,"X-Filter-Time",sprintf('%us (%03.1fL %u%%)',$time,get_load_average(),get_swap_percentage()),0) if (wants_extra_headers());

	where_log('filter_end result query');
	if ($is_result_query) {
		my $rqr = "Scanner: $MyFilterHostName, using $versions\n".
			  "Scan Time: $time\n";
		$rqr .= join("\n",'Warnings:',keys %warnhead,'') if (%warnhead);
		$rqr .= join("\n",'Actions:',keys %modhead,'') if (%modhead);
		unshift @result_reports, $rqr;
	}
	do_result_report($entity,$modhead ne '');
	if ($is_result_query) {
		$is_result_query = 0;
		debug_log(2,'Discarding result query message.');
		clear_from_filter_end();
		return action_discard();
	}
	do_action_delete_header($entity,'Bcc');

	# apply pending recipient list changes
	unless (sync_recipients($entity)) {
		stats_log('reject',$MsgIDs,'no_recipients','','*');
		clear_from_filter_end();
		return action_discard();
	}

	# save to sentoutdb?
	# Sender Rewriting?
	out_add($entity,$Sender,@Recipients);
	if (srs_sender()) {
		out_add($entity,$Sender,@Recipients);
	}
	
	clear_from_filter_end();
	where_log('filter_end end');
}

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