2 eval 'exec perl -S $0 "$@"'
7 pflogsumm.pl - Produce Postfix MTA logfile summary
9 Copyright (C) 1998-2003 by James S. Seymour, Release 1.1.0.
13 pflogsumm.pl -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
14 [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
15 [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
16 [--problems_first] [--rej_add_from] [--no_bounce_detail]
17 [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
18 [--no_smtpd_warnings] [--zero_fill] [--syslog_name=string]
21 pflogsumm.pl -[help|version]
23 If no file(s) specified, reads from stdin. Output is to stdout.
27 Pflogsumm is a log analyzer/summarizer for the Postfix MTA. It is
28 designed to provide an over-view of Postfix activity, with just enough
29 detail to give the administrator a "heads up" for potential trouble
32 Pflogsumm generates summaries and, in some cases, detailed reports of
33 mail server traffic volumes, rejected and bounced email, and server
34 warnings, errors and panics.
38 -d today generate report for just today
39 -d yesterday generate report for just "yesterday"
41 -e extended (extreme? excessive?) detail
43 Emit detailed reports. At present, this includes
44 only a per-message report, sorted by sender domain,
45 then user-in-domain, then by queue i.d.
47 WARNING: the data built to generate this report can
48 quickly consume very large amounts of memory if a
49 lot of log entries are processed!
51 -h <cnt> top <cnt> to display in host/domain reports.
55 See also: "-u" and "--no_*_detail" for further
56 report-limiting options.
58 --help Emit short usage message and bail out.
60 (By happy coincidence, "-h" alone does much the same,
61 being as it requires a numeric argument :-). Yeah, I
65 --ignore_case Handle complete email address in a case-insensitive
68 Normally pflogsumm lower-cases only the host and
69 domain parts, leaving the user part alone. This
70 option causes the entire email address to be lower-
75 For summaries that contain date or time information,
76 use ISO 8601 standard formats (CCYY-MM-DD and HH:MM),
77 rather than "Mon DD CCYY" and "HHMM".
79 -m modify (mung?) UUCP-style bang-paths
82 This is for use when you have a mix of Internet-style
83 domain addresses and UUCP-style bang-paths in the log.
84 Upstream UUCP feeds sometimes mung Internet domain
85 style address into bang-paths. This option can
86 sometimes undo the "damage". For example:
87 "somehost.dom!username@foo" (where "foo" is the next
88 host upstream and "somehost.dom" was whence the email
89 originated) will get converted to
90 "foo!username@somehost.dom". This also affects the
91 extended detail report (-e), to help ensure that by-
92 domain-by-name sorting is more accurate.
94 --mailq Run "mailq" command at end of report.
96 Merely a convenience feature. (Assumes that "mailq"
97 is in $PATH. See "$mailqCmd" variable to path thisi
104 Suppresses the printing of the following detailed
105 reports, respectively:
107 message bounce detail (by relay)
108 message deferral detail
109 message reject detail
111 See also: "-u" and "-h" for further report-limiting
116 Do not emit report on "Messages with no size data".
118 Message size is reported only by the queue manager.
119 The message may be delivered long-enough after the
120 (last) qmgr log entry that the information is not in
121 the log(s) processed by a particular run of
122 pflogsumm.pl. This throws off "Recipients by message
123 size" and the total for "bytes delivered." These are
124 normally reported by pflogsumm as "Messages with no
129 On a busy mail server, say at an ISP, SMTPD warnings
130 can result in a rather sizeable report. This option
131 turns reporting them off.
135 Emit "problems" reports (bounces, defers, warnings,
136 etc.) before "normal" stats.
139 For those reject reports that list IP addresses or
140 host/domain names: append the email from address to
141 each listing. (Does not apply to "Improper use of
142 SMTP command pipelining" report.)
144 -q quiet - don't print headings for empty reports
146 note: headings for warning, fatal, and "master"
147 messages will always be printed.
151 Generate smtpd connection statistics.
153 The "per-day" report is not generated for single-day
154 reports. For multiple-day reports: "per-hour" numbers
155 are daily averages (reflected in the report heading).
159 Set syslog_name to look for for Postfix log entries.
161 By default, pflogsumm looks for entries in logfiles
162 with a syslog name of "postfix," the default.
163 If you've set a non-default "syslog_name" parameter
164 in your Postfix configuration, use this option to
165 tell pflogsumm what that is.
167 See the discussion about the use of this option under
170 -u <cnt> top <cnt> to display in user reports. 0 == none.
172 See also: "-h" and "--no_*_detail" for further
173 report-limiting options.
177 For the message deferral, bounce and reject summaries:
178 display the full "reason", rather than a truncated one.
180 Note: this can result in quite long lines in the report.
182 --verp_mung do "VERP" generated address (?) munging. Convert
183 --verp_mung=2 sender addresses of the form
184 "list-return-NN-someuser=some.dom@host.sender.dom"
186 "list-return-ID-someuser=some.dom@host.sender.dom"
188 In other words: replace the numeric value with "ID".
190 By specifying the optional "=2" (second form), the
191 munging is more "aggressive", converting the address
194 "list-return@host.sender.dom"
196 Actually: specifying anything less than 2 does the
197 "simple" munging and anything greater than 1 results
198 in the more "aggressive" hack being applied.
200 See "NOTES" regarding this option.
202 --version Print program name and version and bail out.
204 --zero_fill "Zero-fill" certain arrays so reports come out with
205 data in columns that that might otherwise be blank.
209 Pflogsumm doesn't return anything of interest to the shell.
213 Error messages are emitted to stderr.
217 Produce a report of previous day's activities:
219 pflogsumm.pl -d yesterday /var/log/maillog
221 A report of prior week's activities (after logs rotated):
223 pflogsumm.pl /var/log/maillog.0
225 What's happened so far today:
227 pflogsumm.pl -d today /var/log/maillog
229 Crontab entry to generate a report of the previous day's activity
230 at 10 minutes after midnight.
232 10 0 * * * /usr/local/sbin/pflogsumm -d yesterday /var/log/maillog
233 2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
235 Crontab entry to generate a report for the prior week's activity.
236 (This example assumes one rotates ones mail logs weekly, some time
237 before 4:10 a.m. on Sunday.)
239 10 4 * * 0 /usr/local/sbin/pflogsumm /var/log/maillog.0
240 2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
242 The two crontab examples, above, must actually be a single line
243 each. They're broken-up into two-or-more lines due to page
248 The pflogsumm FAQ: pflogsumm-faq.txt.
252 Pflogsumm makes no attempt to catch/parse non-Postfix log
253 entries. Unless it has "postfix/" in the log entry, it will be
256 It's important that the logs are presented to pflogsumm in
257 chronological order so that message sizes are available when
260 For display purposes: integer values are munged into "kilo" and
261 "mega" notation as they exceed certain values. I chose the
262 admittedly arbitrary boundaries of 512k and 512m as the points at
263 which to do this--my thinking being 512x was the largest number
264 (of digits) that most folks can comfortably grok at-a-glance.
265 These are "computer" "k" and "m", not 1000 and 1,000,000. You
266 can easily change all of this with some constants near the
267 beginning of the program.
269 "Items-per-day" reports are not generated for single-day
270 reports. For multiple-day reports: "Items-per-hour" numbers are
271 daily averages (reflected in the report headings).
273 Message rejects, reject warnings, holds and discards are all
274 reported under the "rejects" column for the Per-Hour and Per-Day
277 Verp munging may not always result in correct address and
278 address-count reduction.
280 Verp munging is always in a state of experimentation. The use
281 of this option may result in inaccurate statistics with regards
282 to the "senders" count.
284 UUCP-style bang-path handling needs more work. Particularly if
285 Postfix is not being run with "swap_bangpath = yes" and/or *is* being
286 run with "append_dot_mydomain = yes", the detailed by-message report
287 may not be sorted correctly by-domain-by-user. (Also depends on
288 upstream MTA, I suspect.)
290 The "percent rejected" and "percent discarded" figures are only
291 approximations. They are calculated as follows (example is for
296 (rejected / (delivered + rejected + discarded)) * 100
298 There are some issues with the use of --syslog_name. The problem is
299 that, even with $syslog_name set, Postfix will sometimes still log
300 things with "postfix" as the syslog_name. This is noted in
301 /etc/postfix/sample-misc.cf:
303 # Beware: a non-default syslog_name setting takes effect only
304 # after process initialization. Some initialization errors will be
305 # logged with the default name, especially errors while parsing
306 # the command line and errors while accessing the Postfix main.cf
307 # configuration file.
309 As a consequence, pflogsumm must always look for "postfix," in logs,
310 as well as whatever is supplied for syslog_name.
312 Where this becomes an issue is where people are running two or more
313 instances of Postfix, logging to the same file. In such a case:
315 . Neither instance may use the default "postfix" syslog name
318 . Log entries that fall victim to what's described in
319 sample-misc.cf will be reported under "postfix", so that if
320 you're running pflogsumm twice, once for each syslog_name, such
321 log entries will show up in each report.
323 The Pflogsumm Home Page is at:
325 http://jimsun.LinxNet.com/postfix_contrib.html
329 Pflogsumm requires the Date::Calc module, which can be obtained from
330 CPAN at http://www.perl.com.
332 Pflogsumm is currently written and tested under Perl 5.005_03.
333 As of version 19990413-02, pflogsumm worked with Perl 5.003, but
334 future compatibility is not guaranteed.
338 This program is free software; you can redistribute it and/or
339 modify it under the terms of the GNU General Public License
340 as published by the Free Software Foundation; either version 2
341 of the License, or (at your option) any later version.
343 This program is distributed in the hope that it will be useful,
344 but WITHOUT ANY WARRANTY; without even the implied warranty of
345 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
346 GNU General Public License for more details.
348 You may have received a copy of the GNU General Public License
349 along with this program; if not, write to the Free Software
350 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
353 An on-line copy of the GNU General Public License can be found
354 http://www.fsf.org/copyleft/gpl.html.
361 # ---Begin: SMTPD_STATS_SUPPORT---
362 use Date::Calc qw(Delta_DHMS);
363 # ---End: SMTPD_STATS_SUPPORT---
365 my $mailqCmd = "mailq";
366 my $release = "1.1.0";
368 # Variables and constants used throughout pflogsumm
373 $divByOneKAt $divByOneMegAt $oneK $oneMeg
374 @monthNames %monthNums $thisYr $thisMon
375 $msgCntI $msgSizeI $msgDfrsI $msgDlyAvgI $msgDlyMaxI
379 # Some constants used by display routines. I arbitrarily chose to
380 # display in kilobytes and megabytes at the 512k and 512m boundaries,
381 # respectively. Season to taste.
382 $divByOneKAt = 524288; # 512k
383 $divByOneMegAt = 536870912; # 512m
385 $oneMeg = 1048576; # 1m
387 # Constants used throughout pflogsumm
388 @monthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
390 Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
391 Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11);
392 ($thisMon, $thisYr) = (localtime(time()))[4,5];
396 # Variables used only in main loop
399 my (%recipUser, $recipUserCnt);
400 my (%sendgUser, $sendgUserCnt);
402 my (%recipDom, $recipDomCnt); # recipient domain data
403 my (%sendgDom, $sendgDomCnt); # sending domain data
404 # Indexes for arrays in above
405 $msgCntI = 0; # message count
406 $msgSizeI = 1; # total messages size
407 $msgDfrsI = 2; # number of defers
408 $msgDlyAvgI = 3; # total of delays (used for averaging)
409 $msgDlyMaxI = 4; # max delay
412 $cmd, $qid, $addr, $size, $relay, $status, $delay,
414 %panics, %fatals, %warnings, %masterMsgs,
417 %noMsgSize, %msgDetail,
418 $msgsRcvd, $msgsDlvrd, $sizeRcvd, $sizeDlvrd,
419 $msgMonStr, $msgMon, $msgDay, $msgTimeStr, $msgHr, $msgMin, $msgSec,
421 $revMsgDateStr, $dayCnt, %msgsPerDay,
422 %rejects, $msgsRjctd,
424 %discards, $msgsDscrdd,
426 %rcvdMsg, $msgsFwdd, $msgsBncd,
427 $msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
428 %connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
431 $dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
433 # Init total messages delivered, rejected, and discarded
434 $msgsDlvrd = $msgsRjctd = $msgsDscrdd = 0;
436 # Init messages received and delivered per hour
437 my @rcvPerHr = (0) x 24;
438 my @dlvPerHr = @rcvPerHr;
439 my @dfrPerHr = @rcvPerHr; # defers per hour
440 my @bncPerHr = @rcvPerHr; # bounces per hour
441 my @rejPerHr = @rcvPerHr; # rejects per hour
444 # Init "doubly-sub-scripted array": cnt, total and max time per-hour
447 $smtpdPerHr[$_] = [0,0,0];
450 $progName = "pflogsumm.pl";
452 "usage: $progName -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
453 [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
454 [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
455 [--problems_first] [--rej_add_from] [--no_bounce_detail]
456 [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
457 [--no_smtpd_warnings] [--zero_fill] [--syslog_name=name]
460 $progName --[version|help]";
462 # Some pre-inits for convenience
463 $isoDateTime = 0; # Don't use ISO date/time formats
465 "d=s" => \$opts{'d'},
467 "help" => \$opts{'help'},
468 "h=i" => \$opts{'h'},
470 "ignore_case" => \$opts{'i'},
471 "iso_date_time" => \$isoDateTime,
473 "uucp_mung" => \$opts{'m'},
474 "mailq" => \$opts{'mailq'},
475 "no_bounce_detail" => \$opts{'noBounceDetail'},
476 "no_deferral_detail" => \$opts{'noDeferralDetail'},
477 "no_reject_detail" => \$opts{'noRejectDetail'},
478 "no_no_msg_size" => \$opts{'noNoMsgSize'},
479 "no_smtpd_warnings" => \$opts{'noSMTPDWarnings'},
480 "problems_first" => \$opts{'pf'},
482 "rej_add_from" => \$opts{'rejAddFrom'},
483 "smtpd_stats" => \$opts{'smtpdStats'},
484 "syslog_name=s" => \$opts{'syslogName'},
485 "u=i" => \$opts{'u'},
486 "verbose_msg_detail" => \$opts{'verbMsgDetail'},
487 "verp_mung:i" => \$opts{'verpMung'},
488 "version" => \$opts{'version'},
489 "zero_fill" => \$opts{'zeroFill'}
490 ) || die "$usageMsg\n";
492 # internally: 0 == none, undefined == -1 == all
493 $opts{'h'} = -1 unless(defined($opts{'h'}));
494 $opts{'u'} = -1 unless(defined($opts{'u'}));
495 my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
497 if(defined($opts{'help'})) {
502 if(defined($opts{'version'})) {
503 print "$progName $release\n";
507 $dateStr = get_datestr($opts{'d'}) if(defined($opts{'d'}));
510 #open(UNPROCD, "> unprocessed") ||
511 # die "couldn't open \"unprocessed\": $!\n";
514 next if(defined($dateStr) && ! /^$dateStr/o);
515 s/: \[ID \d+ [^\]]+\] /: /o; # lose "[ID nnnnnn some.thing]" stuff
517 next unless((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
518 /^(...) +(\d+) (..):(..):(..) \S+ (.+)$/o) == 6);
519 unless((($cmd, $qid) = $logRmdr =~ m#^(?:vmailer|postfix|$syslogName)/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
520 (($cmd, $qid) = $logRmdr =~ m#^((?:vmailer|postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
527 # snatch out log entry date & time
528 $msgMon = $monthNums{$msgMonStr};
529 $msgYr = ($msgMon > $thisMon? $thisYr - 1 : $thisYr);
531 # the following test depends on one getting more than one message a
532 # month--or at least that successive messages don't arrive on the
533 # same month-day in successive months :-)
534 unless($msgDay == $lastMsgDay) {
535 $lastMsgDay = $msgDay;
536 $revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay;
538 if(defined($opts{'zeroFill'})) {
539 ${$msgsPerDay{$revMsgDateStr}}[4] = 0;
543 # regexp rejects happen in "cleanup"
544 if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
545 /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/o) == 3)
547 $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'});
548 $rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
549 if($rejSubTyp eq "reject") {
550 ++$rejects{$cmd}{$rejReas}{$rejRmdr};
552 } elsif($rejSubTyp eq "warning") {
553 ++$warns{$cmd}{$rejReas}{$rejRmdr};
555 } elsif($rejSubTyp eq "hold") {
556 ++$holds{$cmd}{$rejReas}{$rejRmdr};
558 } elsif($rejSubTyp eq "discard") {
559 ++$discards{$cmd}{$rejReas}{$rejRmdr};
563 ++${$msgsPerDay{$revMsgDateStr}}[4];
564 } elsif($qid eq 'warning') {
565 (my $warnReas = $logRmdr) =~ s/^.*warning: //o;
566 $warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
567 unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
568 ++$warnings{$cmd}{$warnReas};
570 } elsif($qid eq 'fatal') {
571 (my $fatalReas = $logRmdr) =~ s/^.*fatal: //o;
572 $fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
573 ++$fatals{$cmd}{$fatalReas};
574 } elsif($qid eq 'panic') {
575 (my $panicReas = $logRmdr) =~ s/^.*panic: //o;
576 $panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
577 ++$panics{$cmd}{$panicReas};
578 } elsif($qid eq 'reject') {
579 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr],
580 \${$msgsPerDay{$revMsgDateStr}}[4]);
581 } elsif($qid eq 'reject_warning') {
582 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr],
583 \${$msgsPerDay{$revMsgDateStr}}[4]);
584 } elsif($qid eq 'hold') {
585 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr],
586 \${$msgsPerDay{$revMsgDateStr}}[4]);
587 } elsif($qid eq 'discard') {
588 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr],
589 \${$msgsPerDay{$revMsgDateStr}}[4]);
590 } elsif($cmd eq 'master') {
591 ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
592 } elsif($cmd eq 'smtpd') {
593 if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) {
595 # Warning: this code in two places!
598 ++${$msgsPerDay{$revMsgDateStr}}[0];
600 $rcvdMsg{$qid} = gimme_domain($1); # Whence it came
601 } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) {
602 if($rejSubTyp eq 'reject') {
603 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
605 \${$msgsPerDay{$revMsgDateStr}}[4]);
606 } elsif($rejSubTyp eq 'reject_warning') {
607 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
609 \${$msgsPerDay{$revMsgDateStr}}[4]);
610 } elsif($rejSubTyp eq 'hold') {
611 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld,
613 \${$msgsPerDay{$revMsgDateStr}}[4]);
614 } elsif($rejSubTyp eq 'discard') {
615 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd,
617 \${$msgsPerDay{$revMsgDateStr}}[4]);
620 # ---Begin: SMTPD_STATS_SUPPORT---
622 next unless(defined($opts{'smtpdStats'}));
623 if($logRmdr =~ /: connect from /o) {
624 $logRmdr =~ /\/smtpd\[(\d+)\]: /o;
626 ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
627 } elsif($logRmdr =~ /: disconnect from /o) {
628 my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o;
629 if(exists($connTime{$pid})) {
630 $hostID = gimme_domain($hostID);
631 my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
632 $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
633 delete($connTime{$pid}); # dispose of no-longer-needed item
634 my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
636 ++$smtpdPerHr[$msgHr][0];
637 $smtpdPerHr[$msgHr][1] += $tSecs;
638 $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
640 unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
641 ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
642 ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
644 ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
645 ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
646 if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
648 unless(${$smtpdPerDom{$hostID}}[0]++) {
649 ${$smtpdPerDom{$hostID}}[1] = 0;
650 ${$smtpdPerDom{$hostID}}[2] = 0;
652 ${$smtpdPerDom{$hostID}}[1] += $tSecs;
653 ${$smtpdPerDom{$hostID}}[2] = $tSecs
654 if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
657 $smtpdTotTime += $tSecs;
661 # ---End: SMTPD_STATS_SUPPORT---
664 if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2)
666 next if($msgSizes{$qid}); # avoid double-counting!
668 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
669 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
671 $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
672 $addr = lc($addr) if($opts{'i'});
673 $addr = verp_mung($addr);
677 $msgSizes{$qid} = $size;
678 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
679 # Avoid counting forwards
681 # Get the domain out of the sender's address. If there is
682 # none: Use the client hostname/IP-address
684 unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/o) == 1) {
685 $domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
688 unless(${$sendgDom{$domAddr}}[$msgCntI]);
689 ++${$sendgDom{$domAddr}}[$msgCntI];
690 ${$sendgDom{$domAddr}}[$msgSizeI] += $size;
691 ++$sendgUserCnt unless(${$sendgUser{$addr}}[$msgCntI]);
692 ++${$sendgUser{$addr}}[$msgCntI];
693 ${$sendgUser{$addr}}[$msgSizeI] += $size;
695 delete($rcvdMsg{$qid}); # limit hash size
698 elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
699 /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), delay=([^,]+), status=(\S+)(.*)$/o) >= 4)
702 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
703 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
705 $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
706 $addr = lc($addr) if($opts{'i'});
707 (my $domAddr = $addr) =~ s/^[^@]+\@//o; # get domain only
708 if($status eq 'sent') {
710 # was it actually forwarded, rather than delivered?
711 if($toRmdr =~ /forwarded as /o) {
715 ++$recipDomCnt unless(${$recipDom{$domAddr}}[$msgCntI]);
716 ++${$recipDom{$domAddr}}[$msgCntI];
717 ${$recipDom{$domAddr}}[$msgDlyAvgI] += $delay;
718 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
719 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
721 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
723 ++$recipUserCnt unless(${$recipUser{$addr}}[$msgCntI]);
724 ++${$recipUser{$addr}}[$msgCntI];
726 ++${$msgsPerDay{$revMsgDateStr}}[1];
728 if($msgSizes{$qid}) {
729 ${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid};
730 ${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid};
731 $sizeDlvrd += $msgSizes{$qid};
733 ${$recipDom{$domAddr}}[$msgSizeI] += 0;
734 ${$recipUser{$addr}}[$msgSizeI] += 0;
735 $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'});
736 push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'});
737 # put this back later? mebbe with -v?
738 # msg_warn("no message size for qid: $qid");
740 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
741 } elsif($status eq 'deferred') {
742 my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/o;
743 unless(defined($opts{'verbMsgDetail'})) {
744 $deferredReas = said_string_trimmer($deferredReas, 65);
745 $deferredReas =~ s/^\d{3} //o;
746 $deferredReas =~ s/^connect to //o;
748 ++$deferred{$cmd}{$deferredReas};
750 ++${$msgsPerDay{$revMsgDateStr}}[2];
752 ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
753 ++${$recipDom{$domAddr}}[$msgDfrsI];
754 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
755 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
757 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
759 } elsif($status eq 'bounced') {
760 my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/o;
761 unless(defined($opts{'verbMsgDetail'})) {
762 $bounceReas = said_string_trimmer($bounceReas, 66);
763 $bounceReas =~ s/^\d{3} //o;
765 ++$bounced{$relay}{$bounceReas};
767 ++${$msgsPerDay{$revMsgDateStr}}[3];
770 # print UNPROCD "$_\n";
773 elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) {
775 # Warning: this code in two places!
778 ++${$msgsPerDay{$revMsgDateStr}}[0];
780 $rcvdMsg{$qid} = "pickup"; # Whence it came
782 elsif($cmd eq 'smtp') {
783 # Was an IPv6 problem here
784 if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) {
785 ++$smtpMsgs{lc($2)}{$1};
786 } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) {
787 ++$smtpMsgs{lc($2)}{$1};
789 # print UNPROCD "$_\n";
794 # print UNPROCD "$_\n";
801 # die "problem closing \"unprocessed\": $!\n";
803 # Calculate percentage of messages rejected and discarded
804 my $msgsRjctdPct = 0;
805 my $msgsDscrddPct = 0;
806 if(my $msgsTotal = $msgsDlvrd + $msgsRjctd + $msgsDscrdd) {
807 $msgsRjctdPct = int(($msgsRjctd/$msgsTotal) * 100);
808 $msgsDscrddPct = int(($msgsDscrdd/$msgsTotal) * 100);
811 if(defined($dateStr)) {
812 print "Postfix log summaries for $dateStr\n";
815 print "\nGrand Totals\n------------\n";
816 print "messages\n\n";
817 printf " %6d%s received\n", adj_int_units($msgsRcvd);
818 printf " %6d%s delivered\n", adj_int_units($msgsDlvrd);
819 printf " %6d%s forwarded\n", adj_int_units($msgsFwdd);
820 printf " %6d%s deferred", adj_int_units($msgsDfrd);
821 printf " (%d%s deferrals)", adj_int_units($msgsDfrdCnt) if($msgsDfrdCnt);
823 printf " %6d%s bounced\n", adj_int_units($msgsBncd);
824 printf " %6d%s rejected (%d%%)\n", adj_int_units($msgsRjctd), $msgsRjctdPct;
825 printf " %6d%s reject warnings\n", adj_int_units($msgsWrnd);
826 printf " %6d%s held\n", adj_int_units($msgsHld);
827 printf " %6d%s discarded (%d%%)\n", adj_int_units($msgsDscrdd), $msgsDscrddPct;
829 printf " %6d%s bytes received\n", adj_int_units($sizeRcvd);
830 printf " %6d%s bytes delivered\n", adj_int_units($sizeDlvrd);
831 printf " %6d%s senders\n", adj_int_units($sendgUserCnt);
832 printf " %6d%s sending hosts/domains\n", adj_int_units($sendgDomCnt);
833 printf " %6d%s recipients\n", adj_int_units($recipUserCnt);
834 printf " %6d%s recipient hosts/domains\n", adj_int_units($recipDomCnt);
836 # ---Begin: SMTPD_STATS_SUPPORT---
837 if(defined($opts{'smtpdStats'})) {
839 printf " %6d%s connections\n", adj_int_units($smtpdConnCnt);
840 printf " %6d%s hosts/domains\n", adj_int_units(int(keys %smtpdPerDom));
841 printf " %6d avg. connect time (seconds)\n",
842 $smtpdConnCnt > 0? ($smtpdTotTime / $smtpdConnCnt) + .5 : 0;
844 my ($sec, $min, $hr) = get_smh($smtpdTotTime);
845 printf " %2d:%02d:%02d total connect time\n",
849 # ---End: SMTPD_STATS_SUPPORT---
853 print_problems_reports() if(defined($opts{'pf'}));
855 print_per_day_summary(\%msgsPerDay) if($dayCnt > 1);
856 print_per_hour_summary(\@rcvPerHr, \@dlvPerHr, \@dfrPerHr, \@bncPerHr,
857 \@rejPerHr, $dayCnt);
859 print_recip_domain_summary(\%recipDom, $opts{'h'});
860 print_sending_domain_summary(\%sendgDom, $opts{'h'});
862 # ---Begin: SMTPD_STATS_SUPPORT---
863 if(defined($opts{'smtpdStats'})) {
864 print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
865 print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
866 print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
868 # ---End: SMTPD_STATS_SUPPORT---
870 print_user_data(\%sendgUser, "Senders by message count", $msgCntI, $opts{'u'}, $opts{'q'});
871 print_user_data(\%recipUser, "Recipients by message count", $msgCntI, $opts{'u'}, $opts{'q'});
872 print_user_data(\%sendgUser, "Senders by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
873 print_user_data(\%recipUser, "Recipients by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
875 print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1);
877 print_problems_reports() unless(defined($opts{'pf'}));
879 print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'});
881 # Print "problems" reports
882 sub print_problems_reports {
883 unless($opts{'noDeferralDetail'}) {
884 print_nested_hash(\%deferred, "message deferral detail", $opts{'q'});
886 unless($opts{'noBounceDetail'}) {
887 print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'q'});
889 unless($opts{'noRejectDetail'}) {
890 print_nested_hash(\%rejects, "message reject detail", $opts{'q'});
891 print_nested_hash(\%warns, "message reject warning detail", $opts{'q'});
892 print_nested_hash(\%holds, "message hold detail", $opts{'q'});
893 print_nested_hash(\%discards, "message discard detail", $opts{'q'});
895 print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'q'});
896 print_nested_hash(\%warnings, "Warnings", $opts{'q'});
897 print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'q'});
898 print_nested_hash(\%panics, "Panics", 0, $opts{'q'});
899 print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'q'});
903 # flush stdout first cuz of asynchronousity
905 print "\nCurrent Mail Queue\n------------------\n";
909 # print "per-day" traffic summary
910 # (done in a subroutine only to keep main-line code clean)
911 sub print_per_day_summary {
912 my($msgsPerDay) = @_;
914 print <<End_Of_Per_Day_Heading;
916 Per-Day Traffic Summary
917 date received delivered deferred bounced rejected
918 --------------------------------------------------------------------
919 End_Of_Per_Day_Heading
921 foreach (sort { $a <=> $b } keys(%$msgsPerDay)) {
922 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
924 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
926 my $msgMonStr = $monthNames[$msgMon];
927 printf " $msgMonStr %2d $msgYr", $msgDay;
929 foreach $value (@{$msgsPerDay->{$_}}) {
930 my $value2 = $value? $value : 0;
931 printf " %6d%s", adj_int_units($value2);
937 # print "per-hour" traffic summary
938 # (done in a subroutine only to keep main-line code clean)
939 sub print_per_hour_summary {
940 my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_;
941 my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary';
943 print <<End_Of_Per_Hour_Heading;
945 Per-Hour Traffic $reportType
946 time received delivered deferred bounced rejected
947 --------------------------------------------------------------------
948 End_Of_Per_Hour_Heading
950 for($hour = 0; $hour < 24; ++$hour) {
952 printf " %02d:00-%02d:00", $hour, $hour + 1;
954 printf " %02d00-%02d00 ", $hour, $hour + 1;
956 foreach $value (@$rcvPerHr[$hour], @$dlvPerHr[$hour],
957 @$dfrPerHr[$hour], @$bncPerHr[$hour],
961 $value = ($value / $dayCnt) + 0.5 if($dayCnt);
962 printf " %6d%s", adj_int_units($value);
968 # print "per-recipient-domain" traffic summary
969 # (done in a subroutine only to keep main-line code clean)
970 sub print_recip_domain_summary {
972 local($hashRef) = $_[0];
974 return if($cnt == 0);
975 my $topCnt = $cnt > 0? "(top $cnt)" : "";
977 print <<End_Of_Recip_Domain_Heading;
979 Host/Domain Summary: Message Delivery $topCnt
980 sent cnt bytes defers avg dly max dly host/domain
981 -------- ------- ------- ------- ------- -----------
982 End_Of_Recip_Domain_Heading
984 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
985 # there are only delay values if anything was sent
986 if(${$hashRef->{$_}}[$msgCntI]) {
987 $avgDly = (${$hashRef->{$_}}[$msgDlyAvgI] /
988 ${$hashRef->{$_}}[$msgCntI]);
992 printf " %6d%s %6d%s %6d%s %5.1f %s %5.1f %s %s\n",
993 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
994 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
995 adj_int_units(${$hashRef->{$_}}[$msgDfrsI]),
996 adj_time_units($avgDly),
997 adj_time_units(${$hashRef->{$_}}[$msgDlyMaxI]),
1003 # print "per-sender-domain" traffic summary
1004 # (done in a subroutine only to keep main-line code clean)
1005 sub print_sending_domain_summary {
1006 use vars '$hashRef';
1007 local($hashRef) = $_[0];
1009 return if($cnt == 0);
1010 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1011 print <<End_Of_Sender_Domain_Heading;
1013 Host/Domain Summary: Messages Received $topCnt
1014 msg cnt bytes host/domain
1015 -------- ------- -----------
1016 End_Of_Sender_Domain_Heading
1018 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1019 printf " %6d%s %6d%s %s\n",
1020 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1021 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1023 last if --$cnt == 0;
1027 # print "per-user" data sorted in descending order
1028 # order (i.e.: highest first)
1029 sub print_user_data {
1030 my($hashRef, $title, $index, $cnt, $quiet) = @_;
1032 return if($cnt == 0);
1033 $title = sprintf "%s%s", $cnt > 0? "top $cnt " : "", $title;
1036 $dottedLine = ": none";
1038 $dottedLine = "\n" . "-" x length($title);
1040 printf "\n$title$dottedLine\n";
1041 foreach (map { $_->[0] }
1042 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1043 map { [ $_, $hashRef->{$_}[$index], normalize_host($_) ] }
1046 printf " %6d%s %s\n", adj_int_units(${$hashRef->{$_}}[$index]), $_;
1047 last if --$cnt == 0;
1051 # ---Begin: SMTPD_STATS_SUPPORT---
1053 # print "per-hour" smtpd connection summary
1054 # (done in a subroutine only to keep main-line code clean)
1055 sub print_per_hour_smtpd {
1056 my ($smtpdPerHr, $dayCnt) = @_;
1059 print <<End_Of_Per_Hour_Smtp_Average;
1061 Per-Hour SMTPD Connection Daily Average
1062 hour connections time conn.
1063 -------------------------------------
1064 End_Of_Per_Hour_Smtp_Average
1066 print <<End_Of_Per_Hour_Smtp;
1068 Per-Hour SMTPD Connection Summary
1069 hour connections time conn. avg./conn. max. time
1070 --------------------------------------------------------------------
1071 End_Of_Per_Hour_Smtp
1074 for($hour = 0; $hour < 24; ++$hour) {
1075 $smtpdPerHr[$hour]->[0] || next;
1076 my $avg = int($smtpdPerHr[$hour]->[0]?
1077 ($smtpdPerHr[$hour]->[1]/$smtpdPerHr[$hour]->[0]) + .5 : 0);
1079 $smtpdPerHr[$hour]->[0] /= $dayCnt;
1080 $smtpdPerHr[$hour]->[1] /= $dayCnt;
1081 $smtpdPerHr[$hour]->[0] += .5;
1082 $smtpdPerHr[$hour]->[1] += .5;
1084 my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]);
1087 printf " %02d:00-%02d:00", $hour, $hour + 1;
1089 printf " %02d00-%02d00 ", $hour, $hour + 1;
1091 printf " %6d%s %2d:%02d:%02d",
1092 adj_int_units($smtpdPerHr[$hour]->[0]),
1095 printf " %6ds %6ds",
1097 $smtpdPerHr[$hour]->[2];
1104 # print "per-day" smtpd connection summary
1105 # (done in a subroutine only to keep main-line code clean)
1106 sub print_per_day_smtpd {
1107 my ($smtpdPerDay, $dayCnt) = @_;
1108 print <<End_Of_Per_Day_Smtp;
1110 Per-Day SMTPD Connection Summary
1111 date connections time conn. avg./conn. max. time
1112 --------------------------------------------------------------------
1115 foreach (sort { $a <=> $b } keys(%$smtpdPerDay)) {
1116 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1118 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1120 my $msgMonStr = $monthNames[$msgMon];
1121 printf " $msgMonStr %2d $msgYr", $msgDay;
1124 my $avg = (${$smtpdPerDay{$_}}[1]/${$smtpdPerDay{$_}}[0]) + .5;
1125 my($sec, $min, $hr) = get_smh(${$smtpdPerDay{$_}}[1]);
1127 printf " %6d%s %2d:%02d:%02d %6ds %6ds\n",
1128 adj_int_units(${$smtpdPerDay{$_}}[0]),
1131 ${$smtpdPerDay{$_}}[2];
1135 # print "per-domain-smtpd" connection summary
1136 # (done in a subroutine only to keep main-line code clean)
1137 sub print_domain_smtpd_summary {
1138 use vars '$hashRef';
1139 local($hashRef) = $_[0];
1141 return if($cnt == 0);
1142 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1144 print <<End_Of_Domain_Smtp_Heading;
1146 Host/Domain Summary: SMTPD Connections $topCnt
1147 connections time conn. avg./conn. max. time host/domain
1148 ----------- ---------- ---------- --------- -----------
1149 End_Of_Domain_Smtp_Heading
1151 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1152 my $avg = (${$hashRef->{$_}}[1]/${$hashRef->{$_}}[0]) + .5;
1153 my ($sec, $min, $hr) = get_smh(${$hashRef->{$_}}[1]);
1155 printf " %6d%s %2d:%02d:%02d %6ds %6ds %s\n",
1156 adj_int_units(${$hashRef->{$_}}[0]),
1159 ${$hashRef->{$_}}[2],
1161 last if --$cnt == 0;
1165 # ---End: SMTPD_STATS_SUPPORT---
1167 # print hash contents sorted by numeric values in descending
1168 # order (i.e.: highest first)
1169 sub print_hash_by_cnt_vals {
1170 my($hashRef, $title, $cnt, $quiet) = @_;
1172 $title = sprintf "%s%s", $cnt? "top $cnt " : "", $title;
1175 $dottedLine = ": none";
1177 $dottedLine = "\n" . "-" x length($title);
1179 printf "\n$title$dottedLine\n";
1180 really_print_hash_by_cnt_vals($hashRef, $cnt, ' ');
1183 # print hash contents sorted by key in ascending order
1184 sub print_hash_by_key {
1185 my($hashRef, $title, $cnt, $quiet) = @_;
1187 $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title;
1190 $dottedLine = ": none";
1192 $dottedLine = "\n" . "-" x length($title);
1194 printf "\n$title$dottedLine\n";
1195 foreach (sort keys(%$hashRef))
1197 printf " %s %s\n", $_, $hashRef->{$_};
1198 last if --$cnt == 0;
1202 # print "nested" hashes
1203 sub print_nested_hash {
1204 my($hashRef, $title, $quiet) = @_;
1208 $dottedLine = ": none";
1210 $dottedLine = "\n" . "-" x length($title);
1212 printf "\n$title$dottedLine\n";
1213 walk_nested_hash($hashRef, 0);
1216 # "walk" a "nested" hash
1217 sub walk_nested_hash {
1218 my ($hashRef, $level) = @_;
1220 my $indents = ' ' x $level;
1221 my ($keyName, $hashVal) = each(%$hashRef);
1223 if(ref($hashVal) eq 'HASH') {
1224 foreach (sort keys %$hashRef) {
1226 # If the next hash is finally the data, total the
1227 # counts for the report and print
1228 my $hashVal2 = (each(%{$hashRef->{$_}}))[1];
1229 keys(%{$hashRef->{$_}}); # "reset" hash iterator
1230 unless(ref($hashVal2) eq 'HASH') {
1232 $cnt += $_ foreach (values %{$hashRef->{$_}});
1233 print " (total: $cnt)";
1236 walk_nested_hash($hashRef->{$_}, $level);
1239 really_print_hash_by_cnt_vals($hashRef, 0, $indents);
1244 # print per-message info in excruciating detail :-)
1245 sub print_detailed_msg_data {
1246 use vars '$hashRef';
1247 local($hashRef) = $_[0];
1248 my($title, $quiet) = @_[1,2];
1252 $dottedLine = ": none";
1254 $dottedLine = "\n" . "-" x length($title);
1256 printf "\n$title$dottedLine\n";
1257 foreach (sort by_domain_then_user keys(%$hashRef))
1259 printf " %s %s\n", $_, shift(@{$hashRef->{$_}});
1260 foreach (@{$hashRef->{$_}}) {
1267 # *really* print hash contents sorted by numeric values in descending
1268 # order (i.e.: highest first), then by IP/addr, in ascending order.
1269 sub really_print_hash_by_cnt_vals {
1270 my($hashRef, $cnt, $indents) = @_;
1272 foreach (map { $_->[0] }
1273 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1274 map { [ $_, $hashRef->{$_}, normalize_host($_) ] }
1277 printf "$indents%6d%s %s\n", adj_int_units($hashRef->{$_}), $_;
1278 last if --$cnt == 0;
1282 # Normalize IP addr or hostname
1283 # (Note: Makes no effort to normalize IPv6 addrs. Just returns them
1284 # as they're passed-in.)
1285 sub normalize_host {
1286 # For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
1287 my $norm1 = (split(/\s/, $_[0]))[0];
1289 if((my @octets = ($norm1 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/o)) == 4) {
1290 # Dotted-quad IP address
1291 return(pack('C4', @octets));
1293 # Possibly hostname or user@dom.ain
1294 return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 ));
1298 # subroutine to sort by domain, then user in domain, then by queue i.d.
1299 # Note: mixing Internet-style domain names and UUCP-style bang-paths
1300 # may confuse this thing. An attempt is made to use the first host
1301 # preceding the username in the bang-path as the "domain" if none is
1303 sub by_domain_then_user {
1304 # first see if we can get "user@somedomain"
1305 my($userNameA, $domainA) = split(/\@/, ${$hashRef->{$a}}[0]);
1306 my($userNameB, $domainB) = split(/\@/, ${$hashRef->{$b}}[0]);
1308 # try "somedomain!user"?
1309 ($userNameA, $domainA) = (split(/!/, ${$hashRef->{$a}}[0]))[-1,-2]
1311 ($userNameB, $domainB) = (split(/!/, ${$hashRef->{$b}}[0]))[-1,-2]
1314 # now re-order "mach.host.dom"/"mach.host.do.co" to
1315 # "host.dom.mach"/"host.do.co.mach"
1316 $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1318 $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1321 # oddly enough, doing this here is marginally faster than doing
1322 # an "if-else", above. go figure.
1323 $domainA = "" unless($domainA);
1324 $domainB = "" unless($domainB);
1326 if($domainA lt $domainB) {
1328 } elsif($domainA gt $domainB) {
1331 # disregard leading bang-path
1332 $userNameA =~ s/^.*!//o;
1333 $userNameB =~ s/^.*!//o;
1334 if($userNameA lt $userNameB) {
1336 } elsif($userNameA gt $userNameB) {
1349 # Subroutine used by host/domain reports to sort by count, then size.
1350 # We "fix" un-initialized values here as well. Very ugly and un-
1351 # structured to do this here - but it's either that or the callers
1352 # must run through the hashes twice :-(.
1353 sub by_count_then_size {
1354 ${$hashRef->{$a}}[$msgCntI] = 0 unless(${$hashRef->{$a}}[$msgCntI]);
1355 ${$hashRef->{$b}}[$msgCntI] = 0 unless(${$hashRef->{$b}}[$msgCntI]);
1356 if(${$hashRef->{$a}}[$msgCntI] == ${$hashRef->{$b}}[$msgCntI]) {
1357 ${$hashRef->{$a}}[$msgSizeI] = 0 unless(${$hashRef->{$a}}[$msgSizeI]);
1358 ${$hashRef->{$b}}[$msgSizeI] = 0 unless(${$hashRef->{$b}}[$msgSizeI]);
1359 return(${$hashRef->{$a}}[$msgSizeI] <=>
1360 ${$hashRef->{$b}}[$msgSizeI]);
1362 return(${$hashRef->{$a}}[$msgCntI] <=>
1363 ${$hashRef->{$b}}[$msgCntI]);
1367 # return a date string to match in log
1369 my $dateOpt = $_[0];
1371 my $aDay = 60 * 60 * 24;
1374 if($dateOpt eq "yesterday") {
1376 } elsif($dateOpt ne "today") {
1379 my ($t_mday, $t_mon) = (localtime($time))[3,4];
1381 return sprintf("%s %2d", $monthNames[$t_mon], $t_mday);
1384 # if there's a real domain: uses that. Otherwise uses the IP addr.
1385 # Lower-cases returned domain name.
1387 # Optional bit of code elides the last octet of an IPv4 address.
1388 # (In case one wants to assume an IPv4 addr. is a dialup or other
1389 # dynamic IP address in a /24.)
1390 # Does nothing interesting with IPv6 addresses.
1393 my($domain, $ipAddr);
1395 # split domain/ipaddr into separates
1396 # newer versions of Postfix have them "dom.ain[i.p.add.ress]"
1397 # older versions of Postfix have them "dom.ain/i.p.add.ress"
1398 unless((($domain, $ipAddr) = /^([^\[]+)\[([^\]]+)\]/o) == 2 ||
1399 (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/oi) == 2) {
1400 # more exhaustive method
1401 ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o;
1404 # "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
1405 if($domain eq 'unknown') {
1407 # For identifying the host part on a Class C network (commonly
1408 # seen with dial-ups) the following is handy.
1409 # $domain =~ s/\.\d+$//o;
1412 s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o;
1418 # Return (value, units) for integer
1422 $value = 0 unless($value);
1423 if($value > $divByOneMegAt) {
1426 } elsif($value > $divByOneKAt) {
1430 return($value, $units);
1433 # Return (value, units) for time
1434 sub adj_time_units {
1437 $value = 0 unless($value);
1441 } elsif($value > 60) {
1445 return($value, $units);
1448 # Trim a "said:" string, if necessary. Add elipses to show it.
1449 sub said_string_trimmer {
1450 my($trimmedString, $maxLen) = @_;
1452 while(length($trimmedString) > $maxLen) {
1453 if($trimmedString =~ /^.* said: /o) {
1454 $trimmedString =~ s/^.* said: //o;
1455 } elsif($trimmedString =~ /^.*: */o) {
1456 $trimmedString =~ s/^.*?: *//o;
1458 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
1463 return $trimmedString;
1466 # Trim a string, if necessary. Add elipses to show it.
1467 sub string_trimmer {
1468 my($trimmedString, $maxLen, $doNotTrim) = @_;
1470 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..."
1471 if(! $doNotTrim && (length($trimmedString) > $maxLen));
1472 return $trimmedString;
1475 # Get seconds, minutes and hours from seconds
1478 my $hr = int($sec / 3600);
1480 my $min = int($sec / 60);
1482 return($sec, $min, $hr);
1485 # Process smtpd rejects
1486 sub proc_smtpd_reject {
1487 my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_;
1488 my ($rejTyp, $rejFrom, $rejRmdr, $rejReas);
1492 # This could get real ugly!
1494 # First: get everything following the "reject: ", etc. token
1495 # Was an IPv6 problem here
1496 ($rejTyp, $rejFrom, $rejRmdr) =
1497 ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/o);
1499 # Next: get the reject "reason"
1500 $rejReas = $rejRmdr;
1501 unless(defined($opts{'verbMsgDetail'})) {
1502 if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") { # special treatment :-(
1503 # If there are "<>"s immediately following the reject code, that's
1504 # an email address or HELO string. There can be *anything* in
1505 # those--incl. stuff that'll screw up subsequent parsing. So just
1506 # get rid of it right off.
1507 $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/o;
1508 $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/o;
1509 $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/o;
1510 $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/o;
1511 } elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr...
1512 $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o;
1514 $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o;
1518 # Snag recipient address
1519 # Second expression is for unknown recipient--where there is no
1520 # "to=<mumble>" field, third for pathological case where recipient
1521 # field is unterminated, forth when all else fails.
1522 (($to) = $rejRmdr =~ /to=<([^>]+)>/o) ||
1523 (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /o) ||
1524 (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/o) ||
1527 # Snag sender address
1528 (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>");
1530 if(defined($from)) {
1531 $rejAddFrom = $opts{'rejAddFrom'};
1532 $from = verp_mung($from);
1535 # stash in "triple-subscripted-array"
1536 if($rejReas =~ m/^Sender address rejected:/o) {
1537 # Sender address rejected: Domain not found
1538 # Sender address rejected: need fully-qualified address
1539 ++$rejects->{$rejTyp}{$rejReas}{$from};
1540 } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/o) {
1541 # Recipient address rejected: Domain not found
1542 # Recipient address rejected: need fully-qualified address
1543 # User unknown (in local/relay recipient table)
1544 #++$rejects->{$rejTyp}{$rejReas}{$to};
1547 $rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
1549 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1550 } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) {
1551 # Was an IPv6 problem here
1552 my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o;
1553 ++$rejects->{$rejTyp}{$rejReas}{$src};
1554 } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) {
1555 my $rejData = gimme_domain($rejFrom);
1556 $rejData .= " ($from)" if($rejAddFrom);
1557 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1558 } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/o) {
1559 my $rejData = gimme_domain($rejFrom);
1560 $rejData .= " ($from)" if($rejAddFrom);
1561 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1563 # print STDERR "dbg: unknown reject reason $rejReas !\n\n";
1564 my $rejData = gimme_domain($rejFrom);
1565 $rejData .= " ($from)" if($rejAddFrom);
1566 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1573 # Hack for VERP (?) - convert address from somthing like
1574 # "list-return-36-someuser=someplace.com@lists.domain.com"
1575 # to "list-return-ID-someuser=someplace.com@lists.domain.com"
1576 # to prevent per-user listing "pollution." More aggressive
1577 # munging converts to something like
1578 # "list-return@lists.domain.com" (Instead of "return," there
1579 # may be numeric list name/id, "warn", "error", etc.?)
1583 if(defined($opts{'verpMung'})) {
1584 $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi;
1585 if($opts{'verpMung'} > 1) {
1586 $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o;
1594 ### Warning and Error Routines
1597 # Emit warning message to stderr
1599 warn "warning: $progName: $_[0]\n";