pflogsumm.pl - Produce Postfix MTA logfile summary
-Copyright (C) 1998-2010 by James S. Seymour, Release 1.1.4
+Copyright (C) 1998-2010 by James S. Seymour, Release 1.1.5
=head1 SYNOPSIS
my $hasDateCalc = $@ ? 0 : 1;
my $mailqCmd = "mailq";
-my $release = "1.1.4";
+my $release = "1.1.5";
# Variables and constants used throughout pflogsumm
use vars qw(
my (
$cmd, $qid, $addr, $size, $relay, $status, $delay,
- $dateStr,
+ $dateStr, $dateStrRFC3339,
%panics, %fatals, %warnings, %masterMsgs,
%msgSizes,
%deferred, %bounced,
End_Of_HELP_DATE_CALC
}
-$dateStr = get_datestr($opts{'d'}) if(defined($opts{'d'}));
+($dateStr, $dateStrRFC3339) = get_datestrs($opts{'d'}) if(defined($opts{'d'}));
# debugging
#open(UNPROCD, "> unprocessed") ||
# die "couldn't open \"unprocessed\": $!\n";
while(<>) {
- next if(defined($dateStr) && ! /^$dateStr/o);
- s/: \[ID \d+ [^\]]+\] /: /o; # lose "[ID nnnnnn some.thing]" stuff
+ next if(defined($dateStr) && ! (/^${dateStr} / || /^${dateStrRFC3339}T/));
+ s/: \[ID \d+ [^\]]+\] /: /; # lose "[ID nnnnnn some.thing]" stuff
my $logRmdr;
# "Traditional" timestamp format?
if((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
- /^(...) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/o) == 6)
+ /^(...) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/) == 6)
{
# Convert string to numeric value for later "month rollover" check
$msgMon = $monthNums{$msgMonStr};
} else {
# RFC 3339 timestamp format?
next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
- /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:[\+\-](?:\d{2}):(?:\d{2})|Z) \S+ (.+)$/o) == 10);
+ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:[\+\-](?:\d{2}):(?:\d{2})|Z) \S+ (.+)$/) == 7);
# RFC 3339 months start at "1", we index from 0
--$msgMon;
}
# regexp rejects happen in "cleanup"
if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
- /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/o) == 3)
+ /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/) == 3)
{
- $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'});
+ $rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbMsgDetail'});
$rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
if($rejSubTyp eq "reject") {
++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
++$rejPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[4];
} elsif($qid eq 'warning') {
- (my $warnReas = $logRmdr) =~ s/^.*warning: //o;
+ (my $warnReas = $logRmdr) =~ s/^.*warning: //;
$warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
++$warnings{$cmd}{$warnReas};
}
} elsif($qid eq 'fatal') {
- (my $fatalReas = $logRmdr) =~ s/^.*fatal: //o;
+ (my $fatalReas = $logRmdr) =~ s/^.*fatal: //;
$fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
++$fatals{$cmd}{$fatalReas};
} elsif($qid eq 'panic') {
- (my $panicReas = $logRmdr) =~ s/^.*panic: //o;
+ (my $panicReas = $logRmdr) =~ s/^.*panic: //;
$panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
++$panics{$cmd}{$panicReas};
} elsif($qid eq 'reject') {
} elsif($cmd eq 'master') {
++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
} elsif($cmd eq 'smtpd') {
- if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) {
+ if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/) {
#
# Warning: this code in two places!
#
$rcvdMsg{$qid} = gimme_domain($1); # Whence it came
# DEBUG DEBUG DEBUG
#print STDERR "Received: $qid\n";
- } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) {
+ } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /) {
if($rejSubTyp eq 'reject') {
proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
\$rejPerHr[$msgHr],
}
else {
next unless(defined($opts{'smtpdStats'}));
- if($logRmdr =~ /: connect from /o) {
- $logRmdr =~ /\/smtpd\[(\d+)\]: /o;
+ if($logRmdr =~ /: connect from /) {
+ $logRmdr =~ /\/smtpd\[(\d+)\]: /;
@{$connTime{$1}} =
($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
- } elsif($logRmdr =~ /: disconnect from /o) {
- my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o;
+ } elsif($logRmdr =~ /: disconnect from /) {
+ my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/;
if(exists($connTime{$pid})) {
$hostID = gimme_domain($hostID);
my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
}
} else {
my $toRmdr;
- if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2)
+ if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/) == 2)
{
next if($msgSizes{$qid}); # avoid double-counting!
if($addr) {
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
+ if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
$addr = lc($addr) if($opts{'i'});
$addr = verp_mung($addr);
} else {
# Get the domain out of the sender's address. If there is
# none: Use the client hostname/IP-address
my $domAddr;
- unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/o) == 1) {
+ unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/) == 1) {
$domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
}
++$sendgDomCnt
}
}
elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
- /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/o) >= 4)
+ /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/) >= 4)
{
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
+ if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
$addr = lc($addr) if($opts{'i'});
$relay = lc($relay) if($opts{'i'});
- (my $domAddr = $addr) =~ s/^[^@]+\@//o; # get domain only
+ (my $domAddr = $addr) =~ s/^[^@]+\@//; # get domain only
if($status eq 'sent') {
# was it actually forwarded, rather than delivered?
- if($toRmdr =~ /forwarded as /o) {
+ if($toRmdr =~ /forwarded as /) {
++$msgsFwdd;
next;
}
push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
} elsif($status eq 'deferred') {
unless($opts{'deferralDetail'} == 0) {
- my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/o;
+ my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
unless(defined($opts{'verbMsgDetail'})) {
$deferredReas = said_string_trimmer($deferredReas, 65);
- $deferredReas =~ s/^\d{3} //o;
- $deferredReas =~ s/^connect to //o;
+ $deferredReas =~ s/^\d{3} //;
+ $deferredReas =~ s/^connect to //;
}
++$deferred{$cmd}{$deferredReas};
}
}
} elsif($status eq 'bounced') {
unless($opts{'bounceDetail'} == 0) {
- my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/o;
+ my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
unless(defined($opts{'verbMsgDetail'})) {
$bounceReas = said_string_trimmer($bounceReas, 66);
- $bounceReas =~ s/^\d{3} //o;
+ $bounceReas =~ s/^\d{3} //;
}
++$bounced{$relay}{$bounceReas};
}
# print UNPROCD "$_\n";
}
}
- elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) {
+ elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/) {
#
# Warning: this code in two places!
#
}
elsif($cmd eq 'smtp' && $opts{'smtpDetail'} != 0) {
# Was an IPv6 problem here
- if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) {
+ if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/) {
++$smtpMsgs{lc($2)}{$1};
- } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) {
+ } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/) {
++$smtpMsgs{lc($2)}{$1};
} else {
# print UNPROCD "$_\n";
# For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
my $norm1 = (split(/\s/, $_[0]))[0];
- if((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/o)) == 4) {
+ if((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)) == 4) {
# Dotted-quad IP address
return(pack('U4', @octets));
} else {
# now re-order "mach.host.dom"/"mach.host.do.co" to
# "host.dom.mach"/"host.do.co.mach"
- $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
+ $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
if($domainA);
- $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
+ $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
if($domainB);
# oddly enough, doing this here is marginally faster than doing
return 1;
} else {
# disregard leading bang-path
- $userNameA =~ s/^.*!//o;
- $userNameB =~ s/^.*!//o;
+ $userNameA =~ s/^.*!//;
+ $userNameB =~ s/^.*!//;
if($userNameA lt $userNameB) {
return -1;
} elsif($userNameA gt $userNameB) {
}
}
-# return a date string to match in log
-sub get_datestr {
- my $dateOpt = $_[0];
+# return traditional and RFC3339 date strings to match in log
+sub get_datestrs {
+ my ($dateOpt) = $_[0];
my $time = time();
} elsif($dateOpt ne "today") {
die "$usageMsg\n";
}
- my ($t_mday, $t_mon) = (localtime($time))[3,4];
+ my ($t_mday, $t_mon, $t_year) = (localtime($time))[3,4,5];
- return sprintf("%s %2d", $monthNames[$t_mon], $t_mday);
+ return sprintf("%s %2d", $monthNames[$t_mon], $t_mday), sprintf("%04d-%02d-%02d", $t_year+1900, $t_mon+1, $t_mday);
}
# if there's a real domain: uses that. Otherwise uses the IP addr.
# split domain/ipaddr into separates
# newer versions of Postfix have them "dom.ain[i.p.add.ress]"
# older versions of Postfix have them "dom.ain/i.p.add.ress"
- unless((($domain, $ipAddr) = /^([^\[]+)\[((?:\d{1,3}\.){3}\d{1,3})\]/o) == 2 ||
- (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/oi) == 2) {
+ unless((($domain, $ipAddr) = /^([^\[]+)\[((?:\d{1,3}\.){3}\d{1,3})\]/) == 2 ||
+ (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/i) == 2) {
# more exhaustive method
- ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o;
+ ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/;
}
# "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
$domain = $ipAddr;
# For identifying the host part on a Class C network (commonly
# seen with dial-ups) the following is handy.
- # $domain =~ s/\.\d+$//o;
+ # $domain =~ s/\.\d+$//;
} else {
$domain =~
- s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o;
+ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/;
}
return $domain;
my($trimmedString, $maxLen) = @_;
while(length($trimmedString) > $maxLen) {
- if($trimmedString =~ /^.* said: /o) {
- $trimmedString =~ s/^.* said: //o;
- } elsif($trimmedString =~ /^.*: */o) {
- $trimmedString =~ s/^.*?: *//o;
+ if($trimmedString =~ /^.* said: /) {
+ $trimmedString =~ s/^.* said: //;
+ } elsif($trimmedString =~ /^.*: */) {
+ $trimmedString =~ s/^.*?: *//;
} else {
$trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
last;
# First: get everything following the "reject: ", etc. token
# Was an IPv6 problem here
($rejTyp, $rejFrom, $rejRmdr) =
- ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/o);
+ ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/);
# Next: get the reject "reason"
$rejReas = $rejRmdr;
# an email address or HELO string. There can be *anything* in
# those--incl. stuff that'll screw up subsequent parsing. So just
# get rid of it right off.
- $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/o;
- $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/o;
- $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/o;
- $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/o;
+ $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/;
+ $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/;
+ $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/;
+ $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/;
} elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr...
- $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o;
+ $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/;
} else {
- $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o;
+ $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/;
}
}
# Second expression is for unknown recipient--where there is no
# "to=<mumble>" field, third for pathological case where recipient
# field is unterminated, forth when all else fails.
- (($to) = $rejRmdr =~ /to=<([^>]+)>/o) ||
- (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /o) ||
- (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/o) ||
+ (($to) = $rejRmdr =~ /to=<([^>]+)>/) ||
+ (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /) ||
+ (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/) ||
($to = "<>");
$to = lc($to) if($opts{'i'});
# Snag sender address
- (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>");
+ (($from) = $rejRmdr =~ /from=<([^>]+)>/) || ($from = "<>");
if(defined($from)) {
$rejAddFrom = $opts{'rejAddFrom'};
}
# stash in "triple-subscripted-array"
- if($rejReas =~ m/^Sender address rejected:/o) {
+ if($rejReas =~ m/^Sender address rejected:/) {
# Sender address rejected: Domain not found
# Sender address rejected: need fully-qualified address
++$rejects->{$rejTyp}{$rejReas}{$from};
- } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/o) {
+ } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/) {
# Recipient address rejected: Domain not found
# Recipient address rejected: need fully-qualified address
# User unknown (in local/relay recipient table)
$rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
}
++$rejects->{$rejTyp}{$rejReas}{$rejData};
- } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/) {
# Was an IPv6 problem here
- my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o;
+ my ($src) = $logLine =~ /^.+? from (\S+?):.*$/;
++$rejects->{$rejTyp}{$rejReas}{$src};
- } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/) {
my $rejData = gimme_domain($rejFrom);
$rejData .= " ($from)" if($rejAddFrom);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
- } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/) {
my $rejData = gimme_domain($rejFrom);
$rejData .= " ($from)" if($rejAddFrom);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
my $addr = $_[0];
if(defined($opts{'verpMung'})) {
- $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi;
+ $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/i;
if($opts{'verpMung'} > 1) {
- $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o;
+ $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/;
}
}
projects / sven / pflogsumm.git / blobdiff