#!/usr/bin/perl
#***********************************************************************
#
# mdfdb-clean
#
# mimedefang-filter database cleaner/creator
#
# $Id: mdfdb-clean.pl,v 1.42 2009/06/22 16:43:40 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.
#
#***********************************************************************

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

use strict;
use Sys::Syslog;
use DBI;
use IO::File;
use Text::CSV_XS;

my $sqldb;
my $sqlr;
my $sqldbd = '?';

openlog("mdfdbc","pid","mail");

my $verbose = 0;
sub logmsg {
	syslog(@_);
	print sprintf("%s %s\n",shift,sprintf(shift,@_)) if ($verbose);
}

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

my $vacuum = 0;
my $clean = 1;
my $backup = '';
my $restore = '';
my $noconfig = 0;
my $cleanl = '';
my @tables = ();

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($dc_keep $mx_keep $sc_keep $gdb_keep $gdb_keep_host $nsdb_keep $rdb_keep $sdb_keep $bnc_keep);
use vars qw($pgp_keep $ts_keep $msgl_keep $out_keep $smtp_keep $expn_keep $gsnd_keep $virus_keep $trap_keep);
use vars qw($abuse_keep);
add_cfg_cfg('dc_keep',\$dc_keep,5*60,'i');
add_cfg_cfg('mx_keep',\$mx_keep,30*24*60*60,'i');
add_cfg_cfg('sc_keep',\$sc_keep,30*24*60*60,'i');
add_cfg_cfg('gdb_keep',\$gdb_keep,60*24*60*60,'i');
add_cfg_cfg('gdb_keep_host',\$gdb_keep_host,60*24*60*60,'i');
add_cfg_cfg('gdb_keep_msg',\$msgl_keep,60*24*60*60,'i');
add_cfg_cfg('nsdb_keep',\$nsdb_keep,90*24*60*60,'i');
add_cfg_cfg('sdb_keep',\$sdb_keep,90*24*60*60,'i');
add_cfg_cfg('rdb_keep',\$rdb_keep,90*24*60*60,'i');
add_cfg_cfg('pgp_keep',\$pgp_keep,90*24*60*60,'i');
add_cfg_cfg('ts_keep',\$ts_keep,24*60*60,'i');
add_cfg_cfg('out_keep',\$out_keep,90*24*60*60,'i');
add_cfg_cfg('smtp_keep',\$smtp_keep,7*24*60*60,'i');
add_cfg_cfg('expn_keep',\$expn_keep,7*24*60*60,'i');
add_cfg_cfg('gsnd_keep',\$gsnd_keep,40*24*60*60,'i');
add_cfg_cfg('avc_keep',\$virus_keep,7*24*60*60,'i');
add_cfg_cfg('bnc_keep',\$bnc_keep,366*24*60*60,'i');
add_cfg_cfg('trap_keep',\$trap_keep,24*60*60,'i');
add_cfg_cfg('abuse_keep',\$trap_keep,366*24*60*60,'i');

use vars qw ($hilo_keep $hilo_entries $hilo_margin $logs_keep);
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');
add_cfg_cfg('logs_keep',\$logs_keep,14*24*60*60);

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

# 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 {
	foreach my $p (@ARGV) {
		$p =~ s/^-+//;
		if ($p =~ /^v(acuum)?$/i) {
			$vacuum = 1;
		} elsif ($p =~ /^no?[-_]?c(lean)?$/i) {
			$clean = 0;
		} elsif ($p =~ /^c(lean)?\s*[:=]\s*(.*?)\s*$/i) {
			$cleanl .= ",$2,";
		} elsif ($p =~ /^b(ackup)?\s*[:=]\s*(.*?)\s*$/i) {
			$backup = $2;
		} elsif ($p =~ /^r(estore)?\s*[:=]\s*(.*?)\s*$/i) {
			$restore = $2;
		} elsif ($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;
		} elsif ($p =~ /^v(erbose)?$/i) {
			$verbose = 1;
		} else {
			print "? $p\n";
		}
	}
}
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_logmsg('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'}));
	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.
#***********************************************************************

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

