#!/usr/bin/perl -w

# stat-mail.pl
#
# Gather spam statistics from sendmail log file
# See end for sample Cricket Defaults file to read and graph these stats and
# for SSH wrapper module to provide timeouts
#
# Chris Adams <cmadams@hiwaay.net> - HiWAAY Information Services
#
# Released under the GNU Public License.
#
# Version 1.0 - 2000-08-23
# - initial version
# 
# Version 1.01 - 2000-12-08
# - fixed some failure modes to keep the script from dying off
# - fixed scaling typos in sample Cricket Default file
#
# Version 1.5 - 2002-02-22
# - add logging to syslog and HUP handler
# - fix startup to properly close STDIN, STDOUT, STDERR
# 
# Version 1.6 - 2002-07-18
# - add Brightmail probe stats
# 
# Version 1.7 - 2002-09-28
# - fix die handling in timeout eval
# 
# Version 1.8 - 2002-11-01
# - change Brightmail match to what sendmail logs instead of mf_brightmail
# 
# Version 1.9 - 2003-02-17
# - include updated Cricket Defaults and perl SSH wrapper
# 

use Date::Parse;
use Fcntl qw(:flock);
use POSIX;
use Sys::Syslog qw(:DEFAULT setlogsock);
use integer;
use strict;

# Variables that need setting
# $logfile: sendmail log file
# $datafile: where to write out the data
# $mailstats: location of the mail stat program
# $delaystats: location of the delay mailer statistics
# $pid: where to write pid
# $log_facil: what syslog facility to use to write logs
my $logfile = "/var/adm/syslog.dated/current/mail.log";
my $datafile = "/var/adm/sendmail/spamstats";
my $mailstats = "/usr/sbin/mailstats";
my $delaystats = "/var/adm/sendmail/delay-statistics";
my $pidfile = "/var/run/stat-mail.pid";
my $log_facil = "daemon";

# What entries are "spam" records
my @spam = ("Brightmail", "RSS", "DUL", "RBL", "Sender domain resolution",
    "No sender domain", "Invalid sender domain");
# What entries are DNS problems
my @domain = ("Sender domain resolution", "No sender domain",
    "Invalid sender domain");
# What entry gets the total of all @domain entries
my $domain = "DNS";
# What entry gets the total of all @spam entries
my $spam = "Spam Total";
# What order to write the records out
my @order = ("Total", "Brightmail", "RSS", "DUL", "RBL",
    "Sender domain resolution", "No sender domain",
    "Invalid sender domain", "Messages In", "Messages Out", $spam, $domain,
    "Brightmail probes");
# How long to wait for a file lock
my $timeout = 5;
# How many seconds after the minute should this script wake up and run
my $sleep = 55;

# turn lists into hashes
my %spam = ();
@spam{@spam} = (1) x @spam;
my %domain = ();
@domain{@domain} = (1) x @domain;

# If there is a command line arg, treat it as a "one-shot" run on that file
my $oneshot = 0;
if (@ARGV) {
	$logfile = shift @ARGV;
	$oneshot = 1;
} else {
	# Open syslog
	my ($name) = $0 =~ /\/([^\/]+)$/;
	setlogsock ("unix");
	openlog ($name, "pid", $log_facil);

	$SIG{"__WARN__"} = sub { syslog ("warning", "%s", join ("", @_)) };
	$SIG{"__DIE__"} = sub { die @_ if $^S;
	    syslog ("crit", "%s", join ("", @_)); exit 1 };

	# close STDIN, STDOUT, STDERR and "daemonize"
	open (STDIN, "/dev/null") or die "open null: $!\n";
	open (STDOUT, "> /dev/null") or die "open > null: $!\n";
	my $pid = fork;
	die "fork: $!" unless defined ($pid);
	if ($pid != 0) {
		open (PID, "> $pidfile");
		print PID $pid, "\n";
		close (PID);
		exit;
	}
	setsid ();
	open (STDERR, ">&STDOUT");
}

# Handle HUP signal by waking up, running one more loop, and exiting
use vars qw($HUP);
$HUP = 0;
$SIG{"HUP"} = sub { $HUP = 1 };

# What is the biggest integer - used to make sure we wrap properly
my $maxint = 0;
for (my $x = 1; ($x > $maxint); $x *= 2) {
	$maxint = $x;
}

