pflogsumm - Produce Postfix MTA logfile summary
-Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.14
+Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.15
=head1 SYNOPSIS
pflogsumm [--config <file>] [--bounce-detail <cnt>] [--colwidth <n>]
[-d|--date-range <date [range]>] [--deferral-detail <cnt>]
[--detail <cnt>] [--dow0mon] [-e|--extended-detail]
- [--expired-detail <cnt> ] [-h|--host-cnt <cnt>] [-i|--ignore-case]
+ [--expired-detail <cnt>] [-h|--host-cnt <cnt>] [-i|--ignore-case]
[--iso-date-time] [-m|--uucp-mung] [--mailq] [--no-no-msg-size]
[--problems-first] [--pscrn-detail <cnt>] [--pscrn-stats]
[-q|--quiet] [--rej-add-from] [--rej-add-to] [--reject-detail <cnt>]
- [--smtp-detail <cnt>] [--smtpd-stats]
- [--smtpd-warning-detail <cnt>] [--srs-mung] [--syslog-name=string]
- [-u|--user-cnt <cnt>] [--unprocd-file <filename> ] [--use-orig-to]
- [--verbose-msg-detail] [--verp-mung[=<n>]] [-x|--debug] [--zero-fill]
- [file1 [filen]]
+ [--smtpd-stats] [--srs-mung] [--ssl-tls-stats] [--syslog-name <string>]
+ [-u|--user-cnt <cnt>] [--unprocd-file <filename>] [--use-orig-to]
+ [--verbose-msg-detail] [--verp-mung [n]] [--warning-detail <cnt>]
+ [-x|--debug <file>] [--zero-fill] [file1 [filen]]
pflogsumm --[dump-config|help|version]
latter are shown above. See man page for long-form equivalents.
If no file(s) specified, reads from stdin. Output is to stdout. Errors
- and debug to stderr.
+ to stderr.
=head1 DESCRIPTION
"2025-07 - 2025-08" == 2025-07-01 - 2025-08-31
- --debug Enable debugging to STDERR
+ --debug <file>
+ Enable debugging to <file>
See Also: -x
--smtp-detail <cnt>
- Limit detailed smtp delivery reports to the top <cnt>.
- 0 to suppress entirely.
+ Deprecated
--smtpd-stats
Generate smtpd connection statistics.
--smtpd-warning-detail <cnt>
+ Deprecated. Use --warning-detail instead.
+
Limit detailed smtpd warnings reports to the top <cnt>.
0 to suppress entirely.
See the discussion about the use of this option under
"NOTES," below.
+ --ssl-tls-stats
+
+ Report SMTP TLS statistics and SMTPD SSL/TLS errors.
+
-u <cnt>
--user-cnt <cnt>
Note: this can result in quite long lines in the report.
- --verp-mung
- --verp-mung=2
- Do "VERP" generated address (?) munging. Convert
- sender addresses of the form
+ --verp-mung [n]
+
+ If n = 1 or is not provided, perform basic "VERP"
+ address munging, converting sender addresses of the form
+
"list-return-NN-someuser=some.dom@host.sender.dom"
+
to
+
"list-return-ID-someuser=some.dom@host.sender.dom"
In other words: replace the numeric value with "ID".
- By specifying the optional "=2" (second form), the
- munging is more "aggressive", converting the address
- to something like:
+ If n = 2, the munging is more "aggressive", converting the
+ address to something like:
"list-return@host.sender.dom"
- Actually: specifying anything less than 2 does the
- "simple" munging and anything greater than 1 results
- in the more "aggressive" hack being applied.
-
See "NOTES" regarding this option.
--version Print program name and version and bail out.
- -x Enable debugging to STDERR
+ --warning-detail <cnt>
+
+ Limit detailed warnings reports to the top <cnt>.
+ 0 to suppress entirely.
+
+ -x <file> Enable debugging to <file>
See Also: --debug
my $haveConfigSimple = $@ ? 0 : 1;
my $mailqCmd = "mailq";
-my $release = "1.1.14";
+my $release = "1.1.15";
+
+# Used for regression testing, so new features can be selectively
+# disabled.
+my $regtest = $ENV{'PFLOGSUMM_REGTEST'};
# Variables and constants used throughout pflogsumm
our (
};
my (
- $svc, $qid, $addr, $orig_to, $size, $relay, $status, $delay, $tls,
+ $svc, $qid, $addr, $orig_to, $size, $relay, $status, $delay, $tls, %tlsStats,
$strtDate, $endDate,
%panics, %fatals, %warnings, %masterMsgs,
%deferred, %bounced, %expired,
$msgYr,
$revMsgDateStr, $dayCnt, %msgsPerDay,
%rejects, $msgsRjctd,
- %warns, $msgsWrnd,
+ %rejWarns, $msgsWrnd,
%discards, $msgsDscrdd,
%holds, $msgsHld,
%rcvdMsg, $msgsFwdd, $msgsBncd, $msgsExprd,
$msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
%connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
+ %inboundSSLerrs,
%pscrnConnTime, %pscrnPerDay, %pscrnPerIP, $pscrnConnCnt, $pscrnTotTime,
- %smtpMsgs, $sizeDataExists, @deprecated
+ %smtpExcptnMsgs, $sizeDataExists, @deprecated
);
$dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
"usage: $progName [--config <file>] [--bounce-detail <cnt>] [--colwidth <n>]
[-d|--date-range <date [range]>] [--deferral-detail <cnt>]
[--detail <cnt>] [--dow0mon] [-e|--extended-detail]
- [--expired-detail <cnt> ] [-h|--host-cnt <cnt>] [-i|--ignore-case]
+ [--expired-detail <cnt>] [-h|--host-cnt <cnt>] [-i|--ignore-case]
[--iso-date-time] [-m|--uucp-mung] [--mailq] [--no-no-msg-size]
[--problems-first] [--pscrn-detail <cnt>] [--pscrn-stats]
[-q|--quiet] [--rej-add-from] [--rej-add-to] [--reject-detail <cnt>]
- [--smtp-detail <cnt>] [--smtpd-stats]
- [--smtpd-warning-detail <cnt>] [--srs-mung] [--syslog-name=string]
- [-u|--user-cnt <cnt>] [--unprocd-file <filename> ] [--use-orig-to]
- [--verbose-msg-detail] [--verp-mung[=<n>]] [-x|--debug] [--zero-fill]
- [file1 [filen]]
+ [--smtpd-stats] [--srs-mung] [--ssl-tls-stats] [--syslog-name <string>]
+ [-u|--user-cnt <cnt>] [--unprocd-file <filename>] [--use-orig-to]
+ [--verbose-msg-detail] [--verp-mung [n]] [--warning-detail <cnt>]
+ [-x|--debug <file>] [--zero-fill] [file1 [filen]]
$progName --[dump-config|help|version]";
'colwidth' => { type => 'i' },
'config' => { type => 's' }, # not exposed as CLI short option
'date-range' => { type => 's', short => 'd' },
- 'debug' => { type => 'b', short => 'x' },
+ 'debug' => { type => 's', short => 'x' },
'deferral-detail' => { type => 'i' },
'detail' => { type => 'i' },
'dow0mon' => { type => 'b' },
'mailq' => { type => 'b' },
'no-no-msg-size' => { type => 'b' },
'problems-first' => { type => 'b' },
- 'pscrn-detail' => { type => 'i' }, # optional arg
+ 'pscrn-detail' => { type => 'i' },
'pscrn-stats' => { type => 'b' },
'quiet' => { type => 'b', short => 'q' },
'rej-add-from' => { type => 'b' },
'smtpd-warning-detail' => { type => 'i' },
'srs-mung' => { type => 'b' },
'syslog-name' => { type => 's' },
+ 'ssl-tls-stats' => { type => 'b' },
'unprocd-file' => { type => 's' },
'use-orig-to' => { type => 'b' },
'user-cnt' => { type => 'i', short => 'u' },
'uucp-mung' => { type => 'b', short => 'm' },
'verbose-msg-detail' => { type => 'b' },
- 'verp-mung' => { type => 'i' }, # optional arg
+ 'verp-mung' => { type => 'i', valopt => '1' }, # value is optional
'version' => { type => 'b' },
+ 'warning-detail' => { type => 'i' },
'zero-fill' => { type => 'b' },
);
my $type = $optionSpec{$long}->{type};
my $short = $optionSpec{$long}->{short};
+ my $valOpt = exists $optionSpec{$long}->{valopt} && $optionSpec{$long}->{valopt}
+ ? ":"
+ : "=";
+
my $opt_string = $long;
if ($type eq 'f') {
- $opt_string .= "=s";
+ $opt_string .= "${valOpt}s";
} elsif ($type ne 'b') {
- $opt_string .= "=$type";
+ $opt_string .= "${valOpt}$type";
}
+
push @getopt_args, $opt_string => \$opts{$long};
if (defined $short) {
GetOptions(@getopt_args) or die "Invalid command-line arguments\n\n$usageMsg\n";
+# These options are going away
+unless($regtest) {
+ push @deprecated, 'Option "--smtp-detail" deprecated (no longer has any effect)' if $opts{'smtp-detail'};
+ push @deprecated, 'Option "--smtpd-warning-detail" deprecated - use --warning-detail' if $opts{'smtpd-warning-detail'};
+}
+
+# This is temporary—until the deprecated option --smtpd-warning-detail is removed
+$opts{'warning-detail'} = $opts{'smtpd-warning-detail'} if($opts{'smtpd-warning-detail'});
+
+#
+# Get debugging wound-up right out of the gate
+#
+my $dbg_fh;
+
+if (defined $opts{debug}) {
+ open($dbg_fh, '>', $opts{debug})
+ or die "Cannot open debug file \"$opts{debug}\": $!";
+}
+
+sub dbg {
+ return unless $dbg_fh;
+ print $dbg_fh @_;
+}
+
#
# internally: 0 == none, undefined == -1 == all
#
$opts{'colwidth'} = 0 if($opts{'verbose-msg-detail'}); # This one's a bit different
-foreach my $optName (qw(bounce-detail colwidth deferral-detail expired-detail host-cnt pscrn-detail reject-detail smtp-detail smtpd-warning-detail user-cnt)) {
+foreach my $optName (qw(bounce-detail colwidth deferral-detail expired-detail host-cnt pscrn-detail reject-detail warning-detail user-cnt)) {
$opts{$optName} = -1 unless(defined($opts{$optName}));
}
# If --detail was specified, set anything that's not enumerated to it
if(defined($opts{'detail'})) {
- foreach my $optName (qw (bounce-detail deferral-detail expired-detail host-cnt pscrn-detail reject-detail smtp-detail smtpd-warning-detail user-cnt)) {
+ foreach my $optName (qw (bounce-detail deferral-detail expired-detail host-cnt pscrn-detail reject-detail warning-detail user-cnt)) {
$opts{$optName} = $opts{'detail'} unless($opts{"$optName"} != -1);
}
}
while(<>) {
s/: \[ID \d+ [^\]]+\] /: /; # lose "[ID nnnnnn some.thing]" stuff
- my $logRmdr;
+ my ($logRmdr, $pid);
next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) = line_matches_dates($_, $strtDate, $endDate)) == 7);
# Snag last date seen
($thruDate{'yr'}, $thruDate{'mon'}, $thruDate{'day'}) = ($msgYr, $msgMon, $msgDay);
- unless((($svc, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)(?:/(?:smtps|submission))?/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
- (($svc, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
+ unless((($svc, $pid, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)(?:/(?:smtps|submission))?/([^\[]+)\[(\d+)\]:?\s+(?:-\s+)?([^:\s]+):?\s#o) == 3 ||
+ (($svc, $pid, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[(\d+)\])?:?\s+(?:-\s+)?([^:\s]+):?\s#o) == 3)
{
- print $unProcd "[01]: $_" if $unProcd;
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_" if($unProcd && ($logRmdr =~ /postfix/));
next;
}
chomp;
+ $logRmdr =~ s/^.*?\[\d+\]:?\h+(?:-\s+)?(?:(?:NOQUEUE|[0-9A-F]+|[0-9B-DF-HJ-NP-TV-Zb-df-hj-np-tv-z]+):\h+)?//;
# the following test depends on one getting more than one message a
# month--or at least that successive messages don't arrive on the
}
}
- # regexp rejects happen in "cleanup"
- if($svc eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
- /\/cleanup\[\d+\]: .*?\b((?:milter-)?reject|warning|hold|discard): (header|body|END-OF-MESSAGE) (.*)$/) == 3)
+ if(my ($wpfClass, $wpfPayload) = $logRmdr =~ /^(warning|panic|fatal):\s+(.+)$/)
+ {
+ # Cleanup is a special case, as are panics and fatals for any service
+ unless($svc eq 'cleanup' || $wpfClass eq 'panic' || $wpfClass eq 'fatal') {
+ # Condense smtpd and other warnings
+ $wpfPayload =~ s/^(Unable to look up (?:MX|NS) host) for .+(: Host not found(?:,try again)?)/$1$2/ ||
+ $wpfPayload =~ s/^(hostname ).+ (does not resolve to address) [0-9A-F:\.]+$/$1$2/ ||
+ $wpfPayload =~ s/^(hostname ).+ (does not resolve to address) .+(: hostname nor servname provided, or not known)$/$1$2$3/ ||
+ $wpfPayload =~ s/^(Unable to look up (?:MX|NS) host ).+ (for (?:Sender address|Client host|Helo command)) .+(: (?:hostname nor servname provided, or not known|No address associated with hostname))$/$1$2$3/ ||
+ $wpfPayload =~ s/^(malformed domain name in resource data of MX record) for .*$/$1/ ||
+ $wpfPayload =~ s/^(numeric domain name in resource data of (?:MX|NS) record) for .*$/$1/ ||
+ $wpfPayload =~ s/^(numeric hostname): .*$/$1/ ||
+ $wpfPayload =~ s/^(valid_hostname: invalid character) .*$/$1/ ||
+ $wpfPayload =~ s/^[0-9A-F:\.]+ (address not listed for hostname) .*$/$1/ ||
+ $wpfPayload =~ s/^[0-9A-F]+: (queue file size limit exceeded)$/$1/ ||
+ $wpfPayload =~ s/^[^:]+: (SASL (?:LOGIN|PLAIN|CRAM-MD5) authentication failed(?:: Invalid authentication mechanism)?).*$/$1/ ||
+ $wpfPayload =~ s/^(Illegal address syntax )from .+ (in (?:MAIL|RCPT) command): .*$/$1$2/ ||
+ $wpfPayload =~ s/^(non-SMTP command) from .+?(: \S+) .*$/$1$2/ ||
+ $wpfPayload =~ s/^(Connection concurrency limit exceeded: \d+ )from \S+ (for service .+)$/$1$2/ ||
+ $wpfPayload =~ s/^[0-9A-F:\.]+ (hostname ).+ (verification failed: No address associated with hostname)$/$1$2/ ||
+ $wpfPayload =~ s/^[\w\.-]+: (RBL lookup error: Host or domain name not found. Name service error )for name=[\w\.-]+ (type=.+: Host not found, try again)$/$1$2/ ||
+ $wpfPayload =~ s/^.+((?:postfix-)?policyd-spf-perl: process )id \d+: (command time limit exceeded)$/$1$2/ ||
+ $wpfPayload =~ s/(process .+) pid \d+ (exit status \d+)/$1 $2/;
+ }
+
+ if($wpfClass eq 'warning') {
+ $wpfPayload = string_trimmer($wpfPayload, 66);
+ ++$warnings{$svc}{$wpfPayload};
+ } elsif($wpfClass eq 'panic') {
+ ++$panics{$svc}{$wpfPayload};
+ } elsif($wpfClass eq 'fatal') {
+ ++$fatals{$svc}{$wpfPayload};
+ } else {
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_\n" if $unProcd;
+ }
+ }
+ # header and body checks rejects happen in "cleanup"
+ elsif($svc eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
+ /^((?:milter-)?reject|hold|discard): (header|body|END-OF-MESSAGE) (.*)$/) == 3)
{
$rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbose-msg-detail'});
# FIXME: In retrospect: I've no idea where I came up with the magic numbers I pass to this function.
if($opts{'debug'}) {
push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd");
++$qidTracker{$qid}{'lateRejects'};
- print STDERR "dbg: late reject \$rcvdMsg{$qid}{'size'}: $rcvdMsg{$qid}{'size'}\n" if $rcvdMsg{$qid}{'size'};
+ dbg("dbg: late reject \$rcvdMsg{$qid}{'size'}: $rcvdMsg{$qid}{'size'}\n") if $rcvdMsg{$qid}{'size'};
}
--$msgsRcvd; # Late Reject: It will have already been counted as "Received," even though it ultimately is not
- } elsif($rejSubTyp eq "warning") {
- ++$warns{$svc}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
- ++$msgsWrnd;
} elsif($rejSubTyp eq "hold") {
++$holds{$svc}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
++$msgsHld;
delete($rcvdMsg{$qid}); # We're done with this
++$rejPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[4];
- } elsif($qid eq 'warning') {
- (my $warnReas = $logRmdr) =~ s/^.*warning: //;
- unless($opts{'verbose-msg-detail'}) {
- # Condense smtpd and other warnings
- $warnReas =~ s/^(Unable to look up (?:MX|NS) host) for .+(: Host not found(?:,try again)?)/$1$2/ ||
- $warnReas =~ s/^(hostname ).+ (does not resolve to address) [0-9A-F:\.]+$/$1$2/ ||
- $warnReas =~ s/^(hostname ).+ (does not resolve to address) .+(: hostname nor servname provided, or not known)$/$1$2$3/ ||
- $warnReas =~ s/^(Unable to look up (?:MX|NS) host ).+ (for (?:Sender address|Client host|Helo command)) .+(: (?:hostname nor servname provided, or not known|No address associated with hostname))$/$1$2$3/ ||
- $warnReas =~ s/^(malformed domain name in resource data of MX record) for .*$/$1/ ||
- $warnReas =~ s/^(numeric domain name in resource data of (?:MX|NS) record) for .*$/$1/ ||
- $warnReas =~ s/^(numeric hostname): .*$/$1/ ||
- $warnReas =~ s/^(valid_hostname: invalid character) .*$/$1/ ||
- $warnReas =~ s/^[0-9A-F:\.]+ (address not listed for hostname) .*$/$1/ ||
- $warnReas =~ s/^[0-9A-F]+: (queue file size limit exceeded)$/$1/ ||
- $warnReas =~ s/^[^:]+: (SASL (?:LOGIN|PLAIN|CRAM-MD5) authentication failed(?:: Invalid authentication mechanism)?).*$/$1/ ||
- $warnReas =~ s/^(Illegal address syntax )from .+ (in (?:MAIL|RCPT) command): .*$/$1$2/ ||
- $warnReas =~ s/^(non-SMTP command) from .+?(: \S+) .*$/$1$2/ ||
- $warnReas =~ s/^(Connection concurrency limit exceeded: \d+ )from \S+ (for service .+)$/$1$2/ ||
- $warnReas =~ s/^[0-9A-F:\.]+ (hostname ).+ (verification failed: No address associated with hostname)$/$1$2/ ||
- $warnReas =~ s/^[\w\.-]+: (RBL lookup error: Host or domain name not found. Name service error )for name=[\w\.-]+ (type=.+: Host not found, try again)$/$1$2/ ||
- $warnReas =~ s/^.+((?:postfix-)?policyd-spf-perl: process )id \d+: (command time limit exceeded)$/$1$2/ ||
- $warnReas =~ s/(process .+) pid \d+ (exit status \d+)/$1 $2/;
- }
- $warnReas = string_trimmer($warnReas, 66);
- unless($svc eq "smtpd" && $opts{'smtpd-warning-detail'} == 0) {
- ++$warnings{$svc}{$warnReas};
- }
- } elsif($qid eq 'fatal') {
- (my $fatalReas = $logRmdr) =~ s/^.*fatal: //;
- $fatalReas = string_trimmer($fatalReas, 66);
- ++$fatals{$svc}{$fatalReas};
- } elsif($qid eq 'panic') {
- (my $panicReas = $logRmdr) =~ s/^.*panic: //;
- $panicReas = string_trimmer($panicReas, 66);
- ++$panics{$svc}{$panicReas};
- } elsif($qid eq 'reject') {
- proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr],
- \${$msgsPerDay{$revMsgDateStr}}[4]);
- } elsif($qid eq 'reject_warning') {
- proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr],
- \${$msgsPerDay{$revMsgDateStr}}[4]);
- } elsif($qid eq 'hold') {
- proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr],
- \${$msgsPerDay{$revMsgDateStr}}[4]);
- } elsif($qid eq 'discard') {
- proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr],
- \${$msgsPerDay{$revMsgDateStr}}[4]);
} elsif($svc eq 'master') {
- ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
+ ++$masterMsgs{$logRmdr};
} elsif($svc eq 'smtpd' || $svc eq 'postscreen' || $svc eq 'pickup') {
- if((my ($clientInfo)) = $logRmdr =~ /(?|\[\d+\]: \w+: client=(.+?)(?:,|$)|\/(pickup)\[\d+\]: \w+: (?:sender|uid)=)/) {
+ if(($svc eq 'pickup' && $logRmdr =~ /^(sender|uid)=/) || ((my ($clientInfo)) = $logRmdr =~ /^client=(.+?)(?:,|$)/)) {
++$rcvPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[0];
if($opts{'debug'}) {
++$qidTracker{$qid}{'rcvdCnt'};
}
++$msgsRcvd;
- $rcvdMsg{$qid}{'whence'} = $clientInfo eq 'pickup'? $clientInfo : gimme_domain($clientInfo); # Whence it came
- } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /) {
+ $rcvdMsg{$qid}{'whence'} = $svc eq 'pickup'? $svc : gimme_domain($clientInfo); # Whence it came
+ } elsif(my($rejSubTyp) = $logRmdr =~ /^(reject(?:_warning)?|hold|discard): /) {
if($rejSubTyp eq 'reject') {
proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
\$rejPerHr[$msgHr],
if($opts{'debug'}) {
push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd");
++$qidTracker{$qid}{'lateRejects'};
- print STDERR "dbg: late reject \$rcvdMsg{$qid}{'size'}: $rcvdMsg{$qid}{'size'}\n" if $rcvdMsg{$qid}{'size'};
+ dbg("dbg: late reject \$rcvdMsg{$qid}{'size'}: $rcvdMsg{$qid}{'size'}\n") if $rcvdMsg{$qid}{'size'};
}
--$msgsRcvd # Late reject: It's been counted as received already
}
delete($rcvdMsg{$qid}) if($rcvdMsg{$qid}); # Late Reject: If it's rejected later in the game
} elsif($rejSubTyp eq 'reject_warning') {
- proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
+ proc_smtpd_reject($logRmdr, \%rejWarns, \$msgsWrnd,
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
} elsif($rejSubTyp eq 'hold') {
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
}
- }
- else {
+ } else {
if($svc eq 'smtpd') {
- next unless(defined($opts{'smtpd-stats'}));
- if($logRmdr =~ /: connect from /) {
- $logRmdr =~ /\/smtpd\[(\d+)\]: /;
- @{$connTime{$1}} =
- ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
- } elsif($logRmdr =~ /: disconnect from /) {
- my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+?)( unknown=\d+\/\d+)?( commands=\d+\/\d+)?$/;
- if(exists($connTime{$pid}) && ($hostID = gimme_domain($hostID))) {
- my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
- $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
- delete($connTime{$pid}); # dispose of no-longer-needed item
- my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
-
- ++$smtpdPerHr[$msgHr][0];
- $smtpdPerHr[$msgHr][1] += $tSecs;
- $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
-
- unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
- ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
- ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
- }
+ if(my ($msg, $client, $msgP2) = $logRmdr =~ /^(.*?(?:SSL|STARTTLS).*?)\s+from\s+(\S+\[[^\]]+\])(?::\s+(.+))?$/) {
+ # Collect inbound SSL/TLS exceptions/errors
+ $msg .= " $msgP2" if defined $msgP2;
+ ++$inboundSSLerrs{$msg}{gimme_domain($client)};
+ } else {
+ next unless(defined($opts{'smtpd-stats'}));
+ if($logRmdr =~ /^connect from /) {
+ @{$connTime{$pid}} =
+ ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
+ } elsif($logRmdr =~ /^disconnect from /) {
+ my ($hostID) = $logRmdr =~ /^disconnect from (.+?)( unknown=\d+\/\d+)?( commands=\d+\/\d+)?$/;
+ if(exists($connTime{$pid}) && ($hostID = gimme_domain($hostID))) {
+ my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
+ $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
+ delete($connTime{$pid}); # dispose of no-longer-needed item
+ my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
- ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
- ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
- if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
+ ++$smtpdPerHr[$msgHr][0];
+ $smtpdPerHr[$msgHr][1] += $tSecs;
+ $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
- if($hostID){
- unless(${$smtpdPerDom{$hostID}}[0]++) {
- ${$smtpdPerDom{$hostID}}[1] = 0;
- ${$smtpdPerDom{$hostID}}[2] = 0;
+ unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
+ ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
+ ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
+ }
+
+ ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
+ ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
+ if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
+
+ if($hostID){
+ unless(${$smtpdPerDom{$hostID}}[0]++) {
+ ${$smtpdPerDom{$hostID}}[1] = 0;
+ ${$smtpdPerDom{$hostID}}[2] = 0;
+ }
+ ${$smtpdPerDom{$hostID}}[1] += $tSecs;
+ ${$smtpdPerDom{$hostID}}[2] = $tSecs
+ if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
}
- ${$smtpdPerDom{$hostID}}[1] += $tSecs;
- ${$smtpdPerDom{$hostID}}[2] = $tSecs
- if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
- }
- ++$smtpdConnCnt;
- $smtpdTotTime += $tSecs;
+ ++$smtpdConnCnt;
+ $smtpdTotTime += $tSecs;
+ }
+ } else {
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_\n" if $unProcd;
}
}
} elsif($svc eq 'postscreen' && (defined $opts{'pscrn-stats'} || $opts{'pscrn-detail'})) {
my ($pscrnAct, $clientIP, $clientPort, $pscrnAddl, $capCnt);
- print STDERR "\n" if($opts{'debug'});
- print STDERR "\$opts{'pscrn-stats'}: " . ($opts{'pscrn-stats'} // 0) .", \$opts{'pscrn-detail'}: $opts{'pscrn-detail'}\n" if($opts{'debug'});
+ dbg("\n") if($opts{'debug'});
+ dbg("dbg: \$opts{'pscrn-stats'}: " . ($opts{'pscrn-stats'} // 0) .", \$opts{'pscrn-detail'}: $opts{'pscrn-detail'}\n") if($opts{'debug'});
foreach my $regEx (@pscrnRegexs) {
- print STDERR "\$regEx->{'expr'}: \"$regEx->{'expr'}\"\n" if($opts{'debug'});
+ dbg("dbg: \$regEx->{'expr'}: \"$regEx->{'expr'}\"\n") if($opts{'debug'});
if(($capCnt = (($pscrnAct, $clientIP, $clientPort, $pscrnAddl) = $logRmdr =~ /$regEx->{'expr'}/)) >= 3) {
++$regEx->{'cnt'}; # Not (currently?) used
if($opts{'debug'}) {
foreach ($pscrnAct, $clientIP, $clientPort, $pscrnAddl) {
- print STDERR "capt: \"$_\"\n" if(defined $_ );
+ dbg("dbg: capt: \"$_\"\n") if(defined $_ );
}
}
last;
}
}
- print STDERR "\$capCnt: $capCnt\n\$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
+ dbg("dbg: \$capCnt: $capCnt\n\$logRmdr: \"$logRmdr\"\n") if($opts{'debug'});
my $bump_capt_cnt = sub {
if($capCnt == 4) {
- print STDERR "Bumping \$pscrnHits{\"$pscrnAct $pscrnAddl\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
+ dbg("dbg: Bumping \$pscrnHits{\"$pscrnAct $pscrnAddl\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n") if($opts{'debug'});
++$pscrnHits{"$pscrnAct $pscrnAddl"}{$clientIP} if($opts{'pscrn-detail'});
- print STDERR "\$svc: \"$svc\", \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
+ dbg("dbg: \$svc: \"$svc\", \$logRmdr: \"$logRmdr\"\n") if($opts{'debug'});
} else {
- print STDERR "Bumping \$pscrnHits{\"$pscrnAct\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
+ dbg("dbg: Bumping \$pscrnHits{\"$pscrnAct\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n") if($opts{'debug'});
++$pscrnHits{$pscrnAct}{$clientIP} if($opts{'pscrn-detail'});
- print STDERR "\$svc: \"$svc\", \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
+ dbg("dbg: \$svc: \"$svc\", \$logRmdr: \"$logRmdr\"\n") if($opts{'debug'});
}
};
if($pscrnAct eq 'CONNECT') {
@{$connTime{"$clientIP:$clientPort"}} =
($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
- print STDERR "\@{\$connTime{\"$clientIP:$clientPort\"}}: " . join(' / ', @{$connTime{"$clientIP:$clientPort"}}) . "\n" if($opts{'debug'});
+ dbg("dbg: \@{\$connTime{\"$clientIP:$clientPort\"}}: " . join(' / ', @{$connTime{"$clientIP:$clientPort"}}) . "\n") if($opts{'debug'});
} elsif($pscrnAct =~ /^(DISCONNECT|HANGUP|PASS (NEW|OLD))$/) {
- print STDERR "DISCO: \$pscrnAct: \"$pscrnAct\", \$clientIP: \"$clientIP\", \$clientPort: \"$clientPort\"\n" if($opts{'debug'});
+ dbg("dbg: DISCO: \$pscrnAct: \"$pscrnAct\", \$clientIP: \"$clientIP\", \$clientPort: \"$clientPort\"\n") if($opts{'debug'});
if(exists($connTime{"$clientIP:$clientPort"})) {
my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{"$clientIP:$clientPort"}},
$msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
delete($connTime{"$clientIP:$clientPort"}); # dispose of no-longer-needed item
my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
- print STDERR "DISCONNECT: \$tSecs: $tSecs\n" if($opts{'debug'});
+ dbg("dbg: DISCONNECT: \$tSecs: $tSecs\n") if($opts{'debug'});
++$pscrnPerHr[$msgHr][0];
$pscrnPerHr[$msgHr][1] += $tSecs;
} elsif($capCnt == 4) {
$bump_capt_cnt->() if($opts{'pscrn-detail'}); # Want the per-postscreen-action stats?
} else {
- print $unProcd "[02]: $_\n" if($unProcd && (defined $opts{'pscrn-stats'} || $opts{'pscrn-detail'}));
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_\n" if($unProcd && (defined $opts{'pscrn-stats'} || $opts{'pscrn-detail'}));
}
}
}
- } else {
- my $toRmdr;
- if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/) == 2)
+ } elsif(((
+ $addr,
+ $orig_to,
+ $relay,
+ $delay,
+ $tls, # <— new optional capture
+ $status,
+ my $toRmdr
+ ) = $logRmdr =~ m{^
+ to=<([^>]*)>,\s+
+ (?:orig_to=<([^>]*)>,\s+)? # optional
+ relay=([^,]+),\s+
+ (?:conn_use=[^,]+,\s+)? # optional
+ delay=([^,]+),\s+
+ (?:delays=[^,]+,\s+)? # optional
+ (?:tls=([^,]+),\s+)? # <— optional tls=... (captures if present)
+ (?:dsn=[^,]+,\s+)? # optional
+ status=(\S+)(.*)$
+ }x) >= 4)
+ {
+ # This is seen with both delivery svcs (smtp, local, virtual, pipe, lmtp, etc.),
+ # and sometimes qmgr. So this signature test *has* to be performed before checking
+ # for service = qmgr.
+ # N.B.: Since more delivery services may appear, we'll leave $svc out of it and
+ # rely on the delivery signature.
+
+ $relay =~ s/:\d+$//; # strip trailing :port only
+ $addr = $orig_to if($opts{'use-orig-to'} && $orig_to);
+
+ if($opts{'uucp-mung'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
+ $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
+ }
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'ignore-case'});
+ $addr = lc($addr) if($opts{'ignore-case'});
+ $relay = lc($relay) if($opts{'ignore-case'});
+ my $domAddr = fold_domain($addr); # get domain only
+ if($status eq 'sent') {
+
+ # was it actually forwarded, rather than delivered?
+ if(my ($newQid) = $toRmdr =~ /\(forwarded as ([^\)]+)\)/) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, forwarded as new qid $1, ++\$msgsFwdd") if $opts{'debug'};
+ ++$msgsFwdd;
+ delete($rcvdMsg{$qid}); # We're done with this
+ next;
+ }
+ ++$recipDomCnt unless(${$recipDom{$domAddr}}[MSG_CNT_I]);
+ ++${$recipDom{$domAddr}}[MSG_CNT_I];
+ ${$recipDom{$domAddr}}[MSG_DLY_AVG_I] += $delay;
+ if(! ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] ||
+ $delay > ${$recipDom{$domAddr}}[MSG_DLY_MAX_I])
+ {
+ ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] = $delay
+ }
+ ++$recipUserCnt unless(${$recipUser{$addr}}[MSG_CNT_I]);
+ ++${$recipUser{$addr}}[MSG_CNT_I];
+ ++$dlvPerHr[$msgHr];
+ ++${$msgsPerDay{$revMsgDateStr}}[1];
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsDlvrd");
+ ++$qidTracker{$qid}{'dlvrdCnt'};
+ }
+ ++$msgsDlvrd;
+ if($rcvdMsg{$qid}{'size'}) {
+ ${$recipDom{$domAddr}}[MSG_SIZE_I] += $rcvdMsg{$qid}{'size'};
+ ${$recipUser{$addr}}[MSG_SIZE_I] += $rcvdMsg{$qid}{'size'};
+ $sizeDlvrd += $rcvdMsg{$qid}{'size'};
+ } else {
+ ${$recipDom{$domAddr}}[MSG_SIZE_I] += 0;
+ ${$recipUser{$addr}}[MSG_SIZE_I] += 0;
+ $noMsgSize{$qid} = $addr unless($opts{'no-no-msg-size'});
+ push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'extended-detail'});
+ # put this back later? mebbe with -v?
+ # msg_warn("no message size for qid: $qid");
+ }
+ push(@{$msgDetail{$qid}}, $addr) if($opts{'extended-detail'});
+ } elsif($status eq 'deferred') {
+ unless($opts{'deferral-detail'} == 0) {
+ my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
+ if(!defined($opts{'verbose-msg-detail'})) {
+ my ($host, $reason, $moreReason); # More ugliness :/
+ unless((($host, $reason) = $deferredReas =~ /^host (\S+) (?:said|refused to talk to me): ([^(]+)/) ||
+ (($host, $reason) = $deferredReas =~ /^(?:delivery temporarily suspended: )?connect to (.+?(?::\d+)?): ([^\)]+)$/) ||
+ (($host, $reason) = $deferredReas =~ /^cannot (?:append to file|update mailbox) ([^:.]+)[:.] (.+)$/) ||
+ (($reason, $host, $moreReason) = $deferredReas =~ /^.*(Name service error )for (?:domain |name=)?([^: ]+):? (.+)$/) ||
+ (($reason, $host, $moreReason) = $deferredReas =~ /^((?:conversation|lost connection) )with (\S+) ((?:timed out )?while (receiving|sending) .+)$/) ||
+ (($reason, $host, $moreReason) = $deferredReas =~ /^(delivery temporarily suspended: )connect to ([^:]+): (.+)$/)
+ )
+ {
+ $host = "(unknown host)";
+ $reason = $deferredReas;
+ }
+ $host = gimme_domain($host, 1);
+
+ $reason .= $moreReason if($moreReason); # ick
+ # Finally...
+ $reason = said_string_trimmer($reason, 66);
+ ++$deferred{$svc}{$host}{$reason};
+ } else {
+ ++$deferred{$svc}{$deferredReas};
+ }
+ }
+ ++$dfrPerHr[$msgHr];
+ ++${$msgsPerDay{$revMsgDateStr}}[2];
+ push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsDfrd") if $opts{'debug'};
+ ++$msgsDfrdCnt;
+ ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
+ ++${$recipDom{$domAddr}}[MSG_DFRS_I];
+ if(! ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] ||
+ $delay > ${$recipDom{$domAddr}}[MSG_DLY_MAX_I])
+ {
+ ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] = $delay
+ }
+ # For "expired" detail reports
+ if($rcvdMsg{$qid}) {
+ $rcvdMsg{$qid}{'relay'} = $relay;
+ }
+ } elsif($status eq 'bounced') {
+ unless($opts{'bounce-detail'} == 0) {
+ my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
+ unless(defined($opts{'verbose-msg-detail'})) {
+ $bounceReas = said_string_trimmer($bounceReas, 66);
+ }
+ ++$bounced{gimme_domain($relay, 1)}{$bounceReas};
+ }
+ ++$bncPerHr[$msgHr];
+ ++${$msgsPerDay{$revMsgDateStr}}[3];
+ push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsBncd") if $opts{'debug'};
+ ++$msgsBncd;
+ } else {
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_\n" if $unProcd;
+ }
+
+ if(defined($tls)) {
+ my ($level, @policies) = split m{/}, $tls;
+ ++$tlsStats{$level}{gimme_domain($relay, 1)};
+ }
+ } elsif($svc eq 'qmgr' || $svc eq 'nqmgr') {
+ # This is seen only if $svc eq 'qmgr' or 'nqmgr'
+ if((($addr, $size) = $logRmdr =~ /^from=<([^>]*)>, size=(\d+)/) == 2)
{
++$sizeDataExists; # Flag for orphan rcvdMsg cleanup: Older logs won't have size data
next if($rcvdMsg{$qid}{'size'}); # avoid double-counting!
$sizeRcvd += $size;
}
}
- elsif(((
- $addr,
- $orig_to,
- $relay,
- $delay,
- $tls, # <— new optional capture
- $status,
- $toRmdr
- ) = $logRmdr =~ m{
- to=<([^>]*)>,\s+
- (?:orig_to=<([^>]*)>,\s+)? # optional
- relay=([^,]+),\s+
- (?:conn_use=[^,]+,\s+)? # optional
- delay=([^,]+),\s+
- (?:delays=[^,]+,\s+)? # optional
- (?:tls=([^,]+),\s+)? # <— optional tls=... (captures if present)
- (?:dsn=[^,]+,\s+)? # optional
- status=(\S+)(.*)$
- }x) >= 4)
- {
- $addr = $orig_to if($opts{'use-orig-to'} && $orig_to);
-
- if($opts{'uucp-mung'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
- $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
- }
- $addr =~ s/(@.+)/\L$1/ unless($opts{'ignore-case'});
- $addr = lc($addr) if($opts{'ignore-case'});
- $relay = lc($relay) if($opts{'ignore-case'});
- my $domAddr = fold_domain($addr); # get domain only
- if($status eq 'sent') {
-
- # was it actually forwarded, rather than delivered?
- if(my ($newQid) = $toRmdr =~ /\(forwarded as ([^\)]+)\)/) {
- push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, forwarded as new qid $1, ++\$msgsFwdd") if $opts{'debug'};
- ++$msgsFwdd;
- delete($rcvdMsg{$qid}); # We're done with this
- next;
- }
- ++$recipDomCnt unless(${$recipDom{$domAddr}}[MSG_CNT_I]);
- ++${$recipDom{$domAddr}}[MSG_CNT_I];
- ${$recipDom{$domAddr}}[MSG_DLY_AVG_I] += $delay;
- if(! ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] ||
- $delay > ${$recipDom{$domAddr}}[MSG_DLY_MAX_I])
- {
- ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] = $delay
- }
- ++$recipUserCnt unless(${$recipUser{$addr}}[MSG_CNT_I]);
- ++${$recipUser{$addr}}[MSG_CNT_I];
- ++$dlvPerHr[$msgHr];
- ++${$msgsPerDay{$revMsgDateStr}}[1];
- if($opts{'debug'}) {
- push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsDlvrd");
- ++$qidTracker{$qid}{'dlvrdCnt'};
- }
- ++$msgsDlvrd;
- if($rcvdMsg{$qid}{'size'}) {
- ${$recipDom{$domAddr}}[MSG_SIZE_I] += $rcvdMsg{$qid}{'size'};
- ${$recipUser{$addr}}[MSG_SIZE_I] += $rcvdMsg{$qid}{'size'};
- $sizeDlvrd += $rcvdMsg{$qid}{'size'};
- } else {
- ${$recipDom{$domAddr}}[MSG_SIZE_I] += 0;
- ${$recipUser{$addr}}[MSG_SIZE_I] += 0;
- $noMsgSize{$qid} = $addr unless($opts{'no-no-msg-size'});
- push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'extended-detail'});
- # put this back later? mebbe with -v?
- # msg_warn("no message size for qid: $qid");
- }
- push(@{$msgDetail{$qid}}, $addr) if($opts{'extended-detail'});
- } elsif($status eq 'deferred') {
- unless($opts{'deferral-detail'} == 0) {
- my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
- if(!defined($opts{'verbose-msg-detail'})) {
- my ($host, $reason, $moreReason); # More ugliness :/
- unless((($host, $reason) = $deferredReas =~ /^host (\S+) (?:said|refused to talk to me): ([^(]+)/) ||
- (($host, $reason) = $deferredReas =~ /^(?:delivery temporarily suspended: )?connect to (.+?(?::\d+)?): ([^\)]+)$/) ||
- (($host, $reason) = $deferredReas =~ /^cannot (?:append to file|update mailbox) ([^:.]+)[:.] (.+)$/) ||
- (($reason, $host, $moreReason) = $deferredReas =~ /^.*(Name service error )for (?:domain |name=)?([^: ]+):? (.+)$/) ||
- (($reason, $host, $moreReason) = $deferredReas =~ /^((?:conversation|lost connection) )with (\S+) ((?:timed out )?while (receiving|sending) .+)$/) ||
- (($reason, $host, $moreReason) = $deferredReas =~ /^(delivery temporarily suspended: )connect to ([^:]+): (.+)$/)
- )
- {
- $host = "(unknown host)";
- $reason = $deferredReas;
- }
- $host =~ s/:\d{2,3}$//; # Strip trailing port numbers
-
- $reason .= $moreReason if($moreReason); # ick
- # Finally...
- $reason = said_string_trimmer($reason, 66);
- ++$deferred{$svc}{$host}{$reason};
- } else {
- ++$deferred{$svc}{$deferredReas};
- }
- }
- ++$dfrPerHr[$msgHr];
- ++${$msgsPerDay{$revMsgDateStr}}[2];
- push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsDfrd") if $opts{'debug'};
- ++$msgsDfrdCnt;
- ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
- ++${$recipDom{$domAddr}}[MSG_DFRS_I];
- if(! ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] ||
- $delay > ${$recipDom{$domAddr}}[MSG_DLY_MAX_I])
- {
- ${$recipDom{$domAddr}}[MSG_DLY_MAX_I] = $delay
- }
- # For "expired" detail reports
- if($rcvdMsg{$qid}) {
- my ($relay) = $logRmdr =~ /, relay=([^:]+):/;
- $rcvdMsg{$qid}{'relay'} = $relay;
- }
-
- } elsif($status eq 'bounced') {
- unless($opts{'bounce-detail'} == 0) {
- my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
- unless(defined($opts{'verbose-msg-detail'})) {
- $bounceReas = said_string_trimmer($bounceReas, 66);
- }
- ++$bounced{$relay}{$bounceReas};
- }
- ++$bncPerHr[$msgHr];
- ++${$msgsPerDay{$revMsgDateStr}}[3];
- push(@{$qidTracker{$qid}{'status'}}, "\$svc: $svc, \$status: $status, ++\$msgsBncd") if $opts{'debug'};
- ++$msgsBncd;
- } else {
- print $unProcd "[03]: $_\n" if $unProcd;
- }
- }
- elsif($svc eq 'smtp' && $opts{'smtp-detail'} != 0) {
- # Was an IPv6 problem here
- if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/) {
- ++$smtpMsgs{lc($2)}{$1};
- } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/) {
- ++$smtpMsgs{lc($2)}{$1};
- } else {
- print $unProcd "[04]: $_\n" if $unProcd;
- }
- }
- elsif($svc =~ /^n?qmgr$/ && $logRmdr =~ /, status=expired, returned to sender$/) {
- ++$expired{$rcvdMsg{$qid}{'relay'}};
+ elsif($logRmdr =~ /, status=expired, returned to sender$/) {
+ ++$expired{gimme_domain($rcvdMsg{$qid}{'relay'}, 1)};
++$msgsExprd;
}
- elsif($svc =~ /^n?qmgr$/ && $logRmdr =~ /\bremoved$/) {
+ elsif($logRmdr =~ /^removed$/) {
delete($rcvdMsg{$qid}); # We're done with this
}
else
{
- print $unProcd "[05]: (\$svc: \"$svc\") $_\n" if $unProcd;
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: (\$svc: \"$svc\") $_\n" if $unProcd;
+ }
+ } elsif($svc eq 'smtp') {
+ # SMTP session exceptions: connect/greeting diagnostics without per-message delivery signature.
+ my ($dest, $msg);
+
+ if($logRmdr =~ /^connect to\s+([^\]]+\]): (.+?) \(port \d+\)$/) {
+ ($dest, $msg) = ($1, $2);
+ } elsif($logRmdr =~ /^connect to\s+([^\]]+\]):\d+:\s+(.+)$/) {
+ ($dest, $msg) = ($1, $2) unless($regtest);
+ }
+
+ unless(defined $dest && defined $msg) {
+ print $unProcd "[" . __FILE__ . ":" . __LINE__ . "]: $_\n" if $unProcd;
+ next;
}
+ ++$smtpExcptnMsgs{ lc($msg) }{gimme_domain($dest, 1)};
}
}
# Extensive queue I.D. lifetime tracking
if($opts{'debug'} && scalar keys %qidTracker) {
- my ($qidCnt, $rcvdDlvrd, $dlvrdCnt, $addlDlvr, $multiDlvrCnt, $noSizeCnt,
- $addlRcvd, $multiRcvdCnt, $noRcvdCnt, $lateRejects) = ((0) x 10);
+ my ($qidCnt, $dlvrdCnt, $rcvdCnt, $dlvrdTot, $addlDlvr, $multiDlvrCnt, $noSizeCnt,
+ $addlRcvd, $multiRcvdCnt, $noRcvdCnt, $lateRejects, $noRcvdCntDlvrd, $dlvrdNoRcvdCnt) = ((0) x 13);
foreach my $qid (sort keys %qidTracker) {
++$qidCnt;
- print STDERR "qid: $qid\n";
+ dbg("qid: $qid\n");
if(exists $qidTracker{$qid}{'dlvrdCnt'}) {
- ++$rcvdDlvrd;
- $dlvrdCnt += $qidTracker{$qid}{'dlvrdCnt'};
+ ++$dlvrdCnt;
+ $dlvrdTot += $qidTracker{$qid}{'dlvrdCnt'};
if($qidTracker{$qid}{'dlvrdCnt'} > 1) {
$addlDlvr += $qidTracker{$qid}{'dlvrdCnt'} - 1;
++$multiDlvrCnt;
}
- print STDERR " delivered cnt: $qidTracker{$qid}{'dlvrdCnt'}\n"
+ dbg(" delivered cnt: $qidTracker{$qid}{'dlvrdCnt'}\n");
+ $dlvrdNoRcvdCnt += $qidTracker{$qid}{'dlvrdCnt'} unless $qidTracker{$qid}{'rcvdCnt'};
} else {
- print STDERR " delivered cnt: 0\n";
+ dbg(" delivered cnt: 0\n");
}
if(! $qidTracker{$qid}{'rcvdCnt'}) {
- print STDERR " received cnt: 0\n";
+ dbg(" received cnt: 0\n");
++$noRcvdCnt;
- } elsif($qidTracker{$qid}{'rcvdCnt'} > 1) {
- $addlRcvd += $qidTracker{$qid}{'rcvdCnt'} - 1;
- ++$multiRcvdCnt;
- print STDERR " received cnt: $qidTracker{$qid}{'rcvdCnt'}\n";
+ $noRcvdCntDlvrd += $qidTracker{$qid}{'dlvrdCnt'} if exists $qidTracker{$qid}{'dlvrdCnt'};
+ } else {
+ dbg(" received cnt: $qidTracker{$qid}{'rcvdCnt'}\n");
+ $rcvdCnt += $qidTracker{$qid}{'rcvdCnt'};
+ if($qidTracker{$qid}{'rcvdCnt'} > 1) {
+ $addlRcvd += $qidTracker{$qid}{'rcvdCnt'} - 1;
+ ++$multiRcvdCnt;
+ }
}
$lateRejects += $qidTracker{$qid}{'lateRejects'} if $qidTracker{$qid}{'lateRejects'};
foreach my $event (@{$qidTracker{$qid}{'status'}}) {
- print STDERR " $event\n";
+ dbg(" $event\n");
}
if(exists $rcvdMsg{$qid} && ! exists $rcvdMsg{$qid}{'size'}) {
- print STDERR " no size data\n";
+ dbg(" no size data\n");
++$noSizeCnt;
}
}
- printf STDERR "\n %6d%s qids\n", adj_int_units($qidCnt);
- printf STDERR " %6d%s qids delivered\n", adj_int_units($rcvdDlvrd);
- printf STDERR " %6d%s qids w/multi-deliveries\n", adj_int_units($multiDlvrCnt);
- printf STDERR " %6d%s total add'l deliveries\n", adj_int_units($addlDlvr);
- printf STDERR " %6d%s qids w/multi-received\n", adj_int_units($multiRcvdCnt);
- printf STDERR " %6d%s total add'l received\n", adj_int_units($addlRcvd);
- printf STDERR " %6d%s qids w/no received count\n", adj_int_units($noRcvdCnt);
- printf STDERR " %6d%s forwarded\n", adj_int_units($msgsFwdd);
- printf STDERR " %6d%s delivered by cnt\n", adj_int_units($dlvrdCnt);
- printf STDERR " %6d%s discarded\n", adj_int_units($msgsDscrdd);
- printf STDERR " %6d%s qids w/no size data\n", adj_int_units($noSizeCnt);
- printf STDERR " %6d%s late rejects (rec'd but not dlvrd)\n", adj_int_units($lateRejects);
+ dbg(sprintf("\n %6d%s qids\n", adj_int_units($qidCnt)));
+ dbg(sprintf(" %6d%s qids received\n", adj_int_units($rcvdCnt)));
+ dbg(sprintf(" %6d%s qids delivered (%d%s not received)\n", adj_int_units($dlvrdCnt), adj_int_units($dlvrdNoRcvdCnt)));
+ dbg(sprintf(" %6d%s qids w/multi-deliveries\n", adj_int_units($multiDlvrCnt)));
+ dbg(sprintf(" %6d%s delivered total\n", adj_int_units($dlvrdTot)));
+ dbg(sprintf(" %6d%s total add'l deliveries\n", adj_int_units($addlDlvr)));
+ dbg(sprintf(" %6d%s qids w/multi-received\n", adj_int_units($multiRcvdCnt)));
+ dbg(sprintf(" %6d%s total add'l received\n", adj_int_units($addlRcvd)));
+ dbg(sprintf(" %6d%s qids w/no received count (%d%s delivered)\n", adj_int_units($noRcvdCnt), adj_int_units($noRcvdCntDlvrd)));
+ dbg(sprintf(" %6d%s forwarded\n", adj_int_units($msgsFwdd)));
+ dbg(sprintf(" %6d%s discarded\n", adj_int_units($msgsDscrdd)));
+ dbg(sprintf(" %6d%s qids w/no size data\n", adj_int_units($noSizeCnt)));
+ dbg(sprintf(" %6d%s late rejects (rec'd but not dlvrd)\n", adj_int_units($lateRejects)));
}
# debugging
print_domain_smtpd_summary(\%smtpdPerDom, $opts{'host-cnt'});
}
+if(defined($opts{'ssl-tls-stats'})) {
+ print_nested_hash(\%tlsStats, "SMTP TLS Levels (by relay)", $opts{'host-cnt'}, $opts{'quiet'});
+}
+
print_user_data(\%sendgUser, "Senders by message count", MSG_CNT_I, $opts{'user-cnt'}, $opts{'quiet'});
print_user_data(\%recipUser, "Recipients by message count", MSG_CNT_I, $opts{'user-cnt'}, $opts{'quiet'});
print_user_data(\%sendgUser, "Senders by message size", MSG_SIZE_I, $opts{'user-cnt'}, $opts{'quiet'});
}
unless($opts{'reject-detail'} == 0) {
print_nested_hash(\%rejects, "message reject detail", $opts{'reject-detail'}, $opts{'quiet'});
- print_nested_hash(\%warns, "message reject warning detail", $opts{'reject-detail'}, $opts{'quiet'});
+ print_nested_hash(\%rejWarns, "message reject warning detail", $opts{'reject-detail'}, $opts{'quiet'});
print_nested_hash(\%holds, "message hold detail", $opts{'reject-detail'}, $opts{'quiet'});
print_nested_hash(\%discards, "message discard detail", $opts{'reject-detail'}, $opts{'quiet'});
}
- unless($opts{'smtp-detail'} == 0) {
- print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtp-detail'}, $opts{'quiet'});
- }
- unless($opts{'smtpd-warning-detail'} == 0) {
- print_nested_hash(\%warnings, "Warnings", $opts{'smtpd-warning-detail'}, $opts{'quiet'});
+
+if(defined($opts{'ssl-tls-stats'})) {
+ print_nested_hash(\%inboundSSLerrs, "Inbound (smtpd) SSL Errors", $opts{'host-cnt'}, $opts{'quiet'}) unless($regtest);
+}
+
+ print_nested_hash(\%smtpExcptnMsgs, "SMTP Exceptions", 0, $opts{'quiet'});
+
+ unless($opts{'warning-detail'} == 0) {
+ print_nested_hash(\%warnings, "Warnings", $opts{'warning-detail'}, $opts{'quiet'});
}
print_nested_hash(\%pscrnHits, "postscreen actions", $opts{'pscrn-detail'}, $opts{'quiet'}) if($opts{'pscrn-detail'});
}
}
-
# print "per-hour" smtpd connection summary
# (done in a subroutine only to keep main-line code clean)
sub print_per_hour_smtpd {
sub print_hash_by_key {
my($hashRef, $title, $cnt, $quiet) = @_;
my $dottedLine;
- $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title;
+ my $total = scalar keys %$hashRef;
+ $title = sprintf "%s (%s%d)", $title, $cnt? "first $cnt of " : "", $total;
unless(%$hashRef) {
return if($quiet);
$dottedLine = ": none";
}
}
-
# print per-message info in excruciating detail :-)
sub print_detailed_msg_data {
use vars '$hashRef';
# N.B.: IP addr checking is not exhaustive
#
sub gimme_domain {
- my $line = $_[0];
+ my ($line, $want_fqdn) = @_;
# Treat letters, digits, dot, hyphen, and underscore as "hostname-ish".
# Start only if we're NOT preceded by one of those (or we're at BOL).
my ($fqdn, $ipaddr);
+ # Special case
+ return 'none' if $line =~ /^none(?::\d+)?$/;
+
unless( (($fqdn, $ipaddr) = ($line =~ $bracketRegex)) ||
(($fqdn, $ipaddr) = ($line =~ $slashSepRegex)) ||
(($ipaddr) = ($line =~ $addrOnlyRegex)) )
$ipaddr = $1 // $2;
}
}
+
$fqdn = "unknown" unless($fqdn);
$ipaddr = "unknown" unless($ipaddr);
$ipaddr =~ s/^\[|\]$//g;
return $ipaddr if($fqdn eq "unknown" || $fqdn =~ /\.(in-addr|ip6)\.arpa$/);
- return fold_domain($fqdn);
+ return $want_fqdn? $fqdn : fold_domain($fqdn);
}
#
# 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+?): (.*)$/;
- print STDERR "\$rejTyp: \"$rejTyp\", \$rejReas: \"$rejReas\"\n" if($opts{'debug'} && defined $rejTyp && defined $rejReas);
+ $logLine =~ /^(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/;
+ dbg("dbg: \$rejTyp: \"$rejTyp\", \$rejReas: \"$rejReas\"\n") if($opts{'debug'} && defined $rejTyp && defined $rejReas);
# Next: get the reject "reason"
$rejReas = $rejRmdr;
# Recipient address rejected: Domain not found
# Recipient address rejected: need fully-qualified address
# User unknown (in local/relay recipient table)
- #++$rejects->{$rejTyp}{$rejReas}{$to};
my $rejData = $to;
if($opts{'rej-add-from'}) {
$rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
$rejData .= " ($from)" if($opts{'rej-add-from'});
++$rejects->{$rejTyp}{$rejReas}{$rejData};
} else {
- print STDERR "dbg: unknown/un-enumerated reject reason: \$rejReas: \"$rejReas\", \$rejTyp: \"$rejTyp\", \$rejFrom: \"$rejFrom\"!\n" if($opts{'debug'});
+ dbg("dbg: unknown/un-enumerated reject reason: \$rejReas: \"$rejReas\", \$rejTyp: \"$rejTyp\", \$rejFrom: \"$rejFrom\"!\n") if($opts{'debug'});
my $rejData = gimme_domain($rejFrom);
if($opts{'rej-add-from'} && $opts{'rej-add-to'} && $to) {
$rejData .= " ($from -> $to)";