465fbcbcc82627a3d3105837ed866c8857b3d27f
[sven/pflogsumm.git] / pflogsumm.pl
1 #!/usr/bin/perl
2 eval 'exec perl -S $0 "$@"'
3     if 0;
4
5 =head1 NAME
6
7 pflogsumm.pl - Produce Postfix MTA logfile summary
8
9 Copyright (C) 1998-2003 by James S. Seymour, Release 1.1.0.
10
11 =head1 SYNOPSIS
12
13     pflogsumm.pl -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
14         [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
15         [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
16         [--problems_first] [--rej_add_from] [--no_bounce_detail]
17         [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
18         [--no_smtpd_warnings] [--zero_fill] [--syslog_name=string]
19         [file1 [filen]]
20
21     pflogsumm.pl -[help|version]
22
23     If no file(s) specified, reads from stdin.  Output is to stdout.
24
25 =head1 DESCRIPTION
26
27     Pflogsumm is a log analyzer/summarizer for the Postfix MTA.  It is
28     designed to provide an over-view of Postfix activity, with just enough
29     detail to give the administrator a "heads up" for potential trouble
30     spots.
31     
32     Pflogsumm generates summaries and, in some cases, detailed reports of
33     mail server traffic volumes, rejected and bounced email, and server
34     warnings, errors and panics.
35
36 =head1 OPTIONS
37
38     -d today       generate report for just today
39     -d yesterday   generate report for just "yesterday"
40
41     -e             extended (extreme? excessive?) detail
42
43                    Emit detailed reports.  At present, this includes
44                    only a per-message report, sorted by sender domain,
45                    then user-in-domain, then by queue i.d.
46
47                    WARNING: the data built to generate this report can
48                    quickly consume very large amounts of memory if a
49                    lot of log entries are processed!
50
51     -h <cnt>       top <cnt> to display in host/domain reports.
52     
53                    0 = none.
54
55                    See also: "-u" and "--no_*_detail" for further
56                              report-limiting options.
57
58     --help         Emit short usage message and bail out.
59     
60                    (By happy coincidence, "-h" alone does much the same,
61                    being as it requires a numeric argument :-).  Yeah, I
62                    know: lame.)
63
64     -i
65     --ignore_case  Handle complete email address in a case-insensitive
66                    manner.
67                    
68                    Normally pflogsumm lower-cases only the host and
69                    domain parts, leaving the user part alone.  This
70                    option causes the entire email address to be lower-
71                    cased.
72
73     --iso_date_time
74
75                    For summaries that contain date or time information,
76                    use ISO 8601 standard formats (CCYY-MM-DD and HH:MM),
77                    rather than "Mon DD CCYY" and "HHMM".
78
79     -m             modify (mung?) UUCP-style bang-paths
80     --uucp_mung
81
82                    This is for use when you have a mix of Internet-style
83                    domain addresses and UUCP-style bang-paths in the log.
84                    Upstream UUCP feeds sometimes mung Internet domain
85                    style address into bang-paths.  This option can
86                    sometimes undo the "damage".  For example:
87                    "somehost.dom!username@foo" (where "foo" is the next
88                    host upstream and "somehost.dom" was whence the email
89                    originated) will get converted to
90                    "foo!username@somehost.dom".  This also affects the
91                    extended detail report (-e), to help ensure that by-
92                     domain-by-name sorting is more accurate.
93
94     --mailq        Run "mailq" command at end of report.
95     
96                    Merely a convenience feature.  (Assumes that "mailq"
97                    is in $PATH.  See "$mailqCmd" variable to path thisi
98                    if desired.)
99
100     --no_bounce_detail
101     --no_deferral_detail
102     --no_reject_detail
103
104                    Suppresses the printing of the following detailed
105                    reports, respectively:
106
107                         message bounce detail (by relay)
108                         message deferral detail
109                         message reject detail
110
111                    See also: "-u" and "-h" for further report-limiting
112                              options.
113
114     --no_no_msg_size
115
116                     Do not emit report on "Messages with no size data".
117
118                     Message size is reported only by the queue manager.
119                     The message may be delivered long-enough after the
120                     (last) qmgr log entry that the information is not in
121                     the log(s) processed by a particular run of
122                     pflogsumm.pl.  This throws off "Recipients by message
123                     size" and the total for "bytes delivered." These are
124                     normally reported by pflogsumm as "Messages with no
125                     size data."
126
127     --no_smtpd_warnings
128
129                     On a busy mail server, say at an ISP, SMTPD warnings
130                     can result in a rather sizeable report.  This option
131                     turns reporting them off.
132
133     --problems_first
134
135                    Emit "problems" reports (bounces, defers, warnings,
136                    etc.) before "normal" stats.
137
138     --rej_add_from
139                    For those reject reports that list IP addresses or
140                    host/domain names: append the email from address to
141                    each listing.  (Does not apply to "Improper use of
142                    SMTP command pipelining" report.)
143
144     -q             quiet - don't print headings for empty reports
145     
146                    note: headings for warning, fatal, and "master"
147                    messages will always be printed.
148
149     --smtpd_stats
150
151                    Generate smtpd connection statistics.
152
153                    The "per-day" report is not generated for single-day
154                    reports.  For multiple-day reports: "per-hour" numbers
155                    are daily averages (reflected in the report heading).
156
157     --syslog_name=name
158
159                    Set syslog_name to look for for Postfix log entries.
160
161                    By default, pflogsumm looks for entries in logfiles
162                    with a syslog name of "postfix," the default.
163                    If you've set a non-default "syslog_name" parameter
164                    in your Postfix configuration, use this option to
165                    tell pflogsumm what that is.
166
167                    See the discussion about the use of this option under
168                    "NOTES," below.
169
170     -u <cnt>       top <cnt> to display in user reports. 0 == none.
171
172                    See also: "-h" and "--no_*_detail" for further
173                              report-limiting options.
174
175     --verbose_msg_detail
176
177                    For the message deferral, bounce and reject summaries:
178                    display the full "reason", rather than a truncated one.
179
180                    Note: this can result in quite long lines in the report.
181
182     --verp_mung    do "VERP" generated address (?) munging.  Convert
183     --verp_mung=2  sender addresses of the form
184                    "list-return-NN-someuser=some.dom@host.sender.dom"
185                     to
186                       "list-return-ID-someuser=some.dom@host.sender.dom"
187
188                     In other words: replace the numeric value with "ID".
189
190                    By specifying the optional "=2" (second form), the
191                    munging is more "aggressive", converting the address
192                    to something like:
193
194                         "list-return@host.sender.dom"
195
196                    Actually: specifying anything less than 2 does the
197                    "simple" munging and anything greater than 1 results
198                    in the more "aggressive" hack being applied.
199
200                    See "NOTES" regarding this option.
201
202     --version      Print program name and version and bail out.
203
204     --zero_fill    "Zero-fill" certain arrays so reports come out with
205                    data in columns that that might otherwise be blank.
206
207 =head1 RETURN VALUE
208
209     Pflogsumm doesn't return anything of interest to the shell.
210
211 =head1 ERRORS
212
213     Error messages are emitted to stderr.
214
215 =head1 EXAMPLES
216
217     Produce a report of previous day's activities:
218
219         pflogsumm.pl -d yesterday /var/log/maillog
220
221     A report of prior week's activities (after logs rotated):
222
223         pflogsumm.pl /var/log/maillog.0
224
225     What's happened so far today:
226
227         pflogsumm.pl -d today /var/log/maillog
228
229     Crontab entry to generate a report of the previous day's activity
230     at 10 minutes after midnight.
231
232         10 0 * * * /usr/local/sbin/pflogsumm -d yesterday /var/log/maillog
233         2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
234
235     Crontab entry to generate a report for the prior week's activity.
236     (This example assumes one rotates ones mail logs weekly, some time
237     before 4:10 a.m. on Sunday.)
238
239         10 4 * * 0   /usr/local/sbin/pflogsumm /var/log/maillog.0
240         2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
241
242     The two crontab examples, above, must actually be a single line
243     each.  They're broken-up into two-or-more lines due to page
244     formatting issues.
245
246 =head1 SEE ALSO
247
248     The pflogsumm FAQ: pflogsumm-faq.txt.
249
250 =head1 NOTES
251
252     Pflogsumm makes no attempt to catch/parse non-Postfix log
253     entries.  Unless it has "postfix/" in the log entry, it will be
254     ignored.
255
256     It's important that the logs are presented to pflogsumm in
257     chronological order so that message sizes are available when
258     needed.
259
260     For display purposes: integer values are munged into "kilo" and
261     "mega" notation as they exceed certain values.  I chose the
262     admittedly arbitrary boundaries of 512k and 512m as the points at
263     which to do this--my thinking being 512x was the largest number
264     (of digits) that most folks can comfortably grok at-a-glance.
265     These are "computer" "k" and "m", not 1000 and 1,000,000.  You
266     can easily change all of this with some constants near the
267     beginning of the program.
268
269     "Items-per-day" reports are not generated for single-day
270     reports.  For multiple-day reports: "Items-per-hour" numbers are
271     daily averages (reflected in the report headings).
272
273     Message rejects, reject warnings, holds and discards are all
274     reported under the "rejects" column for the Per-Hour and Per-Day
275     traffic summaries.
276
277     Verp munging may not always result in correct address and
278     address-count reduction.
279
280     Verp munging is always in a state of experimentation.  The use
281     of this option may result in inaccurate statistics with regards
282     to the "senders" count.
283
284     UUCP-style bang-path handling needs more work.  Particularly if
285     Postfix is not being run with "swap_bangpath = yes" and/or *is* being
286     run with "append_dot_mydomain = yes", the detailed by-message report
287     may not be sorted correctly by-domain-by-user.  (Also depends on
288     upstream MTA, I suspect.)
289
290     The "percent rejected" and "percent discarded" figures are only
291     approximations.  They are calculated as follows (example is for
292     "percent rejected"):
293
294         percent rejected =
295         
296             (rejected / (delivered + rejected + discarded)) * 100
297
298     There are some issues with the use of --syslog_name.  The problem is
299     that, even with $syslog_name set, Postfix will sometimes still log
300     things with "postfix" as the syslog_name.  This is noted in
301     /etc/postfix/sample-misc.cf:
302
303         # Beware: a non-default syslog_name setting takes effect only
304         # after process initialization. Some initialization errors will be
305         # logged with the default name, especially errors while parsing
306         # the command line and errors while accessing the Postfix main.cf
307         # configuration file.
308
309     As a consequence, pflogsumm must always look for "postfix," in logs,
310     as well as whatever is supplied for syslog_name.
311
312     Where this becomes an issue is where people are running two or more
313     instances of Postfix, logging to the same file.  In such a case:
314
315         . Neither instance may use the default "postfix" syslog name
316           and...
317
318         . Log entries that fall victim to what's described in
319           sample-misc.cf will be reported under "postfix", so that if
320           you're running pflogsumm twice, once for each syslog_name, such
321           log entries will show up in each report.
322
323     The Pflogsumm Home Page is at:
324
325         http://jimsun.LinxNet.com/postfix_contrib.html
326
327 =head1 REQUIREMENTS
328
329     Pflogsumm requires the Date::Calc module, which can be obtained from
330     CPAN at http://www.perl.com.
331
332     Pflogsumm is currently written and tested under Perl 5.005_03.
333     As of version 19990413-02, pflogsumm worked with Perl 5.003, but
334     future compatibility is not guaranteed.
335
336 =head1 LICENSE
337
338     This program is free software; you can redistribute it and/or
339     modify it under the terms of the GNU General Public License
340     as published by the Free Software Foundation; either version 2
341     of the License, or (at your option) any later version.
342     
343     This program is distributed in the hope that it will be useful,
344     but WITHOUT ANY WARRANTY; without even the implied warranty of
345     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
346     GNU General Public License for more details.
347     
348     You may have received a copy of the GNU General Public License
349     along with this program; if not, write to the Free Software
350     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
351     USA.
352     
353     An on-line copy of the GNU General Public License can be found
354     http://www.fsf.org/copyleft/gpl.html.
355
356 =cut
357
358 use strict;
359 use locale;
360 use Getopt::Long;
361 # ---Begin: SMTPD_STATS_SUPPORT---
362 use Date::Calc qw(Delta_DHMS);
363 # ---End: SMTPD_STATS_SUPPORT---
364
365 my $mailqCmd = "mailq";
366 my $release = "1.1.0";
367
368 # Variables and constants used throughout pflogsumm
369 use vars qw(
370     $progName
371     $usageMsg
372     %opts
373     $divByOneKAt $divByOneMegAt $oneK $oneMeg
374     @monthNames %monthNums $thisYr $thisMon
375     $msgCntI $msgSizeI $msgDfrsI $msgDlyAvgI $msgDlyMaxI
376     $isoDateTime
377 );
378
379 # Some constants used by display routines.  I arbitrarily chose to
380 # display in kilobytes and megabytes at the 512k and 512m boundaries,
381 # respectively.  Season to taste.
382 $divByOneKAt   = 524288;        # 512k
383 $divByOneMegAt = 536870912;     # 512m
384 $oneK          = 1024;          # 1k
385 $oneMeg        = 1048576;       # 1m
386
387 # Constants used throughout pflogsumm
388 @monthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
389 %monthNums = qw(
390     Jan  0 Feb  1 Mar  2 Apr  3 May  4 Jun  5
391     Jul  6 Aug  7 Sep  8 Oct  9 Nov 10 Dec 11);
392 ($thisMon, $thisYr) = (localtime(time()))[4,5];
393 $thisYr += 1900;
394
395 #
396 # Variables used only in main loop
397 #
398 # Per-user data
399 my (%recipUser, $recipUserCnt);
400 my (%sendgUser, $sendgUserCnt);
401 # Per-domain data
402 my (%recipDom, $recipDomCnt);   # recipient domain data
403 my (%sendgDom, $sendgDomCnt);   # sending domain data
404 # Indexes for arrays in above
405 $msgCntI    = 0;        # message count
406 $msgSizeI   = 1;        # total messages size
407 $msgDfrsI   = 2;        # number of defers
408 $msgDlyAvgI = 3;        # total of delays (used for averaging)
409 $msgDlyMaxI = 4;        # max delay
410
411 my (
412     $cmd, $qid, $addr, $size, $relay, $status, $delay,
413     $dateStr,
414     %panics, %fatals, %warnings, %masterMsgs,
415     %msgSizes,
416     %deferred, %bounced,
417     %noMsgSize, %msgDetail,
418     $msgsRcvd, $msgsDlvrd, $sizeRcvd, $sizeDlvrd,
419     $msgMonStr, $msgMon, $msgDay, $msgTimeStr, $msgHr, $msgMin, $msgSec,
420     $msgYr,
421     $revMsgDateStr, $dayCnt, %msgsPerDay,
422     %rejects, $msgsRjctd,
423     %warns, $msgsWrnd,
424     %discards, $msgsDscrdd,
425     %holds, $msgsHld,
426     %rcvdMsg, $msgsFwdd, $msgsBncd,
427     $msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
428     %connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
429     %smtpMsgs
430 );
431 $dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
432
433 # Init total messages delivered, rejected, and discarded
434 $msgsDlvrd = $msgsRjctd = $msgsDscrdd = 0;
435
436 # Init messages received and delivered per hour
437 my @rcvPerHr = (0) x 24;
438 my @dlvPerHr = @rcvPerHr;
439 my @dfrPerHr = @rcvPerHr;       # defers per hour
440 my @bncPerHr = @rcvPerHr;       # bounces per hour
441 my @rejPerHr = @rcvPerHr;       # rejects per hour
442 my $lastMsgDay = 0;
443
444 # Init "doubly-sub-scripted array": cnt, total and max time per-hour
445 my @smtpdPerHr;
446 for (0 .. 23) {
447     $smtpdPerHr[$_]  = [0,0,0];
448 }
449
450 $progName = "pflogsumm.pl";
451 $usageMsg =
452     "usage: $progName -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
453        [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
454        [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
455        [--problems_first] [--rej_add_from] [--no_bounce_detail]
456        [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
457        [--no_smtpd_warnings] [--zero_fill] [--syslog_name=name]
458        [file1 [filen]]
459
460        $progName --[version|help]";
461
462 # Some pre-inits for convenience
463 $isoDateTime = 0;       # Don't use ISO date/time formats
464 GetOptions(
465     "d=s"                => \$opts{'d'},
466     "e"                  => \$opts{'e'},
467     "help"               => \$opts{'help'},
468     "h=i"                => \$opts{'h'},
469     "i"                  => \$opts{'i'},
470     "ignore_case"        => \$opts{'i'},
471     "iso_date_time"      => \$isoDateTime,
472     "m"                  => \$opts{'m'},
473     "uucp_mung"          => \$opts{'m'},
474     "mailq"              => \$opts{'mailq'},
475     "no_bounce_detail"   => \$opts{'noBounceDetail'},
476     "no_deferral_detail" => \$opts{'noDeferralDetail'},
477     "no_reject_detail"   => \$opts{'noRejectDetail'},
478     "no_no_msg_size"     => \$opts{'noNoMsgSize'},
479     "no_smtpd_warnings"  => \$opts{'noSMTPDWarnings'},
480     "problems_first"     => \$opts{'pf'},
481     "q"                  => \$opts{'q'},
482     "rej_add_from"       => \$opts{'rejAddFrom'},
483     "smtpd_stats"        => \$opts{'smtpdStats'},
484     "syslog_name=s"      => \$opts{'syslogName'},
485     "u=i"                => \$opts{'u'},
486     "verbose_msg_detail" => \$opts{'verbMsgDetail'},
487     "verp_mung:i"        => \$opts{'verpMung'},
488     "version"            => \$opts{'version'},
489     "zero_fill"          => \$opts{'zeroFill'}
490 ) || die "$usageMsg\n";
491
492 # internally: 0 == none, undefined == -1 == all
493 $opts{'h'} = -1 unless(defined($opts{'h'}));
494 $opts{'u'} = -1 unless(defined($opts{'u'}));
495 my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
496
497 if(defined($opts{'help'})) {
498     print "$usageMsg\n";
499     exit 0;
500 }
501
502 if(defined($opts{'version'})) {
503     print "$progName $release\n";
504     exit 0;
505 }
506
507 $dateStr = get_datestr($opts{'d'}) if(defined($opts{'d'}));
508
509 # debugging
510 #open(UNPROCD, "> unprocessed") ||
511 #    die "couldn't open \"unprocessed\": $!\n";
512
513 while(<>) {
514     next if(defined($dateStr) && ! /^$dateStr/o);
515     s/: \[ID \d+ [^\]]+\] /: /o;        # lose "[ID nnnnnn some.thing]" stuff
516     my $logRmdr;
517     next unless((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
518         /^(...) +(\d+) (..):(..):(..) \S+ (.+)$/o) == 6);
519     unless((($cmd, $qid) = $logRmdr =~ m#^(?:vmailer|postfix|$syslogName)/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
520            (($cmd, $qid) = $logRmdr =~ m#^((?:vmailer|postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
521     {
522         #print UNPROCD "$_";
523         next;
524     }
525     chomp;
526
527     # snatch out log entry date & time
528     $msgMon = $monthNums{$msgMonStr};
529     $msgYr = ($msgMon > $thisMon? $thisYr - 1 : $thisYr);
530
531     # the following test depends on one getting more than one message a
532     # month--or at least that successive messages don't arrive on the
533     # same month-day in successive months :-)
534     unless($msgDay == $lastMsgDay) {
535         $lastMsgDay = $msgDay;
536         $revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay;
537         ++$dayCnt;
538         if(defined($opts{'zeroFill'})) {
539             ${$msgsPerDay{$revMsgDateStr}}[4] = 0;
540         }
541     }
542
543     # regexp rejects happen in "cleanup"
544     if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
545         /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/o) == 3)
546     {
547         $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'});
548         $rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
549         if($rejSubTyp eq "reject") {
550             ++$rejects{$cmd}{$rejReas}{$rejRmdr};
551             ++$msgsRjctd;
552         } elsif($rejSubTyp eq "warning") {
553             ++$warns{$cmd}{$rejReas}{$rejRmdr};
554             ++$msgsWrnd;
555         } elsif($rejSubTyp eq "hold") {
556             ++$holds{$cmd}{$rejReas}{$rejRmdr};
557             ++$msgsHld;
558         } elsif($rejSubTyp eq "discard") {
559             ++$discards{$cmd}{$rejReas}{$rejRmdr};
560             ++$msgsDscrdd;
561         }
562         ++$rejPerHr[$msgHr];
563         ++${$msgsPerDay{$revMsgDateStr}}[4];
564     } elsif($qid eq 'warning') {
565         (my $warnReas = $logRmdr) =~ s/^.*warning: //o;
566         $warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
567         unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
568             ++$warnings{$cmd}{$warnReas};
569         }
570     } elsif($qid eq 'fatal') {
571         (my $fatalReas = $logRmdr) =~ s/^.*fatal: //o;
572         $fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
573         ++$fatals{$cmd}{$fatalReas};
574     } elsif($qid eq 'panic') {
575         (my $panicReas = $logRmdr) =~ s/^.*panic: //o;
576         $panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
577         ++$panics{$cmd}{$panicReas};
578     } elsif($qid eq 'reject') {
579         proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr],
580                           \${$msgsPerDay{$revMsgDateStr}}[4]);
581     } elsif($qid eq 'reject_warning') {
582         proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr],
583                           \${$msgsPerDay{$revMsgDateStr}}[4]);
584     } elsif($qid eq 'hold') {
585         proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr],
586                           \${$msgsPerDay{$revMsgDateStr}}[4]);
587     } elsif($qid eq 'discard') {
588         proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr],
589                           \${$msgsPerDay{$revMsgDateStr}}[4]);
590     } elsif($cmd eq 'master') {
591         ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
592     } elsif($cmd eq 'smtpd') {
593         if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) {
594             #
595             # Warning: this code in two places!
596             #
597             ++$rcvPerHr[$msgHr];
598             ++${$msgsPerDay{$revMsgDateStr}}[0];
599             ++$msgsRcvd;
600             $rcvdMsg{$qid} = gimme_domain($1);  # Whence it came
601         } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) {
602             if($rejSubTyp eq 'reject') {
603                 proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
604                                   \$rejPerHr[$msgHr],
605                                   \${$msgsPerDay{$revMsgDateStr}}[4]);
606             } elsif($rejSubTyp eq 'reject_warning') {
607                 proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
608                                   \$rejPerHr[$msgHr],
609                                   \${$msgsPerDay{$revMsgDateStr}}[4]);
610             } elsif($rejSubTyp eq 'hold') {
611                 proc_smtpd_reject($logRmdr, \%holds, \$msgsHld,
612                                   \$rejPerHr[$msgHr],
613                                   \${$msgsPerDay{$revMsgDateStr}}[4]);
614             } elsif($rejSubTyp eq 'discard') {
615                 proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd,
616                                   \$rejPerHr[$msgHr],
617                                   \${$msgsPerDay{$revMsgDateStr}}[4]);
618             }
619         }
620 # ---Begin: SMTPD_STATS_SUPPORT---
621         else {
622             next unless(defined($opts{'smtpdStats'}));
623             if($logRmdr =~ /: connect from /o) {
624                 $logRmdr =~ /\/smtpd\[(\d+)\]: /o;
625                 @{$connTime{$1}} =
626                     ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
627             } elsif($logRmdr =~ /: disconnect from /o) {
628                 my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o;
629                 if(exists($connTime{$pid})) {
630                     $hostID = gimme_domain($hostID);
631                     my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
632                         $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
633                     delete($connTime{$pid});    # dispose of no-longer-needed item
634                     my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s;
635
636                     ++$smtpdPerHr[$msgHr][0];
637                     $smtpdPerHr[$msgHr][1] += $tSecs;
638                     $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]);
639
640                     unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) {
641                         ${$smtpdPerDay{$revMsgDateStr}}[1] = 0;
642                         ${$smtpdPerDay{$revMsgDateStr}}[2] = 0;
643                     }
644                     ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs;
645                     ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs
646                         if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]);
647
648                     unless(${$smtpdPerDom{$hostID}}[0]++) {
649                         ${$smtpdPerDom{$hostID}}[1] = 0;
650                         ${$smtpdPerDom{$hostID}}[2] = 0;
651                     }
652                     ${$smtpdPerDom{$hostID}}[1] += $tSecs;
653                     ${$smtpdPerDom{$hostID}}[2] = $tSecs
654                         if($tSecs > ${$smtpdPerDom{$hostID}}[2]);
655
656                     ++$smtpdConnCnt;
657                     $smtpdTotTime += $tSecs;
658                 }
659             }
660         }
661 # ---End: SMTPD_STATS_SUPPORT---
662     } else {
663         my $toRmdr;
664         if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2)
665         {
666             next if($msgSizes{$qid});   # avoid double-counting!
667             if($addr) {
668                 if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
669                     $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
670                 }
671                 $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
672                 $addr = lc($addr) if($opts{'i'});
673                 $addr = verp_mung($addr);
674             } else {
675                 $addr = "from=<>"
676             }
677             $msgSizes{$qid} = $size;
678             push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
679             # Avoid counting forwards
680             if($rcvdMsg{$qid}) {
681                 # Get the domain out of the sender's address.  If there is
682                 # none: Use the client hostname/IP-address
683                 my $domAddr;
684                 unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/o) == 1) {
685                     $domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
686                 }
687                 ++$sendgDomCnt
688                     unless(${$sendgDom{$domAddr}}[$msgCntI]);
689                 ++${$sendgDom{$domAddr}}[$msgCntI];
690                 ${$sendgDom{$domAddr}}[$msgSizeI] += $size;
691                 ++$sendgUserCnt unless(${$sendgUser{$addr}}[$msgCntI]);
692                 ++${$sendgUser{$addr}}[$msgCntI];
693                 ${$sendgUser{$addr}}[$msgSizeI] += $size;
694                 $sizeRcvd += $size;
695                 delete($rcvdMsg{$qid});         # limit hash size
696             }
697         }
698         elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
699                 /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), delay=([^,]+), status=(\S+)(.*)$/o) >= 4)
700         {
701
702             if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
703                 $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
704             }
705             $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
706             $addr = lc($addr) if($opts{'i'});
707             (my $domAddr = $addr) =~ s/^[^@]+\@//o;     # get domain only
708             if($status eq 'sent') {
709
710                 # was it actually forwarded, rather than delivered?
711                 if($toRmdr =~ /forwarded as /o) {
712                     ++$msgsFwdd;
713                     next;
714                 }
715                 ++$recipDomCnt unless(${$recipDom{$domAddr}}[$msgCntI]);
716                 ++${$recipDom{$domAddr}}[$msgCntI];
717                 ${$recipDom{$domAddr}}[$msgDlyAvgI] += $delay;
718                 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
719                    $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
720                 {
721                     ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
722                 }
723                 ++$recipUserCnt unless(${$recipUser{$addr}}[$msgCntI]);
724                 ++${$recipUser{$addr}}[$msgCntI];
725                 ++$dlvPerHr[$msgHr];
726                 ++${$msgsPerDay{$revMsgDateStr}}[1];
727                 ++$msgsDlvrd;
728                 if($msgSizes{$qid}) {
729                     ${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid};
730                     ${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid};
731                     $sizeDlvrd += $msgSizes{$qid};
732                 } else {
733                     ${$recipDom{$domAddr}}[$msgSizeI] += 0;
734                     ${$recipUser{$addr}}[$msgSizeI] += 0;
735                     $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'});
736                     push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'});
737                     # put this back later? mebbe with -v?
738                     # msg_warn("no message size for qid: $qid");
739                 }
740                 push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
741             } elsif($status eq 'deferred') {
742                 my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/o;
743                 unless(defined($opts{'verbMsgDetail'})) {
744                     $deferredReas = said_string_trimmer($deferredReas, 65);
745                     $deferredReas =~ s/^\d{3} //o;
746                     $deferredReas =~ s/^connect to //o;
747                 }
748                 ++$deferred{$cmd}{$deferredReas};
749                 ++$dfrPerHr[$msgHr];
750                 ++${$msgsPerDay{$revMsgDateStr}}[2];
751                 ++$msgsDfrdCnt;
752                 ++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
753                 ++${$recipDom{$domAddr}}[$msgDfrsI];
754                 if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] ||
755                    $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI])
756                 {
757                     ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
758                 }
759             } elsif($status eq 'bounced') {
760                 my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/o;
761                 unless(defined($opts{'verbMsgDetail'})) {
762                     $bounceReas = said_string_trimmer($bounceReas, 66);
763                     $bounceReas =~ s/^\d{3} //o;
764                 }
765                 ++$bounced{$relay}{$bounceReas};
766                 ++$bncPerHr[$msgHr];
767                 ++${$msgsPerDay{$revMsgDateStr}}[3];
768                 ++$msgsBncd;
769             } else {
770 #               print UNPROCD "$_\n";
771             }
772         }
773         elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) {
774             #
775             # Warning: this code in two places!
776             #
777             ++$rcvPerHr[$msgHr];
778             ++${$msgsPerDay{$revMsgDateStr}}[0];
779             ++$msgsRcvd;
780             $rcvdMsg{$qid} = "pickup";  # Whence it came
781         }
782         elsif($cmd eq 'smtp') {
783             # Was an IPv6 problem here
784             if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) {
785                 ++$smtpMsgs{lc($2)}{$1};
786             } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) {
787                 ++$smtpMsgs{lc($2)}{$1};
788             } else {
789 #               print UNPROCD "$_\n";
790             }
791         }
792         else
793         {
794 #           print UNPROCD "$_\n";
795         }
796     }
797 }
798
799 # debugging
800 #close(UNPROCD) ||
801 #    die "problem closing \"unprocessed\": $!\n";
802
803 # Calculate percentage of messages rejected and discarded
804 my $msgsRjctdPct = 0;
805 my $msgsDscrddPct = 0;
806 if(my $msgsTotal = $msgsDlvrd + $msgsRjctd + $msgsDscrdd) {
807     $msgsRjctdPct = int(($msgsRjctd/$msgsTotal) * 100);
808     $msgsDscrddPct = int(($msgsDscrdd/$msgsTotal) * 100);
809 }
810
811 if(defined($dateStr)) {
812     print "Postfix log summaries for $dateStr\n";
813 }
814
815 print "\nGrand Totals\n------------\n";
816 print "messages\n\n";
817 printf " %6d%s  received\n", adj_int_units($msgsRcvd);
818 printf " %6d%s  delivered\n", adj_int_units($msgsDlvrd);
819 printf " %6d%s  forwarded\n", adj_int_units($msgsFwdd);
820 printf " %6d%s  deferred", adj_int_units($msgsDfrd);
821 printf "  (%d%s deferrals)", adj_int_units($msgsDfrdCnt) if($msgsDfrdCnt);
822 print "\n";
823 printf " %6d%s  bounced\n", adj_int_units($msgsBncd);
824 printf " %6d%s  rejected (%d%%)\n", adj_int_units($msgsRjctd), $msgsRjctdPct;
825 printf " %6d%s  reject warnings\n", adj_int_units($msgsWrnd);
826 printf " %6d%s  held\n", adj_int_units($msgsHld);
827 printf " %6d%s  discarded (%d%%)\n", adj_int_units($msgsDscrdd), $msgsDscrddPct;
828 print "\n";
829 printf " %6d%s  bytes received\n", adj_int_units($sizeRcvd);
830 printf " %6d%s  bytes delivered\n", adj_int_units($sizeDlvrd);
831 printf " %6d%s  senders\n", adj_int_units($sendgUserCnt);
832 printf " %6d%s  sending hosts/domains\n", adj_int_units($sendgDomCnt);
833 printf " %6d%s  recipients\n", adj_int_units($recipUserCnt);
834 printf " %6d%s  recipient hosts/domains\n", adj_int_units($recipDomCnt);
835
836 # ---Begin: SMTPD_STATS_SUPPORT---
837 if(defined($opts{'smtpdStats'})) {
838     print "\nsmtpd\n\n";
839     printf "  %6d%s  connections\n", adj_int_units($smtpdConnCnt);
840     printf "  %6d%s  hosts/domains\n", adj_int_units(int(keys %smtpdPerDom));
841     printf "  %6d   avg. connect time (seconds)\n",
842         $smtpdConnCnt > 0? ($smtpdTotTime / $smtpdConnCnt) + .5 : 0;
843     {
844         my ($sec, $min, $hr) = get_smh($smtpdTotTime);
845         printf " %2d:%02d:%02d  total connect time\n",
846           $hr, $min, $sec;
847     }
848 }
849 # ---End: SMTPD_STATS_SUPPORT---
850
851 print "\n";
852
853 print_problems_reports() if(defined($opts{'pf'}));
854
855 print_per_day_summary(\%msgsPerDay) if($dayCnt > 1);
856 print_per_hour_summary(\@rcvPerHr, \@dlvPerHr, \@dfrPerHr, \@bncPerHr,
857     \@rejPerHr, $dayCnt);
858
859 print_recip_domain_summary(\%recipDom, $opts{'h'});
860 print_sending_domain_summary(\%sendgDom, $opts{'h'});
861
862 # ---Begin: SMTPD_STATS_SUPPORT---
863 if(defined($opts{'smtpdStats'})) {
864     print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
865     print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
866     print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
867 }
868 # ---End: SMTPD_STATS_SUPPORT---
869
870 print_user_data(\%sendgUser, "Senders by message count", $msgCntI, $opts{'u'}, $opts{'q'});
871 print_user_data(\%recipUser, "Recipients by message count", $msgCntI, $opts{'u'}, $opts{'q'});
872 print_user_data(\%sendgUser, "Senders by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
873 print_user_data(\%recipUser, "Recipients by message size", $msgSizeI, $opts{'u'}, $opts{'q'});
874
875 print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1);
876
877 print_problems_reports() unless(defined($opts{'pf'}));
878
879 print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'});
880
881 # Print "problems" reports
882 sub print_problems_reports {
883     unless($opts{'noDeferralDetail'}) {
884         print_nested_hash(\%deferred, "message deferral detail", $opts{'q'});
885     }
886     unless($opts{'noBounceDetail'}) {
887         print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'q'});
888     }
889     unless($opts{'noRejectDetail'}) {
890         print_nested_hash(\%rejects, "message reject detail", $opts{'q'});
891         print_nested_hash(\%warns, "message reject warning detail", $opts{'q'});
892         print_nested_hash(\%holds, "message hold detail", $opts{'q'});
893         print_nested_hash(\%discards, "message discard detail", $opts{'q'});
894     }
895     print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'q'});
896     print_nested_hash(\%warnings, "Warnings", $opts{'q'});
897     print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'q'});
898     print_nested_hash(\%panics, "Panics", 0, $opts{'q'});
899     print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'q'});
900 }
901
902 if($opts{'mailq'}) {
903     # flush stdout first cuz of asynchronousity
904     $| = 1;
905     print "\nCurrent Mail Queue\n------------------\n";
906     system($mailqCmd);
907 }
908
909 # print "per-day" traffic summary
910 # (done in a subroutine only to keep main-line code clean)
911 sub print_per_day_summary {
912     my($msgsPerDay) = @_;
913     my $value;
914     print <<End_Of_Per_Day_Heading;
915
916 Per-Day Traffic Summary
917     date          received  delivered   deferred    bounced     rejected
918     --------------------------------------------------------------------
919 End_Of_Per_Day_Heading
920
921     foreach (sort { $a <=> $b } keys(%$msgsPerDay)) {
922         my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
923         if($isoDateTime) {
924             printf "    %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
925         } else {
926             my $msgMonStr = $monthNames[$msgMon];
927             printf "    $msgMonStr %2d $msgYr", $msgDay;
928         }
929         foreach $value (@{$msgsPerDay->{$_}}) {
930             my $value2 = $value? $value : 0;
931             printf "    %6d%s", adj_int_units($value2);
932         }
933         print "\n";
934     }
935 }
936
937 # print "per-hour" traffic summary
938 # (done in a subroutine only to keep main-line code clean)
939 sub print_per_hour_summary {
940     my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_;
941     my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary';
942     my ($hour, $value);
943     print <<End_Of_Per_Hour_Heading;
944
945 Per-Hour Traffic $reportType
946     time          received  delivered   deferred    bounced     rejected
947     --------------------------------------------------------------------
948 End_Of_Per_Hour_Heading
949
950     for($hour = 0; $hour < 24; ++$hour) {
951         if($isoDateTime) {
952             printf "    %02d:00-%02d:00", $hour, $hour + 1;
953         } else {
954             printf "    %02d00-%02d00  ", $hour, $hour + 1;
955         }
956         foreach $value (@$rcvPerHr[$hour], @$dlvPerHr[$hour],
957                            @$dfrPerHr[$hour], @$bncPerHr[$hour],
958                            @$rejPerHr[$hour])
959         {
960             my $units = ' ';
961             $value = ($value / $dayCnt) + 0.5 if($dayCnt);
962             printf "    %6d%s", adj_int_units($value);
963         }
964         print "\n";
965     }
966 }
967
968 # print "per-recipient-domain" traffic summary
969 # (done in a subroutine only to keep main-line code clean)
970 sub print_recip_domain_summary {
971     use vars '$hashRef';
972     local($hashRef) = $_[0];
973     my($cnt) = $_[1];
974     return if($cnt == 0);
975     my $topCnt = $cnt > 0? "(top $cnt)" : "";
976     my $avgDly;
977     print <<End_Of_Recip_Domain_Heading;
978
979 Host/Domain Summary: Message Delivery $topCnt
980  sent cnt  bytes   defers   avg dly max dly host/domain
981  -------- -------  -------  ------- ------- -----------
982 End_Of_Recip_Domain_Heading
983
984     foreach (reverse sort by_count_then_size keys(%$hashRef)) {
985         # there are only delay values if anything was sent
986         if(${$hashRef->{$_}}[$msgCntI]) {
987             $avgDly = (${$hashRef->{$_}}[$msgDlyAvgI] /
988                        ${$hashRef->{$_}}[$msgCntI]);
989         } else {
990             $avgDly = 0;
991         }
992         printf " %6d%s  %6d%s  %6d%s  %5.1f %s  %5.1f %s  %s\n",
993             adj_int_units(${$hashRef->{$_}}[$msgCntI]),
994             adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
995             adj_int_units(${$hashRef->{$_}}[$msgDfrsI]),
996             adj_time_units($avgDly),
997             adj_time_units(${$hashRef->{$_}}[$msgDlyMaxI]),
998             $_;
999         last if --$cnt == 0;
1000     }
1001 }
1002
1003 # print "per-sender-domain" traffic summary
1004 # (done in a subroutine only to keep main-line code clean)
1005 sub print_sending_domain_summary {
1006     use vars '$hashRef';
1007     local($hashRef) = $_[0];
1008     my($cnt) = $_[1];
1009     return if($cnt == 0);
1010     my $topCnt = $cnt > 0? "(top $cnt)" : "";
1011     print <<End_Of_Sender_Domain_Heading;
1012
1013 Host/Domain Summary: Messages Received $topCnt
1014  msg cnt   bytes   host/domain
1015  -------- -------  -----------
1016 End_Of_Sender_Domain_Heading
1017
1018     foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1019         printf " %6d%s  %6d%s  %s\n",
1020             adj_int_units(${$hashRef->{$_}}[$msgCntI]),
1021             adj_int_units(${$hashRef->{$_}}[$msgSizeI]),
1022             $_;
1023         last if --$cnt == 0;
1024     }
1025 }
1026
1027 # print "per-user" data sorted in descending order
1028 # order (i.e.: highest first)
1029 sub print_user_data {
1030     my($hashRef, $title, $index, $cnt, $quiet) = @_;
1031     my $dottedLine;
1032     return if($cnt == 0);
1033     $title = sprintf "%s%s", $cnt > 0? "top $cnt " : "", $title;
1034     unless(%$hashRef) {
1035         return if($quiet);
1036         $dottedLine = ": none";
1037     } else {
1038         $dottedLine = "\n" . "-" x length($title);
1039     }
1040     printf "\n$title$dottedLine\n";
1041     foreach (map { $_->[0] }
1042              sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1043              map { [ $_, $hashRef->{$_}[$index], normalize_host($_) ] }
1044              (keys(%$hashRef)))
1045     {
1046         printf " %6d%s  %s\n", adj_int_units(${$hashRef->{$_}}[$index]), $_;
1047         last if --$cnt == 0;
1048     }
1049 }
1050
1051 # ---Begin: SMTPD_STATS_SUPPORT---
1052
1053 # print "per-hour" smtpd connection summary
1054 # (done in a subroutine only to keep main-line code clean)
1055 sub print_per_hour_smtpd {
1056     my ($smtpdPerHr, $dayCnt) = @_;
1057     my ($hour, $value);
1058     if($dayCnt > 1) {
1059         print <<End_Of_Per_Hour_Smtp_Average;
1060
1061 Per-Hour SMTPD Connection Daily Average
1062     hour        connections    time conn.
1063     -------------------------------------
1064 End_Of_Per_Hour_Smtp_Average
1065     } else {
1066         print <<End_Of_Per_Hour_Smtp;
1067
1068 Per-Hour SMTPD Connection Summary
1069     hour        connections    time conn.    avg./conn.   max. time
1070     --------------------------------------------------------------------
1071 End_Of_Per_Hour_Smtp
1072     }
1073
1074     for($hour = 0; $hour < 24; ++$hour) {
1075         $smtpdPerHr[$hour]->[0] || next;
1076         my $avg = int($smtpdPerHr[$hour]->[0]?
1077             ($smtpdPerHr[$hour]->[1]/$smtpdPerHr[$hour]->[0]) + .5 : 0);
1078         if($dayCnt > 1) {
1079             $smtpdPerHr[$hour]->[0] /= $dayCnt;
1080             $smtpdPerHr[$hour]->[1] /= $dayCnt;
1081             $smtpdPerHr[$hour]->[0] += .5;
1082             $smtpdPerHr[$hour]->[1] += .5;
1083         }
1084         my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]);
1085
1086         if($isoDateTime) {
1087             printf "    %02d:00-%02d:00", $hour, $hour + 1;
1088         } else {
1089             printf "    %02d00-%02d00  ", $hour, $hour + 1;
1090         }
1091         printf "   %6d%s       %2d:%02d:%02d",
1092             adj_int_units($smtpdPerHr[$hour]->[0]),
1093             $hr, $min, $sec;
1094         if($dayCnt < 2) {
1095             printf "      %6ds      %6ds",
1096                 $avg,
1097                 $smtpdPerHr[$hour]->[2];
1098         }
1099         print "\n";
1100     }
1101 }
1102
1103
1104 # print "per-day" smtpd connection summary
1105 # (done in a subroutine only to keep main-line code clean)
1106 sub print_per_day_smtpd {
1107     my ($smtpdPerDay, $dayCnt) = @_;
1108     print <<End_Of_Per_Day_Smtp;
1109
1110 Per-Day SMTPD Connection Summary
1111     date        connections    time conn.    avg./conn.   max. time
1112     --------------------------------------------------------------------
1113 End_Of_Per_Day_Smtp
1114
1115     foreach (sort { $a <=> $b } keys(%$smtpdPerDay)) {
1116         my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
1117         if($isoDateTime) {
1118             printf "    %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
1119         } else {
1120             my $msgMonStr = $monthNames[$msgMon];
1121             printf "    $msgMonStr %2d $msgYr", $msgDay;
1122         }
1123
1124         my $avg = (${$smtpdPerDay{$_}}[1]/${$smtpdPerDay{$_}}[0]) + .5;
1125         my($sec, $min, $hr) = get_smh(${$smtpdPerDay{$_}}[1]);
1126
1127         printf "   %6d%s       %2d:%02d:%02d      %6ds      %6ds\n",
1128             adj_int_units(${$smtpdPerDay{$_}}[0]),
1129             $hr, $min, $sec,
1130             $avg,
1131             ${$smtpdPerDay{$_}}[2];
1132     }
1133 }
1134
1135 # print "per-domain-smtpd" connection summary
1136 # (done in a subroutine only to keep main-line code clean)
1137 sub print_domain_smtpd_summary {
1138     use vars '$hashRef';
1139     local($hashRef) = $_[0];
1140     my($cnt) = $_[1];
1141     return if($cnt == 0);
1142     my $topCnt = $cnt > 0? "(top $cnt)" : "";
1143     my $avgDly;
1144     print <<End_Of_Domain_Smtp_Heading;
1145
1146 Host/Domain Summary: SMTPD Connections $topCnt
1147  connections  time conn.  avg./conn.  max. time  host/domain
1148  -----------  ----------  ----------  ---------  -----------
1149 End_Of_Domain_Smtp_Heading
1150
1151     foreach (reverse sort by_count_then_size keys(%$hashRef)) {
1152         my $avg = (${$hashRef->{$_}}[1]/${$hashRef->{$_}}[0]) + .5;
1153         my ($sec, $min, $hr) = get_smh(${$hashRef->{$_}}[1]);
1154
1155         printf "  %6d%s      %2d:%02d:%02d     %6ds    %6ds   %s\n",
1156             adj_int_units(${$hashRef->{$_}}[0]),
1157             $hr, $min, $sec,
1158             $avg,
1159             ${$hashRef->{$_}}[2],
1160             $_;
1161         last if --$cnt == 0;
1162     }
1163 }
1164
1165 # ---End: SMTPD_STATS_SUPPORT---
1166
1167 # print hash contents sorted by numeric values in descending
1168 # order (i.e.: highest first)
1169 sub print_hash_by_cnt_vals {
1170     my($hashRef, $title, $cnt, $quiet) = @_;
1171     my $dottedLine;
1172     $title = sprintf "%s%s", $cnt? "top $cnt " : "", $title;
1173     unless(%$hashRef) {
1174         return if($quiet);
1175         $dottedLine = ": none";
1176     } else {
1177         $dottedLine = "\n" . "-" x length($title);
1178     }
1179     printf "\n$title$dottedLine\n";
1180     really_print_hash_by_cnt_vals($hashRef, $cnt, ' ');
1181 }
1182
1183 # print hash contents sorted by key in ascending order
1184 sub print_hash_by_key {
1185     my($hashRef, $title, $cnt, $quiet) = @_;
1186     my $dottedLine;
1187     $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title;
1188     unless(%$hashRef) {
1189         return if($quiet);
1190         $dottedLine = ": none";
1191     } else {
1192         $dottedLine = "\n" . "-" x length($title);
1193     }
1194     printf "\n$title$dottedLine\n";
1195     foreach (sort keys(%$hashRef))
1196     {
1197         printf " %s  %s\n", $_, $hashRef->{$_};
1198         last if --$cnt == 0;
1199     }
1200 }
1201
1202 # print "nested" hashes
1203 sub print_nested_hash {
1204     my($hashRef, $title, $quiet) = @_;
1205     my $dottedLine;
1206     unless(%$hashRef) {
1207         return if($quiet);
1208         $dottedLine = ": none";
1209     } else {
1210         $dottedLine = "\n" . "-" x length($title);
1211     }
1212     printf "\n$title$dottedLine\n";
1213     walk_nested_hash($hashRef, 0);
1214 }
1215
1216 # "walk" a "nested" hash
1217 sub walk_nested_hash {
1218     my ($hashRef, $level) = @_;
1219     $level += 2;
1220     my $indents = ' ' x $level;
1221     my ($keyName, $hashVal) = each(%$hashRef);
1222
1223     if(ref($hashVal) eq 'HASH') {
1224         foreach (sort keys %$hashRef) {
1225             print "$indents$_";
1226             # If the next hash is finally the data, total the
1227             # counts for the report and print
1228             my $hashVal2 = (each(%{$hashRef->{$_}}))[1];
1229             keys(%{$hashRef->{$_}});    # "reset" hash iterator
1230             unless(ref($hashVal2) eq 'HASH') {
1231                 my $cnt = 0;
1232                 $cnt += $_ foreach (values %{$hashRef->{$_}});
1233                 print " (total: $cnt)";
1234             }
1235             print "\n";
1236             walk_nested_hash($hashRef->{$_}, $level);
1237         }
1238     } else {
1239         really_print_hash_by_cnt_vals($hashRef, 0, $indents);
1240     }
1241 }
1242
1243
1244 # print per-message info in excruciating detail :-)
1245 sub print_detailed_msg_data {
1246     use vars '$hashRef';
1247     local($hashRef) = $_[0];
1248     my($title, $quiet) = @_[1,2];
1249     my $dottedLine;
1250     unless(%$hashRef) {
1251         return if($quiet);
1252         $dottedLine = ": none";
1253     } else {
1254         $dottedLine = "\n" . "-" x length($title);
1255     }
1256     printf "\n$title$dottedLine\n";
1257     foreach (sort by_domain_then_user keys(%$hashRef))
1258     {
1259         printf " %s  %s\n", $_, shift(@{$hashRef->{$_}});
1260         foreach (@{$hashRef->{$_}}) {
1261             print "   $_\n";
1262         }
1263         print "\n";
1264     }
1265 }
1266
1267 # *really* print hash contents sorted by numeric values in descending
1268 # order (i.e.: highest first), then by IP/addr, in ascending order.
1269 sub really_print_hash_by_cnt_vals {
1270     my($hashRef, $cnt, $indents) = @_;
1271
1272     foreach (map { $_->[0] }
1273              sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
1274              map { [ $_, $hashRef->{$_}, normalize_host($_) ] }
1275              (keys(%$hashRef)))
1276     {
1277         printf "$indents%6d%s  %s\n", adj_int_units($hashRef->{$_}), $_;
1278         last if --$cnt == 0;
1279     }
1280 }
1281
1282 # Normalize IP addr or hostname
1283 # (Note: Makes no effort to normalize IPv6 addrs.  Just returns them
1284 # as they're passed-in.)
1285 sub normalize_host {
1286     # For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
1287     my $norm1 = (split(/\s/, $_[0]))[0];
1288
1289     if((my @octets = ($norm1 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/o)) == 4) {
1290         # Dotted-quad IP address
1291         return(pack('C4', @octets));
1292     } else {
1293         # Possibly hostname or user@dom.ain
1294         return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 ));
1295     }
1296 }
1297
1298 # subroutine to sort by domain, then user in domain, then by queue i.d.
1299 # Note: mixing Internet-style domain names and UUCP-style bang-paths
1300 # may confuse this thing.  An attempt is made to use the first host
1301 # preceding the username in the bang-path as the "domain" if none is
1302 # found otherwise.
1303 sub by_domain_then_user {
1304     # first see if we can get "user@somedomain"
1305     my($userNameA, $domainA) = split(/\@/, ${$hashRef->{$a}}[0]);
1306     my($userNameB, $domainB) = split(/\@/, ${$hashRef->{$b}}[0]);
1307
1308     # try "somedomain!user"?
1309     ($userNameA, $domainA) = (split(/!/, ${$hashRef->{$a}}[0]))[-1,-2]
1310         unless($domainA);
1311     ($userNameB, $domainB) = (split(/!/, ${$hashRef->{$b}}[0]))[-1,-2]
1312         unless($domainB);
1313
1314     # now re-order "mach.host.dom"/"mach.host.do.co" to
1315     # "host.dom.mach"/"host.do.co.mach"
1316     $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1317         if($domainA);
1318     $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
1319         if($domainB);
1320
1321     # oddly enough, doing this here is marginally faster than doing
1322     # an "if-else", above.  go figure.
1323     $domainA = "" unless($domainA);
1324     $domainB = "" unless($domainB);
1325
1326     if($domainA lt $domainB) {
1327         return -1;
1328     } elsif($domainA gt $domainB) {
1329         return 1;
1330     } else {
1331         # disregard leading bang-path
1332         $userNameA =~ s/^.*!//o;
1333         $userNameB =~ s/^.*!//o;
1334         if($userNameA lt $userNameB) {
1335             return -1;
1336         } elsif($userNameA gt $userNameB) {
1337             return 1;
1338         } else {
1339             if($a lt $b) {
1340                 return -1;
1341             } elsif($a gt $b) {
1342                 return 1;
1343             }
1344         }
1345     }
1346     return 0;
1347 }
1348
1349 # Subroutine used by host/domain reports to sort by count, then size.
1350 # We "fix" un-initialized values here as well.  Very ugly and un-
1351 # structured to do this here - but it's either that or the callers
1352 # must run through the hashes twice :-(.
1353 sub by_count_then_size {
1354     ${$hashRef->{$a}}[$msgCntI] = 0 unless(${$hashRef->{$a}}[$msgCntI]);
1355     ${$hashRef->{$b}}[$msgCntI] = 0 unless(${$hashRef->{$b}}[$msgCntI]);
1356     if(${$hashRef->{$a}}[$msgCntI] == ${$hashRef->{$b}}[$msgCntI]) {
1357         ${$hashRef->{$a}}[$msgSizeI] = 0 unless(${$hashRef->{$a}}[$msgSizeI]);
1358         ${$hashRef->{$b}}[$msgSizeI] = 0 unless(${$hashRef->{$b}}[$msgSizeI]);
1359         return(${$hashRef->{$a}}[$msgSizeI] <=>
1360                ${$hashRef->{$b}}[$msgSizeI]);
1361     } else {
1362         return(${$hashRef->{$a}}[$msgCntI] <=>
1363                ${$hashRef->{$b}}[$msgCntI]);
1364     }
1365 }
1366
1367 # return a date string to match in log
1368 sub get_datestr {
1369     my $dateOpt = $_[0];
1370
1371     my $aDay = 60 * 60 * 24;
1372
1373     my $time = time();
1374     if($dateOpt eq "yesterday") {
1375         $time -= $aDay;
1376     } elsif($dateOpt ne "today") {
1377         die "$usageMsg\n";
1378     }
1379     my ($t_mday, $t_mon) = (localtime($time))[3,4];
1380
1381     return sprintf("%s %2d", $monthNames[$t_mon], $t_mday);
1382 }
1383
1384 # if there's a real domain: uses that.  Otherwise uses the IP addr.
1385 # Lower-cases returned domain name.
1386 #
1387 # Optional bit of code elides the last octet of an IPv4 address.
1388 # (In case one wants to assume an IPv4 addr. is a dialup or other
1389 # dynamic IP address in a /24.)
1390 # Does nothing interesting with IPv6 addresses.
1391 sub gimme_domain {
1392     $_ = $_[0];
1393     my($domain, $ipAddr);
1394  
1395     # split domain/ipaddr into separates
1396     # newer versions of Postfix have them "dom.ain[i.p.add.ress]"
1397     # older versions of Postfix have them "dom.ain/i.p.add.ress"
1398     unless((($domain, $ipAddr) = /^([^\[]+)\[([^\]]+)\]/o) == 2 ||
1399            (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/oi) == 2) {
1400         # more exhaustive method
1401         ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o;
1402     }
1403  
1404     # "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
1405     if($domain eq 'unknown') {
1406         $domain = $ipAddr;
1407         # For identifying the host part on a Class C network (commonly
1408         # seen with dial-ups) the following is handy.
1409         # $domain =~ s/\.\d+$//o;
1410     } else {
1411         $domain =~
1412             s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o;
1413     }
1414  
1415     return $domain;
1416 }
1417
1418 # Return (value, units) for integer
1419 sub adj_int_units {
1420     my $value = $_[0];
1421     my $units = ' ';
1422     $value = 0 unless($value);
1423     if($value > $divByOneMegAt) {
1424         $value /= $oneMeg;
1425         $units = 'm'
1426     } elsif($value > $divByOneKAt) {
1427         $value /= $oneK;
1428         $units = 'k'
1429     }
1430     return($value, $units);
1431 }
1432
1433 # Return (value, units) for time
1434 sub adj_time_units {
1435     my $value = $_[0];
1436     my $units = 's';
1437     $value = 0 unless($value);
1438     if($value > 3600) {
1439         $value /= 3600;
1440         $units = 'h'
1441     } elsif($value > 60) {
1442         $value /= 60;
1443         $units = 'm'
1444     }
1445     return($value, $units);
1446 }
1447
1448 # Trim a "said:" string, if necessary.  Add elipses to show it.
1449 sub said_string_trimmer {
1450     my($trimmedString, $maxLen) = @_;
1451
1452     while(length($trimmedString) > $maxLen) {
1453         if($trimmedString =~ /^.* said: /o) {
1454             $trimmedString =~ s/^.* said: //o;
1455         } elsif($trimmedString =~ /^.*: */o) {
1456             $trimmedString =~ s/^.*?: *//o;
1457         } else {
1458             $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
1459             last;
1460         }
1461     }
1462
1463     return $trimmedString;
1464 }
1465
1466 # Trim a string, if necessary.  Add elipses to show it.
1467 sub string_trimmer {
1468     my($trimmedString, $maxLen, $doNotTrim) = @_;
1469
1470     $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..." 
1471         if(! $doNotTrim && (length($trimmedString) > $maxLen));
1472     return $trimmedString;
1473 }
1474
1475 # Get seconds, minutes and hours from seconds
1476 sub get_smh {
1477     my $sec = shift @_;
1478     my $hr = int($sec / 3600);
1479     $sec -= $hr * 3600;
1480     my $min = int($sec / 60);
1481     $sec -= $min * 60;
1482     return($sec, $min, $hr);
1483 }
1484
1485 # Process smtpd rejects
1486 sub proc_smtpd_reject {
1487     my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_;
1488     my ($rejTyp, $rejFrom, $rejRmdr, $rejReas);
1489     my ($from, $to);
1490     my $rejAddFrom = 0;
1491
1492     # This could get real ugly!
1493
1494     # First: get everything following the "reject: ", etc. token
1495     # Was an IPv6 problem here
1496     ($rejTyp, $rejFrom, $rejRmdr) = 
1497         ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/o);
1498
1499     # Next: get the reject "reason"
1500     $rejReas = $rejRmdr;
1501     unless(defined($opts{'verbMsgDetail'})) {
1502         if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") {    # special treatment :-(
1503             # If there are "<>"s immediately following the reject code, that's
1504             # an email address or HELO string.  There can be *anything* in
1505             # those--incl. stuff that'll screw up subsequent parsing.  So just
1506             # get rid of it right off.
1507             $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/o;
1508             $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/o;
1509             $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/o;
1510             $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/o;
1511         } elsif($rejTyp eq "MAIL") {    # *more* special treatment :-( grrrr...
1512             $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o;
1513         } else {
1514             $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o;
1515         }
1516     }
1517
1518     # Snag recipient address
1519     # Second expression is for unknown recipient--where there is no
1520     # "to=<mumble>" field, third for pathological case where recipient
1521     # field is unterminated, forth when all else fails.
1522     (($to) = $rejRmdr =~ /to=<([^>]+)>/o) ||
1523         (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /o) ||
1524         (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/o) ||
1525         ($to = "<>");
1526
1527     # Snag sender address
1528     (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>");
1529
1530     if(defined($from)) {
1531         $rejAddFrom = $opts{'rejAddFrom'};
1532         $from = verp_mung($from);
1533     }
1534
1535     # stash in "triple-subscripted-array"
1536     if($rejReas =~ m/^Sender address rejected:/o) {
1537         # Sender address rejected: Domain not found
1538         # Sender address rejected: need fully-qualified address
1539         ++$rejects->{$rejTyp}{$rejReas}{$from};
1540     } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/o) {
1541         # Recipient address rejected: Domain not found
1542         # Recipient address rejected: need fully-qualified address
1543         # User unknown (in local/relay recipient table)
1544         #++$rejects->{$rejTyp}{$rejReas}{$to};
1545         my $rejData = $to;
1546         if($rejAddFrom) {
1547             $rejData .= "  (" . ($from? $from : gimme_domain($rejFrom)) . ")";
1548         }
1549         ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1550     } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) {
1551         # Was an IPv6 problem here
1552         my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o;
1553         ++$rejects->{$rejTyp}{$rejReas}{$src};
1554     } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) {
1555         my $rejData = gimme_domain($rejFrom);
1556         $rejData .= "  ($from)" if($rejAddFrom);
1557         ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1558     } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/o) {
1559         my $rejData = gimme_domain($rejFrom);
1560         $rejData .= "  ($from)" if($rejAddFrom);
1561         ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1562     } else {
1563 #       print STDERR "dbg: unknown reject reason $rejReas !\n\n";
1564         my $rejData = gimme_domain($rejFrom);
1565         $rejData .= "  ($from)" if($rejAddFrom);
1566         ++$rejects->{$rejTyp}{$rejReas}{$rejData};
1567     }
1568     ++$$msgsRjctd;
1569     ++$$rejPerHr;
1570     ++$$msgsPerDay;
1571 }
1572
1573 # Hack for VERP (?) - convert address from somthing like
1574 # "list-return-36-someuser=someplace.com@lists.domain.com"
1575 # to "list-return-ID-someuser=someplace.com@lists.domain.com"
1576 # to prevent per-user listing "pollution."  More aggressive
1577 # munging converts to something like
1578 # "list-return@lists.domain.com"  (Instead of "return," there
1579 # may be numeric list name/id, "warn", "error", etc.?)
1580 sub verp_mung {
1581     my $addr = $_[0];
1582
1583     if(defined($opts{'verpMung'})) {
1584         $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi;
1585         if($opts{'verpMung'} > 1) {
1586             $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o;
1587         }
1588     }
1589
1590     return $addr;
1591 }
1592
1593 ###
1594 ### Warning and Error Routines
1595 ###
1596
1597 # Emit warning message to stderr
1598 sub msg_warn {
1599     warn "warning: $progName: $_[0]\n";
1600 }
1601