sub sql_command {
	$sqlr = undef;
	for (my $i=0;$i<@_;$i++) {
		my $cmd = @_[$i];
		return 0 unless ($sqldb && $cmd);
		if ($cmd =~ /^(CREATE|ALTER) TABLE/) {
			if ($sqldbd eq 'L') {
				$cmd =~ s/<INDEX>/INTEGER PRIMARY KEY AUTOINCREMENT/;
			}
			if ($sqldbd eq 'M') {
				$cmd =~ s/<TINT>/TINYINT/g;
				$cmd =~ s/<INT>/INTEGER/g;
				$cmd =~ s/<UINT>/INTEGER UNSIGNED/g;
				$cmd =~ s/<CHR>/CHAR/g;
				$cmd =~ s/<VCHR>/VARCHAR/g;
				$cmd =~ s/<INDEX>/SERIAL/;
			} else {
				$cmd =~ s/<[TU]?INT>/INTEGER/g;
				$cmd =~ s/<V?CHR>(\(\d+\))?/TEXT/g;
				$cmd =~ s/<(TINY|MEDIUM|LONG)(BLOB|TEXT)>/$2/g;
				$cmd =~ s/<INDEX>/INTEGER NOT NULL AUTOINCREMENT UNIQUE/;
			}
			$cmd =~ s/<([A-Z]+)>/$1/g;
		} elsif ($cmd =~ /^CREATE (UNIQUE )?INDEX/) {
			$cmd =~ s/\(\d+\)//g unless ($sqldbd eq 'M');
		} else {
			$cmd = sql_translate($cmd);
		}
		$sqlr = $sqldb->do($cmd);
		return 0 unless (defined($sqlr));
	}
	return 1;
}

sub sql_select_one_row {
	my $cmd = shift;
	return undef unless ($cmd);
	my $st = $sqldb->prepare(sql_translate($cmd));
	return undef unless ($st);
	$st->execute;
	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];
}

