From: Sven Hoexter Date: Wed, 29 Oct 2025 18:34:52 +0000 (+0100) Subject: New upstream version 1.1.13 X-Git-Tag: upstream/1.1.13^0 X-Git-Url: https://git.sven.stormbind.net/?a=commitdiff_plain;h=4afc3929cfc8c1d9a86afdaed387f8feb53bd9a6;p=sven%2Fpflogsumm.git New upstream version 1.1.13 --- diff --git a/ChangeLog b/ChangeLog index 040ddc9..35b2707 100644 --- a/ChangeLog +++ b/ChangeLog @@ -9,6 +9,33 @@ ChangeLog for pflogsumm feed for update notifications.] +rel-1.1.13 20251023 + + Bug Fixes + + Corrected client-info extraction which sometimes extracted the + wrong bits from log lines. (Bug introduced in v1.1.12.) + + Restored --zero-fill option accidentally dropped in v1.1.12 + + Cleanup/Maintenance + + Removed redundant parentheses from several regex capture + assignments, improving readability without altering behavior. + + Simplified IPv4 octet parsing expression. + + Simplified reject/hold/discard capture assignment. + + Normalized unparsed deferral handling: now labeled as `(unknown + host)` instead of a fabricated sentence. + + Strip trailing port suffixes from hostnames/IP addresses for + cleaner aggregation. + + Improved domain normalization in all summaries for better + host/domain aggregation. + rel-1.1.12 20250819 *** Breaking Changes *** diff --git a/pffrombyto.1 b/pffrombyto.1 index d1bef7b..7b625d6 100644 --- a/pffrombyto.1 +++ b/pffrombyto.1 @@ -55,7 +55,7 @@ .\" ======================================================================== .\" .IX Title "PFFROMBYTO 1" -.TH PFFROMBYTO 1 2025-05-22 1.1.12 "User Contributed Perl Documentation" +.TH PFFROMBYTO 1 2025-05-22 1.1.13 "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l diff --git a/pflogsumm b/pflogsumm index 437ecb9..8d14a12 100755 --- a/pflogsumm +++ b/pflogsumm @@ -6,7 +6,7 @@ eval 'exec perl -S $0 "$@"' pflogsumm - Produce Postfix MTA logfile summary -Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.12 +Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.13 =head1 SYNOPSIS @@ -550,6 +550,7 @@ Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.12 require v5.10.0; use strict; use locale; +use feature 'state'; use Getopt::Long; use List::Util qw(reduce); use Time::Local; @@ -560,7 +561,7 @@ eval { require Config::Simple }; my $haveConfigSimple = $@ ? 0 : 1; my $mailqCmd = "mailq"; -my $release = "1.1.12"; +my $release = "1.1.13"; # Variables and constants used throughout pflogsumm our ( @@ -754,6 +755,7 @@ my %optionSpec = ( 'verbose-msg-detail' => { type => 'b' }, 'verp-mung' => { type => 'i' }, # optional arg 'version' => { type => 'b' }, + 'zero-fill' => { type => 'b' }, ); # Storage for actual values @@ -1034,6 +1036,7 @@ while(<>) { if($opts{'debug'}) { push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd"); ++$qidTracker{$qid}{'lateRejects'}; + print STDERR "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") { @@ -1100,7 +1103,7 @@ while(<>) { } elsif($cmd eq 'master') { ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]}; } elsif($cmd eq 'smtpd' || $cmd eq 'postscreen') { - if((my $clientInfo = $logRmdr) =~ /\[\d+\]: \w+: client=(.+?)(?:,|$)/) { + if((my ($clientInfo)) = $logRmdr =~ /\[\d+\]: \w+: client=(.+?)(?:,|$)/) { # # Warning: this code in two places! # @@ -1122,6 +1125,7 @@ while(<>) { if($opts{'debug'}) { push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd"); ++$qidTracker{$qid}{'lateRejects'}; + print STDERR "dbg: late reject \$rcvdMsg{$qid}{'size'}: $rcvdMsg{$qid}{'size'}\n" if $rcvdMsg{$qid}{'size'}; } --$msgsRcvd # Late reject: It's been counted as received already } @@ -1285,17 +1289,17 @@ while(<>) { $addr = verp_mung($addr); $addr = srs_mung($addr); } else { - $addr = "from=<>" + $addr = "from=<>"; } $rcvdMsg{$qid}{'size'} = $size; push(@{$msgDetail{$qid}}, $addr) if($opts{'extended-detail'}); # Avoid counting forwards if($rcvdMsg{$qid}{'whence'}) { # Get the domain out of the sender's address. If there is - # none: Use the client domain/IP-address + # none (e.g.: "from=<>"): Use the client domain/IP-address my $domAddr; - unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/) == 1) { - $domAddr = $rcvdMsg{$qid}{'whence'} eq "pickup"? $addr : $rcvdMsg{$qid}{'whence'}; + if($addr eq 'from=<>' || ($domAddr = fold_domain($addr)) eq '') { + $domAddr = $rcvdMsg{$qid}{'whence'}; } ++$sendgDomCnt unless(${$sendgDom{$domAddr}}[MSG_CNT_I]); @@ -1318,11 +1322,11 @@ while(<>) { $addr =~ s/(@.+)/\L$1/ unless($opts{'ignore-case'}); $addr = lc($addr) if($opts{'ignore-case'}); $relay = lc($relay) if($opts{'ignore-case'}); - (my $domAddr = $addr) =~ s/^[^@]+\@//; # get domain only + 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 ([^\)]+)\)/)) { + if(my ($newQid) = $toRmdr =~ /\(forwarded as ([^\)]+)\)/) { push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$status: $status, forwarded as new qid $1, ++\$msgsFwdd") if $opts{'debug'}; ++$msgsFwdd; delete($rcvdMsg{$qid}); # We're done with this @@ -1363,17 +1367,18 @@ while(<>) { 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 ([^:]+): (.+)$/)) + 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 = "unrecognized deferral reason(s)"; + $host = "(unknown host)"; $reason = $deferredReas; } + $host =~ s/:\d{2,3}$//; # Strip trailing port numbers $reason .= $moreReason if($moreReason); # ick # Finally... @@ -2110,7 +2115,7 @@ sub normalize_host { return join '', @blocks; } - if ((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)) == 4) { + if ((my @octets = $norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/) == 4) { # Dotted-quad IPv4 address # Validate each octet is in range 0-255 for my $octet (@octets) { @@ -2312,11 +2317,7 @@ sub line_matches_dates { ($line =~ /^(?:<\d{1,3}>(?:[1-9]\d*\s+|\s*))?(\w{3}) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/)) == 6) { return (undef) unless defined($msgMon = $monthNums{$monStr}); - #$msgMon = $monthNums{$monStr}; - #unless(defined($msgMon)) { - # print "dbg: \$msgMon undefined from \$monStr: \"$monStr\"\n"; - # return (undef); - #} + my ($currMon, $currYr) = (localtime($now))[4,5]; # If month in logfile line is > current month the logfile line must be from last year --$currYr if($msgMon > $currMon); @@ -2332,7 +2333,6 @@ sub line_matches_dates { return (undef); # Not a parsable line } - # if there's a real hostname/domain: uses that. Otherwise uses # the IP addr. # @@ -2346,46 +2346,70 @@ sub line_matches_dates { # N.B.: IP addr checking is not exhaustive # sub gimme_domain { - $_ = $_[0]; - my $bracketRegex = '([^\s\[]+)\[((?:\d{1,3}\.){3}\d{1,3}|[\da-fA-F:]+(?:::(?:[\da-fA-F:]+)?)?|[\da-fA-F:]+:(?:\d{1,3}\.){3}\d{1,3})\]'; - my $slashSepRegex = '([^\s\/]+)\/((?:\d{1,3}\.){3}\d{1,3}|[\da-fA-F:]+(?:::(?:[\da-fA-F:]+)?)?|[\da-fA-F:]+:(?:\d{1,3}\.){3}\d{1,3})'; + my $line = $_[0]; + + # 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). + state $HBOUND = qr/(?"s? +# +sub fold_domain { + my ($fqdn) = @_; + state %original_tlds; + return '' unless defined $fqdn; - my @parts = split /\./, $domain; - my $tld = $parts[-1]; - my $sld = $parts[-2]; - my %original_tlds = map { $_ => 1 } qw(com net org gov mil edu); + # Strip brackets, "user@", leading and trailing whitespace, lowercase + (my $domain = $fqdn) =~ s/^\s*]+)>?\s*$/\L$1/; - if ($original_tlds{$tld}) { - # Collapse to second-level domain: example.com - return "$sld.$tld"; - } + # Strip trailing "." (PTRs, etc.) + $domain =~ s/\.$//; - # Otherwise elide leftmost: host.example.co.uk → example.co.uk - # if more than 3 elements - if (@parts > 3) { - shift @parts; - return join('.', @parts); - } else { - return $domain; + return $domain if $domain !~ /\./; + + unless(%original_tlds) { + %original_tlds = map { $_ => 1 } qw(com net org gov mil edu); } + my @parts = split /\./, $domain; + my ($sld,$tld) = @parts[-2,-1]; + + return "$sld.$tld" if $original_tlds{$tld}; + return join('.', @parts[1..$#parts]) if @parts > 3; # elide leftmost once + return $domain; } # Return (value, units) for integer @@ -2487,7 +2511,7 @@ sub proc_smtpd_reject { # 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+?): (.*)$/); + $logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/; print STDERR "\$rejTyp: \"$rejTyp\", \$rejReas: \"$rejReas\"\n" if($opts{'debug'} && defined $rejTyp && defined $rejReas); # Next: get the reject "reason" diff --git a/pflogsumm.1 b/pflogsumm.1 index 5c709bf..8304080 100644 --- a/pflogsumm.1 +++ b/pflogsumm.1 @@ -55,7 +55,7 @@ .\" ======================================================================== .\" .IX Title "PFLOGSUMM 1" -.TH PFLOGSUMM 1 2025-08-19 1.1.12 "User Contributed Perl Documentation" +.TH PFLOGSUMM 1 2025-10-22 1.1.13 "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l @@ -63,7 +63,7 @@ .SH NAME pflogsumm \- Produce Postfix MTA logfile summary .PP -Copyright (C) 1998\-2025 by James S. Seymour, Release 1.1.12 +Copyright (C) 1998\-2025 by James S. Seymour, Release 1.1.13 .SH SYNOPSIS .IX Header "SYNOPSIS" .Vb 10 diff --git a/pftobyfrom.1 b/pftobyfrom.1 index 2d991fa..e9d6faa 100644 --- a/pftobyfrom.1 +++ b/pftobyfrom.1 @@ -55,7 +55,7 @@ .\" ======================================================================== .\" .IX Title "PFTOBYFROM 1" -.TH PFTOBYFROM 1 2025-05-22 1.1.12 "User Contributed Perl Documentation" +.TH PFTOBYFROM 1 2025-05-22 1.1.13 "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l