#!/usr/bin/perl

use strict;
use Sys::Hostname;
use Date::Manip;

my $DELIM = ';';

if ($ARGV[0] =~ m/-h|--help/) {
    print <<EOF;

Usage: $0 [-v] [-v] -m [-D delim_string ] \\
          [domain1 ... domainN] [qid1 .. qidN]
       -h: This screen
       -v: Be verbose, give queue id, create time, queue date, msg age
    -v -v: Very verbose, give much information on each file in queue
           (name, create time, from, to, subject, reason for delay, age)
       -m: Machine readable (greppable) format.  This outputs all the
           same fields, but delimited by '$DELIM'.  Field output is as
           follows (Numbers of fields indicate position in output line!)
           1) Normal mode, no "-v" switches:
              0) domain name
              1) Number of messages in queue
              2) Size of queue in bytes
           2) Verbose "-v" mode.  After each domain line (item 1) above
              is output, lines are output describing the files belonging
              to the domain listed in item 1:
              0) The word "file" to indicate this is a file belonging
                 to the previously output domain.
              1) Queue file name
              2) The number of this delivery attempt since delivery was
                 first attempted.
              3) Unix time stamp date indicating when message was last
                 queued for delivery
              4) Number of seconds message has been in the queue this
                 go around.
              5) Number of seconds before now that message delivery was first
                 attempted (time the messge first entered your host).
           3) Super verbose mode "-v -v" includes all of the items in
              #2 plus:
              6) Unix time stamp indiciating when message first entered
                 the sendmail mail queue (first delivery attempt). 
              7) From address of message
              8) To address of message
              9) Subject of message
             10) Reason for deferral (may be blank)
         -D:  Use an alternate output delimeter (specified after -D switch)
              for machine readable output.
    If you specify "-v" or "-v -v" you may also pass in a list of queue 
    IDs if you wish to limit the verbose output to just one or more
    queue IDs.
 
Examples:

#  Show details of queue id for a deferred message
#  (you can see queue ids with a single "-v" or you can prepend
#  "qf" to a message id you find in your sendmail mail log.

$0 -v -v qfi053QTp24589

#  Show verbose queue summary for hosts foo.com and bar.com
$0 -v foo.com bar.com

#  Show very verbose output for all hosts
$0 -v -v

#  Output verbose summary in machine-readable moed
$0 -v -m

#  Show short summary for all hosts
$0

EOF
    exit(1);
}

my $BASE = "/home/virtual";

my $VERBOSE = (grep(/^-v|--verbose$/, @ARGV));
my @DOMAINS = (grep(/\w+\.\w+|outgoing-mail/, @ARGV));
my @QIDS = (grep(/^[Qq]f\w+/, @ARGV)) if $VERBOSE > 0;
my $MACHINE_READABLE = (grep(/^-m|--machine-readable$/, @ARGV));
my $ALT_DELIM = (join(' ',@ARGV) =~ m/-D\s*(\S+)/)[0];

if ($ALT_DELIM) {
    die "Must specify '-m' switch as well!\n" unless $MACHINE_READABLE;
    $DELIM = $ALT_DELIM if $ALT_DELIM;
}

chdir $BASE || die "No $BASE?  This is not Ensim!  Preposterous!\n";

#  Date::Manip must have this set in order to function
my $TZ = `date '+%Z'`;
chomp($TZ);
$ENV{'TZ'} = $TZ;

print <<EOF unless ($MACHINE_READABLE);
DOMAIN                         MSGS      QUEUE SIZE  
==============================================================================
EOF

my @SITES = @DOMAINS;

unless (@SITES) {
    open(SL,"/usr/local/bin/sitelookup -a domain |")
        || die "Can't read from sitelookup: $!\n";
    @SITES = map { chomp($_); $_ } (<SL>);
    close(SL);
    push(@SITES, "/");
}


#  Outgoing mail
my $out_qdir = "/home/virtual/FILESYSTEMTEMPLATE" .
               "/services/sendmail/mqueue.scanned/";

#### REFACTOR into routine

my @files = (glob("$out_qdir/*f*"));

my $size;
local($/);

for my $file (@files) { $size += (stat($file))[7] };

my @qfiles = (grep(m-/[Qq]\w+?$-, @files));

