smtpLog.pl

#!/usr/bin/perl
#
#	Small program that writes email data to a database
#	for logging purposes and monthly analysis.

use strict;
use Getopt::Long;
use MIME::Words qw(:all); 
use DBI;

my $VERSION = "0.1";

# Configuration
# -------------
my $dbhost = "";
my $dbname = "";
my $dbuser = "";
my $dbpass = "";
my $email = "";

sub usage
{
        print "\n";
        print "usage: bsmtp.pl [*options*]\n";
        print "  -h, --help           display this help and exit\n";
        print "  -f, --file           log file to parse\n";
        print "      --version        output version information and exit\n";
        print "  -v, --verbose        be verbose\n";
        print "      --debug          print debug messages\n";
        print "\n";
        exit;
}

my %opt = ();
GetOptions(\%opt,
        'file|f=s', 'debug', 'verbose|v', 'help|h', 'version'
        ) or exit(1);
usage if $opt{help};
 
if ($opt{version}) {
        print "parser.pl $VERSION by max\@cthought.com\n";
        exit;
}

# Connect to the Database
# -----------------------
my $dbh = DBI->connect("DBI:Pg:dbname=$dbname", $dbuser, $dbpass, { AutoCommit => 0 })
        or die "Couldn't connect to database: " . DBI->errstr;

# SQL Queries
# -----------
my $insert = $dbh->prepare_cached(q(
        insert into quarantine (date, from_user, from_domain, to_user, to_domain, stype, xfrom, xto, subject, body, raw)
        values (?,?,?,?,?,?,?,?,?,?,?)
        )) or die "Couldn't prepare statement: " . $dbh->errstr;

# Look for work
# -------------

chdir($quarantinedir) or die "Cannot change to $quarantinedir: $!";

opendir(DIR,".") or die "Cannot open $quarantinedir: $!";
my @filelist = grep { /\.bsmtp$/ } readdir DIR;
closedir DIR;

if (scalar(@filelist) == 0) {
	print "Nothing to do\n";
	exit 1;
}

foreach my $file (@filelist) {
	process_file($file)
}

# Disconnect from the DB
# ----------------------
$dbh->commit;
$dbh->disconnect;

# ----------
sub process_file {
	my $file = shift;

	my @rcpt;
	my $stype;
	my $sender;
	my $subject;
	my $xfrom;
	my $xto;
	my $body;
	my $raw;
	my $storetime;
	my $success;

	if ($file =~ m/spam/) {
		$stype = "spam";
	} else {
		$stype = "virus";
	}

	open(FILE,"<$file") || return;

	# evaluate the store time
	# statval[10] is ctime
	# --------------------
	my @statval = stat FILE;
	my ($sec, $min, $hr, $mday, $mon, $year) = localtime($statval[10]);
	$storetime = sprintf("%d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $mday, $hr, $min, $sec);

	my $scanstate = "header";
	while(<FILE>) {
		if ($scanstate eq "header") {
			if (m/^MAIL FROM:.*<([^>]*)>.*$/) {
				$sender = $1;
			}
			if (m/RCPT TO:<([^>]*).*$/) {
				push @rcpt, $1;
			}
			if (m/^DATA$/) {
				$scanstate = "body";
			}
		}
		if ($scanstate eq "body") {
			if (m/^\.\n$/s) {
				$scanstate = "ignore";
			} else {
				if (m/^To: (.*)$/) {
					$xto = $1;
				}
				if (m/^From: (.*)$/) {
					$xfrom = $1;
				}
				if (m/^X-Envelope-From: <(.*?)>$/) {
					$xfrom = $1 unless length($sender);
				}
				if (m/^Subject: (.*)$/) {
					$subject = $1;
					chomp($subject);
				}
				$body .= $_;
				$raw .= $_ unless (m/DATA/);
			}
		}
	}

	close FILE;

	foreach my $rcpt (@rcpt) {

		my ($from_user, $from_domain) = split(/@/,lc($sender));
		my ($to_user, $to_domain) = split(/@/,lc($rcpt));

		my $decoded = decode_mimewords($subject);

#		print "$subject \t--> $decoded\n";

		$success = $insert->execute($storetime, $from_user, $from_domain, $to_user, $to_domain, $stype, $xfrom, $xto, $decoded, $body, $raw) or die "Couldn't execute query: " . $dbh->errstr;

	}

        #if (!$success) {
        #        print "$file - Failed to update message database\n";
        #        rename($file, ".notstored/".$file);
        #        return;
        #}

        # finally we can delete the file
        unlink($file) or print "Cannot delete $file: $!\n";
}