#!/usr/bin/perl -w

use strict;

##############################################################################

package OdoHash;
use vars qw(@ISA);
use Tie::Hash;
@ISA = qw(Tie::StdHash);
sub EXISTS { 1; }
sub FETCH {
	$_[0]->SUPER::EXISTS($_[1]) ? $_[0]->SUPER::FETCH($_[1]) : 0
}

##############################################################################

package main;
use IPC::Open2;

sub usage {
	die "usage: $0 incomplete_file complete_file\n";
}

my $incomplete_file = shift or usage;
my $complete_file = shift or usage;

# use external sort to extract the incomplete sessions
# since sort reads all of its input before producing any output
# there is no chance of deadlock.
my $sort_pid = open2(\*SORTOUT, \*SORTIN, "sort -k 1,1n -k 2,2n");

# first step is to process the input and decide which sessions
# are incomplete.
my $n_sessions = 0;
my %pid_to_session;
while (<>) {
	chomp;
	# Jul 13 00:23:08 twinlark : 1089703388.528303 tcpserver: ok 27771 0:168.75.98.6:25 :66.123.202.224::20397

	# hack hack... sendmail-bs doesn't provide all the session info we need!
	next if /twinlark sendmail-bs:/;

	# strip syslog stuff
	s#^[A-Za-z]{3} [\d ]\d \d\d:\d\d:\d\d \S+ \S*: ##;

	my $pid;
	my $end_now;

	if (($pid) = m#^[\d.]+ tcpserver: ok (\d+)#) {
		if (defined($pid_to_session{$pid})) {
			warn "pid reused: $_\n";
		}
		$pid_to_session{$pid} = $n_sessions;
		++$n_sessions;
	}
	elsif (($pid) = m#^[\d.]+ tcpserver: end (\d+)#) {
		$end_now = 1;
	}
	elsif (($pid) = m#^[\d.]+ (?:rblsmtpd|qmail-smtpd): pid (\d+)#) {
		;
	}
	if (defined($pid) && defined($pid_to_session{$pid})) {
		print SORTIN "$pid_to_session{$pid} $_\n";
		if ($end_now) {
			delete $pid_to_session{$pid};
		}
	}
	elsif (defined($pid)) {
		warn "no session: $_\n";
	}
}
close(SORTIN);

my %incomplete_session = map { $_ => 1 } values %pid_to_session;
open(INCOMPLETE, "> $incomplete_file") or die "unable to open $incomplete_file for writing: $!\n";
open(COMPLETE, "> $complete_file") or die "unable to open $complete_file for writing: $!\n";

my %message_tokens = (
	"qp"		=> 'accepted',
	"rset"		=> 'rset',
	"signature"	=> 'signature rejection',
);
my %rt_tokens = (
	"addrrelay"	=> '!%@ relay attempt',
	"badrcptto"	=> 'listed in badrcptto',
	"okrcptto"	=> 'acceptable',
	"realrcptto"	=> 'no such address',
);