sub sql_create_tables {
	return unless ($sqldb);
	#logmsg('info','Checking tables');
	my @tl = $sqldb->tables();
	#foreach my $tt (@tl) {
	#	logmsg('info',"Table: $tt");
	#}
	push @tables, 'dictionary';
	unless (grep(/dictionary/,@tl)) {
		logmsg('info','Creating dictionary table');
		sql_command(
			'CREATE TABLE dictionary ('.
				'dc_stamp <UINT> NOT NULL DEFAULT 0, '.
				'dc_host <CHR>(15) NOT NULL)',
			'CREATE INDEX idx_dc_host ON dictionary (dc_host)',
			'CREATE INDEX idx_dc_stamp ON dictionary (dc_stamp)',
		);
	}
	push @tables, 'relaylist';
	unless (grep(/relaylist/,@tl)) {
		logmsg('info','Creating relaylist table');
		sql_command(
			'CREATE TABLE relaylist ('.
				'rl_host <VCHR>(255) PRIMARY KEY, '.
				'rl_stamp <UINT> NOT NULL DEFAULT 0, '.
				'rl_touch <UINT> NOT NULL DEFAULT 0, '.
				'rl_spam <UINT> NOT NULL DEFAULT 0, '.
				'rl_ham <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_rl_stamp ON relaylist (rl_stamp)',
		);
	}
	push @tables, 'hostlist';
	unless (grep(/hostlist/,@tl)) {
		logmsg('info','Creating hostlist table');
		sql_command(
			'CREATE TABLE hostlist ('.
				'hl_host <CHR>(15) PRIMARY KEY, '.
				'hl_stamp <UINT> NOT NULL DEFAULT 0, '.
				'hl_touch <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_hl_stamp ON hostlist (hl_stamp)',
		);
	}
	push @tables, 'sendercheck';
	unless (grep(/sendercheck/,@tl)) {
		logmsg('info','Creating sendercheck table');
		sql_command(
			'CREATE TABLE sendercheck ('.
				'sc_address <VCHR>(255) PRIMARY KEY, '.
				'sc_stamp <UINT> NOT NULL DEFAULT 0, '.
				'sc_count <UINT> NOT NULL DEFAULT 0, '.
				'sc_result <TINT> NOT NULL DEFAULT 0, '.
				'sc_text <VCHR>(255) NOT NULL DEFAULT \'\')',
			'CREATE INDEX idx_sc_stamp ON sendercheck (sc_stamp)',
		);
	}
	push @tables, 'greylist';
	unless (grep(/greylist/,@tl)) {
		logmsg('info','Creating greylist table');
		sql_command(
			'CREATE TABLE greylist ('.
				'gl_reset <UINT> NOT NULL DEFAULT 0, '.
				'gl_accepted <UINT> NOT NULL DEFAULT 0, '.
				'gl_host <CHR>(15) NOT NULL, '.
				'gl_sender <VCHR>(255) NOT NULL, '.
				'gl_recipient <VCHR>(255) NOT NULL)',
			'CREATE UNIQUE INDEX idx_gl_triplet ON greylist (gl_host,gl_sender,gl_recipient)',
			'CREATE INDEX idx_gl_resetaccept ON greylist (gl_reset,gl_accepted)',
		);
	}
	push @tables, 'mxcheck';
	unless (grep(/mxcheck/,@tl)) {
		logmsg('info','Creating mxcheck table');
		sql_command(
			'CREATE TABLE mxcheck ('.
				'mx_domain <VCHR>(255) PRIMARY KEY, '.
				'mx_stamp <UINT> NOT NULL DEFAULT 0, '.
				'mx_error <VCHR>(255) NOT NULL DEFAULT \'\')',
			'CREATE INDEX idx_mx_stamp ON mxcheck (mx_stamp)',
		);
	}
	push @tables, 'nospamlist';
	unless (grep(/nospamlist/,@tl)) {
		logmsg('info','Creating nospam table');
		sql_command(
			'CREATE TABLE nospamlist ('.
				'ns_host <VCHR>(255) PRIMARY KEY, '.
				'ns_stamp <UINT> NOT NULL DEFAULT 0, '.
				'ns_touch <UINT> NOT NULL DEFAULT 0, '.
				'ns_count <INT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_ns_stamp ON nospamlist (ns_stamp)',
		);
	}
	push @tables, 'pgpring';
	unless (grep(/pgpring/,@tl)) {
		logmsg('info','Creating pgp ring table');
		sql_command(
			'CREATE TABLE pgpring ('.
				'pgp_id <CHR>(40) PRIMARY KEY, '.
				'pgp_stamp <UINT> NOT NULL DEFAULT 0, '.
				'pgp_note <VCHR>(255), '.
				'pgp_key <TEXT>, '.
				'pgp_mail <TEXT>, '.
				'pgp_person <TEXT>)',
			'CREATE INDEX idx_pgp_stamp ON pgpring (pgp_stamp)',
		);
	}
	push @tables, 'times';
	unless (grep(/times/,@tl)) {
		logmsg('info','Creating time stamp table');
		sql_command(
			'CREATE TABLE times ('.
				'ts_id <CHR>(14) PRIMARY KEY, '.
				'ts_stamp <UINT> NOT NULL DEFAULT 0, '.
				'ts_end <UINT> NOT NULL DEFAULT 0, '.
				'ts_time <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_ts_stamp ON times (ts_stamp)',
		);
	}
	push @tables, 'messages';
	unless (grep(/messages/,@tl)) {
		logmsg('info','Creating messages table');
		sql_command(
			'CREATE TABLE messages ('.
				'msg_id <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'msg_sender <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'msg_recipient <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'msg_stamp <UINT> NOT NULL DEFAULT 0, '.
				'msg_count <UINT> NOT NULL DEFAULT 0, '.
				'msg_spam <UINT> NOT NULL DEFAULT 0)',
			'CREATE UNIQUE INDEX idx_msg_triplet ON messages (msg_id,msg_sender,msg_recipient)',
			'CREATE INDEX idx_msg_stamp ON messages (msg_stamp)',
		);
	}
	push @tables, 'sentout';
	unless (grep(/sentout/,@tl)) {
		logmsg('info','Creating sent out table');
		sql_command(
			'CREATE TABLE sentout ('.
				'out_id <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'out_sender <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'out_rcpt_usr <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'out_rcpt_dom <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'out_subject <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'out_stamp <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_out_id_recipient_sender ON sentout (out_id(40),out_rcpt_dom(15),out_sender(20))',
			'CREATE INDEX idx_out_sender_recipient_subject ON sentout (out_sender(20),out_rcpt_dom(15),out_rcpt_usr(15),out_subject(20))',
			'CREATE INDEX idx_out_stamp ON sentout (out_stamp)',
		);
	}
	push @tables, 'smtpcheck';
	unless (grep(/smtpcheck/,@tl)) {
		logmsg('info','Creating smtp check table');
		sql_command(
			'CREATE TABLE smtpcheck ('.
				'smtp_from <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'smtp_to <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'smtp_host <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'smtp_stamp <UINT> NOT NULL DEFAULT 0,'.
				'smtp_result <CHR>(8) NOT NULL DEFAULT \'\', '.
				'smtp_text <VCHR>(255) NOT NULL DEFAULT \'\')',
			'CREATE UNIQUE INDEX idx_smtp_triplet ON smtpcheck (smtp_from,smtp_to,smtp_host)',
			'CREATE INDEX idx_smtp_stamp ON smtpcheck (smtp_stamp)',
		);
	}
	push @tables, 'expncheck';
	unless (grep(/expncheck/,@tl)) {
		logmsg('info','Creating expn check table');
		sql_command(
			'CREATE TABLE expncheck ('.
				'expn_address <VCHR>(255) PRIMARY KEY, '.
				'expn_newaddress <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'expn_stamp <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_expn_stamp ON expncheck (expn_stamp)',
		);
	}
	push @tables, 'hiloscores';
	unless (grep(/hiloscores/,@tl)) {
		logmsg('info','Creating high/low scores table');
		sql_command(
			'CREATE TABLE hiloscores ('.
				'hilo_id <INDEX>,'.
				'hilo_stamp <UINT> NOT NULL DEFAULT 0,'.
				'hilo_score <REAL> NOT NULL DEFAULT 0.0,'.
				'hilo_spam <TINT> NOT NULL DEFAULT 0,'.
				'hilo_names <TEXT> NOT NULL,'.
				'hilo_report <TEXT> NOT NULL,'.
				'hilo_info <TEXT> NOT NULL,'.
				'hilo_message <MEDIUMTEXT> NOT NULL)',
			'CREATE INDEX idx_hilo_score ON hiloscores (hilo_score)',
			'CREATE INDEX idx_hilo_stamp ON hiloscores (hilo_stamp)',
		);
	}
	push @tables, 'generatedsenders';
	unless (grep(/generatedsenders/,@tl)) {
		logmsg('info','Creating generated senders table');
		sql_command(
			'CREATE TABLE generatedsenders ('.
				'gsnd_address <VCHR>(255) PRIMARY KEY,'.
				'gsnd_stamp <UINT> NOT NULL DEFAULT 0)',
				'gsnd_rcpts <UINT> NOT NULL DEFAULT 0)',
				'gsnd_bounces <UINT> NOT NULL DEFAULT 0)',
			'CREATE INDEX idx_gsnd_stamp ON generatedsenders (gsnd_stamp)',
		);
	}
	push @tables, 'virusresults';
	unless (grep(/virusresults/,@tl)) {
		logmsg('info','Creating virus cache table');
		sql_command(
			'CREATE TABLE virusresults ('.
				'vir_hash <VCHR>(255) NOT NULL, '.
				'vir_local <TINT> NOT NULL, '.
				'vir_entity <TINT> NOT NULL, '.
				'vir_scanners <UINT> NOT NULL DEFAULT 0, '.
				'vir_stamp <UINT> NOT NULL DEFAULT 0, '.
				'vir_code <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'vir_category <VCHR>(20) NOT NULL DEFAULT \'\', '.
				'vir_action <VCHR>(15) NOT NULL DEFAULT \'\', '.
				'vir_name <VCHR>(255) NOT NULL DEFAULT \'\')',
			'CREATE UNIQUE INDEX idx_vir_quad ON virusresults (vir_hash,vir_local,vir_entity,vir_scanners)',
			'CREATE INDEX idx_vir_stamp ON virusresults (vir_stamp)',
		);
	}
	push @tables, 'spamresults';
	unless (grep(/spamresults/,@tl)) {
		logmsg('info','Creating spam cache table');
		sql_command(
			'CREATE TABLE spamresults ('.
				'spam_hash <VCHR>(255) NOT NULL, '.
				'spam_sender <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'spam_recipients <VCHR>(255) NOT NULL DEFAULT \'\', '.
				'spam_stamp <UINT> NOT NULL DEFAULT 0, '.
				'spam_count <INT> NOT NULL DEFAULT 0, '.
				'spam_id <CHR>(14) NOT NULL DEFAULT \'\', '.
				'spam_score <INT> NOT NULL DEFAULT 0, '.
				'spam_required <INT> NOT NULL DEFAULT 0)',
			'CREATE UNIQUE INDEX idx_spam ON spamresults (spam_hash,spam_sender,spam_recipients)',
			'CREATE INDEX idx_spam_stamp ON spamresults (spam_stamp)',
		);
	}
	push @tables, 'bouncing';
	unless (grep(/bouncing/,@tl)) {
		logmsg('info','Creating bounce collection table');
		sql_command(
			'CREATE TABLE bouncing ('.
				'bnc_address <VCHR>(255) PRIMARY KEY, '.
				'bnc_stamp <UINT> NOT NULL DEFAULT 0, '.
				'bnc_severity <INT> NOT NULL DEFAULT -1, '.
				'bnc_count <UINT> NOT NULL DEFAULT 0, '.
				'bnc_problem <VCHR>(20), '.
				'bnc_reason <VCHR>(255))',
			'CREATE INDEX idx_bnc_stamp ON bouncing (bnc_stamp)',
		);
	}
	push @tables, 'trapper';
	unless (grep(/trapper/,@tl)) {
		logmsg('info','Creating trapper table');
		sql_command(
			'CREATE TABLE trapper ('.
				'trap_stamp <UINT> NOT NULL DEFAULT 0, '.
				'trap_host <CHR>(15) NOT NULL)',
			'CREATE INDEX idx_trap_stamp ON trapper (trap_stamp)',
		);
	}
	push @tables, 'abuse';
	unless (grep(/abuse/,@tl)) {
		logmsg('info','Creating abuse table');
		sql_command(
			'CREATE TABLE abuse ('.
				'abuse_stamp <UINT> NOT NULL DEFAULT 0, '.
				'abuse_from <VCHR>(255), '.
				'abuse_addr <VCHR>(255))',
			'CREATE INDEX idx_abuse_stamp ON abuse (abuse_stamp)',
			'CREATE UNIQUE INDEX idx_abuse_from ON abuse (abuse_from,abuse_addr)',
		);
	}
	push @tables, 'logs';
	unless (grep(/logs/,@tl)) {
		logmsg('info','Creating logs table');
		sql_command(
			'CREATE TABLE logs ('.
				'logs_id <INDEX>,'.
				'logs_stamp <UINT> NOT NULL DEFAULT 0,'.
				'logs_type <CHR>(15) NOT NULL,'.
				'logs_cont <CHR>(15) NOT NULL DEFAULT \'\','.
				'logs_mqid <CHR>(14) NOT NULL DEFAULT \'\','.
				'logs_line <TEXT> NOT NULL)',
			'CREATE INDEX idx_logs_type_cont ON logs (logs_type,logs_cont)',
			'CREATE INDEX idx_logs_stamp ON logs (logs_stamp)',
		);
	}
	my %ci;
	foreach my $tn (@tables) {
		my $st = $sqldb->column_info(undef,undef,$tn,'%');
		next unless ($st);
		while (my @cir = $st->fetchrow_array) {
			$ci{$cir[2]}{$cir[3]} = {dt=>$cir[4],tn=>$cir[5],sz=>$cir[6]};
		}
		$st->finish;
	}
	unless ($ci{messages}{msg_spam}) {
		logmsg('info','Updating messages table');
		sql_command('ALTER TABLE messages ADD COLUMN msg_spam <UINT> NOT NULL DEFAULT 0');
	}
	unless ($ci{virusresults}{vir_name}) {
		logmsg('info','Updating virus cache table');
		sql_command('ALTER TABLE virusresults ADD COLUMN vir_name <VCHR>(255) NOT NULL DEFAULT \'\'');
	}
}