# Loop and run
$SIG{"ALRM"} = "IGNORE";
while (1) {
	# Open and lock the stat file
	open (STAT, "+< $datafile") or do {
		warn "open $datafile: $!";
		next;
	};
	my $locked = 0;
	eval {
		local $SIG{"ALRM"} = sub { die "timed out!\n"; };
		alarm ($timeout);

		if (flock (STAT, LOCK_EX)) {
			$locked = 1;
		} else {
			die "flock: $!\n";
		}
		alarm (0);
	};
	if (! $locked) {
		warn "lock failed: $@";
		close (STAT);
		next;
	}

	# Read in the current stat file
	my %stats = ();
	my $time = <STAT>;
	while (<STAT>) {
		chomp;
		my ($cnt, $type) = split (/\s+/, $_, 2);
		$stats{$type} = $cnt;
	}

	# Open the log file and get in position
	open (LOG, $logfile) or do {
		warn "open $logfile: $!";
		close (STAT);
		next;
	};
	my ($dev, $inode, $size) = (stat (LOG))[0,1,7];
	if ($stats{"inode"}) {
		if (($stats{"dev"} != $dev) || ($stats{"inode"} != $inode)) {
			$stats{"dev"} = $dev;
			$stats{"inode"} = $inode;
			$stats{"lastpos"} = 0;
		} elsif ($size < $stats{"lastpos"}) {
			$stats{"lastpos"} = 0;
		}
		seek (LOG, $stats{"lastpos"}, SEEK_SET);
	} else {
		$stats{"dev"} = $dev;
		$stats{"inode"} = $inode;
	}

	# Read the log entries
	while (<LOG>) {
		my $reason = "";
		if (/reject=([45])\d{2} (?:\d\.){2}\d .*\.{3} (.*)/) {
			my $temp = $1;
			$reason = reason ($2);
			$reason .= " (temp)" if ($temp eq "4");
		} elsif (/Milter delete: rcpt/) {
			$reason = "Brightmail";
		}
		$stats{$reason} = (($stats{$reason} || 0) + 1) % $maxint
		    if ($reason);
	}
	$stats{"lastpos"} = tell (LOG);
	close (LOG);

	# Get the mailstats entry
	$stats{"Messages In"} = $stats{"Messages Out"} = $stats{"Total"} = 0;
	open (MSTAT, "$mailstats |") && do {
		while (<MSTAT>) {
			my @line = split;
			my $t = "";
			if ($line[0] eq "0") {
				$t = "Messages In";
			} elsif ($line[0] eq "1") {
				$t = "Messages In";
			} elsif ($line[0] eq "3") {
				$t = "Messages In";
			} elsif ($line[0] eq "5") {
				$t = "Messages Out";
			} elsif ($line[0] eq "T") {
				$t = "Total";
			}
			$stats{$t} += $line[3] if ($t);
		}
		close (MSTAT);
	};

	# Get the other mailstats entry
	$stats{"Brightmail probes"} = 0;
	(-f $delaystats) && open (MSTAT, "$mailstats -f $delaystats|") && do {
		while (<MSTAT>) {
			my @line = split;
			my $t = "";
			if ($line[0] eq "T") {
				$t = "Brightmail probes";
			}
			$stats{$t} += $line[3] if ($t);
		}
		close (MSTAT);
	};

	# Write out the new stat file
	my $out = "";
	my $now = time;
	$out = $now . " " . scalar (localtime ($now)) . "\n";
	$stats{$spam} = 0;
	foreach my $type (@spam) {
		$stats{$spam} = ($stats{$spam} + $stats{$type}) % $maxint;
	}
	$stats{$domain} = 0;
	foreach my $type (@domain) {
		$stats{$domain} = ($stats{$domain} + $stats{$type}) % $maxint;
	}
	foreach my $type (@order) {
		$stats{$type} ||= 0;
		$out .= $stats{$type} . " " . $type . "\n";
		delete ($stats{$type});
	}
	foreach my $type (sort keys %stats) {
		$out .= $stats{$type} . " " . $type . "\n";
	}
	truncate (STAT, 0);
	seek (STAT, 0, SEEK_SET);
	print STAT $out;

	# Close the file (unlocks as well)
	close (STAT);

	# Done if this is was a single run
	last if ($oneshot);
} continue {
	# How long to sleep?
	my $tosleep = (60 + $sleep - (time % 60)) % 60;
	$tosleep = 60 if (! $tosleep);
	last if ($HUP);
	sleep ($tosleep);
}


sub reason
{
	my ($msg) = shift;
	return "DUL" if ($msg =~ /Mail from dial-up rejected/);
	return "RSS" if ($msg =~ /Open relay problem/);
	return "RBL" if ($msg =~ /Blackholed/);
	return "Sender domain resolution"
	    if ($msg =~ /Domain of sender address/);
	return "Relay" if ($msg =~ /Relaying denied/);
	return "Relay" if ($msg =~ /Relaying temporarily denied/);
	return "No sender domain" if ($msg =~ /Domain name required/);
	return "Invalid sender domain"
	    if ($msg =~ /Real domain name required/);
}


__END__;


########################################################################
########################################################################
# Here is a Cricket Defaults file.  To use, all you need is
# an entry like:
# target mail
# 	server = "mail.mydomain.com"
# It uses ssh to fetch the data (see the included Ssh.pm below).
Target	--default--
	target-type	=	mail-stats
	server		=	""
	my-desc		=	%server%
	short-desc	=	%my-desc%
	my-long-desc	=	%my-desc%
	spamfile	=	"cat /var/adm/sendmail/spamstats"

datasource	mail-total
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",1)"
	rrd-ds-type = COUNTER

datasource	mail-in
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",9)"
	rrd-ds-type = COUNTER

