#!/usr/bin/perl
#
###############################################################################
#
# MAIL Q-TIP: Lets you get a better idea for what your mail statistics
#             are for your site, if you get a lot of mail.
#	      Uses the "mailq" program of Sendmail.
#
# Written by Jason Scott. Version 1.0. Released June 9, 2000.
#
###############################################################################
##
## SETTINGS FOR THIS SCRIPT FOR YOUR SPECIFIC SITE
## Modify them for your stuff.

# Set the least amount of mail queued you want on the top list.
$lowerlimit=20;            

# Where do all the HTML files go?
$outputdirect="/var/website"; 

# What name do you want to report all your mail as coming from?
$mailhost="SMTP.COW.NET";

# Set the color scheme to be different if you don't dig my choices.

$text="#FFFFFF";        # The foreground text (default white)
$back="#550000";	# The document backgrounds (default red)
$head="#000000";	# The header background (default black)
$info="#440000";	# The error backgrounds (default dark red)
$name="#220000";	# The hostname backgrounds (default darker red)

# What font would you like to be the font everything is in?
$font="Arial";

## END OF SETTINGS
## No modifications should be necessary for this script to function below.

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

## Shave and a Haircut
## This subroutine takes a typical recipient line and turns it into a host.
## It gets called tons.

sub shave {
           $recipient =~ s/\>//g;
           $recipient =~ s/\<//g;
           $recipient =~ s/ //g;
           @host=split(/@/,$recipient);
           $mailhosts{$host[1]}++;
           }


## Attempt to open the mailq program and invoke it with -v.

$? = 0;
open MAILQ,"mailq -v|"
    or die "$!";

$date=`date`;

## Open up an HTML file for index.html, and then hosts.html.

open (INDEX,">$outputdirect/index.html");

print INDEX "<HTML><BODY BGCOLOR=$back TEXT=\"$head\">\n";
print INDEX "<TABLE WIDTH=100% ><TR>\n";

print INDEX "<TD BGCOLOR=$head WIDTH=100% COLSPAN=3 ALIGN=MIDDLE VALIGN=TOP>\n";
print INDEX "<FONT FACE=\"$font\" COLOR=$text SIZE=+2>\n";
print INDEX "Mail Queue Statistics for $mailhost</FONT><BR>\n";

print INDEX "<TR><TD BGCOLOR=$head BORDER=0 COLSPAN=3><CENTER>\n";
print INDEX "<FONT FACE=\"$font\" SIZE=+1 COLOR=$text>Top Problem Hosts</A>\n";
print INDEX "<BR><SMALL>Last Updated on $date</SMALL>\n";
print INDEX "<FONT FACE=\"$font\" SIZE=+1 COLOR=$text><BR>\n";
print INDEX "<A HREF=\"hosts.html\">Click Here for a Complete List</A>\n";
print INDEX "<TABLE WIDTH=100% CELLSPACING=1 CELLPADDING=0>\n";
print INDEX "</TABLE>\n";

open (HOSTS,">$outputdirect/hosts.html");

print HOSTS "<HTML><BODY BGCOLOR=$back TEXT=\"$head\">\n";
print HOSTS "<TABLE WIDTH=100% ><TR>\n";

print HOSTS "<TD BGCOLOR=$head WIDTH=100% COLSPAN=3 ALIGN=MIDDLE VALIGN=TOP>\n";
print HOSTS "<FONT FACE=\"$font\" COLOR=$text SIZE=+2>\n";
print HOSTS "Mail Queue Statistics for $mailhost</FONT><BR>\n";

print HOSTS "<TR><TD BGCOLOR=$head BORDER=0 COLSPAN=3><CENTER>\n";
print HOSTS "<FONT FACE=\"$font\" SIZE=+1 COLOR=$text>Top Problem Hosts</A>\n";
print HOSTS "<BR><SMALL>Last Updated on $date</SMALL>\n";
print HOSTS "<CENTER><TR><TD ALIGN=CENTER VALIGN=CENTER >\n";
print HOSTS "<TABLE WIDTH=100% CELLSPACING=1 CELLPADDING=0>\n";
print HOSTS "</TABLE>\n";


## Read in the MailQ results.