my $n_sess = 0;
tie my %rbl, 'OdoHash';
tie my %smtpd, 'OdoHash';
tie my %tls, 'OdoHash';
tie my %auth, 'OdoHash';
my $n_tls_auth = 0;
my $n_messages = 0;
my $sess_tls;		# does cur session use tls?
my $msg_okrt = 0;	# how many okrt this message?
my $msg_badrt = 0;	# how many badrt this message?
my $n_ok_and_badrt = 0; # how many messages with both ok and bad rt?
my $sess_qp = 0;	# how many messages accepted this session?
my $n_waiting_for_DATA = 0;
my $n_abort_with_okrt = 0;
my $n_rset_with_okrt = 0;
tie my %okrt_rset_dist, 'OdoHash';
tie my %okrt_dist, 'OdoHash';
tie my %qp_dist, 'OdoHash';
tie my %okmf, 'OdoHash';
tie my %okrt, 'OdoHash';
my $sess_start;
tie my %sess_len_dist, 'OdoHash';
my $log_base = 1 - log(2);
while (<SORTOUT>) {
	chomp;
	my ($sess,$rest) = m#^(\d+) (.*)$#;
	if (defined($incomplete_session{$sess})) {
		print INCOMPLETE "$rest\n";
		next;
	}
	print COMPLETE "$rest\n";
	my ($stamp, $msg) = $rest =~ m#^([\d.]+) (.*)#;
	if ($msg =~ m#^tcpserver: ok#) {
		$msg_okrt = 0;
		$msg_badrt = 0;
		$sess_qp = 0;
		undef $sess_tls;
		++$n_sess;
		$sess_start = $stamp;
	}
	elsif ($msg =~ m#^tcpserver: end#) {
		if ($sess_qp) {
			++$qp_dist{$sess_qp};
		}
		if ($msg_okrt > 0) {
			++$n_abort_with_okrt;
			++$okrt_rset_dist{$msg_okrt};
		}
		if ($stamp > $sess_start) {
			my $bin = sprintf("%.0f", log($stamp - $sess_start)/$log_base);
			$bin =~ s#^-0$#0#;
			++$sess_len_dist{$bin};
		}

	}
	elsif ($msg =~ m#^rblsmtpd: pid \d+ \d+ [\d.]+ rejected by (\S+):#) {
		++$rbl{$1};
	}
	elsif ($msg =~ m#rblsmtpd:#) {
		++$rbl{"/etc/tcp.smtp"};
	}
	elsif ($msg =~ m#^qmail-smtpd: pid \d+ tls (\S+)#) {
		++$tls{$1};
		$sess_tls = 1;
	}
	elsif ($msg =~ m#^qmail-smtpd: pid \d+ auth (\S+)#) {
		my $u = $1;
		$u .= " tls" if defined($sess_tls);
		++$n_tls_auth if defined($sess_tls);
		++$auth{$u};
	}
	elsif ($msg =~ m#^qmail-smtpd: pid \d+ mfcheck \S* (soft|hard)#) {
		++$smtpd{"mfcheck $1"};
	}
	elsif ($msg =~ m#^qmail-smtpd: pid \d+ (\S+)( \S*)?#) {
		++$smtpd{$1};
		if ($1 eq 'okrcptto') {
			if ($msg_okrt == 0) {
				++$n_waiting_for_DATA;
			}
			++$msg_okrt;
			++$okrt{$2};
		}
		if ($1 eq 'okmf') {
			++$okmf{$2};
		}
		if ($msg_okrt > 0 and $1 eq 'rset') {
			++$n_rset_with_okrt;
			++$okrt_rset_dist{$msg_okrt};
		}
		if ($1 eq 'qp') {
			++$okrt_dist{$msg_okrt};
			++$sess_qp;
		}
		++$msg_badrt if (defined($rt_tokens{$1}) and $1 ne "okrcptto");
		if (defined($message_tokens{$1})) {
			++$n_ok_and_badrt if ($msg_okrt and $msg_badrt);
			$msg_okrt = 0;
			$msg_badrt = 0;
		}
	}
}

sub sum {
	my $t = 0;
	foreach (@_) {
		$t += $_;
	}
	$t;
}

print "\nsessions:\n";
printf "  %-30s %10u\n", "total", $n_sess;
my $n_rbl = sum(values %rbl);
printf "  %-30s %10u %5.1f%%\n", "rejected by RBL", $n_rbl, 100.0 * $n_rbl / $n_sess;
my $n_tls = sum(values %tls);
printf "  %-30s %10u %5.1f%%\n", "using TLS", $n_tls, 100.0 * $n_tls / $n_sess;
my $n_auth = sum(values %auth);
printf "  %-30s %10u %5.1f%%\n", "using AUTH", $n_auth, 100.0 * $n_auth / $n_sess;
printf "  %-30s %10u %5.1f%%\n", "using TLS and AUTH", $n_tls_auth, 100.0 * $n_tls_auth / $n_sess;

# MAIL FROM
my %mf_tokens = (
	"badmailfrom"	=> 'listed in badmailfrom',
	"mfcheck soft"	=> 'dns soft failure',
	"mfcheck hard"	=> 'dns hard failure',
	"mfnodomain"	=> 'address without domain',
	"okmf"		=> 'acceptable',
	"realmf"	=> 'local domain, no such user',
);
my $n_mf = sum(map($smtpd{$_}, grep(defined($smtpd{$_}), keys %mf_tokens)));
if ($n_mf > 0) {
	print "\nMAIL FROM:\n";
	printf "  %-30s %10u\n", "total", $n_mf;
	foreach (sort { $mf_tokens{$a} cmp $mf_tokens {$b} } keys %mf_tokens) {
		next unless defined($smtpd{$_});
		printf "  %-30s %10u %5.1f%%\n", $mf_tokens{$_}, $smtpd{$_}, 100.0 * $smtpd{$_} / $n_mf;
	}
}

