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.3.
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_bounce_detail] [--no_deferral_detail]
17 [--no_no_msg_size] [--no_reject_detail] [--no_smtpd_warnings]
18 [--problems_first] [--rej_add_from] [--reject_detail <cnt>]
19 [--smtp_detail <cnt>] [--smtpd_stats]
20 [--smtpd_warning_detail <cnt>] [--syslog_name=string]
21 [-u <cnt>] [--verbose_msg_detail] [--verp_mung[=<n>]]
22 [--zero_fill] [file1 [filen]]
24 pflogsumm.pl -[help|version]
26 If no file(s) specified, reads from stdin. Output is to stdout.
30 Pflogsumm is a log analyzer/summarizer for the Postfix MTA. It is
31 designed to provide an over-view of Postfix activity, with just enough
32 detail to give the administrator a "heads up" for potential trouble
35 Pflogsumm generates summaries and, in some cases, detailed reports of
36 mail server traffic volumes, rejected and bounced email, and server
37 warnings, errors and panics.
43 Limit detailed bounce reports to the top <cnt>. 0
46 -d today generate report for just today
47 -d yesterday generate report for just "yesterday"
49 --deferral_detail <cnt>
51 Limit detailed deferral reports to the top <cnt>. 0
56 Sets all --*_detail, -h and -u to <cnt>. Is
57 over-ridden by individual settings. --detail 0
58 suppresses *all* detail.
60 -e extended (extreme? excessive?) detail
62 Emit detailed reports. At present, this includes
63 only a per-message report, sorted by sender domain,
64 then user-in-domain, then by queue i.d.
66 WARNING: the data built to generate this report can
67 quickly consume very large amounts of memory if a
68 lot of log entries are processed!
70 -h <cnt> top <cnt> to display in host/domain reports.
74 See also: "-u" and "--*_detail" options for further
75 report-limiting options.
77 --help Emit short usage message and bail out.
79 (By happy coincidence, "-h" alone does much the same,
80 being as it requires a numeric argument :-). Yeah, I
84 --ignore_case Handle complete email address in a case-insensitive
87 Normally pflogsumm lower-cases only the host and
88 domain parts, leaving the user part alone. This
89 option causes the entire email address to be lower-
94 For summaries that contain date or time information,
95 use ISO 8601 standard formats (CCYY-MM-DD and HH:MM),
96 rather than "Mon DD CCYY" and "HHMM".
98 -m modify (mung?) UUCP-style bang-paths
101 This is for use when you have a mix of Internet-style
102 domain addresses and UUCP-style bang-paths in the log.
103 Upstream UUCP feeds sometimes mung Internet domain
104 style address into bang-paths. This option can
105 sometimes undo the "damage". For example:
106 "somehost.dom!username@foo" (where "foo" is the next
107 host upstream and "somehost.dom" was whence the email
108 originated) will get converted to
109 "foo!username@somehost.dom". This also affects the
110 extended detail report (-e), to help ensure that by-
111 domain-by-name sorting is more accurate.
113 --mailq Run "mailq" command at end of report.
115 Merely a convenience feature. (Assumes that "mailq"
116 is in $PATH. See "$mailqCmd" variable to path thisi
123 These switches are depreciated in favour of
124 --bounce_detail, --deferral_detail and
125 --reject_detail, respectively.
127 Suppresses the printing of the following detailed
128 reports, respectively:
130 message bounce detail (by relay)
131 message deferral detail
132 message reject detail
134 See also: "-u" and "-h" for further report-limiting
139 Do not emit report on "Messages with no size data".
141 Message size is reported only by the queue manager.
142 The message may be delivered long-enough after the
143 (last) qmgr log entry that the information is not in
144 the log(s) processed by a particular run of
145 pflogsumm.pl. This throws off "Recipients by message
146 size" and the total for "bytes delivered." These are
147 normally reported by pflogsumm as "Messages with no
152 This switch is depreciated in favour of
155 On a busy mail server, say at an ISP, SMTPD warnings
156 can result in a rather sizeable report. This option
157 turns reporting them off.
161 Emit "problems" reports (bounces, defers, warnings,
162 etc.) before "normal" stats.
165 For those reject reports that list IP addresses or
166 host/domain names: append the email from address to
167 each listing. (Does not apply to "Improper use of
168 SMTP command pipelining" report.)
170 -q quiet - don't print headings for empty reports
172 note: headings for warning, fatal, and "master"
173 messages will always be printed.
175 --reject_detail <cnt>
177 Limit detailed smtpd reject, warn, hold and discard
178 reports to the top <cnt>. 0 to suppress entirely.
182 Limit detailed smtp delivery reports to the top <cnt>.
183 0 to suppress entirely.
187 Generate smtpd connection statistics.
189 The "per-day" report is not generated for single-day
190 reports. For multiple-day reports: "per-hour" numbers
191 are daily averages (reflected in the report heading).
193 --smtpd_warning_detail <cnt>
195 Limit detailed smtpd warnings reports to the top <cnt>.
196 0 to suppress entirely.
200 Set syslog_name to look for for Postfix log entries.
202 By default, pflogsumm looks for entries in logfiles
203 with a syslog name of "postfix," the default.
204 If you've set a non-default "syslog_name" parameter
205 in your Postfix configuration, use this option to
206 tell pflogsumm what that is.
208 See the discussion about the use of this option under
211 -u <cnt> top <cnt> to display in user reports. 0 == none.
213 See also: "-h" and "--*_detail" options for further
214 report-limiting options.
218 For the message deferral, bounce and reject summaries:
219 display the full "reason", rather than a truncated one.
221 Note: this can result in quite long lines in the report.
223 --verp_mung do "VERP" generated address (?) munging. Convert
224 --verp_mung=2 sender addresses of the form
225 "list-return-NN-someuser=some.dom@host.sender.dom"
227 "list-return-ID-someuser=some.dom@host.sender.dom"
229 In other words: replace the numeric value with "ID".
231 By specifying the optional "=2" (second form), the
232 munging is more "aggressive", converting the address
235 "list-return@host.sender.dom"
237 Actually: specifying anything less than 2 does the
238 "simple" munging and anything greater than 1 results
239 in the more "aggressive" hack being applied.
241 See "NOTES" regarding this option.
243 --version Print program name and version and bail out.
245 --zero_fill "Zero-fill" certain arrays so reports come out with
246 data in columns that that might otherwise be blank.
250 Pflogsumm doesn't return anything of interest to the shell.
254 Error messages are emitted to stderr.
258 Produce a report of previous day's activities:
260 pflogsumm.pl -d yesterday /var/log/maillog
262 A report of prior week's activities (after logs rotated):
264 pflogsumm.pl /var/log/maillog.0
266 What's happened so far today:
268 pflogsumm.pl -d today /var/log/maillog
270 Crontab entry to generate a report of the previous day's activity
271 at 10 minutes after midnight.
273 10 0 * * * /usr/local/sbin/pflogsumm -d yesterday /var/log/maillog
274 2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
276 Crontab entry to generate a report for the prior week's activity.
277 (This example assumes one rotates ones mail logs weekly, some time
278 before 4:10 a.m. on Sunday.)
280 10 4 * * 0 /usr/local/sbin/pflogsumm /var/log/maillog.0
281 2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
283 The two crontab examples, above, must actually be a single line
284 each. They're broken-up into two-or-more lines due to page
289 The pflogsumm FAQ: pflogsumm-faq.txt.
293 Pflogsumm makes no attempt to catch/parse non-Postfix log
294 entries. Unless it has "postfix/" in the log entry, it will be
297 It's important that the logs are presented to pflogsumm in
298 chronological order so that message sizes are available when
301 For display purposes: integer values are munged into "kilo" and
302 "mega" notation as they exceed certain values. I chose the
303 admittedly arbitrary boundaries of 512k and 512m as the points at
304 which to do this--my thinking being 512x was the largest number
305 (of digits) that most folks can comfortably grok at-a-glance.
306 These are "computer" "k" and "m", not 1000 and 1,000,000. You
307 can easily change all of this with some constants near the
308 beginning of the program.
310 "Items-per-day" reports are not generated for single-day
311 reports. For multiple-day reports: "Items-per-hour" numbers are
312 daily averages (reflected in the report headings).
314 Message rejects, reject warnings, holds and discards are all
315 reported under the "rejects" column for the Per-Hour and Per-Day
318 Verp munging may not always result in correct address and
319 address-count reduction.
321 Verp munging is always in a state of experimentation. The use
322 of this option may result in inaccurate statistics with regards
323 to the "senders" count.
325 UUCP-style bang-path handling needs more work. Particularly if
326 Postfix is not being run with "swap_bangpath = yes" and/or *is* being
327 run with "append_dot_mydomain = yes", the detailed by-message report
328 may not be sorted correctly by-domain-by-user. (Also depends on
329 upstream MTA, I suspect.)
331 The "percent rejected" and "percent discarded" figures are only
332 approximations. They are calculated as follows (example is for
337 (rejected / (delivered + rejected + discarded)) * 100
339 There are some issues with the use of --syslog_name. The problem is
340 that, even with $syslog_name set, Postfix will sometimes still log
341 things with "postfix" as the syslog_name. This is noted in
342 /etc/postfix/sample-misc.cf:
344 # Beware: a non-default syslog_name setting takes effect only
345 # after process initialization. Some initialization errors will be
346 # logged with the default name, especially errors while parsing
347 # the command line and errors while accessing the Postfix main.cf
348 # configuration file.
350 As a consequence, pflogsumm must always look for "postfix," in logs,
351 as well as whatever is supplied for syslog_name.
353 Where this becomes an issue is where people are running two or more
354 instances of Postfix, logging to the same file. In such a case:
356 . Neither instance may use the default "postfix" syslog name
359 . Log entries that fall victim to what's described in
360 sample-misc.cf will be reported under "postfix", so that if
361 you're running pflogsumm twice, once for each syslog_name, such
362 log entries will show up in each report.
364 The Pflogsumm Home Page is at:
366 http://jimsun.LinxNet.com/postfix_contrib.html
370 For certain options (e.g.: --smtpd_stats), Pflogsumm requires the
371 Date::Calc module, which can be obtained from CPAN at
374 Pflogsumm is currently written and tested under Perl 5.8.3.
375 As of version 19990413-02, pflogsumm worked with Perl 5.003, but
376 future compatibility is not guaranteed.
380 This program is free software; you can redistribute it and/or
381 modify it under the terms of the GNU General Public License
382 as published by the Free Software Foundation; either version 2
383 of the License, or (at your option) any later version.
385 This program is distributed in the hope that it will be useful,
386 but WITHOUT ANY WARRANTY; without even the implied warranty of
387 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
388 GNU General Public License for more details.
390 You may have received a copy of the GNU General Public License
391 along with this program; if not, write to the Free Software
392 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
395 An on-line copy of the GNU General Public License can be found
396 http://www.fsf.org/copyleft/gpl.html.
403 eval { require Date::Calc };
404 my $hasDateCalc = $@ ? 0 : 1;
406 my $mailqCmd = "mailq";
407 my $release = "1.1.3";
409 # Variables and constants used throughout pflogsumm
414 $divByOneKAt $divByOneMegAt $oneK $oneMeg
415 @monthNames %monthNums $thisYr $thisMon
416 $msgCntI $msgSizeI $msgDfrsI $msgDlyAvgI $msgDlyMaxI
420 # Some constants used by display routines. I arbitrarily chose to
421 # display in kilobytes and megabytes at the 512k and 512m boundaries,
422 # respectively. Season to taste.
423 $divByOneKAt = 524288; # 512k
424 $divByOneMegAt = 536870912; # 512m
426 $oneMeg = 1048576; # 1m
428 # Constants used throughout pflogsumm
429 @monthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
431 Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
432 Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11);
433 ($thisMon, $thisYr) = (localtime(time()))[4,5];
437 # Variables used only in main loop
440 my (%recipUser, $recipUserCnt);
441 my (%sendgUser, $sendgUserCnt);
443 my (%recipDom, $recipDomCnt); # recipient domain data
444 my (%sendgDom, $sendgDomCnt); # sending domain data
445 # Indexes for arrays in above
446 $msgCntI = 0; # message count
447 $msgSizeI = 1; # total messages size
448 $msgDfrsI = 2; # number of defers
449 $msgDlyAvgI = 3; # total of delays (used for averaging)
450 $msgDlyMaxI = 4; # max delay
453 $cmd, $qid, $addr, $size, $relay, $status, $delay,
455 %panics, %fatals, %warnings, %masterMsgs,
458 %noMsgSize, %msgDetail,
459 $msgsRcvd, $msgsDlvrd, $sizeRcvd, $sizeDlvrd,
460 $msgMonStr, $msgMon, $msgDay, $msgTimeStr, $msgHr, $msgMin, $msgSec,
462 $revMsgDateStr, $dayCnt, %msgsPerDay,
463 %rejects, $msgsRjctd,
465 %discards, $msgsDscrdd,
467 %rcvdMsg, $msgsFwdd, $msgsBncd,
468 $msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
469 %connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
472 $dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
474 # Init total messages delivered, rejected, and discarded
475 $msgsDlvrd = $msgsRjctd = $msgsDscrdd = 0;
477 # Init messages received and delivered per hour
478 my @rcvPerHr = (0) x 24;
479 my @dlvPerHr = @rcvPerHr;
480 my @dfrPerHr = @rcvPerHr; # defers per hour
481 my @bncPerHr = @rcvPerHr; # bounces per hour
482 my @rejPerHr = @rcvPerHr; # rejects per hour
485 # Init "doubly-sub-scripted array": cnt, total and max time per-hour
488 $smtpdPerHr[$_] = [0,0,0];
491 $progName = "pflogsumm.pl";
493 "usage: $progName -[eq] [-d <today|yesterday>] [--detail <cnt>]
494 [--bounce_detail <cnt>] [--deferral_detail <cnt>]
495 [-h <cnt>] [-i|--ignore_case] [--iso_date_time] [--mailq]
496 [-m|--uucp_mung] [--no_bounce_detail] [--no_deferral_detail]
497 [--no_no_msg_size] [--no_reject_detail] [--no_smtpd_warnings]
498 [--problems_first] [--rej_add_from] [--reject_detail <cnt>]
499 [--smtp_detail <cnt>] [--smtpd_stats]
500 [--smtpd_warning_detail <cnt>] [--syslog_name=string]
501 [-u <cnt>] [--verbose_msg_detail] [--verp_mung[=<n>]]
502 [--zero_fill] [file1 [filen]]
504 $progName --[version|help]";
506 # Some pre-inits for convenience
507 $isoDateTime = 0; # Don't use ISO date/time formats
509 "bounce_detail=i" => \$opts{'bounceDetail'},
510 "d=s" => \$opts{'d'},
511 "deferral_detail=i" => \$opts{'deferralDetail'},
512 "detail=i" => \$opts{'detail'},
514 "help" => \$opts{'help'},
515 "h=i" => \$opts{'h'},
516 "ignore_case" => \$opts{'i'},
518 "iso_date_time" => \$isoDateTime,
519 "mailq" => \$opts{'mailq'},
521 "no_bounce_detail" => \$opts{'noBounceDetail'},
522 "no_deferral_detail" => \$opts{'noDeferralDetail'},
523 "no_no_msg_size" => \$opts{'noNoMsgSize'},
524 "no_reject_detail" => \$opts{'noRejectDetail'},
525 "no_smtpd_warnings" => \$opts{'noSMTPDWarnings'},
526 "problems_first" => \$opts{'pf'},
528 "rej_add_from" => \$opts{'rejAddFrom'},
529 "reject_detail=i" => \$opts{'rejectDetail'},
530 "smtp_detail=i" => \$opts{'smtpDetail'},
531 "smtpd_stats" => \$opts{'smtpdStats'},
532 "smtpd_warning_detail=i" => \$opts{'smtpdWarnDetail'},
533 "syslog_name=s" => \$opts{'syslogName'},
534 "u=i" => \$opts{'u'},
535 "uucp_mung" => \$opts{'m'},
536 "verbose_msg_detail" => \$opts{'verbMsgDetail'},
537 "verp_mung:i" => \$opts{'verpMung'},
538 "version" => \$opts{'version'},
539 "zero_fill" => \$opts{'zeroFill'}
540 ) || die "$usageMsg\n";
542 # internally: 0 == none, undefined == -1 == all
543 $opts{'h'} = -1 unless(defined($opts{'h'}));
544 $opts{'u'} = -1 unless(defined($opts{'u'}));
545 $opts{'bounceDetail'} = -1 unless(defined($opts{'bounceDetail'}));
546 $opts{'deferralDetail'} = -1 unless(defined($opts{'deferralDetail'}));
547 $opts{'smtpDetail'} = -1 unless(defined($opts{'smtpDetail'}));
548 $opts{'smtpdWarnDetail'} = -1 unless(defined($opts{'smtpdWarnDetail'}));
549 $opts{'rejectDetail'} = -1 unless(defined($opts{'rejectDetail'}));
551 # These go away eventually
552 if(defined($opts{'noBounceDetail'})) {
553 $opts{'bounceDetail'} = 0;
554 warn "$progName: \"no_bounce_detail\" is depreciated, use \"bounce_detail=0\" instead\n"
556 if(defined($opts{'noDeferralDetail'})) {
557 $opts{'deferralDetail'} = 0;
558 warn "$progName: \"no_deferral_detail\" is depreciated, use \"deferral_detail=0\" instead\n"
560 if(defined($opts{'noRejectDetail'})) {
561 $opts{'rejectDetail'} = 0;
562 warn "$progName: \"no_reject_detail\" is depreciated, use \"reject_detail=0\" instead\n"
564 if(defined($opts{'noSMTPDWarnings'})) {
565 $opts{'smtpdWarnDetail'} = 0;
566 warn "$progName: \"no_smtpd_warnings\" is depreciated, use \"smtpd_warning_detail=0\" instead\n"
569 # If --detail was specified, set anything that's not enumerated to it
570 if(defined($opts{'detail'})) {
571 foreach my $optName (qw (h u bounceDetail deferralDetail smtpDetail smtpdWarnDetail rejectDetail)) {
572 $opts{$optName} = $opts{'detail'} unless($opts{"$optName"} != -1);
576 my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
578 if(defined($opts{'help'})) {
583 if(defined($opts{'version'})) {
584 print "$progName $release\n";
589 # manually import the Date::Calc routine we want
591 # This looks stupid, but it's the only way to shut Perl up about
592 # "Date::Calc::Delta_DHMS" used only once" if -w is on. (No,
593 # $^W = 0 doesn't work in this context.)
594 *Delta_DHMS = *Date::Calc::Delta_DHMS;
595 *Delta_DHMS = *Date::Calc::Delta_DHMS;
597 } elsif(defined($opts{'smtpdStats'})) {
598 # If user specified --smtpd_stats but doesn't have Date::Calc
599 # installed, die with friendly help message.
600 die <<End_Of_HELP_DATE_CALC;
602 The option "--smtpd_stats" does calculations that require the
603 Date::Calc Perl module, but you don't have this module installed.
604 If you want to use this extended functionality of Pflogsumm, you
605 will have to install this module. If you have root privileges
606 on the machine, this is as simple as performing the following
609 perl -MCPAN -e 'install Date::Calc'
611 End_Of_HELP_DATE_CALC
614 $dateStr = get_datestr($opts{'d'}) if(defined($opts{'d'}));
617 #open(UNPROCD, "> unprocessed") ||
618 # die "couldn't open \"unprocessed\": $!\n";
621 next if(defined($dateStr) && ! /^$dateStr/o);
622 s/: \[ID \d+ [^\]]+\] /: /o; # lose "[ID nnnnnn some.thing]" stuff
625 # "Traditional" timestamp format?
626 if((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
627 /^(...) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/o) == 6)
629 # Convert string to numeric value for later "month rollover" check
630 $msgMon = $monthNums{$msgMonStr};
632 # RFC 3339 timestamp format?
633 next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
634 /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(?:[\+\-](?:\d{2}):(?:\d{2})|Z) \S+ (.+)$/o) == 10);
635 # RFC 3339 months start at "1", we index from 0
639 unless((($cmd, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
640 (($cmd, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
647 # If the log line's month is greater than our current month,
648 # we've probably had a year rollover
649 # FIXME: For processing old logfiles: This is a broken test!
650 $msgYr = ($msgMon > $thisMon? $thisYr - 1 : $thisYr);
652 # the following test depends on one getting more than one message a
653 # month--or at least that successive messages don't arrive on the
654 # same month-day in successive months :-)
655 unless($msgDay == $lastMsgDay) {
656 $lastMsgDay = $msgDay;
657 $revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay;
659 if(defined($opts{'zeroFill'})) {
660 ${$msgsPerDay{$revMsgDateStr}}[4] = 0;
664 # regexp rejects happen in "cleanup"
665 if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
666 /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/o) == 3)
668 $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'});
669 $rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
670 if($rejSubTyp eq "reject") {
671 ++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
673 } elsif($rejSubTyp eq "warning") {
674 ++$warns{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
676 } elsif($rejSubTyp eq "hold") {
677 ++$holds{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
679 } elsif($rejSubTyp eq "discard") {
680 ++$discards{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
684 ++${$msgsPerDay{$revMsgDateStr}}[4];
685 } elsif($qid eq 'warning') {
686 (my $warnReas = $logRmdr) =~ s/^.*warning: //o;
687 $warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
688 unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
689 ++$warnings{$cmd}{$warnReas};
691 } elsif($qid eq 'fatal') {
692 (my $fatalReas = $logRmdr) =~ s/^.*fatal: //o;
693 $fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
694 ++$fatals{$cmd}{$fatalReas};
695 } elsif($qid eq 'panic') {
696 (my $panicReas = $logRmdr) =~ s/^.*panic: //o;
697 $panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
698 ++$panics{$cmd}{$panicReas};
699 } elsif($qid eq 'reject') {
700 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr],
701 \${$msgsPerDay{$revMsgDateStr}}[4]);
702 } elsif($qid eq 'reject_warning') {
703 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr],
704 \${$msgsPerDay{$revMsgDateStr}}[4]);
705 } elsif($qid eq 'hold') {
706 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr],
707 \${$msgsPerDay{$revMsgDateStr}}[4]);
708 } elsif($qid eq 'discard') {
709 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr],
710 \${$msgsPerDay{$revMsgDateStr}}[4]);
711 } elsif($cmd eq 'master') {
712 ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
713 } elsif($cmd eq 'smtpd') {
714 if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) {
716 # Warning: this code in two places!
719 ++${$msgsPerDay{$revMsgDateStr}}[0];
721 $rcvdMsg{$qid} = gimme_domain($1); # Whence it came
722 } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) {
723 if($rejSubTyp eq 'reject') {
724 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
726 \${$msgsPerDay{$revMsgDateStr}}[4]);
727 } elsif($rejSubTyp eq 'reject_warning') {
728 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
730 \${$msgsPerDay{$revMsgDateStr}}[4]);
731 } elsif($rejSubTyp eq 'hold') {
732 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld,
734 \${$msgsPerDay{$revMsgDateStr}}[4]);
735 } elsif($rejSubTyp eq 'discard') {
736 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd,
738 \${$msgsPerDay{$revMsgDateStr}}[4]);
742 next unless(defined($opts{'smtpdStats'}));
743 if($logRmdr =~ /: connect from /o) {
744 $logRmdr =~ /\/smtpd\[(\d+)\]: /o;
746 ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
747 } elsif($logRmdr =~ /: disconnect from /o) {
748 my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o;
749 if(exists($connTime{$pid})) {
750 $hostID = gimme_domain($hostID);
751 my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
752 $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
753 delete($connTime{$pid}); # dispose of no-longer-needed item
754 my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
756 ++$smtpdPerHr[$msgHr][0];
757 $smtpdPerHr[$msgHr][1] += $tSecs;
758 $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
760 unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
761 ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
762 ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
764 ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
765 ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
766 if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
768 unless(${$smtpdPerDom{$hostID}}[0]++) {
769 ${$smtpdPerDom{$hostID}}[1] = 0;
770 ${$smtpdPerDom{$hostID}}[2] = 0;
772 ${$smtpdPerDom{$hostID}}[1] += $tSecs;
773 ${$smtpdPerDom{$hostID}}[2] = $tSecs
774 if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
777 $smtpdTotTime += $tSecs;
783 if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2)
785 next if($msgSizes{$qid}); # avoid double-counting!
787 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
788 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
790 $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
791 $addr = lc($addr) if($opts{'i'});
792 $addr = verp_mung($addr);
796 $msgSizes{$qid} = $size;
797 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
798 # Avoid counting forwards
800 # Get the domain out of the sender's address. If there is
801 # none: Use the client hostname/IP-address
803 unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/o) == 1) {
804 $domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
807 unless(${$sendgDom{$domAddr}}[$msgCntI]);
808 ++${$sendgDom{$domAddr}}[$msgCntI];
809 ${$sendgDom{$domAddr}}[$msgSizeI] += $size;
810 ++$sendgUserCnt unless(${$sendgUser{$addr}}[$msgCntI]);
811 ++${$sendgUser{$addr}}[$msgCntI];
812 ${$sendgUser{$addr}}[$msgSizeI] += $size;
814 delete($rcvdMsg{$qid}); # limit hash size
817 elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
818 /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/o) >= 4)
821 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
822 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
824 $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
825 $addr = lc($addr) if($opts{'i'});
826 $relay = lc($relay) if($opts{'i'});
827 (my $domAddr = $addr) =~ s/^[^@]+\@//o; # get domain only
828 if($status eq 'sent') {
830 # was it actually forwarded, rather than delivered?
831 if($toRmdr =~ /forwarded as /o) {
835 ++$recipDomCnt unless(${$recipDom{$domAddr}}[$msgCntI]);
836 ++${$recipDom{$domAddr}}[$msgCntI];
837 ${$recipDom{$domAddr}}[$msgDlyAvgI] += $delay;
838 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
839 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
841 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
843 ++$recipUserCnt unless(${$recipUser{$addr}}[$msgCntI]);
844 ++${$recipUser{$addr}}[$msgCntI];
846 ++${$msgsPerDay{$revMsgDateStr}}[1];
848 if($msgSizes{$qid}) {
849 ${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid};
850 ${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid};
851 $sizeDlvrd += $msgSizes{$qid};
853 ${$recipDom{$domAddr}}[$msgSizeI] += 0;
854 ${$recipUser{$addr}}[$msgSizeI] += 0;
855 $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'});
856 push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'});
857 # put this back later? mebbe with -v?
858 # msg_warn("no message size for qid: $qid");
860 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
861 } elsif($status eq 'deferred') {
862 unless($opts{'deferralDetail'} == 0) {
863 my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/o;
864 unless(defined($opts{'verbMsgDetail'})) {
865 $deferredReas = said_string_trimmer($deferredReas, 65);
866 $deferredReas =~ s/^\d{3} //o;
867 $deferredReas =~ s/^connect to //o;
869 ++$deferred{$cmd}{$deferredReas};
872 ++${$msgsPerDay{$revMsgDateStr}}[2];
874 ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
875 ++${$recipDom{$domAddr}}[$msgDfrsI];
876 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
877 $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
879 ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
881 } elsif($status eq 'bounced') {
882 unless($opts{'bounceDetail'} == 0) {
883 my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/o;
884 unless(defined($opts{'verbMsgDetail'})) {
885 $bounceReas = said_string_trimmer($bounceReas, 66);
886 $bounceReas =~ s/^\d{3} //o;
888 ++$bounced{$relay}{$bounceReas};
891 ++${$msgsPerDay{$revMsgDateStr}}[3];
894 # print UNPROCD "$_\n";
897 elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) {
899 # Warning: this code in two places!
902 ++${$msgsPerDay{$revMsgDateStr}}[0];
904 $rcvdMsg{$qid} = "pickup"; # Whence it came
906 elsif($cmd eq 'smtp' && $opts{'smtpDetail'} != 0) {
907 # Was an IPv6 problem here
908 if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) {
909 ++$smtpMsgs{lc($2)}{$1};
910 } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) {
911 ++$smtpMsgs{lc($2)}{$1};
913 # print UNPROCD "$_\n";
918 # print UNPROCD "$_\n";
925 # die "problem closing \"unprocessed\": $!\n";
927 # Calculate percentage of messages rejected and discarded
928 my $msgsRjctdPct = 0;
929 my $msgsDscrddPct = 0;
930 if(my $msgsTotal = $msgsDlvrd + $msgsRjctd + $msgsDscrdd) {
931 $msgsRjctdPct = int(($msgsRjctd/$msgsTotal) * 100);
932 $msgsDscrddPct = int(($msgsDscrdd/$msgsTotal) * 100);
935 if(defined($dateStr)) {
936 print "Postfix log summaries for $dateStr\n";
939 print_subsect_title("Grand Totals");
940 print "messages\n\n";
941 printf " %6d%s received\n", adj_int_units($msgsRcvd);
942 printf " %6d%s delivered\n", adj_int_units($msgsDlvrd);
943 printf " %6d%s forwarded\n", adj_int_units($msgsFwdd);
944 printf " %6d%s deferred", adj_int_units($msgsDfrd);
945 printf " (%d%s deferrals)", adj_int_units($msgsDfrdCnt) if($msgsDfrdCnt);
947 printf " %6d%s bounced\n", adj_int_units($msgsBncd);
948 printf " %6d%s rejected (%d%%)\n", adj_int_units($msgsRjctd), $msgsRjctdPct;
949 printf " %6d%s reject warnings\n", adj_int_units($msgsWrnd);
950 printf " %6d%s held\n", adj_int_units($msgsHld);
951 printf " %6d%s discarded (%d%%)\n", adj_int_units($msgsDscrdd), $msgsDscrddPct;
953 printf " %6d%s bytes received\n", adj_int_units($sizeRcvd);
954 printf " %6d%s bytes delivered\n", adj_int_units($sizeDlvrd);
955 printf " %6d%s senders\n", adj_int_units($sendgUserCnt);
956 printf " %6d%s sending hosts/domains\n", adj_int_units($sendgDomCnt);
957 printf " %6d%s recipients\n", adj_int_units($recipUserCnt);
958 printf " %6d%s recipient hosts/domains\n", adj_int_units($recipDomCnt);
960 if(defined($opts{'smtpdStats'})) {
962 printf " %6d%s connections\n", adj_int_units($smtpdConnCnt);
963 printf " %6d%s hosts/domains\n", adj_int_units(int(keys %smtpdPerDom));
964 printf " %6d avg. connect time (seconds)\n",
965 $smtpdConnCnt > 0? ($smtpdTotTime / $smtpdConnCnt) + .5 : 0;
967 my ($sec, $min, $hr) = get_smh($smtpdTotTime);
968 printf " %2d:%02d:%02d total connect time\n",
975 print_problems_reports() if(defined($opts{'pf'}));
977 print_per_day_summary(\%msgsPerDay) if($dayCnt > 1);
978 print_per_hour_summary(\@rcvPerHr, \@dlvPerHr, \@dfrPerHr, \@bncPerHr,
979 \@rejPerHr, $dayCnt);
981 print_recip_domain_summary(\%recipDom, $opts{'h'});
982 print_sending_domain_summary(\%sendgDom, $opts{'h'});
984 if(defined($opts{'smtpdStats'})) {
985 print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
986 print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
987 print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
990 print_user_data(\%sendgUser, "Senders by message count", $msgCntI, $opts{'u'}, $opts{'q'});
991 print_user_data(\%recipUser, "Recipients by message count", $msgCntI, $opts{'u'}, $opts{'q'});
992 print_user_data(\%sendgUser, "Senders by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
993 print_user_data(\%recipUser, "Recipients by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
995 print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1);
997 print_problems_reports() unless(defined($opts{'pf'}));
999 print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'});
1001 # Print "problems" reports
1002 sub print_problems_reports {
1003 unless($opts{'deferralDetail'} == 0) {
1004 print_nested_hash(\%deferred, "message deferral detail", $opts{'deferralDetail'}, $opts{'q'});
1006 unless($opts{'bounceDetail'} == 0) {
1007 print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'bounceDetail'}, $opts{'q'});
1009 unless($opts{'rejectDetail'} == 0) {
1010 print_nested_hash(\%rejects, "message reject detail", $opts{'rejectDetail'}, $opts{'q'});
1011 print_nested_hash(\%warns, "message reject warning detail", $opts{'rejectDetail'}, $opts{'q'});
1012 print_nested_hash(\%holds, "message hold detail", $opts{'rejectDetail'}, $opts{'q'});
1013 print_nested_hash(\%discards, "message discard detail", $opts{'rejectDetail'}, $opts{'q'});
1015 unless($opts{'smtpDetail'} == 0) {
1016 print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtpDetail'}, $opts{'q'});
1018 unless($opts{'smtpdWarnDetail'} == 0) {
1019 print_nested_hash(\%warnings, "Warnings", $opts{'smtpdWarnDetail'}, $opts{'q'});
1021 print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'q'});
1022 print_nested_hash(\%panics, "Panics", 0, $opts{'q'});
1023 print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'q'});
1026 if($opts{'mailq'}) {
1027 # flush stdout first cuz of asynchronousity
1029 print_subsect_title("Current Mail Queue");
1033 # print "per-day" traffic summary
1034 # (done in a subroutine only to keep main-line code clean)
1035 sub print_per_day_summary {
1036 my($msgsPerDay) = @_;
1039 print_subsect_title("Per-Day Traffic Summary");
1041 print <<End_Of_Per_Day_Heading;
1042 date received delivered deferred bounced rejected
1043 --------------------------------------------------------------------
1044 End_Of_Per_Day_Heading
1046 foreach (sort { $a <=> $b } keys(%$msgsPerDay)) {
1047 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1049 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1051 my $msgMonStr = $monthNames[$msgMon];
1052 printf " $msgMonStr %2d $msgYr", $msgDay;
1054 foreach $value (@{$msgsPerDay->{$_}}) {
1055 my $value2 = $value? $value : 0;
1056 printf " %6d%s", adj_int_units($value2);
1062 # print "per-hour" traffic summary
1063 # (done in a subroutine only to keep main-line code clean)
1064 sub print_per_hour_summary {
1065 my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_;
1066 my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary';
1069 print_subsect_title("Per-Hour Traffic $reportType");
1071 print <<End_Of_Per_Hour_Heading;
1072 time received delivered deferred bounced rejected
1073 --------------------------------------------------------------------
1074 End_Of_Per_Hour_Heading
1076 for($hour = 0; $hour < 24; ++$hour) {
1078 printf " %02d:00-%02d:00", $hour, $hour + 1;
1080 printf " %02d00-%02d00 ", $hour, $hour + 1;
1082 foreach $value (@$rcvPerHr[$hour], @$dlvPerHr[$hour],
1083 @$dfrPerHr[$hour], @$bncPerHr[$hour],
1087 $value = ($value / $dayCnt) + 0.5 if($dayCnt);
1088 printf " %6d%s", adj_int_units($value);
1094 # print "per-recipient-domain" traffic summary
1095 # (done in a subroutine only to keep main-line code clean)
1096 sub print_recip_domain_summary {
1097 use vars '$hashRef';
1098 local($hashRef) = $_[0];
1100 return if($cnt == 0);
1101 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1104 print_subsect_title("Host/Domain Summary: Message Delivery $topCnt");
1106 print <<End_Of_Recip_Domain_Heading;
1107 sent cnt bytes defers avg dly max dly host/domain
1108 -------- ------- ------- ------- ------- -----------
1109 End_Of_Recip_Domain_Heading
1111 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1112 # there are only delay values if anything was sent
1113 if(${$hashRef->{$_}}[$msgCntI]) {
1114 $avgDly = (${$hashRef->{$_}}[$msgDlyAvgI] /
1115 ${$hashRef->{$_}}[$msgCntI]);
1119 printf " %6d%s %6d%s %6d%s %5.1f %s %5.1f %s %s\n",
1120 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1121 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1122 adj_int_units(${$hashRef->{$_}}[$msgDfrsI]),
1123 adj_time_units($avgDly),
1124 adj_time_units(${$hashRef->{$_}}[$msgDlyMaxI]),
1126 last if --$cnt == 0;
1130 # print "per-sender-domain" traffic summary
1131 # (done in a subroutine only to keep main-line code clean)
1132 sub print_sending_domain_summary {
1133 use vars '$hashRef';
1134 local($hashRef) = $_[0];
1136 return if($cnt == 0);
1137 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1139 print_subsect_title("Host/Domain Summary: Messages Received $topCnt");
1141 print <<End_Of_Sender_Domain_Heading;
1142 msg cnt bytes host/domain
1143 -------- ------- -----------
1144 End_Of_Sender_Domain_Heading
1146 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1147 printf " %6d%s %6d%s %s\n",
1148 adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1149 adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1151 last if --$cnt == 0;
1155 # print "per-user" data sorted in descending order
1156 # order (i.e.: highest first)
1157 sub print_user_data {
1158 my($hashRef, $title, $index, $cnt, $quiet) = @_;
1160 return if($cnt == 0);
1161 $title = sprintf "%s%s", $cnt > 0? "top $cnt " : "", $title;
1164 $dottedLine = ": none";
1166 $dottedLine = "\n" . "-" x length($title);
1168 printf "\n$title$dottedLine\n";
1169 foreach (map { $_->[0] }
1170 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1171 map { [ $_, $hashRef->{$_}[$index], normalize_host($_) ] }
1174 printf " %6d%s %s\n", adj_int_units(${$hashRef->{$_}}[$index]), $_;
1175 last if --$cnt == 0;
1180 # print "per-hour" smtpd connection summary
1181 # (done in a subroutine only to keep main-line code clean)
1182 sub print_per_hour_smtpd {
1183 my ($smtpdPerHr, $dayCnt) = @_;
1186 print_subsect_title("Per-Hour SMTPD Connection Daily Average");
1188 print <<End_Of_Per_Hour_Smtp_Average;
1189 hour connections time conn.
1190 -------------------------------------
1191 End_Of_Per_Hour_Smtp_Average
1193 print_subsect_title("Per-Hour SMTPD Connection Summary");
1195 print <<End_Of_Per_Hour_Smtp;
1196 hour connections time conn. avg./conn. max. time
1197 --------------------------------------------------------------------
1198 End_Of_Per_Hour_Smtp
1201 for($hour = 0; $hour < 24; ++$hour) {
1202 $smtpdPerHr[$hour]->[0] || next;
1203 my $avg = int($smtpdPerHr[$hour]->[0]?
1204 ($smtpdPerHr[$hour]->[1]/$smtpdPerHr[$hour]->[0]) + .5 : 0);
1206 $smtpdPerHr[$hour]->[0] /= $dayCnt;
1207 $smtpdPerHr[$hour]->[1] /= $dayCnt;
1208 $smtpdPerHr[$hour]->[0] += .5;
1209 $smtpdPerHr[$hour]->[1] += .5;
1211 my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]);
1214 printf " %02d:00-%02d:00", $hour, $hour + 1;
1216 printf " %02d00-%02d00 ", $hour, $hour + 1;
1218 printf " %6d%s %2d:%02d:%02d",
1219 adj_int_units($smtpdPerHr[$hour]->[0]),
1222 printf " %6ds %6ds",
1224 $smtpdPerHr[$hour]->[2];
1230 # print "per-day" smtpd connection summary
1231 # (done in a subroutine only to keep main-line code clean)
1232 sub print_per_day_smtpd {
1233 my ($smtpdPerDay, $dayCnt) = @_;
1235 print_subsect_title("Per-Day SMTPD Connection Summary");
1237 print <<End_Of_Per_Day_Smtp;
1238 date connections time conn. avg./conn. max. time
1239 --------------------------------------------------------------------
1242 foreach (sort { $a <=> $b } keys(%$smtpdPerDay)) {
1243 my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1245 printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1247 my $msgMonStr = $monthNames[$msgMon];
1248 printf " $msgMonStr %2d $msgYr", $msgDay;
1251 my $avg = (${$smtpdPerDay{$_}}[1]/${$smtpdPerDay{$_}}[0]) + .5;
1252 my($sec, $min, $hr) = get_smh(${$smtpdPerDay{$_}}[1]);
1254 printf " %6d%s %2d:%02d:%02d %6ds %6ds\n",
1255 adj_int_units(${$smtpdPerDay{$_}}[0]),
1258 ${$smtpdPerDay{$_}}[2];
1262 # print "per-domain-smtpd" connection summary
1263 # (done in a subroutine only to keep main-line code clean)
1264 sub print_domain_smtpd_summary {
1265 use vars '$hashRef';
1266 local($hashRef) = $_[0];
1268 return if($cnt == 0);
1269 my $topCnt = $cnt > 0? "(top $cnt)" : "";
1272 print_subsect_title("Host/Domain Summary: SMTPD Connections $topCnt");
1274 print <<End_Of_Domain_Smtp_Heading;
1275 connections time conn. avg./conn. max. time host/domain
1276 ----------- ---------- ---------- --------- -----------
1277 End_Of_Domain_Smtp_Heading
1279 foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1280 my $avg = (${$hashRef->{$_}}[1]/${$hashRef->{$_}}[0]) + .5;
1281 my ($sec, $min, $hr) = get_smh(${$hashRef->{$_}}[1]);
1283 printf " %6d%s %2d:%02d:%02d %6ds %6ds %s\n",
1284 adj_int_units(${$hashRef->{$_}}[0]),
1287 ${$hashRef->{$_}}[2],
1289 last if --$cnt == 0;
1293 # print hash contents sorted by numeric values in descending
1294 # order (i.e.: highest first)
1295 sub print_hash_by_cnt_vals {
1296 my($hashRef, $title, $cnt, $quiet) = @_;
1298 $title = sprintf "%s%s", $cnt? "top $cnt " : "", $title;
1301 $dottedLine = ": none";
1303 $dottedLine = "\n" . "-" x length($title);
1305 printf "\n$title$dottedLine\n";
1306 really_print_hash_by_cnt_vals($hashRef, $cnt, ' ');
1309 # print hash contents sorted by key in ascending order
1310 sub print_hash_by_key {
1311 my($hashRef, $title, $cnt, $quiet) = @_;
1313 $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title;
1316 $dottedLine = ": none";
1318 $dottedLine = "\n" . "-" x length($title);
1320 printf "\n$title$dottedLine\n";
1321 foreach (sort keys(%$hashRef))
1323 printf " %s %s\n", $_, $hashRef->{$_};
1324 last if --$cnt == 0;
1328 # print "nested" hashes
1329 sub print_nested_hash {
1330 my($hashRef, $title, $cnt, $quiet) = @_;
1334 $dottedLine = ": none";
1336 $dottedLine = "\n" . "-" x length($title);
1338 printf "\n$title$dottedLine\n";
1339 walk_nested_hash($hashRef, $cnt, 0);
1342 # "walk" a "nested" hash
1343 sub walk_nested_hash {
1344 my ($hashRef, $cnt, $level) = @_;
1346 my $indents = ' ' x $level;
1347 my ($keyName, $hashVal) = each(%$hashRef);
1349 if(ref($hashVal) eq 'HASH') {
1350 foreach (sort keys %$hashRef) {
1352 # If the next hash is finally the data, total the
1353 # counts for the report and print
1354 my $hashVal2 = (each(%{$hashRef->{$_}}))[1];
1355 keys(%{$hashRef->{$_}}); # "reset" hash iterator
1356 unless(ref($hashVal2) eq 'HASH') {
1357 print " (top $cnt)" if($cnt > 0);
1359 $rptCnt += $_ foreach (values %{$hashRef->{$_}});
1360 print " (total: $rptCnt)";
1363 walk_nested_hash($hashRef->{$_}, $cnt, $level);
1366 really_print_hash_by_cnt_vals($hashRef, $cnt, $indents);
1371 # print per-message info in excruciating detail :-)
1372 sub print_detailed_msg_data {
1373 use vars '$hashRef';
1374 local($hashRef) = $_[0];
1375 my($title, $quiet) = @_[1,2];
1379 $dottedLine = ": none";
1381 $dottedLine = "\n" . "-" x length($title);
1383 printf "\n$title$dottedLine\n";
1384 foreach (sort by_domain_then_user keys(%$hashRef))
1386 printf " %s %s\n", $_, shift(@{$hashRef->{$_}});
1387 foreach (@{$hashRef->{$_}}) {
1394 # *really* print hash contents sorted by numeric values in descending
1395 # order (i.e.: highest first), then by IP/addr, in ascending order.
1396 sub really_print_hash_by_cnt_vals {
1397 my($hashRef, $cnt, $indents) = @_;
1399 foreach (map { $_->[0] }
1400 sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1401 map { [ $_, $hashRef->{$_}, normalize_host($_) ] }
1404 printf "$indents%6d%s %s\n", adj_int_units($hashRef->{$_}), $_;
1405 last if --$cnt == 0;
1409 # Print a sub-section title with properly-sized underline
1410 sub print_subsect_title {
1412 print "\n$title\n" . "-" x length($title) . "\n";
1415 # Normalize IP addr or hostname
1416 # (Note: Makes no effort to normalize IPv6 addrs. Just returns them
1417 # as they're passed-in.)
1418 sub normalize_host {
1419 # For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
1420 my $norm1 = (split(/\s/, $_[0]))[0];
1422 if((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/o)) == 4) {
1423 # Dotted-quad IP address
1424 return(pack('C4', @octets));
1426 # Possibly hostname or user@dom.ain
1427 return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 ));
1431 # subroutine to sort by domain, then user in domain, then by queue i.d.
1432 # Note: mixing Internet-style domain names and UUCP-style bang-paths
1433 # may confuse this thing. An attempt is made to use the first host
1434 # preceding the username in the bang-path as the "domain" if none is
1436 sub by_domain_then_user {
1437 # first see if we can get "user@somedomain"
1438 my($userNameA, $domainA) = split(/\@/, ${$hashRef->{$a}}[0]);
1439 my($userNameB, $domainB) = split(/\@/, ${$hashRef->{$b}}[0]);
1441 # try "somedomain!user"?
1442 ($userNameA, $domainA) = (split(/!/, ${$hashRef->{$a}}[0]))[-1,-2]
1444 ($userNameB, $domainB) = (split(/!/, ${$hashRef->{$b}}[0]))[-1,-2]
1447 # now re-order "mach.host.dom"/"mach.host.do.co" to
1448 # "host.dom.mach"/"host.do.co.mach"
1449 $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1451 $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1454 # oddly enough, doing this here is marginally faster than doing
1455 # an "if-else", above. go figure.
1456 $domainA = "" unless($domainA);
1457 $domainB = "" unless($domainB);
1459 if($domainA lt $domainB) {
1461 } elsif($domainA gt $domainB) {
1464 # disregard leading bang-path
1465 $userNameA =~ s/^.*!//o;
1466 $userNameB =~ s/^.*!//o;
1467 if($userNameA lt $userNameB) {
1469 } elsif($userNameA gt $userNameB) {
1482 # Subroutine used by host/domain reports to sort by count, then size.
1483 # We "fix" un-initialized values here as well. Very ugly and un-
1484 # structured to do this here - but it's either that or the callers
1485 # must run through the hashes twice :-(.
1486 sub by_count_then_size {
1487 ${$hashRef->{$a}}[$msgCntI] = 0 unless(${$hashRef->{$a}}[$msgCntI]);
1488 ${$hashRef->{$b}}[$msgCntI] = 0 unless(${$hashRef->{$b}}[$msgCntI]);
1489 if(${$hashRef->{$a}}[$msgCntI] == ${$hashRef->{$b}}[$msgCntI]) {
1490 ${$hashRef->{$a}}[$msgSizeI] = 0 unless(${$hashRef->{$a}}[$msgSizeI]);
1491 ${$hashRef->{$b}}[$msgSizeI] = 0 unless(${$hashRef->{$b}}[$msgSizeI]);
1492 return(${$hashRef->{$a}}[$msgSizeI] <=>
1493 ${$hashRef->{$b}}[$msgSizeI]);
1495 return(${$hashRef->{$a}}[$msgCntI] <=>
1496 ${$hashRef->{$b}}[$msgCntI]);
1500 # return a date string to match in log
1502 my $dateOpt = $_[0];
1506 if($dateOpt eq "yesterday") {
1507 # Back up to yesterday
1508 $time -= ((localtime($time))[2] + 2) * 3600;
1509 } elsif($dateOpt ne "today") {
1512 my ($t_mday, $t_mon) = (localtime($time))[3,4];
1514 return sprintf("%s %2d", $monthNames[$t_mon], $t_mday);
1517 # if there's a real domain: uses that. Otherwise uses the IP addr.
1518 # Lower-cases returned domain name.
1520 # Optional bit of code elides the last octet of an IPv4 address.
1521 # (In case one wants to assume an IPv4 addr. is a dialup or other
1522 # dynamic IP address in a /24.)
1523 # Does nothing interesting with IPv6 addresses.
1524 # FIXME: I think the IPv6 address parsing may be weak
1527 my($domain, $ipAddr);
1529 # split domain/ipaddr into separates
1530 # newer versions of Postfix have them "dom.ain[i.p.add.ress]"
1531 # older versions of Postfix have them "dom.ain/i.p.add.ress"
1532 unless((($domain, $ipAddr) = /^([^\[]+)\[((?:\d{1,3}\.){3}\d{1,3})\]/o) == 2 ||
1533 (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/oi) == 2) {
1534 # more exhaustive method
1535 ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o;
1538 # "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
1539 if($domain eq 'unknown') {
1541 # For identifying the host part on a Class C network (commonly
1542 # seen with dial-ups) the following is handy.
1543 # $domain =~ s/\.\d+$//o;
1546 s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o;
1552 # Return (value, units) for integer
1556 $value = 0 unless($value);
1557 if($value > $divByOneMegAt) {
1560 } elsif($value > $divByOneKAt) {
1564 return($value, $units);
1567 # Return (value, units) for time
1568 sub adj_time_units {
1571 $value = 0 unless($value);
1575 } elsif($value > 60) {
1579 return($value, $units);
1582 # Trim a "said:" string, if necessary. Add elipses to show it.
1583 # FIXME: This sometimes elides The Wrong Bits, yielding
1584 # summaries that are less useful than they could be.
1585 sub said_string_trimmer {
1586 my($trimmedString, $maxLen) = @_;
1588 while(length($trimmedString) > $maxLen) {
1589 if($trimmedString =~ /^.* said: /o) {
1590 $trimmedString =~ s/^.* said: //o;
1591 } elsif($trimmedString =~ /^.*: */o) {
1592 $trimmedString =~ s/^.*?: *//o;
1594 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
1599 return $trimmedString;
1602 # Trim a string, if necessary. Add elipses to show it.
1603 sub string_trimmer {
1604 my($trimmedString, $maxLen, $doNotTrim) = @_;
1606 $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..."
1607 if(! $doNotTrim && (length($trimmedString) > $maxLen));
1608 return $trimmedString;
1611 # Get seconds, minutes and hours from seconds
1614 my $hr = int($sec / 3600);
1616 my $min = int($sec / 60);
1618 return($sec, $min, $hr);
1621 # Process smtpd rejects
1622 sub proc_smtpd_reject {
1623 my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_;
1624 my ($rejTyp, $rejFrom, $rejRmdr, $rejReas);
1632 # Hate the sub-calling overhead if we're not doing reject details
1633 # anyway, but this is the only place we can do this.
1634 return if($opts{'rejectDetail'} == 0);
1636 # This could get real ugly!
1638 # First: get everything following the "reject: ", etc. token
1639 # Was an IPv6 problem here
1640 ($rejTyp, $rejFrom, $rejRmdr) =
1641 ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/o);
1643 # Next: get the reject "reason"
1644 $rejReas = $rejRmdr;
1645 unless(defined($opts{'verbMsgDetail'})) {
1646 if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") { # special treatment :-(
1647 # If there are "<>"s immediately following the reject code, that's
1648 # an email address or HELO string. There can be *anything* in
1649 # those--incl. stuff that'll screw up subsequent parsing. So just
1650 # get rid of it right off.
1651 $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/o;
1652 $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/o;
1653 $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/o;
1654 $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/o;
1655 } elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr...
1656 $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o;
1658 $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o;
1662 # Snag recipient address
1663 # Second expression is for unknown recipient--where there is no
1664 # "to=<mumble>" field, third for pathological case where recipient
1665 # field is unterminated, forth when all else fails.
1666 (($to) = $rejRmdr =~ /to=<([^>]+)>/o) ||
1667 (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /o) ||
1668 (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/o) ||
1670 $to = lc($to) if($opts{'i'});
1672 # Snag sender address
1673 (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>");
1675 if(defined($from)) {
1676 $rejAddFrom = $opts{'rejAddFrom'};
1677 $from = verp_mung($from);
1678 $from = lc($from) if($opts{'i'});
1681 # stash in "triple-subscripted-array"
1682 if($rejReas =~ m/^Sender address rejected:/o) {
1683 # Sender address rejected: Domain not found
1684 # Sender address rejected: need fully-qualified address
1685 ++$rejects->{$rejTyp}{$rejReas}{$from};
1686 } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/o) {
1687 # Recipient address rejected: Domain not found
1688 # Recipient address rejected: need fully-qualified address
1689 # User unknown (in local/relay recipient table)
1690 #++$rejects->{$rejTyp}{$rejReas}{$to};
1693 $rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
1695 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1696 } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) {
1697 # Was an IPv6 problem here
1698 my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o;
1699 ++$rejects->{$rejTyp}{$rejReas}{$src};
1700 } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) {
1701 my $rejData = gimme_domain($rejFrom);
1702 $rejData .= " ($from)" if($rejAddFrom);
1703 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1704 } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/o) {
1705 my $rejData = gimme_domain($rejFrom);
1706 $rejData .= " ($from)" if($rejAddFrom);
1707 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1709 # print STDERR "dbg: unknown reject reason $rejReas !\n\n";
1710 my $rejData = gimme_domain($rejFrom);
1711 $rejData .= " ($from)" if($rejAddFrom);
1712 ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1716 # Hack for VERP (?) - convert address from somthing like
1717 # "list-return-36-someuser=someplace.com@lists.domain.com"
1718 # to "list-return-ID-someuser=someplace.com@lists.domain.com"
1719 # to prevent per-user listing "pollution." More aggressive
1720 # munging converts to something like
1721 # "list-return@lists.domain.com" (Instead of "return," there
1722 # may be numeric list name/id, "warn", "error", etc.?)
1726 if(defined($opts{'verpMung'})) {
1727 $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi;
1728 if($opts{'verpMung'} > 1) {
1729 $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o;
1737 ### Warning and Error Routines
1740 # Emit warning message to stderr
1742 warn "warning: $progName: $_[0]\n";