#!/usr/bin/perl -w
#
# Name: findsender.pl
# Purpose: Checks a specified postfix maillog for a specified recipient
#    email address and returns a list of sender's email addresses
#    to which email was sent.
# Author: David Miller -- <>
# Version: 0.01
# Created:  25 Jul 2002
# Modified: for additional syslog formats, 
#
use strict;

#--------------
# variables
#--------------
my $debug = 0;
my $maillog;
my $recipient;
my @msgids;
my $msg;
my @fields;

my $qid;			# field numbers within $maillog
my $nrcpts;
my $sender;
my $size;

#---------------------------
# Main Thread of Execution
#---------------------------
# process command line arguments
usage() unless (@ARGV == 2);
$recipient = $ARGV[0];
$maillog = $ARGV[1];

# check sender name for basically valid form
if (! ($recipient =~ /.+@.+/)) {
    print "Recipient address $recipient does not appear valid\n";
    exit 1;
}
# test for existence of maillog
if(! -r $maillog) {
    print "Can not find mail log $maillog\n";
    exit 1;
}

# get all message ids associated with the recipient in temporary array
my @temp;
open(LOG, "<$maillog") || die "Initial open of $maillog failed\n";
while(<LOG>) {
    # on the fly, determine log line format (where various fields are)
    unless (defined $nrcpts) {
        if(/from=</ && !/postfix\/pickup/ && !/: warning: .*;/) {
	    my @fields = split;
	    find_fromline_fields(@fields);
	}
    }
    if(/to=/) {			# feature: matches Postfix orig_to= also
	if(/to=<?$recipient[\W_]/) { # same feature
	    my @fields = split;
	    $fields[$qid] =~ s/://;
	    push @temp, $fields[$qid];
	}
    }
}
close(LOG);

# optimize list by sorting and removing duplicates
@temp = sort @temp;
foreach my $msg (@temp) {
    if ((@msgids == 0) || ($msgids[$#msgids] ne $msg)) { # not yet recorded
	push @msgids, $msg;
    }
}

# display count of messages, and display header if there are messages
#    if no messages we are done
print "Found ", scalar @msgids, " messages for $recipient in $maillog\n";
(@msgids) ? printMessageHeader() : exit 0;

# look up sender, size, etc. for each message id
open(LOG, "<$maillog") || die "2nd open of $maillog failed\n";
foreach $msg (@msgids) {
    while(<LOG>) {
        chomp();
        if(/$msg/ && /from=</ && !/postfix\/pickup/ && !/: warning: .*;/) {
	    @fields = split " ", $_, 14;
	    # munge data fields for output
	    if ($fields[$sender] =~ /^from=<>,$/) {
		$fields[$sender] = "<>";
	    } else {
		$fields[$sender] =~ s/^from=<(.+)>,$/$1/; # keep just the addr
	    }
            $fields[$size] =~ s/^size=(\d+),$/$1/; # keep just the number
	    $fields[$nrcpts] =~ s/^nrcpts?=(\d+),?$/$1/; # keep just the number
	    # display the message info
	    write;
	    last;
	}
    }
    unless ($msg eq $msgids[-1]) { # in which case we're done
	seek LOG, 0, 0 && die "Seek/rewind failed: $!";
    }
}
close(LOG);
exit 0;

format =
@<<<<<<<<<<<<<<  @>>>>>>  @>   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$msg, $fields[$size], $fields[$nrcpts], $fields[$sender]
.

#----------------
# Sub Routines
#----------------
sub usage
{
    print "usage: $0 recipient maillog\n";
    exit 0;
}

sub printMessageHeader
{
    print "Checking for message senders\n\n";
    print "Message ID          Size Rcpts Sender\n";
    print "-"x70, "\n";
}

sub find_fromline_fields
{
    my @fields = @_;

    for my $i (0 .. $#fields) {
	unless (defined $qid) {
	    if ($fields[$i] =~ /^[A-Za-z\d]+:$/) { # alphanum+colon
		$qid = $i;
		print if ($debug > 1);
		print "DEBUG: \$qid\t= $qid\n" if ($debug);
	    }
	}
	if ($fields[$i] =~ /from=/) {
	    $sender = $i;
	    print if ($debug > 1);
	    print "DEBUG: \$sender\t= $sender\n" if ($debug);
	} elsif ($fields[$i] =~ /size=/) {
	    $size = $i;
	    print if ($debug > 1);
	    print "DEBUG: \$size\t= $size\n" if ($debug);
	} elsif ($fields[$i] =~ /nrcpts?=/) {
	    $nrcpts = $i;
	    print if ($debug > 1);
	    print "DEBUG: \$nrcpts\t= $nrcpts\n" if ($debug);
	}
    }
}