while(<MAILQ>) {

if(/^[a-zA-Z0-9]/) {

$holder=0;
@line = split();
$recipient=$line[6];

if ("$recipient" eq "" ) {
    $holder=1;
    }

# Do something here where you count the messages.

                   $messages++;
                   }

#elsif($holder) {

# This routine is designed so that if the recipient is null, then
# mark a "HOLDER" and the next time an address goes by, snag it. Unless
# of course the next major mail line goes through.
# The problem rests in somehow making the setup such that it will only do
# the additions to the totals once a mail recipient is discovered.
# Not there yet, but at least the info is being grabbed.

#     if (/@/) {
#		@host=split(/@/);
#                $host[1]=~ s/\>//g;
#        print "OTHER RECIPIENT: $host[1]\n";
#        $holder=0;
#        }
#      }


elsif(/\(*\)/) {

# Lose the requests lines

     if (/requests/) {
                     }
     
# Do something here where you keep track of what the reason for dying is.

     elsif (/onnection timed out with/) {
                $cto++;
                @host=split(/with/);
                $host[1] =~ s/\)//;
		$host[1] =~ s/ //g;
                chomp($host[1]);
                $mailhosts{$host[1]}++;
                $timeouts{$host[1]}++;
                }

     elsif (/onnection reset/) {
                $cr++;
                @host=split(/by/);
                $host[1] =~ s/\)//;
                $host[1] =~ s/ //g;
                chomp($host[1]);
                $mailhosts{$host[1]}++;
	        $connectionreset{$host[1]}++;
                }

     elsif (/onnection refused/) {
                $crf++;
                @host=split(/by/);
                $host[1] =~ s/\)//;
                $host[1] =~ s/ //g;
                chomp($host[1]);
                $mailhosts{$host[1]}++;
                $connectionrefused{$host[1]}++;
                }

     elsif (/host map/) {
                $hm++;
                @check=split(/\(/);
                $check[2] =~ s/\)//;
                @host=split(/:/,$check[2]);
                $host[0] =~ s/ //g;
                chomp($host[0]);
                $mailhosts{$host[0]}++;
                $domainlookup{$host[0]}++;
                }

      elsif (/host name lookup/) {
                $hm++;
                @check=split(/\(/);
                $check[2] =~ s/\)//;
                @host=split(/:/,$check[2]);
                $host[0] =~ s/ //g;
                chomp($host[2]);
                $mailhosts{$host[0]}++;
                $domainlookup{$host[0]}++;
                }


# These errors have to use the most recently sent recipient to figure
# out what the host was.

     elsif (/not send/) {
                $nb++;
		shave();
                $unsent{$host[1]}++;
		
                }

     elsif (/I\/O/) {
                $io++;
                shave();
                $ioerror{$host[1]}++
                }

     elsif (/[Ii]nsufficient/) {
                $ds++;
                shave();
                $outofdisk{$host[1]}++;
                }

     elsif (/[Nn]ot [Ee]nough [Ss]pace/) {
                $ds++;
                shave();
                $outofdisk{$host[1]}++;
                }


     elsif (/oute to ho/) {
                $ho++;
                shave();
		$noroute{$host[1]}++;
                }

     elsif (/roken pip/) {
                $bp++;
                shave();
		$brokenpipe{$host[1]}++;
                }


     elsif (/read error/) {
                $re++;
                shave();
		$readerrors{$host[1]}++;
                }

     elsif (/[Ii]llegal [Ss]eek/) {
                $re++;
                shave();
                $readerrors{$host[1]}++;
                }

     else {
          $weird++;
          print "Unknown Error: $_\n";
          }

               }
               }

    
close(MAILQ);

print "\n";
print "==============================\n";
print "TOP LIST OF HOSTS AND MESSAGES\n";
print "==============================\n";


