#!/usr/bin/perl
#***********************************************************************
#
# mdf-report
#
# mimedefang-filter reporter
#
# $Id: mdf-report.pl,v 1.22 2009/04/03 18:35:59 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 MIME::Head;
use MIME::Words;
use Encode;
use HTML::Entities;
use CGI;
use CGI::Pretty;
use MIME::Lite;
use Email::MessageID;
use Net::SMTP;
use Fortune;
use CSS::Tiny;
use DBI;
use Date::Format;
use Text::CSV_XS;

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

my $debug = 0;
my $quiet = 0;
my $sqldb;
my $sqldbd = '?';
my $mailto = '';
my $forget = 0;

my $FilterRevision = '$Revision: 1.22 $';
my $FilterUtilVers = '?';
if ('$Id: mdf-report.pl,v 1.22 2009/04/03 18:35:59 jonas Exp $' =~ /^\S+?:\s(\S+?),v\s([.\d]+)\s/) { $FilterUtilVers = "$1 $2"; }

my %Features;
$Features{'Path:QUARANTINEDIR'} = '/var/spool/MD-Quarantine';

# 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($AdminAddress $MyFilterHostName);
add_cfg_cfg('AdminAddress',\$AdminAddress,'postmaster','a');
add_cfg_cfg('MyFilterHostName',\$MyFilterHostName,'host.domain.tld','s');

# md: $DaemonAddress
use vars qw($DaemonAddress $MailResultMailer);
add_cfg_cfg('DaemonAddress',\$DaemonAddress,'mailer-daemon','a');
add_cfg_cfg('MailResultMailer',\$MailResultMailer,'127.0.0.1:25','s');

use vars qw ($hilo_entries);
add_cfg_cfg('hilo_entries',\$hilo_entries,0,'i');

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($silly_fortunes $silly_oneliners);
add_cfg_cfg('silly_fortunes',\$silly_fortunes,'');
add_cfg_cfg('silly_oneliners',\$silly_oneliners,'');

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

# 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 =~ /^d(ata)?b(ase)?[-_]?s(pec|pecification)?[:=]\s*(.*?)\s*$/i) {
			$database_spec = $4;
		} elsif ($p =~ /^d(ata)?b(ase)?[-_]?u(sr|ser)?[:=]\s*(.*?)\s*$/i) {
			$database_user = $4;
		} elsif ($p =~ /^d(ata)?b(ase)?[-_]?p(ass|assword|wd)?[:=]\s*(.*?)\s*$/i) {
			$database_pass = $4;
		} 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*?[\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;
					} 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';
	}
}

#***********************************************************************
# SQL.
#***********************************************************************
my $sqlr;

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

sub sql_connect {
	return 1 if ($sqldb);
	$sqldb = DBI->connect($database_spec,$database_user,$database_pass,{RaiseError=>0});
	return 0 unless ($sqldb);
	return 1;
}

sub sql_translate {
	my ($cmd) = @_;
	$cmd =~ s/ LIMIT -1$//;
	return $cmd;
}

sub sql_exec_commands {
	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);
		my $res = $st->execute(@pars);
		$st->finish;
		return 0 unless ($res);
	}
	return 1;
}

sub sql_execute_multi {
	return 0 unless (sql_connect());
	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_query {
	my $cmd = sql_translate(shift);
	return undef unless (sql_connect() && $cmd);
	my $st = $sqldb->prepare($cmd);
	return undef unless ($st);
	$st->execute(@_);
	return $st;
}

sub sql_select_one_row {
	my $st = sql_query(@_);
	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];
}

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

sub fwords {
	my $ws = join(' ',@_);
	$ws =~ s/_/ /g;
	$ws =~ s/\b([a-z])/uc($1)/ge;
	return $ws;
}

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

