#!/usr/bin/perl
#***********************************************************************
#
# mdf-mail-reporter
#
# mimedefang-filter spam/ham report handler
#
# $Id: mdf-mail-reporter.pl,v 1.33 2009/12/17 18:16:36 jonas Exp $
#
# This program may be distributed under the terms of the GNU General
# Public License, Version 2, or (at your option) any later version.
#
#***********************************************************************

use strict;
use Socket;
use MIME::Parser;
use MIME::Entity;
use Email::Address;
use Email::Received;
use Email::MessageID;
use Mail::Field;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Client;
use Mail::SpamAssassin::Util::RegistrarBoundaries;
use LockFile::Simple;
use Date::Parse;
use Sys::Syslog;
use Digest::MD5;
use Digest::SHA;
use DBI;
use YAML::XS;
use Regexp::Common qw(net URI);
use URI::Find::Schemeless;
use HTML::Tree;
use Net::DNS;
use CGI;
use CGI::Pretty;
use CSS::Tiny;
use Date::Format;

my $debug	= 0;
my $debugprint	= 0;
my $debugnoage	= 0;
my $stdlog	= 0;
my $learnage	= 30*24*60*60;
my $forwardage	= 3*24*60*60;
my $parseage	= 3*24*60*60;
my $maxage	= 0; foreach my $cage (($learnage,$forwardage,$parseage)) { $maxage = $cage if ($cage > $maxage); }

my $postconf	= '';
my $noreport	= 0;
my $nosend	= 0;
my $nochange	= 0;
my $noparse	= 0;
my $nosave	= 0;
my $nospam	= 0;
my $noham	= 0;
my $spamd	= '';
my $mailto	= '';

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

openlog("mdfrep","pid","mail");
my $locker = LockFile::Simple->make(-autoclean=>1,-hold=>24*60*60,-stale=>1);

sub log_msg {
	syslog('notice',@_);
	return unless ($debug || $stdlog);
	my $msg = shift @_;
	print sprintf("$msg\n",@_);
}

sub file_id {
	my $fn = shift;
	my $ft = shift;
	$ft = '' unless ($ft);
	$fn =~ s/^.*\///;
	$fn =~ s/$ft$//;
	return $fn;
}

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

#***********************************************************************
# Config.
#***********************************************************************

my $FilterRevision = '$Revision: 1.33 $';
my $FilterUtilVers = '?';
if ('$Id: mdf-mail-reporter.pl,v 1.33 2009/12/17 18:16:36 jonas Exp $' =~ /^\S+?:\s(\S+?),v\s([.\d]+)\s/) { $FilterUtilVers = "$1 $2"; }

my %Features;
$Features{'Path:SPOOLDIR'} = '/var/spool/MIMEDefang';

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

use vars qw($MyFilterHostName $MyFilterHostNames $AdminAddress $AdminContactAddress $OurDomains);
add_cfg_cfg('MyFilterHostName',\$MyFilterHostName,'host.domain.tld','s');
add_cfg_cfg('MyFilterHostNames',\$MyFilterHostNames,'','l','myfilterhostname');
add_cfg_cfg('AdminAddress',\$AdminAddress,'postmaster','a');
add_cfg_cfg('AdminContactAddress',\$AdminContactAddress,'','a');
add_cfg_cfg('OurDomains',\$OurDomains,'','l','myfilterhostnames');

