pflogsumm.pl

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