my @qdir_reported = ();
my %qdir_reported = ();
sub mark_qdir_reported {
	return unless (@qdir_reported);
	unless ($forget) {
		print "\tqdir\n" unless ($quiet);
		return if ($debug);
		for (my $i=0;$i<@qdir_reported;$i++) {
			next if $qdir_reported{$qdir_reported[$i]};
			$qdir_reported{$qdir_reported[$i]} = create_file($qdir_reported[$i]);
		}
	}
	@qdir_reported = ();
}
my @logs_reported = ();
my %logs_reported = ();
sub mark_logs_reported {
	return unless (@logs_reported);
	unless ($forget) {
		print "\tlogs\n" unless ($quiet);
		return if ($debug);
		my @dels = ([]);
		for (my $i=0;$i<@logs_reported;$i++) {
			next if $qdir_reported{$logs_reported[$i]};
			push @dels, [] if (@{$dels[$#dels]} > 512);
			push @{$dels[$#dels]}, $logs_reported[$i];
		}
		foreach my $del (@dels) {
			next unless (@{$del});
			if (sql_execute('DELETE FROM logs WHERE logs_id IN (?)',join(',',@{$del}))) {
				for (my $i=0;$i<@{$del};$i++) {
					logs_reported{$del->[$i]} = 1;
				}
			}
		}
	}
	@logs_reported = ();
}
sub mark_reported {
	return unless (@qdir_reported || @logs_reported);
	if ($forget) {
		@qdir_reported = ();
		@logs_reported = ();
		return;
	}
	print "Marking\n";
	mark_qdir_reported();
	mark_logs_reported();
}

# Get a fortune cookie...
sub get_fortune_cookie {
	my ($fn,$l1,$d) = @_;
	$d = '' unless ($d);
	return $d unless ($fn);
	return $d unless (-f $fn);
	my $fo = 0;
	my $fh;
	eval { $fh = new Fortune($fn); };
	return $d unless ($fh);
	if (-f "$fn.dat") {
		eval { $fh->read_header(); $fo = 1; };
	} else {
		eval { $fh->compute_header(); $fo = 1; };
	}
	if ($fo) {
		my $c;
		my $t = 0;
		do {
			$t ++;
			$c = $fh->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 if ($c =~ /[^\r\n\s\x20-\x7E]/);
		} while ($t < 10 && !$c);
		$d = $c if ($c);
	}
	$fh->close_file;
	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);
}

sub read_file {
	my ($fn,$one) = @_;
	my @r = ();
	if (open(F,'<',$fn)) {
		while (my $l = <F>) {
			$l =~ s/[\r\n]+$//;
			push @r, $l;
			last if ($one);
		}
		close(F);
	}
	return @r;
}

sub read_lines {
	my @r = read_file(@_);
	return undef unless (@r);
	return \@r;
}

sub read_line {
	my @r = read_file(@_,1);
	return undef unless (@r);
	$r[0] =~ s/[\r\n]+$//;
	return $r[0];
}

sub read_text {
	my @r = read_file(@_);
	return undef unless (@r);
	return join("\n",@r,'');
}

sub decode_header {
	my $r = join('',@_);
	$r =~ s/[\r\n]+$//;
	if ($r =~ /=\?(\S+)\?[QBqb]\?.*\?=/) {
		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";
		}
		my @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];
				}
			}
		}
	}
	$r =~ s/[\s\r\n\t]+/ /gs;
	$r =~ s/^\s+//;
	$r =~ s/\s+$//;
	return $r;
}

#***********************************************************************
# Reports.
#***********************************************************************
my $cgi = $debug ? new CGI : new CGI::Pretty;

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

sub report_mail {
	my $what = shift;
	my $addr = shift;
	my $subj = shift;
	my $html = $cgi->start_html(-title=>$subj,-style=>{-verbatim=>css}).join(' ',@_).$cgi->end_html;
	unless ($debug) {
		#$html =~ s/>[\s\r\n]+</></gs;
		$html =~ s/>[\s\r\n]+/>/gs;
		$html =~ s/[\s\r\n]+</</gs;
		$html =~ s/[\s\r\n]+/ /gs;
		$html =~ s/^(<!DOCTYPE [^>]*>)/$1\n/;
		$html =~ s/a>\|<a/a> | <a/gs;
	}
	my $mt = $addr;
	$mt = $mailto unless ($mt);
	$mt = $AdminAddress unless ($mt);
	print "\tcreate mail\n" unless ($quiet);
	my $eml = MIME::Lite->new(
		'X-MDF-Report:'	=> "($FilterUtilVers) <$what>",
		'Message-ID:'	=> Email::MessageID->new($MyFilterHostName)->format,
		From		=> $DaemonAddress,
		To		=> $mt,
		Subject		=> $subj,
		Type		=> 'multipart/mixed',
	);
	$eml->attach(
		Type		=> 'text/plain',
		Encoding	=> '7bit',
		Disposition	=> 'inline',
		Data		=> get_oneliner,
	);
	$eml->attach(
		Type		=> 'text/html',
		Encoding	=> 'quoted-printable',
		Disposition	=> 'inline',
		Data		=> $html,
	);
	$eml->attach(
		Type		=> 'text/plain',
		Encoding	=> '7bit',
		Disposition	=> 'inline',
		Data		=> get_fortune,
	);
	if ($debug) {
		print $eml->as_string;
		return 0;
	}
	print "\tsend mail ($mt)\n" unless ($quiet);
	my $smtp = Net::SMTP->new($MailResultMailer);
	return 0 unless ($smtp);
	my $sok = ($smtp->mail($DaemonAddress) && $smtp->recipient($mt) && $smtp->data($eml->as_string));
	$smtp->quit;
	return $sok;
}

