[comp.mail.sendmail] Tools to analyze mail log & PET PEEVE

pvo@talon.UCS.ORST.EDU (Paul O'Neill) (03/12/91)

I was going to clean this up and post it.  It would never have made it to you.

Here it is "dirty."

1st the pet peeve:

	Why are so many people throwing out code here w/o their name and date
	on it?  Just because perl "makes programing fun again" (tm), is no
	reason to get sloppy.

2nd the mail summarizer:

I don't know who to attribute this to.  It could still use some work.

Output of "ssl.pl -m /var/log/syslog" (can you tell I'm on a Sun?)
looks something like:

To: 18008
2855 messages 8492201 bytes pvo
1634 messages 3502129 bytes rick
1563 messages 3785582 bytes leach
1120 messages 2783366 bytes rpm
507 messages 1149150 bytes kean
504 messages 1263615 bytes curt
421 messages  878648 bytes sears
402 messages 1394068 bytes johng
.
.
.
From: 12463
1295 messages 3108314 bytes relay-info-vax@crvax.sri.com
1018 messages  548525 bytes irje@windom.ucar.edu
825 messages 1972528 bytes sun-managers-relay@eecs.nwu.edu
681 messages 2833610 bytes arg-admin@ois.db.toronto.edu
425 messages 1747975 bytes root
405 messages  747954 bytes tcp-ip-relay@nic.ddn.mil
396 messages 1662481 bytes @ois.db.toronto.edu:arg-admin@db.toronto.edu
336 messages  688968 bytes owner-openlook@uunet.uu.net
309 messages  517632 bytes @cunyvm.cuny.edu:emusic-l@auvm.bitnet
278 messages  605850 bytes owner-sco-list@uunet.uu.net
.
.
.



# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by sapphire!pvo on Mon Mar 11 21:18:16 PST 1991
# Contents:  ssl.pl
 
echo x - ssl.pl
sed 's/^@//' > "ssl.pl" <<'@//E*O*F ssl.pl//'
#!/usr/local/bin/perl
#
#	original by ?????
#
#	Paul O'Neill
#	Coastal Imaging Lab
#	Oregon State University
#
#	18 jun 90
#	fix various bugs
#	add sorted output
#
# summarize sendmail syslog
#
# flags mean:
#
#	-o	outbound mail only
#	-i	inbound  mail only
#	-t	suppress printing of totals
#	-e 	print strange lines to stderr
#	-m	reduce to local mbox is possible

($program = $0) =~ s%.*/%%;


while ($ARGV[0] =~ /^-/) {
    $ARGV[0] =~ s/^-//; 
    foreach $flag ( split (//,$ARGV[0]) ) {
	if ( 'oitem' !~ /$flag/ ) {
	    printf stderr "unknown flag: %s\n", $flag;
	    die "usage: $program [-oitem] [syslog_file ...]\n";
	} 
	die "$0: '$flag' flag already set\n" if ($flags{$flag}++);
    } 
    shift;
}

if ( !$flags{'o'} && !$flags{'i'} && !$flags{'t'}) {
    $flags{'o'}++;
    $flags{'i'}++;
} 

do hash_passwd() if $flags{'m'};

while (<>) {
    if (/: [A-Z][A-Z](\d+): from=(.*), size=(\d+)/) {
#	next unless $flags{'t'} || $flags{'o'};
	($id, $user, $size) = ($1, $2, $3);
#print "$user\n";
	$user =~ s/.*<(.*)>/$1/;		# get rid of <>
#print "$user\n";
	$user =~ tr/A-Z/a-z/;			# canonical lc
#print "$user\n";

	if ($flags{'m'}) {
	    $ouser = $user;
#print "	$user\n";
	    $user = do strip($user);
#print "	 $user\n";
	    $user = $ouser if ! $known{$user};
#print "	  $user\n";
#print "	  $known{$user}\n";
	}

	$from_user_size{$user} += $size;
	$id_size{$id} = $size;
	$from_user_count{$user}++;
	$total_from++;
    } elsif (/: [A-Z][A-Z](\d+): to=(.*), delay=/) {
#	next unless $flags{'t'} || $flags{'i'};
	$id = $1;
	for (split(/,/, $2)) {
	    s/.*<(.*)>/$1/;
#	    $to = $flags{'m'} ? do strip($_) : $_;
	    $to = $_;
	    if ($flags{'m'}) {
		$oto = $to;
#print "		$to\n";
		$to = do strip($to);
#print "		 $to\n";
		$to = $oto if ! $known{$to};
#print "		  $to\n";
#print "		  $known{$to}\n";
	    }
	    $to =~ tr/A-Z/a-z/;
#	    printf "adding %d bytes to %s from %s\n",
		$id_size{$id},$to,$user; 
	    if (!$to) {
		die "to no one: $_\n";

	    } 
	    $to_user_size{$to} += $id_size{$id};
	    $to_user_count{$to}++;
	    $total_to++;
	} 
    } else {
	study;
	next if /message-id/;
	next if /locked/;
	next if /alias database (auto|)rebuilt/;
	#next if /aliases/;
	next if /rebuilding alias database/;
	print stderr if $flags{'e'};
	$errors++;
    } 
} 

printf stderr "Error lines: %d\n", $errors if $errors && ($flags{'e'}) && !($flags{'t'});


if ($flags{'i'}) {
    printf "To: %d\n", $total_to unless $flags{'t'};;

    @loop = keys(to_user_size);
    foreach $user (sort tosort @loop) {
	printf "%4d message%s %7d bytes %s\n",
	    $to_user_count{$user}, 
	    $to_user_count{$user} != 1 ? "s" : " ",
	    $to_user_size{$user}, 
	    $user;
    } 
}


if ($flags{'o'}) {
    printf "From: %d\n", $total_from unless $flags{'t'};;

    @loop = keys(from_user_size);
    foreach $user (sort fromsort @loop) {
	printf "%4d message%s %7d bytes %s\n",
	    $from_user_count{$user}, 
	    $from_user_count{$user} != 1 ? "s" : " ",
	    $from_user_size{$user}, 
	    $user;
    } 
}

sub tosort {
    ($to_user_count{$b} - $to_user_count{$a})* 10000000 + $to_user_size{$b} - $to_user_size{$a};
}
sub fromsort {
    ($from_user_count{$b} - $from_user_count{$a}) * 10000000 + $from_user_size{$b} -$from_user_size{$a};
}

sub strip {
    local($foo) = shift(@_);
#print "$foo\n";
    
    $foo =~ s/@.*//;
    $foo =~ s/.*!//;
    $foo =~ s/\s*\(.*\)//;
    $foo =~ tr/A-Z/a-z/;

    return $foo;
} 

sub hash_passwd {
    chop($yp = `/bin/domainname`) if -x '/bin/domainname';
    $passwd = $yp ? 'ypcat passwd |' : '/etc/passwd';
    open passwd || die "$program: can't open $passwd: $!\n";
    while (<passwd>) {
	/^(\w+):[^:]+:(\d+):.*/;
	($who,$uid) = ($1, $2);
#	$uid = 'zero' if ! $uid;  # kludge for uid 0
	$uid = 'zero' if ($uid == 0) && $who;
#	$uid = 'zero' if defined($uid);
	$known{$who} = $uid;
#print "$who $uid		$known{$who}\n";
    } 
    close passwd;
#print "SPECIEALLLL -- $known{''}\n";
} 
@//E*O*F ssl.pl//
chmod u=rwx,g=rwx,o=rx ssl.pl
 
exit 0

tchrist@convex.COM (Tom Christiansen) (03/12/91)

From the keyboard of pvo@talon.UCS.ORST.EDU (Paul O'Neill):
:Here it is "dirty."
:
:1st the pet peeve:
:
:	Why are so many people throwing out code here w/o their name and date
:	on it?  Just because perl "makes programing fun again" (tm), is no
:	reason to get sloppy.

'Tis mine, sorry.  Yes, it's a bit unclean.  Sorry not to have put the
right attributions there.  I did it a "long" time ago, and it's probably
not the pinnacle a perl programming I'd right today.  Maybe I just didn't
want anyone to know.  :-)

--tom