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