my %qdir_ids = ('?'=>0);
sub list_quarantine {
	my ($force,$all,$list) = @_;
	return 1 if (!$force && $qdir_ids{'?'});
	print "\tlist qdirs\n" unless ($quiet);
	return 0 unless (opendir('D',$Features{'Path:QUARANTINEDIR'}));
	my $now = time();
	while (my $f = readdir(D)) {
		next if ($f =~ /^\./);
		my $pn = $Features{'Path:QUARANTINEDIR'}.'/'.$f;
		if (-d $pn) {
			my $qid = read_line("$pn/SENDMAIL-QID");
			$qdir_ids{$qid} = $pn if ($qid && $qid ne '?');
			next unless ($list);
			next if ($now - (stat(_))[9] < 12*60*60);
			if (-f "$pn/reported") {
				$qdir_reported{"$pn/reported"} = 1;
				next unless ($all);
			}
			push @{$list}, {fn=>$f,pn=>$pn,qid=>$qid?encode_entities($qid):''};
		}
	}
	closedir(D);
	$qdir_ids{'?'} ++;
	return 1;
}
my %qdir_hds = ();
sub read_header {
	my ($qid,$qdir) = @_;
	$qid = '' if (length($qid) < 2);
	$qdir = '' if (length($qdir) < 2);
	return undef unless ($qid || $qdir);
	return $qdir_hds{$qid}{''} if ($qid && $qdir_hds{$qid}{''});
	$qdir = $qdir_ids{$qid} unless ($qdir);
	return undef unless ($qdir && length($qdir)>1);
	return undef unless (-e "$qdir/HEADERS");
	my $hdr = MIME::Head->from_file("$qdir/HEADERS");
	return undef unless ($hdr);
	$qdir_hds{$qid}{''} = $hdr if ($qid);
	return $hdr;
}
sub get_header {
	my ($qid,$qdir,$hdrn) = @_;
	$qid = '' if (length($qid) < 2);
	$qdir = '' if (length($qdir) < 2);
	return '' unless ($hdrn && ($qid || $qdir));
	$hdrn = lc($hdrn);
	return $qdir_hds{$qid}{$hdrn} if ($qid && $qdir_hds{$qid}{$hdrn});
	my $hdr = read_header($qid,$qdir);
	return '' unless ($hdr);
	my $val = $hdr->get($hdrn);
	return '' unless (defined($val));
	$val = decode_header($val) if ($val);
	$qdir_hds{$qid}{$hdrn} = $val if ($qid);
	return $val;
}

