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