#!/usr/bin/perl -w
#
# qlanalyze
# jms1 2005-07-07
#
# quick and dirty qmail log analyzer (with nice output thrown in)
#
# cat /var/log/qmail.* /var/log/smtp* | qlanalyze
#
# 2008-04-22 jms1 - changed rblsmtpd reject count to include 451 in addition
#   to 553. thanks to niamh holding for catching this.
#
###############################################################################
#
# Copyright (C) 2005,2007,2008 John Simpson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 2, as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# or visit http://www.gnu.org/licenses/gpl.txt
#
###############################################################################

require 5.003 ;
use strict ;

# SMTP accumulators

my ( 	%con   , %con_d , %con_a ,		# tcpserver: conn, deny, allow
	%rdns  , %rbl_d , %rbl_a ,		# rblsmtpd: revdns, deny, allow
		 %jgr_f , %jgr_s ) ;		# jgreylist: (revdns) 1st, 2nd+

my (	$t_con   , $t_con_d , $t_con_a ,	# totals
	$t_rdns  , $t_rbl_d , $t_rbl_a ,
		   $t_jgr_f , $t_jgr_s ) ;

# qmail-send accumulators

my (	%del    , %delt_l , %delt_r ,		# total, local, remote
	%dels_s , %dels_d , %dels_f ) ;		# success, deferral, failure

my (	$t_del    , $t_delt_l , $t_delt_r ,	# totals
	$t_dels_s , $t_dels_d , $t_dels_f ) ;

# other stuff

my ( %dates , %acc , $t_acc , $pline , $sline , $last_recordio ) ;

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

sub center($$)
{
	my $width = shift ;
	my $string = shift ;

	my $l = length ( $string ) ;
	return $string if ( $l >= $width ) ;

	my $pad = int ( ( $width - $l ) / 2 ) ;

	return ( " " x $pad . $string ) ;
}

sub comma($)
{
	my $x = reverse $_[0] ;
	$x =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g ;
	return scalar reverse $x ;
}

sub cwidth($)
{
	my $l = length($_[0]) ;
	return ( ( $l > 6 ) ? $l : 6 ) ;
}

sub ccwidth($)
{
	return cwidth ( comma ( $_[0] ) ) ;
}

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

$pline = "" ;
$last_recordio = 0 ;