#***********************************************************************
# Backup/restore.
#***********************************************************************

sub db_backup {
	my ($fn) = @_;
	if (my $fh = new IO::File(">$fn")) {
		my $ssv = Text::CSV_XS->new({sep_char=>';',quote_char=>'"',binary=>1});
		my $tc = 0;
		foreach my $table (@tables) {
			if ($sqldbd eq 'L') {
				$table =~ s/^\"(.*)\"$/$1/;
				next if ($table =~ /^sqlite_/);
			} elsif ($sqldbd eq 'M') {
				$table =~ s/^\`(.*)\`$/$1/;
			}
			my $st = $sqldb->prepare("SELECT * FROM $table");
			next unless ($st);
			my $c = 0;
			logmsg('info','Backing up %s',$table);
			$ssv->print($fh,['=',$table]);
			$fh->print("\n");
			$st->execute;
			while (my @res = $st->fetchrow_array) {
				next unless (@res);
				unshift @res, '+';
				$ssv->print($fh,\@res);
				$fh->print("\n");
				$c ++;
			}
			$st->finish;
			logmsg('info','Backed up %s = %u',$table,$c);
			$tc += $c;
		}
		$fh->close();
		logmsg('info','Backed up %u',$tc);
	}
}

sub make_statement {
	my ($table,$ref) = @_;
	my @q = ();
	for (my $i=0;$i<@$ref;$i++) { push @q, '?'; }
	my $sts;
	return sql_translate(sprintf('INSERT OR IGNORE INTO %s VALUES (%s)',$table,join(',',@q)));
}
sub db_restore {
	my ($fn) = @_;
	if (my $fh = new IO::File("<$fn")) {
		my $ssv = Text::CSV_XS->new({sep_char=>';',quote_char=>'"',binary=>1});
		my $table = '';
		my $tc = 0;
		my $cc = 0;
		my $st = undef;
		my $sts = '';
		while (!$fh->eof && (my $ref = $ssv->getline($fh))) {
			next unless (@$ref);
			if ($ref->[0] eq '=') {
				logmsg('info','Restored %s = %u',$table,$cc) if ($table);
				$sts = '';
				$table = $ref->[1];
				logmsg('info','Restoring %s',$table) if ($table);
			} elsif ($table && $ref->[0] eq '+') {
				shift @$ref;
				my $x = make_statement($table,$ref);
				if ($sts ne $x) {
					$st->finish if ($st);
					$sts = $x;
					$st = $sqldb->prepare($sts);
					unless ($st) {
						print STDERR "Error preparing statement: $sts\n";
						logmsg('err','Error preparing statement: %s',$sts);
						last;
					}
				}
				unless ($st->execute(@$ref)) {
					print STDERR "Error executing statement: $sts\n";
					logmsg('err','Error executing statement: %s',$sts);
					last;
				}
				$cc ++;
				$tc ++;
			}
		}
		logmsg('info','Restored %s = %u',$table,$cc) if ($table);
		$st->finish if ($st);
		$fh->close();
		logmsg('info','Restored %u',$tc);
	}
}


#***********************************************************************
# Cleaners.
#***********************************************************************

# Clean dictionary list for all hosts
sub dc_clean_list {
	my $t = time() - $dc_keep;
	logmsg('info','%u dc rec(s) removed',$sqlr) if ((sql_command("DELETE FROM dictionary WHERE (dc_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean relay list for all hosts
sub rdb_clean_list {
	my $t = time() - $rdb_keep;
	logmsg('info','%u rdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM relaylist WHERE (rl_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean greylist for all hosts
sub gdb_clean_list {
	my $t = time() - $msgl_keep;
	logmsg('info','%u msgdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM messages WHERE (msg_stamp < $t)") && $sqlr>0) || $verbose);
	$t = time() - $gdb_keep_host;
	logmsg('info','%u ghdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM hostlist WHERE (hl_stamp < $t)") && $sqlr>0) || $verbose);
	$t = time() - $gdb_keep;
	logmsg('info','%u gdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM greylist WHERE (gl_reset < $t AND gl_accepted < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean sender check cache
sub sc_clean_list {
	my $t = time() - $sc_keep;
	logmsg('info','%u sc rec(s) removed',$sqlr) if ((sql_command("DELETE FROM sendercheck WHERE (sc_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean MX check cache
sub mx_clean_list {
	my $t = time() - $sc_keep;
	logmsg('info','%u mx rec(s) removed',$sqlr) if ((sql_command("DELETE FROM mxcheck WHERE (mx_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean nospam list for all hosts
sub nsdb_clean_list {
	my $t = time() - $nsdb_keep;
	logmsg('info','%u nsdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM nospamlist WHERE (ns_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean pgp ring list
sub pgpdb_clean_list {
	my $t = time() - $pgp_keep;
	logmsg('info','%u pgpdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM pgpring WHERE (pgp_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean time stamp list
sub tsdb_clean_list {
	my $t = time() - $ts_keep;
	logmsg('info','%u tsdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM times WHERE (ts_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean sent out list
sub outdb_clean_list {
	my $t = time() - $out_keep;
	logmsg('info','%u outdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM sentout WHERE (out_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean smtp check list
sub smtpdb_clean_list {
	my $t = time() - $smtp_keep;
	logmsg('info','%u smtpdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM smtpcheck WHERE (smtp_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean expn check list
sub expndb_clean_list {
	my $t = time() - $expn_keep;
	logmsg('info','%u expndb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM expncheck WHERE (expn_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean high/low scores
sub hilodb_clean_list {
	my $km = $hilo_entries+$hilo_margin;
	my $rc = 0;
	$rc += $sqlr if (sql_command("DELETE FROM hiloscores WHERE (hilo_names='GTUBE') OR (hilo_names LIKE 'GTUBE,%') OR (hilo_names LIKE '%,GTUBE') OR (hilo_names LIKE '%,GTUBE,%')"));
	if ($hilo_keep && $hilo_keep>0) {
		my $old = time()-$hilo_keep;
		my $new = $km+1;
		$new = sql_select_one("SELECT count(hilo_score) FROM hiloscores WHERE hilo_stamp>$old") if ($hilo_entries && $hilo_entries>0);
		if ($new > $km) {
			$rc += $sqlr if (($new>$km) && sql_command("DELETE FROM hiloscores WHERE (hilo_stamp<$old)"));
			#logmsg('info',"<$new> DELETE FROM hiloscores WHERE (hilo_stamp<$old)");
		}
	}
	unless ($hilo_entries && $hilo_entries<0) {
		my $min = sql_select_one("SELECT max(hilo_score) FROM (SELECT hilo_score FROM hiloscores ORDER BY hilo_score ASC LIMIT $km) AS hilo_score_set");
		my $max = sql_select_one("SELECT min(hilo_score) FROM (SELECT hilo_score FROM hiloscores ORDER BY hilo_score DESC LIMIT $km) AS hilo_score_set");
		if (defined($min) && defined($max) && $max>$min) {
			$rc += $sqlr if (sql_command("DELETE FROM hiloscores WHERE (hilo_score<$max && hilo_score>$min)"));
			#logmsg('info',"DELETE FROM hiloscores WHERE (hilo_score<$max && hilo_score>$min)");
		}
	}
	logmsg('info','%u hilodb rec(s) removed',$rc) if ($rc>0 || $verbose);
	return 1;
}

# Clean expn check list
sub gsnddb_clean_list {
	my $t = time() - $gsnd_keep;
	logmsg('info','%u gsnddb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM generatedsenders WHERE (gsnd_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean virus cache list
sub virus_clean_list {
	my $t = time() - $virus_keep;
	logmsg('info','%u avcdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM virusresults WHERE (vir_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean spam cache list
sub spam_clean_list {
	my $t = time() - $sdb_keep;
	logmsg('info','%u sdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM spamresults WHERE (spam_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean bounce collection
sub bnc_clean_list {
	my $t = time() - $bnc_keep;
	logmsg('info','%u bncdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM bouncing WHERE (bnc_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean trapper list
sub trap_clean_list {
	my $t = time() - $trap_keep;
	logmsg('info','%u trap rec(s) removed',$sqlr) if ((sql_command("DELETE FROM trapper WHERE (trap_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean abuse contact list
sub abuse_clean_list {
	my $t = time() - $abuse_keep;
	logmsg('info','%u abuse rec(s) removed',$sqlr) if ((sql_command("DELETE FROM abuse WHERE (abuse_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Clean bounce collection
sub logs_clean_list {
	my $t = time() - $logs_keep;
	logmsg('info','%u logdb rec(s) removed',$sqlr) if ((sql_command("DELETE FROM logs WHERE (logs_stamp < $t)") && $sqlr>0) || $verbose);
	return 1;
}

# Defrag, remove emptyness, etc...
sub db_vacuum {
	if ($sqldbd eq 'L') {
		logmsg('info','database vacuumed') if (sql_command('VACUUM'));
	} elsif ($sqldbd eq 'M') {
		logmsg('info','database vacuumed') if (sql_command('OPTIMIZE TABLE '.join(',',@tables)));
	} else {
		logmsg('info','cannot vacuum this database');
	}
}

#***********************************************************************
# Main.
#***********************************************************************

read_cfg_cfg();
logmsg('info','MIMEDefang-filter Database Cleaner/Creator');
$sqldb = DBI->connect($database_spec,$database_user,$database_pass,{RaiseError=>0,AutoCommit=>1});
if ($sqldb) {
	sql_create_tables();
	sql_command('PRAGMA SYNCHRONOUS=OFF') if ($sqldbd eq 'L');
	if ($clean) {
		dc_clean_list()		if ($cleanl eq '' || $cleanl =~ /,d(c|ict)?(db)?,/i);
		rdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,r(elay)?(db)?,/i);
		gdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,(g|grey)?h(ost)?(db)?,/i);
		sc_clean_list()		if ($cleanl eq '' || $cleanl =~ /,s(ender)?c(heck)?(db)?,/i);
		mx_clean_list()		if ($cleanl eq '' || $cleanl =~ /,mx(db)?,/i);
		nsdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,no?s(pam)?(db)?,/i);
		outdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,(s|sent)?o(ut)?(db)?,/i);
		pgpdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,pgp(db)?,/i);
		tsdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,t(ime)?s(tamps?)?(db)?,/i);
		smtpdb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,s(mtp)?(db)?,/i);
		expndb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,e(xpn)?(db)?,/i);
		hilodb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,h(i|igh)?l(o|ow)?(s|score)?(db)?,/i);
		gsnddb_clean_list()	if ($cleanl eq '' || $cleanl =~ /,g(en(erated)?)?se?nd(ers?)?(db)?,/i);
		virus_clean_list()	if ($cleanl eq '' || $cleanl =~ /,a(nti)?v(ir(us)?)?c(ache)?(db)?,/i);
		spam_clean_list()	if ($cleanl eq '' || $cleanl =~ /,s(pam)?(db)?,/i);
		bnc_clean_list()	if ($cleanl eq '' || $cleanl =~ /,b((ou)?nce?)?(db)?,/i);
		trap_clean_list()	if ($cleanl eq '' || $cleanl =~ /,tra?p?(db)?,/i);
		abuse_clean_list()	if ($cleanl eq '' || $cleanl =~ /,a(use)?c(ontact)?(db)?,/i);
		logs_clean_list()	if ($cleanl eq '' || $cleanl =~ /,l(ogs?)?(db)?,/i);
	}
	db_vacuum() if ($vacuum);
	db_restore($restore) if ($restore);
	db_backup($backup) if ($backup);
	$sqldb->disconnect();
	$sqldb = undef;
}