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