my $mod  = 1024;
my $type = "KB";
if ($size > (1*1024*1024)) {
    $mod = (1024 * 1024);
    $type = "MB *WARNING*";
} elsif ($size > (1*1024*1024*1024)) {
    $mod = (1024 * 1024);
    $type = "GB *PROBLEM*";
}

if (! $MACHINE_READABLE) {
    printf("%-30s %4d %10.2f $type\n",
           'outgoing-mail', scalar(@qfiles), ($size / $mod));
} else {
    print join($DELIM, 'outgoing-mail', scalar(@qfiles), $size)."\n";
}

if ($VERBOSE) {
    print <<EOF if ((! $MACHINE_READABLE) && $VERBOSE == 1);
------------------------------------------------------------------------------
EOF
    show_summary(@qfiles);
    show_orphans(@files);
    if (! $MACHINE_READABLE) {
        print <<EOF;
------------------------------------------------------------------------------
EOF
    }
}

#### REFACTOR 

#  Sites

for my $site (@SITES) {
    my $qdir;

    my $base = $BASE;

    # Account for main site 
    $base = '' if $site eq '/';

    my $qdir = "$base/$site/var/spool/mqueue";

    next unless -d $qdir;

    my $site_mqdir = "$base/$site/var/spool/mqueue.site";

    #  Quarantined email
    my $site_qdir = "$base/$site/var/spool/mail.quarantine";

    #  Account for main site
    $site = hostname() if $site eq '/';

    my @files = (glob("$qdir/*f*"),
                 glob("$site_mqdir/*f*"));

    next unless scalar(@files) > 0;

    my $size;
    local($/);

    for my $file (@files) { $size += (stat($file))[7] };

    my @qfiles = (grep(m-/[Qq]\w+?$-, @files));

    my $mod  = 1024;
    my $type = "KB";
    if ($size > (1*1024*1024)) {
        $mod = (1024 * 1024);
        $type = "MB *WARNING*";
    } elsif ($size > (1*1024*1024*1024)) {
        $mod = (1024 * 1024);
        $type = "GB *PROBLEM*";
    }

    if (! $MACHINE_READABLE) {
        printf("%-30s %4d %10.2f $type\n",
               $site, scalar(@qfiles), ($size / $mod));
    } else {
        print join($DELIM, $site, scalar(@qfiles), $size)."\n";
    }

    if ($VERBOSE) {
        print <<EOF if ((! $MACHINE_READABLE) && $VERBOSE == 1);
------------------------------------------------------------------------------
EOF
        show_summary(@qfiles);
        show_orphans(@files);
        if (! $MACHINE_READABLE) {
            print <<EOF;
------------------------------------------------------------------------------
EOF
        }
    }

}

print <<EOF unless ($MACHINE_READABLE || $VERBOSE);
==============================================================================
EOF

exit 0;

########
# SUBS #
########

my $SUMMARY_HEADER = 0;

