#!/usr/bin/perl -w
#
# $Id: //websites/unixwiz/unixwiz.net/webroot/tools/ordbscan.txt#1 $
#
# written by :  Stephen J. Friedl
#               Software Consultant
#               Orange County, California USA
#               steve@unixwiz.net
#
#	===================================================================
#	This program is in the public domain and may be used in any way
#	without restriction.
#	===================================================================
#
#	===================================================================
#	NOTE: THIS PROGRAM IS OBSOLETE; ordb went away a long time ago.
#	===================================================================
#
#
#	This program runs through the sendmail logfiles and looks for email
#	that has been bounced due to ORDB rejections, and it reports the
#	senders and recipients: this allows us to detect the false positives.
#	With this information we can find our partners that need to get
#	their acts together, or at least be whitelisted.
#
#	This is run as:
#
#		# ordbscan /var/log/maillog*
#
#	and it processes all logfiles in one big chunk. It matches the
#	"from" and "to" lines, and it writes a report that shows the
#	bounces by recipient: this allows us to forward the list to the
#	user and ask "do any of these ring any bells?"
#
#	Parsing the file is sometimes a little tricky because we get lots of
#	variations in the formats of the parameters: we'll do our best to
#	get the interesting parts from them.
#
# SENDMAIL REQUIREMENTS
# ---------------------
#	
#	This program ONLY works if the "delay_checks" feature has been 
#	included in the sendmail configuration file. If only the ORDB
#	rule is included, the connection is rejected very early in the
#	SMTP transaction, long before the recipient is known. This means
#	you get no information about who you were bouncing the mail to.
#
#	By adding "delay_checks", the check is made at RCPT time, so
#	the logs contain both the sender and the recipient: this is
#	the only way ordbscan can pick this up.
#
#	My sendmail configuration contains:
#
#
#	FEATURE(`delay_checks')dnl
#	FEATURE(`dnsbl', `relays.ordb.org', `Rejected - see http://ordb.org/')dnl
#
# BUGS
# ----
#
#	This program works on *my* sendmail and did so directly on the
#	systems of others, but it depends very much on the format of
#	the sendmail logfiles. It's possible that the regular expressions
#	will require a bit of tuning on any given system or vesion of
#	sendmail.
#
#	I would appreciate seeing logfiles that this program won't catch.
#

use strict;

my $verbose = 0;

my @LOGFILES = ();

foreach ( @ARGV )
{
	if ( m/^--help/i )
	{
		print STDERR <<EOF;

Usage: $0 [options] logfile [logfiles...]

  --help        Show this help listing
  --verbose     Show lots more debugging information

  logfile       one or more sendmail logfiles

EOF
		exit 1;
	}
	elsif ( m/^--verbose$/i )
	{
		$verbose = 1;
	}
	elsif ( m/^-/ )
	{
		die "ERROR: {$_} is invalid cmdline param (try --help)\n";
	}
	else
	{
		push @LOGFILES, $_;
	}
}

die "ERROR: no mail logfiles to process!\n" if @LOGFILES == 0;

my %ORDB = ();

foreach my $file ( @LOGFILES )
{
	print "Processing $file\n";

	open(F, $file) || die "ERROR: cannot open logfile $file\n";

	while ( <F> )
	{
		# grab the date

		my $date = $1	if m/^(... .. ..:..:..)/;

		# --------------------------------------------------------
		# REJECTED MESSAGE (with recipient)
		#
		# Look for a "rejected" message from ORDB, and if found,
		# save the Queue ID, recipient, and the responsible relay.
		#


		if ( m/sendmail\[\d+\]:		# just an anchor
			\s+ ([^:]+):		# queue ID
			\s+ ruleset=check_rcpt,	# anchor again
			\s+ arg1=([^,]+),	# recipient
			\s+ relay=([^,]+),	# relay host
			.*ordb/xi )
		{
			my $qid   = $1;
			my $recip = $2;
			my $relay = $3;

			$recip =~ s/[<>]//g;	# dump leading/trailing < >

			if ( $relay =~ m/(\d+\.\d+\.\d+\.\d+)/ )
			{
				$relay = $1;
			}

			my $ref = getQref($qid, $_, $date);

			$ref->{Relay} = $relay;

			push @{ $ref->{Recips} }, $recip;

			print "Q=$qid To=$recip Relay=$relay\n" if $verbose;
		}

		# --------------------------------------------------------
		# SENDER
		#
		# This grabs the sender of the message, but only if we have
		# seen the queue ID previously. 
		#

		elsif ( m/sendmail\[\d+\]:		# just an anchor
			\s+ ([^:]+):			# queue ID
			\s+ from=( [^,]+ ),/xi )	# sender (empty?)
		{
			my $qid    = $1;
			my $sender = $2;

			$sender =~ s/[<>]//g;		# dump leading/trailing <>
			$sender = "MAILER-DAEMON"	if length $sender == 0;

			next unless defined $ORDB{ $qid };

			my $ref = getQref($qid, $_, $date);

			$ref->{Sender} = $sender;

			print "Q=$qid From=$sender\n"	if $verbose;
		}
	}
}

# ------------------------------------------------------------------------
# Now we have essentially all the logfile lines sorted by Queue ID, so
# rewrite it to put them in order of recipient (and all the senders).
# This lets us send email to each recipient to ask "does this ring any
# bells". Those that do ring bells should be either whitelisted or
# contacted to get them to fix their relays.
#

my %RECIPS = ();

foreach my $qid ( keys %ORDB )
{
	my $ref = $ORDB{ $qid };

	foreach my $recip ( @{ $ref->{Recips} } )
	{
		$recip =~ tr/A-Z/a-z/;		# lower case

		push @{ $RECIPS{ $recip} }, {
			Sender	=> $ref->{Sender},
			Date	=> $ref->{Date},
			Relay	=> $ref->{Relay},
			QueueID	=> $qid
		};
	}
}

print "\n";

foreach my $recip ( sort keys %RECIPS )
{
	print "To: $recip\n";

	foreach my $ref ( @{ $RECIPS{$recip} } )
	{
		printf "   %-40s %s R=%s\n",
			$ref->{Sender},
			$ref->{Date},
			$ref->{Relay};
	}

	print "\n";
}


sub getQref {
	my $qid  = shift;
	my $ln   = shift;
	my $date = shift;

	# ----------------------------------------------------------------
	# If this entry is not defined, create it. This creates the
	# template that is added to by subsequent entries.
	#

	if ( not defined $ORDB{$qid} )
	{
		$ORDB{$qid} = {
			QueueID	=> $qid,
			Sender	=> "",
			Recips	=> [ ],
			Relays	=> [ ],
			Logs    => [ ],
			Date	=> $date,
		};
	}

	# always add the Log line

	my $ref = $ORDB{$qid};

	push @{ $ref->{Logs} }, $ln		if $verbose;


	return $ref;
}