use vars qw($SpamReportSpool $HamReportSpool $SpamTrapSpool $SASizeLimit $SpamReportForward $PurgeSpools $SpamReportSender);
add_cfg_cfg('SpamReportSpool',\$SpamReportSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('HamReportSpool',\$HamReportSpool,'/var/spool/ham-reports','p');
add_cfg_cfg('SpamTrapSpool',\$SpamTrapSpool,'/var/spool/spam-reports','p');
add_cfg_cfg('SASizeLimit',\$SASizeLimit,200*1024,'i');
add_cfg_cfg('SpamReportForward',\$SpamReportForward,'','ms');
add_cfg_cfg('PurgeSpools',\$PurgeSpools,30*24*60*60,'i');
add_cfg_cfg('SpamReportSender',\$SpamReportSender,'','a');

use vars qw($SpamParseSpool $SpamParseURL);
add_cfg_cfg('SpamParseSpool',\$SpamParseSpool,'/var/spool/spam-parsed','p');
add_cfg_cfg('SpamParseURL',\$SpamParseURL,'','s');

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($sa_database_spec $sa_database_user $sa_database_pass);
add_cfg_cfg('sa_database_spec',\$sa_database_spec,'','p');
add_cfg_cfg('sa_database_user',\$sa_database_user,'','s');
add_cfg_cfg('sa_database_pass',\$sa_database_pass,'','s');

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($sendmailconfdir $sm_domains);
add_cfg_cfg('SendmailConfig',\$sendmailconfdir,'/etc/mail','p');
add_cfg_cfg('SM_Domains',\$sm_domains,'local-host-names;mailertable;virtdomains','mpsm');

# Get a file path name 
sub get_file_path_name {
	my $f = shift;
	return $f if ($f =~ /[\/\\]/);
	foreach my $d (('/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 the configuration file
sub read_cfg_params {
	my @pp = @ARGV;
	@ARGV = ();
	foreach my $p (@pp) {
		$p =~ s/^-+//;
		if ($p =~ /^H(?:am)?[-_]?R(?:eport)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
			$HamReportSpool = $1;
		} elsif ($p =~ /^S(?:pam)?[-_]?R(?:eport)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
			$SpamReportSpool = $1;
		} else {
			push @ARGV, $p;
		}
	}
}
sub read_cfg_cfg {
	my $cfgfn = get_file_path_name('filter.conf');
	if ($cfgfn) {
		die('No filter config!') unless ($cfgfn);
		$Features{'Path:CONFDIR'} = $cfgfn; $Features{'Path:CONFDIR'} =~ s/(\/filter)?\/[^\/]*$//;
		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*\$?$/) {
				#log_msg('Config %s: %s',$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;
	} else {
		$Features{'Path:CONFDIR'} = '.';
	}
	read_cfg_params();
	$Features{'Path:SPOOLDIR'} = '.' unless ($Features{'Path:SPOOLDIR'} && (-d $Features{'Path:SPOOLDIR'}));
	$Features{'Path:QUARANTINEDIR'} = '.' unless ($Features{'Path:QUARANTINEDIR'} && (-d $Features{'Path:QUARANTINEDIR'}));
	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;
			${$cfgcfg{$c}{v}} =~ s/\./\\./g if (${$cfgcfg{$c}{v}} !~ /\\\./);
			${$cfgcfg{$c}{v}} =~ s/\@/\\\@/g if (${$cfgcfg{$c}{v}} !~ /\\\@/);
			${$cfgcfg{$c}{v}} =~ s/\./\\./g if (${$cfgcfg{$c}{v}} !~ /\\\./);
			${$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 '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'});
		} 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';
#	}
	$spamd = -1 if ($spamdsocket || ($spamdhost && $spamdport));
}

# read parameters
sub read_params {
	my %gp = ();
	foreach my $p (@ARGV) {
		$p =~ s/^-+//;
		if ($p =~ /^P(?:ost)?[-_]?C(?:onf(?:if)?)?[:=]\s*(.*?)\s*$/i) {
			$postconf = $1;
		} elsif ($p =~ /^S(?:pam)?[-_]?D(?:aemon)?[:=]\s*(.*?)\s*$/i) {
			$spamd = $1;
		} elsif ($p =~ /^S(?:pam)?[-_]?D(?:aemon)?$/i) {
			$spamd = -1;
		} elsif ($p =~ /^S(?:pam)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
			$SpamReportSpool = $1;
			$HamReportSpool = '' unless ($gp{hrs});
			$SpamTrapSpool = '';
			$gp{srs} = 1;
		} elsif ($p =~ /^H(?:am)?[-_]?S(?:pool)?[:=]\s*(.*?)\s*$/i) {
			$HamReportSpool = $1;
			$SpamReportSpool = '' unless ($gp{srs});
			$SpamTrapSpool = '';
			$gp{hrs} = 1;
		} elsif ($p =~ /^No?[-_]?R(?:eports?)?$/i) {
			$noreport = 1;
		} elsif ($p =~ /^No?[-_]?S(?:ends?)?$/i) {
			$nosend = 1;
		} elsif ($p =~ /^No?[-_]?S(?:aves?)?$/i) {
			$nosave = 1;
		} elsif ($p =~ /^No?[-_]?C(?:hanges?)?$/i) {
			$nochange = 1;
		} elsif ($p =~ /^No?[-_]?P(?:ars(?:e|e?ing)s?)?$/i) {
			$noparse = 1;
		} elsif ($p =~ /^No?[-_]?S(?:pam)?[-_]?S(?:pool)?$/i) {
			$nospam = 1;
		} elsif ($p =~ /^No?[-_]?H(?:am)?[-_]?S(?:pool)?$/i) {
			$noham = 1;
		} elsif ($p =~ /^O(?:nly)?[-_]?S(?:pam)?$/i) {
			$noham = 1;
		} elsif ($p =~ /^O(?:nly)?[-_]?H(?:am)?$/i) {
			$nospam = 1;
		} elsif ($p =~ /^D(?:ebug)?$/i) {
			$debug = 1;
		} elsif ($p =~ /^D(?:ebug)?[-_]?P(?:rint)?$/i) {
			$debugprint = 1;
		} elsif ($p =~ /^D(?:ebug)?[-_]?No?[-_]?A(?:ge)?$/i) {
			$debugnoage = 1;
		}
	}
}

#***********************************************************************
# App...
#***********************************************************************

sub css {
	my $css = CSS::Tiny->new();
	$css->{'body'} = {
		'background-color'	=> 'rgb(220,255,220)',
		'color'			=> 'black',
		'margin'		=> '1%',
		'font-family'		=> 'arial, helvetica, sans-serif',
	};
	$css->{'h1'} = {
		'text-align'		=> 'center',
		'font-weight'		=> 'bold',
		'margin-top'		=> '0em',
		'margin-bottom'		=> '1em',
		'margin-left'		=> '0',
		'clear'			=> 'both',
	};
	$css->{'h2'} = {
		'font-weight'		=> 'bold',
		'margin-top'		=> '1em',
		'margin-bottom'		=> '0.5em',
		'margin-left'		=> '0',
		'clear'			=> 'both',
	};
	$css->{'tr'} = {
		'vertical-align'	=> 'baseline'
	};
	$css->{'table.top tr'} = {
		'vertical-align'	=> 'top'
	};
	$css->{'tr.even'} = {
		'background-color'	=> 'rgb(220,220,255)'
	};
	$css->{'tr.odd'} = {
		'background-color'	=> 'rgb(255,220,220)'
	};
	$css->{'th'} = {
		'background-color'	=> 'rgb(0,50,0)',
		'color'			=> 'rgb(220,255,220)',
	};
	$css->{'td'} = {
		'border-style'		=> 'none',
	};
	my $r = $css->write_string;
	$r =~ s/\{\s+/{/gs;
	$r =~ s/\s+\}/}/gs;
	$r =~ s/\s+\{/{/gs;
	$r =~ s/: /:/gs;
	return $r;
}

my $sqlsa;
sub sql_connect_sa {
	return 1 if ($sqlsa);
	#dbg('sql connect');
	$sqlsa = DBI->connect_cached($sa_database_spec,$sa_database_user,$sa_database_pass,{RaiseError=>0,AutoCommit=>1});
	return 1 if ($sqlsa);
	return 0;
}

sub sql_disconnect_sa {
	$sqlsa->disconnect() if ($sqlsa);
	$sqlsa = undef;
}

sub check_ip_in_list($$) {
	my $ip = shift;
	return 0 unless ($ip && $ip =~ /^$RE{net}{IPv4}$/);
	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;
}

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');
}

sub trim_host_part {
	my ($addr,$toboundary) = @_;
	$addr =~ s/^.*\@//;
	$toboundary = 1 unless (defined($toboundary));
	if ($addr =~ /^$RE{net}{IPv4}$/) {
		return "$3.$4.$5" if ($toboundary);
		return $addr;
	}
	my $dn = Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain($addr);
	return lc($addr) unless ($dn);
	return lc($dn) if ($toboundary);
	$addr =~ s/^(.*?\.)([^.]+\.$dn)$/$2/;
	return lc($addr);
}

my $resolver;
sub get_resolver {
	return $resolver if (defined($resolver));
	$resolver = Net::DNS::Resolver->new;
	#$resolver->persistent_tcp(0);
	#$resolver->tcp_timeout($to);
	#$resolver->udp_timeout($to);
	return $resolver;
}

my %queries = ();
my $queries = 0;
my $queriec = 0;
sub dns_bgsend {
	my ($addr,$type,$qf,$qF) = @_;
	return 0 unless ($type && $addr);
	return 0 unless (get_resolver());
	$addr = lc($addr);
	$type = uc($type);
	$qF = defined($qF) ? $qF+1 : 0;
	my $oaddr = $addr;
	my $otype = $type;
	if ($type eq 'A') {
		return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
	} elsif ($type eq 'PTR') {
		return 0 if ($addr !~ /^$RE{net}{IPv4}$/);
	} elsif ($type eq 'ABUSE') {
		return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
		return 0 if ("1.$addr" =~ /^$RE{net}{IPv4}$/);
		$type = 'TXT';
		$addr= "$addr.contacts.abuse.net";
	} elsif ($type eq 'RFC') {
		$type = 'A';
		$addr = "$addr.rfc-ignorant.org";
		$qF = 999;
	} elsif ($type eq 'SOA') {
		return 0 if ($addr =~ /^$RE{net}{IPv4}$/);
		$addr = trim_host_part($addr);
	} elsif ($type ne 'TXT') {
		return 0;
	}
	return 1 if (defined($queries{"$type:$addr"}));
	my $qs = $resolver->bgsend($addr,$type);
	return 0 unless ($qs);
	$queriec ++;
	my %qi = (
		qT => $otype,
		qA => $oaddr,
		qt => $type,
		qa => $addr,
		qc => $queriec,
		qs => $qs,
		qF => $qF,
	);
	$qi{qf} = $qf if ($qf);
	$queries{"$type:$addr"} = \%qi;
	$queries ++;
	return $queries;
}
sub dns_bgclose {
	foreach my $qi (values %queries) {
		eval { $qi->{qs}->close unless (defined($qi->{rl})); };
	}
}
sub dns_bgclear {
	dns_bgclose();
	%queries = ();
	$queries = 0;
}
sub dns_bglist {
	return sort { $a->{qc} <=> $b->{qc} } values %queries;
}
sub dns_bgresult {
	my ($addr,$type,$raw) = @_;
	return 0 unless ($type && $addr);
	$addr = lc($addr);
	$type = uc($type);
	my $otype = $type;
	if ($type eq 'ABUSE') {
		$type = 'TXT';
		$addr= "$addr.contacts.abuse.net";
	} elsif ($type eq 'RFC') {
		$type = 'A';
		$addr = "$addr.rfc-ignorant.org";
	} elsif ($type eq 'SOA') {
		$addr = trim_host_part($addr);
	}
	return wantarray ? () : undef unless (defined($queries{"$type:$addr"}) && defined($queries{"$type:$addr"}->{rl}) && @{$queries{"$type:$addr"}->{rl}});
	return wantarray ? @{$queries{"$type:$addr"}->{rl}} : [@{$queries{"$type:$addr"}->{rl}}] if ($raw);
	my @ans = ();
	if ($type eq 'MX') {
		foreach my $ans (sort {$a->{p} <=> $b->{p}} @{$queries{"$type:$addr"}->{rl}}) {
			push @ans, $ans->{x};
		}
	} else {
		foreach my $ans (@{$queries{"$type:$addr"}->{rl}}) {
			my $res = $type eq  'PTR' || $type eq 'A' ? $ans->{a} :
				  $type eq  'SOA'		  ? join(' ',$ans->{ns},$ans->{mb}) :
				  $otype eq 'ABUSE'		  ? $ans->{a} :
				  $type eq  'TXT'		  ? $ans->{t} :
				  undef;
			push @ans, $res if ($res);
		}
	}
	return wantarray ? @ans : [@ans];
}
sub dns_bgfullcircle {
	my ($addr) = @_;
	if ($addr =~ /^$RE{net}{IPv4}$/) {
		my $ans = dns_bgresult($addr,'PTR');
		return 0 unless ($ans);
		foreach my $res (@{$ans}) {
			my $rans = dns_bgresult($res,'A');
			next unless ($rans);
			foreach my $rres (@{$rans}) {
				return 1 if ($rres eq $addr);
			}
		}
	} else {
		my $ans = dns_bgresult($addr,'A');
		return 0 unless ($ans);
		$addr = lc($addr);
		foreach my $res (@{$ans}) {
			my $rans = dns_bgresult($res,'PTR');
			next unless ($rans);
			foreach my $rres (@{$rans}) {
				return 1 if (lc($rres) eq $addr);
			}
		}
	}
	return 0;
}
sub dns_bgcollect {
	my ($to,$follow,$abuse) = @_;
	return 0 unless ($resolver);
	$to = 300 unless ($to);
	my $dnst = time() + $to;
	while ($queries) {
		my $wq = 0;
		foreach my $qi (values %queries) {
			next if (defined($qi->{rl}));
			unless ($resolver->bgisready($qi->{qs})) {
				$wq ++;
				next;
			}
			my $pkt = $resolver->bgread($qi->{qs});
			$qi->{qs}->close;
			$queries --;
			$qi->{rl} = [];
			next unless ($pkt);
			foreach my $ans ($pkt->answer) {
				next unless ($ans->class eq 'IN');
				next unless ($ans->type eq $qi->{qt});
				if ($qi->{qt} eq 'MX') {
					next unless ($ans->exchange);
					push @{$qi->{rl}}, {p=>$ans->preference,x=>$ans->exchange};
					if ($follow) {
						$wq ++ if (dns_bgsend($ans->exchange,'A',$qi->{qc}));
						$wq ++ if (dns_bgsend($ans->exchange,'PTR',$qi->{qc}));
						$wq ++ if (dns_bgsend($ans->exchange,'SOA',$qi->{qc}));
					}
					if ($abuse) {
						$wq ++ if (dns_bgsend($ans->exchange,'ABUSE',$qi->{qc}));
						$wq ++ if (dns_bgsend(trim_host_part($ans->exchange),'ABUSE',$qi->{qc}));
					}
				} elsif ($qi->{qt} eq 'PTR') {
					next unless ($ans->ptrdname);
					push @{$qi->{rl}}, {a=>$ans->ptrdname};
					if ($follow && $qi->{qF}<4) {
						$wq ++ if (dns_bgsend($ans->ptrdname,'A',$qi->{qc},$qi->{qF}));
						$wq ++ if (dns_bgsend($ans->ptrdname,'SOA',$qi->{qc}));
					}
					if ($abuse) {
						$wq ++ if (dns_bgsend($ans->ptrdname,'ABUSE',$qi->{qc}));
						$wq ++ if (dns_bgsend(trim_host_part($ans->ptrdname),'ABUSE',$qi->{qc}));
					}
				} elsif ($qi->{qt} eq 'A') {
					next unless ($ans->address);
					push @{$qi->{rl}}, {a=>$ans->address};
					if ($follow && $qi->{qF}<4) {
						$wq ++ if (dns_bgsend($ans->address,'PTR',$qi->{qc},$qi->{qF}));
					}
				} elsif ($qi->{qt} eq 'SOA') {
					next unless ($ans->mname && $ans->rname);
					push @{$qi->{rl}}, {ns=>$ans->mname,mb=>$ans->rname,sn=>$ans->serial,rf=>$ans->refresh,ry=>$ans->retry,ex=>$ans->expire,mt=>$ans->minimum};
				} elsif ($qi->{qt} eq 'TXT') {
					next unless ($ans->txtdata);
					if ($qi->{qT} eq 'ABUSE') {
						push @{$qi->{rl}}, {a=>$ans->txtdata,d=>trim_host_part($ans->txtdata)};
						$wq ++ if (dns_bgsend($ans->txtdata,'SOA',$qi->{qc}));
						if ($ans->txtdata =~ /^<?(postmaster|abuse)\@(.*?)>?$/i) {
							$wq ++ if (dns_bgsend("$2.$1",'RFC',$qi->{qc}));
						}
					} else {
						push @{$qi->{rl}}, {t=>$ans->txtdata};
					}
				}
			}
		}
		return 0E0 unless ($wq && $queries);
		return $wq if (time() > $dnst);
		sleep(1);
	}
	return $queries ? $queries : 0E0;
}

my %mails = ();
my @atts = ();
sub init_mail {
	my ($spam,$from) = @_;
	return if ($mails{$spam});
	my $spams = $spam?'spam':'ham';
	$mails{$spam} = {};
	$mails{$spam}->{frm} = $from;
	$mails{$spam}->{att} = 0;
	$mails{$spam}->{ent} = MIME::Entity->build(
		From		=> $from,
		Subject		=> $spams,
		Data		=> "$spams reports attached\n",
		Encoding	=> '-SUGGEST',
		'X-MDF-Report:'	=> "($FilterUtilVers) <forward>",
		'Message-ID:'	=> Email::MessageID->new($MyFilterHostName)->format,
		'Reply-To:'	=> $AdminContactAddress ? $AdminContactAddress : $AdminAddress,
	);
}

sub done_mail {
	%mails = ();
	while (my $nf = shift @atts) {
		unlink($nf);
	}
}

sub add_mail {
	return 0 if ($nosend);
	my ($spam,$rf,$ra) = @_;
	return 0 unless ($mails{$spam} && $mails{$spam}->{ent});
	return 0 unless (-e $rf);
	my $nf = sprintf('%s.%03u',$rf,$#atts+1);
	return 0 unless link($rf,$nf);
	push @atts, $nf;
	my $df = $nf;
	$df =~ s/^.*[\/\\]//s;
	$mails{$spam}->{att}++;
	$mails{$spam}->{ent}->attach(
		Path		=> $nf,
		Type		=> 'message/rfc822',
		Disposition	=> 'attachment',
		Encoding	=> '-SUGGEST',
		Filename	=> "$df.eml",
		'X-Age:'	=> $ra ? sprintf('%u',$ra/(24*60*60)) : '?',
	);
	return 1;
}

sub send_mail {
	return 0 if ($nosend);
	return 1 unless (@atts);
	my $cnt = 0;
	my $snd = $SpamReportSender ? $SpamReportSender : $AdminAddress;
	while (my ($spam,$mail) = each %mails) {
		next unless ($mail->{ent} && $mail->{att});
		my $cmd = "sendmail -odd -Ac -oi -f '$snd' --";
		my @rcpts = ();
		my $rc = 0;
		if ($spam) {
			foreach my $rcpt (split(/\s*;\s*/,$SpamReportForward)) {
				next unless ($rcpt =~ /^\S+\@\S+$/);
				$cmd .= " '$rcpt'";
				push @rcpts, $rcpt;
			}
		}
		next unless (@rcpts);
		log_msg('Sending: %s -> %s',$AdminAddress,join(', ',@rcpts));
		print	"=============================================\n".
			"Send mail (".($spam?'spam':'ham').")\n".
			"---------------------------------------------\n".
			$mail->{ent}->as_string.
			"=============================================\n" if ($debugprint);
		$cnt ++;
		next if ($debug);
		unless (open(SM,"|$cmd")) {
			log_msg('Error calling sendmail!');
			return 0;
		}
		print SM $mail->{ent}->as_string;
		close(SM);
	}
	return $cnt;
}

my $mparser;
my $sparser;
sub clean_parser {
	unless (@_) {
		push @_, $sparser if (defined($sparser));
		push @_, $mparser if (defined($mparser));
	}
	foreach my $prs (@_) {
		return unless (defined($prs));
		my $dir = $prs->output_dir();
		$prs->filer->purge();
		rmdir($dir) if ($dir && (-d $dir));
	}
}
sub init_mparser {
	return 1 if (defined($mparser));
	$mparser = new MIME::Parser();
	return 0 unless (defined($mparser));
	$mparser->output_under('/tmp');
	$mparser->extract_nested_messages(0);
	$mparser->filer->ignore_filename(1);
	return 1;
}
sub init_sparser {
	return 1 if (defined($sparser));
	$sparser = new MIME::Parser();
	return 0 unless (defined($sparser));
	$sparser->output_under('/tmp');
	$sparser->extract_nested_messages(1);
	$sparser->extract_uuencode(1);
	$sparser->filer->ignore_filename(1);
}

sub cat_message {
	my ($spam,$rf) = @_;
	return 0 unless (open(FS,'<',$rf));
	print $spam?"SPAM\n":"HAM\n";
	while (my $l = <FS>) { print $l; }
	close(FS);
	return 1;
}
my $sa;
sub report_message_sa {
	return 2 if ($noreport);
	my ($spam,$eml,$id,$ri) = @_;
	return 0 unless ($eml);
	return 3 if (length($eml) > $SASizeLimit);
	if ($ri) {
		log_msg('Reporting: {%s} %s %s <%s> %s [%s] (%s)',$spamd?'SD':'SA',$id,$spam?'spam':'ham',$ri->{addr},$ri->{helo},$ri->{ip},$ri->{rdns});
	} else {
		log_msg('Reporting: {%s} %s %s',$spamd?'SD':'SA',$id,$spam?'spam':'ham');
	}
	print	"=============================================\n".
		"Report message (".($spam?'spam':'ham').")\n".
		"---------------------------------------------\n".
		$eml.
		"=============================================\n" if ($debugprint);
	return 1 if ($debug);
	if ($spamd) {
		unless (defined($sa)) {
			my %sap = (
				socketpath	=> $spamdsocket,
				host		=> $spamdhost,
				port		=> $spamdport,
				username	=> 'mdf',
			);
			unless ($spamd == -1) {
				my ($sdh,$sdp,$sdu) = split(/:/,$spamd,3);
				$sap{socketpath}	= $sdh if ($sdh && $sdh =~ /\//);
				$sap{host}		= $sdh if ($sdh && $sdh !~ /\//);
				$sap{port}		= $sdp if ($sdp);
				$sap{username}		= $sdu if ($sdu);
			}
			$sa = new Mail::SpamAssassin::Client(\%sap);
			$sa = 0 unless ($sa && $sa->ping);

		}
		return 0 unless ($sa && defined($sa->learn($eml,$spam?0:1)));
		return 1;
	}
	unless (defined($sa)) {
		if ($postconf) {
			$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,post_config_text=>$postconf});
		} else {
			my $cfg = '/usr/local/etc/mimedefang/spamassassin.cf';
			foreach my $cfn (('/usr/local/etc/mimedefang/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/sa-mimedefang.cf','/usr/local/etc/mimedefang/spamassassin/local.cf')) {
				if (-r $cfn) {
					$cfg = $cfn;
					last;
				}
			}
			$sa = Mail::SpamAssassin->new({dont_copy_prefs=>1,userprefs_filename=>$cfg});
		}
		$sa->init_learner({caller_will_untie=>1,learn_to_journal=>1});
	}
	return 0 unless (defined($sa));
	my $msg = $sa->parse($eml);
	return 0 unless ($msg);
	my $ok = 0;
	my $st = $sa->learn($msg,undef,$spam,0);
	if ($st) {
		$ok = 1;
		$st->finish();
	}
	$msg->finish();
	return $ok;
}

my $prsc = 0;
my $prst = time();
my $urif;
sub save_parsed {
	my ($path,$file,$spam,$ra) = @_;
	return 0 unless ($path && $file);
	return 0 unless (init_sparser());
	return 0 unless ((-d $path) && (-e $file));
	log_msg('Saving: %s',$file);
	my $entity = $sparser->parse_open($file);
	unless ($entity) {
		clean_parser($sparser);
		return 0;
	}
	my %msg = (
		rage		=> $ra,
		spam		=> $spam,
		stamp		=> time(),
		relays		=> [],
		senders 	=> [],
		abuse		=> {},
		ignorants	=> {},
		nosoas		=> {},
		data		=> {
			received	=> [],
			senders		=> [],
			original	=> [],
			links		=> [],
			queries		=> [],
		},
	);
	my @senders = ();
	$entity->head->unfold();
	foreach my $val ($entity->head->get('Received')) {
		next unless (defined($val));
		$val =~ s/[\s\r\n]+$//;
		next if ($val eq '');
		push @{$msg{data}->{original}}, {field=>'Received',value=>$val};
		my %rcvd = ();
		my ($tree,$fld);
		if (($fld = Mail::Field->new('Received',$val)) && ($tree = $fld->parse_tree()) && $fld->parsed_ok) {
			$rcvd{mft} = $tree;
			$rcvd{from_helo} = lc($tree->{from}->{HELO}) if ($tree->{from}->{HELO});
			$rcvd{from_host} = lc($tree->{from}->{domain}) if ($tree->{from}->{domain});
			$rcvd{from_addr} = lc($tree->{from}->{address}) if ($tree->{from}->{address});
			$rcvd{by_host} = lc($tree->{by}->{domain}) if ($tree->{by}->{domain});
		}
		if ($tree = parse_received($val)) {
			$rcvd{ert} = $tree;
			$rcvd{from_helo} = lc($tree->{helo}) if ($tree->{helo});
			$rcvd{from_host} = lc($tree->{rdns}) if ($tree->{rdns});
			$rcvd{from_addr} = lc($tree->{ip}) if ($tree->{ip});
			$rcvd{from_mail} = lc($tree->{envfrom}) if ($tree->{envfrom});
			$rcvd{by_host} = lc($tree->{by}) if ($tree->{by});
			push @senders, {hn=>'Received',hv=>$tree->{envfrom},ho=>$#{$msg{data}->{original}}} if ($tree->{envfrom});
		}
		next unless (%rcvd);
		foreach my $k (keys %rcvd) {
			next unless ($k =~ /^(?:by|from)_/);
			$rcvd{$k} =~ s/^[<\[](.*?)[\]>]$/$1/;
		}
		$rcvd{from_rdom} = trim_host_part($rcvd{from_host}) if ($rcvd{from_host});
		$rcvd{from_hdom} = trim_host_part($rcvd{from_helo}) if ($rcvd{from_helo});
		$rcvd{by_dom} = trim_host_part($rcvd{by_host}) if ($rcvd{by_host});
		$rcvd{original} = $#{$msg{data}->{original}};
		push @{$msg{data}->{received}}, \%rcvd;
	}
	foreach my $ahn (('From','Reply-To','Sender','Return-Path','Envelope-From','To','CC','BCC')) {
		foreach my $val ($entity->head->get($ahn)) {
			next unless (defined($val));
			$val =~ s/[\s\r\n]+$//;
			next if ($val eq '');
			push @{$msg{data}->{original}}, {field=>$ahn,value=>$val};
			push @senders, {hn=>$ahn,hv=>$val,ho=>$#{$msg{data}->{original}}};
		}
	}
	my @uris = ();
	foreach my $part ($entity->parts_DFS) {
		next unless ($part->effective_type =~ /^text\/(?:plain|flowed|html)$/i);
		$urif = URI::Find::Schemeless->new(sub {
			my ($uri,$txt) = @_;
			push @uris, {uri=>$uri,txt=>$txt,src=>'plain'};
			return $txt;
		}) unless (defined($urif));
		my $body = $part->bodyhandle;
		next unless ($body);
		my $data = join('',$body->as_lines);
		if ($part->effective_type =~ /^text\/html$/i) {
			my $html = HTML::TreeBuilder->new_from_content($data);
			if ($html) {
				foreach my $tag ($html->look_down(sub { defined($_[0]->attr('src')) })) {
					my %uri = (tag=>$tag->tag,fld=>'src',txt=>$tag->attr('src'),uri=>URI->new($tag->attr('src')),src=>'html');
					push @uris, \%uri if ($uri{uri});
				}
				foreach my $tag ($html->look_down(sub { defined($_[0]->attr('href')) })) {
					my %uri = (tag=>$tag->tag,fld=>'href',txt=>$tag->attr('href'),uri=>URI->new($tag->attr('href')),src=>'html');
					push @uris, \%uri if ($uri{uri});
				}
			}
			$data =~ s/<.*?>//gs;
		}
		next unless ($urif);
		$urif->find(\$data);
	}
	clean_parser($sparser);
	foreach my $uri (@uris) {
		my %uri = (text=>$uri->{txt});
		eval { $uri{schm} = lc($uri->{uri}->scheme) if ($uri->{uri}->scheme); };
		next unless ($uri{schm});
		eval{ $uri{host} = lc($uri->{uri}->host) if ($uri->{uri}->host); };
		eval{ $uri{addr} = lc($uri->{uri}->address) if ($uri->{uri}->address); };
		eval{ $uri{addr} = lc($uri->{uri}->to) if ($uri->{uri}->to); } unless ($uri{addr} || $uri{schm} !~ /^(?:mailto)$/i);
		next unless ($uri{host} || $uri{addr});
		eval{ $uri{user} = $uri->{uri}->user if ($uri->{uri}->user); };
		eval{ $uri{user} = $uri->{uri}->userinfo if ($uri->{uri}->userinfo); $uri{user} =~ s/:.*$// if ($uri{user}); } unless ($uri{user});
		$uri{rdom} = trim_host_part($uri{host}) if ($uri{host});
		if ($uri{addr} && $uri{addr} =~ /^.*\@((?:[-\w]+\.)+?(?:[-\w]+))$/) {
			$uri{adom} = $1;
		}
		$uri{type} = lc($uri->{src});
		$uri{type} .= lc(".$uri->{tag}") if ($uri->{tag});
		if ($uri->{host} =~ /^$RE{net}{IPv4}$/) {
			$uri{ip} = $uri->{host};
			delete $uri->{host};
		}
		push @{$msg{data}->{links}}, \%uri;
	}
	my $pelo;
	my $trust = 1;
	foreach my $rcvd (@{$msg{data}->{received}}) {
		if ($pelo && $rcvd->{by_dom} ne $pelo) {
			$rcvd->{note} = "by helo domain '$pelo' != domain '$rcvd->{by_dom}'";
			last;
		}
		$pelo = $rcvd->{from_hdom};
		unless ($rcvd->{from_addr}) {
			$rcvd->{note} = 'not from addr';
			next;
		}
		if (check_black_nets($rcvd->{from_addr})) {
			$rcvd->{note} = "from local addr '$rcvd->{from_addr}'";
			next;
		}
		my %relay = (addr=>$rcvd->{from_addr});
		$relay{host} = $rcvd->{from_host} if ($rcvd->{from_host});
		$relay{helo} = $rcvd->{from_helo} if ($rcvd->{from_helo});
		$relay{rdom} = $rcvd->{from_rdom} if ($rcvd->{from_rdom});
		push @{$msg{relays}}, \%relay;
		unless ($trust) {
			if ($rcvd->{from_helo} =~ /^\d+\.\d+\.\d+\.\d+$/ && $rcvd->{from_helo} !~ /^$RE{net}{IPv4}$/) {
				$rcvd->{note} = "from bad helo addr '$rcvd->{from_helo}'";
				last;
			}
			if ($rcvd->{from_helo} =~ /^$RE{net}{IPv4}$/ && $rcvd->{from_helo} ne $rcvd->{from_addr}) {
				$rcvd->{note} = "from bogus helo addr '$rcvd->{from_helo}'";
				last;
			}
			if ($rcvd->{from_helo} !~ /^([-\w]+\.)+?([-\w]+)$/) {
				$rcvd->{note} = "from bad helo '$rcvd->{from_helo}'";
				last;
			}
		}
		$trust = 0;
	}
	my %senders = ();
	foreach my $snd (@senders) {
		foreach my $adr (Email::Address->parse($snd->{hv})) {
			next unless ($adr && $adr->address);
			my $caddr = lc($adr->address);
			next if ($caddr =~ /\@$OurDomains>?$/i);
			my $dp = -1;
			my $sp = -1;
			if ($senders{$caddr}) {
				$dp = $senders{$caddr}->{d};
				$sp = $senders{$caddr}->{s};
			} else {
				$senders{$caddr} = {};
			}
			if (!defined($dp) || $dp<0) {
				my %sndr = (address=>$caddr);
				$senders{$sndr{address}} = {};
				$sndr{phrase}	 = $adr->phrase if ($adr->phrase);
				$sndr{comment}	 = $adr->comment if ($adr->comment);
				$sndr{host}	 = lc($adr->host) if ($adr->host);
				$sndr{user}	 = lc($adr->user) if ($adr->user);
				$sndr{format}	 = $adr->format if ($adr->format);
				$sndr{name}	 = $adr->name if ($adr->name);
				$sndr{domain}	 = trim_host_part($sndr{host}) if ($sndr{host});
				$sndr{originals} = [];
				$sndr{headers}	 = [];
				push @{$msg{data}->{senders}}, \%sndr;
				$dp = $#{$msg{data}->{senders}};
				$senders{$caddr}->{d} = $dp;
			}
			if (!defined($sp) || $sp<0) {
				my %sender = (addr=>$caddr);
				$sender{user} = lc($adr->user) if ($adr->user);
				$sender{host} = lc($adr->host) if ($adr->host);
				$sender{rdom} = trim_host_part($sender{host}) if ($sender{host});
				push @{$msg{senders}}, \%sender;
				$sp = $#{$msg{senders}};
				$senders{$caddr}->{s} = $sp;
			}
			if (defined($dp) && $dp >= 0) {
				push @{$msg{data}->{senders}->[$dp]->{headers}}, $snd->{hn};
				push @{$msg{data}->{senders}->[$dp]->{originals}}, $snd->{ho};
			}
			if (defined($sp) && $sp >= 0) {
				push @{$msg{senders}->[$dp]->{headers}}, $snd->{hn};
				push @{$msg{senders}->[$dp]->{originals}}, $snd->{ho};
			}
		}
	}
	dns_bgclear();
	foreach my $uri (@{$msg{data}->{links}}) {
		if ($uri->{host}) {
			dns_bgsend($uri->{host},'A');
			dns_bgsend($uri->{host},'ABUSE');
			dns_bgsend($uri->{rdom},'ABUSE');
		}
		if ($uri->{ip}) {
			dns_bgsend($uri->{ip},'PTR');
			dns_bgsend($uri->{ip},'ABUSE');
		}
		if ($uri->{adom} && $uri->{schm} =~ /mail/i) {
			dns_bgsend($uri->{adom},'MX');
			dns_bgsend($uri->{adom},'A');
			dns_bgsend($uri->{adom},'PTR');
			dns_bgsend($uri->{adom},'ABUSE');
		}
	}
	foreach my $snd (@{$msg{senders}}) {
		if ($snd->{host}) {
			dns_bgsend($snd->{host},'MX');
			dns_bgsend($snd->{host},'A');
			dns_bgsend($snd->{host},'PTR');
			dns_bgsend($snd->{host},'ABUSE');
			dns_bgsend($snd->{rdom},'ABUSE');
			dns_bgsend($snd->{rdom},'SOA');
		}
	}
	foreach my $rly (@{$msg{relays}}) {
		if ($rly->{addr}) {
			dns_bgsend($rly->{addr},'PTR');
			dns_bgsend($rly->{addr},'ABUSE');
		}
		if ($rly->{host}) {
			dns_bgsend($rly->{host},'A');
			dns_bgsend($rly->{host},'ABUSE');
			dns_bgsend($rly->{rdom},'ABUSE');
		}
	}
	dns_bgcollect(300,1,1);
	dns_bgclose();
	$msg{querycount} = scalar %queries;
	foreach my $qi (dns_bglist()) {
		delete $qi->{qs} if ($qi->{qs});
		my %qx = (type=>$qi->{qt},addr=>$qi->{qa},qcid=>$qi->{qc});
		$qx{qsrc} = $qi->{qf} if ($qi->{qf});
		$qx{otyp} = $qi->{qT} if ($qi->{qt} ne $qi->{qT});
		$qx{oadr} = $qi->{qA} if ($qi->{qa} ne $qi->{qA});
		if ($qi->{rl} && @{$qi->{rl}}) {
			$qx{ansr} = $qi->{rl};
			if ($qi->{qT} eq 'ABUSE') {
				$msg{abuse}->{$qi->{qA}} = $qi->{rl};
			} elsif ($qi->{qT} eq 'RFC' && $qi->{qA} =~ /^(.*?)\.([a-z])$/i) {
				$msg{ignorants}->{lc("$2\@$1")} = 1;
			}
		}
		push @{$msg{data}->{queries}}, \%qx;
	}
	my $dans;
	foreach my $uri (@{$msg{data}->{links}}) {
		if ($uri->{host} && ($dans = dns_bgresult($uri->{host},'A'))) {
			$uri->{ip} = [@{$dans}];
		} elsif ($uri->{ip} && ($dans = dns_bgresult($uri->{ip},'PTR'))) {
			$uri->{host} = [@{$dans}];
		}
	}
	foreach my $snd (@{$msg{senders}}) {
		$msg{nosoas}->{lc($snd->{addr})} = 1 unless ($msg{nosoas}->{lc($snd->{addr})} || dns_bgresult($snd->{rdom},'SOA'));
		next unless ($snd->{host});
		if ($dans = dns_bgresult($snd->{host},'MX')) {
			$snd->{mx} = [];
			foreach my $qa ((@{$dans})) {
				my %mxi = (host=>$qa);
				if ($qa =~ /^$RE{net}{IPv4}$/) {
					$mxi{addr} = [$qa];
				} elsif ($dans = dns_bgresult($qa,'A')) {
					$mxi{addr} = [@{$dans}];
				}
				push @{$snd->{mx}}, \%mxi;
			}
		}
		next if ($snd->{mx} && @{$snd->{mx}});
		if ($dans = dns_bgresult($snd->{host},'A')) {
			$snd->{mx} = [{
				host => $snd->{host},
				addr => [@{$dans}],
			}];
		}
	}
	foreach my $snd (values %{$msg{abuse}}) {
		foreach my $abu (@{$snd}) {
			$msg{nosoas}->{lc($abu->{a})} = 1 unless ($msg{nosoas}->{lc($abu->{a})} || dns_bgresult($abu->{d},'SOA'));
		}
	}
	foreach my $rly (@{$msg{relays}}) {
		if ($rly->{addr}) {
			if ($dans = dns_bgresult($rly->{addr},'PTR')) {
				$rly->{rdns} = [@{$dans}];
			}
			$rly->{fadr} = dns_bgfullcircle($rly->{addr});
		}
		if ($rly->{host}) {
			if ($dans = dns_bgresult($rly->{host},'A')) {
				$rly->{fdns} = [@{$dans}];
			}
			$rly->{fhst} = dns_bgfullcircle($rly->{host});
		}
	}
	dns_bgclear();
	my $dump = Dump(\%msg);
	print	"=============================================\n".
		"Save '$file' to '$path'\n".
		"---------------------------------------------\n".
		$dump.
		"=============================================\n" if ($debugprint);
	return 1 if ($debug);
	my $nfn;
	my $fnc = 0;
	while (1) {
		$prsc ++;
		$nfn = sprintf('t%Xr%Xp%Xn%Xs%Xr%X.prs',time(),rand(0xFFFF),$$,$prsc,$prst,rand(0xFFFF));
		last if (!(-e "$path/$nfn.eml") && link($file,"$path/$nfn.eml"));
		$fnc ++;
		return 0 if ($fnc > 10000);
	}
	log_msg('Saved: %s',"$path/$nfn");
	return 0 unless (open(F,'>',"$path/$nfn.dat"));
	print F $dump;
	close(F);
	if (open(F,'>',"$path/$nfn.sav")) { close(F); }
	if (open(F,'>',"$path/$nfn.new")) { close(F); }
	return 1;
}

sub make_hash0 {
	my ($body,$header) = @_;
	$body =~ s/^[\s\n]+//s;
	$body =~ s/[\s\n]+$//s;
	my $hdr = '';
	foreach my $h (@{$header}) {
		next unless ($h =~ /^(?:Content-\S+|Subject):/i);
		$hdr .= $h;
	}
	$body = "$hdr\n$body";
	my $hash = join('+',Digest::MD5::md5_hex($body),Digest::SHA::sha1_hex($body));
	return "=$hash";
}
sub make_hash1 {
	my ($body) = @_;
	$body =~ s/([[:space:]]{100})(?:\1+)/$1/g;
	$body =~ s/([[:space:]])(?:\1+)/$1/g;
	$body =~ s/[[:graph:]]+//go;
	my $hash = Digest::MD5::md5_hex($body);
	return "~$hash";
}
sub make_hash2 {
	my ($body) = @_;
	$body =~ s/[[:cntrl:][:alnum:]%&#;=]+//g;
	$body =~ tr/_/./;
	$body =~ s/([[:print:]]{100})(?:\1+)/$1/g;
	$body =~ s/([[:print:]])(?:\1+)/$1/g;
	my $hash = Digest::MD5::md5_hex($body);
	return "~$hash";
}
sub make_hash3 {
	my ($body) = @_;
	$body =~ s/[[:cntrl:][:space:]=]+//g;
	$body =~ s/([[:print:]]{100})(?:\1+)/$1/g;
	$body =~ s/([[:graph:]])(?:\1+)/$1/g;
	my $hash = Digest::MD5::md5_hex($body);
	return "~$hash";
}
sub add_hashes {
	my $ft = shift;
	my $sti = $sqlsa->prepare('INSERT INTO hashcount (stamp,type,hash) VALUES (?,?,?)');
	return 0 unless ($sti);
	my $cnt = ($ft =~ /tra?p/i) ? 'count_trap' : 'count_flag';
	my $ok = 1;
	my $now = time();
	foreach my $hash (@_) {
		#log_msg('AddHash: %s %s',$cnt,$hash);
		next if ($debug);
		next if ($sti->execute($now,($ft=~/tra?p/i)?'trap':'flag',$hash));
		$ok = 0;
		last;
	}
	$sti->finish;
	return $ok if ($sqlsa->{AutoCommit});
	return $sqlsa->commit if ($ok);
	$sqlsa->rollback;
	return $ok;
}
sub report_message_count {
	return 0 if ($noreport);
	my ($spam,$ft,$body,$header) = @_;
	return 0 unless ($body);
	return 0 unless ($spam);
	my @hashes = ();
	push @hashes, make_hash0($body,$header);
	push @hashes, make_hash1($body) if (($body =~ /(?:[\s\t].+?){20}/ ) && ($body =~ /\n.*?\n/));
	push @hashes, make_hash2($body) if ($body =~ /(?:(?:(?:[<>\(\)\|@\*'!?,]){3}|(:\/)))/m);
	push @hashes, make_hash3($body) if (!@hashes && ($body =~ /\S{4}.*\S{4}/));
	return 0 unless (@hashes);
	return 0 unless (sql_connect_sa());
	my $ok = add_hashes($ft,@hashes);
	sql_disconnect_sa();
	return 0 unless ($ok);
	return scalar @hashes;
}

sub handle_message {
	my ($spam,$mf,$id,$ft) = @_;
	return (1,1,0) if ($noreport && $nosend && $nosave && $noparse);
	my $notreport = $noreport;
	my $notcount = $spam ? $noreport : 1;
	my $notsend = ($nosend || $ft =~ /tra?p/i);
	my $notchange = ($nochange || $ft =~ /tra?p/i);
	my $notparse = ($noparse || (!$maxage && $ft =~ /tra?p/i));
	my $notsave = ($nosave || $ft =~ /tra?p/i);
	return (1,1,0) if ($notreport && $notsend && $notsave && $notparse && $notcount);
	return (0,0,1) unless (open(FI,'<',$mf));
	my @hdr = ();
	while (my $l = <FI>) {
		last if ($l =~ /^[\r\n]*$/s);
		$l =~ s/\r\n/\n/s;
		$l =~ s/\r/\n/s;
		if (@hdr && $l =~ /^\s/) {
			$hdr[$#hdr] .= $l;
		} else {
			push @hdr, $l;
		}
	}
	my @bdy = ();
	while (my $l = <FI>) {
		$l =~ s/\r\n/\n/s;
		$l =~ s/\r/\n/s;
		#print "B:$l";
		push @bdy, $l;
	}
	close(FI);
	return (0,0,0) unless (@hdr && @bdy);
	my $rpath = '';
	my $hdr1 = '';
	my $hdr2 = '';
	my $ri;
	my @hish = ([]);
	my $msgid;
	my $ok = 1;
	my @er = ();
	my $ra;
	unless ($notparse && $notchange) {
		my $rp = -1;
		my $rt = 0;
		my $fp = -1;
		for (my $li=0;$li<@hdr;$li++) {
			if ($hdr[$li] =~ /^Received:/i) {
				if ($hdr[$li] =~ /^Received:\s+from\s+(\S+\s+\([^\)]*\))\s+by\s+$MyFilterHostNames(\s.*|)$/si) {
					$rp = $li;
					if ($hdr[$li] =~ /;\s*([^;]*?)(\s*\([^\)]*\))?\s*$/si) {
						my $t = str2time($1);
						$rt = $t if ($t);
					}
				} else {
					pop @hish if (@hish);
				}
				push @hish, [];
			} elsif ($hdr[$li] =~ /^X-Scanned-By:\s+$MyFilterHostNames([,\s].*|)$/si) {
				$fp = $li if ($fp < 0);
			} elsif ($hdr[$li] =~ /^Return-Path:\s+(.*?)\s*$/si) {
				push @{$hish[$#hish]}, $hdr[$li];
				$rpath = $1 unless ($rpath);
				init_mail($spam,$rpath);
			} elsif ($hdr[$li] =~ /^Message-ID:\s*\S+\s*$/i) {
				$msgid = $hdr[$li];
				push @{$hish[$#hish]}, $hdr[$li];
			} elsif ($hdr[$li] =~ /^(X-SMTP-From|Return-Path|Delivered-To|Sent-To|Received-From):/i) {
				push @{$hish[$#hish]}, $hdr[$li];
			}
		}
		return (1,0,0,[@er,'h']) unless (@hdr && ($rp >= 0 || $ft =~ /tra?p/i));
		my $now = time();
		$rt = $now unless ($rt);
		$ra = $now-$rt;
		if ($ra>$maxage && !$debugnoage) {
			log_msg('Too old: %s',$id);
			return (1,0,4,[@er,'o']);
		}
		pop @hish if ($#hish > 0);
		#for (my $hi=1;$hi<=@hish;$hi++) {
		#	print "$hi\n";
		#	for (my $li=1;$li<=@{$hish[$hi-1]};$li++) {
		#		print "$hi.$li $hish[$hi-1]->[$li-1]\n";
		#	}
		#}
		while ($#hish > 0) { shift @hish; }
		foreach (my $li=0;$li<@{$hish[0]};$li++) {
			if ($hish[0]->[$li] =~ /^X-SMTP-From:\s+\S+\s+<(\S*)>\s+(\S+)\s+\[(\S+)\]\s+\((\S+)\)/si) {
				$ri = {addr=>$1,helo=>$2,ip=>$3,rdns=>$4};
			} else {
				next if ($ft !~ /(auto?|tra?p)/i && $hish[0]->[$li] =~ /^(Return-Path|Delivered-To|Sent-To|Received-From):/i);
				$msgid = '' if ($hish[0]->[$li] =~ /^Message-ID:\s*(\S+)\s*$/i);
				$hdr1 .= $hish[0]->[$li];
			}		
		}
		for (my $li=0;$li<@hdr;$li++) {
			next if ($li < $rp);
			next if ($hdr[$li] =~ /^X-Antivirus:/i);
			next if ($fp > $rp && $hdr[$li] =~ /^(X-Mailer|Thread-Index|X-Redirected|X-Filter-Time|X-Greylist|X-Scanned-By|X-SMTP-From|X-Fortune|X-Exclamation|X-Virus-Scanned-By|X-Spam-Info|X-Spam-Scanned-By|X-Spam-Score):/i);
			next if ($ft !~ /(auto?|tra?p)/i && $hdr[$li] =~ /^(Return-Path|Delivered-To|Sent-To|Received-From):/i);
			$msgid = '' if ($hdr[$li] =~ /^Message-ID:\s*(\S+)\s*$/i);
			$hdr2 .= $hdr[$li];
		}
		$rpath = "Return-Path: $rpath\n" if ($rpath ne '');
		unless ($notparse) {
			$notreport = 0 unless ($noreport || ($ra>$learnage && !$debugnoage) || (-s $mf > $SASizeLimit));
			$notsend = 0 unless ($nosend || ($ra>$forwardage && !$debugnoage) || !$spam || $ft !~ /spam/i || $ft =~ /(auto?|tra?p)/i);
			$notsave = 0 unless ($nosave || ($ra>$forwardage && !$debugnoage) || !$spam || $ft !~ /spam/i || $ft =~ /(auto?|tra?p)/i);
		}
	}
	unless ($notcount) {
		push @er, 'rmc' unless (report_message_count($spam,$ft,join('',@bdy),\@hdr));
	}
	unless ($notreport) {
		if ($msgid) {
			push @{$hish[0]}, $msgid;
		} elsif (!defined($msgid)) {
			unshift @{$hish[0]}, sprintf("Message-ID: <%s.%u.%s\@%s>\n",$id,$spam,$ft,$MyFilterHostName);
		}
		push @er, 'rmsa' unless (report_message_sa($spam,$notchange?join('',@hdr,"\n",@bdy):join('',$rpath,$hdr1,$hdr2,"\n",@bdy),$id,$ri));
	}
	unless ($notsend && $notsave) {
		return (0,1,2,[@er,'w']) unless (open(FO,'>',"$mf.report"));
		print FO $notchange ? join('',@hdr,"\n",@bdy) : join('',$rpath,$hdr2,"\n",@bdy);
		close(FO);
		add_mail($spam,"$mf.report",$ra) unless ($notsend);
		save_parsed($SpamParseSpool,"$mf.report",$spam,$ra) unless ($notsave);
		unlink("$mf.report");
	}
	$ok = 0 if (@er);
	return ($ok,1,3,\@er);
}

sub handle_part {
	my ($spam,$mf,$id,$ft,$prt,$xm) = @_;
	return (1,0,14) if ($prt->is_multipart);
	my $rfn = $prt->head ? $prt->head->recommended_filename : '';
	my $mine = 0;
	$mine = 1 if (!$mine && $prt->effective_type eq 'message/rfc822');
	my $fixm = 0;
	if (!$mine && $xm =~ /Outlook/ && $prt->effective_type eq 'text/plain' && $rfn =~ /^(?:report|Messagedat)\d+\.txt$/) {
		$mine = 1;
		$fixm = 1;
	}
	return (1,0,15) unless ($mine);
	my $bh = $prt->bodyhandle;
	return (1,0,16) unless ($bh);
	my $bio = $bh->open('r');
	return (1,0,17) unless ($bio);
	my $cl = 0;
	if ($fixm) {	
		my $part = '';
		while (my $l = $bio->getline) {
			next if ($cl == 0 && $l =~ /^>?From /);
			$l =~ s/[\r\n]+//s;
			$part .= "$l\n";
			$cl ++;
		}
		$part =~ s/^(.*?\n)\n(Content-Type: \S+(?:;\n\s+\S+)\n\n)/$1$2/s;
		return (0,0,13)	unless (open(F,'>',"$mf.part"));
		print F $part;
		close(F);
		$part = '';
	} else {
		return (0,0,13)	unless (open(F,'>',"$mf.part"));
		my $cl = 0;
		while (my $l = $bio->getline) {
			next if ($cl == 0 && $l =~ /^>?From /);
			$l =~ s/[\r\n]+//s;
			print F "$l\n";
			$cl ++;
		}
		close(F);
	}
	$bio->close();
	my ($ok,$dh,$en,$el) = handle_message($spam,"$mf.part",$id,$ft);
	unlink("$mf.part");
	return ($ok,$dh,$en,$el);
}
sub handle_attaches {
	my ($spam,$mf,$id,$ft) = @_;
	return (0,0,11) unless (init_mparser());
	my $msg = $mparser->parse_open($mf);
	unless ($msg) {
		clean_parser($mparser);
		return (0,0,12);
	}
	init_mail($spam,$msg->get('Return-Path')) unless ($nosend);
	my $ok = 1;
	my @er = ();
	my $dh = 0;
	my $en = 0;
	my $el;
	my $xm = $msg->get('X-Mailer');
	if ($msg->is_multipart) {
		foreach my $prt ($msg->parts) {
			my ($xdh);
			($ok,$xdh,$en,$el) = handle_part($spam,$mf,$id,$ft,$prt,$xm);
			push @er, @{$el} if defined($el);
			$dh += $xdh;
			last unless ($ok);
		}
	} else {
		($ok,$dh,$en,$el) = handle_part($spam,$mf,$id,$ft,$msg,$xm);
		push @er, @{$el} if defined($el);
	}
	clean_parser($mparser);
	return ($ok,$dh,$en);
}

sub handle_report {
	my ($spam,$ft,$id,$rf,$df) = @_;
	log_msg('Handling: %s %s',$id,$spam?'spam':'ham');
	my ($ok,$dh,$en,$wc,$el);
	if ($ft =~ /(auto?|tra?p)/i) {
		$wc = 'm';
		($ok,$dh,$en,$el) = handle_message($spam,$rf,$id,$ft);
	} else {
		$wc = 'a';
		($ok,$dh,$en) = handle_attaches($spam,$rf,$id,$ft);
	}
	unless ($SpamReportSender) {
		send_mail() if ($ok);
		done_mail();
	}
	unless ($ok) {
		log_msg('Error: %s %s %u %u %s',$id,$wc,$dh,$en,(defined($el) && @{$el}) ? join(',',@{$el}) : '-');
		return 0;
	}
	if ($dh) {
		log_msg('Reported: %s %u',$id,$dh);
	} else {
		log_msg('Unhandled: %s',$id);
	}
	return 1 if ($debug);
	unlink($rf) if ($df);
	rename($rf,"$rf.done") if (-e $rf);
	return 1;
}

sub handle_dir {
	my ($spam,$d) = @_;
	return unless ($d);
	my $now = time();
	my @reports = ();
	my @olds = ();
	return unless (opendir(D,$d));
	#init_mail(0,$HamReportSender) if ($HamReportSender);
	init_mail(1,$SpamReportSender) if ($SpamReportSender);
	while (my $f = readdir(D)) {
		next if ($f =~ /^\./);
		next unless (-f "$d/$f");
		if ($now-(stat(_))[9]>$PurgeSpools) {
			push @olds, $f;
			next;
		}
		my $csm = $spam;
		my $ft = '';
		if ($f =~ /(\.[^\.]*)$/) {
			$ft = $1;
			if ($ft =~ /spam/i) {
				$csm = 1;
			} elsif ($ft =~ /ham/i) {
				$csm = 0;
			} elsif ($ft !~ /(auto?|tra?p|localdelivery)/i) {
				$csm = -1;
			}
		}
		next if ($csm < 0);
		next if ($nospam && $csm);
		next if ($noham && !$csm);
		push @reports, {ft=>$ft,fn=>$f,sm=>$csm,id=>file_id($f,$ft)};
	}
	closedir(D);
	unless ($debug) {
		foreach my $f (@olds) {
			unlink("$d/$f");
		}
	}
	return unless (@reports);
	log_msg('Handling: %s',$d);
	foreach my $rf (@reports) {
		handle_report($rf->{sm},$rf->{ft},$rf->{id},"$d/$rf->{fn}",1);
	}
	send_mail();
	done_mail();
}

sub handle_parsed_dir {
	my ($d) = @_;
	return unless ($d);
	return unless (opendir(D,$d));
	my $now = time();
	my %al = ();
	while (my $f = readdir(D)) {
		next unless ($f =~ /([a-z0-9]+)\.prs\.(new|eml|dat|sav)$/i);
		my $n = $1;
		my $e = $2;
		next unless (-f "$d/$f");
		$al{$n} = {tl=>$now,th=>0,el=>[]} unless (defined($al{$n}));
		push @{$al{$n}->{el}}, $e;
		$al{$n}->{fn} = $n;
		$al{$n}->{lc($e)} = 1;
		$al{$n}->{th} = (stat(_))[9] unless ($al{$n}->{th} >= (stat(_))[9]);
		$al{$n}->{tl} = (stat(_))[9] unless ($al{$n}->{tl} <= (stat(_))[9]);
	}
	closedir(D);
	return 0 unless (%al);
	my @nl = ();
	foreach my $f (values %al) {
		$f->{old} = $debugnoage ? 0 : ($now - $f->{th} > $maxage) ? 1 : 0;
		unless ($f->{old}) {
			if ($f->{dat} && $f->{eml} && $f->{new}) {
				unless ($f->{sav}) {
					if (open(F,'>',"$d/$f->{fn}.prs.sav")) { close(F); }
				}
				push @nl, $f;
			}
			next;
		}
		log_msg('Purge: %s/%s',$d,$f->{fn});
		next if ($debug);
		foreach my $e (@{$f->{el}}) {
			unlink("$d/$f->{fn}.prs.$e");
		}
	}
	return 0 unless (@nl);
	my $cgi = $debug ? new CGI::Pretty : new CGI;
	my @tl = ();
	my @pl = ();
	foreach my $f (@nl) {
		log_msg('List: %s/%s',$d,$f->{fn});
		my @rl = ();
		push @rl, $cgi->td(time2str('%Y-%m-%d %H:%M:%S',$f->{tl}));
		push @pl, time2str('%Y-%m-%d %H:%M:%S  ',$f->{tl});
		if ($SpamParseURL) {
			push @rl, $cgi->td($cgi->a({href=>"$SpamParseURL/$f->{fn}"},$f->{fn}));
			$pl[$#pl] .= "<$SpamParseURL/$f->{fn}>\n";
		} else {
			push @rl, $cgi->td($f->{fn});
			$pl[$#pl] .= "$f->{fn}\n";
		}
		push @tl, $cgi->TR({class=>$#tl%2?'odd':'even'},@rl);
	}
	return 0 unless (@tl);
	unshift @tl, $cgi->TR($cgi->th('received'),$cgi->th('id'));
	unshift @pl, "\n";
	unshift @pl, "New spam ready for reporting\n";
	my $mt = $mailto ? $mailto : $AdminAddress;
	my $snd = $SpamReportSender ? $SpamReportSender : $AdminAddress;
	my $eml = MIME::Entity->build(
		From		=> $snd,
		To		=> $mt,
		Subject		=> 'You have new spam ready for reporting',
		Encoding	=> '-SUGGEST',
		Type		=> 'multipart/alternative',
		'X-MDF-Report:'	=> "($FilterUtilVers) <reported>",
		'Message-ID:'	=> Email::MessageID->new($MyFilterHostName)->format,
		'Reply-To:'	=> $AdminContactAddress ? $AdminContactAddress : $AdminAddress,
	);
	return 0 unless ($eml);
	$eml->attach(
		Type		=> 'text/plain',
		Disposition	=> 'inline',
		Encoding	=> '-SUGGEST',
		Data		=> join('',@pl),
	);
	$eml->attach(
		Type		=> 'text/html',
		Disposition	=> 'inline',
		Encoding	=> '-SUGGEST',
		Data		=> join('',
					$cgi->start_html(-title=>'report spam',-style=>{-verbatim=>css()}),
					$cgi->h1('New spam ready for reporting'),
					$cgi->table(@tl).
					$cgi->end_html),
	);
	log_msg('Sending: %s -> %s',$snd,$mt);
	print	"=============================================\n".
		"Send mail (reports) from '$snd' to '$mt'\n".
		"---------------------------------------------\n".
		$eml->as_string.
		"=============================================\n" if ($debugprint);
	return scalar @nl if ($debug);
	my $cmd = "/usr/sbin/sendmail -odd -Ac -oi -f '$snd' -- '$mt'";
	unless (open(SM,"|$cmd")) {
		log_msg('Error calling sendmail!');
		return 0;
	}
	print SM $eml->as_string;
	close(SM);
	foreach my $f (@nl) {
		foreach my $e (@{$f->{el}}) {
			unlink("$d/$f->{fn}.prs.$e") if (lc($e) eq 'new');
		}
		if (open(F,'>',"$d/$f->{fn}.prs.rep")) { close(F); }
	}
	return scalar @nl;
}

sub handle_a_dir {
	my ($spam,$d) = @_;
	return unless ($d);
	return unless ($locker->trylock("$d/mdf-mail-reporter"));
	if ($spam eq 'P') {
		handle_parsed_dir($d);
	} else {
		handle_dir($spam,$d);
	}
	$locker->unlock("$d/mdf-mail-reporter");
}

read_cfg_cfg();
read_params();
$nosave = 1 unless ($SpamParseSpool && (-d $SpamParseSpool));
if ($SpamReportSpool eq $HamReportSpool) {
	handle_a_dir(-1,$SpamReportSpool);
} else {
	handle_a_dir(1,$SpamReportSpool);
	handle_a_dir(0,$HamReportSpool);
}
done_mail();
if ($SpamTrapSpool && ($SpamTrapSpool ne $SpamReportSpool) && ($SpamTrapSpool ne $HamReportSpool)) {
	handle_a_dir(1,$SpamTrapSpool);
}
done_mail();
unless ($nosave) {
	handle_a_dir('P',$SpamParseSpool);
}
done_mail();
$sa->finish_learner() if (defined($sa) && !$spamd);
clean_parser();