sub quarantine_table {
	my ($qdl,$tables,$fa,$hm) = @_;
	print "\tmake table ($fa,$hm)\n" unless ($quiet);
	my @trl = ();
	foreach my $qd (sort { $a->{fn} cmp $b->{fn} } @{$qdl}) {
		next unless ($qd->{fa} eq $fa && $qd->{hm} eq $hm);
		$qd->{inc} = 1;
		my @qfi = ();
		if ($quarantine_url && $qd->{fn}) {
			push @qfi, $cgi->a({href=>sprintf('%s/%s',$quarantine_url,$qd->{fn})},$qd->{fn});
		} elsif ($qd->{fn}) {
			push @qfi, $qd->{fn};
		}
		push @qfi, $qd->{qid} if ($qd->{qid});
		push @trl, $cgi->TR({class=>$#trl%2?'odd':'even'},
			#$cgi->td("$fa$hm"),
			#$cgi->td($qd->{qid}),
			$cgi->td($qd->{snd}),
			$cgi->td(join($cgi->br,@{$qd->{rcpt}})),
			$cgi->td($qd->{subj}),
			$cgi->td($qd->{msgs}),
			$cgi->td(join($cgi->br,@qfi)),
		);
	}
	return '' unless (@trl);
	unshift @trl, $cgi->TR(
		#$cgi->th('what'),
		#$cgi->th('Queue ID'),
		$cgi->th('Sender'),
		$cgi->th('Recipient(s)'),
		$cgi->th('Subject'),
		$cgi->th('Information'),
		$cgi->th('Q'),
	);
	my $hs;
	if ($fa eq 'S') {
		$hs = 'Stopped';
	} elsif ($fa eq 'R') {
		$hs = 'Removed';
	} elsif ($fa eq 'M') {
		$hs = 'Modified';
	} else {
		$hs = 'Handled';
	}
	if ($hm eq 'M') {
		$hs .= ' Message';
	} elsif ($hm eq 'P') {
		$hs .= ' Part';
	} else {
		$hs .= ' Thing';
	}
	$hs .= 's' if ($#trl > 0);
	my $hsa = lc($hs);
	$hsa =~ s/\s+/_/g;
	$hsa =~ s/[^_a-z0-9]//g;
	push @{$tables}, $cgi->a({href=>"#$hsa"},encode_entities($hs));
	return $cgi->div($cgi->h2({id=>$hsa},encode_entities($hs)),$cgi->table(@trl));
}
sub quarantine_report {
	print "Quarantine Report\n" unless ($quiet);
	my ($all) = @_;
	my @qdl = ();
	return unless (list_quarantine(1,$all,\@qdl));
	return unless (@qdl);
	print "\tread qdirs\n" unless ($quiet);
	my $dc = 0;
	foreach my $qd (@qdl) {
		my %msgf = ();
		my %flag = ();
		my %dir = ();
		next unless (opendir(D,$qd->{pn}));
		print "\t\t$qd->{fn}\n" if ($debug);
		while (my $f = readdir(D)) {
			next if ($f =~ /^\./);
			next if ($f eq 'reported');
			$dir{$f} = 1;
			if ($f =~ /^FLAG\.(.+)$/) {
				$flag{lc($1)} = 1;
			} elsif ($f =~ /^MSG.(\d+)$/) {
				$msgf{$1} = $f;
			}
		}
		closedir(D);
		next unless (%dir);
		$dc ++;
		if ($flag{'stopped'}) {
			$qd->{fa} = 'S';
		} elsif ($flag{'removed'}) {
			$qd->{fa} = 'R';
		} elsif ($flag{'modified'}) {
			$qd->{fa} = 'M';
		} else {
			$qd->{fa} = '?';
		}
		if ($dir{'ENTIRE_MESSAGE'}) {
			$qd->{hm} = 'M';
		} else {
			$qd->{hm} = 'P';
		}
		$qd->{qid} = '';
		$qd->{snd} = '';
		$qd->{rcpt} = [];
		$qd->{subj} = '';
		$qd->{snd} = encode_entities(read_line("$qd->{pn}/SENDER")) if ($dir{'SENDER'});
		if ($dir{'RECIPIENTS'}) {
			$qd->{rcpt} = read_lines("$qd->{pn}/RECIPIENTS");
			if ($qd->{rcpt}) {
				for (my $i=0;$i<@{$qd->{rcpt}};$i++) {
					$qd->{rcpt}->[$i] = encode_entities($qd->{rcpt}->[$i]);
				}
			}
		}
		$qd->{subj} = encode_entities(get_header($qd->{qid},$qd->{pn},'Subject'));
		foreach my $mn (sort { $a <=> $b } keys %msgf) {
			my $msg = read_text("$qd->{pn}/$msgf{$mn}");
			next unless ($msg);
			$msg =~ s/[\s\n]+$//s;
			$msg =~ s/^\n+//s;
			next unless ($msg);
			$msg = encode_entities($msg);
			$msg =~ s/\n+/$cgi->br/gse;
			$qd->{msgs} = '' unless ($qd->{msgs});
			$qd->{msgs} .= $cgi->p($msg);
		}
		if ($dir{'SPAM_REPORT'}) {
			foreach my $l (read_file("$qd->{pn}/SPAM_REPORT")) {
				if ($l =~ /^Score:/i) {
					$qd->{msgs} = '' unless ($qd->{msgs});
					$qd->{msgs} .= $cgi->p(encode_entities($l));
					last;
				}
			}
		}
	}
	return unless ($dc);
	my $html = '';
	my @tables = ();
	$html .= quarantine_table(\@qdl,\@tables,'S','M');
	$html .= quarantine_table(\@qdl,\@tables,'R','M');
	$html .= quarantine_table(\@qdl,\@tables,'S','P');
	$html .= quarantine_table(\@qdl,\@tables,'R','P');
	$html .= quarantine_table(\@qdl,\@tables,'M','M');
	$html .= quarantine_table(\@qdl,\@tables,'M','P');
	$html .= quarantine_table(\@qdl,\@tables,'?','M');
	$html .= quarantine_table(\@qdl,\@tables,'?','P');
	return unless ($html);
	return unless (report_mail('quarantine','','MDF Quarantine Report',
			$cgi->h1('MDF Quarantine Report'),
			$cgi->p(join(' | ',@tables)),
			$html));
	foreach my $qd (@qdl) {
		next unless ($qd->{inc});
		push @qdir_reported, "$qd->{pn}/reported";
	}
}

my %rej_lines = ();
my %rej_reasons = ();
my $rej_collected = 0;
sub reject_collect {
	return 0 if ($rej_collected<0);
	return 1 if ($rej_collected);
	print "\tcollect\n" unless ($quiet);	
	return 0 unless (list_quarantine());
	my $logcsv = Text::CSV_XS->new({sep_char=>',',quote_char=>"'",binary=>1});
	my $logssv = Text::CSV_XS->new({sep_char=>';',quote_char=>'"',binary=>1});
	my $now = time();
	return 0 unless (sql_connect());
	#sql_execute('DELETE FROM logs WHERE logs_type=? AND logs_cont!=? AND logs_cont!=?',
	#		'stats','reject','discard');
	my $st = sql_query('SELECT logs_id,logs_mqid,logs_stamp,logs_line FROM logs WHERE logs_stamp<? AND logs_type=? AND (logs_cont=? OR logs_cont=?) ORDER BY logs_id',
			$now-(12*60*60),'stats','reject','discard');
	return 0 unless ($st);
	$st->execute;
	%rej_lines = ();
	%rej_reasons = ();
	while (my @res = $st->fetchrow_array) {
		my $qid = $res[1];
		next unless ($logssv->parse($res[3]));
		my @flds = $logssv->fields;
		$flds[0] = 'phish' if ($flds[0] eq 'virus' && $flds[1] =~ /\.Phishing\./i);
		$flds[0] = 'eicar' if ($flds[0] eq 'virus' && $flds[1] =~ /^Eicar[-_.]Test[-_.]/i);
		$rej_reasons{$flds[0]}{t} = 0 unless ($rej_reasons{$flds[0]}{t});
		$rej_reasons{$flds[0]}{t} ++;
		my $bad = 0;
		foreach my $i ((1,6)) {
			if (defined($flds[$i]) && $flds[$i] ne '') {
				unless ($logcsv->parse($flds[$i])) {
					$bad = 1;
					last;
				}
				$flds[$i] = [$logcsv->fields];
			} else {
				$flds[$i] = [];
			}
		}
		next if ($bad);
		$flds[3] = undef if ($flds[3] eq "[$flds[2]]");
		$flds[4] = undef if (lc($flds[4]) eq lc($flds[3]));
		$flds[7] = decode_header($flds[7]) if ($flds[7]);
		$rej_reasons{$flds[0]}{l} = [] unless ($rej_reasons{$flds[0]}{l});
		$rej_reasons{$flds[0]}{c} = 0 unless ($rej_reasons{$flds[0]}{c});
		$rej_reasons{$flds[0]}{c} ++;
		$rej_lines{$qid} = [] unless $rej_lines{$qid};
		push @{$rej_lines{$qid}}, {
			id	=> $res[0],
			stamp	=> $res[2],
			#line	=> $res[3],
			#fields	=> \@flds,
			reason	=> $flds[0],
			info	=> $flds[1],
			relay	=> $flds[2],
			host	=> $flds[3],
			helo	=> $flds[4],
			sender	=> $flds[5],
			rcpts	=> $flds[6],
			subject	=> $flds[7],
		};
		push @{$rej_reasons{$flds[0]}{l}}, {q=>$qid,l=>$#{$rej_lines{$qid}}};
		$qdir_ids{$qid} = '?' if ($qid && $qid ne '?' && !$qdir_ids{$qid});
		$rej_collected ++;
	}
	$st->finish;
	unless ($rej_collected) {
		$rej_collected = -1;
		return 0
	};
	return 1;
}
sub reject_cmp {
	my $r = $a->[0] <=> $b->[0];
	$r = $r ? $r : $a->[7] cmp $b->[7];
	return $r if ($r);
	for my $i ((5,1,2,3,4)) {
		$r = $a->[$i] cmp $b->[$i];
		return $r if ($r);
	}
	return 0;
}
sub reject_table {
	my ($what,$logs,$all,$tables,$usersr,$totals) = @_;
	print "\tmake table ($what)\n" unless ($quiet);
	my $infoslash = $what eq 'spam';
	my @used = ();
	my @nouse = ();
	my @tll = ();
	my %lid = ();
	my $ls = $logs;
	$nouse[1] = 1 if ($what =~ /^(mail_from|unknown_local_user)$/);
	$nouse[2] = 1 if ($usersr || $what =~ /^(bad_recipient_map|bad_user|unknown_user)$/);
	$nouse[5] = 1 if ($usersr);
	$nouse[6] = 1 unless ($usersr);
	foreach my $li (@{$ls}) {
		my $line = $rej_lines{$li->{q}}->[$li->{l}];
		next unless ($line);
		next if (!$all && length($li->{q})>1 && $qdir_ids{$li->{q}} && length($qdir_ids{$li->{q}})>1);
		if ($usersr) {
			next unless ($line->{rcpts} && @{$line->{rcpts}});
			my $skip = 1;
			foreach my $rcpt (@{$line->{rcpts}}) {
				if ($rcpt =~ /^$usersr$/i) {
					$skip = 0;
					last;
				}
			}
			next if ($skip);
		}	
		my $lused = 0;
		my @tl = ();
		$tl[8] = $line->{id};
		if (!$nouse[1]) {
			if ($usersr) {
				foreach my $hn ('From','Sender','Reply-To') {
					$tl[1] = get_header($li->{q},'',$hn);
					last if ($tl[1]);
				}
			}
			$tl[1] = $line->{sender} if (!$tl[1] && defined($line->{sender}) && $line->{sender} ne '');
			if ($tl[1]) {
				$tl[1] = encode_entities($tl[1]);
				$used[1] = 1;
				$lused = 1;
			}
		}
		if (!$nouse[2] && $line->{rcpts} && @{$line->{rcpts}}) {
			$tl[2] = join($cgi->br,map { encode_entities($_) } @{$line->{rcpts}});
			$used[2] = 1;
			$lused = 1;
		}
		if (!$nouse[3]) {
			$tl[3] = $line->{subject} if (defined($line->{subject}) && $line->{subject} ne '');
			$tl[3] = get_header($li->{q},'','Subject') unless (defined($tl[3]));
			if (defined($tl[3]) && $tl[3] ne '') {
				$tl[3] = encode_entities($tl[3]);
				$used[3] = 1;
				$lused = 1;
			}
		}
		if (!$nouse[4] && $line->{info} && @{$line->{info}}) {
			if ($infoslash) {
				$tl[4] = join(' / ',map { encode_entities($_) } @{$line->{info}});
			} else {
				$tl[4] = join($cgi->br,map { encode_entities($_) } @{$line->{info}});
			}
			$used[4] = 1;
			$lused = 1;
		}
		if (!$nouse[5]) {
			my @xinfo = ();
			foreach my $xi ('relay','host','helo') {
				next if ($xi eq $what);
				push @xinfo, sprintf('%s: %s',ucfirst($xi),encode_entities($line->{$xi})) if (defined($line->{$xi}) && $line->{$xi} ne '');
			}
			if (@xinfo) {
				$tl[5] = join($cgi->br,@xinfo);
				$used[5] = 1;
				$lused = 1;
			}
		}
		if (!$nouse[6] && length($li->{q})>1 && $qdir_ids{$li->{q}} && length($qdir_ids{$li->{q}})>0) {
			$tl[6] = $qdir_ids{$li->{q}};
			$tl[6] =~ s/^[^\/]*\///;
			$used[6] = 1;
		}
		next unless ($lused);
		if ($what eq 'spam') {
			$tl[7] = sprintf('%09.4f',$line->{info}->[0]);
		} elsif ($what eq 'virus') {
			$tl[7] = sprintf('%u|%s',$line->{info}->[0]&&$line->{info}->[0]=~/\.Phishing\./i?1:0,$line->{info}->[0]);
		} else {
			$tl[7] = '';
			foreach my $inf (@{$line->{info}}) {
				if ($inf =~ /^\d+$/) {
					$tl[7] .= sprintf('|%127s',$inf);
				} else {
					$tl[7] .= sprintf('|%-127s',$inf);
				}
			}
		}
		my $rid = join("\x01",@tl);
		if ($lid{$rid}) {
			$tll[$lid{$rid}]->[0] ++;
			$used[0] = 1;
		} else {
			$tl[0] = 1;
			push @tll, \@tl;
			$lid{$rid} = $#tll;
		}
		if ($totals) {
			$totals->{$what} = 0 unless ($totals->{$what});
			$totals->{$what} ++;
		}
	}
	my @table = ();
	foreach my $tl (sort reject_cmp @tll) {
		my @ll = ();
		my $fi = 0;
		for (my $i=0;$i<7;$i++) {
			next unless ($used[$i]);
			if (defined($tl->[$i]) && $tl->[$i] ne '') {
				$fi = 1;
			} else {
				$tl->[$i];
			}
			push @ll, $cgi->td($tl->[$i]);
		}
		next unless ($fi);
		#push @logs_reported, $tl->[8];
		push @table, $cgi->TR({class=>$#table%2?'odd':'even'},@ll);
	}
	return '' unless (@table);
	my @head = ();
	push @head, $cgi->th('Count') if ($used[0]);
	push @head, $cgi->th('Sender') if ($used[1]);
	push @head, $cgi->th('Recipients') if ($used[2]);
	push @head, $cgi->th('Subject') if ($used[3]);
	push @head, $cgi->th('Info') if ($used[4]);
	push @head, $cgi->th('Mailer') if ($used[5]);
	unshift @table, $cgi->TR(@head);
	push @{$tables}, $cgi->a({href=>"#$what"},encode_entities(fwords($what)));
	return $cgi->div($cgi->h2({id=>$what},encode_entities(fwords($what))),$cgi->table(@table));
}
sub reject_report {
	print "Rejection Report\n" unless ($quiet);
	my ($show,$hide,$all) = @_;
	return unless (reject_collect());
	my $html = '';
	my @summary = ();
	foreach my $rsn (sort { $rej_reasons{$a}{t} <=> $rej_reasons{$b}{t} } keys %rej_reasons) {
		push @summary, $cgi->TR({class=>$#summary%2?'odd':'even'},$cgi->td(fwords($rsn)),$cgi->td($rej_reasons{$rsn}{t}));
	}
	if (@summary) {
		#push @tables, $cgi->a({href=>'#summary'},'Summary');
		$html .= $cgi->div($cgi->h2({id=>'summary'},'Summary'),$cgi->table(@summary));
	}
	my @tables = ();
	foreach my $rsn (sort keys %rej_reasons) {
		next unless ($rej_reasons{$rsn}{c});
		next unless ($rsn =~ /^$show$/i && $rsn !~ /^$hide$/i);
		$html .= reject_table($rsn,$rej_reasons{$rsn}{l},$all,\@tables);
	}
	return unless ($html);
	#print $html; return;
	return unless (report_mail("rejections:$show",'','MDF Rejection Report',
			$cgi->h1('MDF Rejection Report'),
			$cgi->p(join(' | ',@tables)),
			$html));
}
sub reject_report_user {
	my $show = shift;
	my $hide = shift;
	my $all = shift;
	my $user = shift;
	$user =~ s/^<(.*?)>$/$1/;
	@_ = ($user) unless (@_);
	my @usersr = ();
	my @userst = ();
	foreach my $usr (@_) {
		my $usrx = $usr;
		$usrx =~ s/\s+//g;
		next unless ($usrx);
		$usrx =~ s/^<(.*?)>$/$1/;
		push @userst, "<$usrx>";
		push @usersr, "<?$usrx>?";
	}
	return unless (@usersr);
	print "Rejection Report (".join(',',@userst).")\n" unless ($quiet);
	return unless (reject_collect());
	my @tables = ();
	my %totals = ();
	my $html = '';
	foreach my $rsn (sort keys %rej_reasons) {
		next unless ($rej_reasons{$rsn}{c});
		next unless ($rsn =~ /^$show$/i && $rsn !~ /^$hide$/i);
		$html .= reject_table($rsn,$rej_reasons{$rsn}{l},$all,\@tables,join('|',@usersr),\%totals);
	}
	my @summary = ();
	foreach my $rsn (sort { $totals{$a} <=> $totals{$b} } keys %totals) {
		next unless ($totals{$rsn});
		push @summary, $cgi->TR({class=>$#summary%2?'odd':'even'},$cgi->td(fwords($rsn)),$cgi->td($totals{$rsn}));
	}
	if (@summary) {
		#push @tables, $cgi->a({href=>'#summary'},'Summary');
		$html = $cgi->div($cgi->h2({id=>'summary'},'Summary'),$cgi->table(@summary)).$html;
	}
	return unless ($html);
	return unless (report_mail("user:$show",$user,'MDF Rejection Report',
			$cgi->h1('MDF Rejection Report'),
			$cgi->blockquote(encode_entities(join(' ',@userst))),
			$cgi->p(join(' | ',@tables)),
			$html));
}
sub reject_report_users {
	my ($rtufn) = @_;
	$rtufn = get_file_path_name('user-reports');
	return unless (open(UF,'<',$rtufn));
	my @users = <UF>;
	close(UF);
	foreach my $l (@users) {
		$l =~ s/[\r\n]+//gs;
		next unless ($l);
		next if ($l =~ /^\s*[#;]/);
		reject_report_user('spam|phish|virus','',1,split(/\s+/,$l));
	}
}

sub hiloscores_table {
	my $ord = shift;
	my $lmt = shift;
	my $lst = shift;
	return unless (sql_connect());
	my $st = sql_query("SELECT hilo_id,hilo_stamp,hilo_score,hilo_info,hilo_report FROM hiloscores ORDER BY hilo_score $ord LIMIT $lmt");
	return unless ($st);
	$st->execute;
	my @trl = ();
	while (my @res = $st->fetchrow_array) {
		next unless ($res[1] && $res[2] && $res[3]);
		my $date = time2str('%Y-%m-%d %H:%M:%S',$res[1]);
		my $score = $res[2];
		my $info = '';
		if ($res[3]) {
			my @itl = ();
			foreach my $l (split(/[\r\n]+/,$res[3])) {
				if ($l =~ /^([^:]+)\s*:\s*(.*?)\s*$/) {
					my $k = $1;
					my $v = decode_header($2);
					$k = encode_entities("$k:");
					$k =~ s/ /\&nbsp;/g;
					push @itl, $cgi->TR(
						$cgi->td($k),
						$cgi->td(encode_entities($v)),
					);
				}
			}
			$info = $cgi->table({class=>'top'},@itl) if (@itl);
		}
		my $report = '';
		if ($res[4]) {
			$res[4] =~ s/\r?\n/\n/gs;
			$res[4] =~ s/\r/\n/gs;
		  	if ($res[4] =~ /----------/s) {
				$res[4] =~ s/[- A-Za-z]+:\s+\([^\n\)]*\)\n\s*\n[ a-z]+\n[- ]+----------\n//gs;
				$res[4] =~ s/[ a-z]+\n[- ]+----------\n//gs;
				$res[4] =~ s/[- ]+----------\n//gs;
			}
			$res[4] =~ s/\n+/\n/gs;
			my @hti = ();
			foreach my $l (split(/[\r\n]+/,$res[4])) {
				if ($l =~ /^\s*(-?\d+\.\d+)\s+(\S+)\s*(.*?)\s*$/) {
					push @hti, {sc=>encode_entities($1),rn=>encode_entities($2),rd=>[]};
					push @{$hti[$#hti]->{rd}}, encode_entities($3) if ($3);
				} elsif ($l =~ /^\s*(\S+.*?)\s*$/ && @hti) {
					push @{$hti[$#hti]->{rd}}, encode_entities($1);
				}
			}
			my @htl = ();
			foreach my $ri (@hti) {
				push @htl, $cgi->TR(
					$cgi->td($ri->{sc}),
					$cgi->td($ri->{rn}),
					$cgi->td(join($cgi->br,@{$ri->{rd}})),
				);
			}
			$report = $cgi->table({class=>'top'},@htl) if (@htl);
		}
		push @trl, $cgi->TR({class=>$#trl%2?'odd':'even'},
			$cgi->td($date),
			$cgi->td($score),
			$cgi->td($info),
			$cgi->td($report),
		);
	}
	$st->finish;
	return '' unless (@trl);
	@trl = reverse @trl if ($ord eq 'ASC');
	unshift @trl, $cgi->TR(
		$cgi->th('Date'),
		$cgi->th('Score'),
		$cgi->th('Info'),
		$cgi->th('Report'),
	);
	my $hs = "$lst Score List";
	my $hsa = lc($hs);
	$hsa =~ s/\s+/_/g;
	$hsa =~ s/[^_a-z0-9]//g;
	#push @{$tables}, $cgi->a({href=>"#$hsa"},$hs);
	return $cgi->div($cgi->h2({id=>$hsa},encode_entities($hs)),$cgi->table({class=>'top'},@trl));
}
sub hiloscores_report {
	print "High/Low Scores Report\n" unless ($quiet);
	my $html = '';
	$html .= hiloscores_table('DESC',$hilo_entries,'High');
	$html .= hiloscores_table('ASC',$hilo_entries,'Low');
	return unless ($html);
	report_mail('hiloscores','','Spam High and Low Scores Report',
			$cgi->h1('Spam High and Low Scores Report'),
			$html);
}

sub external_local_table {
	return '' unless (sql_connect());
	my $st = sql_query('SELECT logs_id,logs_mqid,logs_stamp,logs_line FROM logs WHERE logs_type=? AND logs_cont=?',
				'stats','notice');
	return '' unless ($st);
	my $logssv = Text::CSV_XS->new({sep_char=>';',quote_char=>'"',binary=>1});
	my %addresses = ();
	my @qids = ();
	while (my @res = $st->fetchrow_array) {
		my $qid = $res[1];
		next unless ($logssv->parse($res[3]));
		my @flds = $logssv->fields;
		next unless (@flds && $flds[0] eq 'external_local');
		my $stq = sql_query('SELECT logs_mqid FROM logs WHERE logs_type=? AND logs_cont=? AND logs_mqid=?',
						'stats','deliver',$qid);
		next unless ($stq);
		my @resq = $stq->fetchrow_array;
		$stq->finish;
		next if ($#resq || $resq[0] ne $qid);
		$flds[3] =~ s/^<(.*)>$/$1/;
		$addresses{$flds[3]} = {
			cnt	=> 0,
			qid	=> {},
			relays	=> {},
			hosts	=> {},
			oldt	=> 0,
			newt	=> 0,
			olds	=> '',
			news	=> '',
		} unless ($addresses{$flds[3]});
		push @qids, $res[1];
		my $relay = "[$flds[1]]";
		$relay = "$flds[2] $relay" if ($flds[2] && $flds[2] !~ /^\[?$flds[1]\]?$/);
		$addresses{$flds[3]}->{cnt} ++;
		$addresses{$flds[3]}->{qid}->{$res[1]} = 1;
		$addresses{$flds[3]}->{rly}->{$relay} = 1;
		if ($res[2]>$addresses{$flds[3]}->{newt}) {
			$addresses{$flds[3]}->{newt} = $res[2];
			$addresses{$flds[3]}->{news} = time2str('%Y-%m-%d',$res[2]);
		}
		if (!$addresses{$flds[3]}->{oldt} || $res[2]<$addresses{$flds[3]}->{oldt}) {
			$addresses{$flds[3]}->{oldt} = $res[2];
			$addresses{$flds[3]}->{olds} = time2str('%Y-%m-%d',$res[2]);
		}
		push @logs_reported, $res[0];
	}
	$st->finish;
	return '' unless (%addresses);
	my @trl = ();
	foreach my $addr (sort { $addresses{$a}->{new} <=> $addresses{$b}->{new} } keys %addresses) {
		push @trl, $cgi->TR({class=>$#trl%2?'odd':'even'},
			$cgi->td($addr),
			$cgi->td($addresses{$addr}->{olds} eq $addresses{$addr}->{news} ?
				$addresses{$addr}->{olds} :
				join($cgi->br,$addresses{$addr}->{olds},$addresses{$addr}->{news})),
			$cgi->td($addresses{$addr}->{cnt}),
			$cgi->td(join($cgi->br,keys %{$addresses{$addr}->{rly}})),
			$cgi->td(join($cgi->br,keys %{$addresses{$addr}->{qid}})),
		);
	}
	#@trl = reverse @trl if ($ord eq 'ASC');
	unshift @trl, $cgi->TR(
		$cgi->th('Address'),
		$cgi->th('Date(s)'),
		$cgi->th('Count'),
		$cgi->th('Relays'),
		$cgi->th('QIDs'),
	);
	return $cgi->div($cgi->h2({id=>'external_local'},'Local senders from external relays'),$cgi->table(@trl));
}
sub external_local_report {
	print "External Local Report\n" unless ($quiet);
	my $html = external_local_table();
	return unless ($html);
	report_mail('externlocal','','External Local Report',$html);
}

read_cfg_cfg();
#$forget = 1;
#$debug = 1;
for (my $i=0;$i<@ARGV;$i++) {
	my ($c,$p) = split(/[:=]+/,$ARGV[$i]);
	$c =~ s/[^A-Za-z]+//g;
	unless ($c) {
		print "? $ARGV[$i]\n" unless ($quiet);
		next;
	}
	$c = lc($c);
	if ($c =~ /^d(e?bu?g)?$/) {
		$debug = 1;
	} elsif ($p && $c =~ /^m(ail)?to?$/) {
		$mailto = $p;
	} elsif ($c =~ /^q(uarantine?)?$/) {
		quarantine_report(0);
	} elsif ($c =~ /^f(ull)?q(uarantine?)?$/) {
		quarantine_report(1);
	} elsif ($c =~ /^(h|hi|high)?(l|lo|low)?(s|score)?(l|lists?)?$/) {
		hiloscores_report();
	} elsif ($c =~ /^r(eject(ion)?s?)?$/) {
		reject_report('.*','(|unknown_user|bad_recipient_map|helo|bad_user|mail_from|relay|unknown_local_user)',0);
	} elsif ($c =~ /^f(ull)?r(eject(ion)?s?)?$/) {
		reject_report('.*','',1);
	} elsif ($c =~ /^s(pam)?r(eject(ion)?s?)?$/) {
		reject_report('spam(_.*)?','',0);
	} elsif ($c =~ /^(\S+?)r(eject(ion)?s?)?$/) {
		reject_report(lc($1),'',0);
	} elsif ($c =~ /^u(sers?)(r(eports?)?)?$/) {
		reject_report_users();
	} elsif ($p && $c =~ /^u(?:sers?)(?:r(?:eports?)?)?$/) {
		reject_report_users($p);
	} elsif ($c =~ /^(e|x|extern(?:al)?)l(oc(?:al)?)?$/) {
		external_local_report();
	} elsif ($c =~ /^q(uiet)?$/) {
		$quiet = 1;
	} elsif ($c =~ /^f(orget)?$/) {
		$forget = 1;
	} else {
		print "? $ARGV[$i]\n" unless ($quiet);
	}
}
mark_reported();
sql_disconnect();