#!/usr/local/bin/perl
#
#
# Create report for sendmail check_mail/rcpt/relay rejects
#

use strict;
use Getopt::Std;
use FileHandle;


my $PROGRAM     = 'logcheck';
my $VERSION     = '1.0 $Revision: 5.2 $ ';

##############################################################################
#
#
# Perl functions to read FIDOGATE config file,
# included by <INCLUDE config.pl> when running subst.pl
#

my %CONFIG;

# specials for DosDrive and Zone
my %CONFIG_dosdrive;
my %CONFIG_zone;



my %CONFIG_default =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"toss_toss", "%S/toss/toss",
	"seq_toss", "%V/seq/toss",
	"toss_route", "%S/toss/route",
	"config_main", "%C/fidogate.conf",
	"outpkt_mail", "%S/outpkt/mail",
	"spyes", "%C/spyes",
	"aliases", "%C/aliases",
	"seq_pkt", "%V/seq/pkt",
	"btbasedir", "/var/spool/fido/bt",
	"uplinks", "%C/uplinks",
	"areas", "%C/areas",
	"dbc_history", "%V/bdc",
	"tick_hold", "%B/tick",
	"toss_pack", "%S/toss/pack",
	"seq_pack", "%V/seq/pack",
	"spooldir", "/var/spool/fido/gate",
	"ftnacl", "%C/ftnacl",
	"toss_bad", "%S/toss/bad",
	"seq_news", "%V/seq/news",
	"outrfc_mail", "%S/outrfc/mail",
	"logdir", "/var/log/fido/gate",
	"outpkt", "%S/outpkt",
	"lock_history", "history",
	"newslibdir", "/usr/local/news",
	"seq_tick", "%V/seq/tick",
	"seq_msgid", "%V/seq/msgid",
	"routing", "%C/routing",
	"configdir", "/usr/local/etc/fido/gate",
	"vardir", "/var/db/fidogate",
	"newsbindir", "/usr/local/news/bin",
	"libexecdir", "/usr/local/libexec/fidogate",
	"history", "%V/history",
	"pinbound", "/var/spool/fido/bt/pin",
	"lock_tic_hist", "tic_hist",
	"seq_mail", "%V/seq/mail",
	"outpkt_news", "%S/outpkt/news",
	"config_gate", "%C/fidogate.conf",
	"inbound", "/var/spool/fido/bt/in",
	"charsetmap", "%L/charset.bin",
	"passwd", "%C/passwd",
	"acl", "%C/acl",
	"ftpinbound", "/var/spool/fido/bt/ftpin",
	"outrfc_news", "%S/outrfc/news",
	"newsvardir", "/usr/local/news/db",
	"newsspooldir", "/usr/local/news/spool/articles",
	"netmaildir", "/var/spool/fido/bt/netmail",
	"hubroutedb", "%V/route",
	"tic_history", "%V/tic_hist",
	"inn_batchdir", "/usr/local/news/spool/outgoing",
	"seq_split", "%V/seq/split",
	"seq_ff", "%V/seq/ff",
	"packing", "%C/packing",
	"lockdir", "/var/run/fidogate",
	"lock_dbc", "dbc",
	"newsetcdir", "/usr/local/news/etc",
	"hosts", "%C/hosts",
	"bindir", "/usr/local/bin",
	"logfile", "%G/log",
	"uuinbound", "/var/spool/fido/bt/uuin",
     );
my %CONFIG_abbrev =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"I", "inbound",
	"B", "btbasedir",
	"L", "libexecdir",
	"N", "bindir",
	"G", "logdir",
	"V", "vardir",
	"K", "lockdir",
	"P", "pinbound",
	"S", "spooldir",
	"C", "configdir",
     );



