2 eval 'exec perl -S $0 "$@"'
7 pflogsumm.pl - Produce Postfix MTA logfile summary
9 Copyright (C) 1998-2010 by James S. Seymour, Release 1.1.5
13 pflogsumm.pl -[eq] [-d <today|yesterday>] [--detail <cnt>]
14 [--bounce-detail <cnt>] [--deferral-detail <cnt>]
15 [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
16 [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
17 [--rej-add-from] [--reject-detail <cnt>] [--smtp-detail <cnt>]
18 [--smtpd-stats] [--smtpd-warning-detail <cnt>]
19 [--syslog-name=string] [-u <cnt>] [--verbose-msg-detail]
20 [--verp-mung[=<n>]] [--zero-fill] [file1 [filen]]
22 pflogsumm.pl -[help|version]
24 If no file(s) specified, reads from stdin. Output is to stdout.
28 Pflogsumm is a log analyzer/summarizer for the Postfix MTA. It is
29 designed to provide an over-view of Postfix activity, with just enough
30 detail to give the administrator a "heads up" for potential trouble
33 Pflogsumm generates summaries and, in some cases, detailed reports of
34 mail server traffic volumes, rejected and bounced email, and server
35 warnings, errors and panics.
41 Limit detailed bounce reports to the top <cnt>. 0
44 -d today generate report for just today
45 -d yesterday generate report for just "yesterday"
47 --deferral-detail <cnt>
49 Limit detailed deferral reports to the top <cnt>. 0
54 Sets all --*-detail, -h and -u to <cnt>. Is
55 over-ridden by individual settings. --detail 0
56 suppresses *all* detail.
58 -e extended (extreme? excessive?) detail
60 Emit detailed reports. At present, this includes
61 only a per-message report, sorted by sender domain,
62 then user-in-domain, then by queue i.d.
64 WARNING: the data built to generate this report can
65 quickly consume very large amounts of memory if a
66 lot of log entries are processed!
68 -h <cnt> top <cnt> to display in host/domain reports.
72 See also: "-u" and "--*-detail" options for further
73 report-limiting options.
75 --help Emit short usage message and bail out.
77 (By happy coincidence, "-h" alone does much the same,
78 being as it requires a numeric argument :-). Yeah, I
82 --ignore-case Handle complete email address in a case-insensitive
85 Normally pflogsumm lower-cases only the host and
86 domain parts, leaving the user part alone. This
87 option causes the entire email address to be lower-
92 For summaries that contain date or time information,
93 use ISO 8601 standard formats (CCYY-MM-DD and HH:MM),
94 rather than "Mon DD CCYY" and "HHMM".
96 -m modify (mung?) UUCP-style bang-paths
99 This is for use when you have a mix of Internet-style
100 domain addresses and UUCP-style bang-paths in the log.
101 Upstream UUCP feeds sometimes mung Internet domain
102 style address into bang-paths. This option can
103 sometimes undo the "damage". For example:
104 "somehost.dom!username@foo" (where "foo" is the next
105 host upstream and "somehost.dom" was whence the email
106 originated) will get converted to
107 "foo!username@somehost.dom". This also affects the
108 extended detail report (-e), to help ensure that by-
109 domain-by-name sorting is more accurate.
111 --mailq Run "mailq" command at end of report.
113 Merely a convenience feature. (Assumes that "mailq"
114 is in $PATH. See "$mailqCmd" variable to path thisi
121 These switches are deprecated in favour of
122 --bounce-detail, --deferral-detail and
123 --reject-detail, respectively.
125 Suppresses the printing of the following detailed
126 reports, respectively:
128 message bounce detail (by relay)
129 message deferral detail
130 message reject detail
132 See also: "-u" and "-h" for further report-limiting
137 Do not emit report on "Messages with no size data".
139 Message size is reported only by the queue manager.
140 The message may be delivered long-enough after the
141 (last) qmgr log entry that the information is not in
142 the log(s) processed by a particular run of
143 pflogsumm.pl. This throws off "Recipients by message
144 size" and the total for "bytes delivered." These are
145 normally reported by pflogsumm as "Messages with no
150 This switch is deprecated in favour of
153 On a busy mail server, say at an ISP, SMTPD warnings
154 can result in a rather sizeable report. This option
155 turns reporting them off.
159 Emit "problems" reports (bounces, defers, warnings,
160 etc.) before "normal" stats.
163 For those reject reports that list IP addresses or
164 host/domain names: append the email from address to
165 each listing. (Does not apply to "Improper use of
166 SMTP command pipelining" report.)
168 -q quiet - don't print headings for empty reports
170 note: headings for warning, fatal, and "master"
171 messages will always be printed.
173 --reject-detail <cnt>
175 Limit detailed smtpd reject, warn, hold and discard
176 reports to the top <cnt>. 0 to suppress entirely.
180 Limit detailed smtp delivery reports to the top <cnt>.
181 0 to suppress entirely.
185 Generate smtpd connection statistics.
187 The "per-day" report is not generated for single-day
188 reports. For multiple-day reports: "per-hour" numbers
189 are daily averages (reflected in the report heading).
191 --smtpd-warning-detail <cnt>
193 Limit detailed smtpd warnings reports to the top <cnt>.
194 0 to suppress entirely.
198 Set syslog-name to look for for Postfix log entries.
200 By default, pflogsumm looks for entries in logfiles
201 with a syslog name of "postfix," the default.
202 If you've set a non-default "syslog_name" parameter
203 in your Postfix configuration, use this option to
204 tell pflogsumm what that is.
206 See the discussion about the use of this option under
209 -u <cnt> top <cnt> to display in user reports. 0 == none.
211 See also: "-h" and "--*-detail" options for further
212 report-limiting options.
216 For the message deferral, bounce and reject summaries:
217 display the full "reason", rather than a truncated one.
219 Note: this can result in quite long lines in the report.
221 --verp-mung do "VERP" generated address (?) munging. Convert
222 --verp-mung=2 sender addresses of the form
223 "list-return-NN-someuser=some.dom@host.sender.dom"
225 "list-return-ID-someuser=some.dom@host.sender.dom"
227 In other words: replace the numeric value with "ID".
229 By specifying the optional "=2" (second form), the
230 munging is more "aggressive", converting the address
233 "list-return@host.sender.dom"
235 Actually: specifying anything less than 2 does the
236 "simple" munging and anything greater than 1 results
237 in the more "aggressive" hack being applied.
239 See "NOTES" regarding this option.
241 --version Print program name and version and bail out.
243 --zero-fill "Zero-fill" certain arrays so reports come out with
244 data in columns that that might otherwise be blank.
248 Pflogsumm doesn't return anything of interest to the shell.
252 Error messages are emitted to stderr.
256 Produce a report of previous day's activities:
258 pflogsumm.pl -d yesterday /var/log/maillog
260 A report of prior week's activities (after logs rotated):
262 pflogsumm.pl /var/log/maillog.0
264 What's happened so far today:
266 pflogsumm.pl -d today /var/log/maillog
268 Crontab entry to generate a report of the previous day's activity
269 at 10 minutes after midnight.
271 10 0 * * * /usr/local/sbin/pflogsumm -d yesterday /var/log/maillog
272 2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
274 Crontab entry to generate a report for the prior week's activity.
275 (This example assumes one rotates ones mail logs weekly, some time
276 before 4:10 a.m. on Sunday.)
278 10 4 * * 0 /usr/local/sbin/pflogsumm /var/log/maillog.0
279 2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
281 The two crontab examples, above, must actually be a single line
282 each. They're broken-up into two-or-more lines due to page
287 The pflogsumm FAQ: pflogsumm-faq.txt.
291 Pflogsumm makes no attempt to catch/parse non-Postfix log
292 entries. Unless it has "postfix/" in the log entry, it will be
295 It's important that the logs are presented to pflogsumm in
296 chronological order so that message sizes are available when
299 For display purposes: integer values are munged into "kilo" and
300 "mega" notation as they exceed certain values. I chose the
301 admittedly arbitrary boundaries of 512k and 512m as the points at
302 which to do this--my thinking being 512x was the largest number
303 (of digits) that most folks can comfortably grok at-a-glance.
304 These are "computer" "k" and "m", not 1000 and 1,000,000. You
305 can easily change all of this with some constants near the
306 beginning of the program.
308 "Items-per-day" reports are not generated for single-day
309 reports. For multiple-day reports: "Items-per-hour" numbers are
310 daily averages (reflected in the report headings).
312 Message rejects, reject warnings, holds and discards are all
313 reported under the "rejects" column for the Per-Hour and Per-Day
316 Verp munging may not always result in correct address and
317 address-count reduction.
319 Verp munging is always in a state of experimentation. The use
320 of this option may result in inaccurate statistics with regards
321 to the "senders" count.
323 UUCP-style bang-path handling needs more work. Particularly if
324 Postfix is not being run with "swap_bangpath = yes" and/or *is* being
325 run with "append_dot_mydomain = yes", the detailed by-message report
326 may not be sorted correctly by-domain-by-user. (Also depends on
327 upstream MTA, I suspect.)
329 The "percent rejected" and "percent discarded" figures are only
330 approximations. They are calculated as follows (example is for
335 (rejected / (delivered + rejected + discarded)) * 100
337 There are some issues with the use of --syslog-name. The problem is
338 that, even with Postfix' $syslog_name set, it will sometimes still
339 log things with "postfix" as the syslog_name. This is noted in
340 /etc/postfix/sample-misc.cf:
342 # Beware: a non-default syslog_name setting takes effect only
343 # after process initialization. Some initialization errors will be
344 # logged with the default name, especially errors while parsing
345 # the command line and errors while accessing the Postfix main.cf
346 # configuration file.
348 As a consequence, pflogsumm must always look for "postfix," in logs,
349 as well as whatever is supplied for syslog_name.
351 Where this becomes an issue is where people are running two or more
352 instances of Postfix, logging to the same file. In such a case:
354 . Neither instance may use the default "postfix" syslog name
357 . Log entries that fall victim to what's described in
358 sample-misc.cf will be reported under "postfix", so that if
359 you're running pflogsumm twice, once for each syslog_name, such
360 log entries will show up in each report.
362 The Pflogsumm Home Page is at:
364 http://jimsun.LinxNet.com/postfix_contrib.html
368 For certain options (e.g.: --smtpd-stats), Pflogsumm requires the
369 Date::Calc module, which can be obtained from CPAN at
372 Pflogsumm is currently written and tested under Perl 5.8.3.
373 As of version 19990413-02, pflogsumm worked with Perl 5.003, but
374 future compatibility is not guaranteed.
378 This program is free software; you can redistribute it and/or
379 modify it under the terms of the GNU General Public License
380 as published by the Free Software Foundation; either version 2
381 of the License, or (at your option) any later version.
383 This program is distributed in the hope that it will be useful,
384 but WITHOUT ANY WARRANTY; without even the implied warranty of
385 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
386 GNU General Public License for more details.
388 You may have received a copy of the GNU General Public License
389 along with this program; if not, write to the Free Software
390 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
393 An on-line copy of the GNU General Public License can be found
394 http://www.fsf.org/copyleft/gpl.html.
401 eval { require Date::Calc };
402 my $hasDateCalc = $@ ? 0 : 1;
404 my $mailqCmd = "mailq";
405 my $release = "1.1.5";
407 # Variables and constants used throughout pflogsumm
412 $divByOneKAt $divByOneMegAt $oneK $oneMeg
413 @monthNames %monthNums $thisYr $thisMon
414 $msgCntI $msgSizeI $msgDfrsI $msgDlyAvgI $msgDlyMaxI
418 # Some constants used by display routines. I arbitrarily chose to
419 # display in kilobytes and megabytes at the 512k and 512m boundaries,
420 # respectively. Season to taste.
421 $divByOneKAt = 524288; # 512k
422 $divByOneMegAt = 536870912; # 512m
424 $oneMeg = 1048576; # 1m
426 # Constants used throughout pflogsumm
427 @monthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
429 Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
430 Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11);
431 ($thisMon, $thisYr) = (localtime(time()))[4,5];
435 # Variables used only in main loop
438 my (%recipUser, $recipUserCnt);
439 my (%sendgUser, $sendgUserCnt);
441 my (%recipDom, $recipDomCnt); # recipient domain data
442 my (%sendgDom, $sendgDomCnt); # sending domain data
443 # Indexes for arrays in above
444 $msgCntI = 0; # message count
445 $msgSizeI = 1; # total messages size
446 $msgDfrsI = 2; # number of defers
447 $msgDlyAvgI = 3; # total of delays (used for averaging)
448 $msgDlyMaxI = 4; # max delay
451 $cmd, $qid, $addr, $size, $relay, $status, $delay,
452 $dateStr, $dateStrRFC3339,
453 %panics, %fatals, %warnings, %masterMsgs,
456 %noMsgSize, %msgDetail,
457 $msgsRcvd, $msgsDlvrd, $sizeRcvd, $sizeDlvrd,
458 $msgMonStr, $msgMon, $msgDay, $msgTimeStr, $msgHr, $msgMin, $msgSec,
460 $revMsgDateStr, $dayCnt, %msgsPerDay,
461 %rejects, $msgsRjctd,
463 %discards, $msgsDscrdd,
465 %rcvdMsg, $msgsFwdd, $msgsBncd,
466 $msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
467 %connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
470 $dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
472 # Init total messages delivered, rejected, and discarded
473 $msgsDlvrd = $msgsRjctd = $msgsDscrdd = 0;
475 # Init messages received and delivered per hour
476 my @rcvPerHr = (0) x 24;
477 my @dlvPerHr = @rcvPerHr;
478 my @dfrPerHr = @rcvPerHr; # defers per hour
479 my @bncPerHr = @rcvPerHr; # bounces per hour
480 my @rejPerHr = @rcvPerHr; # rejects per hour
483 # Init "doubly-sub-scripted array": cnt, total and max time per-hour
486 $smtpdPerHr[$_] = [0,0,0];
489 ($progName = $0) =~ s/^.*\///;
492 "usage: $progName -[eq] [-d <today|yesterday>] [--detail <cnt>]
493 [--bounce-detail <cnt>] [--deferral-detail <cnt>]
494 [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
495 [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
496 [--rej-add-from] [--reject-detail <cnt>] [--smtp-detail <cnt>]
497 [--smtpd-stats] [--smtpd-warning-detail <cnt>]
498 [--syslog-name=string] [-u <cnt>] [--verbose-msg-detail]
499 [--verp-mung[=<n>]] [--zero-fill] [file1 [filen]]
501 $progName --[version|help]";
503 # Accept either "_"s or "-"s in --switches
509 # Some pre-inits for convenience
510 $isoDateTime = 0; # Don't use ISO date/time formats
512 "bounce-detail=i" => \$opts{'bounceDetail'},
513 "d=s" => \$opts{'d'},
514 "deferral-detail=i" => \$opts{'deferralDetail'},
515 "detail=i" => \$opts{'detail'},
517 "help" => \$opts{'help'},
518 "h=i" => \$opts{'h'},
519 "ignore-case" => \$opts{'i'},
521 "iso-date-time" => \$isoDateTime,
522 "mailq" => \$opts{'mailq'},
524 "no-bounce-detail" => \$opts{'noBounceDetail'},
525 "no-deferral-detail" => \$opts{'noDeferralDetail'},
526 "no-no-msg-size" => \$opts{'noNoMsgSize'},
527 "no-reject-detail" => \$opts{'noRejectDetail'},
528 "no-smtpd-warnings" => \$opts{'noSMTPDWarnings'},
529 "problems-first" => \$opts{'pf'},
531 "rej-add-from" => \$opts{'rejAddFrom'},
532 "reject-detail=i" => \$opts{'rejectDetail'},
533 "smtp-detail=i" => \$opts{'smtpDetail'},
534 "smtpd-stats" => \$opts{'smtpdStats'},
535 "smtpd-warning-detail=i" => \$opts{'smtpdWarnDetail'},
536 "syslog-name=s" => \$opts{'syslogName'},
537 "u=i" => \$opts{'u'},
538 "uucp-mung" => \$opts{'m'},
539 "verbose-msg-detail" => \$opts{'verbMsgDetail'},
540 "verp-mung:i" => \$opts{'verpMung'},
541 "version" => \$opts{'version'},
542 "zero-fill" => \$opts{'zeroFill'}
543 ) || die "$usageMsg\n";
545 # internally: 0 == none, undefined == -1 == all
546 $opts{'h'} = -1 unless(defined($opts{'h'}));
547 $opts{'u'} = -1 unless(defined($opts{'u'}));
548 $opts{'bounceDetail'} = -1 unless(defined($opts{'bounceDetail'}));
549 $opts{'deferralDetail'} = -1 unless(defined($opts{'deferralDetail'}));
550 $opts{'smtpDetail'} = -1 unless(defined($opts{'smtpDetail'}));
551 $opts{'smtpdWarnDetail'} = -1 unless(defined($opts{'smtpdWarnDetail'}));
552 $opts{'rejectDetail'} = -1 unless(defined($opts{'rejectDetail'}));
554 # These go away eventually
555 if(defined($opts{'noBounceDetail'})) {
556 $opts{'bounceDetail'} = 0;
557 warn "$progName: \"no_bounce_detail\" is deprecated, use \"bounce-detail=0\" instead\n"
559 if(defined($opts{'noDeferralDetail'})) {
560 $opts{'deferralDetail'} = 0;
561 warn "$progName: \"no_deferral_detail\" is deprecated, use \"deferral-detail=0\" instead\n"
563 if(defined($opts{'noRejectDetail'})) {
564 $opts{'rejectDetail'} = 0;
565 warn "$progName: \"no_reject_detail\" is deprecated, use \"reject-detail=0\" instead\n"
567 if(defined($opts{'noSMTPDWarnings'})) {
568 $opts{'smtpdWarnDetail'} = 0;
569 warn "$progName: \"no_smtpd_warnings\" is deprecated, use \"smtpd-warning-detail=0\" instead\n"
572 # If --detail was specified, set anything that's not enumerated to it
573 if(defined($opts{'detail'})) {
574 foreach my $optName (qw (h u bounceDetail deferralDetail smtpDetail smtpdWarnDetail rejectDetail)) {
575 $opts{$optName} = $opts{'detail'} unless($opts{"$optName"} != -1);
579 my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
581 if(defined($opts{'help'})) {
586 if(defined($opts{'version'})) {
587 print "$progName $release\n";
592 # manually import the Date::Calc routine we want
594 # This looks stupid, but it's the only way to shut Perl up about
595 # "Date::Calc::Delta_DHMS" used only once" if -w is on. (No,
596 # $^W = 0 doesn't work in this context.)
597 *Delta_DHMS = *Date::Calc::Delta_DHMS;
598 *Delta_DHMS = *Date::Calc::Delta_DHMS;
600 } elsif(defined($opts{'smtpdStats'})) {
601 # If user specified --smtpd-stats but doesn't have Date::Calc
602 # installed, die with friendly help message.
603 die <<End_Of_HELP_DATE_CALC;
605 The option "--smtpd-stats" does calculations that require the
606 Date::Calc Perl module, but you don't have this module installed.
607 If you want to use this extended functionality of Pflogsumm, you
608 will have to install this module. If you have root privileges
609 on the machine, this is as simple as performing the following
612 perl -MCPAN -e 'install Date::Calc'
614 End_Of_HELP_DATE_CALC
617 ($dateStr, $dateStrRFC3339) = get_datestrs($opts{'d'}) if(defined($opts{'d'}));
620 #open(UNPROCD, "> unprocessed") ||
621 # die "couldn't open \"unprocessed\": $!\n";
624 next if(defined($dateStr) && ! (/^${dateStr} / || /^${dateStrRFC3339}T/));
625 s/: \[ID \d+ [^\]]+\] /: /; # lose "[ID nnnnnn some.thing]" stuff
628 # "Traditional" timestamp format?
629 if((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
630 /^(...) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/) == 6)
632 # Convert string to numeric value for later "month rollover" check
633 $msgMon = $monthNums{$msgMonStr};
635 # RFC 3339 timestamp format?
636 next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
637 /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:[\+\-](?:\d{2}):(?:\d{2})|Z) \S+ (.+)$/) == 7);
638 # RFC 3339 months start at "1", we index from 0
642 unless((($cmd, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)(?:/(?:smtps|submission))?/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
643 (($cmd, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
650 # If the log line's month is greater than our current month,
651 # we've probably had a year rollover
652 # FIXME: For processing old logfiles: This is a broken test!
653 $msgYr = ($msgMon > $thisMon? $thisYr - 1 : $thisYr);
655 # the following test depends on one getting more than one message a
656 # month--or at least that successive messages don't arrive on the
657 # same month-day in successive months :-)
658 unless($msgDay == $lastMsgDay) {
659 $lastMsgDay = $msgDay;
660 $revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay;
662 if(defined($opts{'zeroFill'})) {
663 ${$msgsPerDay{$revMsgDateStr}}[4] = 0;
667 # regexp rejects happen in "cleanup"
668 if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
669 /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/) == 3)
671 $rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbMsgDetail'});
672 $rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
673 if($rejSubTyp eq "reject") {
674 ++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
676 } elsif($rejSubTyp eq "warning") {
677 ++$warns{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
679 } elsif($rejSubTyp eq "hold") {
680 ++$holds{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
682 } elsif($rejSubTyp eq "discard") {
683 ++$discards{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
687 ++${$msgsPerDay{$revMsgDateStr}}[4];
688 } elsif($qid eq 'warning') {
689 (my $warnReas = $logRmdr) =~ s/^.*warning: //;
690 $warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
691 unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
692 ++$warnings{$cmd}{$warnReas};
694 } elsif($qid eq 'fatal') {
695 (my $fatalReas = $logRmdr) =~ s/^.*fatal: //;
696 $fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
697 ++$fatals{$cmd}{$fatalReas};
698 } elsif($qid eq 'panic') {
699 (my $panicReas = $logRmdr) =~ s/^.*panic: //;
700 $panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
701 ++$panics{$cmd}{$panicReas};
702 } elsif($qid eq 'reject') {
703 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr],
704 \${$msgsPerDay{$revMsgDateStr}}[4]);
705 } elsif($qid eq 'reject_warning') {
706 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr],
707 \${$msgsPerDay{$revMsgDateStr}}[4]);
708 } elsif($qid eq 'hold') {
709 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr],
710 \${$msgsPerDay{$revMsgDateStr}}[4]);
711 } elsif($qid eq 'discard') {
712 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr],
713 \${$msgsPerDay{$revMsgDateStr}}[4]);
714 } elsif($cmd eq 'master') {
715 ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
716 } elsif($cmd eq 'smtpd') {
717 if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/) {
719 # Warning: this code in two places!
722 ++${$msgsPerDay{$revMsgDateStr}}[0];
724 $rcvdMsg{$qid} = gimme_domain($1); # Whence it came
726 #print STDERR "Received: $qid\n";
727 } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /) {
728 if($rejSubTyp eq 'reject') {
729 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
731 \${$msgsPerDay{$revMsgDateStr}}[4]);
732 } elsif($rejSubTyp eq 'reject_warning') {
733 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
735 \${$msgsPerDay{$revMsgDateStr}}[4]);
736 } elsif($rejSubTyp eq 'hold') {
737 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld,
739 \${$msgsPerDay{$revMsgDateStr}}[4]);
740 } elsif($rejSubTyp eq 'discard') {
741 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd,
743 \${$msgsPerDay{$revMsgDateStr}}[4]);
747 next unless(defined($opts{'smtpdStats'}));
748 if($logRmdr =~ /: connect from /) {
749 $logRmdr =~ /\/smtpd\[(\d+)\]: /;
751 ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
752 } elsif($logRmdr =~ /: disconnect from /) {
753 my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/;
754 if(exists($connTime{$pid})) {
755 $hostID = gimme_domain($hostID);
756 my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
757 $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
758 delete($connTime{$pid}); # dispose of no-longer-needed item
759 my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
761 ++$smtpdPerHr[$msgHr][0];
762 $smtpdPerHr[$msgHr][1] += $tSecs;
763 $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
765 unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
766 ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
767 ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
769 ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
770 ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
771 if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
773 unless(${$smtpdPerDom{$hostID}}[0]++) {
774 ${$smtpdPerDom{$hostID}}[1] = 0;
775 ${$smtpdPerDom{$hostID}}[2] = 0;
777 ${$smtpdPerDom{$hostID}}[1] += $tSecs;
778 ${$smtpdPerDom{$hostID}}[2] = $tSecs
779 if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
782 $smtpdTotTime += $tSecs;
788 if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/) == 2)
790 next if($msgSizes{$qid}); # avoid double-counting!
792 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
793 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
795 $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
796 $addr = lc($addr) if($opts{'i'});
797 $addr = verp_mung($addr);
801 $msgSizes{$qid} = $size;
802 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
803 # Avoid counting forwards
805 # Get the domain out of the sender's address. If there is
806 # none: Use the client hostname/IP-address
808 unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/) == 1) {
809 $domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
812 unless(${$sendgDom{$domAddr}}[$msgCntI]);
813 ++${$sendgDom{$domAddr}}[$msgCntI];
814 ${$sendgDom{$domAddr}}[$msgSizeI] += $size;
815 ++$sendgUserCnt unless(${$sendgUser{$addr}}[$msgCntI]);
816 ++${$sendgUser{$addr}}[$msgCntI];
817 ${$sendgUser{$addr}}[$msgSizeI] += $size;
819 delete($rcvdMsg{$qid}); # limit hash size
822 elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
823 /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/) >= 4)
826 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
827 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
829 $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
830 $addr = lc($addr) if($opts{'i'});
831 $relay = lc($relay) if($opts{'i'});
832 (my $domAddr = $addr) =~ s/^[^@]+\@//; # get domain only
833 if($status eq 'sent') {
835 # was it actually forwarded, rather than delivered?
836 if($toRmdr =~ /forwarded as /) {
840 ++$recipDomCnt unless(${$recipDom{$domAddr}}[$msgCntI]);
841 ++${$recipDom{$domAddr}}[$msgCntI];
842 ${$recipDom{$domAddr}}[$msgDlyAvgI] += $delay;
843 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
844 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
846 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
848 ++$recipUserCnt unless(${$recipUser{$addr}}[$msgCntI]);
849 ++${$recipUser{$addr}}[$msgCntI];
851 ++${$msgsPerDay{$revMsgDateStr}}[1];
854 #print STDERR "Delivered: $qid\n";
855 if($msgSizes{$qid}) {
856 ${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid};
857 ${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid};
858 $sizeDlvrd += $msgSizes{$qid};
860 ${$recipDom{$domAddr}}[$msgSizeI] += 0;
861 ${$recipUser{$addr}}[$msgSizeI] += 0;
862 $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'});
863 push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'});
864 # put this back later? mebbe with -v?
865 # msg_warn("no message size for qid: $qid");
867 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
868 } elsif($status eq 'deferred') {
869 unless($opts{'deferralDetail'} == 0) {
870 my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
871 unless(defined($opts{'verbMsgDetail'})) {
872 $deferredReas = said_string_trimmer($deferredReas, 65);
873 $deferredReas =~ s/^\d{3} //;
874 $deferredReas =~ s/^connect to //;
876 ++$deferred{$cmd}{$deferredReas};
879 ++${$msgsPerDay{$revMsgDateStr}}[2];
881 ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
882 ++${$recipDom{$domAddr}}[$msgDfrsI];
883 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
884 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
886 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
888 } elsif($status eq 'bounced') {
889 unless($opts{'bounceDetail'} == 0) {
890 my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
891 unless(defined($opts{'verbMsgDetail'})) {
892 $bounceReas = said_string_trimmer($bounceReas, 66);
893 $bounceReas =~ s/^\d{3} //;
895 ++$bounced{$relay}{$bounceReas};
898 ++${$msgsPerDay{$revMsgDateStr}}[3];
901 # print UNPROCD "$_\n";
904 elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/) {
906 # Warning: this code in two places!
909 ++${$msgsPerDay{$revMsgDateStr}}[0];
911 $rcvdMsg{$qid} = "pickup"; # Whence it came
913 elsif($cmd eq 'smtp' && $opts{'smtpDetail'} != 0) {
914 # Was an IPv6 problem here
915 if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/) {
916 ++$smtpMsgs{lc($2)}{$1};
917 } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/) {
918 ++$smtpMsgs{lc($2)}{$1};
920 # print UNPROCD "$_\n";
925 # print UNPROCD "$_\n";
932 # die "problem closing \"unprocessed\": $!\n";
934 # Calculate percentage of messages rejected and discarded
935 my $msgsRjctdPct = 0;
936 my $msgsDscrddPct = 0;
937 if(my $msgsTotal = $msgsDlvrd + $msgsRjctd + $msgsDscrdd) {
938 $msgsRjctdPct = int(($msgsRjctd/$msgsTotal) * 100);
939 $msgsDscrddPct = int(($msgsDscrdd/$msgsTotal) * 100);
942 if(defined($dateStr)) {
943 print "Postfix log summaries for $dateStr\n";
946 print_subsect_title("Grand Totals");
947 print "messages\n\n";
948 printf " %6d%s received\n", adj_int_units($msgsRcvd);
949 printf " %6d%s delivered\n", adj_int_units($msgsDlvrd);
950 printf " %6d%s forwarded\n", adj_int_units($msgsFwdd);
951 printf " %6d%s deferred", adj_int_units($msgsDfrd);
952 printf " (%d%s deferrals)", adj_int_units($msgsDfrdCnt) if($msgsDfrdCnt);
954 printf " %6d%s bounced\n", adj_int_units($msgsBncd);
955 printf " %6d%s rejected (%d%%)\n", adj_int_units($msgsRjctd), $msgsRjctdPct;
956 printf " %6d%s reject warnings\n", adj_int_units($msgsWrnd);
957 printf " %6d%s held\n", adj_int_units($msgsHld);
958 printf " %6d%s discarded (%d%%)\n", adj_int_units($msgsDscrdd), $msgsDscrddPct;
960 printf " %6d%s bytes received\n", adj_int_units($sizeRcvd);
961 printf " %6d%s bytes delivered\n", adj_int_units($sizeDlvrd);
962 printf " %6d%s senders\n", adj_int_units($sendgUserCnt);
963 printf " %6d%s sending hosts/domains\n", adj_int_units($sendgDomCnt);
964 printf " %6d%s recipients\n", adj_int_units($recipUserCnt);
965 printf " %6d%s recipient hosts/domains\n", adj_int_units($recipDomCnt);
967 if(defined($opts{'smtpdStats'})) {
969 printf " %6d%s connections\n", adj_int_units($smtpdConnCnt);
970 printf " %6d%s hosts/domains\n", adj_int_units(int(keys %smtpdPerDom));
971 printf " %6d avg. connect time (seconds)\n",
972 $smtpdConnCnt > 0? ($smtpdTotTime / $smtpdConnCnt) + .5 : 0;
974 my ($sec, $min, $hr) = get_smh($smtpdTotTime);
975 printf " %2d:%02d:%02d total connect time\n",
982 print_problems_reports() if(defined($opts{'pf'}));
984 print_per_day_summary(\%msgsPerDay) if($dayCnt > 1);
985 print_per_hour_summary(\@rcvPerHr, \@dlvPerHr, \@dfrPerHr, \@bncPerHr,
986 \@rejPerHr, $dayCnt);
988 print_recip_domain_summary(\%recipDom, $opts{'h'});
989 print_sending_domain_summary(\%sendgDom, $opts{'h'});
991 if(defined($opts{'smtpdStats'})) {
992 print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
993 print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
994 print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
997 print_user_data(\%sendgUser, "Senders by message count", $msgCntI, $opts{'u'}, $opts{'q'});
998 print_user_data(\%recipUser, "Recipients by message count", $msgCntI, $opts{'u'}, $opts{'q'});
999 print_user_data(\%sendgUser, "Senders by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
1000 print_user_data(\%recipUser, "Recipients by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
1002 print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1);
1004 print_problems_reports() unless(defined($opts{'pf'}));
1006 print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'});
1008 # Print "problems" reports
1009 sub print_problems_reports {
1010 unless($opts{'deferralDetail'} == 0) {
1011 print_nested_hash(\%deferred, "message deferral detail", $opts{'deferralDetail'}, $opts{'q'});
1013 unless($opts{'bounceDetail'} == 0) {
1014 print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'bounceDetail'}, $opts{'q'});
1016 unless($opts{'rejectDetail'} == 0) {
1017 print_nested_hash(\%rejects, "message reject detail", $opts{'rejectDetail'}, $opts{'q'});
1018 print_nested_hash(\%warns, "message reject warning detail", $opts{'rejectDetail'}, $opts{'q'});
1019 print_nested_hash(\%holds, "message hold detail", $opts{'rejectDetail'}, $opts{'q'});
1020 print_nested_hash(\%discards, "message discard detail", $opts{'rejectDetail'}, $opts{'q'});
1022 unless($opts{'smtpDetail'} == 0) {
1023 print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtpDetail'}, $opts{'q'});
1025 unless($opts{'smtpdWarnDetail'} == 0) {
1026 print_nested_hash(\%warnings, "Warnings", $opts{'smtpdWarnDetail'}, $opts{'q'});
1028 print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'q'});
1029 print_nested_hash(\%panics, "Panics", 0, $opts{'q'});
1030 print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'q'});
1033 if($opts{'mailq'}) {
1034 # flush stdout first cuz of asynchronousity
1036 print_subsect_title("Current Mail Queue");
1040 # print "per-day" traffic summary
1041 # (done in a subroutine only to keep main-line code clean)
1042 sub print_per_day_summary {
1043 my($msgsPerDay) = @_;
1046 print_subsect_title("Per-Day Traffic Summary");
1048 print <<End_Of_Per_Day_Heading;
1049 date received delivered deferred bounced rejected
1050 --------------------------------------------------------------------
1051 End_Of_Per_Day_Heading
1053 foreach (sort { $a <=> $b } keys(%$msgsPerDay)) {
1054 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1056 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1058 my $msgMonStr = $monthNames[$msgMon];
1059 printf " $msgMonStr %2d $msgYr", $msgDay;
1061 foreach $value (@{$msgsPerDay->{$_}}) {
1062 my $value2 = $value? $value : 0;
1063 printf " %6d%s", adj_int_units($value2);
1069 # print "per-hour" traffic summary
1070 # (done in a subroutine only to keep main-line code clean)
1071 sub print_per_hour_summary {
1072 my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_;
1073 my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary';
1076 print_subsect_title("Per-Hour Traffic $reportType");
1078 print <<End_Of_Per_Hour_Heading;
1079 time received delivered deferred bounced rejected
1080 --------------------------------------------------------------------
1081 End_Of_Per_Hour_Heading
1083 for($hour = 0; $hour < 24; ++$hour) {
1085 printf " %02d:00-%02d:00", $hour, $hour + 1;
1087 printf " %02d00-%02d00 ", $hour, $hour + 1;
1089 foreach $value (@$rcvPerHr[$hour], @$dlvPerHr[$hour],
1090 @$dfrPerHr[$hour], @$bncPerHr[$hour],
1094 $value = ($value / $dayCnt) + 0.5 if($dayCnt);
1095 printf " %6d%s", adj_int_units($value);
1101 # print "per-recipient-domain" traffic summary
1102 # (done in a subroutine only to keep main-line code clean)
1103 sub print_recip_domain_summary {
1104 use vars '$hashRef';
1105 local($hashRef) = $_[0];
1107 return if($cnt == 0);
1108 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1111 print_subsect_title("Host/Domain Summary: Message Delivery $topCnt");
1113 print <<End_Of_Recip_Domain_Heading;
1114 sent cnt bytes defers avg dly max dly host/domain
1115 -------- ------- ------- ------- ------- -----------
1116 End_Of_Recip_Domain_Heading
1118 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1119 # there are only delay values if anything was sent
1120 if(${$hashRef->{$_}}[$msgCntI]) {
1121 $avgDly = (${$hashRef->{$_}}[$msgDlyAvgI] /
1122 ${$hashRef->{$_}}[$msgCntI]);
1126 printf " %6d%s %6d%s %6d%s %5.1f %s %5.1f %s %s\n",
1127 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1128 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1129 adj_int_units(${$hashRef->{$_}}[$msgDfrsI]),
1130 adj_time_units($avgDly),
1131 adj_time_units(${$hashRef->{$_}}[$msgDlyMaxI]),
1133 last if --$cnt == 0;
1137 # print "per-sender-domain" traffic summary
1138 # (done in a subroutine only to keep main-line code clean)
1139 sub print_sending_domain_summary {
1140 use vars '$hashRef';
1141 local($hashRef) = $_[0];
1143 return if($cnt == 0);
1144 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1146 print_subsect_title("Host/Domain Summary: Messages Received $topCnt");
1148 print <<End_Of_Sender_Domain_Heading;
1149 msg cnt bytes host/domain
1150 -------- ------- -----------
1151 End_Of_Sender_Domain_Heading
1153 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1154 printf " %6d%s %6d%s %s\n",
1155 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1156 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1158 last if --$cnt == 0;
1162 # print "per-user" data sorted in descending order
1163 # order (i.e.: highest first)
1164 sub print_user_data {
1165 my($hashRef, $title, $index, $cnt, $quiet) = @_;
1167 return if($cnt == 0);
1168 $title = sprintf "%s%s", $cnt > 0? "top $cnt " : "", $title;
1171 $dottedLine = ": none";
1173 $dottedLine = "\n" . "-" x length($title);
1175 printf "\n$title$dottedLine\n";
1176 foreach (map { $_->[0] }
1177 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1178 map { [ $_, $hashRef->{$_}[$index], normalize_host($_) ] }
1181 printf " %6d%s %s\n", adj_int_units(${$hashRef->{$_}}[$index]), $_;
1182 last if --$cnt == 0;
1187 # print "per-hour" smtpd connection summary
1188 # (done in a subroutine only to keep main-line code clean)
1189 sub print_per_hour_smtpd {
1190 my ($smtpdPerHr, $dayCnt) = @_;
1193 print_subsect_title("Per-Hour SMTPD Connection Daily Average");
1195 print <<End_Of_Per_Hour_Smtp_Average;
1196 hour connections time conn.
1197 -------------------------------------
1198 End_Of_Per_Hour_Smtp_Average
1200 print_subsect_title("Per-Hour SMTPD Connection Summary");
1202 print <<End_Of_Per_Hour_Smtp;
1203 hour connections time conn. avg./conn. max. time
1204 --------------------------------------------------------------------
1205 End_Of_Per_Hour_Smtp
1208 for($hour = 0; $hour < 24; ++$hour) {
1209 $smtpdPerHr[$hour]->[0] || next;
1210 my $avg = int($smtpdPerHr[$hour]->[0]?
1211 ($smtpdPerHr[$hour]->[1]/$smtpdPerHr[$hour]->[0]) + .5 : 0);
1213 $smtpdPerHr[$hour]->[0] /= $dayCnt;
1214 $smtpdPerHr[$hour]->[1] /= $dayCnt;
1215 $smtpdPerHr[$hour]->[0] += .5;
1216 $smtpdPerHr[$hour]->[1] += .5;
1218 my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]);
1221 printf " %02d:00-%02d:00", $hour, $hour + 1;
1223 printf " %02d00-%02d00 ", $hour, $hour + 1;
1225 printf " %6d%s %2d:%02d:%02d",
1226 adj_int_units($smtpdPerHr[$hour]->[0]),
1229 printf " %6ds %6ds",
1231 $smtpdPerHr[$hour]->[2];
1237 # print "per-day" smtpd connection summary
1238 # (done in a subroutine only to keep main-line code clean)
1239 sub print_per_day_smtpd {
1240 my ($smtpdPerDay, $dayCnt) = @_;
1242 print_subsect_title("Per-Day SMTPD Connection Summary");
1244 print <<End_Of_Per_Day_Smtp;
1245 date connections time conn. avg./conn. max. time
1246 --------------------------------------------------------------------
1249 foreach (sort { $a <=> $b } keys(%$smtpdPerDay)) {
1250 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1252 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1254 my $msgMonStr = $monthNames[$msgMon];
1255 printf " $msgMonStr %2d $msgYr", $msgDay;
1258 my $avg = (${$smtpdPerDay{$_}}[1]/${$smtpdPerDay{$_}}[0]) + .5;
1259 my($sec, $min, $hr) = get_smh(${$smtpdPerDay{$_}}[1]);
1261 printf " %6d%s %2d:%02d:%02d %6ds %6ds\n",
1262 adj_int_units(${$smtpdPerDay{$_}}[0]),
1265 ${$smtpdPerDay{$_}}[2];
1269 # print "per-domain-smtpd" connection summary
1270 # (done in a subroutine only to keep main-line code clean)
1271 sub print_domain_smtpd_summary {
1272 use vars '$hashRef';
1273 local($hashRef) = $_[0];
1275 return if($cnt == 0);
1276 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1279 print_subsect_title("Host/Domain Summary: SMTPD Connections $topCnt");
1281 print <<End_Of_Domain_Smtp_Heading;
1282 connections time conn. avg./conn. max. time host/domain
1283 ----------- ---------- ---------- --------- -----------
1284 End_Of_Domain_Smtp_Heading
1286 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1287 my $avg = (${$hashRef->{$_}}[1]/${$hashRef->{$_}}[0]) + .5;
1288 my ($sec, $min, $hr) = get_smh(${$hashRef->{$_}}[1]);
1290 printf " %6d%s %2d:%02d:%02d %6ds %6ds %s\n",
1291 adj_int_units(${$hashRef->{$_}}[0]),
1294 ${$hashRef->{$_}}[2],
1296 last if --$cnt == 0;
1300 # print hash contents sorted by numeric values in descending
1301 # order (i.e.: highest first)
1302 sub print_hash_by_cnt_vals {
1303 my($hashRef, $title, $cnt, $quiet) = @_;
1305 $title = sprintf "%s%s", $cnt? "top $cnt " : "", $title;
1308 $dottedLine = ": none";
1310 $dottedLine = "\n" . "-" x length($title);
1312 printf "\n$title$dottedLine\n";
1313 really_print_hash_by_cnt_vals($hashRef, $cnt, ' ');
1316 # print hash contents sorted by key in ascending order
1317 sub print_hash_by_key {
1318 my($hashRef, $title, $cnt, $quiet) = @_;
1320 $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title;
1323 $dottedLine = ": none";
1325 $dottedLine = "\n" . "-" x length($title);
1327 printf "\n$title$dottedLine\n";
1328 foreach (sort keys(%$hashRef))
1330 printf " %s %s\n", $_, $hashRef->{$_};
1331 last if --$cnt == 0;
1335 # print "nested" hashes
1336 sub print_nested_hash {
1337 my($hashRef, $title, $cnt, $quiet) = @_;
1341 $dottedLine = ": none";
1343 $dottedLine = "\n" . "-" x length($title);
1345 printf "\n$title$dottedLine\n";
1346 walk_nested_hash($hashRef, $cnt, 0);
1349 # "walk" a "nested" hash
1350 sub walk_nested_hash {
1351 my ($hashRef, $cnt, $level) = @_;
1353 my $indents = ' ' x $level;
1354 my ($keyName, $hashVal) = each(%$hashRef);
1356 if(ref($hashVal) eq 'HASH') {
1357 foreach (sort keys %$hashRef) {
1359 # If the next hash is finally the data, total the
1360 # counts for the report and print
1361 my $hashVal2 = (each(%{$hashRef->{$_}}))[1];
1362 keys(%{$hashRef->{$_}}); # "reset" hash iterator
1363 unless(ref($hashVal2) eq 'HASH') {
1364 print " (top $cnt)" if($cnt > 0);
1366 $rptCnt += $_ foreach (values %{$hashRef->{$_}});
1367 print " (total: $rptCnt)";
1370 walk_nested_hash($hashRef->{$_}, $cnt, $level);
1373 really_print_hash_by_cnt_vals($hashRef, $cnt, $indents);
1378 # print per-message info in excruciating detail :-)
1379 sub print_detailed_msg_data {
1380 use vars '$hashRef';
1381 local($hashRef) = $_[0];
1382 my($title, $quiet) = @_[1,2];
1386 $dottedLine = ": none";
1388 $dottedLine = "\n" . "-" x length($title);
1390 printf "\n$title$dottedLine\n";
1391 foreach (sort by_domain_then_user keys(%$hashRef))
1393 printf " %s %s\n", $_, shift(@{$hashRef->{$_}});
1394 foreach (@{$hashRef->{$_}}) {
1401 # *really* print hash contents sorted by numeric values in descending
1402 # order (i.e.: highest first), then by IP/addr, in ascending order.
1403 sub really_print_hash_by_cnt_vals {
1404 my($hashRef, $cnt, $indents) = @_;
1406 foreach (map { $_->[0] }
1407 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1408 map { [ $_, $hashRef->{$_}, normalize_host($_) ] }
1411 printf "$indents%6d%s %s\n", adj_int_units($hashRef->{$_}), $_;
1412 last if --$cnt == 0;
1416 # Print a sub-section title with properly-sized underline
1417 sub print_subsect_title {
1419 print "\n$title\n" . "-" x length($title) . "\n";
1422 # Normalize IP addr or hostname
1423 # (Note: Makes no effort to normalize IPv6 addrs. Just returns them
1424 # as they're passed-in.)
1425 sub normalize_host {
1426 # For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
1427 my $norm1 = (split(/\s/, $_[0]))[0];
1429 if((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)) == 4) {
1430 # Dotted-quad IP address
1431 return(pack('U4', @octets));
1433 # Possibly hostname or user@dom.ain
1434 return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 ));
1438 # subroutine to sort by domain, then user in domain, then by queue i.d.
1439 # Note: mixing Internet-style domain names and UUCP-style bang-paths
1440 # may confuse this thing. An attempt is made to use the first host
1441 # preceding the username in the bang-path as the "domain" if none is
1443 sub by_domain_then_user {
1444 # first see if we can get "user@somedomain"
1445 my($userNameA, $domainA) = split(/\@/, ${$hashRef->{$a}}[0]);
1446 my($userNameB, $domainB) = split(/\@/, ${$hashRef->{$b}}[0]);
1448 # try "somedomain!user"?
1449 ($userNameA, $domainA) = (split(/!/, ${$hashRef->{$a}}[0]))[-1,-2]
1451 ($userNameB, $domainB) = (split(/!/, ${$hashRef->{$b}}[0]))[-1,-2]
1454 # now re-order "mach.host.dom"/"mach.host.do.co" to
1455 # "host.dom.mach"/"host.do.co.mach"
1456 $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
1458 $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
1461 # oddly enough, doing this here is marginally faster than doing
1462 # an "if-else", above. go figure.
1463 $domainA = "" unless($domainA);
1464 $domainB = "" unless($domainB);
1466 if($domainA lt $domainB) {
1468 } elsif($domainA gt $domainB) {
1471 # disregard leading bang-path
1472 $userNameA =~ s/^.*!//;
1473 $userNameB =~ s/^.*!//;
1474 if($userNameA lt $userNameB) {
1476 } elsif($userNameA gt $userNameB) {
1489 # Subroutine used by host/domain reports to sort by count, then size.
1490 # We "fix" un-initialized values here as well. Very ugly and un-
1491 # structured to do this here - but it's either that or the callers
1492 # must run through the hashes twice :-(.
1493 sub by_count_then_size {
1494 ${$hashRef->{$a}}[$msgCntI] = 0 unless(${$hashRef->{$a}}[$msgCntI]);
1495 ${$hashRef->{$b}}[$msgCntI] = 0 unless(${$hashRef->{$b}}[$msgCntI]);
1496 if(${$hashRef->{$a}}[$msgCntI] == ${$hashRef->{$b}}[$msgCntI]) {
1497 ${$hashRef->{$a}}[$msgSizeI] = 0 unless(${$hashRef->{$a}}[$msgSizeI]);
1498 ${$hashRef->{$b}}[$msgSizeI] = 0 unless(${$hashRef->{$b}}[$msgSizeI]);
1499 return(${$hashRef->{$a}}[$msgSizeI] <=>
1500 ${$hashRef->{$b}}[$msgSizeI]);
1502 return(${$hashRef->{$a}}[$msgCntI] <=>
1503 ${$hashRef->{$b}}[$msgCntI]);
1507 # return traditional and RFC3339 date strings to match in log
1509 my ($dateOpt) = $_[0];
1513 if($dateOpt eq "yesterday") {
1514 # Back up to yesterday
1515 $time -= ((localtime($time))[2] + 2) * 3600;
1516 } elsif($dateOpt ne "today") {
1519 my ($t_mday, $t_mon, $t_year) = (localtime($time))[3,4,5];
1521 return sprintf("%s %2d", $monthNames[$t_mon], $t_mday), sprintf("%04d-%02d-%02d", $t_year+1900, $t_mon+1, $t_mday);
1524 # if there's a real domain: uses that. Otherwise uses the IP addr.
1525 # Lower-cases returned domain name.
1527 # Optional bit of code elides the last octet of an IPv4 address.
1528 # (In case one wants to assume an IPv4 addr. is a dialup or other
1529 # dynamic IP address in a /24.)
1530 # Does nothing interesting with IPv6 addresses.
1531 # FIXME: I think the IPv6 address parsing may be weak
1534 my($domain, $ipAddr);
1536 # split domain/ipaddr into separates
1537 # newer versions of Postfix have them "dom.ain[i.p.add.ress]"
1538 # older versions of Postfix have them "dom.ain/i.p.add.ress"
1539 unless((($domain, $ipAddr) = /^([^\[]+)\[((?:\d{1,3}\.){3}\d{1,3})\]/) == 2 ||
1540 (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/i) == 2) {
1541 # more exhaustive method
1542 ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/;
1545 # "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
1546 if($domain eq 'unknown') {
1548 # For identifying the host part on a Class C network (commonly
1549 # seen with dial-ups) the following is handy.
1550 # $domain =~ s/\.\d+$//;
1553 s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/;
1559 # Return (value, units) for integer
1563 $value = 0 unless($value);
1564 if($value > $divByOneMegAt) {
1567 } elsif($value > $divByOneKAt) {
1571 return($value, $units);
1574 # Return (value, units) for time
1575 sub adj_time_units {
1578 $value = 0 unless($value);
1582 } elsif($value > 60) {
1586 return($value, $units);
1589 # Trim a "said:" string, if necessary. Add elipses to show it.
1590 # FIXME: This sometimes elides The Wrong Bits, yielding
1591 # summaries that are less useful than they could be.
1592 sub said_string_trimmer {
1593 my($trimmedString, $maxLen) = @_;
1595 while(length($trimmedString) > $maxLen) {
1596 if($trimmedString =~ /^.* said: /) {
1597 $trimmedString =~ s/^.* said: //;
1598 } elsif($trimmedString =~ /^.*: */) {
1599 $trimmedString =~ s/^.*?: *//;
1601 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
1606 return $trimmedString;
1609 # Trim a string, if necessary. Add elipses to show it.
1610 sub string_trimmer {
1611 my($trimmedString, $maxLen, $doNotTrim) = @_;
1613 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..."
1614 if(! $doNotTrim && (length($trimmedString) > $maxLen));
1615 return $trimmedString;
1618 # Get seconds, minutes and hours from seconds
1621 my $hr = int($sec / 3600);
1623 my $min = int($sec / 60);
1625 return($sec, $min, $hr);
1628 # Process smtpd rejects
1629 sub proc_smtpd_reject {
1630 my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_;
1631 my ($rejTyp, $rejFrom, $rejRmdr, $rejReas);
1639 # Hate the sub-calling overhead if we're not doing reject details
1640 # anyway, but this is the only place we can do this.
1641 return if($opts{'rejectDetail'} == 0);
1643 # This could get real ugly!
1645 # First: get everything following the "reject: ", etc. token
1646 # Was an IPv6 problem here
1647 ($rejTyp, $rejFrom, $rejRmdr) =
1648 ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/);
1650 # Next: get the reject "reason"
1651 $rejReas = $rejRmdr;
1652 unless(defined($opts{'verbMsgDetail'})) {
1653 if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") { # special treatment :-(
1654 # If there are "<>"s immediately following the reject code, that's
1655 # an email address or HELO string. There can be *anything* in
1656 # those--incl. stuff that'll screw up subsequent parsing. So just
1657 # get rid of it right off.
1658 $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/;
1659 $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/;
1660 $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/;
1661 $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/;
1662 } elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr...
1663 $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/;
1665 $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/;
1669 # Snag recipient address
1670 # Second expression is for unknown recipient--where there is no
1671 # "to=<mumble>" field, third for pathological case where recipient
1672 # field is unterminated, forth when all else fails.
1673 (($to) = $rejRmdr =~ /to=<([^>]+)>/) ||
1674 (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /) ||
1675 (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/) ||
1677 $to = lc($to) if($opts{'i'});
1679 # Snag sender address
1680 (($from) = $rejRmdr =~ /from=<([^>]+)>/) || ($from = "<>");
1682 if(defined($from)) {
1683 $rejAddFrom = $opts{'rejAddFrom'};
1684 $from = verp_mung($from);
1685 $from = lc($from) if($opts{'i'});
1688 # stash in "triple-subscripted-array"
1689 if($rejReas =~ m/^Sender address rejected:/) {
1690 # Sender address rejected: Domain not found
1691 # Sender address rejected: need fully-qualified address
1692 ++$rejects->{$rejTyp}{$rejReas}{$from};
1693 } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/) {
1694 # Recipient address rejected: Domain not found
1695 # Recipient address rejected: need fully-qualified address
1696 # User unknown (in local/relay recipient table)
1697 #++$rejects->{$rejTyp}{$rejReas}{$to};
1700 $rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
1702 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1703 } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/) {
1704 # Was an IPv6 problem here
1705 my ($src) = $logLine =~ /^.+? from (\S+?):.*$/;
1706 ++$rejects->{$rejTyp}{$rejReas}{$src};
1707 } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/) {
1708 my $rejData = gimme_domain($rejFrom);
1709 $rejData .= " ($from)" if($rejAddFrom);
1710 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1711 } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/) {
1712 my $rejData = gimme_domain($rejFrom);
1713 $rejData .= " ($from)" if($rejAddFrom);
1714 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1716 # print STDERR "dbg: unknown reject reason $rejReas !\n\n";
1717 my $rejData = gimme_domain($rejFrom);
1718 $rejData .= " ($from)" if($rejAddFrom);
1719 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1723 # Hack for VERP (?) - convert address from somthing like
1724 # "list-return-36-someuser=someplace.com@lists.domain.com"
1725 # to "list-return-ID-someuser=someplace.com@lists.domain.com"
1726 # to prevent per-user listing "pollution." More aggressive
1727 # munging converts to something like
1728 # "list-return@lists.domain.com" (Instead of "return," there
1729 # may be numeric list name/id, "warn", "error", etc.?)
1733 if(defined($opts{'verpMung'})) {
1734 $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/i;
1735 if($opts{'verpMung'} > 1) {
1736 $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/;
1744 ### Warning and Error Routines
1747 # Emit warning message to stderr
1749 warn "warning: $progName: $_[0]\n";