# RCPT TO
my $n_rt = sum(map($smtpd{$_}, grep(defined($smtpd{$_}), keys %rt_tokens)));
if ($n_rt > 0) {
	print "\nRCPT TO:\n";
	printf "  %-30s %10u\n", "total", $n_rt;
	foreach (sort { $rt_tokens{$a} cmp $rt_tokens {$b} } keys %rt_tokens) {
		next unless defined($smtpd{$_});
		printf "  %-30s %10u %5.1f%%\n", $rt_tokens{$_}, $smtpd{$_}, 100.0 * $smtpd{$_} / $n_rt;
	}
}

# DATA
if ($n_waiting_for_DATA > 0) {
	print "\nwaiting for DATA:\n";
	printf "  %-30s %10u\n", "total", $n_waiting_for_DATA;
	printf "  %-30s %10u %5.1f%%\n", "TCP abort", $n_abort_with_okrt, 100.0 * $n_abort_with_okrt / $n_waiting_for_DATA;
	printf "  %-30s %10u %5.1f%%\n", "RSET", $n_rset_with_okrt, 100.0 * $n_rset_with_okrt / $n_waiting_for_DATA;
	printf "  %-30s %10u %5.1f%%\n", "matched virus sig", $smtpd{"signature"},
		100.0 * $smtpd{"signature"} / $n_waiting_for_DATA;
	printf "  %-30s %10u %5.1f%%\n", "message accepted", $smtpd{"qp"}, 100.0 * $smtpd{"qp"} / $n_waiting_for_DATA;
}

printf "\n%-32s %10u\n", "messages with ok and badrt:", $n_ok_and_badrt;

print "\nrbl statistics:\n";
foreach (sort { $rbl{$b} <=> $rbl{$a} } keys %rbl) {
	printf "  %-30s %10u %5.1f%%\n", $_, $rbl{$_}, 100.0*$rbl{$_}/$n_rbl;
}

print "\nsmtpd:\n";
foreach (sort { $smtpd{$b} <=> $smtpd{$a} } keys %smtpd) {
	printf "%8u %s\n", $smtpd{$_}, $_;
}
print "\ntls:\n";
foreach (sort { $tls{$b} <=> $tls{$a} } keys %tls) {
	printf "%8u %s\n", $tls{$_}, $_;
}
print "\nauth:\n";
foreach (sort { $auth{$b} <=> $auth{$a} } keys %auth) {
	printf "%8u %s\n", $auth{$_}, $_;
}
print "\nokrt per message distribution:\n";
foreach (sort { $a <=> $b } keys %okrt_dist) {
	printf "%8u %8u\n", $_, $okrt_dist{$_};
}
print "\nokrt per RSET/TCP abort distribution:\n";
foreach (sort { $a <=> $b } keys %okrt_rset_dist) {
	printf "%8u %8u\n", $_, $okrt_rset_dist{$_};
}
print "\nqp per session distribution:\n";
foreach (sort { $a <=> $b } keys %qp_dist) {
	printf "%8u %8u\n", $_, $qp_dist{$_};
}

sub addr_stats {
	my ($name,$h) = @_;
	print "\ntop 20 $name:\n";
	foreach ((sort { $$h{$b} <=> $$h{$a} } keys %$h)[0..19]) {
		last unless defined($_);
		printf "%8u %s\n", $$h{$_}, $_;
	}
	tie my %d, 'OdoHash';
	foreach (keys %$h) {
		if (my ($dom) = m#@(.*)$#) {
			$d{$dom} += $$h{$_};
		}
	}
	print "\ntop 20 $name domains:\n";
	foreach ((sort { $d{$b} <=> $d{$a} } keys %d)[0..19]) {
		last unless defined($_);
		printf "%8u %s\n", $d{$_}, $_;
	}
}

addr_stats("okrt",\%okrt);
addr_stats("okmf",\%okmf);

print "\nsession length distribution:\n";
foreach (sort { $a <=> $b } keys %sess_len_dist) {
	printf "%8.3f ..%8.3f %8u\n", exp(($_-0.5)*$log_base), exp(($_+0.5)*$log_base), $sess_len_dist{$_};
}