sub CONFIG_read {
    my($file) = @_;
    my($key, $arg);
    local *C;

    $file = CONFIG_expand($file);

    open(C,"$file") || die "config.pl: can't open config file $file\n";
    while(<C>) {
	chop;
	next if( /^\s*\#/ );	# comments
	next if( /^\s*$/  );	# empty
	s/\s*$//;		# remove trailing white space
	s/^\s*//;		# remove leading white space
	($key,$arg) = split(' ', $_, 2);
	$key =~ tr/A-Z/a-z/;
	if($key eq "include") {
	    CONFIG_read($arg);
	    next;
	}
	if($key eq "dosdrive") {
	    my ($d, $path) = split(' ', $arg);
	    $CONFIG_dosdrive{lc($d)} = $path;
	    next;
	}
	if($key eq "zone") {
	    my ($z, $rest) = split(' ', $arg, 2);
	    $CONFIG_zone{$z} = $rest;
	    next;
	}
	$CONFIG{$key} = $arg if(!$CONFIG{$key});
    }
    close(C);
}


sub CONFIG_get1 {
    my($key) = @_;
    my($ukey);

    $ukey = $key;
    $ukey =~ tr/a-z/A-Z/;
    return $ENV{"FIDOGATE_$ukey"} if($ENV{"FIDOGATE_$ukey"});

    return $CONFIG{$key} if($CONFIG{$key});
    return $CONFIG_default{$key};
}


sub CONFIG_get {
    my($key) = @_;
    my($ret);
    my($exp);

    $key =~ tr/A-Z/a-z/;
    return CONFIG_expand( CONFIG_get1($key) );
}


sub CONFIG_expand {
    my($v) = @_;
    my($exp);

    if($v =~ /^%([A-Z])/) {
	$exp = CONFIG_get1($CONFIG_abbrev{$1});
	$v =~ s/^%./$exp/;
    }

    return $v;
}


sub CONFIG_debug {    
    my($key);

    for $key (keys %CONFIG) {
	print "$key = $CONFIG{$key} -> ", CONFIG_get($key), "\n";
    }
}

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

# read config
my $CONFIG = "%C/fidogate.conf";
CONFIG_read($CONFIG);


my $NEWSGROUPS  = "junk";
my $SUBJECT     = "Sendmail Reject Report";
my $MAX         = 50;
my $TH_DISABLED = 100;
my $TH_RSS      = 50;

my $INEWS       = CONFIG_get("INEWS");
my $SENDMAIL    = CONFIG_get("SENDMAIL");

my $out_flag    = 0;




##### Command line ###########################################################
use vars qw($opt_g $opt_s $opt_n $opt_m $opt_v $opt_r
	    $opt_h $opt_h $opt_k $opt_N);
getopts('g:s:nm:vrhkN:');

if($opt_h) {
    print STDERR
      "\n",
      "$PROGRAM --- Summary of sendmail rejects\n",
      "\n",
      "usage:  $PROGRAM [-vh] [-r] [-k] [-N MAX]\n",
      "                 [-n] [-m EMAIL] [-g NEWSGROUPS] [-s SUBJECT]\n",
      "          -v               verbose\n",
      "          -h               this help\n",
      "          -r               include relay in output\n",
      "          -k               output killip commands\n",
      "          -N MAX           output top MAX entries only [default: $MAX]\n",
      "          -n               post output as news article\n",
      "          -m EMAIL         send output as mail to EMAIL\n",
      "          -g NEWSGROUPS    newsgroup(s) for posting [default: $NEWSGROUPS]\n",
      "          -s SUBJECT       subject for mail/news\n",
      "\n";
    
    exit 1;
}


if($opt_N) {
    $MAX        = $opt_N;
}
if($opt_g) {
    $NEWSGROUPS = $opt_g;
}
if($opt_s) {
    $SUBJECT    = $opt_s;
}
if($opt_n) {
    open(OUT, "|$INEWS")
      || die "logreport: can't open pipe to inews\n";
    select(OUT);
    $out_flag = 1;
}
if($opt_m) {
    open(OUT, "|$SENDMAIL $opt_m")
      || die "logreport: can't open pipe to sendmail\n";
    select(OUT);
    $out_flag = 1;
}
if($opt_k) {
    $opt_r = 1;
    $opt_n = 0;
    $opt_m = 0;
}



print "Newsgroups: $NEWSGROUPS\n" if($opt_n);
print "Subject: $SUBJECT\n" if($opt_m || $opt_n);
print "\n" if($opt_m || $opt_n);


my $first_date;
my $last_date;
my $addr;
my $r;
my $k;
my $n;

my %rbl_rss;
my %rbl_dul;
my %rbl_rbl;
my %reject;
my %nodns;
my %relay;
my %disabled;

# Read sendmail log
while(<>) {
    chop;

    if( /^(... .\d \d\d:\d\d:\d\d) / ) {
	$first_date = $1 if(!$first_date);
	$last_date  = $1;
    }

    # RBL
    if( /ruleset=check_relay, arg1=(.*), arg2=(.*), relay=(.*), reject=553 Rejected -/ ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $3;
	$rbl_rbl{"$addr /// $r"}++;
	print "rbl rbl: $addr\n" if($opt_v);
    }
    # DUL
    elsif( /ruleset=check_relay, arg1=(.*), arg2=(.*), relay=(.*), reject=553 Dialup -/ ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $3;
	$rbl_dul{"$addr /// $r"}++;
	print "rbl dul: $addr\n" if($opt_v);
    }
    # RSS
    elsif( /ruleset=check_relay, arg1=(.*), arg2=(.*), relay=(.*), reject=553 Open spam relay -/ ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $3;
	if($opt_k) {
	    $rbl_rss{$r}++;
	}
	else {
	    $rbl_rss{"$addr /// $r"}++;
	}
	print "rbl rss: $addr\n" if($opt_v);
    }
    elsif( /ruleset=check_mail \(([^\)]*)\) rejection: 551/ ||
	   /ruleset=check_mail, arg1=(.*), relay=(.*), reject=55\d/ ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $opt_r ? $2 : "";
	$reject{"$addr /// $r"}++;
	print "reject: $addr\n" if($opt_v);
    }
    elsif( /ruleset=check_mail \(([^\)]*)\) rejection: 451/ ||
	   /ruleset=check_mail, arg1=(.*), relay=(.*), reject=(451|501)/ ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $opt_r ? $2 : "";
	$nodns{"$addr /// $r"}++;
	print "no DNS: $addr\n" if($opt_v);
    }
    # Local black list (To, "Mailbox disabled")
    elsif( /ruleset=check_rcpt, arg1=(.*),() relay=(.*), reject=550 .*Mailbox disabled/     ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $opt_r ? $3 : "";
	if($opt_k) {
	    $disabled{$r}++;
	}
	else {
	    $disabled{"$addr /// $r"}++;
	}
	print "disabled: $addr\n" if($opt_v);
    }
    elsif( /ruleset=check_rcpt \(([^\)]*)\)()() rejection: 551/             ||
	   /ruleset=check_mail, arg1=(.*),() relay=(.*), reject=551/        ||
	   /ruleset=check_relay, arg1=(.*), arg2=(.*), relay=(.*), reject=550/ ||
	   /ruleset=check_rcpt, arg1=(.*),() relay=(.*), reject=5\d\d/     ) {
	$addr = $1;
	$addr = "<$addr>" if(! $addr =~ /^<.*>$/);
	$r = $opt_r ? $3 : "";
	$relay{"$addr /// $r"}++;
	print "relay : $addr\n" if($opt_v);
    }
    elsif(/check_/) {
	print "NOT MATCHED: $_\n" if($opt_v);
    }
}