foreach $hosts(sort{$mailhosts{$b} <=> $mailhosts{$a} } keys %mailhosts ) {
        $totalhosts++;  # Sorry, forgot the right way to do this

        if($mailhosts{$hosts} > $lowerlimit) {

## Put it in the INDEX.HTML file... Start it here so optional lines get added.

print INDEX "<TR><TD BGCOLOR=$name COLSPAN=2><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$hosts\n";

if ("$hosts" eq "" ) {
print INDEX "(unknown host)\n"; 
}

print INDEX "<TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$mailhosts{$hosts}\n";

        print "$hosts..";
        print "($mailhosts{$hosts} messages).\n";

        if ($timeouts{$hosts}) {
        print "           Timeouts: $timeouts{$hosts}\n";

print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Host Timeouts\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$timeouts{$hosts}\n";
                               }

        if ($connectionreset{$hosts}) {
	print "  Reset Connections: $connectionreset{$hosts}\n";

print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Reset Connections\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$connectionreset{$hosts}\n";
        }

        if ($connectionrefused{$hosts}) {
        print "  Refused Connections: $connectionrefused{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Refused Connections\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$connectionrefused{$hosts}\n";
        }

        if ($domainlookup{$hosts}) {
        print "  Domain Lookup Failure: $domainlookup{$hosts}\n";

print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Domain Lookup Failure\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$domainlookup{$hosts}\n";
        }

	if ($ioerror{$hosts}) {
        print "  Host I/O Failure: $ioerror{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Host I/O Failure\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$ioerror{$hosts}\n";
        }

        if ($noroute{$hosts}) {
        print "  No Route to Host: $noroute{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "No Route to Host\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$noroute{$hosts}\n";
        }

        if ($brokenpipe{$hosts}) {
        print "  Broken Pipe: $brokenpipe{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Broken Pipe to Host\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$brokenpipe{$hosts}\n";
        }

        if ($readerrors{$hosts}) {
        print "  Read Error: $readerrors{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Network Read Errors\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$readerrors{$hosts}\n";
        }


        if ($unsent{$hosts}) {
        print "  Waiting to Resend: $unsent{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Waiting 4 Hours to Resend\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$unsent{$hosts}\n";
        }

        if ($outofdisk{$hosts}) {
        print "  Out of Storage Space: $outofdisk{$hosts}\n";
print  INDEX "<TR><TD WIDTH=10%>&nbsp;<TD BGCOLOR=$info><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "Out of Storage Space\n";
print  INDEX "<TD BGCOLOR=$info ALIGN=RIGHT><FONT FACE=\"$font\" COLOR=$text>\n";
print  INDEX "$outofdisk{$hosts}\n";
        }

        }
        }

print "\n";
print "===============================\n";
print "FULL LIST OF HOSTS AND MESSAGES\n";
print "===============================\n";

foreach $hosts(sort(keys(%mailhosts))) {

print HOSTS "<TR><TD BGCOLOR=$name COLSPAN=2><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$hosts\n";

if ("$hosts" eq "" ) {
print HOSTS "(unknown host)\n";
}

print HOSTS "<TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$mailhosts{$hosts}\n";

        print "$hosts..";
        print "($mailhosts{$hosts} messages).\n";
        }

print "\n";
print "===================================\n";
print "Total Different Hosts: $totalhosts\n";
print "===================================\n";
print "Total Reset Connections: $cr\n";
print "Total Timeouts: $cto\n";
print "Total Refused connections: $crf\n";
print "Total Hostname Lookup Failures: $hm\n";
print "Total Still Unsent: $nb\n";
print "Input/Output Errors: $io\n";
print "Out of Disk Space: $ds\n";
print "No Route to Host: $ho\n";
print "Broken Pipe: $bp\n";
print "Read Errors: $re\n";
print "Stuff I didn't figure out: $weird\n\n";

$total=$cr+$cto+$crf+$hm+$nb+$io+$ds+$ho+$bp+$re+$weird;

print "Total Screwups Figured Out:";
print $total;
print "\nTotal Messages: $messages\n";

## Do it again, now for Index.HTML.

print INDEX "</TABLE>\n";
print INDEX "<TABLE WIDTH=100%><TR>\n";

print INDEX "<TD COLSPAN=2 BGCOLOR=$head WIDTH=100% ALIGN=MIDDLE VALIGN=TOP>&nbsp;<BR>\n";
print INDEX "<FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "General Mail Queue Statistics for $mailhost</FONT><BR>&nbsp;\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Different Hosts <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$totalhosts\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Reset Connections: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$cr\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Timeouts: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$cto\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Refused connections: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$crf\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Hostname Lookup Failures: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$hm\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Still Unsent: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$nb\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Input/Output Errors: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$io\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Out of Disk Space: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$ds\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "No Route to Host: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$ho\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Broken Pipe: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$bp\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Read Errors: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$re\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Stuff I didn't figure out: <TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$weird\n\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Screwups Figured Out:";
print INDEX "<TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1>$total\n";
print INDEX "<TR><TD BGCOLOR=$name><FONT FACE=\"$font\" COLOR=$text SIZE=+1>\n";
print INDEX "Total Queued Messages:<TD><FONT FACE=\"$font\" COLOR=$text SIZE=+1> $messages\n";
print INDEX "</TABLE>\n";

## Close out the INDEX.HTML file.

print INDEX "</TABLE>\n";
print INDEX "</BODY></HTML>\n";

print HOSTS "</TABLE>\n";
print HOSTS "</BODY></HTML>\n";

