#!/usr/bin/perl

my $DEBUG = 0;
my $LOGNAME = '/var/log/maillog';
my $GNU_DATE = '/bin/date';

use strict;
use Getopt::Long;
use POSIX;
use Sys::Hostname;

my $HOSTNAME = hostname();

my %CF;
$CF{'output'}->{short} = 1;

my $result = GetOptions(
    'help|h' => \$CF{'help'},
    'range|r=s' => \$CF{'time'},
    'brief|b' => \$CF{'brief'},
    'from|f=s' => \$CF{'from'},
    'no-link|nl' => \$CF{'nolink'},
    'long-output|lo' => sub { $CF{'output'}->{short} = 0 },
    'debug|d' => sub { $DEBUG = 1 }
);

if ($CF{'help'}) {
print <<EOF;
Usage: $0 [--debug|-d] [[--range|-r] N] [[--from|-f] N] \\
          [[--long-output|-lo] [[--nolink|-nl] \\
          [ SEARCH_TERM_1 ... SEARCH_TERM_N ]
Where:
    --debug: Turns on debug mode (very verbose!)
    --range: Set how many minutes/hours/days back in your mail logs to
             search.  Use suffixs "h" for hours, "m" for minutes, or
             "d" for days.  

             Example: Search back 3 days "--range 3d".

             Defaults to current day.

     --from: Latest date to search.  This is very useful if you want
             to see transactions that happened for say, last Friday
             only, not Friday to now. 

             Example: "--from '12/14/2003 23:59:59'"

             Defaults to current time/date.
             
     --long-output: 

             Show EVERY FIELD and value in each action for each
             transaction.  Good for hunting details of a problem.
             Default is to summarize fields and value for each action 
             within a transaction to make viewing easier.

     --no-link:

             Do not link multiple, related transactions together for
             viewing.  By default this script WILL link together related
             transactions for ease of viewing sendmail action histories
             (this part of the code needs more work).  Default is TO
             LINK together transactions.  Useful if you are searching over
             a large period of time (> 3 days).

    SEARCH_TERM:  Can be a simple string or a perl regular expression to
                  match.  Note that if a single ACTION in a transaction
                  matches, the whole transaction will be captured.
    
    Example usage:

    #  Search for all email transactions over last day.
    $0

    #  Find all deferred transactions over last 2 days
    $0 -r 2d eferred

    #  Find all transactions over last 4 days, without linking
    #  related transactions together, that involved you\@yourdomain.
    $0 -r 4d -nl you\@yourdomain.com

    #  Find all transactions that had DSN errors on 12/13 and 12/14.
    $0 -r 1d -f '12/14/2003 23:59:59' DSN

EOF

    exit;
}

#  Set END timel user specified or now.
if ($CF{'from'}) {
    $CF{'from'} = `$GNU_DATE -d "$CF{from}" +%s`;
} else {
    $CF{from} = time;
}

#  Everything else is a search
my $SEARCH = join('|', @ARGV) || undef;

my @hits = ();

my $time_filter = time2filter($CF{'time'}, $CF{'from'});

#warn $time_filter;

my %RECORDS;
my %KEYS;
my @IDS;
my %REFER;

my @FILES = ();

#  Set up files so we see them in oldest -> newest order
for (my $i = 9; $i >= 0; $i--) {
    push(@FILES, " $LOGNAME.$i") if -r "$LOGNAME.$i";
}

push(@FILES, "$LOGNAME");

for my $FILE (@FILES) {

  open(MAIL, "< $FILE") || die "Can't open read pipe from $FILE: $!\n";

  while (<MAIL>) {

    next unless m/(sendmail|idle|DATA|read|\[[\d.]+\])\[(\d+)\]:/;

    my $state = $1;
    my $pid = $2;

    debug("PID: $pid STATE: $state ");

    next unless $pid;
    
    chomp($_);
    s/\s+$//;
    my $line = $_;

    #  Get rid of date
    my $date = (m/^(\S+\s+\d+\s+\d+:\d+:\d+)/)[0];

    debug("DATE: $date ");

    s#^.+?[A-Za-z]\[\d+\]:\s+##;

    my $id = (m/(\S+):/)[0];
    s/^.*?${id}://;

    next unless $id;

    debug("ID: $id\n");

    # If we started to put together a transaction,
    # don't miss parts just because it falls outside
    # of date range or SEARCH .. if one part has matched,
    # whole thing should match.

    if (! exists $RECORDS{$id}) {
        next unless $date =~ /$time_filter/;
    }

    debug("GOTCHA: $id\n");

    my $record = { pid => $pid, state => $state };

    $record->{date} = $date;
    $record->{raw} = $line;

    if ($line =~ m/SYSERR(?:\((\w+)\)):/) {

        my $user = $1 || "N/A";
        my $msg = $line;
        $msg =~ s/^.+SYSERR(?:\(\w+\)):\s+//;
        $record->{error_type} = 'SYSERR';
        $record->{error_msg} = $msg;
       
        if (! $CF{'nolink'}) {
            if ($msg =~ m/(\S+):/) {
                $REFER{$1} = $id;
                debug("SYSERR linked from $id -> $1\n");
            }
        }

    } elsif ($line =~ m/DSN:/) {

        my $msg = $line;
        m/(\S+): DSN/;
        $record->{refer} = $1;
        $REFER{$record->{refer}} = $id;
        debug("DSN linked from $id -> $1\n");
        $msg =~ s/^.+DSN:\s+//;
        $record->{error_type} = 'DSN';
        $record->{error_msg} = $msg;

    } else {

        # Fields separated by ', ' .. subsep =
        my @fields = split(', ', $_);
        for my $field (@fields) {
            my ($key, $value) = split('=', $field, 2);
            $key =~ s/^\s+//;
            $key =~ s/\s+$//;
            if (! defined $value) {
                $record->{msg} = $key;
                if (! $CF{'nolink'}) {
                    if ($record->{msg} =~ m/(\S+):/) {
                        $REFER{$1} = $id;
                        debug("MSG linked from $id -> $1\n");
                    }
                }
            } else {
                $record->{$key} = $value;
            }
        }
    }

    my $linked = 0;

    if (! $CF{'nolink'}) {

        #  See if we refer to anyone else .. if so, add ourselves
        # to them .. we are the child adding ourselves to
        #  the end of the parent.

        my $KEY_MATCH = join('|', keys %KEYS);

        my @keys = ();
         
        if (@keys = ($_ =~ m/\b($KEY_MATCH)\b/g)) {

            for my $key (@keys) {

                 next if $key eq $id;

                 my $newrec  = {%{$record}};
                 $newrec->{link} = $id;
                 my $ref = $RECORDS{$id};

                 unshift(@{$RECORDS{$key}}, $newrec);

                 # FIND ALL RECORDs WITH no link key
                 # from this transaction and add em.
                 if (defined $ref) {
                      my @records = @{$RECORDS{$id}};
                      for my $rec (reverse @records) {
                           next if exists $rec->{link};
                           my $new = {%{ $rec }};
                           $new->{link} = $id;
                           unshift(@{$RECORDS{$key}}, $new);
                           $linked = 1;
                      }
                 }
            }
        }

        #  If an error occurred, we could be a part of it
        #  ... append ourselves to the original message.

        if (exists $REFER{$id} && exists $RECORDS{$REFER{$id}}) {
            my $refid = $REFER{$id};
            my @records = @{$RECORDS{$refid}};
            my $newrec = {%{$record}};
            $newrec->{link} = $id;
            push(@{$RECORDS{$refid}}, $newrec);
        }

    }

    unless ($id =~ /\d+/) {
        LOOK:
        for my $key (keys %RECORDS) {
            my @recs = @{$RECORDS{$key}};
            for my $one (@recs) {
                if ($one->{pid} == $pid) {
                    next if exists $one->{link};
                    next unless exists $one->{arg2};
                    my $newrec = {%{$record}};
                    $newrec->{link} = $id;
                    push(@{$RECORDS{$key}}, $newrec);
                }
            }
        }
    } else {
        push(@{$RECORDS{$id}}, $record);
        push(@IDS, $id) unless exists $KEYS{$id};
        $KEYS{$id} = 1;
    }

  }

}

close(MAIL);

if ($CF{brief}) {
}

sub bytrans {
    my $ta = ($a =~ m/(\d+)$/)[0];
    my $tb = ($b =~ m/(\d+)$/)[0];
    $ta <=> $tb;
}

for my $id (@IDS) {

    my @records = @{$RECORDS{$id}};

    my $matched = 0;

    for my $rec (@records) {
        if ($rec->{raw} =~ /$SEARCH/) {
            $matched = 1;
            last;
        }
    }

    next unless $matched == 1;

    print "Transaction $id:\n";

    for (my $i = 0; $i < scalar(@records); $i++) {
        my $record = $records[$i];
        if ($CF{'output'}->{'short'} == 1) {
            printf("%4d: %-15s %-10s ", ($i+1), $record->{date}, $record->{state});

            my $type;

            if ($record->{from}) {
                if ($record->{from} =~ m/\@/) {
                    $type = 'RELAY IN';
                } else {
                    $type = 'MAIL';
                    $type .= " **SUSPICIOUS** " if $record->{from} =~ /^\s*<?\s*>?\s*$/;
                }
                my $relay = $record->{relay};
                my $mech  = $record->{mech};
                if ($relay =~ /127.0.0.1/) {
                    $type .= ' FROM LOCAL';
                } elsif ($relay =~ /(\w+)\@localhost/) {
                    $type .= " FROM LOCAL USER $1";
                } else {
                    if ($relay =~ /$HOSTNAME/) {
                        $type .= ' FROM ME';
                    } else {
                        $type .= ' FROM REMOTE';
                    }
                }

                if ($mech) {
                    $type .= ' AUTHENTICATED MUA';
                } else {
                    $type .= ' MTA' if $record->{from} =~ /\@/;
                }
        
                $type .= " [$record->{size} bytes]";

            } elsif ($record->{to}) {
                $type = "DELIVER";
                my $mailer = $record->{mailer};
                if ($mailer =~ /virthostmail/) {
                    $type .= ' LOCAL VIRTUAL HOST';
                } elsif ($mailer =~ /mail/) {
                    $type .= ' LOCAL';
                } elsif ($mailer =~ /local/) {
                    $type .= ' LOCAL USER';
                } else {
                    $type = 'RELAY OUT';
                    if ($record->{dsn} =~ /^2/) {
                        $type .= ' (SUCCESS)';
                    } elsif ($record->{dsn} =~ /^4/) {
                        $type .= ' (TEMP FAIL)';
                    } elsif ($record->{dsn} =~ /^5/) {
                        $type .= ' (PERM FAIL)';
                    }
                }
            } elsif ($record->{arg1}) {
                $type = "REJECT";
            } elsif ($record->{error_type}) {
                $type = "ERROR";
            } elsif ($record->{msg}) {
                $type = "ERROR";
            } else {
                $type = "UNKNOWN";
                print "\n         KEYS: " . join(',', keys %{$record});
                print "\n         VALS: " . join(',', values %{$record});
            }
            
            if ($record->{link}) {
                $type .= " (* $record->{link})";
            }

            print $type;

            if ($record->{from}) {
                print "\n         FROM: $record->{from}";
                print "\n        RELAY: $record->{relay}";
                print "\n         MECH: $record->{mech}" if $record->{mech};
            } elsif ($record->{to}) {
                print "\n           TO: $record->{to}";
                print "\n       MAILER: $record->{mailer}";
                print "\n        RELAY: $record->{relay}";
            } elsif ($record->{arg1}) {
                print "\n        RELAY: $record->{relay}";
                print "\n       REJECT: $record->{reject}";
            } elsif ($record->{error_type}) {
                print "\n         TYPE: $record->{error_type}";
                print "\n          MSG: $record->{error_msg}";
                print "\n        REFER: $record->{refer}";
            } elsif ($record->{msg}) {
                print "\n         TYPE: $record->{link}";
                print "\n          MSG: $record->{msg}";
            }

            if ($record->{stat}) {
                print "\n         STAT: $record->{stat}";
                if ($record->{stat} =~ /eferred/) {
                    print "\n        DELAY: $record->{delay}";
                    print "\n       XDELAY: $record->{xdelay}";
                }
            }

            print "\n";
        } else {
            print "    Action " . ($i+1) . "\n";
            for my $field (sort keys %{$record}) {
                next if $field eq 'raw';
                print "        $field: $record->{$field}\n";
            }
        }
    }

}

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

sub fmt {
    my $fmt = shift;
    return POSIX::strftime($fmt, @_);
}

sub time2filter {
    my $spec  = shift;
    my $start = shift;

    my ($value, $type) = ($spec =~ m/(\d+)(\w)/);

    $type = lc($type);

    $value = 0 unless $value;
    $type = 'd' unless $type;

    # Dec 14 04:04:01

    my @parts;

    my $interval = 0;
    my $template;

    if ($type eq 'd') {
        $template = "%b %e";
        $interval = 86400;
    } elsif ($type eq 'h') {
        $template = "%b %e %H";
        $interval = 3600;
    } else {
        $template = "%b %e %H:%M";
        $interval = 60;
    }

    #  1 hour ago would be this hour + 1, etc.
    $value++;

    while ($value >= 1) {
         push(@parts, fmt($template, localtime($start - (($value-1)*$interval))));
             $value--;
    }

    return '^(?:' . join('|', @parts) . ')';

}

sub debug {
    return if $DEBUG != 1;
    my $msg = shift;
    print $msg;
}