#!/usr/bin/perl

##
# smlogstats.pl analyzes sendmail 8.12 logfile and produces html output
##

# Version 1.1a
# Last Modified: July 1, 2005
# Modified By: Jim Cameron (support @ moonpoint.com)

# This script is a slightly modified version of smlogstats.pl 
# Ver 1.1 by Ted George  (ted@kcnet.com)  Oct 24, 2001
# The original script is available at i
# http://www.salug.org/~wcb/smlogstats.pl.txt
#
# Modifications:
#
# 1. Added code to print usage information if no arguments are given
#    on the command line.
# 2. Modified the code so that an output file can be specified on the
#     command line.
#
# usage:  smlogstats.pl [ -d ] [ -l logfile ] [ -o htmlfile] [ -t n ]
#
# -d  print detail
# -l  full path name to logfile (default /var/log/maillog)
# -o  full path name to html output file (default stats.html)
# -t  print top n addresses (default 10)
#

# If no arguments are included on the command line, print
# usage information.
#
# The $#ARGV variable contains the number of the last subscript
# in the array, not the number of elements in the array. The number
# of arguments is $#ARGV + 1. $#ARGV initially has a value of -1.
if ($#ARGV +1 == 0) 
{
  print STDERR <<EOF;

usage:  smlogstats.pl [ -d ] [ -l logfile ] [ -o htmlfile] [ -t n ]

-d  print detail
-l  full path name to logfile (default /var/log/maillog)
-o  full path to the html output file (default stats.html)
-t  print top n addresses (default 10)

EOF
  exit 1;
}

# Getopts takes a string containing one character options.
# If the character has a colon after it, then the option takes
# a value following it. If the character isn't followed by a
# colon, then no value is used by the option. E.g., the -d
# option for this script doesn't take a value, whereas the
# -l, -o, and -t options all require a value. The -l and -o
# options require a filename while the -t option takes a number.
# See http://aplawrence.com/Unix/perlgetopts.html for further
# information on getopts.
require 'getopts.pl';
&Getopts('dl:o:t:');

# pattern to match for message id.  this works for 8.12
$pattern = '\[\d+\]: (\w{14,14}): ';

# location of date command
$date = '/bin/date';

$printdetail = $opt_d || 0;
$top = $opt_t || 10;
$logfile = $opt_l || "/var/log/maillog";
$output = $opt_o || "stats.html"; # location of the html output file
$report_date = `$date`;

&main();

sub main {
	&read_logfile();
	open(OUTPUT, "> $output") or die "Can't open $output: $!\n";
	&print_header();
	&summary();

	if ($printdetail) {
		&count_mail();

		$title = "Top $top senders by number of recipients sent to";
		&pr_detail($title, "Address", $cnt_sent_to, \%rcpts_to_addr)
			if $cnt_sent_to;

		$title = "Top $top senders summarized by domain";
		&pr_detail($title, "Domain", $cnt_sent_to, \%rcpts_to_domain)
			if $cnt_sent_to;

		$title = "Top $top relays by number of recipients sent to";
		&pr_detail($title, "Relay_IP", $cnt_sent_to, \%rcpts_to_ip)
			if $cnt_sent_to;

		$title = "Top $top senders to local unknown users";
		&pr_detail($title, "Address", $cnt_unknown, \%rcpts_to_unknown)
			if $cnt_unknown;

		$title = "Top $top senders triggering SMTP RCPT flood throttle";
		&pr_detail($title, "Address", $flooding, \%rcpt_flood)
			if $flooding;
	}

	print OUTPUT "</table></center></body></html>";
	close(OUTPUT);
}

sub print_header {
	print OUTPUT "<html><head><title>\n";
	print OUTPUT "Sendmail Logfile Stats</title></head>\n";
	print OUTPUT "<body bgcolor=\"#FFFFFF\">\n";
	print OUTPUT "<center><table border=\"0\" cellspacing=\"0\" width=\"640\">\n";

	print OUTPUT "<tr><td><h2>Sendmail Logfile Stats<br>";
	print OUTPUT "<small>for $date_from - $datestr</small></h3>";
	print OUTPUT "<h3>Report generated by smlogstats.pl on $report_date";
	print OUTPUT "</h3><hr></td></tr>\n";
}

sub read_logfile {
	local($id);
	open(INPUT, "$logfile") or die "Can't open $logfile: $!\n";

	while (<INPUT>) {
		$entries++;
		$datestr = substr($_, 0, 15);
		$date_from = $datestr unless $date_from;
		$rejecting++ if /rejecting connections on daemon MTA/;
		$deferring++ if /deferring connections on daemon MTA/;
		$delaying++ if /delaying connections on daemon MTA/;
		$rulesetreject++ if /: ruleset=check_/;

		$id = $1 if /$pattern/;
		next unless $id;

		&proc_to($_, $id) if /: to=\S+, /;
		&proc_from($_, $id) if /: from=\S+, /;

		if (/Possible SMTP RCPT flood/) {
			$flooding++;
			$flooding{$id}++;
		}

		if (/\.\.\. User unknown$/) {
			$sent_to{$id}++;
			$cnt_sent_to++;
			$cnt_unknown++;
			$sent_to_unknown{$id}++;
		}

	}

	close(INPUT);
}

sub proc_to {
	local($_) = shift();
	local($id) = shift();

	$sent_to{$id}++;
	$cnt_sent_to++;

	if (/, stat=Sent/) {
		$to_internal++ if / mailer=local, /;
		$to_external++ if / mailer=esmtp, /;

	# site specific information, probably don't need this
	} elsif (/, mailer=local, .*, stat=User unknown/) {
		$to_unknown++ unless /: to=bounce,/;

	} else {
		$to_failed++;
	}
}

sub proc_from {
	local($_) = shift();
	local($id) = shift();

	/: from=(\S+), /;
	$from{$id} = &fix_angles($1);
	/, relay=.*\[([^\]]+)/;
	$from_relay{$id} = $1;
	$cnt_from++;
}

sub summary {
	local(@_);
	print OUTPUT "<tr><td><h4>Logfile Summary</h4>";

	$_ = &commas($entries);
	push(@_, "Total_logfile_entries_processed $_");
	$_ = &commas($cnt_from);
	push(@_, "Total_envelopes_sent $_");
	$_ = &commas($cnt_sent_to);
	push(@_, "Total_recipients_sent_to $_");
	$_ = &commas($to_internal);
	push(@_, "Internal_deliveries $_");
	$_ = &commas($to_external);
	push(@_, "External_deliveries $_");
	$_ = &commas($cnt_unknown);
	push(@_, "Sent_to_local_unknown_users $_");
	$_ = &commas($to_unknown);
	push(@_, "Procmail_filter_rejections $_")
		if $to_unknown;
	$_ = &commas($to_failed);
	push(@_, "Other_failed_deliveries $_");
	$_ = &commas($rejecting);
	push(@_, "Throttling_-_rejecting_connections_on_daemon_MTA $_")
		if $rejecting;
	$_ = &commas($deferring);
	push(@_, "Throttling_-_deferring_connections_on_daemon_MTA $_")
		if $deferring;
	$_ = &commas($delaying);
	push(@_, "Throttling_-_delaying_connections_on_daemon_MTA $_")
		if $delaying;
	$_ = &commas($flooding);
	push(@_, "Throttling_-_possible_SMTP_RCPT_flood $_")
		if $flooding;
	$_ = &commas($rulesetreject);
	push(@_, "Rejections_based_on_check_*_rulesets $_")
		if $rulesetreject;

	print_table(1, 80, 0, 2, 'lr', @_);
	print OUTPUT "<br><hr></td></tr>\n";
}

sub pr_detail {
	local($title) = shift();
	local($heading) = shift();
	local($count) = shift();
	local($hashref) = @_[$[];
	local(@table);

	print OUTPUT "<tr><td><h4>$title</h4>";
	push(@table, "$heading Count %Total");

	sub hashvalues { $hashref->{$b} <=> $hashref->{$a}; }
	$i = 0;

	foreach $key (sort hashvalues (keys(%$hashref))) {
		$i++;
		$percent = sprintf("%6.2f%s", $hashref->{$key} / $count * 100, "%");
		$skey = fixhtml($key);
		$_ = &commas($hashref->{$key});

		push(@table, "$skey $_ $percent");
		last if $i >= $top;
	}

	print_table(1, 80, 1, 3, 'lrr', @table);
	print OUTPUT "<br><hr></td></tr>\n";
}

sub count_mail {
	local($id);
	while ($id = each %from) {
		$rcpts_to_addr{$from{$id}} += $sent_to{$id};
		$rcpts_to_unknown{$from{$id}} += $sent_to_unknown{$id};
		$rcpt_flood{$from{$id}} += $flooding{$id};
		$domain = $1 if $from{$id} =~ /\@([^\>]+)/;
		$rcpts_to_domain{$domain} += $sent_to{$id};
	}

	while ($id = each %from_relay) {
		$rcpts_to_ip{$from_relay{$id}} += $sent_to{$id};
	}
}

sub fix_angles {
	local($_) = shift();
	s/^/\</ unless /^\</;
	s/$/\>/ unless /$\>/;
	$_;
}

sub commas {
	local($_) = shift() || 0;
	1 while s/(.*\d)(\d\d\d)/$1,$2/;
	$_;
}

sub fixhtml {
	local($_) = shift();
	s/ /_/g;
	s/</&lt;/;
	s/</&gt;/;
	$_;
}

sub print_table {
	# usage:  print_table(b, w, h, c, 's', @_);
	#
	# b   border (1 or 0)
	# w   width in %
	# h   print table headers (1 or 0)
	# c   no of columns
	# s   string value of l (left) r (right) and c (center) for each column
	# @_  array
	#
	local($border) = shift();
	local($width) = shift();
	local($headings) = shift();
	local($cols) = shift();
	local($align) = shift();
	local(@_) = @_;
	local($firstrow) = 1;
	local($i, @row);

	print OUTPUT "<table border=\"$border\", width=\"$width\%\">\n";

	foreach (@_) {
		@row = split();
		print OUTPUT "<tr>\n";

		for ($i = 0; $i < $cols; $i++) {
			@row[$i] =~ s/_/ /g;

			print OUTPUT "<th" if $firstrow and $headings;
			print OUTPUT "<td" unless $firstrow and $headings;

			print OUTPUT " align=\"left\">@row[$i]"
				if substr($align, $i, 1) eq 'l';
			print OUTPUT " align=\"right\">@row[$i]"
				if substr($align, $i, 1) eq 'r';
			print OUTPUT " align=\"center\">@row[$i]"
				if substr($align, $i, 1) eq 'c';

			print OUTPUT "</th>" if $firstrow and $headings;
			print OUTPUT "</td>" unless $firstrow and $headings;
		}

		$firstrow = 0;
		print OUTPUT "</tr>\n";
	}

	print OUTPUT "</table>\n";
}