datasource	mail-out
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",10)"
	rrd-ds-type = COUNTER

datasource	mail-brightmail
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",2)"
	rrd-ds-type = COUNTER

datasource	mail-rss
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",3)"
	rrd-ds-type = COUNTER

datasource	mail-dul
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",4)"
	rrd-ds-type = COUNTER

datasource	mail-rbl
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",5)"
	rrd-ds-type = COUNTER

datasource	mail-spam
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",11)"
	rrd-ds-type = COUNTER

datasource	mail-dns
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",12)"
	rrd-ds-type = COUNTER

datasource	mail-probes
	ds-source = FUNC:"ssh(\"%server%\",\"%spamfile%\",13)"
	rrd-ds-type = COUNTER


targetType	mail-stats
	ds = "mail-total, mail-in, mail-out, mail-brightmail, mail-rss, mail-dul, mail-rbl, mail-spam, mail-dns, mail-probes"
	view = "Messages: mail-in mail-out, Spam statistics: mail-rbl mail-dul mail-rss mail-brightmail mail-dns, Spam summary: mail-spam, RBL: mail-rbl, DUL: mail-dul, RSS: mail-rss, Brightmail: mail-brightmail, DNS: mail-dns, Probes: mail-probes"

color deepgreen 008000
color deeppurple CA10CA

graph	--default--
    scale	=   60,*
    y-axis	=   "messages per minute"
    units	=   "msgs/min"
    color	=   gold
    draw-as	=   AREA

graph   mail-in
    legend	=   "Messages received"
 
graph   mail-out
    color	=   blue
    draw-as	=   LINE1
    legend	=   "Messages sent"
 
graph   mail-probes
    color	=   deepgreen
    draw-as	=   LINE1
    legend	=   "Messages to Brightmail probes"
 
graph   mail-brightmail
    color	=   deepgreen
    legend	=   "Messages blocked by Brightmail"
    draw-as	=   LINE1
    y-max	=   450
    show-max	=   false
 
graph   mail-rss
    color	=   red
    legend	=   "Messages blocked by RSS"
    draw-as	=   LINE1
    y-max	=   200
    show-max	=   false
 
graph   mail-dul
    color	=   blue
    legend	=   "Messages blocked by DUL"
    draw-as	=   LINE1
    y-max	=   50
    show-max	=   false
 
graph   mail-rbl
    color	=   deeppurple
    legend	=   "Messages blocked by RBL"
    draw-as	=   LINE1
    y-max	=   100
    show-max	=   false
 
graph   mail-dns
    color	=   gold
    legend	=   "Messages blocked by DNS lookups"
    draw-as	=   LINE1
    y-max	=   100
    show-max	=   false
 
graph   mail-spam
    legend	=   "Messages blocked"
    y-max	=   800
 
########################################################################
########################################################################
# This is a function wrapper for SSH that provides reasonable timeouts (in
# case the server is busy, hung, or dead).  To use, put this file (called
# "Ssh.pm") in your perl library path or cricket/lib directory, then edit
# cricket/lib/func.pm and add "use Ssh.pm;" under "use Common::Log;" and edit
# cricket/collector and uncomment the "use func;" line.
#
# There are a couple of configuration variables in this module:
#  $TIMEOUT - the number of seconds to wait for the SSH to complete
#  @SSH - list with full path to SSH and args to pass

package Ssh;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ssh);
use strict;

my $TIMEOUT = 5;
my @SSH = ("/usr/bin/ssh", "-x", "-a");

# Setup cache
use vars qw(%servers);
%servers = ();

# Called by collector
sub ssh
{
	my ($host, $cmd, $line) = @_;

	if (! defined ($servers{$host}{$cmd})) {
		# No data in the cache for this host so fetch it
		do_ssh ($host, $cmd);
	}
	if (! defined ($servers{$host}{$cmd}[$line])) {
		# No data for this line, return "U"nkown
		$servers{$host}{$cmd}[$line] = "U";
	}
	return $servers{$host}{$cmd}[$line];
}

# Function to actually fetch data
sub do_ssh
{
	my ($host, $cmd) = @_;

	# Fork off the child process and call ssh
	local (*SUB);
	die "Can't fork: $!\n" unless defined (my $pid = open (SUB, "-|"));
	if (! $pid) {
		open (STDIN, "</dev/null") or die "dup(/dev/nul): $!\n";
		exec @SSH, $host, $cmd;
		die "exec: $!\n";
	}

	# Fetch lines until either end-of-file or timeout
	local $SIG{ALRM} = sub { 1 };
	eval {
		local $SIG{ALRM} = sub { die "timeout\n" };
		alarm ($TIMEOUT);

		while (<SUB>) {
			# Just take the first column of data
			chomp;
			my @l = split;
			push @{$servers{$host}{$cmd}}, $l[0];
		}
	};
	alarm (0);

	# Make sure the child process is gone
	kill (9, $pid);
	waitpid ($pid, 0);
	close (SUB);
}

1;
########################################################################
########################################################################