sub show_orphans {
    my @files = @_;

    for my $dfile (grep(m#/df\w+$#, @files)) {
        my $match = $dfile;
        $match =~ s#/df#/[Qq]f#;
        if (! grep(m#${match}$#, @files)) {

            my $qf = ($dfile =~ m#^.+/(\S+)$#)[0];

            if (! $MACHINE_READABLE) {
                print "  $qf: orphan\n";
            } else {
                print join($DELIM, 'file', $qf, 'NQF', '', '', '')."\n";
            }
        }
    }

}

sub show_summary {
    my @files = @_;
   
    local($/) = undef;
    local(*F);
 
    my $now = time();

    for my $f (@files) {

        my $qf = ($f =~ m#^.+/(\S+)$#)[0];
        if (! -e $f) {
            print "    $f: already processed\n";
            next;
        }
        open(F, "< $f");
        my $text = <F>;
        close(F);

        #  Get summary information from the message

        my $atime = (stat($f))[10];
        #  Date message added to queue, not initial message delivery date
        my $date = scalar localtime($atime);
        my $qage = format_age($now - $atime, 0);
        my $from = ($text =~ m/H\?F?\?From:\s+(.+?)\n/ms)[0];
        my $to   = ($text =~ m/H\?\?To:\s+(.+?)\n/ms)[0];
        my $sub  = ($text =~ m/H\?\?Subject:\s+(.+?)\n/ms)[0];
        my $init = ($text =~ m/H\?D?\?Date:\s+(.+?)\n/ms)[0];
        my $stat = ($text =~ m/^M(.+?)\n/ms)[0] || "ERROR";
        my $try  = sprintf("%03d", ($text =~ m/^N(\d+)/ms)[0]);
        $try = 'ERR' if $qf =~ /^Q/;
        
        #  VERBOSE == 0, verbose, > 1 super verbose

        if ($VERBOSE > 0) {
            next if (@QIDS && ! grep(/$qf/i, @QIDS));
        }

        if ($VERBOSE == 1) {
            if ((! $MACHINE_READABLE) && $SUMMARY_HEADER == 0) {
                $SUMMARY_HEADER = 1;
                print <<EOF;
  QUEUE FILE    [TRY]  THIS ATTEMPT STARTED AT  (QUEUE AGE)      MSG AGE
  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
EOF
            }
            #  How old is this message from first delivery attempt?

            if (! $MACHINE_READABLE) {
                my $secs = UnixDate($init, "%s");
                my $age = format_age($now - $secs, 1);
                $qage = "   $qage  " if (length($qage) < 5);
                print "  $qf\[$try\]: $date ($qage)  - $age\n";
            } else {
                my $age = $now - UnixDate($init, "%s");
                $qage = $now - $atime;
                print join($DELIM, 'file', $qf, $try, $atime, $qage, $age)."\n";
            }

        } elsif ($VERBOSE > 1) {

            #  How old is this message from first delivery attempt?
            my $age = format_age($now - UnixDate($init, "%s"));
            my $trym;
 
            if ($MACHINE_READABLE) {

                my $age = $now - UnixDate($init, "%s");
                $qage = $now - $atime;
                $init = UnixDate($init, "%s");
                print join($DELIM, 'file', $qf, $try, $atime, $qage, $age,
                           $init,$from,$to,$sub,$stat)."\n";
                next;
            }

            if ($try eq 'ERR') {
                $trym = "Failure: sendmail could not deliver this message";
            } else {
                $trym = "$try delivery attempts so far";
            }
            print <<EOF;
------------------------------------------------------------------------------
Queue file: $qf ($date - $qage) 
     Tries: $trym
   Born On: $init ($age old) 
      From: $from
        To: $to
   Subject: $sub
    Status: $stat
EOF

       }
    }

    $SUMMARY_HEADER = 0;

}

#  Turn seconds since epoch into summary string format.
#  Pass in 1 as second arg to get short form, which 
#  just has highest time value type .. e.g. hours.  Long
#  format will show all time value types that are appropriate
#  for the value .. e.g. "04:03 m:s"

sub format_age {
    my $seconds = shift;
    my $short = shift;
    my @parts;

    my $fmt = "%02d";
    my $type = "s";

    if ($seconds < 60) {
        @parts = ($seconds);
        return sprintf "%2d+  secs", $seconds if $short;
    } elsif ($seconds < (60*60)) {
        my $mins = int($seconds / 60);
        return sprintf "%2d+  mins", $mins if $short;
        my $secs = $seconds % 60;
        $fmt = "%02d:%02d";
        @parts = ($mins, $secs);
        $type = "m:s"
    } elsif ($seconds < (60*60*24)) {
        my $hrs = int($seconds / (60*60));
        return sprintf "%2d+ hours", $hrs if $short;
        $seconds = ($seconds % (60 * 60));
        my $mins = int($seconds / 60);
        my $secs = $seconds % 60;
        $fmt = "%02d:%02d:%02d";
        @parts = ($hrs, $mins, $secs);
        $type = "h:m:s";
    } else {
        my $days = int($seconds / (60*60*24));
        $days = 99 if $days >= 99;
        return sprintf "%2d+  days", $days if $short;
        $seconds = ($seconds % (60 * 60 * 24));
        my $hrs = int($seconds / (60*60));
        $seconds = ($seconds % (60 * 60));
        my $mins = int($seconds / 60);
        my $secs = $seconds % 60;
        if ($days < 99) {
            $fmt = "%02d:%02d:%02d:%02d";
            @parts = ($days, $hrs, $mins, $secs);
            $type = "d:h:m:s";
        } else {
            $fmt = "%4s";
            @parts = ("> 99");
            $type = "days";
        }
    }
    return sprintf($fmt, @parts) . " $type";
}