security-scripts/mail/search maillogs/findsender.pl

157 lines
3.9 KiB
Perl
Executable file

#!/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);
}
}
}