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