while ( my $line = <> )
{
	chomp $line ;
	$sline = $line ;

	my $date = "" ;
	if ( $line =~ s/^\@40000000([0-9a-f]{8})[0-9a-f]{8} // )
	{
		# not exact, but a few seconds isn't going to make
		# much difference for a simple report like this

		my @d = localtime ( hex $1 ) ;
		$date = sprintf ( "%04d-%02d-%02d" ,
			$d[5]+1900 , $d[4]+1 , $d[3] ) ;
	}
	elsif ( $line =~ s/^(\d\d\d\d\-\d\d\-\d\d) [\d\:\.]+ // )
	{
		$date = $1 ;
	}
	elsif ( $last_recordio )
	{
		next ;
	}
	else
	{
		die ( "Cannot decode date on this line\n$sline\n"
			. "Previous line was...\n$pline\n" ) ;
	}

	$dates{$date} ++ ;

	########################################
	# qmail-smtpd: incoming stuff

	if ( $line =~ /^(tcp|ssl)server: / )
	{
		if ( $line =~ /\: pid / )
		{
			$con{$date} ++ ;
		}
		elsif ( $line =~ /\: deny / )
		{
			$con_d{$date} ++ ;
		}
		elsif ( $line =~ /\: ok / )
		{
			$con_a{$date} ++ ;
		}
	}
	elsif ( $line =~ /^rblsmtpd: / )
	{
		if ( $line =~ / without reverse DNS/ )
		{
			$rdns{$date} ++ ;
		}
		elsif ( $line =~ /\: (553|451) / )
		{
			$rbl_d{$date} ++ ;
		}
		else
		{
			$rbl_a{$date} ++ ;
		}
	}
	elsif ( $line =~ /^jgreylist\[/ )
	{
		if ( $line =~ /DENY no reverse DNS/ )
		{
			$rdns{$date} ++ ;
		}
		elsif ( $line =~ /GREY first/ )
		{
			$jgr_f{$date} ++ ;
		}
		elsif ( $line =~ /GREY too/ )
		{
			$jgr_s{$date} ++ ;
		}
	}

	########################################
	# qmail-send: delivery stuff

	elsif ( $line =~ /^starting delivery / )
	{
		$del{$date} ++ ;

		if ( $line =~ / to local / )
		{
			$delt_l{$date} ++ ;
		}
		elsif ( $line =~ / to remote / )
		{
			$delt_r{$date} ++ ;
		}
		else
		{
			die "Unknown (local/remote) on this line\n$line" ;
		}
	}
	elsif ( $line =~ /^delivery \d+\: success\: / )
	{
		$dels_s{$date} ++ ;
	}
	elsif ( $line =~ /^delivery \d+\: deferral\: / )
	{
		$dels_d{$date} ++ ;
	}
	elsif ( $line =~ /^delivery \d+\: failure\: / )
	{
		$dels_f{$date} ++ ;
	}

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

	$last_recordio = ( $line =~ /\d+ [<>]/ ) ? 1 : 0 ;
	$pline = $sline ;
}

###############################################################################
###############################################################################
#
# output

print <<EOF ;
           |                       SMTP                       ||                  Deliveries
   Date    |   Conn  :deny RevDNS    RBL  Grey1  Grey+ Accept ||  total  local remote |   succ  defer   fail
---------- | ------ ------ ------ ------ ------ ------ ------ || ------ ------ ------ | ------ ------ ------
EOF

my $format = <<EOF ;
%-10s | %6d %6d %6d %6d %6d %6d %6d || %6d %6d %6d | %6d %6d %6d
EOF

for my $date ( sort keys %dates )
{
	$acc{$date} =
		  ( $con{$date}   || 0 )
		- ( $con_d{$date} || 0 )
		- ( $rdns{$date}  || 0 )
		- ( $rbl_d{$date} || 0 )
		- ( $jgr_f{$date} || 0 )
		- ( $jgr_s{$date} || 0 ) ;

	$t_con    += ( $con{$date}    || 0 ) ;
	$t_con_d  += ( $con_d{$date}  || 0 ) ;
	$t_con_a  += ( $con_a{$date}  || 0 ) ;
	$t_rdns   += ( $rdns{$date}   || 0 ) ;
	$t_rbl_d  += ( $rbl_d{$date}  || 0 ) ;
	$t_rbl_a  += ( $rbl_a{$date}  || 0 ) ;
	$t_jgr_f  += ( $jgr_f{$date}  || 0 ) ;
	$t_jgr_s  += ( $jgr_s{$date}  || 0 ) ;

	$t_acc    += ( $acc{$date}    || 0 ) ;

	$t_del    += ( $del{$date}    || 0 ) ;
	$t_delt_l += ( $delt_l{$date} || 0 ) ;
	$t_delt_r += ( $delt_r{$date} || 0 ) ;
	$t_dels_s += ( $dels_s{$date} || 0 ) ;
	$t_dels_d += ( $dels_d{$date} || 0 ) ;
	$t_dels_f += ( $dels_f{$date} || 0 ) ;

	printf $format , $date ,
		( $con{$date}    || 0 ) ,
		( $con_d{$date}  || 0 ) ,
		( $rdns{$date}   || 0 ) ,
		( $rbl_d{$date}  || 0 ) ,
		( $jgr_f{$date}  || 0 ) ,
		( $jgr_s{$date}  || 0 ) ,
		( $acc{$date}    || 0 ) ,
		( $del{$date}    || 0 ) ,
		( $delt_l{$date} || 0 ) ,
		( $delt_r{$date} || 0 ) ,
		( $dels_s{$date} || 0 ) ,
		( $dels_d{$date} || 0 ) ,
		( $dels_f{$date} || 0 ) ;
}

print <<EOF ;
---------- | ------ ------ ------ ------ ------ ------ ------ || ------ ------ ------ | ------ ------ ------
EOF

printf $format , "Totals" ,
	$t_con    ,
	$t_con_d  ,
	$t_rdns   ,
	$t_rbl_d  ,
	$t_jgr_f  ,
	$t_jgr_s  ,
	$t_acc    ,
	$t_del    ,
	$t_delt_l ,
	$t_delt_r ,
	$t_dels_s ,
	$t_dels_d ,
	$t_dels_f ;