# Output killip commands
if($opt_k) {
#    print "# Local blacklist (To, \"Mailbox disabled\")\n";
#    for $k (sort { $disabled{$b} <=> $disabled{$a} } keys(%disabled)) {
#	$n = $disabled{$k};
#	printf "%5d %s\n", $n, $k;
#    }

    print "# mail-abuse RSS\n";
    for $k (sort { $rbl_rss{$b} <=> $rbl_rss{$a} } keys(%rbl_rss)) {
	$n = $rbl_rss{$k};
	next if($n < $TH_RSS);
	printf "%5d %s\n", $n, $k if($opt_v);
	if($k =~ /\[(.+)\]/) {
	    print "/root/m/killip $1\n";
	}
    }

    exit 0;
}



# Report
print "sendmail reject report: $first_date -- $last_date\n";

if(scalar(%reject)) {
    print
	"\nLocal blacklist rejects (From):\n",
	"-------------------------------\n";
    $n = 0;
    for $k (sort { $reject{$b} <=> $reject{$a} } keys(%reject)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $reject{$k};
	print " $addr\n";
	print "                relay: $r\n" if($opt_r);
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%disabled)) {
    print
	"\nLocal blacklist rejects (To):\n",
	"-----------------------------\n";
    $n = 0;
    for $k (sort { $disabled{$b} <=> $disabled{$a} } keys(%disabled)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $disabled{$k};
	print " $addr\n";
	print "                relay: $r\n" if($opt_r);
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%nodns)) {
    print
	"\nNo DNS rejects:\n",
	"---------------\n";
    $n = 0;
    for $k (sort { $nodns{$b} <=> $nodns{$a} } keys(%nodns)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $nodns{$k};
	print " $addr\n";
	print "                relay: $r\n" if($opt_r);
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%relay)) {
    print
	"\nRelay attempt rejects:\n",
	"----------------------\n";
    $n = 0;
    for $k (sort { $relay{$b} <=> $relay{$a} } keys(%relay)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $relay{$k};
	print " $addr\n";
	print "                relay: $r\n" if($opt_r);
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%rbl_rbl)) {
    print
	"\nMail-Abuse RBL rejects:\n",
	"-----------------------\n";
    $n = 0;
    for $k (sort { $rbl_rbl{$b} <=> $rbl_rbl{$a} } keys(%rbl_rbl)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $rbl_rbl{$k};
	print " relay: $r\n";
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%rbl_dul)) {
    print
	"\nMail-Abuse DUL rejects:\n",
	"-----------------------\n";
    $n = 0;
    for $k (sort { $rbl_dul{$b} <=> $rbl_dul{$a} } keys(%rbl_dul)) {
	($a, $r) = split(" /// ", $k);
	printf "%5d", $rbl_dul{$k};
	print " relay: $r\n";
	last if($MAX && $n++>$MAX);
    }
}

if(scalar(%rbl_rss)) {
    print
	"\nMail-Abuse RSS rejects:\n",
	"-----------------------\n";
    $n = 0;
    for $k (sort { $rbl_rss{$b} <=> $rbl_rss{$a} } keys(%rbl_rss)) {
	($addr, $r) = split(" /// ", $k);
	printf "%5d", $rbl_rss{$k};
	print " relay: $r\n";
	last if($MAX && $n++>$MAX);
    }
}


close(OUT) if($out_flag);
