postfix-logwatch

   1 #!/usr/bin/perl -T
   2
   3 ##########################################################################
   4 # Postfix-logwatch: written and maintained by:
   5 #
   6 #    Mike "MrC" Cappella <mike (at) cappella (dot) us>
   7 #      http://logreporters.sourceforge.net/
   8 #
   9 # Please send all comments, suggestions, bug reports regarding this
  10 # program/module to the email address above.  I will respond as quickly
  11 # as possible. [MrC]
  12 #
  13 # Questions regarding the logwatch program itself should be directed to
  14 # the logwatch project at:
  15 #   http://sourceforge.net/projects/logwatch/support
  16 #
  17 #######################################################
  18 ### All work since Dec 12, 2006 (logwatch CVS revision 1.28)
  19 ### Copyright (c) 2006-2012  Mike Cappella
  20 ###
  21 ### Covered under the included MIT/X-Consortium License:
  22 ###    http://www.opensource.org/licenses/mit-license.php
  23 ### All modifications and contributions by other persons to
  24 ### this script are assumed to have been donated to the
  25 ### Logwatch project and thus assume the above copyright
  26 ### and licensing terms.  If you want to make contributions
  27 ### under your own copyright or a different license this
  28 ### must be explicitly stated in the contribution an the
  29 ### Logwatch project reserves the right to not accept such
  30 ### contributions.  If you have made significant
  31 ### contributions to this script and want to claim
  32 ### copyright please contact logwatch-devel@lists.sourceforge.net.
  33 ##########################################################
  34
  35 ##########################################################################
  36 # The original postfix logwatch filter was written by
  37 # Kenneth Porter, and has had many contributors over the years.
  38 #
  39 # CVS log removed: see Changes file for postfix-logwatch at
  40 #    http://logreporters.sourceforge.net/
  41 # or included with the standalone postfix-logwatch distribution
  42 ##########################################################################
  43
  44 ##########################################################################
  45 #
  46 # Test data included via inline comments starting with "#TD"
  47 #
  48
  49 #use Devel::Size qw(size total_size);
  50
  51 package Logreporters;
  52 use 5.008;
  53 use strict;
  54 use warnings;
  55 no warnings "uninitialized";
  56 use re 'taint';
  57
  58 our $Version          = '1.40.03';
  59 our $progname_prefix  = 'postfix';
  60
  61 # Specifies the default configuration file for use in standalone mode.
  62 my $config_file = "/usr/local/etc/${progname_prefix}-logwatch.conf";
  63
  64 # support postfix long (2.9+) or short queue ids
  65 my $re_QID_s   = qr/[A-Z\d]+/;
  66 my $re_QID_l   = qr/(?:NOQUEUE|[bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ\d]+)/;
  67 our $re_QID;
  68
  69 # The enhanced status codes can contain two-digit (or more) numbers;
  70 # for example, "550 5.7.23".
  71 our $re_DSN     = qr/(?:(?:\d{3})?(?: ?\d+\.\d+\.\d+)?)/;
  72 our $re_DDD     = qr/(?:(?:conn_use=\d+ )?delay=-?[\d.]+(?:, delays=[\d\/.]+)?(?:, dsn=[\d.]+)?)/;
  73
  74 #MODULE: ../Logreporters/Utils.pm
  75 package Logreporters::Utils;
  76
  77 use 5.008;
  78 use strict;
  79 use re 'taint';
  80 use warnings;
  81
  82 BEGIN {
  83    use Exporter ();
  84    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  85    $VERSION = '1.003';
  86    @ISA = qw(Exporter);
  87    @EXPORT = qw(&formathost &get_percentiles &get_percentiles2 &get_frequencies &commify &unitize
  88                 &get_usable_sectvars &add_section &begin_section_group &end_section_group
  89                 &get_version &unique_list);
  90    @EXPORT_OK = qw(&gen_test_log);
  91 }
  92
  93 use subs qw (@EXPORT @EXPORT_OK);
  94
  95
  96 # Formats IP and hostname for even column spacing
  97 #
  98 sub formathost($ $) {
  99    # $_[0] : hostip
 100    # $_[1] : hostname;
 101
 102    if (! $Logreporters::Config::Opts{'unknown'} and $_[1] eq 'unknown') {
 103       return $_[0];
 104    }
 105
 106    return sprintf "%-$Logreporters::Config::Opts{'ipaddr_width'}s  %s",
 107       $_[0] eq '' ? '*unknown' :    $_[0],
 108       $_[1] eq '' ? '*unknown' : lc $_[1];
 109 }
 110
 111 # Add a new section to the end of a section table
 112 #
 113 sub add_section($$$$$;$) {
 114    my $sref = shift;
 115    die "Improperly specified Section entry: $_[0]" if !defined $_[3];
 116
 117    my $entry  = {
 118       CLASS     => 'DATA',
 119       NAME      => $_[0],
 120       DETAIL    => $_[1],
 121       FMT       => $_[2],
 122       TITLE     => $_[3],
 123    };
 124    $entry->{'DIVISOR'}   = $_[4] if defined $_[4];
 125    push @$sref, $entry;
 126 }
 127
 128 {
 129 my $group_level = 0;
 130
 131 # Begin a new section group.  Groups can nest.
 132 #
 133 sub begin_section_group($;@) {
 134    my $sref = shift;
 135    my $group_name = shift;
 136    my $entry  = {
 137       CLASS     => 'GROUP_BEGIN',
 138       NAME      => $group_name,
 139       LEVEL     => ++$group_level,
 140       HEADERS   => [ @_ ],
 141    };
 142    push @$sref, $entry;
 143 }
 144
 145 # Ends a section group.
 146 #
 147 sub end_section_group($;@) {
 148    my $sref = shift;
 149    my $group_name = shift;
 150    my $entry  = {
 151       CLASS     => 'GROUP_END',
 152       NAME      => $group_name,
 153       LEVEL     => --$group_level,
 154       FOOTERS   => [ @_ ],
 155    };
 156    push @$sref, $entry;
 157 }
 158 }
 159
 160 # Generate and return a list of section table entries or
 161 # limiter key names, skipping any formatting entries.
 162 # If 'namesonly' is set, limiter key names are returned,
 163 # otherwise an array of section array records is returned.
 164 sub get_usable_sectvars(\@ $) {
 165    my ($sectref,$namesonly) = @_;
 166    my (@sect_list, %unique_names);
 167
 168    foreach my $sref (@$sectref) {
 169       #print "get_usable_sectvars: $sref->{NAME}\n";
 170       next unless $sref->{CLASS} eq 'DATA';
 171       if ($namesonly) {
 172          $unique_names{$sref->{NAME}} = 1;
 173       }
 174       else {
 175          push @sect_list, $sref;
 176       }
 177    }
 178    # return list of unique names
 179    if ($namesonly) {
 180       return keys %unique_names;
 181    }
 182    return @sect_list;
 183 }
 184
 185 # Print program and version info, preceeded by an optional string, and exit.
 186 #
 187 sub get_version() {
 188
 189    print STDOUT "@_\n"  if ($_[0]);
 190    print STDOUT "$Logreporters::progname: $Logreporters::Version\n";
 191    exit 0;
 192 }
 193
 194
 195 # Returns a list of percentile values given a
 196 # sorted array of numeric values.  Uses the formula:
 197 #
 198 # r = 1 + (p(n-1)/100) = i + d  (Excel method)
 199 #
 200 # r = rank
 201 # p = desired percentile
 202 # n = number of items
 203 # i = integer part
 204 # d = decimal part
 205 #
 206 # Arg1 is an array ref to the sorted series
 207 # Arg2 is a list of percentiles to use
 208
 209 sub get_percentiles(\@ @) {
 210    my ($aref,@plist) = @_;
 211    my ($n, $last, $r, $d, $i, @vals, $Yp);
 212
 213    $last = $#$aref;
 214    $n = $last + 1;
 215    #printf "%6d" x $n . "\n", @{$aref};
 216
 217    #printf "n: %4d, last: %d\n", $n, $last;
 218    foreach my $p (@plist) {
 219       $r = 1 + ($p * ($n - 1) / 100.0);
 220       $i = int ($r);            # integer part
 221       # domain: $i = 1 .. n
 222       if ($i == $n) {
 223         $Yp = $aref->[$last];
 224       }
 225       elsif ($i == 0) {
 226         $Yp = $aref->[0];
 227         print "CAN'T HAPPEN: $Yp\n";
 228       }
 229       else {
 230          $d = $r - $i;          # decimal part
 231          #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
 232          $Yp = $aref->[$i-1] + ($d * ($aref->[$i] - $aref->[$i-1]));
 233       }
 234       #printf "\np(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d", $p, $r, $i, $d, $Yp;
 235       push @vals, $Yp;
 236    }
 237
 238    return @vals;
 239 }
 240
 241 sub get_num_scores($) {
 242    my $scoretab_r = shift;
 243
 244    my $totalscores = 0;
 245
 246    for (my $i = 0; $i < @$scoretab_r; $i += 2) {
 247       $totalscores += $scoretab_r->[$i+1]
 248    }
 249
 250    return $totalscores;
 251 }
 252
 253 # scoretab
 254 #
 255 #  (score1, n1), (score2, n2), ... (scoreN, nN)
 256 #     $i   $i+1
 257 #
 258 # scores are 0 based (0 = 1st score)
 259 sub get_nth_score($ $) {
 260    my ($scoretab_r, $n) = @_;
 261
 262    my $i = 0;
 263    my $n_cur_scores = 0;
 264    #print "Byscore (", .5 * @$scoretab_r, "): "; for (my $i = 0; $i < $#$scoretab_r / 2; $i++) { printf "%9s (%d) ", $scoretab_r->[$i], $scoretab_r->[$i+1]; } ; print "\n";
 265
 266    while ($i < $#$scoretab_r) {
 267       #print "Samples_seen: $n_cur_scores\n";
 268       $n_cur_scores += $scoretab_r->[$i+1];
 269       if ($n_cur_scores >= $n) {
 270          #printf "range: %s  %s  %s\n", $i >= 2 ? $scoretab_r->[$i - 2] : '<begin>', $scoretab_r->[$i], $i+2 > $#$scoretab_r ? '<end>' : $scoretab_r->[$i + 2];
 271          #printf "n: $n, i: %8d, n_cur_scores: %8d, score: %d x %d hits\n", $i, $n_cur_scores, $scoretab_r->[$i], $scoretab_r->[$i+1];
 272          return $scoretab_r->[$i];
 273       }
 274
 275       $i += 2;
 276    }
 277    print "returning last score $scoretab_r->[$i]\n";
 278    return $scoretab_r->[$i];
 279 }
 280
 281 sub get_percentiles2(\@ @) {
 282    my ($scoretab_r, @plist) = @_;
 283    my ($n, $last, $r, $d, $i, @vals, $Yp);
 284
 285    #$last = $#$scoretab_r - 1;
 286    $n = get_num_scores($scoretab_r);
 287    #printf "\n%6d" x $n . "\n", @{$scoretab_r};
 288
 289    #printf "\n\tn: %4d, @$scoretab_r\n", $n;
 290    foreach my $p (@plist) {
 291   ###print "\nPERCENTILE: $p\n";
 292       $r = 1 + ($p * ($n - 1) / 100.0);
 293       $i = int ($r);            # integer part
 294       if ($i == $n) {
 295         #print "last:\n";
 296         #$Yp = $scoretab_r->[$last];
 297         $Yp = get_nth_score($scoretab_r, $n);
 298       }
 299       elsif ($i == 0) {
 300         #$Yp = $scoretab_r->[0];
 301         print "1st: CAN'T HAPPEN\n";
 302         $Yp = get_nth_score($scoretab_r, 1);
 303       }
 304       else {
 305          $d = $r - $i;          # decimal part
 306          #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
 307          my $ithvalprev = get_nth_score($scoretab_r, $i);
 308          my $ithval     = get_nth_score($scoretab_r, $i+1);
 309          $Yp = $ithvalprev + ($d * ($ithval - $ithvalprev));
 310       }
 311       #printf "p(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d\n", $p, $r, $i, $d, $Yp;
 312       push @vals, $Yp;
 313    }
 314
 315    return @vals;
 316 }
 317
 318
 319
 320 # Returns a list of frequency distributions given an incrementally sorted
 321 # set of sorted scores, and an incrementally sorted list of buckets
 322 #
 323 # Arg1 is an array ref to the sorted series
 324 # Arg2 is a list of frequency buckets to use
 325 sub get_frequencies(\@ @) {
 326    my ($aref,@blist) = @_;
 327
 328    my @vals = ( 0 ) x (@blist);
 329    my @sorted_blist = sort { $a <=> $b } @blist;
 330    my $bucket_index = 0;
 331
 332 OUTER: foreach my $score (@$aref) {
 333       #print "Score: $score\n";
 334       for my $i ($bucket_index .. @sorted_blist - 1) {
 335          #print "\tTrying Bucket[$i]: $sorted_blist[$i]\n";
 336          if ($score > $sorted_blist[$i]) {
 337             $bucket_index++;
 338          }
 339          else {
 340             #printf "\t\tinto Bucket[%d]\n", $bucket_index;
 341             $vals[$bucket_index]++;
 342             next OUTER;
 343          }
 344       }
 345       #printf "\t\tinto Bucket[%d]\n", $bucket_index - 1;
 346       $vals[$bucket_index - 1]++;
 347    }
 348
 349    return @vals;
 350 }
 351
 352 # Inserts commas in numbers for easier readability
 353 #
 354 sub commify ($) {
 355     return undef if ! defined ($_[0]);
 356
 357     my $text = reverse $_[0];
 358     $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
 359     return scalar reverse $text;
 360 }
 361
 362 # Unitize a number, and return appropriate printf formatting string
 363 #
 364 sub unitize($ $) {
 365    my ($num, $fmt) = @_;
 366    my $kilobyte = 2**10;
 367    my $megabyte = 2**20;
 368    my $gigabyte = 2**30;
 369    my $terabyte = 2**40;
 370
 371    if ($num >= $terabyte) {
 372       $num /= $terabyte;
 373       $fmt .= '.3fT';
 374    } elsif ($num >= $gigabyte) {
 375       $num /= $gigabyte;
 376       $fmt .= '.3fG';
 377    } elsif ($num >= $megabyte) {
 378       $num /= $megabyte;
 379       $fmt .= '.3fM';
 380    } elsif ($num >= $kilobyte) {
 381       $num /= $kilobyte;
 382       $fmt .= '.3fK';
 383    } else {
 384       $fmt .= 'd ';
 385    }
 386
 387    return ($num, $fmt);
 388 }
 389
 390 # Returns a sublist of the supplied list of elements in an unchanged order,
 391 # where only the first occurrence of each defined element is retained
 392 # and duplicates removed
 393 #
 394 # Borrowed from amavis 2.6.2
 395 #
 396 sub unique_list(@) {
 397    my ($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_;  # accept list, or a list ref
 398    my (%seen);
 399    my (@unique) = grep { defined($_) && !$seen{$_}++ } @$r;
 400
 401    return @unique;
 402 }
 403
 404 # Generate a test maillog file from the '#TD' test data lines
 405 # The test data file is placed in /var/tmp/maillog.autogen
 406 #
 407 # arg1: "postfix" or "amavis"
 408 # arg2: path to postfix-logwatch or amavis-logwatch from which to read '#TD' data
 409 #
 410 # Postfix TD syntax:
 411 #    TD<service><QID>(<count>) log entry
 412 #
 413 sub gen_test_log($) {
 414    my $scriptpath = shift;
 415
 416    my $toolname = $Logreporters::progname_prefix;
 417    my $datafile = "/var/tmp/maillog-${toolname}.autogen";
 418
 419    die "gen_test_log: invalid toolname $toolname"  if ($toolname !~ /^(postfix|amavis)$/);
 420
 421    eval {
 422       require Sys::Hostname;
 423       require Fcntl;
 424    } or die "Unable to create test data file: required module(s) not found\n$@";
 425
 426    my $syslogtime = localtime;
 427    $syslogtime =~ s/^....(.*) \d{4}$/$1/;
 428
 429    my ($hostname) = split /\./, Sys::Hostname::hostname();
 430
 431   # # avoid -T issues
 432   # delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 433
 434    my $flags = &Fcntl::O_CREAT|&Fcntl::O_WRONLY|&Fcntl::O_TRUNC;
 435    sysopen(FH, $datafile, $flags) or die "Can't create test data file: $!";
 436    print "Generating test log data file from $scriptpath: $datafile\n";
 437
 438    my $id;
 439    @ARGV = ($scriptpath);
 440    if ($toolname eq 'postfix') {
 441       my %services = (
 442           DEF   => 'smtpd',
 443           bQ    => 'bounce',
 444           cN    => 'cleanup',
 445           cQ    => 'cleanup',
 446           lQ    => 'local',
 447           m     => 'master',
 448           p     => 'pickup',
 449           pQ    => 'pickup',
 450           ppQ   => 'pipe',
 451           pfw   => 'postfwd',
 452           pg    => 'postgrey',
 453           pgQ   => 'postgrey',
 454           ps    => 'postsuper',
 455           qQ    => 'qmgr',
 456           s     => 'smtp',
 457           sQ    => 'smtp',
 458           sd    => 'smtpd',
 459           sdN   => 'smtpd',
 460           sdQ   => 'smtpd',
 461           spf   => 'policy-spf',
 462           vN    => 'virtual',
 463           vQ    => 'virtual',
 464       );
 465       $id = 'postfix/smtp[12345]';
 466
 467       while (<>) {
 468          if (/^\s*#TD([a-zA-Z]*[NQ]?)(\d+)?(?:\(([^)]+)\))? (.*)$/) {
 469             my ($service,$count,$qid,$line) = ($1, $2, $3, $4);
 470
 471             #print "SERVICE: %s, QID: %s, COUNT: %s, line: %s\n", $service, $qid, $count, $line;
 472
 473             if ($service eq '') {
 474                $service = 'DEF';
 475             }
 476             die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
 477
 478             $id = $services{$service} . '[123]';
 479             $id = 'postfix/' . $id    unless $services{$service} eq 'postgrey';
 480             #print "searching for service: \"$service\"\n\tFound $id\n";
 481             if    ($service =~ /N$/) { $id .= ': NOQUEUE'; }
 482             elsif ($service =~ /Q$/) { $id .= $qid ? $qid : ': DEADBEEF'; }
 483
 484             $line =~ s/ +/ /g;
 485             $line =~ s/^ //g;
 486             #print "$syslogtime $hostname $id: \"$line\"\n" x ($count ? $count : 1);
 487             print FH "$syslogtime $hostname $id: $line\n" x ($count ? $count : 1);
 488          }
 489       }
 490    }
 491    else { #amavis
 492       my %services = (
 493           DEF   => 'amavis',
 494           dcc   => 'dccproc',
 495       );
 496       while (<>) {
 497          if (/^\s*#TD([a-z]*)(\d+)? (.*)$/) {
 498             my ($service,$count,$line) = ($1, $2, $3);
 499             if ($service eq '') {
 500                $service = 'DEF';
 501             }
 502             die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
 503             $id = $services{$service} . '[123]:';
 504             if ($services{$service} eq 'amavis') {
 505                $id .= ' (9999-99)';
 506             }
 507             print FH "$syslogtime $hostname $id $line\n" x ($count ? $count : 1)
 508          }
 509       }
 510    }
 511
 512    close FH or die "Can't close $datafile: $!";
 513 }
 514
 515 1;
 516
 517 #MODULE: ../Logreporters/Config.pm
 518 package Logreporters::Config;
 519
 520 use 5.008;
 521 use strict;
 522 use re 'taint';
 523 use warnings;
 524
 525
 526 BEGIN {
 527    use Exporter ();
 528    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 529    $VERSION = '1.002';
 530    @ISA = qw(Exporter);
 531    @EXPORT = qw(&init_run_mode &add_option &get_options &init_cmdline &get_vars_from_file
 532                 &process_limiters &process_debug_opts &init_getopts_table_common &zero_opts
 533                 @Optspec %Opts %Configvars @Limiters %line_styles $fw1 $fw2 $sep1 $sep2
 534                 &D_CONFIG &D_ARGS &D_VARS &D_TREE &D_SECT &D_UNMATCHED &D_TEST &D_ALL
 535              );
 536 }
 537
 538 use subs @EXPORT;
 539
 540 our  @Optspec = ();      # options table used by Getopts
 541
 542 our %Opts = ();         # program-wide options
 543 our %Configvars = ();   # configuration file variables
 544 our @Limiters;
 545
 546 # Report separator characters and widths
 547 our ($fw1,$fw2)   = (22, 10);
 548 our ($sep1,$sep2) = ('=', '-');
 549
 550 use Getopt::Long;
 551
 552
 553 BEGIN {
 554    import Logreporters::Utils qw(&get_usable_sectvars);
 555 }
 556
 557 our %line_styles = (
 558    truncate => 0,
 559    wrap     => 1,
 560    full     => 2,
 561 );
 562
 563 sub init_run_mode($);
 564 sub confighash_to_cmdline(\%);
 565 sub get_vars_from_file(\% $);
 566 sub process_limiters(\@);
 567 sub add_option(@);
 568 sub get_options($);
 569 sub init_getopts_table_common(@);
 570 sub set_supplemental_reports($$);
 571 # debug constants
 572 sub D_CONFIG ()    { 1<<0 }
 573 sub D_ARGS ()      { 1<<1 }
 574 sub D_VARS ()      { 1<<2 }
 575 sub D_TREE ()      { 1<<3 }
 576 sub D_SECT ()      { 1<<4 }
 577 sub D_UNMATCHED () { 1<<5 }
 578
 579 sub D_TEST ()      { 1<<30 }
 580 sub D_ALL ()       { 1<<31 }
 581
 582 my %debug_words = (
 583    config     => D_CONFIG,
 584    args       => D_ARGS,
 585    vars       => D_VARS,
 586    tree       => D_TREE,
 587    sect       => D_SECT,
 588    unmatched  => D_UNMATCHED,
 589
 590    test       => D_TEST,
 591    all        => 0xffffffff,
 592 );
 593
 594 # Clears %Opts hash and initializes basic running mode options in
 595 # %Opts hash by setting keys: 'standalone', 'detail', and 'debug'.
 596 # Call early.
 597 #
 598 sub init_run_mode($) {
 599    my $config_file = shift;
 600    $Opts{'debug'} = 0;
 601
 602    # Logwatch passes a filter's options via environment variables.
 603    # When running standalone (w/out logwatch), use command line options
 604    $Opts{'standalone'} = exists ($ENV{LOGWATCH_DETAIL_LEVEL}) ? 0 : 1;
 605
 606    # Show summary section by default
 607    $Opts{'summary'} = 1;
 608
 609    if ($Opts{'standalone'}) {
 610       process_debug_opts($ENV{'LOGREPORTERS_DEBUG'}) if exists ($ENV{'LOGREPORTERS_DEBUG'});
 611    }
 612    else {
 613       $Opts{'detail'} = $ENV{'LOGWATCH_DETAIL_LEVEL'};
 614       # XXX
 615       #process_debug_opts($ENV{'LOGWATCH_DEBUG'}) if exists ($ENV{'LOGWATCH_DEBUG'});
 616    }
 617
 618    # first process --debug, --help, and --version options
 619    add_option ('debug=s',                   sub { process_debug_opts($_[1]); 1});
 620    add_option ('version',                   sub { &Logreporters::Utils::get_version(); 1;});
 621    get_options(1);
 622
 623    # now process --config_file, so that all config file vars are read first
 624    add_option ('config_file|f=s',           sub { get_vars_from_file(%Configvars, $_[1]); 1;});
 625    get_options(1);
 626
 627    # if no config file vars were read
 628    if ($Opts{'standalone'} and ! keys(%Configvars) and -f $config_file) {
 629       print "Using default config file: $config_file\n" if $Opts{'debug'} & D_CONFIG;
 630       get_vars_from_file(%Configvars, $config_file);
 631    }
 632 }
 633
 634 sub get_options($) {
 635    my $pass_through = shift;
 636    #$SIG{__WARN__} = sub { print "*** $_[0]*** options error\n" };
 637    # ensure we're called after %Opts is initialized
 638    die "get_options: program error: %Opts is emtpy" unless exists $Opts{'debug'};
 639
 640    my $p = new Getopt::Long::Parser;
 641
 642    if ($pass_through) {
 643       $p->configure(qw(pass_through permute));
 644    }
 645    else {
 646       $p->configure(qw(no_pass_through no_permute));
 647    }
 648    #$p->configure(qw(debug));
 649
 650    if ($Opts{'debug'} & D_ARGS) {
 651       print "\nget_options($pass_through): enter\n";
 652       printf "\tARGV(%d): ", scalar @ARGV;
 653       print @ARGV, "\n";
 654       print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
 655    }
 656
 657    if ($p->getoptions(\%Opts, @Optspec) == 0) {
 658       print STDERR "Use ${Logreporters::progname} --help for options\n";
 659       exit 1;
 660    }
 661    if ($Opts{'debug'} & D_ARGS) {
 662       print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
 663       printf "\tARGV(%d): ", scalar @ARGV;
 664       print @ARGV, "\n";
 665       print "get_options: exit\n";
 666    }
 667 }
 668
 669 sub add_option(@) {
 670    push @Optspec, @_;
 671 }
 672
 673 # untaint string, borrowed from amavisd-new
 674 sub untaint($) {
 675    no re 'taint';
 676
 677    my ($str);
 678    if (defined($_[0])) {
 679       local($1);            # avoid Perl taint bug: tainted global $1 propagates taintedness
 680       $str = $1  if $_[0] =~ /^(.*)$/;
 681    }
 682
 683    return $str;
 684 }
 685
 686 sub init_getopts_table_common(@) {
 687    my @supplemental_reports = @_;
 688
 689    print "init_getopts_table_common: enter\n"   if $Opts{'debug'} & D_ARGS;
 690
 691    add_option ('help',                       sub { print STDOUT Logreporters::usage(undef); exit 0 });
 692    add_option ('gen_test_log=s',             sub { Logreporters::Utils::gen_test_log($_[1]); exit 0; });
 693    add_option ('detail=i');
 694    add_option ('nodetail',                   sub {
 695       # __none__ will set all limiters to 0 in process_limiters
 696       # since they are not known (Sections table is not yet built).
 697       push @Limiters, '__none__';
 698       # 0 = disable supplemental_reports
 699       set_supplemental_reports(0, \@supplemental_reports);
 700    });
 701    add_option ('max_report_width=i');
 702    add_option ('summary!');
 703    add_option ('show_summary=i',             sub { $Opts{'summary'} = $_[1]; 1; });
 704    # untaint ipaddr_width for use w/sprintf() in Perl v5.10
 705    add_option ('ipaddr_width=i',             sub { $Opts{'ipaddr_width'} = untaint ($_[1]); 1; });
 706
 707    add_option ('sect_vars!');
 708    add_option ('show_sect_vars=i',           sub { $Opts{'sect_vars'} = $_[1]; 1; });
 709
 710    add_option ('syslog_name=s');
 711    add_option ('wrap',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 712    add_option ('full',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 713    add_option ('truncate',                   sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 714    add_option ('line_style=s',               sub {
 715       my $style = lc($_[1]);
 716       my @list = grep (/^$style/, keys %line_styles);
 717       if (! @list) {
 718          print STDERR "Invalid line_style argument \"$_[1]\"\n";
 719          print STDERR "Option line_style argument must be one of \"wrap\", \"full\", or \"truncate\".\n";
 720          print STDERR "Use $Logreporters::progname --help for options\n";
 721          exit 1;
 722       }
 723       $Opts{'line_style'} = $line_styles{lc($list[0])};
 724       1;
 725    });
 726
 727    add_option ('limit|l=s',                 sub {
 728       my ($limiter,$lspec) = split(/=/, $_[1]);
 729       if (!defined $lspec) {
 730          printf STDERR "Limiter \"%s\" requires value (ex. --limit %s=10)\n", $_[1],$_[1];
 731          exit 2;
 732       }
 733       foreach my $val (split(/(?:\s+|\s*,\s*)/, $lspec)) {
 734          if ($val !~ /^\d+$/ and
 735              $val !~ /^(\d*)\.(\d+)$/ and
 736              $val !~ /^::(\d+)$/ and
 737              $val !~ /^:(\d+):(\d+)?$/ and
 738              $val !~ /^(\d+):(\d+)?:(\d+)?$/)
 739          {
 740             printf STDERR "Limiter value \"$val\" invalid in \"$limiter=$lspec\"\n";
 741             exit 2;
 742          }
 743       }
 744       push @Limiters, lc $_[1];
 745    });
 746
 747    print "init_getopts_table_common: exit\n"   if $Opts{'debug'} & D_ARGS;
 748 }
 749
 750 sub get_option_names() {
 751    my (@ret, @tmp);
 752    foreach (@Optspec) {
 753       if (ref($_) eq '') {       # process only the option names
 754          my $spec = $_;
 755          $spec =~ s/=.*$//;
 756          $spec =~ s/([^|]+)\!$/$1|no$1/g;
 757          @tmp = split /[|]/, $spec;
 758          #print "PUSHING: @tmp\n";
 759          push @ret, @tmp;
 760       }
 761    }
 762    return @ret;
 763 }
 764
 765 # Set values for the configuration variables passed via hashref.
 766 # Variables are of the form ${progname_prefix}_KEYNAME.
 767 #
 768 # Because logwatch lowercases all config file entries, KEYNAME is
 769 # case-insensitive.
 770 #
 771 sub init_cmdline() {
 772    my ($href, $configvar, $value, $var);
 773
 774    # logwatch passes all config vars via environment variables
 775    $href = $Opts{'standalone'} ? \%Configvars : \%ENV;
 776
 777    # XXX: this is cheeze: need a list of valid limiters, but since
 778    # the Sections table is not built yet, we don't know what is
 779    # a limiter and what is an option, as there is no distinction in
 780    # variable names in the config file (perhaps this should be changed).
 781    my @valid_option_names = get_option_names();
 782    die "Options table not yet set" if ! scalar @valid_option_names;
 783
 784    print "confighash_to_cmdline: @valid_option_names\n"  if $Opts{'debug'} & D_ARGS;
 785    my @cmdline = ();
 786    while (($configvar, $value) = each %$href) {
 787       if ($configvar =~ s/^${Logreporters::progname_prefix}_//o) {
 788          # distinguish level limiters from general options
 789          # would be easier if limiters had a unique prefix
 790          $configvar = lc $configvar;
 791          my $ret = grep (/^$configvar$/i, @valid_option_names);
 792          if ($ret == 0) {
 793             print "\tLIMITER($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
 794             push @cmdline, '-l', "$configvar" . "=$value";
 795          }
 796          else {
 797             print "\tOPTION($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
 798             unshift @cmdline, $value  if defined ($value);
 799             unshift @cmdline, "--$configvar";
 800          }
 801       }
 802    }
 803    unshift @ARGV, @cmdline;
 804 }
 805
 806 # Obtains the variables from a logwatch-style .conf file, for use
 807 # in standalone mode.  Returns an ENV-style hash of key/value pairs.
 808 #
 809 sub get_vars_from_file(\% $) {
 810    my ($href, $file) = @_;
 811    my ($var, $val);
 812
 813    print "get_vars_from_file: enter: processing file: $file\n" if $Opts{'debug'} & D_CONFIG;
 814
 815    my  $message = undef;
 816    my $ret = stat ($file);
 817    if ($ret == 0) { $message = $!; }
 818    elsif (! -r _) { $message = "Permission denied"; }
 819    elsif (  -d _) { $message = "Is a directory"; }
 820    elsif (! -f _) { $message = "Not a regular file"; }
 821
 822    if ($message) {
 823       print STDERR "Configuration file \"$file\": $message\n";
 824       exit 2;
 825    }
 826
 827    my $prog = $Logreporters::progname_prefix;
 828    open FILE, '<', "$file" or die "unable to open configuration file $file: $!";
 829    while (<FILE>) {
 830       chomp;
 831       next if (/^\s*$/);   # ignore all whitespace lines
 832       next if (/^\*/);     # ignore logwatch's *Service lines
 833       next if (/^\s*#/);   # ignore comment lines
 834       if (/^\s*\$(${prog}_[^=\s]+)\s*=\s*"?([^"]+)"?$/o) {
 835          ($var,$val) = ($1,$2);
 836          if    ($val =~ /^(?:no|false)$/i) { $val = 0; }
 837          elsif ($val =~ /^(?:yes|true)$/i) { $val = 1; }
 838          elsif ($val eq '')                { $var =~ s/${prog}_/${prog}_no/; $val = undef; }
 839
 840          print "\t\"$var\" => \"$val\"\n"  if $Opts{'debug'} & D_CONFIG;
 841
 842          $href->{$var} = $val;
 843       }
 844    }
 845    close FILE         or die "failed to close configuration handle for $file: $!";
 846    print "get_vars_from_file: exit\n" if $Opts{'debug'} & D_CONFIG;
 847 }
 848
 849 sub process_limiters(\@) {
 850    my ($sectref) = @_;
 851
 852    my ($limiter, $var, $val, @errors);
 853    my @l = get_usable_sectvars(@$sectref, 1);
 854
 855    if ($Opts{'debug'} & D_VARS) {
 856       print "process_limiters: enter\n";
 857       print "\tLIMITERS: @Limiters\n";
 858    }
 859    while ($limiter = shift @Limiters) {
 860       my @matched = ();
 861
 862       printf "\t%-30s  ",$limiter   if $Opts{'debug'} & D_VARS;
 863       # disable all limiters when limiter is __none__: see 'nodetail' cmdline option
 864       if ($limiter eq '__none__') {
 865          $Opts{$_} = 0 foreach @l;
 866          next;
 867       }
 868
 869       ($var,$val) = split /=/, $limiter;
 870
 871       if ($val eq '') {
 872          push @errors, "Limiter \"$var\" requires value (ex. --limit limiter=10)";
 873          next;
 874       }
 875
 876       # try exact match first, then abbreviated match next
 877       if (scalar (@matched = grep(/^$var$/, @l)) == 1 or scalar (@matched = grep(/^$var/, @l)) == 1) {
 878          $limiter = $matched[0];    # unabbreviate limiter
 879          print "MATCH: $var: $limiter => $val\n" if $Opts{'debug'} & D_VARS;
 880          # XXX move limiters into section hash entry...
 881          $Opts{$limiter} = $val;
 882          next;
 883       }
 884       print "matched=", scalar @matched, ": @matched\n" if $Opts{'debug'} & D_VARS;
 885
 886       push @errors, "Limiter \"$var\" is " . (scalar @matched == 0 ? "invalid" : "ambiguous: @matched");
 887    }
 888    print "\n" if $Opts{'debug'} & D_VARS;
 889
 890    if (@errors) {
 891       print STDERR "$_\n" foreach @errors;
 892       exit 2;
 893    }
 894
 895    # Set the default value of 10 for each section if no limiter exists.
 896    # This allows output for each section should there be no configuration
 897    # file or missing limiter within the configuration file.
 898    foreach (@l) {
 899       $Opts{$_} = 10 unless exists $Opts{$_};
 900    }
 901
 902    # Enable collection for each section if a limiter is non-zero.
 903    foreach (@l) {
 904       #print "L is: $_\n";
 905       #print "DETAIL: $Opts{'detail'}, OPTS: $Opts{$_}\n";
 906       $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
 907    }
 908    #print "OPTS: \n"; map { print "$_ => $Opts{$_}\n"} keys %Opts;
 909    #print "COLLECTING: \n"; map { print "$_ => $Logreporters::TreeData::Collecting{$_}\n"} keys %Logreporters::TreeData::Collecting;
 910 }
 911
 912 # Enable/disable supplemental reports
 913 # arg1:     0=off, 1=on
 914 # arg2,...: list of supplemental report keywords
 915 sub set_supplemental_reports($$) {
 916    my ($onoff,$aref) = @_;
 917
 918    $Opts{$_} = $onoff foreach (@$aref);
 919 }
 920
 921 sub process_debug_opts($) {
 922    my $optstring = shift;
 923
 924    my @errors = ();
 925    foreach (split(/\s*,\s*/, $optstring)) {
 926       my $word = lc $_;
 927       my @matched = grep (/^$word/, keys %debug_words);
 928
 929       if (scalar @matched == 1) {
 930          $Opts{'debug'} |= $debug_words{$matched[0]};
 931          next;
 932       }
 933
 934       if (scalar @matched == 0) {
 935          push @errors, "Unknown debug keyword \"$word\"";
 936       }
 937       else {  # > 1
 938          push @errors, "Ambiguous debug keyword abbreviation \"$word\": (matches: @matched)";
 939       }
 940    }
 941    if (@errors) {
 942       print STDERR "$_\n" foreach @errors;
 943       print STDERR "Debug keywords: ", join (' ', sort keys %debug_words), "\n";
 944       exit 2;
 945    }
 946 }
 947
 948 # Zero the options controlling level specs and those
 949 # any others passed via Opts key.
 950 #
 951 # Zero the options controlling level specs in the
 952 # Detailed section, and set all other report options
 953 # to disabled. This makes it easy via command line to
 954 # disable the entire summary section, and then re-enable
 955 # one or more sections for specific reports.
 956 #
 957 #   eg. progname --nodetail --limit forwarded=2
 958 #
 959 sub zero_opts ($ @) {
 960    my $sectref = shift;
 961    # remaining args: list of Opts keys to zero
 962
 963    map { $Opts{$_} = 0; print "zero_opts: $_ => 0\n" if $Opts{'debug'} & D_VARS;} @_;
 964    map { $Opts{$_} = 0 } get_usable_sectvars(@$sectref, 1);
 965 }
 966
 967 1;
 968
 969 #MODULE: ../Logreporters/TreeData.pm
 970 package Logreporters::TreeData;
 971
 972 use 5.008;
 973 use strict;
 974 use re 'taint';
 975 use warnings;
 976 no warnings "uninitialized";
 977
 978 BEGIN {
 979    use Exporter ();
 980    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 981    $VERSION = '1.001';
 982    @ISA = qw(Exporter);
 983    @EXPORT = qw(%Totals %Counts %Collecting $END_KEY);
 984    @EXPORT_OK = qw(&printTree &buildTree);
 985
 986 }
 987
 988 use subs @EXPORT_OK;
 989
 990 BEGIN {
 991    import Logreporters::Config qw(%line_styles);
 992 }
 993
 994 # Totals and Counts are the log line accumulator hashes.
 995 # Totals: maintains per-section grand total tallies for use in Summary section
 996 # Counts: is a multi-level hash, which maintains per-level key totals.
 997 our (%Totals, %Counts);
 998
 999 # The Collecting hash determines which sections will be captured in
1000 # the Counts hash.  Counts are collected only if a section is enabled,
1001 # and this hash obviates the need to test both existence and
1002 # non-zero-ness of the Opts{'keyname'} (either of which cause capture).
1003 # XXX The Opts hash could be used ....
1004 our %Collecting = ();
1005
1006 sub buildTree(\% $ $ $ $ $);
1007 sub printTree($ $ $ $ $);
1008 =pod
1009 [ a:b:c, ... ]
1010
1011 which would be interpreted as follows:
1012
1013 a = show level a detail
1014 b = show at most b items at this level
1015 c = minimun count that will be shown
1016 =cut
1017
1018 sub printTree($ $ $ $ $) {
1019    my ($treeref, $lspecsref, $line_style, $max_report_width, $debug) = @_;
1020    my ($entry, $line);
1021    my $cutlength = $max_report_width - 3;
1022
1023    my $topn = 0;
1024    foreach $entry (sort bycount @$treeref) {
1025       ref($entry) ne "HASH" and die "Unexpected entry in tree: $entry\n";
1026
1027       #print "LEVEL: $entry->{LEVEL}, TOTAL: $entry->{TOTAL}, HASH: $entry, DATA: $entry->{DATA}\n";
1028
1029       # Once the top N lines have been printed, we're done
1030       if ($lspecsref->[$entry->{LEVEL}]{topn}) {
1031          if ($topn++ >= $lspecsref->[$entry->{LEVEL}]{topn} ) {
1032             print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1033                unless ($debug) and do {
1034                      $line = '     ' . '   ' x ($entry->{LEVEL} + 3) . '...';
1035                      printf "%-130s L%d: topn reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{topn};
1036                };
1037             last;
1038          }
1039       }
1040
1041       # Once the item's count falls below the given threshold, we're done at this level
1042       # unless a top N is specified, as threshold has lower priority than top N
1043       elsif ($lspecsref->[$entry->{LEVEL}]{threshold}) {
1044          if ($entry->{TOTAL} <= $lspecsref->[$entry->{LEVEL}]{threshold}) {
1045             print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1046                unless ($debug) and do {
1047                   $line = '     ' . ('   ' x ($entry->{LEVEL} + 3)) . '...';
1048                   printf "%-130s L%d: threshold reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{threshold};
1049                };
1050             last;
1051          }
1052       }
1053
1054       $line = sprintf "%8d%s%s", $entry->{TOTAL}, '   ' x ($entry->{LEVEL} + 2),  $entry->{DATA};
1055
1056       if ($debug) {
1057          printf "%-130s %-60s\n", $line, $entry->{DEBUG};
1058       }
1059
1060       # line_style full, or lines < max_report_width
1061
1062       #printf "MAX: $max_report_width, LEN: %d, CUTLEN $cutlength\n", length($line);
1063       if ($line_style == $line_styles{'full'} or length($line) <= $max_report_width) {
1064          print $line, "\n";
1065       }
1066       elsif ($line_style == $line_styles{'truncate'}) {
1067          print substr ($line,0,$cutlength), '...', "\n";
1068       }
1069       elsif ($line_style == $line_styles{'wrap'}) {
1070          my $leader = ' ' x 8 . '   ' x ($entry->{LEVEL} + 2);
1071          print substr ($line, 0, $max_report_width, ''), "\n";
1072          while (length($line)) {
1073             print $leader, substr ($line, 0, $max_report_width - length($leader), ''), "\n";
1074          }
1075       }
1076       else {
1077          die ('unexpected line style');
1078       }
1079
1080       printTree ($entry->{CHILDREF}, $lspecsref, $line_style, $max_report_width, $debug)   if (exists $entry->{CHILDREF});
1081    }
1082 }
1083
1084 my $re_IP_strict = qr/\b(25[0-5]|2[0-4]\d|[01]?\d{1,2})\.(25[0-5]|2[0-4]\d|[01]?\d{1,2})\.(25[0-5]|2[0-4]\d|[01]?\d{1,2})\.(25[0-5]|2[0-4]\d|[01]?\d{1,2})\b/;
1085 # XXX optimize this using packed default sorting.  Analysis shows speed isn't an issue though
1086 sub bycount {
1087    # Sort by totals, then IP address if one exists, and finally by data as a string
1088
1089    local $SIG{__WARN__} = sub { print "*** PLEASE REPORT:\n*** $_[0]*** Unexpected: \"$a->{DATA}\", \"$b->{DATA}\"\n" };
1090
1091    $b->{TOTAL} <=> $a->{TOTAL}
1092
1093       ||
1094
1095    pack('C4' => $a->{DATA} =~ /^$re_IP_strict/o) cmp pack('C4' => $b->{DATA} =~ /^$re_IP_strict/o)
1096
1097       ||
1098
1099    $a->{DATA} cmp $b->{DATA}
1100 }
1101
1102 #
1103 # Builds a tree of REC structures from the multi-key %Counts hashes
1104 #
1105 # Parameters:
1106 #    Hash:  A multi-key hash, with keys being used as category headings, and leaf data
1107 #           being tallies for that set of keys
1108 #    Level: This current recursion level.  Call with 0.
1109 #
1110 # Returns:
1111 #    Listref: A listref, where each item in the list is a rec record, described as:
1112 #           DATA:      a string: a heading, or log data
1113 #           TOTAL:     an integer: which is the subtotal of this item's children
1114 #           LEVEL:     an integer > 0: representing this entry's level in the tree
1115 #           CHILDREF:  a listref: references a list consisting of this node's children
1116 #    Total: The cummulative total of items found for a given invocation
1117 #
1118 # Use the special key variable $END_KEY, which is "\a\a" (two ASCII bell's) to end a,
1119 # nested hash early, or the empty string '' may be used as the last key.
1120
1121 our $END_KEY = "\a\a";
1122
1123 sub buildTree(\% $ $ $ $ $) {
1124    my ($href, $max_level_section, $levspecref, $max_level_global, $recurs_level, $show_unique, $debug) = @_;
1125    my ($subtotal, $childList, $rec);
1126
1127    my @treeList = ();
1128    my $total = 0;
1129
1130    foreach my $item (sort keys %$href) {
1131       if (ref($href->{$item}) eq "HASH") {
1132          #print " " x ($recurs_level * 4), "HASH: LEVEL $recurs_level: Item: $item, type: \"", ref($href->{$item}), "\"\n";
1133
1134          ($subtotal, $childList) = buildTree (%{$href->{$item}}, $max_level_section, $levspecref, $max_level_global, $recurs_level + 1, $debug);
1135
1136          if ($recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1137             # me + children
1138             $rec = {
1139                DATA     => $item,
1140                TOTAL    => $subtotal,
1141                LEVEL    => $recurs_level,
1142                CHILDREF => $childList,
1143             };
1144
1145             if ($debug) {
1146                $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1147                      $recurs_level + 1, $max_level_global, $max_level_section,
1148                      $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $subtotal;
1149             }
1150             push (@treeList, $rec);
1151          }
1152       }
1153       else {
1154          if ($item ne '' and $item ne $END_KEY and $recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1155             $rec = {
1156                DATA  => $item,
1157                TOTAL => $href->{$item},
1158                LEVEL => $recurs_level,
1159                #CHILDREF => undef,
1160             };
1161             if ($debug) {
1162                $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1163                      $recurs_level, $max_level_global, $max_level_section,
1164                      $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $href->{$item};
1165             }
1166             push (@treeList,  $rec);
1167          }
1168          $subtotal = $href->{$item};
1169       }
1170
1171       $total += $subtotal;
1172    }
1173
1174    #print " " x ($recurs_level * 4), "LEVEL $recurs_level: Returning from recurs_level $recurs_level\n";
1175
1176    return ($total, \@treeList);
1177 }
1178
1179 1;
1180
1181 #MODULE: ../Logreporters/RegEx.pm
1182 package Logreporters::RegEx;
1183
1184 use 5.008;
1185 use strict;
1186 use re 'taint';
1187 use warnings;
1188
1189 BEGIN {
1190    use Exporter ();
1191    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1192    $VERSION = '1.000';
1193    @ISA = qw(Exporter);
1194 #   @EXPORT = qw($re_IP);
1195    @EXPORT_OK = qw();
1196 }
1197
1198 # IPv4 and IPv6
1199 # See syntax in RFC 2821 IPv6-address-literal,
1200 # eg. IPv6:2001:630:d0:f102:230:48ff:fe77:96e
1201 #our $re_IP      = '(?:(?:::(?:ffff:|FFFF:)?)?(?:\d{1,3}\.){3}\d{1,3}|(?:(?:IPv6:)?[\da-fA-F]{0,4}:){2}(?:[\da-fA-F]{0,4}:){0,5}[\da-fA-F]{0,4})';
1202
1203 # Modified from "dartware" case at http://forums.dartware.com/viewtopic.php?t=452#
1204 #our $re_IP             = qr/(?:(?:(?:(?:[\da-f]{1,4}:){7}(?:[\da-f]{1,4}|:))|(?:(?:[\da-f]{1,4}:){6}(?::[\da-f]{1,4}|(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[\da-f]{1,4}:){5}(?:(?:(?::[\da-f]{1,4}){1,2})|:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[\da-f]{1,4}:){4}(?:(?:(?::[\da-f]{1,4}){1,3})|(?:(?::[\da-f]{1,4})?:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){3}(?:(?:(?::[\da-f]{1,4}){1,4})|(?:(?::[\da-f]{1,4}){0,2}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){2}(?:(?:(?::[\da-f]{1,4}){1,5})|(?:(?::[\da-f]{1,4}){0,3}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){1}(?:(?:(?::[\da-f]{1,4}){1,6})|(?:(?::[\da-f]{1,4}){0,4}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?::(?:(?:(?::[\da-f]{1,4}){1,7})|(?:(?::[\da-f]{1,4}){0,5}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:)))(?:%.+)?)|(?:(?:\d{1,3}\.){3}(?:\d{1,3}))/i;
1205
1206 # IPv4 only
1207 #our $re_IP      = qr/(?:\d{1,3}\.){3}(?:\d{1,3})/;
1208
1209 1;
1210
1211 #MODULE: ../Logreporters/Reports.pm
1212 package Logreporters::Reports;
1213
1214 use 5.008;
1215 use strict;
1216 use re 'taint';
1217 use warnings;
1218 no warnings "uninitialized";
1219
1220 BEGIN {
1221    use Exporter ();
1222    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1223    $VERSION = '1.002';
1224    @ISA = qw(Exporter);
1225    @EXPORT = qw(&inc_unmatched &print_unmatched_report &print_percentiles_report2
1226                 &print_summary_report &print_detail_report);
1227    @EXPORT_OK = qw();
1228 }
1229
1230 use subs @EXPORT_OK;
1231
1232 BEGIN {
1233    import Logreporters::Config qw(%Opts $fw1 $fw2 $sep1 $sep2 &D_UNMATCHED &D_TREE);
1234    import Logreporters::Utils qw(&commify &unitize &get_percentiles &get_percentiles2);
1235    import Logreporters::TreeData qw(%Totals %Counts &buildTree &printTree);
1236 }
1237
1238 my (%unmatched_list);
1239
1240 our $origline;       # unmodified log line, for error reporting and debug
1241
1242 sub inc_unmatched($) {
1243    my ($id) = @_;
1244    $unmatched_list{$origline}++;
1245    print "UNMATCHED($id): \"$origline\"\n"  if $Opts{'debug'} & D_UNMATCHED;
1246 }
1247
1248 # Print unmatched lines
1249 #
1250 sub print_unmatched_report() {
1251    return unless (keys %unmatched_list);
1252
1253    print "\n\n**Unmatched Entries**\n";
1254    foreach my $line (sort {$unmatched_list{$b}<=>$unmatched_list{$a} } keys %unmatched_list) {
1255       printf "%8d   %s\n", $unmatched_list{$line}, $line;
1256    }
1257 }
1258
1259 =pod
1260    ****** Summary ********************************************************
1261           2   Miscellaneous warnings
1262
1263       20621   Total messages scanned ----------------  100.00%
1264     662.993M  Total bytes scanned                  695,198,092
1265    ========   ================================================
1266
1267       19664   Ham -----------------------------------   95.36%
1268       19630     Clean passed                            95.19%
1269          34     Bad header passed                        0.16%
1270
1271         942   Spam ----------------------------------    4.57%
1272         514     Spam blocked                             2.49%
1273         428     Spam discarded (no quarantine)           2.08%
1274
1275          15   Malware -------------------------------    0.07%
1276          15     Malware blocked                          0.07%
1277
1278
1279        1978   SpamAssassin bypassed
1280          18   Released from quarantine
1281        1982   Allowlisted
1282           3   Denylisted
1283          12   MIME error
1284          51   Bad header (debug supplemental)
1285          28   Extra code modules loaded at runtime
1286 =cut
1287 # Prints the Summary report section
1288 #
1289 sub print_summary_report (\@) {
1290    my ($sections) = @_;
1291    my ($keyname,$cur_level);
1292    my @lines;
1293
1294    my $expand_header_footer = sub {
1295       my $line = undef;
1296
1297       foreach my $horf (@_) {
1298          # print blank line if keyname is newline
1299          if ($horf eq "\n") {
1300             $line .= "\n";
1301          }
1302          elsif (my ($sepchar) = ($horf =~ /^(.)$/o)) {
1303             $line .= sprintf "%s   %s\n", $sepchar x 8, $sepchar x 50;
1304          }
1305          else {
1306             die "print_summary_report: unsupported header or footer type \"$horf\"";
1307          }
1308       }
1309       return $line;
1310    };
1311
1312    if ($Opts{'detail'} >= 5) {
1313       my $header = "****** Summary ";
1314       print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n\n";
1315    }
1316
1317    my @headers;
1318    foreach my $sref (@$sections) {
1319       # headers and separators
1320       die "Unexpected Section $sref"  if (ref($sref) ne 'HASH');
1321
1322       # Start of a new section group.
1323       # Expand and save headers to output at end of section group.
1324       if ($sref->{CLASS} eq 'GROUP_BEGIN') {
1325          $cur_level = $sref->{LEVEL};
1326          $headers[$cur_level] = &$expand_header_footer(@{$sref->{HEADERS}});
1327       }
1328
1329       elsif ($sref->{CLASS} eq 'GROUP_END') {
1330          my $prev_level = $sref->{LEVEL};
1331
1332          # If this section had lines to output, tack on headers and footers,
1333          # removing extraneous newlines.
1334          if ($lines[$cur_level]) {
1335             # squish multiple blank lines
1336             if ($headers[$cur_level] and substr($headers[$cur_level],0,1) eq "\n") {
1337                if ( ! defined $lines[$prev_level][-1] or $lines[$prev_level][-1] eq "\n") {
1338                   $headers[$cur_level] =~ s/^\n+//;
1339                }
1340             }
1341
1342             push @{$lines[$prev_level]}, $headers[$cur_level]  if $headers[$cur_level];
1343             push @{$lines[$prev_level]}, @{$lines[$cur_level]};
1344             my $f = &$expand_header_footer(@{$sref->{FOOTERS}});
1345             push @{$lines[$prev_level]}, $f   if $f;
1346             $lines[$cur_level] = undef;
1347          }
1348
1349          $headers[$cur_level] = undef;
1350          $cur_level = $prev_level;
1351       }
1352
1353       elsif ($sref->{CLASS} eq 'DATA') {
1354          # Totals data
1355          $keyname = $sref->{NAME};
1356          if ($Totals{$keyname} > 0) {
1357             my ($numfmt, $desc, $divisor) = ($sref->{FMT}, $sref->{TITLE}, $sref->{DIVISOR});
1358
1359             my $fmt   = '%8';
1360             my $extra = ' %25s';
1361             my $total = $Totals{$keyname};
1362
1363             # Z format provides  unitized or unaltered totals, as appropriate
1364             if ($numfmt eq 'Z') {
1365                ($total, $fmt) = unitize ($total, $fmt);
1366             }
1367             else {
1368                $fmt .= "$numfmt ";
1369                $extra = '';
1370             }
1371
1372             if ($divisor and $$divisor) {
1373                # XXX generalize this
1374                if (ref ($desc) eq 'ARRAY') {
1375                   $desc = @$desc[0] . ' ' . @$desc[1] x (42 - 2 - length(@$desc[0]));
1376                }
1377
1378                push @{$lines[$cur_level]},
1379                   sprintf "$fmt  %-42s %6.2f%%\n", $total, $desc,
1380                      $$divisor == $Totals{$keyname} ? 100.00 : $Totals{$keyname} * 100 / $$divisor;
1381             }
1382             else {
1383                 my $new_line;
1384                 if ($extra eq '') {
1385                     $new_line = sprintf("$fmt  %-23s \n", $total, $desc);
1386                 }
1387                 else {
1388                     $new_line = sprintf("$fmt  %-23s $extra\n",
1389                                         $total,
1390                                         $desc,
1391                                         commify ($Totals{$keyname}));
1392                 }
1393                 push @{$lines[$cur_level]}, $new_line
1394             }
1395          }
1396       }
1397       else {
1398          die "print_summary_report: unexpected control...";
1399       }
1400    }
1401    print @{$lines[0]};
1402    print "\n";
1403 }
1404
1405 # Prints the Detail report section
1406 #
1407 # Note: side affect; deletes each key in Totals/Counts
1408 # after printout.  Only the first instance of a key in
1409 # the Section table will result in Detail output.
1410 sub print_detail_report (\@) {
1411    my ($sections) = @_;
1412    my $header_printed = 0;
1413
1414    return unless (keys %Counts);
1415
1416 #use Devel::Size qw(size total_size);
1417
1418    foreach my $sref ( @$sections ) {
1419       next unless $sref->{CLASS} eq 'DATA';
1420       # only print detail for this section if DETAIL is enabled
1421       # and there is something in $Counts{$keyname}
1422       next unless $sref->{DETAIL};
1423       next unless exists $Counts{$sref->{NAME}};
1424
1425       my $keyname = $sref->{NAME};
1426       my $max_level = undef;
1427       my $print_this_key = 0;
1428
1429       my @levelspecs = ();
1430       clear_level_specs($max_level, \@levelspecs);
1431       if (exists $Opts{$keyname}) {
1432          $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
1433          $print_this_key = 1  if ($max_level);
1434       }
1435       else {
1436          $print_this_key = 1;
1437       }
1438       #print_level_specs($max_level,\@levelspecs);
1439
1440       # at detail 5, print level 1, detail 6: level 2, ...
1441
1442 #print STDERR "building: $keyname\n";
1443       my ($count, $treeref) =
1444             buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
1445                        \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);
1446
1447       if ($count > 0) {
1448          if ($print_this_key) {
1449             my $desc = $sref->{TITLE};
1450             $desc =~ s/^\s+//;
1451
1452             if (! $header_printed) {
1453                my $header = "****** Detail ($max_level) ";
1454                print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
1455                $header_printed = 1;
1456             }
1457             printf "\n%8d   %s %s\n", $count, $desc,
1458                      $Opts{'sect_vars'} ?
1459                        ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
1460                         '-' x ($Opts{'max_report_width'} - 12 - length($desc))
1461          }
1462
1463          printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
1464                     $Opts{'debug'} & D_TREE);
1465       }
1466 #print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
1467 #print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
1468       $treeref = undef;
1469       $Totals{$keyname} = undef;
1470       delete $Totals{$keyname};
1471       delete $Counts{$keyname};
1472    }
1473    #print "\n";
1474 }
1475
1476 =pod
1477
1478 Print out a standard percentiles report
1479
1480    === Delivery Delays Percentiles ===============================================================
1481                           0%       25%       50%       75%       90%       95%       98%      100%
1482    -----------------------------------------------------------------------------------------------
1483    Before qmgr          0.01      0.70      1.40  45483.70  72773.08  81869.54  87327.42  90966.00
1484    In qmgr              0.00      0.00      0.00      0.01      0.01      0.01      0.01      0.01
1485    Conn setup           0.00      0.00      0.00      0.85      1.36      1.53      1.63      1.70
1486    Transmission         0.03      0.47      0.92      1.61      2.02      2.16      2.24      2.30
1487    Total                0.05      1.18      2.30  45486.15  72776.46  81873.23  87331.29  90970.00
1488    ===============================================================================================
1489
1490    === Postgrey Delays Percentiles ===========================================================
1491                       0%       25%       50%       75%       90%       95%       98%      100%
1492    -------------------------------------------------------------------------------------------
1493    Postgrey       727.00    727.00    727.00    727.00    727.00    727.00    727.00    727.00
1494    ===========================================================================================
1495
1496  tableref:
1497    data table: ref to array of arrays, first cell is label, subsequent cells are data
1498  title:
1499    table's title
1500  percentiles_str:
1501    string of space or comma separated integers, which are the percentiles
1502    calculated and output as table column data
1503 =cut
1504 sub print_percentiles_report2($$$) {
1505    my ($tableref, $title, $percentiles_str) = @_;
1506
1507    return unless @$tableref;
1508
1509    my $myfw2 = $fw2 - 1;
1510    my @percents = split /[ ,]/, $percentiles_str;
1511
1512    # Calc y label width from the hash's keys. Each key is padded with the
1513    # string "#: ", # where # is a single-digit sort index.
1514    my $y_label_max_width = 0;
1515    for (@$tableref) {
1516       $y_label_max_width = length($_->[0])   if (length($_->[0]) > $y_label_max_width);
1517    }
1518
1519    # Titles row
1520    my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
1521    my $table_width = length($col_titles_str);
1522
1523    # Table header row
1524    my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
1525    $table_header_str .= $sep1 x ($table_width - length($table_header_str));
1526
1527    print "\n", $table_header_str;
1528    print "\n", $col_titles_str;
1529    print "\n", $sep2 x $table_width;
1530
1531    my (@p, @coldata, @xformed);
1532    foreach (@$tableref) {
1533       my ($title, $ref) = ($_->[0], $_->[1]);
1534       #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};
1535
1536       my @byscore = ();
1537
1538       for my $bucket (sort { $a <=> $b } keys %$ref) {
1539       #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
1540       # pairs: bucket (i.e. key), tally
1541          push @byscore, $bucket, $ref->{$bucket};
1542       }
1543
1544
1545       my @p = get_percentiles2 (@byscore, @percents);
1546       printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
1547    }
1548
1549 =pod
1550    foreach (@percents) {
1551       #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
1552       printf "\n%3d%%", $title;
1553       foreach my $val (@{shift @xformed}) {
1554          my $unit;
1555          if ($val > 1000) {
1556             $unit = 's';
1557             $val /= 1000;
1558          }
1559          else {
1560             $unit = '';
1561          }
1562          printf "%${fw3}.2f%-2s", $val, $unit;
1563       }
1564    }
1565 =cut
1566
1567    print "\n", $sep1 x $table_width, "\n";
1568 }
1569
1570 sub clear_level_specs($ $) {
1571    my ($max_level,$lspecsref) = @_;
1572    #print "Zeroing $max_level rows of levelspecs\n";
1573    $max_level = 0 if (not defined $max_level);
1574    for my $x (0..$max_level) {
1575       $lspecsref->[$x]{topn}      = undef;
1576       $lspecsref->[$x]{threshold} = undef;
1577    }
1578 }
1579
1580 # topn      = 0 means don't limit
1581 # threshold = 0 means no min threshold
1582 sub create_level_specs($ $ $) {
1583    my ($optkey,$gdetail,$lspecref) = @_;
1584
1585    return 0 if ($optkey eq "0");
1586
1587    my $max_level = $gdetail;            # default to global detail level
1588    my (@specsP1, @specsP2, @specsP3);
1589
1590    #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;
1591
1592    foreach my $sp (split /[\s,]+/, $optkey) {
1593       #print "create_level_specs:  SP: \"$sp\"\n";
1594       # original level specifier
1595       if ($sp =~ /^\d+$/) {
1596          $max_level = $sp;
1597          #print "create_level_specs:  max_level set: $max_level\n";
1598       }
1599       # original level specifier + topn at level 1
1600       elsif ($sp =~ /^(\d*)\.(\d+)$/) {
1601          if ($1) { $max_level = $1; }
1602          else    { $max_level = $gdetail; }           # top n specified, but no max level
1603
1604          # force top N at level 1 (zero based)
1605          push @specsP1, { level => 0, topn => $2, threshold => 0 };
1606       }
1607       # newer level specs
1608       elsif ($sp =~ /^::(\d+)$/) {
1609          push @specsP3, { level => undef, topn => 0, threshold => $1 };
1610       }
1611       elsif ($sp =~ /^:(\d+):(\d+)?$/) {
1612          push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
1613       }
1614       elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
1615          push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
1616       }
1617       else {
1618          print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
1619       }
1620    }
1621
1622    #foreach my $sp (@specsP3, @specsP2, @specsP1) {
1623    #   printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
1624    #}
1625
1626    my ($min, $max);
1627    foreach my $sp ( @specsP3, @specsP2, @specsP1) {
1628       ($min, $max) = (0, $max_level);
1629
1630       if (defined $sp->{level}) {
1631          $min = $max = $sp->{level};
1632       }
1633       for my $level ($min..$max) {
1634          #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
1635          $lspecref->[$level]{topn}      = $sp->{topn}          if ($sp->{topn});
1636          $lspecref->[$level]{threshold} = $sp->{threshold}     if ($sp->{threshold});
1637       }
1638    }
1639
1640    return $max_level;
1641 }
1642
1643 sub print_level_specs($ $) {
1644    my ($max_level,$lspecref) = @_;
1645    for my $level (0..$max_level) {
1646       printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
1647    }
1648 }
1649
1650
1651 1;
1652
1653 #MODULE: ../Logreporters/RFC3463.pm
1654 package Logreporters::RFC3463;
1655
1656 use 5.008;
1657 use strict;
1658 use re 'taint';
1659 use warnings;
1660
1661 BEGIN {
1662    use Exporter ();
1663    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1664    $VERSION = '1.000';
1665    @ISA = qw(Exporter);
1666    @EXPORT = qw(&get_dsn_msg);
1667 }
1668
1669 use subs @EXPORT;
1670
1671 #-------------------------------------------------
1672 # Enhanced Mail System Status Codes (aka: extended status codes)
1673 #
1674 #   RFC 3463   http://www.ietf.org/rfc/rfc3463.txt
1675 #   RFC 4954   http://www.ietf.org/rfc/rfc4954.txt
1676 #
1677 # Class.Subject.Detail
1678 #
1679 my %dsn_codes = (
1680     class => {
1681       '2' => 'Success',
1682       '4' => 'Transient failure',
1683       '5' => 'Permanent failure',
1684     },
1685
1686     subject => {
1687       '0' => 'Other/Undefined status',
1688       '1' => 'Addressing status',
1689       '2' => 'Mailbox status',
1690       '3' => 'Mail system status',
1691       '4' => 'Network & routing status',
1692       '5' => 'Mail delivery protocol status',
1693       '6' => 'Message content/media status',
1694       '7' => 'Security/policy status',
1695     },
1696
1697     detail => {
1698       '0.0' => 'Other undefined status',
1699       '1.0' => 'Other address status',
1700       '1.1' => 'Bad destination mailbox address',
1701       '1.2' => 'Bad destination system address',
1702       '1.3' => 'Bad destination mailbox address syntax',
1703       '1.4' => 'Destination mailbox address ambiguous',
1704       '1.5' => 'Destination mailbox address valid',
1705       '1.6' => 'Mailbox has moved',
1706       '1.7' => 'Bad sender\'s mailbox address syntax',
1707       '1.8' => 'Bad sender\'s system address',
1708
1709       '2.0' => 'Other/Undefined mailbox status',
1710       '2.1' => 'Mailbox disabled, not accepting messages',
1711       '2.2' => 'Mailbox full',
1712       '2.3' => 'Message length exceeds administrative limit.',
1713       '2.4' => 'Mailing list expansion problem',
1714
1715       '3.0' => 'Other/Undefined mail system status',
1716       '3.1' => 'Mail system full',
1717       '3.2' => 'System not accepting network messages',
1718       '3.3' => 'System not capable of selected features',
1719       '3.4' => 'Message too big for system',
1720
1721       '4.0' => 'Other/Undefined network or routing status',
1722       '4.1' => 'No answer from host',
1723       '4.2' => 'Bad connection',
1724       '4.3' => 'Routing server failure',
1725       '4.4' => 'Unable to route',
1726       '4.5' => 'Network congestion',
1727       '4.6' => 'Routing loop detected',
1728       '4.7' => 'Delivery time expired',
1729
1730       '5.0' => 'Other/Undefined protocol status',
1731       '5.1' => 'Invalid command',
1732       '5.2' => 'Syntax error',
1733       '5.3' => 'Too many recipients',
1734       '5.4' => 'Invalid command arguments',
1735       '5.5' => 'Wrong protocol version',
1736       '5.6' => 'Authentication Exchange line too long',
1737
1738       '6.0' => 'Other/Undefined media error',
1739       '6.1' => 'Media not supported',
1740       '6.2' => 'Conversion required & prohibited',
1741       '6.3' => 'Conversion required but not supported',
1742       '6.4' => 'Conversion with loss performed',
1743       '6.5' => 'Conversion failed',
1744
1745       '7.0' => 'Other/Undefined security status',
1746       '7.1' => 'Delivery not authorized, message refused',
1747       '7.2' => 'Mailing list expansion prohibited',
1748       '7.3' => 'Security conversion required but not possible',
1749       '7.4' => 'Security features not supported',
1750       '7.5' => 'Cryptographic failure',
1751       '7.6' => 'Cryptographic algorithm not supported',
1752       '7.7' => 'Message integrity failure',
1753     },
1754
1755     # RFC 4954
1756     complete => {
1757       '2.7.0'  => 'Authentication succeeded',
1758       '4.7.0'  => 'Temporary authentication failure',
1759       '4.7.12' => 'Password transition needed',
1760       '5.7.0'  => 'Authentication required',
1761       '5.7.8'  => 'Authentication credentials invalid',
1762       '5.7.9'  => 'Authentication mechanism too weak',
1763       '5.7.11' => 'Encryption required for requested authentication mechanism',
1764     },
1765 );
1766
1767 # Returns an RFC 3463 DSN messages given a DSN code
1768 #
1769 sub get_dsn_msg ($) {
1770    my $dsn = shift;
1771    my ($msg, $class, $subject, $detail);
1772
1773    return "*DSN unavailable"  if ($dsn =~ /^$/);
1774
1775    unless ($dsn =~ /^(\d)\.((\d{1,3})\.\d{1,3})$/) {
1776       print "Error: not a DSN code $dsn\n";
1777       return "Invalid DSN";
1778    }
1779
1780    $class = $1; $subject = $3; $detail = $2;
1781
1782    #print "DSN: $dsn, Class: $class, Subject: $subject, Detail: $detail\n";
1783
1784    if (exists $dsn_codes{'class'}{$class}) {
1785       $msg = $dsn_codes{'class'}{$class};
1786    }
1787    if (exists $dsn_codes{'subject'}{$subject}) {
1788       $msg .= ': ' . $dsn_codes{'subject'}{$subject};
1789    }
1790    if (exists $dsn_codes{'complete'}{$dsn}) {
1791       $msg .= ': ' . $dsn_codes{'complete'}{$dsn};
1792    }
1793    elsif (exists $dsn_codes{'detail'}{$detail}) {
1794       $msg .= ': ' . $dsn_codes{'detail'}{$detail};
1795    }
1796
1797    #print "get_dsn_msg: $msg\n" if ($msg);
1798    return $dsn . ': ' . $msg;
1799 }
1800
1801 1;
1802
1803 #MODULE: ../Logreporters/PolicySPF.pm
1804 package Logreporters::PolicySPF;
1805
1806 use 5.008;
1807 use strict;
1808 use re 'taint';
1809 use warnings;
1810
1811 BEGIN {
1812    use Exporter ();
1813    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1814    $VERSION = '1.000';
1815    @ISA = qw(Exporter);
1816    @EXPORT = qw(&postfix_policy_spf);
1817 }
1818
1819 use subs @EXPORT;
1820
1821 BEGIN {
1822    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
1823    import Logreporters::Utils;
1824    import Logreporters::Reports qw(&inc_unmatched);
1825 }
1826
1827 # Handle postfix/policy_spf entries
1828 #
1829 # Mail::SPF::Result
1830 #   Pass      the SPF record designates the host to be allowed to send accept
1831 #   Fail      the SPF record has designated the host as NOT being allowed to send  reject
1832 #   SoftFail  the SPF record has designated the host as NOT being allowed to send but is in transition  accept but mark
1833 #   Neutral   the SPF record specifies explicitly that nothing can be said about validity   accept
1834 #   None      the domain does not have an SPF record or the SPF record does not evaluate to a result accept
1835 #   PermError a permanent error has occured (eg. badly formatted SPF record) unspecified
1836 #   TempError a transient error has occured accept or reject
1837
1838 sub postfix_policy_spf($) {
1839    my $line = shift;
1840
1841    if (
1842         $line =~ /^Attribute: / or
1843         # handler sender_policy_framework: is decisive.
1844         $line =~ /^handler [^:]+/ or
1845         # decided action=REJECT Please see http://www.openspf.org/why.html?sender=jrzjcez%40telecomitalia.it&ip=81.178.62.236&receiver=protegate1.zmi.at
1846         $line =~ /^decided action=/ or
1847
1848         # pypolicyd-spf-0.7.1
1849         #
1850         # Read line: "request=smtpd_access_policy"
1851         # Found the end of entry
1852         # Config: {'Mail_From_reject': 'Fail', 'PermError_reject': 'False', 'HELO_reject': 'SPF_Not_Pass', 'defaultSeedOnly': 1, 'debugLevel': 4, 'skip_addresses': '127.0.0.0/8,::ffff:127.0.0.0//104,::1//128', 'TempError_Defer': 'False'}
1853         # spfcheck: pyspf result: "['Pass', 'sender SPF authorized', 'helo']"
1854         # ERROR: Could not match line "#helo pass and mfrom none"
1855         # Traceback (most recent call last):
1856         #   File "/usr/local/bin/policyd-spf", line 405, in <module>
1857         #     line = sys.stdin.readline()
1858         # KeyboardInterrupt
1859         $line =~ /^Read line: "/ or
1860         $line =~ /^Found the end of entry$/ or
1861         $line =~ /^Config: \{/ or
1862         $line =~ /^spfcheck: pyspf result/ or
1863         $line =~ /^Starting$/ or
1864         $line =~ /^Normal exit$/ or
1865         $line =~ /^ERROR: Could not match line/ or
1866         $line =~ /^Traceback / or
1867         $line =~ /^KeyboardInterrupt/ or
1868         $line =~ /^\s\s+/
1869       )
1870    {
1871       #print "IGNORING...\n\tORIG: $::OrigLine\n";
1872       return
1873    }
1874
1875    # Keep policy-spf warnings in its section
1876    if (my ($warn,$msg) = $line =~ /^warning: ([^:]+): (.*)$/) {
1877       #TDspf warning: ignoring garbage: # No SPF
1878
1879       $msg =~ s/^# ?//;
1880       $Totals{'policyspf'}++;
1881       $Counts{'policyspf'}{'*Warning'}{ucfirst $warn}{$msg}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
1882       return;
1883    }
1884
1885    # pypolicyd-spf-0.7.1
1886
1887    # Fail;      identity=helo;     client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1888    # Fail;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1889    # Neutral;   identity=helo;     client-ip=192.168.0.3; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1890    # None;      identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1891    # None;      identity=helo;     client-ip=192.168.0.5; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1892    # None;      identity=mailfrom; client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1893    # None;      identity=mailfrom; client-ip=192.168.0.2; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1894    # Pass;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1895    # Permerror; identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1896    # Softfail;  identity=mailfrom; client-ip=192.168.0.6; helo=example.com; envelope-from=f@example.com; receiver=yahl@example.org
1897    if ($line =~ /^(Pass|Fail|None|Neutral|Permerror|Softfail|Temperror); (.*)$/) {
1898          my $result = $1;
1899          my %params = $2 =~ /([-\w]+)=([^;]+)/g;
1900          #$params{'s'} = '*unknown' unless $params{'s'};
1901          $Totals{'policyspf'}++;
1902          if ($Logreporters::TreeData::Collecting{'policyspf'}) {
1903             my ($id) = $params{'identity'};
1904             $id =~ s/mailfrom/envelope-from/;
1905
1906             $Counts{'policyspf'}{'Policy Action'}{"SPF: $result"}{join(': ',$params{'identity'},$params{$id})}{$params{'client-ip'}}{$params{'receiver'}}++;
1907          }
1908          return;
1909    }
1910    elsif ($line =~ /^ERROR /) {
1911       $line =~ s/^ERROR //;
1912       $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
1913       $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
1914       return;
1915    }
1916
1917    # Strip QID if it exists, and trailing ": ", leaving just the message.
1918    $line =~ s/^(?:$Logreporters::re_QID|): //;
1919
1920    # other ignored
1921    if (
1922         $line =~ /^SPF \S+ \(.+?\): .*$/ or
1923         $line =~ /^Mail From/ or
1924         $line =~ /^:HELO check failed/ or     # log entry has no space after :
1925         $line =~ /^testing:/
1926       )
1927    {
1928         #TDspf testing: stripped sender=jrzjcez@telecomitalia.it, stripped rcpt=hengstberger@adv.at
1929         # postfix-policyd-spf-perl-2.007
1930         #TDspf SPF pass (Mechanism 'ip4:10.0.0.2/22' matched): Envelope-from: foo@example.com
1931         #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): Envelope-from: anyone@sample.net
1932         #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): HELO/EHLO (Null Sender): mailout2.example.com
1933         #TDspf SPF fail (Mechanism '-all' matched): HELO/EHLO: mailout1.example.com
1934         #TDspf SPF none (No applicable sender policy available): Envelope-from: efrom@example.com
1935         #TDspf SPF permerror (Included domain 'example.com' has no applicable sender policy): Envelope-from: efrom@example.com
1936         #TDspf SPF permerror (Maximum DNS-interactive terms limit (10) exceeded): Envelope-from: efrom@example.com
1937         #TDspf Mail From (sender) check failed - Mail::SPF->new(10.0.0.1, , test.DNSreport.com) failed: 'identity' option must not be empty
1938         #TDspf HELO check failed - Mail::SPF->new(, , ) failed: Missing required 'identity' option
1939
1940         #TDspf SPF not applicable to localhost connection - skipped check
1941
1942         #print "IGNORING...\n\tLINE: $line\n\tORIG: \"$Logreporters::Reports::origline\"\n";
1943         return;
1944    }
1945
1946    my ($action, $domain, $ip, $message, $mechanism);
1947    ($domain, $ip, $message, $mechanism) = ('*unknown', '*unknown', '', '*unavailable');
1948    #print "LINE: '$line'\n";
1949
1950    # postfix-policyd-spf-perl: http://www.openspf.org/Software
1951    if ($line =~ /^Policy action=(.*)$/) {
1952       $line = $1;
1953
1954       #: Policy action=DUNNO
1955       return if $line =~ /^DUNNO/;
1956       # Policy action=PREPEND X-Comment: SPF not applicable to localhost connection - skipped check
1957       return if $line =~ /^PREPEND X-Comment: SPF not applicable to localhost connection - skipped check$/;
1958
1959       #print "LINE: '$line'\n";
1960       if ($line =~ /^DEFER_IF_PERMIT SPF-Result=\[?(.*?)\]?: (.*) of .*$/) {
1961          my ($lookup,$message) = ($1,$2);
1962          # Policy action=DEFER_IF_PERMIT SPF-Result=[10.0.0.1]: Time-out on DNS 'SPF' lookup of '[10.0.0.1]'
1963          # Policy action=DEFER_IF_PERMIT SPF-Result=example.com: 'SERVFAIL' error on DNS 'SPF' lookup of 'example.com'
1964          $message =~ s/^(.*?) on (DNS SPF lookup)$/$2: $1/;
1965          $message =~ s/'//g;
1966          $Totals{'policyspf'}++;
1967          $Counts{'policyspf'}{'Policy Action'}{'defer_if_permit'}{$message}{$lookup}{$END_KEY}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1968          return;
1969       }
1970
1971       if ($line =~ /^550 Please see http:\/\/www\.openspf\.org\/Why\?(.*)$/) {
1972          # Policy action=550 Please see http://www.openspf.org/Why?s=mfrom&id=from%40example.com&ip=10.0.0.1&r=example.net
1973          # Policy action=550 Please see http://www.openspf.org/Why?s=helo;id=mailout03.example.com;ip=192.168.0.1;r=mx1.example.net
1974          # Policy action=550 Please see http://www.openspf.org/Why?id=someone%40example.com&ip=10.0.0.1&receiver=vps.example.net
1975
1976          my %params;
1977          for (split /[&;]/, $1) {
1978             my ($id,$val) = split /=/, $_;
1979             $params{$id} = $val;
1980          }
1981          $params{'id'} =~ s/^.*%40//;
1982          $params{'s'} = '*unknown' unless $params{'s'};
1983          #print "Please see...:\n\tMessage: $message\n\tIP: $ip\n\tDomain: $domain\n";
1984          $Totals{'policyspf'}++;
1985          $Counts{'policyspf'}{'Policy Action'}{'550 reject'}{'See http://www.openspf.org/Why?...'}{$params{'s'}}{$params{'ip'}}{$params{'id'}}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1986          return;
1987       }
1988
1989       if ($line =~ /^[^:]+: (none|pass|fail|softfail|neutral|permerror|temperror) \((.+?)\) receiver=[^;]+(?:; (.*))?$/) {
1990          # iehc is identity, envelope-from, helo, client-ip
1991          my ($result,$message,$iehc,$subject) = ($1,$2,$3,undef);
1992          my %params = ();
1993          #TDspf Policy action=PREPEND Received-SPF: pass (bounces.example.com ... _spf.example.com: 10.0.0.1 is authorized to use 'from@bounces.example.com' in 'mfrom' identity (mechanism 'ip4:10.0.0.1/24' matched)) receiver=sample.net; identity=mfrom; envelope-from="from@bounces.example.com"; helo=out.example.com; client-ip=10.0.0.1
1994
1995          # Note: "identity=mailfrom" new in Mail::SPF version 2.006 Aug. 17
1996          #TDspf Policy action=PREPEND Received-SPF: pass (example.com: 10.0.0.1 is authorized to use 'from@example.com' in 'mfrom' identity (mechanism 'ip4:10.0.0.0/24' matched)) receiver=mx.example.com; identity=mailfrom; envelope-from="from@example.com"; helo=example.com; client-ip=10.0.0.1
1997
1998          #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=sample.net; identity=mfrom; envelope-from="f@example.com"; helo=example.com; client-ip=10.0.0.1
1999
2000          #TDspf Policy action=PREPEND Received-SPF: neutral (example.com: Domain does not state whether sender is authorized to use 'f@example.com' in 'mfrom' identity (mechanism '?all' matched)) receiver=sample.net identity=mfrom; envelope-from="f@example.com"; helo="[10.0.0.1]"; client-ip=192.168.0.1
2001
2002          #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=sample.net; identity=helo; helo=example.com; client-ip=192.168.0.1
2003          #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=mx1.example
2004
2005          #print "LINE: $iehc\n";
2006          if ($iehc) {
2007             %params = $iehc =~ /([-\w]+)=([^;]+)/g;
2008
2009             if (exists $params{'identity'}) {
2010                $params{'identity'} =~ s/identity=//;
2011                if ($params{'identity'} eq 'mfrom' or $params{'identity'} eq 'mailfrom') {
2012                   $params{'identity'} = 'mail from';
2013                }
2014                $params{'identity'} = uc $params{'identity'};
2015             }
2016             $params{'envelope-from'} =~ s/"//g        if exists $params{'envelope-from'};
2017             #($helo    = $params{'helo'}) =~ s/"//g   if exists $params{'helo'};
2018             $ip       = $params{'client-ip'}          if exists $params{'client-ip'};
2019          }
2020
2021          $message =~ s/^([^:]+): // and $subject = $1;
2022
2023          if ($message =~ /^No applicable sender policy available$/) {
2024             $message = 'No sender policy';
2025          }
2026          elsif ($message =~ s/^(Junk encountered in mechanism) '(.*?)'/$1/) {
2027             #TDspf Policy action=PREPEND Received-SPF: permerror (example.com: Junk encountered in mechanism 'a:10.0.0.1') receiver=example.net; identity=mfrom; envelope-from="ef@example.com"; helo=h; client-ip=10.0.0.2
2028             $ip = formathost ($ip, 'mech: ' . $2);
2029          }
2030          elsif ($message =~ s/^(Included domain) '(.*?)' (has no .*)$/$1 $3/) {
2031             #TDspf Policy action=PREPEND Received-SPF: permerror (example.com: Included domain 's.example.net' has no applicable sender policy) receiver=x.sample.com; identity=mfrom; envelope-from="ef@example.com"; helo=example.net; client-ip=10.0.0.2
2032             $subject .= "  (included: $2)";
2033          }
2034          elsif ($message =~ /^Domain does not state whether sender is authorized to use '.*?' in '\S+' identity \(mechanism '(.+?)' matched\)$/) {
2035             # Domain does not state whether sender is authorized to use 'returns@example.com' in 'mfrom' identity                                            (mechanism '?all' matched))
2036             ($mechanism,$message) = ($1,'Domain does not state if sender authorized to use');
2037          }
2038          elsif ($message =~ /^(\S+) is (not )?authorized( by default)? to use '.*?' in '\S+' identity(?:, however domain is not currently prepared for false failures)? \(mechanism '(.+?)' matched\)$/) {
2039             # Sender is not authorized by default to use 'from@example.com' in 'mfrom' identity, however domain is not currently prepared for false failures (mechanism '~all' matched))
2040             # 192.168.1.10 is     authorized by default to use 'from@example.com' in 'mfrom' identity                                                              (mechanism 'all' matched))
2041             $message = join (' ',
2042                              $1 eq 'Sender' ? 'Sender' : 'IP',   # canonicalize IP address
2043                              $2 ? 'not authorized' : 'authorized',
2044                              $3 ? 'by default to use' : 'to use',
2045                             );
2046             $mechanism = $4;
2047          }
2048          elsif ($message =~ /^Maximum DNS-interactive terms limit \S+ exceeded$/) {
2049             $message = 'Maximum DNS-interactive terms limit exceeded';
2050          }
2051          elsif ($message =~ /^Invalid IPv4 prefix length encountered in (.*)$/) {
2052             $subject .= " (invalid: $1)";
2053             $message = 'Invalid IPv4 prefix length encountered';
2054          }
2055
2056          #print "Result: $result, Identity: $params{'identity'}, Mech: $mechanism, Subject: $subject, IP: $ip\n";
2057          $Totals{'policyspf'}++;
2058          if ($Logreporters::TreeData::Collecting{'policyspf'}) {
2059             $message = join (' ', $message, $params{'identity'})  if exists $params{'identity'};
2060             $Counts{'policyspf'}{'Policy Action'}{"SPF $result"}{$message}{'mech: ' .$mechanism}{$subject}{$ip}++
2061          }
2062          return;
2063       }
2064
2065       inc_unmatched('postfix_policy_spf(2)');
2066       return;
2067    }
2068
2069 =pod
2070    Mail::SPF::Query
2071    libmail-spf-query-perl 1:1.999
2072
2073     XXX incomplete
2074
2075     Some possible smtp_comment results:
2076      pass         "localhost is always allowed."
2077      none         "SPF", "domain of sender $query->{sender} does not designate mailers
2078      unknown      $explanation, "domain of sender $query->{sender} does not exist"
2079                   $query->{spf_error_explanation}, $query->is_looping
2080                   $query->{spf_error_explanation}, $directive_set->{hard_syntax_error}
2081                   $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}"
2082      error        $query->{spf_error_explanation}, $query->{error}
2083
2084      $result      $explanation, $comment, $query->{directive_set}->{orig_txt}
2085
2086     Possible header_comment results:
2087      pass         "$query->{spf_source} designates $ip as permitted sender"
2088      fail         "$query->{spf_source} does not designate $ip as permitted sender"
2089      softfail     "transitioning $query->{spf_source} does not designate $ip as permitted sender"
2090      /^unknown /  "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
2091      unknown      "error in processing during lookup of $query->{sender}"
2092      neutral      "$ip is neither permitted nor denied by domain of $query->{sender}"
2093      error        "encountered temporary error during SPF processing of $query->{spf_source}"
2094      none         "$query->{spf_source} does not designate permitted sender hosts"
2095                   "could not perform SPF query for $query->{spf_source}" );
2096 =cut
2097
2098    #TDspf 39053DC: SPF none: smtp_comment=SPF: domain of sender user@example.com does not designate mailers, header_comment=sample.net: domain of user@example.com does not designate permitted sender hosts
2099    #TDspf : SPF none: smtp_comment=SPF: domain of sender user@example.com does not designate mailers, header_comment=sample.net: domain of user@example.com does not designate permitted sender hosts
2100    #TDspf : SPF pass: smtp_comment=Please see http://www.openspf.org/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=sample.net: example.com MX mail.example.com A 10.0.0.1, header_comment=example.com: domain of user@example.com designates 10.0.0.1 as permitted sender
2101    #TDspf : SPF fail: smtp_comment=Please see http://www.openspf.org/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=sample.net, header_comment=sample.net: domain of user@example.com does not designate 10.0.0.1 as permitted sender
2102    #TDspf : : SPF none: smtp_comment=SPF: domain of sender does not designate mailers, header_comment=mx1.example.com: domain of does not designate permitted sender hosts
2103
2104    if (my ($result, $reply) = ($line =~ /^(SPF [^:]+): (.*)$/)) {
2105
2106       #print "result: $result\n\treply: $reply\n\tORIG: \"$Logreporters::Reports::origline\"\n";
2107
2108       if ($reply =~ /^(?:smtp_comment=)(.*)$/) {
2109          $reply = $1;
2110
2111          # SPF none
2112          if ($reply =~ /^SPF: domain of sender (?:(?:[^@]+@)?(\S+) )?does not designate mailers/) {
2113             $domain = $1 ? $1 : '*unknown';
2114             #print "result: $result: domain: $domain\n";
2115          }
2116          elsif ($reply =~ /^Please see http:\/\/[^\/]+\/why\.html\?sender=(?:.+%40)?([^&]+)&ip=([^&]+)/) {
2117             ($domain,$ip) = ($1,$2);
2118             #print "result: $result: domain: $domain, IP: $ip\n";
2119          }
2120
2121          # SPF unknown
2122          elsif ($reply =~ /^SPF record error: ([^,]+), .*: error in processing during lookup of (?:[^@]+\@)?(\S+)/) {
2123             ($message, $domain) = ($1, $2);
2124             #print "result: $result: domain: $domain, Problem: $message\n";
2125          }
2126          elsif ($reply =~ /^SPF record error: ([^,]+), .*: encountered unrecognized mechanism during SPF processing of domain (?:[^@]+\@)?(\S+)/) {
2127             ($message, $domain) = ($1,$2);
2128             #print "result: \"$result\": domain: $domain, Problem: $message\n";
2129             $result = "SPF permerror"   if ($result =~ /SPF unknown mx-all/);
2130          }
2131          else {
2132             inc_unmatched('postfix_policy_spf(3)');
2133             return;
2134          }
2135       }
2136       else {
2137          inc_unmatched('postfix_policy_spf(4)');
2138          return;
2139       }
2140
2141       $Totals{'policyspf'}++;
2142       if ($message) {
2143          $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$message}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2144       }
2145       else {
2146          $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2147       }
2148       return;
2149    }
2150
2151
2152    inc_unmatched('postfix_policy_spf(5)');
2153 }
2154
2155 1;
2156
2157 #MODULE: ../Logreporters/Postfwd.pm
2158 package Logreporters::Postfwd;
2159
2160 use 5.008;
2161 use strict;
2162 use re 'taint';
2163 use warnings;
2164
2165 BEGIN {
2166    use Exporter ();
2167    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2168    $VERSION = '1.000';
2169    @ISA = qw(Exporter);
2170    @EXPORT = qw(&postfix_postfwd);
2171 }
2172
2173 use subs @EXPORT;
2174
2175 BEGIN {
2176    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2177    import Logreporters::Utils;
2178    import Logreporters::Reports qw(&inc_unmatched);
2179 }
2180
2181 # postfwd: http://postfwd.org/
2182 #
2183 #
2184 sub postfix_postfwd($) {
2185    my $line = shift;
2186
2187    return if (
2188       #TDpfw [STATS] Counters: 213000 seconds uptime, 39 rules
2189       #TDpfw [LOGS info]: compare rbl: "example.com[10.1.0.7]"  ->  "localrbl.local"
2190       #TDpfw [DNSBL] object 10.0.0.1 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2191       $line =~ /^\[STATS\] / or
2192       $line =~ /^\[DNSBL\] / or
2193       $line =~ /^\[LOGS info\]/ or
2194       $line =~ /^Process Backgrounded/ or
2195       $line =~ /^Setting [ug]id to/ or
2196       $line =~ /^Binding to TCP port/ or
2197       $line =~ /^terminating\.\.\./ or
2198       $line =~ /^Setting status interval to \S+ seconds/ or
2199       $line =~ /^postfwd .+ ready for input$/ or
2200       $line =~ /postfwd .+ (?:starting|terminated)/
2201    );
2202
2203    my ($type,$rule,$id,$action,$host,$hostip,$recipient);
2204
2205    if ($line =~ /^\[(RULES|CACHE)\] rule=(\d+), id=([^,]+), client=([^[]+)\[([^]]+)\], sender=.*?, recipient=<(.*?)>,.*? action=(.*)$/) {
2206       #TDpfw [RULES] rule=0, id=OK_DNSWL, client=example.com[10.0.0.1], sender=<f@example.com>, recipient=<to@sample.net>, helo=<example.com>, proto=ESMTP, state=RCPT, delay=0s, hits=OK_DNSWL, action=DUNNO
2207       #TDpfw [CACHE] rule=14, id=GREY_NODNS, client=unknown[192.168.0.1], sender=<f@example.net>, recipient=<to@sample.com>, helo=<example.com>, proto=ESMTP, state=RCPT, delay=0s, hits=SET_NODNS;EVAL_DNSBLS;EVAL_RHSBLS;GREY_NODNS, action=greylist
2208       ($type,$rule,$id,$host,$hostip,$recipient,$action) = ($1,$2,$3,$4,$5,$6,$7);
2209       $recipient  = '*unknown' if (not defined $recipient);
2210       $Counts{'postfwd'}{"Rule $rule"}{$id}{$action}{$type}{$recipient}{formathost($hostip,$host)}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2211    }
2212    elsif (($line =~ /Can't connect to TCP port/) or
2213           ($line =~ /Pid_file already exists for running process/)
2214          )
2215     {
2216       $line =~ s/^[-\d\/:]+ //; # strip leading date/time stamps 2009/07/18-20:09:49
2217       $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
2218       $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
2219       return;
2220    }
2221
2222    # ignoring [DNSBL] lines
2223    #elsif ($line =~ /^\[DNSBL\] object (\S+) listed on (\S+) \(answer: ([^,]+), .*\)$/) {
2224    #   #TDpfw [DNSBL] object 10.0.0.60 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2225    #   ($type,$rbl) = split (/:/, $2);
2226    #   $Counts{'postfwd'}{"DNSBL: $type"}{$rbl}{$1}{$3}{''}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2227    #}
2228    else {
2229       inc_unmatched('postfwd');
2230       return;
2231    }
2232
2233    $Totals{'postfwd'}++;
2234 }
2235
2236 1;
2237
2238 #MODULE: ../Logreporters/Postgrey.pm
2239 package Logreporters::Postgrey;
2240
2241 use 5.008;
2242 use strict;
2243 use re 'taint';
2244 use warnings;
2245
2246 my (%pgDelays,%pgDelayso);
2247
2248 BEGIN {
2249    use Exporter ();
2250    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2251    $VERSION = '1.000';
2252    @ISA = qw(Exporter);
2253    @EXPORT = qw(&postfix_postgrey &print_postgrey_reports);
2254 }
2255
2256 use subs @EXPORT;
2257
2258 BEGIN {
2259    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2260    import Logreporters::Utils;
2261    import Logreporters::Config qw(%Opts);
2262    import Logreporters::Reports qw(&inc_unmatched &print_percentiles_report2);
2263 }
2264
2265 # postgrey: http://postgrey.schweikert.ch/
2266 #
2267 # Triplet: (client IP, envelope sender, envelope recipient address)
2268 #
2269 sub postfix_postgrey($) {
2270    my $line = shift;
2271
2272    return if (
2273       #TDpg cleaning up old logs...
2274       #TDpg cleaning up old entries...
2275       #TDpg cleaning clients database finished. before: 207, after: 207
2276       #TDpg cleaning main database finished. before: 3800, after: 2539
2277       #TDpg delayed 603 seconds: client=10.0.example.com, from=anyone@sample.net, to=joe@example.com
2278
2279       #TDpg Setting uid to "504"
2280       #TDpg Setting gid to "1002 1002"
2281       #TDpg Process Backgrounded
2282       #TDpg 2008/03/08-15:54:49 postgrey (type Net::Server::Multiplex) starting! pid(21961)
2283       #TDpg Binding to TCP port 10023 on host 127.0.0.1
2284       #TDpg 2007/01/25-14:58:24 Server closing!
2285       #TDpg Couldn't unlink "/var/run/postgrey.pid" [Permission denied]
2286       #TDpg ignoring garbage: <help>
2287       #TDpg unrecognized request type: ''
2288       #TDpg rm /var/spool/postfix/postgrey/log.0000000002
2289       #TDpg 2007/01/25-14:48:00 Pid_file already exists for running process (4775)... aborting    at line 232 in file /usr/lib/perl5/vendor_perl/5.8.7/Net/Server.pm
2290
2291
2292       $line =~ /^cleaning / or
2293       $line =~ /^delayed / or
2294       $line =~ /^cleaning / or
2295       $line =~ /^Setting [ug]id/ or
2296       $line =~ /^Process Backgrounded/ or
2297       $line =~ /^Binding to / or
2298       $line =~ /^Couldn't unlink / or
2299       $line =~ /^ignoring garbage: / or
2300       $line =~ /^unrecognized request type/ or
2301       $line =~ /^rm / or
2302       # unanchored last
2303       $line =~ /Pid_file already exists/ or
2304       $line =~ /postgrey .* starting!/ or
2305       $line =~ /Server closing!/
2306    );
2307
2308    my ($action,$reason,$delay,$host,$ip,$sender,$recip);
2309
2310    if ($line =~ /^(?:$Logreporters::re_QID: )?action=(.*?), reason=(.*?)(?:, delay=(\d+))?, client_name=(.*?), client_address=(.*?)(?:, sender=(.*?))?(?:, +recipient=(.*))?$/o) {
2311       #TDpg  action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2312       #TDpgQ action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com
2313       #TDpgQ action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2314       #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2315       #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2316       #TDpg  action=pass,     reason=triplet found, delay=99, client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2317       ($action,$reason,$delay,$host,$ip,$sender,$recip) = ($1,$2,$3,$4,$5,$6,$7);
2318       $reason =~ s/^(early-retry) \(.* missing\)$/$1/;
2319       $recip  = '*unknown' if (not defined $recip);
2320       $sender = ''         if (not defined $sender);
2321
2322       $Totals{'postgrey'}++;
2323       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2324          $Counts{'postgrey'}{"\u$action"}{"\u$reason"}{formathost($ip,$host)}{$recip}{$sender}++;
2325
2326          if (defined $delay and $Logreporters::TreeData::Collecting{'postgrey_delays'}) {
2327             $pgDelays{'1: Total'}{$delay}++;
2328
2329             push @{$pgDelayso{'Postgrey'}}, $delay
2330          }
2331       }
2332    }
2333    elsif ($line =~ /^whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2334       #TDpg: whitelisted: example.com[10.0.0.1]
2335       $Totals{'postgrey'}++;
2336       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2337          $Counts{'postgrey'}{'Whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2338       }
2339    }
2340    elsif ($line =~ /^tarpit whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2341       #TDpg: tarpit whitelisted: example.com[10.0.0.1]
2342       $Totals{'postgrey'}++;
2343       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2344          $Counts{'postgrey'}{'Tarpit whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2345       }
2346    }
2347    else {
2348       inc_unmatched('postgrey');
2349    }
2350
2351    return;
2352 }
2353
2354 sub print_postgrey_reports() {
2355    #print STDERR "pgDelays     memory usage: ", commify(Devel::Size::total_size(\%pgDelays)), "\n";
2356
2357    if ($Opts{'postgrey_delays'}) {
2358       my @table;
2359       for (sort keys %pgDelays) {
2360          # anon array ref: label, array ref of $Delay{key}
2361          push @table, [ substr($_,3), $pgDelays{$_} ];
2362       }
2363       if (@table) {
2364          print_percentiles_report2(\@table, "Postgrey Delays Percentiles", $Opts{'postgrey_delays_percentiles'});
2365       }
2366    }
2367 }
2368
2369 1;
2370
2371 #MODULE: ../Logreporters/PolicydWeight.pm
2372 package Logreporters::PolicydWeight;
2373
2374 use 5.008;
2375 use strict;
2376 use re 'taint';
2377 use warnings;
2378
2379 BEGIN {
2380    use Exporter ();
2381    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2382    $VERSION = '1.000';
2383    @ISA = qw(Exporter);
2384    @EXPORT = qw(&postfix_policydweight);
2385 }
2386
2387 use subs @EXPORT;
2388
2389 BEGIN {
2390    import Logreporters::Reports qw(&inc_unmatched);
2391    import Logreporters::TreeData qw(%Totals %Counts);
2392    import Logreporters::Utils;
2393 }
2394
2395 # Handle postfix/policydweight entries
2396 #
2397 sub postfix_policydweight($) {
2398    my $line = shift;
2399    my ($r1, $code, $reason, $reason2);
2400
2401    if (
2402         $line =~ /^weighted check/ or
2403         $line =~ /^policyd-weight .* started and daemonized/ or
2404         $line =~ /^(cache|child|master): / or
2405         $line =~ /^cache (?:spawned|killed)/ or
2406         $line =~ /^child \d+ exited/ or
2407         $line =~ /^Daemon terminated/ or
2408         $line =~ /^Daemon terminated/
2409       )
2410    {
2411       #print "$OrigLine\n";
2412       return;
2413    }
2414
2415    if ($line =~ s/^decided action=//) {
2416       $line =~ s/; delay: \d+s$//;     # ignore, eg.: "delay: 3s"
2417       #print "....\n\tLINE: $line\n\tORIG: '$Logreporters::Reports::origline'\n";
2418       if (($code,$r1) = ($line =~ /^(\d+)\s+(.*)$/ )) {
2419          my @problems = ();
2420          for (split /; */, $r1) {
2421
2422             if (/^Mail appeared to be SPAM or forged\. Ask your Mail\/DNS-Administrator to correct HELO and DNS MX settings or to get removed from DNSBLs/ ) {
2423                push @problems, 'spam/forged: bad DNS/hit DNSRBLs';
2424             }
2425             elsif (/^Your MTA is listed in too many DNSBLs/) {
2426                push @problems, 'too many DNSBLs';
2427             }
2428             elsif (/^temporarily blocked because of previous errors - retrying too fast\. penalty: \d+ seconds x \d+ retries\./) {
2429                push @problems, 'temp blocked: retrying too fast';
2430             }
2431             elsif (/^Please use DynDNS/) {
2432                push @problems, 'use DynDNS';
2433             }
2434             elsif (/^please relay via your ISP \([^)]+\)/) {
2435                push @problems, 'use ISP\'s relay';
2436             }
2437             elsif (/^in (.*)/) {
2438                push @problems, $1;
2439             }
2440             elsif (m#^check http://rbls\.org/\?q=#) {
2441                push @problems, 'see http://rbls.org';
2442             }
2443             elsif (/^MTA helo: .* \(helo\/hostname mismatch\)/) {
2444                push @problems, 'helo/hostname mismatch';
2445             }
2446             elsif (/^No DNS entries for your MTA, HELO and Domain\. Contact YOUR administrator\s+/) {
2447                push @problems, 'no DNS entries';
2448             }
2449             else {
2450                push @problems, $_;
2451             }
2452          }
2453
2454          $reason = $code; $reason2 = join (', ', @problems);
2455       }
2456       elsif ($line =~ s/^DUNNO\s+//) {
2457          #decided action=DUNNO multirecipient-mail - already accepted by previous query; delay: 0s
2458          $reason = 'DUNNO'; $reason2 = $line;
2459       }
2460       elsif ($line =~ s/^check_greylist//) {
2461          #decided action=check_greylist; delay: 16s
2462          $reason = 'Check greylist'; $reason2 = $line;
2463       }
2464       elsif ($line =~ s/^PREPEND X-policyd-weight:\s+//) {
2465          #decided action=PREPEND X-policyd-weight: using cached result; rate: -7.6; delay: 0s
2466          if ($line =~ /(using cached result); rate:/) {
2467             $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = "\u$1";
2468          }
2469          else {
2470             #decided action=PREPEND X-policyd-weight:  NOT_IN_SBL_XBL_SPAMHAUS=-1.5 P0F_LINUX=0 <client=10.0.0.1> <helo=example.com> <from=f@example.com> <to=t@sample.net>, rate: -7.6; delay: 2s
2471             $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = 'Varies';
2472          }
2473       }
2474       else {
2475          return;
2476       }
2477    }
2478    elsif ($line =~ /^err/) {
2479       # coerrce policyd-weight err's into general warnings
2480       $Totals{'startuperror'}++;
2481       $Counts{'startuperror'}{'Service: policyd-weight'}{$line}++    if ($Logreporters::TreeData::Collecting{'startuperror'});
2482       return;
2483    }
2484    else {
2485       inc_unmatched('policydweight');
2486       return;
2487    }
2488
2489    $Totals{'policydweight'}++;
2490    $Counts{'policydweight'}{$reason}{$reason2}++   if ($Logreporters::TreeData::Collecting{'policydweight'});
2491 }
2492
2493 1;
2494
2495
2496 package Logreporters;
2497
2498 BEGIN {
2499    import Logreporters::Utils;
2500    import Logreporters::Config;
2501    import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree $END_KEY);
2502    import Logreporters::RegEx;
2503    import Logreporters::Reports;
2504    import Logreporters::RFC3463;
2505    import Logreporters::PolicySPF;
2506    import Logreporters::Postfwd;
2507    import Logreporters::Postgrey;
2508    import Logreporters::PolicydWeight;
2509 }
2510 use 5.008;
2511 use strict;
2512 use warnings;
2513 no warnings "uninitialized";
2514 use re 'taint';
2515
2516 use File::Basename;
2517 our $progname =  fileparse($0);
2518
2519 my @supplemental_reports = qw(delays postgrey_delays);
2520
2521 # Default values for various options.  These are used
2522 # to reset default values after an option has been
2523 # disabled (via undef'ing its value).  This allows
2524 # a report to be disabled via config file or --nodetail,
2525 # but reenabled via subsequent command line option
2526 my %Defaults = (
2527    detail                      => 10,                        # report level detail
2528    max_report_width            => 100,                       # maximum line width for report output
2529    line_style                  => undef,                     # lines > max_report_width, 0=truncate,1=wrap,2=full
2530    syslog_name                 => 'postfix',                 # service name (postconf(5), syslog_name)
2531    sect_vars                   => 0,                         # show section vars in detail report hdrs
2532    unknown                     => 1,                         # show 'unknown' in address/hostname pairs
2533    ipaddr_width                => 15,                        # width for printing ip addresses
2534    long_queue_ids              => 0,                         # enable long queue ids (2.9+)
2535    delays                      => 1,                         # show message delivery delays report
2536    delays_percentiles          => '0 25 50 75 90 95 98 100', # percentiles shown in delays report
2537    reject_reply_patterns       => '5.. 4.. warn',            # reject reply grouping patterns
2538    postgrey_delays             => 1,                         # show postgrey delays report
2539    postgrey_delays_percentiles => '0 25 50 75 90 95 98 100', # percentiles shown in postgrey delays report
2540 );
2541
2542 my $usage_str = <<"END_USAGE";
2543 Usage: $progname [ ARGUMENTS ] [logfile ...]
2544    ARGUMENTS can be one or more of options listed below.  Later options
2545    override earlier ones.  Any argument may be abbreviated to an unambiguous
2546    length.  Input is read from the named logfile(s), or STDIN.
2547
2548    --debug AREAS                          provide debug output for AREAS
2549    --help                                 print usage information
2550    --version                              print program version
2551
2552    --config_file FILE, -f FILE            use alternate configuration file FILE
2553    --ignore_services PATTERN              ignore postfix/PATTERN services
2554    --syslog_name PATTERN                  only consider log lines that match
2555                                           syslog service name PATTERN
2556
2557    --detail LEVEL                         print LEVEL levels of detail
2558                                           (default: 10)
2559    --nodetail                             set all detail levels to 0
2560    --[no]summary                          display the summary section
2561
2562    --ipaddr_width WIDTH                   use WIDTH chars for IP addresses in
2563                                           address/hostname pairs
2564    --line_style wrap|full|truncate        disposition of lines > max_report_width
2565                                           (default: truncate)
2566    --full                                 same as --line_style=full
2567    --truncate                             same as --line_style=truncate
2568    --wrap                                 same as --line_style=wrap
2569    --max_report_width WIDTH               limit report width to WIDTH chars
2570                                           (default: 100)
2571    --limit L=V, -l L=V                    set level limiter L with value V
2572    --[no]long_queue_ids                   use long queue ids
2573    --[no]unknown                          show the 'unknown' hostname in
2574                                           formatted address/hostnames pairs
2575    --[no]sect_vars                        [do not] show config file var/cmd line
2576                                           option names in section titles
2577
2578    --recipient_delimiter C                split delivery addresses using
2579                                           recipient delimiter char C
2580    --reject_reply_patterns "R1 [R2 ...]"  set reject reply patterns used in
2581                                           to group rejects to R1, [R2 ...],
2582                                           where patterns are [45][.0-9][.0-9]
2583                                           or "Warn" (default: 5.. 4.. Warn)
2584    Supplimental reports
2585    --[no]delays                           [do not] show msg delays percentiles report
2586    --delays_percentiles "P1 [P2 ...]"     set delays report percentiles to
2587                                           P1 [P2 ...] (range: 0...100)
2588    --[no]postgrey_delays                  [do not] show postgrey delays percentiles
2589                                           report
2590    --postgrey_delays_percentiles "P1 [P2 ...]"
2591                                           set postgrey delays report percentiles to
2592                                           P1 [P2 ...] (range: 0...100)
2593 END_USAGE
2594
2595 my @RejectPats;      # pattern list used to match against reject replys
2596 my @RejectKeys;      # 1-to-1 with RejectPats, but with 'x' replacing '.' (for report output)
2597 my (%DeferredByQid, %SizeByQid, %AcceptedByQid, %Delays);
2598
2599 # local prototypes
2600 sub usage;
2601 sub init_getopts_table;
2602 sub init_defaults;
2603 sub build_sect_table;
2604 sub postfix_bounce;
2605 sub postfix_cleanup;
2606 sub postfix_panic;
2607 sub postfix_fatal;
2608 sub postfix_error;
2609 sub postfix_warning;
2610 sub postfix_script;
2611 sub postfix_postsuper;
2612 sub process_delivery_attempt;
2613 sub cleanhostreply;
2614 sub strip_ftph;
2615 sub get_reject_key;
2616 sub expand_bare_reject_limiters;
2617 sub create_ignore_list;
2618 sub in_ignore_list;
2619 sub header_body_checks;
2620 sub milter_common;
2621
2622 # lines that match any RE in this list will be ignored.
2623 # see create_ignore_list();
2624 my @ignore_list = ();
2625
2626 # The Sections table drives Summary and Detail reports.  For each entry in the
2627 # table, if there is data avaialable, a line will be output in the Summary report.
2628 # Additionally, a sub-section will be output in the Detail report if both the
2629 # global --detail, and the section's limiter variable, are sufficiently high (a
2630 # non-existent section limiter variable is considered to be sufficiently high).
2631 #
2632 my @Sections = ();
2633
2634 # List of reject variants.  See also: "Add reject variants" below, and conf file(s).
2635 my @RejectClasses = qw(
2636    rejectrelay rejecthelo rejectdata rejectunknownuser rejectrecip rejectsender
2637    rejectclient rejectunknownclient rejectunknownreverseclient rejectunverifiedclient
2638    rejectrbl rejectheader rejectbody rejectcontent rejectsize rejectmilter rejectproxy
2639    rejectinsufficientspace rejectconfigerror rejectverify rejectetrn rejectlookupfailure
2640 );
2641
2642 # Dispatch table of the list of supported policy services
2643 # XXX have add-ins register into the dispatch table
2644 my @policy_services = (
2645    [ qr/^postfwd/,         \&Logreporters::Postfwd::postfix_postfwd ],
2646    [ qr/^postgrey/,        \&Logreporters::Postgrey::postfix_postgrey ],
2647    [ qr/^policyd?-spf/,    \&Logreporters::PolicySPF::postfix_policy_spf ],
2648    [ qr/^policyd-?weight/, \&Logreporters::PolicydWeight::postfix_policydweight ],
2649 );
2650
2651 # Initialize main running mode and basic opts
2652 init_run_mode($config_file);
2653
2654 # Configure the Getopts options table
2655 init_getopts_table();
2656
2657 # Place configuration file/environment variables onto command line
2658 init_cmdline();
2659
2660 # Initialize default values
2661 init_defaults();
2662
2663 # Process command line arguments, 0=no_permute,no_pass_through
2664 get_options(0);
2665
2666 # Build the Section table, after reject_reply_patterns is final
2667 build_sect_table();
2668
2669 # Expand bare rejects before generic processing
2670 expand_bare_reject_limiters();
2671
2672 # Run through the list of Limiters, setting the limiters in %Opts.
2673 process_limiters(@Sections);
2674
2675 # Set collection for any enabled supplemental sections
2676 foreach (@supplemental_reports) {
2677    $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
2678 }
2679
2680 if (! defined $Opts{'line_style'}) {
2681    # default line style to full if detail >= 11, or truncate otherwise
2682    $Opts{'line_style'} =
2683       ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
2684 }
2685
2686 # Set the QID RE to capture either pre-2.9 short style or 2.9+ long style.
2687 $re_QID = $Opts{'long_queue_ids'} ? $re_QID_l : $re_QID_s;
2688
2689 # Create the list of REs used to match against log lines
2690 create_ignore_list();
2691
2692 # Notes:
2693 #
2694 #   - IN REs, always use /o flag or qr// at end of RE when RE uses interpolated vars
2695 #   - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<.*?> )
2696 #   - See additional notes below, search for "Note:".
2697 #   - XXX indicates change, fix or thought required
2698
2699
2700 # Main processing loop
2701 #
2702 LINE: while ( <> ) {
2703    chomp;
2704    s/\s+$//;
2705    next unless length $_;
2706
2707    $Logreporters::Reports::origline = $_;
2708
2709    # Linux:   Jul  1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2710    # FreeBSD: Jul  1 20:08:06 <mail.info> mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2711    #          Aug 17 15:16:12 mailhost postfix/cleanup[14194]: [ID 197553 mail.info] EC2B339E5: message-id=<2616.EC2B339E5@example.com>
2712    #          Dec 25 05:20:28 mailhost policyd-spf[14194]: [ID 27553 mail.info] ... policyd-spf stuff ...
2713
2714    next unless /^[A-Z][a-z]{2} [ \d]\d \d{2}:\d{2}:\d{2} (?:<[^>]+> )?(\S+) ($Opts{'syslog_name'}(?:\/([^:[]+))?)(?:\[\d+\])?: (?:\[ID \d+ \w+\.\w+\] )?(.*)$/o;
2715
2716    our $service_name = $3;
2717    my ($mailhost,$server_name,$p1) = ($1,$2,$4);
2718
2719    $service_name = $server_name unless $service_name;
2720
2721    # ignored postfix services...
2722    next if $service_name eq 'postlog';
2723    next if $service_name =~ /^$Opts{'ignore_services'}$/o;
2724
2725    # common log entries up front
2726    if ($p1 =~ s/^connect from //) {
2727       #TD25 connect from sample.net[10.0.0.1]
2728       #TD connect from mail.example.com[2001:dead:beef::1]
2729       #TD connect from localhost.localdomain[127.0.0.1]
2730       #TD connect from unknown[unknown]
2731       $Totals{'connectioninbound'}++;
2732       next unless ($Collecting{'connectioninbound'});
2733
2734       my $host = $p1;  my $hostip;
2735       if (($host,$hostip) = ($host =~ /^([^[]+)\[([^]]+)\]/)) {
2736          $host = formathost($hostip,$host);
2737       }
2738       $Counts{'connectioninbound'}{$host}++;
2739       next;
2740    }
2741
2742    if ($p1 =~ /^disconnect from /) {
2743       #TD25 disconnect from sample.net[10.0.0.1]
2744       #TD disconnect from mail.example.com[2001:dead:beef::1]
2745       $Totals{'disconnection'}++;
2746       next;
2747    }
2748
2749    if ($p1 =~ s/^connect to //) {
2750       next if ($p1 =~ /^subsystem /);
2751       $Totals{'connecttofailure'}++;
2752       next unless ($Collecting{'connecttofailure'});
2753
2754       my ($host,$hostip,$reason,$port) = ($p1 =~ /^([^[]+)\[([^]]+)\](?::\d+)?: (.*?)(?:\s+\(port (\d+)\))?$/);
2755       # all "connect to" messages indicate a problem with the connection
2756       #TDs connect to example.org[10.0.0.1]: Connection refused (port 25)
2757       #TDs connect to mail.sample.com[10.0.0.1]: No route to host (port 25)
2758       #TDs connect to sample.net[192.168.0.1]: read timeout (port 25)
2759       #TDs connect to mail.example.com[10.0.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2760       #TDs connect to mail.example.com[192.168.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2761       #TDs connect to ipv6-1.example.com[2001:dead:beef::1]: Connection refused (port 25)
2762       #TDs connect to ipv6-2.example.com[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]: Connection refused (port 25)
2763       #TDs connect to ipv6-3.example.com[1080:0:0:0:8:800:200C:4171]: Connection refused (port 25)
2764       #TDs connect to ipv6-4.example.com[3ffe:2a00:100:7031::1]: Connection refused (port 25)
2765       #TDs connect to ipv6-5.example.com[1080::8:800:200C:417A]: Connection refused (port 25)
2766       #TDs connect to ipv6-6.example.com[::192.9.5.5]: Connection refused (port 25)
2767       #TDs connect to ipv6-7.example.com[::FFFF:129.144.52.38]: Connection refused (port 25)
2768       #TDs connect to ipv6-8.example.com[2010:836B:4179::836B:4179]: Connection refused (port 25)
2769       #TDs connect to mail.example.com[10.0.0.1]: server refused to talk to me: 452 try later   (port 25)
2770
2771       $host = join(' :', $host, $port)   if ($port and $port ne '25');
2772       # Note: See ConnectToFailure below
2773       if ($reason =~ /^server (refused to talk to me): (.*)$/) {
2774          $Counts{'connecttofailure'}{ucfirst($1)}{formathost($hostip,$host)}{$2}++;
2775       } else {
2776          $Counts{'connecttofailure'}{ucfirst($reason)}{formathost($hostip,$host)}{''}++;
2777       }
2778       next;
2779    }
2780
2781 =pod
2782 real    3m43.997s
2783 user    3m39.038s
2784 sys     0m3.005s
2785 =pod
2786    # Handle before panic, fatal, warning, so that service-specific code gets first crack
2787    # XXX replace w/dispatch table for add-ins, so user's can add their own...
2788    if ($service_name eq 'postfwd')          { postfix_postfwd($p1);       next; }
2789    if ($service_name eq 'postgrey')         { postfix_postgrey($p1);      next; }
2790    if ($service_name =~ /^policyd?-spf/)    { postfix_policy_spf($p1);    next; } # postfix/policy-spf
2791    if ($service_name =~ /^policyd-?weight/) { postfix_policydweight($p1); next; } # postfix/policydweight
2792
2793 =cut
2794    # Handle policy service handlers before panic, fatal, warning, etc.
2795    # messages so that service-specific code gets first crack.
2796    # 5:25
2797    foreach (@policy_services) {
2798       if ($service_name =~ $_->[0]) {
2799          &{$_->[1]}($p1);
2800          next LINE;
2801       }
2802    };
2803 #=cut
2804
2805    # ^warning: ...
2806    # ^fatal: ...
2807    # ^panic: ...
2808    # ^error: ...
2809    if ($p1 =~ /^warning: +(.*)$/)           { postfix_warning($1); next; }
2810    if ($p1 =~ /^fatal: +(.*)$/)             { postfix_fatal($1);   next; }
2811    if ($p1 =~ /^panic: +(.*)$/)             { postfix_panic($1);   next; }
2812    if ($p1 =~ /^error: +(.*)$/)             { postfix_error($1);   next; }
2813
2814    # output by all services that use table lookups - process before specific messages
2815    if ($p1 =~ /(?:lookup )?table (?:[^ ]+ )?has changed -- (?:restarting|exiting)$/) {
2816       #TD table hash:/var/mailman/data/virtual-mailman(0,lock|fold_fix) has changed -- restarting
2817       #TD table hash:/etc/postfix/helo_checks has changed -- restarting
2818       $Totals{'tablechanged'}++;
2819       next;
2820    }
2821
2822    # postfix/postscreen and postfix/verify services
2823    if ($service_name eq 'postscreen'
2824     or $service_name eq 'verify')          { postfix_postscreen($p1); next; }    # postfix/postscreen, postfix/verify
2825    if ($service_name eq 'dnsblog')         { postfix_dnsblog($p1);    next; }    # postfix/dnsblog
2826    if ($service_name =~ /^cleanup/)        { postfix_cleanup($p1);    next; }    # postfix/cleanup*
2827    if ($service_name =~ /^bounce/)         { postfix_bounce($p1);     next; }    # postfix/bounce*
2828    if ($service_name eq 'postfix-script')  { postfix_script($p1);     next; }    # postfix/postfix-script
2829    if ($service_name eq 'postsuper')       { postfix_postsuper($p1);  next; }    # postfix/postsuper
2830
2831    # ignore tlsproxy for now
2832    if ($service_name eq 'tlsproxy')        { next; }                             # postfix/tlsproxy
2833
2834    my ($helo, $relay, $from, $origto, $to, $domain, $status,
2835        $type, $reason, $reason2, $filter, $site, $cmd, $qid,
2836        $rej_type, $reject_name, $host, $hostip, $dsn, $reply, $fmthost, $bytes);
2837
2838    $rej_type = undef;
2839
2840    # ^$re_QID: ...
2841    if ($p1 =~ s/^($re_QID): //o) {
2842       $qid = $1;
2843
2844       next if ($p1 =~ /^host \S*\[\S*\] said: 4\d\d/);  # deferrals, picked up in "status=deferred"
2845
2846       if ($p1 =~ /^removed\s*$/ ) {
2847          # Note: See REMOVED elsewhere
2848          # 52CBDC2E0F: removed
2849          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
2850          $Totals{'removedfromqueue'}++;
2851          next;
2852       }
2853
2854       # coerce into general warning
2855       if (($p1 =~ /^Cannot start TLS: handshake failure/) or
2856           ($p1 =~ /^non-E?SMTP response from/)) {
2857          postfix_warning($p1);
2858          next;
2859       }
2860
2861       if ($p1 eq 'status=deferred (bounce failed)') {
2862          #TDqQ status=deferred (bounce failed)
2863          $Totals{'bouncefailed'}++;
2864          next;
2865       }
2866
2867       # this test must preceed access checks below
2868       #TDsQ  replace: header From:     "Postmaster" <postmaster@webmail.example.com>: From:     "Postmaster" <postmaster@webmail.example.org>
2869       if ($service_name eq 'smtp' and header_body_checks($p1)) {
2870          next;
2871       }
2872
2873       # Postfix access actions
2874       #   REJECT optional text...
2875       #   DISCARD optional text...
2876       #   HOLD optional text...
2877       #   WARN optional text...
2878       #   FILTER transport:destination
2879       #   REDIRECT user@domain
2880       #   BCC user@domain  (2.6 experimental branch)
2881       # The following actions are indistinguishable in the logs
2882       #   4NN text
2883       #   5NN text
2884       #   DEFER_IF_REJECT optional text...
2885       #   DEFER_IF_PERMIT optional text...
2886       #   UCE restriction...
2887       # The following actions are not logged
2888       #   PREPEND headername: headervalue
2889       #   DUNNO
2890       #
2891       # Reject actions based on remote client information:
2892       #     - one of host name, network address, envelope sender
2893       #   or
2894       #     - recipient address
2895
2896       # Template of access controls.  Rejects look like the first line, other access actions the second.
2897       # ftph is envelope from, envelope to, proto and helo.
2898       # QID: ACTION  STAGE from host[hostip]: DSN       trigger: explanation; ftph
2899       # QID: ACTION  STAGE from host[hostip]: trigger:           explanation; ftph
2900
2901       # $re_QID: reject: RCPT|MAIL|CONNECT|HELO|DATA from ...
2902       # $re_QID: reject_warning: RCPT|MAIL|CONNECT|HELO|DATA from ...
2903       if ($p1 =~ /^(reject(?:_warning)?|discard|filter|hold|redirect|warn|bcc|replace): /) {
2904          my $action = $1;
2905          $p1 = substr($p1, length($action) + 2);
2906
2907          if ($p1 !~ /^(RCPT|MAIL|CONNECT|HELO|EHLO|DATA|VRFY|ETRN|END-OF-MESSAGE) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
2908             inc_unmatched('unexpected access');
2909             next;
2910          }
2911          my ($stage,$host,$hostip,$p1) = ($1,$2,$3,$4);
2912          my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
2913
2914 # QID: ACTION         STAGE from host[hostip]:   DSN       trigger:          explanation;                                                       ftph
2915 #TDsdN reject_warning: VRFY from host[10.0.0.1]: 450 4.1.2 <<1F4@bs>>:       Recipient address rejected: Domain not found;                                          to=<<1F4@bs>>        proto=SMTP  helo=<friend>
2916 #TDsdN reject:         VRFY from host[10.0.0.1]: 550 5.1.1 <:>:              Recipient address rejected: User unknown in local recipient table;                     to=<:> proto=SMTP helo=<10.0.0.1>
2917 #TDsdN reject:         VRFY from host[10.0.0.1]: 450 4.1.8 <to@example.com>: Sender address rejected: Domain not found;                         from=<f@sample.com> to=<eto@example.com> proto=SMTP
2918 #TDsdN reject:         VRFY from host[10.0.0.1]: 554 5.7.1 Service unavailable; Client host [10.0.0.1] blocked using zen.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; to=<u> proto=SMTP
2919 #TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.2 <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2920 #TDsdN reject:         RCPT from host[10.0.0.1]: 550       <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2921 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 550       <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2922 #TDsdN reject:         RCPT from host[10.0.0.1]: 550 5.1.1 <to@example.com>: Recipient address rejected: User unknown in virtual address table; from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<localhost>
2923 #TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.1 <to@sample.net>:  Recipient address rejected: User unknown in virtual mailbox table; from=<f@sample.net> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2924 #TDsdN reject:         RCPT from host[10.0.0.1]: 550 5.5.0 <to@example.com>: Recipient address rejected: User unknown;                          from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<[10.0.0.1]>
2925 #TDsdN reject:         RCPT from host[10.0.0.1]: 450       <to@example.net>: Recipient address rejected: Greylisted;                            from=<f@sample.net> to=<eto@example.net> proto=ESMTP helo=<example.com>
2926 #TDsdN reject:         RCPT from host[10.0.0.1]: 454 4.7.1 <to@sample.net>:  Recipient address rejected: Access denied;                         from=<f@sample.com> to=<eto@sample.net>  proto=SMTP  helo=<example.com>
2927 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 <to@sample.net>:  Recipient address rejected: Access denied;                         from=<f@sample.net> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2928 #TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.2 <to@example.com>: Recipient address rejected: Domain not found;                      from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<sample.net>
2929 #TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@example.net>: Recipient address rejected: Please see http://www.openspf.org/why.html?sender=from%40example.net&ip=10.0.0.1&receiver=example.net; from=<from@example.net> to=<to@example.net> proto=ESMTP helo=<to@example.com>
2930 #TDsdN reject:         RCPT from host[10.0.0.1]: 550       <to@example.net>: Recipient address rejected: undeliverable address: host example.net[192.168.0.1] said: 550 <unknown@example.net>: User unknown in virtual alias table (in reply to RCPT TO command); from=<from@example.com> to=<unknown@example.net> proto=SMTP helo=<mail.example.com>
2931 #TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@example.com>: Recipient address rejected: Please see http://spf.pobox.com/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=mail; from=<user@example.com> to=<to@sample.net> proto=ESMTP helo=<10.0.0.1>
2932 #TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                               from=<f@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>
2933 #TDsdN reject_warning: HELO from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                                                                        proto=SMTP  helo=<example.com>
2934 #TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.8 <f@sample.net>:   Sender address rejected: Domain not found;                         from=<f@sample.com> to=<to@example.com>  proto=ESMTP helo=<sample.net>
2935 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 450 4.1.8 <f@sample.net>:   Sender address rejected: Domain not found;                         from=<f@sample.com> to=<to@example.com>  proto=ESMTP helo=<sample.net>
2936 #TDsdN reject:         RCPT from host[10.0.0.1]: 550       <f@example.net>:  Sender address rejected: undeliverable address: host example.net[10.0.0.1] said: 550 <f@example.net>: User unknown in virtual alias table (in reply to RCPT TO command); from=<f@example.net> to=<eto@example.net> proto=SMTP helo=<example.com>
2937 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 554       <host[10.0.0.1]>: Client host rejected: Access denied;                               from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<friend>
2938 #TDsdN reject:         RCPT from host[10.0.0.1]: 554       <host[10.0.0.1]>: Client host rejected: Optional text;                               from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<friend>
2939 #TDsdN reject:      CONNECT from host[10.0.0.1]: 503 5.5.0 <host[10.0.1]>:   Client host rejected: Improper use of SMTP command pipelining;                                              proto=SMTP
2940
2941 #TDsdN reject_warning: RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2942 #TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2943 #TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];                                                proto=ESMTP
2944 #TDsdN reject:         RCPT from unk[10.0.0.1]: 550 5.7.1                    Client host rejected: cannot find your reverse hostname, [10.0.0.1]
2945 #TDsdN reject:      CONNECT from unk[unknown]:  421 4.7.1                    Client host rejected: cannot find your reverse hostname, [unknown];                                         proto=SMTP
2946
2947 #TDsdN reject:         RCPT from host[10.0.0.1]: 554 5.7.1                   Service unavailable; Client host [10.0.0.1] blocked using sbl-xbl.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<friend>
2948 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 554 5.7.1                   Service unavailable; Client host [10.0.0.1] blocked using sbl-xbl.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<friend>
2949 #TDsdN reject:         RCPT from host[10.0.0.1]: 554                         Service denied; Client host [10.0.0.1] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?83.164.27.124; from=<bogus@example.com> to=<user@example.org> proto=ESMTP helo=<example.com>
2950 #TDsdN reject:         RCPT from host[10.0.0.1]: 454 4.7.1 <localhost>:      Helo command rejected: Access denied;                             from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
2951 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 <localhost>:      Helo command rejected: Access denied;                             from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
2952 #TDsdN reject:         EHLO from host[10.0.0.1]: 504 5.5.2 <bogus>:          Helo command rejected: need fully-qualified hostname;                                                      proto=SMTP  helo=<bogus>
2953 #TDsdQ reject:         DATA from host[10.0.0.1]: 550 5.5.3 <DATA>:           Data command rejected: Multi-recipient bounce;                    from=<>                                  proto=ESMTP helo=<localhost>
2954 #TDsdN reject:         ETRN from host[10.0.0.1]: 554 5.7.1 <example.com>:    Etrn command rejected: Access denied;                                                                      proto=ESMTP helo=<example.com>
2955 #TDsdN reject:         RCPT from host[10.0.0.1]: 452                         Insufficient system storage;                                      from=<f@sample.com> to=<eto@sample.net>
2956 #TDsdN reject_warning: RCPT from host[10.0.0.1]: 451 4.3.5                   Server configuration error;                                       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2957 #TDsdN reject:         RCPT from host[10.0.0.1]: 450                         Server configuration problem;                                     from=<f@sample.net> to=<eto@sample.com>  proto=ESMTP helo=<sample.net>
2958 #TDsdN reject:         MAIL from host[10.0.0.1]: 552                         Message size exceeds fixed limit;                                                                          proto=ESMTP helo=<localhost>
2959 #TDsdN reject:         RCPT from unk[10.0.0.1]:  554 5.7.1 <unk[10.0.0.1]>:  Unverified Client host rejected: Access denied;                   from=<f@sample.net> to=<eto@sample.com>  proto=SMTP  helo=<sample.net>
2960 #TDsdN reject:         MAIL from host[10.0.0.1]: 451 4.3.0 <f@example.com>:  Temporary lookup failure;                                         from=<f@example.com>                     proto=ESMTP helo=<example.com>
2961
2962          # reject, reject_warning
2963          if ($action =~ /^reject/) {
2964             my ($recip);
2965
2966             if ($p1 !~ /^($re_DSN) (.*)$/o) {
2967                inc_unmatched('reject1');
2968                next;
2969             }
2970             ($dsn,$p1) = ($1,$2);
2971             $fmthost = formathost($hostip,$host);
2972
2973             # reject_warning override temp or perm reject types
2974             $rej_type = ($action eq 'reject_warning' ? 'warn' : get_reject_key($dsn));
2975
2976             if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
2977                $Counts{'byiprejects'}{$fmthost}++;
2978             }
2979
2980             if ($stage eq 'VRFY') {
2981                if ($p1 =~ /^(?:<(\S*)>: )?(.*);$/) {
2982                   my ($trigger,$reason) = ($1,$2);
2983                   $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name});
2984
2985                   if ($reason =~ /^Service unavailable; Client host \[[^]]+\] (blocked using [^;]*);/) {
2986                      $reason = join (' ', 'Client host blocked using', $1);
2987                      $trigger = '';
2988                   }
2989                   $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++;
2990                } else {
2991                   inc_unmatched('vrfyfrom');
2992                }
2993                next;
2994             }
2995
2996             # XXX there may be several semicolon-separated messages
2997             # Recipient address rejected: Unknown users and via check_recipient_access
2998             if ($p1 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/) {
2999                ($recip,$reason) = ($1,$2);
3000
3001                my ($localpart,$domainpart);
3002                # Unknown users; local mailbox, alias, virtual, relay user, unspecified
3003                if ($recip eq '') { ($localpart, $domainpart) = ('<>', '*unspecified'); }
3004                else {
3005                   ($localpart, $domainpart) = split (/@/, lc $recip);
3006                   ($localpart, $domainpart) = ($recip, '*unspecified')   if ($domainpart eq '');
3007                }
3008
3009                if ($reason =~ s/^User unknown *//) {
3010                   $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name});
3011
3012                   my ($table) = ($reason =~ /^in ((?:\w+ )+table)/);
3013                   $table = 'Address table unavailable'  if ($table eq '');     # when show_user_unknown_table_name=no
3014                   $Counts{$reject_name}{ucfirst($table)}{$domainpart}{$localpart}{$fmthost}++;
3015                } else {
3016                   # check_recipient_access
3017                   $Totals{$reject_name = "${rej_type}rejectrecip" }++; next unless ($Collecting{$reject_name});
3018
3019                   if ($reason =~ m{^Please see http://[^/]+/why\.html}) {
3020                      $reason = 'SPF reject';
3021                   }
3022                   elsif ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3023                      $reason = 'undeliverable address: remote host rejected recipient';
3024                   }
3025                   $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++;
3026                }
3027
3028             } elsif ($p1 =~ /^<(.*?)>.* Relay access denied/) {
3029                $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name});
3030                $Counts{$reject_name}{$fmthost}{$eto}++;
3031
3032             } elsif ($p1 =~ /^<(.*)>: Sender address rejected: (.*);/) {
3033                $Totals{$reject_name = "${rej_type}rejectsender" }++;  next unless ($Collecting{$reject_name});
3034                ($from,$reason) =  ($1,$2);
3035
3036                if ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3037                   $reason = 'undeliverable address: remote host rejected sender';
3038                }
3039                $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++;
3040
3041             } elsif ($p1 =~ /^(?:<.*>: )?Unverified Client host rejected: /) {
3042                # check_reverse_client_hostname_access (postfix 2.6+)
3043                $Totals{$reject_name = "${rej_type}rejectunverifiedclient" }++; next unless ($Collecting{$reject_name});
3044                $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3045
3046             } elsif ($p1 =~ s/^(?:<.*>: )?Client host rejected: //) {
3047                # reject_unknown_client
3048                #   client IP->name mapping fails
3049                #   name->IP mapping fails
3050                #   name->IP mapping =! client IP
3051                if ($p1 =~ /^cannot find your hostname/) {
3052                   $Totals{$reject_name = "${rej_type}rejectunknownclient" }++; next unless ($Collecting{$reject_name});
3053                   $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3054                }
3055                # reject_unknown_reverse_client_hostname (no PTR record for client's IP)
3056                elsif ($p1 =~ /^cannot find your reverse hostname/) {
3057                   $Totals{$reject_name = "${rej_type}rejectunknownreverseclient" }++; next unless ($Collecting{$reject_name});
3058                   $Counts{$reject_name}{$hostip}++
3059                }
3060                else {
3061                   $Totals{$reject_name = "${rej_type}rejectclient" }++; next unless ($Collecting{$reject_name});
3062                   $p1 =~ s/;$//;
3063                   $Counts{$reject_name}{ucfirst($p1)}{$fmthost}{$eto}{$efrom}++;
3064                }
3065             } elsif ($p1 =~ /^Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/) {
3066                # Note: similar code below: search RejectRBL
3067
3068                # postfix 2.1
3069                #TDsdN reject: RCPT from example.com[10.0.0.5]: 554 Service unavailable; Client host [10.0.0.5] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.5; from=<from@example.com> to=<to@example.net> proto=ESMTP helo=<example.com>
3070                # postfix 2.3+
3071                #TDsdN reject: RCPT from example.com[10.0.0.6]: 554 5.7.1 Service unavailable; Client host [10.0.0.6] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.6; from=<from@example.com> to=<to@example.net> proto=SMTP helo=<example.com>
3072                #TDsdN reject: RCPT from example.com[10.0.0.1]: 550 5.7.1 Service unavailable; Client host [10.0.0.1] blocked using Trend Micro RBL+. Please see http://www.mail-abuse.com/cgi-bin/lookup?ip_address=10.0.0.1; Mail from 10.0.0.1 blocked using Trend Micro Email Reputation database. Please see <http://www.mail-abuse.com/cgi-bin/lookup?10.0.0.1>; from=<from@example.com> to=<to@example.net> proto=SMTP helo=<10.0.0.1>
3073
3074                $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3075                ($site,$reason) = ($1 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3076                $reason =~ s/^reason: // if ($reason);
3077                $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++;
3078
3079             } elsif ($p1 =~ /^<.*>: Helo command rejected: (.*);$/) {
3080                $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name});
3081                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3082
3083             } elsif ($p1 =~ /^<.*>: Etrn command rejected: (.*);$/) {
3084                $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name});
3085                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3086
3087             } elsif ($p1 =~ /^<.*>: Data command rejected: (.*);$/) {
3088                $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name});
3089                $Counts{$reject_name}{$1}{$fmthost}{$helo}++;
3090
3091             } elsif ($p1 =~ /^Insufficient system storage;/) {
3092                $Totals{'warninsufficientspace'}++;    # force display in Warnings section also
3093                $Totals{$reject_name = "${rej_type}rejectinsufficientspace" }++; next unless ($Collecting{$reject_name});
3094                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3095
3096             } elsif ($p1 =~ /^Server configuration (?:error|problem);/) {
3097                $Totals{'warnconfigerror'}++;          # force display in Warnings section also
3098                $Totals{$reject_name = "${rej_type}rejectconfigerror" }++; next unless ($Collecting{$reject_name});
3099                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3100
3101             } elsif ($p1 =~ /^Message size exceeds fixed limit;$/) {
3102                # Postfix responds with this message after a MAIL FROM:<...> SIZE=nnn  command, where postfix consider's nnn excessive
3103                # Note: similar code below: search RejectSize
3104                # Note: reject_warning does not seem to occur
3105                $Totals{$reject_name = "${rej_type}rejectsize" }++; next unless ($Collecting{$reject_name});
3106                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3107
3108             } elsif ($p1 =~ /^<(.*?)>: Temporary lookup failure;/) {
3109                $Totals{$reject_name = "${rej_type}rejectlookupfailure" }++; next unless ($Collecting{$reject_name});
3110                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3111
3112             # This would capture all other rejects, but I think it might be more useful to add
3113             # additional capture sections based on user reports of uncapture lines.
3114             #
3115             #} elsif ( ($reason) = ($p1 =~ /^([^;]+);/)) {
3116             #  $Totals{$rej_type . 'rejectother'}++;
3117             #  $Counts{$rej_type . 'rejectother'}{$reason}++;
3118             } else {
3119                inc_unmatched('rejectother');
3120             }
3121          }
3122          # end of $re_QID: reject:
3123
3124 # QID: ACTION         STAGE from host[hostip]:   trigger:                    reason;                                                            ftph
3125 #
3126 #TDsdN warn:           RCPT from host[10.0.0.1]:                             TEST access WARN action;                                           from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3127 #TDsdN warn:           RCPT from host[10.0.0.1]:                             ;                                                                  from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.net>
3128 #TDsdN discard:        RCPT from host[10.0.0.1]: <from@example.com>:         Sender address TEST DISCARD action;                                from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3129 #TDsdN discard:        RCPT from host[10.0.0.1]: <host[10.0.0.1]>:           Client host    TEST DISCARD action w/ip(client_checks);            from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3130 #TDsdN discard:        RCPT from host[10.0.0.1]: <host[10.0.0.1]>:           Unverified Client host triggers DISCARD action;                    from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<10.0.0.1>
3131 #TDsdN hold:           RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers HOLD action;                            from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<10.0.0.1>
3132 #TDsdN hold:           RCPT from host[10.0.0.1]: <dummy>:                    Helo command optional text...;                                     from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3133 #TDsdN hold:           RCPT from host[10.0.0.1]: <dummy>:                    Helo command triggers HOLD action;                                 from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3134 #TDsdN hold:           DATA from host[10.0.0.1]: <dummy>:                    Helo command triggers HOLD action;                                 from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3135 #TDsdN filter:         RCPT from host[10.0.0.1]: <>:                         Sender address triggers FILTER filter:somefilter;                  from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.com>
3136 #TDsdN filter:         RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers FILTER smtp-amavis:[127.0.0.1]:10024;   from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<sample.net>
3137 #TDsdN redirect:       RCPT from host[10.0.0.1]: <example.com[10.0.0.1]>:    Client host triggers REDIRECT root@localhost;                      from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
3138 #TDsdN redirect:       RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers REDIRECT root@localhost;                from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3139
3140 # BCC action (postfix 2.6+)
3141 #TDsdN bcc:            RCPT from host[10.0.0.1]: <user@example.com>:         Sender address triggers BCC root@localhost;                        from=<f@sample.net> to=<eto@sample.com> proto=ESMTP helo=<sample.net>
3142
3143          # $re_QID: discard, filter, hold, redirect, warn, bcc, replace ...
3144          else {
3145             my $trigger;
3146             ($trigger,$reason) = ($p1 =~ /^(?:<(\S*)>: )?(.*);$/ );
3147             if ($trigger eq '') {   $trigger = '*unavailable';  }
3148             else {                  $trigger =~ s/^<(.+)>$/$1/; }
3149             $reason  = '*unavailable' if ($reason eq '');
3150             $fmthost = formathost ($hostip,$host);
3151
3152             # reason -> subject text
3153             #           subject -> "Helo command"           : smtpd_helo_restrictions
3154             #           subject -> "Client host"            : smtpd_client_restrictions
3155             #           subject -> "Unverified Client host" : smtpd_client_restrictions
3156             #           subject -> "Client certificate"     : smtpd_client_restrictions
3157             #           subject -> "Sender address"         : smtpd_sender_restrictions
3158             #           subject -> "Recipient address"      : smtpd_recipient_restrictions
3159
3160             #           subject -> "Data command"           : smtpd_data_restrictions
3161             #           subject -> "End-of-data"            : smtpd_end_of_data_restrictions
3162             #           subject -> "Etrn command"           : smtpd_etrn_restrictions
3163
3164             #           text    -> triggers <ACTION> action|triggers <ACTION> <destination>|optional text...
3165
3166             my ($subject, $text) =
3167                ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o);
3168
3169             if ($action eq 'filter') {
3170                $Totals{'filtered'}++; next unless ($Collecting{'filtered'});
3171                # See "Note: Counts" before changing $Counts below re: Filtered
3172                $text =~ s/triggers FILTER //;
3173                if    ($subject eq 'Recipient address') { $Counts{'filtered'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3174                elsif ($subject =~ /Client host$/)      { $Counts{'filtered'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3175                else                                    { $Counts{'filtered'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3176             }
3177             elsif ($action eq 'redirect') {
3178                $Totals{'redirected'}++; next unless ($Collecting{'redirected'});
3179                $text =~ s/triggers REDIRECT //;
3180                # See "Note: Counts" before changing $Counts below re: Redirected
3181                if    ($subject eq 'Recipient address') { $Counts{'redirected'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3182                elsif ($subject =~ /Client host$/)      { $Counts{'redirected'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3183                else                                    { $Counts{'redirected'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3184             }
3185             # hold, discard, and warn allow "optional text"
3186             elsif ($action eq 'hold') {
3187                $Totals{'hold'}++; next unless ($Collecting{'hold'});
3188                # See "Note: Counts" before changing $Counts below re: Hold
3189                $subject = $reason unless $text eq 'triggers HOLD action';
3190                if    ($subject eq 'Recipient address') { $Counts{'hold'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3191                elsif ($subject =~ /Client host$/)      { $Counts{'hold'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3192                else                                    { $Counts{'hold'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3193             }
3194             elsif ($action eq 'discard') {
3195                $Totals{'discarded'}++; next unless ($Collecting{'discarded'});
3196                # See "Note: Counts" before changing $Counts below re: Discarded
3197                $subject = $reason unless $text eq 'triggers DISCARD action';
3198                if    ($subject eq 'Recipient address') { $Counts{'discarded'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3199                elsif ($subject =~ /Client host$/)      { $Counts{'discarded'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3200                else                                    { $Counts{'discarded'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3201             }
3202             elsif ($action eq 'warn') {
3203                $Totals{'warned'}++; next unless ($Collecting{'warned'});
3204                $Counts{'warned'}{$reason}{$fmthost}{$eto}{''}++;
3205                # See "Note: Counts" before changing $Counts above...
3206             }
3207             elsif ($action eq 'bcc') {
3208                $Totals{'bcced'}++; next unless ($Collecting{'bcced'});
3209                # See "Note: Counts" before changing $Counts below re: Filtered
3210                $text =~ s/triggers BCC //o;
3211                if    ($subject eq 'Recipient address') { $Counts{'bcced'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3212                elsif ($subject =~ /Client host$/)      { $Counts{'bcced'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3213                else                                    { $Counts{'bcced'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3214             }
3215             else {
3216                die "Unexpected ACTION: '$action'";
3217             }
3218          }
3219       }
3220
3221       elsif ($p1 =~ s/^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)//) {
3222          my ($hip,$host,$hostip) = ($1,$2,$3);
3223
3224          # Increment accepted when the client connection is made and smtpd has a QID.
3225          # Previously, accepted was being incorrectly incremented when the first qmgr
3226          # "from=xxx, size=nnn ..." line was seen.  This is erroneous when the smtpd
3227          # client connection occurred outside the date range of the log being analyzed.
3228          $AcceptedByQid{$qid} = $hip;
3229          $Totals{'msgsaccepted'}++;
3230
3231          #TDsdQ client=unknown[192.168.0.1]
3232          #TDsdQ client=unknown[192.168.0.1]:unknown
3233          #TDsdQ client=unknown[192.168.0.1]:10025
3234          #TDsd client=example.com[192.168.0.1], helo=example.com
3235          #TDsdQ client=mail.example.com[2001:dead:beef::1]
3236
3237          #TDsdQ client=localhost[127.0.0.1], sasl_sender=someone@example.com
3238          #TDsdQ client=example.com[192.168.0.1], sasl_method=PLAIN, sasl_username=anyone@sample.net
3239          #TDsdQ client=example.com[192.168.0.1], sasl_method=LOGIN, sasl_username=user@example.com, sasl_sender=<id352ib@sample.net>
3240          #TDsdQ client=unknown[10.0.0.1], sasl_sender=user@examine.com
3241          next if ($p1 eq '');
3242          my ($method,$user,$sender) = ($p1 =~ /^(?:, sasl_method=([^,]+))?(?:, sasl_username=([^,]+))?(?:, sasl_sender=<?(.*)>?)?$/);
3243
3244          # sasl_sender occurs when AUTH verb is present in MAIL FROM, typically used for relaying
3245          # the username (eg. sasl_username) of authenticated users.
3246          if ($sender or $method or $user) {
3247             $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'});
3248             $method ||= '*unknown method';
3249             $user   ||= '*unknown user';
3250             $Counts{'saslauth'}{$user . ($sender ? " ($sender)" : '')}{$method}{formathost($hostip,$host)}++;
3251          }
3252       }
3253
3254       # ^$re_QID: ...  (not access(5) action)
3255       elsif ($p1 =~ /^from=<(.*?)>, size=(\d+), nrcpt=(\d+)/) {
3256          my ($efrom,$bytes,$nrcpt) = ($1,$2,$3);
3257          #TDsdQ from=<FROM: SOME USER@example.com>, size=4051, nrcpt=1 (queue active)
3258          #TDsdQ(12) from=<anyone@example.com>, size=25302, nrcpt=2 (queue active)
3259          #TDsdQ from=<from@example.com>, size=5529, nrcpt=1 (queue active)
3260          #TDsdQ from=<from@example.net, @example.com>, size=5335, nrcpt=1 (queue active)
3261
3262          # Distinguish bytes accepted vs. bytes delivered due to multiple recips
3263
3264          # Increment bytes accepted on the first qmgr "from=..." line...
3265          next if (exists $SizeByQid{$qid});
3266          $SizeByQid{$qid}          = $bytes;
3267          # ...but only when the smtpd "client=..." line has been seen too.
3268          # This under-counts when the smtpd "client=..." connection log entry and the
3269          # qmgr "from=..." log entry span differnt periods (as fed to postfix-logwatch).
3270          next if (! exists $AcceptedByQid{$qid});
3271
3272          $Totals{'bytesaccepted'} += $bytes;
3273
3274          $Counts{'envelopesenders'}{$efrom ne '' ? $efrom : '<>'}++      if ($Collecting{'envelopesenders'});
3275          if ($Collecting{'envelopesenderdomains'}) {
3276             my ($localpart, $domain);
3277             if ($efrom eq '') { ($localpart, $domain) = ('<>', '*unknown'); }
3278             else              { ($localpart, $domain) = split (/@/, lc $efrom); }
3279
3280             $Counts{'envelopesenderdomains'}{$domain ne '' ? $domain : '*unknown'}{$localpart}++;
3281          }
3282          delete $AcceptedByQid{$qid};           # prevent incrementing BytesAccepted again
3283       }
3284
3285       ### sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3286       elsif ($p1 =~ s/^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=(\S+) //o) {
3287          ($relay,$status) = ($3,$5);
3288
3289          my ($to,$origto,$localpart,$domainpart,$dsn,$p1) = process_delivery_attempt ($1,$2,$4,$p1);
3290
3291          #TD 552B6C20E: to=<to@sample.com>, relay=mail.example.net[10.0.0.1]:25, delay=1021, delays=1020/0.04/0.56/0.78, dsn=2.0.0, status=sent (250 Ok: queued as 6EAC4719EB)
3292          #TD 552B6C20E: to=<to@sample.com>, relay=mail.example.net[10.0.0.1]:25, conn_use=2 delay=1021, delays=1020/0.04/0.56/0.78, dsn=2.0.0, status=sent (250 Ok: queued as 6EAC4719EB)
3293          #TD DD925BBE2: to=<to@example.net>, orig_to=<to-ext@example.net>, relay=mail.example.net[2001:dead:beef::1], delay=2, status=sent (250 Ok: queued as 5221227246)
3294
3295          ### sent
3296          if ($status eq 'sent') {
3297             if ($p1 =~ /forwarded as /) {
3298                $Totals{'bytesforwarded'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3299                $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'});
3300                $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++;
3301             }
3302             else {
3303                if ($service_name eq 'lmtp') {
3304                   $Totals{'bytessentlmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3305                   $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'});
3306                   $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++;
3307                }
3308                elsif ($service_name eq 'smtp') {
3309                   $Totals{'bytessentsmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3310                   $Totals{'sent'}++; next unless ($Collecting{'sent'});
3311                   $Counts{'sent'}{$domainpart}{$localpart}{$origto}++;
3312                }
3313                # virtual, command, ...
3314                else {
3315                   $Totals{'bytesdelivered'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3316                   $Totals{'delivered'}++; next unless ($Collecting{'delivered'});
3317                   $Counts{'delivered'}{$domainpart}{$localpart}{$origto}++;
3318                }
3319             }
3320          }
3321
3322          elsif ($status eq 'deferred') {
3323             #TDsQ to=<to@example.com>, relay=none, delay=27077, delays=27077/0/0.57/0, dsn=4.4.3, status=deferred (Host or domain name not found. Name service error for name=example.com type=MX: Host not found, try again)
3324             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused)
3325             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused)
3326             #TDsQ to=<to@example.com>, relay=none, delay=306142, delays=306142/0.04/0.18/0, dsn=4.4.1, status=deferred (connect to example.com[10.0.0.1]: Connection refused)
3327             #TDsQ to=<to@example.org>, relay=example.org[10.0.0.1], delay=48779, status=deferred (lost connection with mail.example.org[10.0.0.1] while sending MAIL FROM)
3328             #TDsQ to=<to@sample.net>, relay=sample.net, delay=26541, status=deferred (conversation with mail.example.com timed out while sending end of data -- message may be sent more than once)
3329             #TDsQ to=<to@sample.net>, relay=sample.net[10.0.0.1]:25, delay=322, delays=0.04/0/322/0, dsn=4.4.2, status=deferred (conversation with example.com[10.0.0.01] timed out while receiving the initial server greeting)
3330             #TDsQ to=<to@localhost>, orig_to=<toalias@localhost>, relay=none, delay=238024, status=deferred (delivery temporarily suspended: transport is unavailable)
3331
3332             # XXX postfix reports dsn=5.0.0, host's reply may contain its own dsn's such as 511 and #5.1.1
3333             # XXX should these be used instead?
3334             #TDsQ to=<to@sample.net>, relay=sample.net[10.0.0.1]:25, delay=5.7, delays=0.05/0.02/5.3/0.3, dsn=4.7.1, status=deferred (host sample.net[10.0.0.1] said: 450 4.7.1 <to@sample.net>: Recipient address rejected: Greylisted (in reply to RCPT TO command))
3335             #TDsQ to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=79799, delays=79797/0.02/0.4/1.3, dsn=4.0.0, status=deferred (host example.com[10.0.0.1] said: 450 <to@example.com>: User unknown in local recipient table (in reply to RCPT TO command))
3336             #TDsQ to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=97, delays=0.03/0/87/10, dsn=4.0.0, status=deferred (host example.com[10.0.0.1] said: 450 <to@example.com>: Recipient address rejected: undeliverable address: User unknown in virtual alias table (in reply to RCPT TO command))
3337
3338             ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3339
3340             $Totals{'deferred'}++      if ($DeferredByQid{$qid}++ == 0);
3341             $Totals{'deferrals'}++;    next unless ($Collecting{'deferrals'});
3342             $Counts{'deferrals'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3343          }
3344
3345          ### bounced
3346          elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') {
3347             # local agent
3348             #TDlQ to=<envto@example.com>,                  relay=local, delay=2.5, delays=2.1/0.22/0/0.21, dsn=5.1.1, status=bounced (unknown user: "friend")
3349
3350             # smtp agent
3351             #TDsQ to=<envto@example.com>, orig_to=<envto>, relay=sample.net[10.0.0.1]:25, delay=22, delays=0.02/0.09/22/0.07, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 551 invalid address (in reply to MAIL FROM command))
3352
3353             #TDsQ to=<envto@example.com>,                  relay=sample.net[10.0.0.1]:25, delay=11, delays=0.13/0.07/0.98/0.52, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 550 MAILBOX NOT FOUND (in reply to RCPT TO command))
3354             #TDsQ to=<envto@example.com>, orig_to=<envto>, relay=sample.net[10.0.0.1]:25, delay=22, delays=0.02/0.09/22/0.07, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 551 invalid address (in reply to MAIL FROM command))
3355
3356
3357             #TDsQ to=<envto@example.com>,                  relay=none,  delay=0.57, delays=0.57/0/0/0,      dsn=5.4.6, status=bounced (mail for sample.net loops back to myself)
3358             #TDsQ to=<>,                                   relay=none,  delay=1,                                       status=bounced (mail for sample.net loops back to myself)
3359             #TDsQ to=<envto@example.com>,                  relay=none,  delay=0,                                       status=bounced (Host or domain name not found. Name service error for name=unknown.com type=A: Host not found)
3360             # XXX verify these...
3361             #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=none, delay=1, status=bounced (User unknown in virtual alias table)
3362             #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=sample.net[192.168.0.1], delay=1.1, status=bounced (User unknown in relay recipient table)
3363             #TD D8962E54: to=<anyone@example.com>, relay=local, conn_use=2 delay=0.21, delays=0.05/0.02/0/0.14, dsn=4.1.1, status=SOFTBOUNCE (unknown user: "to")
3364             #TD F031C832: to=<to@sample.net>, orig_to=<alias@sample.net>, relay=local, delay=0.17, delays=0.13/0.01/0/0.03, dsn=5.1.1, status=bounced (unknown user: "to")
3365
3366             #TD C76431E2: to=<login@sample.net>, relay=local, delay=2, status=SOFTBOUNCE (host sample.net[192.168.0.1] said: 450 <login@sample.com>: User unknown in local recipient table (in reply to RCPT TO command))
3367             #TD 04B0702E: to=<anyone@example.com>, relay=example.com[10.0.0.1]:25, delay=12, delays=6.5/0.01/0.03/5.1, dsn=5.1.1, status=bounced (host example.com[10.0.0.1] said: 550 5.1.1 User unknown (in reply to RCPT TO command))
3368             #TD 9DAC8B2D: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=1.4, delays=0.04/0/0.27/1.1, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 511 sorry, no mailbox here by that name (#5.1.1 - chkuser) (in reply to RCPT TO command))
3369             #TD 79CB702D: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=0.3, delays=0.04/0/0.61/0.8, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 550 <to@example.com>, Recipient unknown (in reply to RCPT TO command))
3370             #TD 88B7A079: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=45, delays=0.03/0/5.1/40, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 550-"The recipient cannot be verified.  Please check all recipients of this 550 message to verify they are valid." (in reply to RCPT TO command))
3371             #TD 47B7B074: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=6.6, delays=6.5/0/0/0.11, dsn=5.1.1, status=bounced (host example.com[10.0.0.1] said: 550 5.1.1 <to@example.com> User unknown; rejecting (in reply to RCPT TO command))
3372             #TDppQ to=<withheld>, relay=dbmail-pipe, delay=0.15, delays=0.09/0.01/0/0.06, dsn=5.3.0, status=bounced (Command died with signal 11: "/usr/sbin/dbmail-smtp")
3373
3374
3375             # See same code elsewhere "Note: Bounce"
3376             ### local bounce
3377             # XXX local v. remote bounce seems iffy, relative
3378             if ($relay =~ /^(?:none|local|virtual|127\.0\.0\.1|maildrop|avcheck)/) {
3379                $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'});
3380                $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($p1)}{$localpart}++;
3381             }
3382             else {
3383                $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'});
3384                ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3385                $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
3386             }
3387          }
3388
3389
3390          elsif ($status =~ 'undeliverable') {
3391             #TDsQ to=<u@example.com>, relay=sample.com[10.0.0.1], delay=0, dsn=5.0.0, status=undeliverable (host sample.com[10.0.0.1] refused to talk to me: 554 5.7.1 example.com Connection not authorized)
3392             #TDsQ to=<to@example.com>, relay=mx.example.com[10.0.0.1]:25, conn_use=2, delay=5.5, delays=0.03/0/0.21/5.3, dsn=5.0.0, status=undeliverable-but-not-cached (host mx.example.com[10.0.0.1] said: 550 RCPT TO:<to@example.com> User unknown (in reply to RCPT TO command))
3393             #TDvQ to=<u@example.com>, relay=virtual, delay=0.14, delays=0.06/0/0/0.08, dsn=5.1.1, status=undeliverable (unknown user: "u@example.com")
3394             #TDlQ to=<to@example.com>, relay=local, delay=0.02, delays=0.01/0/0/0, dsn=5.1.1, status=undeliverable-but-not-cached (unknown user: "to")
3395             $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'});
3396             if ($p1 =~ /^unknown user: ".+?"$/) {
3397                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{'Unknown user'}{$domainpart}{$localpart}{$origto ? $origto : ''}++;
3398             }
3399             else {
3400                my ($reply,$fmthost) = cleanhostreply($p1,'',$to ne '' ? $to : '<>',$domainpart);
3401                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3402             }
3403          }
3404
3405          elsif ($status eq 'deliverable') {
3406             # address verification, sendmail -bv deliverable reports
3407             #TDvQ to=<u@example.com>, relay=virtual, delay=0.09, delays=0.03/0/0/0.06, dsn=2.0.0, status=deliverable (delivers to maildir)
3408             $Totals{'deliverable'}++; next unless ($Collecting{'deliverable'});
3409             my $dsn = ($p1 =~ s/^($re_DSN) // ? $1 : '*unavailable');
3410             $Counts{'deliverable'}{$dsn}{$p1}{$origto ? "$to ($origto)" : $to}++;
3411          }
3412
3413          else {
3414             # keep this as the last condition in this else clause
3415             inc_unmatched('unknownstatus');
3416          }
3417       } # end of sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3418
3419       # pickup
3420       elsif ($p1 =~ /^(uid=\S* from=<.*?>)/) {
3421          #TDpQ2 uid=0 from=<root>
3422          $AcceptedByQid{$qid} = $1;
3423          $Totals{'msgsaccepted'}++;
3424       }
3425
3426       elsif ($p1 =~ /^from=<(.*?)>, status=expired, returned to sender$/) {
3427          #TDqQ from=<from@example.com>, status=expired, returned to sender
3428          $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'});
3429          $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++;
3430       }
3431
3432       elsif ($p1 =~ s/^host ([^[]+)\[([^]]+)\](?::\d+)? refused to talk to me://) {
3433          #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 553 Connections are being blocked due to previous incidents of abuse
3434          #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 501 Connection from 192.168.2.1 (XY) rejected
3435          # Note: See ConnectToFailure above
3436          $Totals{'connecttofailure'}++; next unless ($Collecting{'connecttofailure'});
3437          $Counts{'connecttofailure'}{'Refused to talk to me'}{formathost($2,$1)}{$p1}++;
3438       }
3439
3440       elsif ($p1 =~ /^lost connection with ([^[]*)\[([^]]+)\](?::\d+)? (while .*)$/) {
3441          # outbound smtp
3442          #TDsQ lost connection with sample.net[10.0.0.1] while sending MAIL FROM
3443          #TDsQ lost connection with sample.net[10.0.0.2] while receiving the initial server greeting
3444          $Totals{'connectionlostoutbound'}++; next unless ($Collecting{'connectionlostoutbound'});
3445          $Counts{'connectionlostoutbound'}{ucfirst($3)}{formathost($2,$1)}++;
3446       }
3447
3448       elsif ($p1 =~ /^conversation with ([^[]*)\[([^]]+)\](?::\d+)? timed out (while .*)$/) {
3449          #TDsQ conversation with sample.net[10.0.0.1] timed out while receiving the initial SMTP greeting
3450          # Note: see TimeoutInbound below
3451          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3452          $Counts{'timeoutinbound'}{ucfirst($3)}{formathost($2,$1)}{''}++;
3453       }
3454
3455       elsif ($p1 =~ /^enabling PIX (<CRLF>\.<CRLF>) workaround for ([^[]+)\[([^]]+)\](?::\d+)?/ or
3456              $p1 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[([^]]+)\](?::\d+)?/) {
3457          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for example.com[192.168.0.1]
3458          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for mail.sample.net[10.0.0.1]:25
3459          #TDsQ enabling PIX workarounds: disable_esmtp delay_dotcrlf for spam.example.org[10.0.0.1]:25
3460          $Totals{'pixworkaround'}++; next unless ($Collecting{'pixworkaround'});
3461          $Counts{'pixworkaround'}{$1}{formathost($3,$2)}++;
3462       }
3463
3464       # milter-reject, milter-hold, milter-discard
3465       elsif ($p1 =~ s/^milter-//) {
3466          milter_common($p1);
3467       }
3468
3469       elsif ($p1 =~ s/^SASL (\[CACHED\] )?authentication failed; //) {
3470          #TDsQ SASL authentication failed; cannot authenticate to server smtp.example.com[10.0.0.1]: no mechanism available
3471          #TDsQ SASL authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3472          #TDsQ SASL [CACHED] authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3473          # see saslauthfail elsewhere
3474
3475          $Totals{'saslauthfail'}++; next unless ($Collecting{'saslauthfail'});
3476          my $cached = $1;
3477
3478          if ($p1 =~ /^(authentication protocol loop with server): ([^[]+)\[([^]]+)\](?::\d+)?$/) {
3479             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,'');
3480          }
3481          elsif ($p1 =~ /^(cannot authenticate to server) ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
3482             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,$4);
3483          }
3484          elsif ($p1 =~ /^server ([^[]+)\[([^]]+)\](?::\d+)? said: (.+)$/) {
3485             ($reason,$host,$hostip,$reason2) = ('server ... said',$1,$2,$3);
3486          }
3487          else {
3488             inc_unmatched('saslauthfail');
3489             next;
3490          }
3491
3492          $reason .= ': ' . $reason2  if $reason2;
3493          $Counts{'saslauthfail'}{$cached . $reason}{formathost($hostip,$host)}++;
3494       }
3495
3496       else {
3497          # keep this as the last condition in this else clause
3498          inc_unmatched('unknownqid')  if  ! in_ignore_list ($p1);
3499       }
3500    }
3501    # end of $re_QID section
3502
3503    elsif ($p1 =~ /^(timeout|lost connection) (after [^ ]+)(?: \((?:approximately )?(\d+) bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3504       my ($lort,$reason,$bytes,$host,$hostip) = ($1,$2,$3,$4,$5);
3505       if ($lort eq 'timeout') {
3506          # see also TimeoutInbound in $re_QID section
3507          #TDsd timeout after RSET from example.com[192.168.0.1]
3508          #TDsd timeout after DATA (6253 bytes) from example.com[10.0.0.1]
3509
3510          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3511          $Counts{'timeoutinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3512       } else {
3513          #TDsd lost connection after CONNECT from mail.example.com[192.168.0.1]
3514          # postfix 2.5:20071003
3515          #TDsd lost connection after DATA (494133 bytes) from localhost[127.0.0.1]
3516          # postfix 2.6:20080621
3517          #TDsd lost connection after DATA (approximately 0 bytes) from example.com[10.0.0.1]
3518
3519          $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'});
3520          $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3521       }
3522    }
3523
3524    elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ($re_DSN) Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/o) {
3525       my ($rej_type,$host,$hostip,$dsn,)  = ($1,$2,$3,$4);
3526       ($site,$reason) = ($5 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3527       $reason =~ s/^reason: // if ($reason);
3528       $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn));
3529       # Note: similar code above: search RejectRBL
3530
3531       # This section required: postfix didn't always log QID (eg. postfix 1.1)
3532       # Also, "reason:" was probably always present in this case, but I'm not certain
3533       # postfix 1.1
3534       #TDsd reject_warning: RCPT from example.com[10.0.0.1]: 554 Service unavailable; [10.0.0.1] blocked using orbz.org, reason: Open relay. Please see http://orbz.org/?10.0.0.1; from=<from@example.com> to=<to@sample.net>
3535       #TDsd reject: RCPT from example.com[10.0.0.2]: 554 Service unavailable; [10.0.0.2] blocked using orbz.org, reason: Open relay. Please see http://orbz.org/?10.0.0.2; from=<from@example.com> to=<to@example.net>
3536       #TDsd reject: RCPT from unknown[10.0.0.3]: 554 Service unavailable; [10.0.0.3] blocked using bl.spamcop.net, reason: Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.3; from=<from@example.net> to=<to@example.com>
3537       #TDsd reject: RCPT from example.com[10.0.0.4]: 554 Service unavailable; [10.0.0.4] blocked using sbl.spamhaus.org, reason: http://www.spamhaus.org/SBL/sbl.lasso?query=B12057; from=<from@example.net> to=<to@example.com>
3538
3539       if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
3540          $fmthost = formathost($hostip,$host);
3541          $Counts{'byiprejects'}{$fmthost}++;
3542       }
3543
3544       $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3545       $Counts{$reject_name}{$site}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reason ? $reason : ''}++;
3546    }
3547
3548    # proxy-reject, proxy-accept
3549    elsif ($p1 =~ s/^proxy-(reject|accept): ([^:]+): //) {
3550       # 2.7
3551       #TDsdN proxy-accept: END-OF-MESSAGE: 250 2.0.0 Ok: queued as 9BE3547AFE; from=<senderexample.com> to=<recipientexample.com> proto=ESMTP helo=<client.example.com>
3552       #TDsdN proxy-reject: END-OF-MESSAGE: 554 5.7.0 Reject, id=11912-03 - INFECTED: Eicar-Test-Signature; from=<root@example.com> to=<root@example.net> proto=ESMTP helo=<example.com>
3553       #TDsdN proxy-reject: END-OF-MESSAGE: ; from=<user@example.com> to=<user@example.org> proto=SMTP helo=<mail.example.net>
3554
3555       next if $1 eq 'accept';    #ignore accepts
3556
3557       my ($stage) = ($2);
3558       my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
3559
3560       my ($dsn,$reject_name);
3561       ($dsn,$reply) = ($1,$2)    if $p1 =~ /^($re_DSN) (.*)$/o;
3562
3563       # DSN may not be present. Can occur, for example, when queue
3564       # file size limit is reached, which is logged as a Warning.
3565       # Ignore these, since they can't be add to any reject section
3566       # (no SMTP reply code).
3567       if (! defined $dsn) {
3568          next;
3569       }
3570
3571       $Totals{$reject_name = get_reject_key($dsn) . 'rejectproxy' }++; next unless ($Collecting{$reject_name});
3572       $Counts{$reject_name}{$stage}{$reply}{$eto}++;
3573    }
3574
3575    ### smtpd_tls_loglevel >= 1
3576    # Server TLS messages
3577    elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/)) {
3578       #TDsd TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3579       # Postfix 2.5+: status: Untrusted or Trusted
3580       #TDsd Untrusted TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3581       #TDsd Anonymous TLS connection established from localhost[127.0.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3582
3583       $Totals{'tlsserverconnect'}++; next unless ($Collecting{'tlsserverconnect'});
3584       $Counts{'tlsserverconnect'}{$status ? "$status: $type" : $type}{formathost($hostip,$host)}++;
3585    }
3586
3587    # Client TLS messages
3588    elsif ( ($status,$host,$type) = ($p1 =~ /^(?:(Verified|Trusted|Untrusted|Anonymous) )?TLS connection established to ([^ ]*): (.*)$/o)) {
3589       #TD TLS connection established to example.com: TLSv1 with cipher AES256-SHA (256/256 bits)
3590       # Postfix 2.5+: peer verification status: Untrusted, Trusted or Verified when
3591       # server's trust chain is valid and peername is matched
3592       #TD Verified TLS connection established to 127.0.0.1[127.0.0.1]:26: TLSv1 with cipher DHE-DSS-AES256-SHA (256/256 bits)
3593
3594       $Totals{'tlsclientconnect'}++; next unless ($Collecting{'tlsclientconnect'});
3595       $Counts{'tlsclientconnect'}{$status ? "$status: $type" : $type}{$host}++;
3596    }
3597
3598    # smtp_tls_note_starttls_offer=yes
3599    elsif ($p1 =~ /^Host offered STARTTLS: \[(.*)\]$/o) {
3600       #TD Host offered STARTTLS: [mail.example.com]
3601       $Totals{'tlsoffered'}++; next unless ($Collecting{'tlsoffered'});
3602       $Counts{'tlsoffered'}{$1}++;
3603    }
3604
3605    ### smtpd_tls_loglevel >= 1
3606    elsif ($p1 =~ /^Unverified: (.*)/o) {
3607       #TD Unverified: subject_CN=(www|smtp|mailhost).(example.com|sample.net), issuer=someuser
3608       $Totals{'tlsunverified'}++; next unless ($Collecting{'tlsunverified'});
3609       $Counts{'tlsunverified'}{$1}++;
3610    }
3611
3612    # Note: no QID
3613    elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<(.*?)> to=<(.*?)>/)) {
3614       #TD reject: RCPT from size.example.com[192.168.0.1]: 452 Message size exceeds fixed limit; from=<from@example.com> to=<to@sample.net>
3615       #TD reject: RCPT from size.example.com[192.168.0.1]: 552 Message size exceeds fixed limit; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<example.com>
3616       # Note: similar code above: search RejectSize
3617       # Note: reject_warning does not seem to occur
3618       if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
3619          $fmthost = formathost($hostip,$host);
3620          $Counts{'byiprejects'}{$fmthost}++;
3621       }
3622       $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name});
3623       $Counts{$reject_name}{$fmthost ? $fmthost : formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++;
3624    }
3625
3626    elsif ($p1 =~ /looking for plugins in (.*)$/) {
3627     #TD looking for plugins in '/usr/lib/sasl2', failed to open directory, error: No such file or directory
3628       $Totals{'warnconfigerror'}++; next unless ($Collecting{'warnconfigerror'});
3629       $Counts{'warnconfigerror'}{$1}++;
3630    }
3631
3632    # SMTP/ESMTP protocol violations
3633    elsif ($p1 =~ /^(improper command pipelining) (after \S+) from ([^[]*)\[([^]]+)\](?::\d+)?/) {
3634       # ProtocolViolation
3635       #TDsd postfix/smtpd[24928]: improper command pipelining after RCPT from unknown[192.168.0.1]
3636       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3637       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3638       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3639    }
3640
3641    elsif ($p1 =~ /^(too many errors) (after [^ ]*)(?: \((?:approximately )?\d+ bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3642       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3643       #TDsd too many errors after AUTH from sample.net[10.0.0.1]
3644       #TDsd too many errors after DATA (0 bytes) from 1-0-0-10.example.com[10.0.0.1]
3645       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3646       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3647    }
3648
3649    # coerce these into general warnings
3650    elsif ( $p1 =~ /^cannot load Certificate Authority data/ or
3651            $p1 =~ /^SSL_connect error to /)
3652    {
3653       #TDsQ Cannot start TLS: handshake failure
3654       #TDsd cannot load Certificate Authority data
3655       #TDs SSL_connect error to mail.example.com: 0
3656
3657       postfix_warning($p1);
3658    }
3659
3660    else {
3661       # add to the unmatched list if not on the ignore_list
3662       inc_unmatched('final')   if ! in_ignore_list ($p1);
3663    }
3664 }
3665
3666 ########################################
3667 # Final tabulations, and report printing
3668
3669 for my $code (@RejectKeys) {
3670    for my $type (@RejectClasses) {
3671       $Totals{'totalrejects' . $code} += $Totals{$code . $type};
3672    }
3673
3674    if ($code =~ /^5/o) {
3675       $Totals{'totalrejects'} += $Totals{'totalrejects' . $code};
3676    }
3677 }
3678
3679 # XXX this was naive - the goal was to avoid recounting messages
3680 # released from quarantine, but externally introduced messages may
3681 # contain resent-message-id; trying to track only internally resent
3682 # messages does not seem useful.
3683 # make some corrections now, due to double counting
3684 #$Totals{'msgsaccepted'} -= $Totals{'resent'}   if ($Totals{'msgsaccepted'} >= $Totals{'resent'});
3685
3686 $Totals{'totalacceptplusreject'} = $Totals{'msgsaccepted'} + $Totals{'totalrejects'};
3687
3688 # Print the Summary report if any key has non-zero data.
3689 # Note: must explicitely check for any non-zero data,
3690 # as Totals always has some keys extant.
3691 #
3692 if ($Opts{'summary'}) {
3693    for (keys %Totals) {
3694       if ($Totals{$_}) {
3695          print_summary_report (@Sections);
3696          last;
3697       }
3698    }
3699 }
3700
3701 # Print the Detail report, if detail is sufficiently high
3702 #
3703 if ($Opts{'detail'} >= 5) {
3704    print_detail_report(@Sections);
3705
3706    if ($Opts{'delays'}) {
3707       my @table;
3708       for (sort keys %Delays) {
3709          # anon array ref: label, array ref of $Delay{key}
3710          push @table, [ substr($_,3), $Delays{$_} ];
3711       }
3712       if (@table) {
3713          print_percentiles_report2(\@table, "Delivery Delays Percentiles", $Opts{'delays_percentiles'});
3714       }
3715    }
3716
3717    print_postgrey_reports();
3718
3719 }
3720
3721 # Finally, print any unmatched lines
3722 #
3723 print_unmatched_report();
3724
3725 #
3726 # End of main
3727 #
3728 ##################################################
3729
3730 # Create the list of REs against which log lines are matched.
3731 # Lines that match any of the patterns in this list are ignored.
3732 #
3733 # Note: This table is created at runtime, due to a Perl bug which
3734 # I reported as perl bug #56202:
3735 #
3736 #    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
3737 #
3738 sub create_ignore_list() {
3739    # top 3 hitters up front
3740    push @ignore_list, qr/^statistics:/;
3741    push @ignore_list, qr/^setting up TLS connection (?:from|to)/;
3742    push @ignore_list, qr/^Verified: /;
3743    push @ignore_list, qr/^skipped, still being delivered/;
3744
3745    # SSL info at/above mail.info level
3746    push @ignore_list, qr/^read from [a-fA-F\d]{8}/;
3747    push @ignore_list, qr/^write to [a-fA-F\d]{8}/;
3748    push @ignore_list, qr/^[a-f\d]{4} [a-f\d]{2}/;
3749    push @ignore_list, qr/^[a-f\d]{4} - <SPACES/;
3750    push @ignore_list, qr/^[<>]+ /;
3751
3752    push @ignore_list, qr/^premature end-of-input (?:on|from) .* socket while reading input attribute name$/;
3753    push @ignore_list, qr/^certificate peer name verification failed/;
3754    push @ignore_list, qr/^Peer certi?ficate could not be verified$/;   # missing i was a postfix typo
3755    push @ignore_list, qr/^Peer cert verify depth=/;
3756    push @ignore_list, qr/^Peer verification:/;
3757    push @ignore_list, qr/^Server certificate could not be verified/;
3758    push @ignore_list, qr/^cannot load .SA certificate and key data/;
3759    push @ignore_list, qr/^tlsmgr_cache_run_event/;
3760    push @ignore_list, qr/^SSL_accept/;
3761    push @ignore_list, qr/^SSL_connect:/;
3762    push @ignore_list, qr/^connection (?:closed|established)/;
3763    push @ignore_list, qr/^delete smtpd session/;
3764    push @ignore_list, qr/^put smtpd session/;
3765    push @ignore_list, qr/^save session/;
3766    push @ignore_list, qr/^Reusing old/;
3767    push @ignore_list, qr/^looking up session/;
3768    push @ignore_list, qr/^lookup smtpd session/;
3769    push @ignore_list, qr/^lookup \S+ type/;
3770    push @ignore_list, qr/^xsasl_(?:cyrus|dovecot)_/;
3771    push @ignore_list, qr/^watchdog_/;
3772    push @ignore_list, qr/^read smtpd TLS/;
3773    push @ignore_list, qr/^open smtpd TLS/;
3774    push @ignore_list, qr/^write smtpd TLS/;
3775    push @ignore_list, qr/^read smtp TLS cache entry/;
3776    push @ignore_list, qr/^starting TLS engine$/;
3777    push @ignore_list, qr/^initializing the server-side TLS/;
3778    push @ignore_list, qr/^global TLS level: /;
3779    push @ignore_list, qr/^auto_clnt_/;
3780    push @ignore_list, qr/^generic_checks:/;
3781    push @ignore_list, qr/^inet_addr_/;
3782    push @ignore_list, qr/^mac_parse:/;
3783    push @ignore_list, qr/^cert has expired/;
3784    push @ignore_list, qr/^daemon started/;
3785    push @ignore_list, qr/^master_notify:/;
3786    push @ignore_list, qr/^rewrite_clnt:/;
3787    push @ignore_list, qr/^rewrite stream/;
3788    push @ignore_list, qr/^dict_/;
3789    push @ignore_list, qr/^send attr /;
3790    push @ignore_list, qr/^match_/;
3791    push @ignore_list, qr/^input attribute /;
3792    push @ignore_list, qr/^Run-time/;
3793    push @ignore_list, qr/^Compiled against/;
3794    push @ignore_list, qr/^private\//;
3795    push @ignore_list, qr/^reject_unknown_/;    # don't combine or shorten these reject_ patterns
3796    push @ignore_list, qr/^reject_unauth_/;
3797    push @ignore_list, qr/^reject_non_/;
3798    push @ignore_list, qr/^permit_/;
3799    push @ignore_list, qr/^idle timeout/;
3800    push @ignore_list, qr/^get_dns_/;
3801    push @ignore_list, qr/^dns_/;
3802    push @ignore_list, qr/^chroot /;
3803    push @ignore_list, qr/^process generation/;
3804    push @ignore_list, qr/^fsspace:/;
3805    push @ignore_list, qr/^master disconnect/;
3806    push @ignore_list, qr/^resolve_clnt/;
3807    push @ignore_list, qr/^ctable_/;
3808    push @ignore_list, qr/^extract_addr/;
3809    push @ignore_list, qr/^mynetworks:/;
3810    push @ignore_list, qr/^name_mask:/;
3811       #TDm reload -- version 2.6-20080814, configuration /etc/postfix
3812       #TDm reload configuration /etc/postfix
3813    push @ignore_list, qr/^reload (?:-- version \S+, )?configuration/;
3814    push @ignore_list, qr/^terminating on signal 15$/;
3815    push @ignore_list, qr/^verify error:num=/;
3816    push @ignore_list, qr/^verify return:/;
3817    push @ignore_list, qr/^nss_ldap: /;
3818    push @ignore_list, qr/^discarding EHLO keywords: /;
3819    push @ignore_list, qr/^sql auxprop plugin/;
3820    push @ignore_list, qr/^sql plugin/;
3821    push @ignore_list, qr/^sql_select/;
3822    push @ignore_list, qr/^auxpropfunc error/;
3823    push @ignore_list, qr/^commit transaction/;
3824    push @ignore_list, qr/^begin transaction/;
3825    push @ignore_list, qr/^maps_find: /;
3826    push @ignore_list, qr/^check_access: /;
3827    push @ignore_list, qr/^check_domain_access: /;
3828    push @ignore_list, qr/^check_mail_access: /;
3829    push @ignore_list, qr/^check_table_result: /;
3830    push @ignore_list, qr/^mail_addr_find: /;
3831    push @ignore_list, qr/^mail_addr_map: /;
3832    push @ignore_list, qr/^mail_flow_put: /;
3833    push @ignore_list, qr/^smtp_addr_one: /;
3834    push @ignore_list, qr/^smtp_connect_addr: /;
3835    push @ignore_list, qr/^smtp_connect_unix: trying: /;
3836    push @ignore_list, qr/^smtp_find_self: /;
3837    push @ignore_list, qr/^smtp_get: /;
3838    push @ignore_list, qr/^smtp_fputs: /;
3839    push @ignore_list, qr/^smtp_parse_destination: /;
3840    push @ignore_list, qr/^smtp_sasl_passwd_lookup: /;
3841    push @ignore_list, qr/^smtpd_check_/;
3842    push @ignore_list, qr/^smtpd_chat_notify: /;
3843    push @ignore_list, qr/^been_here: /;
3844    push @ignore_list, qr/^set_eugid: /;
3845    push @ignore_list, qr/^deliver_/;
3846    push @ignore_list, qr/^flush_send_file: queue_id/;
3847    push @ignore_list, qr/^milter_macro_lookup/;
3848    push @ignore_list, qr/^milter8/;
3849    push @ignore_list, qr/^skipping non-protocol event/;
3850    push @ignore_list, qr/^reply: /;
3851    push @ignore_list, qr/^event: /;
3852    push @ignore_list, qr/^trying... /;
3853    push @ignore_list, qr/ all milters$/;
3854    push @ignore_list, qr/^vstream_/;
3855    push @ignore_list, qr/^server features/;
3856    push @ignore_list, qr/^skipping event/;
3857    push @ignore_list, qr/^Using /;
3858    push @ignore_list, qr/^rec_(?:put|get): /;
3859    push @ignore_list, qr/^subject=/;
3860    push @ignore_list, qr/^issuer=/;
3861    push @ignore_list, qr/^pref  /;  # yes, multiple spaces
3862    push @ignore_list, qr/^request: \d/;
3863    push @ignore_list, qr/^done incoming queue scan$/;
3864    push @ignore_list, qr/^qmgr_/;
3865    push @ignore_list, qr/^trigger_server_accept_fifo: /;
3866    push @ignore_list, qr/^proxymap stream/;
3867    push @ignore_list, qr/^(?:start|end) sorted recipient list$/;
3868    push @ignore_list, qr/^connecting to \S+ port /;
3869    push @ignore_list, qr/^Write \d+ chars/;
3870    push @ignore_list, qr/^Read \d+ chars/;
3871    push @ignore_list, qr/^(?:lookup|delete) smtp session/;
3872    push @ignore_list, qr/^delete smtp session/;
3873    push @ignore_list, qr/^(?:reloaded|remove|looking for) session .* cache$/;
3874    push @ignore_list, qr/^(?:begin|end) \S+ address list$/;
3875    push @ignore_list, qr/^mapping DSN status/;
3876    push @ignore_list, qr/^record [A-Z]/;
3877    push @ignore_list, qr/^dir_/;
3878    push @ignore_list, qr/^transport_event/;
3879    push @ignore_list, qr/^read [A-Z](?: |$)/;
3880    push @ignore_list, qr/^relay: /;
3881    push @ignore_list, qr/^why: /;
3882    push @ignore_list, qr/^fp: /;
3883    push @ignore_list, qr/^path: /;
3884    push @ignore_list, qr/^level: /;
3885    push @ignore_list, qr/^recipient: /;
3886    push @ignore_list, qr/^delivered: /;
3887    push @ignore_list, qr/^queue_id: /;
3888    push @ignore_list, qr/^queue_name: /;
3889    push @ignore_list, qr/^user: /;
3890    push @ignore_list, qr/^sender: /;
3891    push @ignore_list, qr/^offset: /;
3892    push @ignore_list, qr/^offset: /;
3893    push @ignore_list, qr/^verify stream disconnect/;
3894    push @ignore_list, qr/^event_request_timer: /;
3895    push @ignore_list, qr/^smtp_sasl_authenticate: /;
3896    push @ignore_list, qr/^flush_add: /;
3897    push @ignore_list, qr/^disposing SASL state information/;
3898    push @ignore_list, qr/^starting new SASL client/;
3899    push @ignore_list, qr/^error: dict_ldap_connect: /;
3900    push @ignore_list, qr/^error: to submit mail, use the Postfix sendmail command/;
3901    push @ignore_list, qr/^local_deliver[:[]/;
3902    push @ignore_list, qr/^_sasl_plugin_load /;
3903    push @ignore_list, qr/^exp_type: /;
3904    push @ignore_list, qr/^wakeup [\dA-Z]/;
3905    push @ignore_list, qr/^defer (?:site|transport) /;
3906    push @ignore_list, qr/^local: /;
3907    push @ignore_list, qr/^exp_from: /;
3908    push @ignore_list, qr/^extension: /;
3909    push @ignore_list, qr/^owner: /;
3910    push @ignore_list, qr/^unmatched: /;
3911    push @ignore_list, qr/^domain: /;
3912    push @ignore_list, qr/^initializing the client-side TLS engine/;
3913    push @ignore_list, qr/^header_token: /;
3914    push @ignore_list, qr/^(?:PUSH|POP) boundary/;
3915    push @ignore_list, qr/^recipient limit \d+$/;
3916    push @ignore_list, qr/^scan_dir_next: found/;
3917    push @ignore_list, qr/^open (?:btree|incoming)/;
3918    push @ignore_list, qr/^Renamed to match inode number/;
3919    push @ignore_list, qr/^cleanup_[^:]+:/;
3920    push @ignore_list, qr/^(?:before|after) input_transp_cleanup: /;
3921    push @ignore_list, qr/^event_enable_read: /;
3922    push @ignore_list, qr/^report recipient to all milters /;
3923    push @ignore_list, qr/_action = defer_if_permit$/;
3924    push @ignore_list, qr/^reject_invalid_hostname: /;
3925    push @ignore_list, qr/^cfg_get_/;
3926    push @ignore_list, qr/^sacl_check: /;
3927
3928    # non-anchored
3929    #push @ignore_list, qr/: Greylisted for /;
3930    push @ignore_list, qr/certificate verification (?:depth|failed for)/;
3931    push @ignore_list, qr/re-using session with untrusted certificate, look for details earlier in the log$/;
3932    push @ignore_list, qr/socket: wanted attribute: /;
3933    push @ignore_list, qr/ smtpd cache$/;
3934    push @ignore_list, qr/ old session$/;
3935    push @ignore_list, qr/fingerprint=/;
3936    push @ignore_list, qr/TLS cipher list "/;
3937 }
3938
3939 # Evaluates a given line against the list of ignore patterns.
3940 #
3941 sub in_ignore_list($) {
3942    my $line = shift;
3943
3944    foreach (@ignore_list) {
3945       if ($line =~ /$_/) {
3946          return 1;
3947       }
3948    }
3949
3950    return 0;
3951 }
3952
3953 # Accepts common fields from a standard delivery attempt, processing then
3954 # and returning modified values
3955 #
3956 sub process_delivery_attempt ($ $ $ $) {
3957    my ($to,$origto,$DDD,$reason) = @_;
3958
3959    $reason =~ s/\((.*)\)/$1/;   # Makes capturing nested parens easier
3960    # leave $to/$origto undefined, or strip < > chars if not null address (<>).
3961    defined $to     and $to =     ($to eq '')     ? '<>' : lc $to;
3962    defined $origto and $origto = ($origto eq '') ? '<>' : lc $origto;
3963    my ($localpart, $domainpart) = split ('@', $to);
3964    ($localpart, $domainpart) = ($to, '*unspecified')   if ($domainpart eq '');
3965    my ($dsn);
3966
3967    # If recipient_delimiter is set, break localpart into user + extension
3968    # and save localpart in origto if origto is empty
3969    #
3970    if ($Opts{'recipient_delimiter'} and $localpart =~ /\Q$Opts{'recipient_delimiter'}\E/o) {
3971
3972       # special cases: never split mailer-daemon or double-bounce
3973       # or owner- or -request if delim is "-" (dash).
3974       unless ($localpart =~ /^(?:mailer-daemon|double-bounce)$/i or
3975           ($Opts{'recipient_delimiter'} eq '-' and $localpart =~ /^owner-.|.-request$/i)) {
3976          my ($user,$extension) = split (/\Q$Opts{'recipient_delimiter'}\E/, $localpart, 2);
3977          $origto = $localpart    if ($origto eq '');
3978          $localpart = $user;
3979       }
3980    }
3981
3982    unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) {
3983       $dsn = '';
3984    }
3985
3986    if ($Collecting{'delays'} and $DDD =~ m{delay=([\d.]+)(?:, delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+))?}) {
3987       # Message delivery time stamps
3988       # delays=a/b/c/d, where
3989       #   a = time before queue manager, including message transmission
3990       #   b = time in queue manager
3991       #   c = connection setup including DNS, HELO and TLS;
3992       #   d = message transmission time.
3993       if (defined $2) {
3994          $Delays{'1: Before qmgr'}{$2}++;
3995          $Delays{'2: In qmgr'}{$3}++;
3996          $Delays{'3: Conn setup'}{$4}++;
3997          $Delays{'4: Transmission'}{$5}++;
3998       }
3999       $Delays{'5: Total'}{$1}++;
4000    }
4001
4002    return ($to,$origto,$localpart,$domainpart,$dsn,$reason);
4003 }
4004
4005 # Processes postfix/bounce messages
4006 #
4007 sub postfix_bounce($) {
4008    my $line = shift;
4009    my $type;
4010
4011    $line =~ s/^(?:$re_QID): //o;
4012    if ($line =~ /^(sender|postmaster) non-delivery notification/o) {
4013       #TDbQ postmaster non-delivery notification: 7446BCD68
4014       #TDbQ sender non-delivery notification: 7446BCD68
4015       $type = 'Non-delivery';
4016    }
4017    elsif ($line =~ /^(sender|postmaster) delivery status notification/o ) {
4018       #TDbQ sender delivery status notification: 7446BCD68
4019       $type = 'Delivery';
4020    }
4021    elsif ($line =~ /^(sender|postmaster) delay notification: /o) {
4022       #TDbQ sender delay notification: AA61EC2F9A
4023       $type = 'Delayed';
4024    }
4025    else {
4026       inc_unmatched('bounce')   if ! in_ignore_list($line);
4027       return;
4028    }
4029
4030    $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'});
4031    $Counts{'notificationsent'}{$type}{$1}++;
4032 }
4033
4034 # Processes postfix/cleanup messages
4035 #   cleanup always has a QID
4036 #
4037 sub postfix_cleanup($) {
4038    my $line = shift;
4039    my ($qid,$reply,$fmthost,$reject_name);
4040
4041    ($qid, $line) = ($1, $2)  if ($line =~ /^($re_QID): (.*)$/o );
4042
4043    #TDcQ message-id=<C1BEA2A0.188572%from@example.com>
4044    return if ($line =~ /^message-id=/);
4045
4046    # milter-reject, milter-hold, milter-discard
4047    if ($line =~ s/^milter-//) {
4048       milter_common($line);
4049       return;
4050    }
4051
4052    ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps)
4053    # Note: Bounce
4054    #   See same code elsewhere "Note: Bounce"
4055    #TDcQ to=<envto@example.com>,                  relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text...
4056    #TDcQ to=<envto@example.com>, orig_to=<envto>, relay=none, delay=0.13, delays=0.13/0/0/0, dsn=5.7.1, status=bounced optional text...
4057    if ($line =~ /^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o) {
4058       # ($to,$origto,$relay,$DDD,$status,$reason) = ($1,$2,$3,$4,$5,$6);
4059       if ($5 ne 'bounced' and $5 ne 'SOFTBOUNCE') {
4060          inc_unmatched('cleanupbounce');
4061          return;
4062       }
4063
4064       my ($to,$origto,$relay,$DDD,$reason) = ($1,$2,$3,$4,$6);
4065       my ($localpart,$domainpart,$dsn);
4066       ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$DDD,$reason);
4067
4068       ### local bounce
4069       # XXX local v. remote bounce seems iffy, relative
4070       if ($relay =~ /^(?:none|local|virtual|maildrop|127\.0\.0\.1|avcheck)/) {
4071          $Totals{'bouncelocal'}++; return unless ($Collecting{'bouncelocal'});
4072          $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++;
4073       }
4074       ### remote bounce
4075       else {
4076          ($reply,$fmthost) = cleanhostreply($reason,$relay,$to ne '' ? $to : '<>',$domainpart);
4077          $Totals{'bounceremote'}++; return unless ($Collecting{'bounceremote'});
4078          $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
4079       }
4080    }
4081
4082    # *header_checks and body_checks
4083    elsif (header_body_checks($line)) {
4084       return;
4085    }
4086
4087    #TDcQ resent-message-id=4739073.1
4088    #TDcQ resent-message-id=<ARF+DXZwLECdxm@mail.example.com>
4089    #TDcQ resent-message-id=<B19-DVD42188E0example.com>?    <120B11@samplepc>
4090    elsif ( ($line =~ /^resent-message-id=<?.+>?$/o  )) {
4091       $Totals{'resent'}++;
4092    }
4093
4094    #TDcN unable to dlopen .../sasl2/libplain.so.2: .../sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted
4095    elsif ($line =~ /^unable to dlopen /) {
4096       # strip extraneous doubling of library path
4097       $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/);
4098       postfix_warning($line);
4099    }
4100
4101    else {
4102       inc_unmatched('cleanup(last)')   if ! in_ignore_list($line);
4103    }
4104 }
4105
4106 =pod
4107  header_body_checks
4108
4109   Handle cleanup's header_checks and body_checks, and smtp's smtp_body_checks/smtp_*header_checks
4110
4111   Possible actions that log are:
4112
4113      REJECT optional text...
4114      DISCARD optional text...
4115      FILTER transport:destination
4116      HOLD optional text...
4117      REDIRECT user@domain
4118      PREPEND text...
4119      REPLACE text...
4120      WARN optional text...
4121
4122      DUNNO and IGNORE are not logged
4123
4124 Returns:
4125    1: if line matched or handled
4126    0: otherwise
4127 =cut
4128
4129 sub header_body_checks($)
4130 {
4131    my $line = shift;
4132
4133    # bcc, discard, filter, hold, prepend, redirect, reject, replace, warning
4134    return 0 if ($line !~ /^[bdfhprw]/) or   # short circuit alternation when no match possible
4135                ($line !~ /^(re(?:ject|direct|place)|filter|hold|discard|prepend|warning|bcc): (header|body|content) (.*)$/);
4136
4137    my ($action,$part,$p3) = ($1,$2,$3);
4138
4139    my ($trigger,$host,$eto,$p4,$fmthost,$reject_name);
4140    # $re_QID: reject: body ...
4141    # $re_QID: reject: header ...
4142    # $re_QID: reject: content ...
4143
4144
4145    if ($p3 =~ /^(.*) from ([^;]+); from=<.*?>(?: to=<(.*?)>)?(?: proto=\S*)?(?: helo=<.*?>)?(?:: (.*)|$)/) {
4146       ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4);
4147
4148       #    $action   $part  $trigger                                 $host                                              $eto                                                $p4
4149       #TDcQ reject:   body   Subject: Cheap cialis               from local;                    from=<root@localhost>:                                                       optional text...
4150       #TDcQ reject:   body   Quality replica watches!!!          from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>: optional text...
4151       #TDcQ reject:   header To: <user@example.com>              from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4152       # message_reject_characters (postfix >= 2.3)
4153       #TDcQ reject:   content Received: by example.com Postfix   from example.com[10.0.0.1];    from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=.example.com>: 5.7.1 disallowed character
4154
4155       #TDcQ filter:   header To: to@example.com                  from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: transport:destination
4156       #TDcQ hold:     header Message-ID: <user@example.com>      from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4157       #TDcQ hold:     header Subject: Hold Test                  from local;                    from=<efrom@example.com> to=<eto@sample.net>:                                optional text...
4158       #TDcQ hold:     header Received: by example.com...from x   from local;                    from=<efrom@example.com>
4159       #TDcQ hold:     header Received: from x.com (x.com[10.0.0.1])??by example.com (Postfix) with ESMTP id 630BF??for <X>; Thu, 20 Oct 2006 13:27: from example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>
4160       #      hold:     header Received: from [10.0.0.1] by example.com Thu, 9 Jan 2008 18:06:06 -0500 from sample.net[10.0.0.2]; from=<> to=<to@example.com> proto=SMTP helo=<sample.net>: faked header
4161       #TDcQ redirect: header From: "Attn Men" <attn@example.com> from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4162       #TDcQ redirect: header From: "Superman" <attn@example.com> from hb.example.com[10.0.0.2]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4163       #TDcQ redirect: body   Original drugs                      from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>: user@domain
4164       #TDcQ discard:  header Subject: **SPAM** Blah...           from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>
4165       #TDcQ prepend:  header Rubble: Mr.                         from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: text...
4166       #TDcQ replace:  header Rubble: flintstone                  from localhost[127.0.0.1];     from=<efrom@apple.com>   to=<eto@sample.net> proto=ESMTP helo=<example.com>: text...
4167       #TDcQ warning:  header Date: Tues, 99:34:67                from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4168       # BCC action (2.6 experimental branch)
4169       #TDcQ bcc:      header To: to@example.com                  from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4170
4171       # Note: reject_warning does not seem to occur
4172    }
4173
4174    else {
4175       # smtp_body_checks, smtp_header_checks, smtp_mime_header_checks, smtp_nested_header_checks (postfix >= 2.5)
4176       #TDsQ replace:  header Sender:   <from@example.com>                                                                                                                  : Sender:   <fm2@sample.net>
4177
4178       $trigger = $p3; $host = ''; $eto = ''; $p4 = $part eq 'body' ? 'smtp_body_checks' : 'smtp_*header_checks';
4179
4180       #inc_unmatched('header_body_checks');
4181       #return 1;
4182    }
4183
4184    $trigger =~ s/\s+/ /g;
4185    $trigger = '*unknown reason'    if ($trigger eq '');
4186    $eto     = '*unknown'           if ($eto     eq '');
4187
4188    my ($trig,$trig_opt,$text);
4189    if    ($part eq 'header')               { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; }
4190    elsif ($part eq 'body')                 { $trig = "Body check"; }
4191    else                                    { $trig = "Content check"; }  # message_reject_characters (postfix >= 2.3)
4192
4193    if ($p4 eq '')                          { $text = '*generic'; $trig_opt = $trig; }
4194    else                                    { $text = $p4;        $trig_opt = "$trig ($p4)"; }
4195
4196    if    ($host eq 'local')                { $fmthost = formathost('127.0.0.1', 'local'); }
4197    elsif ($host =~ /([^[]+)\[([^]]+)\]/)   { $fmthost = formathost($2,$1); }
4198    else                                    { $fmthost = '*unknown'; }
4199
4200    # Note: Counts
4201    #   Ensure each $Counts{key} accumulator is consistently
4202    #   used with the same number of hash key levels throughout the code.
4203    #   For example, $Counts{'hold'} below has 4 keys; ensure that every
4204    #   other usage of $Counts{'hold'} also has 4 keys.  Currently, it is
4205    #   OK to set the last key as '', but only the last.
4206
4207    if ($action eq 'reject') {
4208       $Counts{'byiprejects'}{$fmthost}++                                if $Collecting{'byiprejects'};
4209
4210       # Note: no temporary or reject_warning
4211       # Note: no reply code - force into a 5xx reject
4212       # XXX this won't be seen if the user has no 5.. entry in reject_reply_patterns
4213       $Totals{$reject_name = "5xxreject$part" }++;
4214       $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++          if $Collecting{$reject_name};
4215    }
4216    elsif ( $action eq 'filter' ) {
4217       $Totals{'filtered'}++;
4218       $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++     if $Collecting{'filtered'};
4219    }
4220    elsif ( $action eq 'hold' ) {
4221       $Totals{'hold'}++;
4222       $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++            if $Collecting{'hold'};
4223    }
4224    elsif ( $action eq 'redirect' ) {
4225       $Totals{'redirected'}++;
4226       $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++   if $Collecting{'redirected'};
4227    }
4228    elsif ( $action eq 'discard' ) {
4229       $Totals{'discarded'}++;
4230       $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++           if $Collecting{'discarded'};
4231    }
4232    elsif ( $action eq 'prepend' ) {
4233       $Totals{'prepended'}++;
4234       $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++ if $Collecting{'prepended'};
4235    }
4236    elsif ( $action eq 'replace' ) {
4237       $Totals{'replaced'}++;
4238       $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++  if $Collecting{'replaced'};
4239    }
4240    elsif ( $action eq 'warning' ) {
4241       $Totals{'warned'}++;
4242       $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++              if $Collecting{'warned'};
4243    }
4244    elsif ( $action eq 'bcc' ) {
4245       $Totals{'bcced'}++;
4246       $Counts{'bcced'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++        if $Collecting{'bcced'};
4247    }
4248    else {
4249       inc_unmatched('header_body_checks unexpected action');
4250    }
4251
4252    return 1;
4253 }
4254
4255
4256 # Handle common milter actions:
4257 #    milter-reject, milter-hold, milter-discard
4258 # which are created by both smtpd and cleanup
4259 #
4260 sub milter_common($) {
4261    my $line = shift;
4262
4263    #TDsdN milter-reject: MAIL           from milterS.example.com[10.0.0.1]: 553 5.1.7 address incomplete;                                                                          proto=ESMTP helo=<example.com>
4264    #TDsdN milter-reject: CONNECT        from milterS.example.com[10.0.0.2]: 451 4.7.1 Service unavailable - try again later; proto=SMTP
4265    #TDsdQ milter-reject: END-OF-MESSAGE from milterS.example.com[10.0.0.3]: 5.7.1 black listed URL host sample.com by ...uribl.com;  from=<from@sample.com> to=<to@example.net>    proto=ESMTP helo=<example.com>
4266    #TDsdQ milter-hold:   END-OF-MESSAGE from milterS.example.com[10.0.0.4]: milter triggers HOLD action;                             from=<from@sample.com> to=<to@example.net>    proto=ESMTP helo=<sample.com>
4267
4268    #TDcQ milter-reject:  END-OF-MESSAGE from milterC.example.com[10.0.0.1]: 5.7.1 Some problem;                                      from=<efrom@example.com> to=<eto@sample.net>  proto=SMTP  helo=<example.com>
4269    #TDcQ milter-reject:  CONNECT        from milterC.example.com[10.0.0.2]: 5.7.1 Some problem;                                                                                    proto=SMTP
4270    #TDcQ milter-hold:    END-OF-MESSAGE from milterC.example.com[10.0.0.3]: milter triggers HOLD action;                             from=<efrom@example.com> to=<eto@example.net> proto=ESMTP helo=<example.com>
4271    #TDcQ milter-discard: END-OF-MESSAGE from milterC.example.com[10.0.0.4]: milter triggers DISCARD action;                          from=<efrom@example.com> to=<eto@example.net> proto=ESMTP helo=<example.com>
4272 #   84B82AC8B3: milter-reject: END-OF-MESSAGE from localhost[127.0.0.1]: 5.7.1 Blocked
4273
4274    my ($efrom,$eto,$proto,$helo) = strip_ftph($line);
4275    $line =~ s/;$//;
4276
4277    if ($line =~ /^(reject|hold|discard): (\S+) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
4278
4279       my ($action,$stage,$host,$hostip,$reply) = ($1,$2,$3,$4,$5);
4280
4281       if ($action eq 'reject') {
4282          my ($dsn,$fmthost,$reject_name);
4283          ($dsn,$reply) = ($1,$2)    if $reply =~ /^($re_DSN) (.*)$/o;
4284
4285          if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
4286             $fmthost = formathost($hostip,$host);
4287             $Counts{'byiprejects'}{$fmthost}++;
4288          }
4289          # Note: reject_warning does not seem to occur
4290          # Note: See rejectmilter elsewhere
4291          $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; return unless ($Collecting{$reject_name});
4292          $Counts{$reject_name}{$stage}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reply}++;
4293       }
4294       # milter-hold
4295       elsif ($action eq 'hold') {
4296          $Totals{'hold'}++; return unless ($Collecting{'hold'});
4297          $Counts{'hold'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4298       }
4299       # milter-discard
4300       else { # $action eq 'discard'
4301          $Totals{'discarded'}++; return unless ($Collecting{'discarded'});
4302          $Counts{'discarded'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4303       }
4304
4305    }
4306    else {
4307       inc_unmatched('milter_common)');
4308    }
4309 }
4310
4311 sub postfix_dnsblog {
4312    my $line = shift;
4313
4314    #postfix/dnsblog[16943]: addr 192.168.0.1 listed by domain bl.spamcop.net as 127.0.0.2
4315    #postfix/dnsblog[78598]: addr 192.168.0.1 blocked by domain zen.spamhaus.org as 127.0.0.11
4316    if ($line =~ /^addr (\S+) (?:listed|blocked) by domain (\S+) as (\S+)$/) {
4317       $Counts{'dnsblog'}{$2}{$1}{$3}++  if $Collecting{'dnsblog'};
4318    }
4319    else {
4320       inc_unmatched('dnsblog')   if ! in_ignore_list($line);
4321       return;
4322    }
4323 }
4324
4325 sub postfix_postscreen {
4326    my $line = shift;
4327
4328    return if (
4329       $line =~ /^cache / or
4330       $line =~ /discarding EHLO keywords: / or
4331       $line =~ /: discard_mask / or
4332       $line =~ /: sq=\d+ cq=\d+ event/ or
4333       $line =~ /: replacing command "/ or
4334       $line =~ /^(DATA|BDAT) without valid RCPT/
4335    );
4336
4337
4338    if (($line =~ /^(PREGREET) \d+ (?:after \S+)? from \[([^]]+)\](?::\d+)?/) or
4339       # PREGREET 20 after 0.31 from [192.168.0.1]:12345: HELO 10.0.0.1??
4340       # HANGUP after 0.7 from [192.168.0.4]:12345
4341        ($line =~ /^(HANGUP) (?:after \S+)? from \[([^]]+)\](?::\d+)?/)) {
4342       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4343    }
4344    elsif ($line =~ /^((ALLOW|WHITE|BLACK|DENY)LISTED|PASS \S+) \[([^]]+)\](?::\d+)?$/) {
4345       # This will display two separate counts for e.g. "allowlisted"
4346       # and "whitelisted" if you change your configuration in the
4347       # middle of the day, but I don't see that as a huge problem.
4348       #
4349       # ALLOWLISTED [40.92.75.48]:17085
4350       # PASS NEW [192.168.0.2]:12345
4351       # PASS OLD [192.168.0.3]:12345
4352       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4353    }
4354    elsif ($line =~ /^DNSBL rank (\S+) for \[([^]]+)\](?::\d+)?$/) {
4355       $Counts{'postscreen'}{'dnsbl'}{$2}{$1}++      if $Collecting{'postscreen'};
4356    }
4357
4358    elsif ($line =~ /^(CONNECT|COMMAND (?:(?:TIME|COUNT|LENGTH) LIMIT|PIPELINING)|NON-SMTP COMMAND|BARE NEWLINE) from \[([^\]]+)\]:\d+/) {
4359       # CONNECT from [192.168.1.1]:12345
4360       $Counts{'postscreen'}{lc($1)}{$2}{$END_KEY}++             if $Collecting{'postscreen'};
4361    }
4362    elsif ($line =~ /^DISCONNECT \[([^\]]+)\]:\d+$/) {
4363       # DISCONNECT [192.168.1.1]:12345
4364       $Counts{'postscreen'}{'disconnect'}{$1}{$END_KEY}++       if $Collecting{'postscreen'};
4365    }
4366
4367    elsif ($line =~ /^NOQUEUE: reject: RCPT from \[([^]]+)\](?::\d+)?: ($re_DSN) ([^;]+)/o) {
4368       #NOQUEUE: reject: RCPT from [192.168.0.1]:12345: 550 5.7.1 Service unavailable; client [192.168.0.1] blocked using b.barracudacentral.org; from=<from@example.com>, to=<to@example.net>, proto=SMTP, helo=<example.com>
4369       my ($ip,$dsn,$msg) = ($1,$2,$3);
4370
4371       if ($dsn =~ /^([54])/) {
4372          $Counts{'postscreen'}{$1 . 'xx reject'}{"$dsn $msg"}{$ip}++      if $Collecting{'postscreen'};
4373       }
4374       else {
4375          $Counts{'postscreen'}{'reject'}{"$dsn $msg"}{$ip}{$END_KEY}++      if $Collecting{'postscreen'};
4376       }
4377    }
4378
4379    elsif ($line =~ /^(NOQUEUE: )?reject: (connect|CONNECT) from \[([^]]+)\](?::\d+)?: (.+)$/) {
4380        # NOQUEUE: reject: CONNECT from [192.168.0.1]:7197: too many connections
4381        # NOQUEUE: reject: CONNECT from [192.168.0.1]:39410: all server ports busy
4382        # reject: connect from [192.168.0.1]:21225: all screening ports busy
4383       $Counts{'postscreen'}{'reject'}{"\u$4"}{$3}{$END_KEY}++      if $Collecting{'postscreen'};
4384    }
4385
4386    elsif ($line =~ /^(?:(WHITE|ALLOW)LIST VETO) \[([^]]+)\](?::\d+)?$/) {
4387       # WHITELIST VETO [192.168.0.8]:43579
4388       $Counts{'postscreen'}{'allowlist veto'}{$1}{$END_KEY}++   if $Collecting{'postscreen'};
4389    }
4390
4391    elsif ($line =~ /^(entering|leaving) STRESS mode with (\d+) connections$/) {
4392       # entering STRESS mode with 90 connections
4393       $Counts{'postscreen'}{'stress mode: ' . $1}{$2}{$END_KEY}++      if $Collecting{'postscreen'};
4394    }
4395
4396    elsif ($line =~ /^close database (\S+): No such file or directory/) {
4397       # close database /var/lib/postfix/postscreen_cache.db: No such file or directory (possible Berkeley DB bug)
4398       $Counts{'postscreen'}{'close database'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4399    }
4400
4401    else {
4402       inc_unmatched('postscreen')   if ! in_ignore_list($line);
4403       return;
4404    }
4405
4406    $Totals{'postscreen'}++;
4407 }
4408
4409
4410 # Handles postfix/postsuper lines
4411 #
4412 sub postfix_postsuper($) {
4413    my $line = shift;
4414
4415    return if $line =~ /^Deleted: \d+ messages?$/;
4416
4417    if ($line =~ /^Placed on hold: (\d+) messages?$/o) {
4418       #TDps Placed on hold: 2 messages
4419       # Note: See Hold elsewhere
4420       $Totals{'hold'} += $1; return unless ($Collecting{'hold'});
4421       $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1;
4422    }
4423    elsif ($line =~ /^Released from hold: (\d+) messages?$/o) {
4424       #TDps Released from hold: 1 message
4425       $Totals{'releasedfromhold'} += $1;
4426    }
4427    elsif ($line =~ /^Requeued: (\d+) messages?$/o) {
4428       #TDps Requeued: 1 message
4429       $Totals{'requeued'} += $1;
4430    }
4431    elsif (my($qid,$p2) = ($line =~ /($re_QID): (.*)$/)) {
4432       # postsuper double reports the following 3 lines
4433       return if ($p2 eq 'released from hold');
4434       return if ($p2 eq 'placed on hold');
4435       return if ($p2 eq 'requeued');
4436
4437       if ($p2 =~ /^removed\s*$/o) {
4438          # Note: See REMOVED elsewhere
4439          # 52CBDC2E0F: removed
4440          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
4441          $Totals{'removedfromqueue'}++;
4442       }
4443       elsif (! in_ignore_list ($p2)) {
4444          inc_unmatched('postsuper2');
4445       }
4446    }
4447    elsif (! in_ignore_list ($line)) {
4448       inc_unmatched('postsuper1');
4449    }
4450 }
4451
4452 # Handles postfix panic: lines
4453 #
4454 sub postfix_panic($) {
4455    #TD panic: myfree: corrupt or unallocated memory block
4456    $Totals{'panicerror'}++; return unless ($Collecting{'panicerror'});
4457    $Counts{'panicerror'}{ucfirst($1)}++;
4458 }
4459
4460 # Handles postfix fatal: lines
4461 #
4462 sub postfix_fatal($) {
4463    my ($reason) = shift;
4464
4465    if ($reason =~ /^\S*\(\d+\): Message file too big$/o) {
4466       #TD fatal: root(0): Message file too big
4467       $Totals{'fatalfiletoobig'}++;
4468
4469
4470    # XXX its not clear this is at all useful - consider falling
4471    # through to last case
4472    } elsif ( $reason =~ /^config variable (\S*): (.*)$/o ) {
4473       #TD fatal: config variable inet_interfaces: host not found: 10.0.0.1:2525
4474       #TD fatal: config variable inet_interfaces: host not found: all:2525
4475       $Totals{'fatalconfigerror'}++; return unless ($Collecting{'fatalconfigerror'});
4476       $Counts{'fatalconfigerror'}{ucfirst($reason)}++;
4477    }
4478    else {
4479       #TD fatal: watchdog timeout
4480       #TD fatal: bad boolean configuration: smtpd_use_tls =
4481
4482       #TDvN fatal: update queue file active/4B709F060E: File too large
4483       $reason =~ s/(^update queue file \w+\/)\w+:/$1*:/;
4484
4485       $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'});
4486       $Counts{'fatalerror'}{ucfirst($reason)}++;
4487    }
4488 }
4489 # Handles postfix fatal: lines
4490 #
4491 sub postfix_error($) {
4492    my ($reason) = shift;
4493    # postfix/postfix-script[4271]: error: unknown command: 'rel'
4494
4495    $Totals{'error'}++; return unless ($Collecting{'fatalerror'});
4496    $Counts{'error'}{ucfirst($reason)}++;
4497 }
4498
4499 # Handles postfix warning: lines
4500 # and additional lines coerced into warnings
4501 #
4502 sub postfix_warning($) {
4503    my ($warning) = shift;
4504
4505    # Skip these
4506    return if ($warning =~ /$re_QID: skipping further client input$/o);
4507    return if ($warning =~ /^Mail system is down -- accessing queue directly$/o);
4508    return if ($warning =~ /^SASL authentication failure: (?:Password verification failed|no secret in database)$/o);
4509    return if ($warning =~ /^no MX host for .* has a valid A record$/o);
4510    return if ($warning =~ /^uid=\d+: Broken pipe$/o);
4511
4512    #TD warning: connect to 127.0.0.1:12525: Connection refused
4513    #TD warning: problem talking to server 127.0.0.1:12525: Connection refused
4514    #TD warning: valid_ipv4_hostaddr: invalid octet count:
4515
4516    my ($domain,$to,$type,$site,$helo,$cmd);
4517    my ($addr,$size,$hostip,$host,$port,$reason,$qid,$queue,$reason2,$process,$status,$service);
4518
4519    if (($hostip,$host,$reason) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): hostname ([^ ]+) verification failed: (.*)$/) or
4520        ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): (address not listed for hostname) (.*)$/) or
4521        ($host,$reason,$hostip,$reason2) = ($warning =~ /^(?:smtpd_peer_init: )?hostname (\S+) (does not resolve to address) ([\d.]+)(: host not found, try again)?$/)) {
4522       #TD warning: 10.0.0.1: hostname sample.com verification failed: Host not found
4523       #TD warning: smtpd_peer_init: 192.168.0.1: hostname example.com verification failed: Name or service not known
4524       #TD warning: 192.168.0.1: address not listed for hostname sample.net
4525       # post 2.8
4526       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1: host not found, try again
4527       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1
4528
4529       $reason .= $reason2 if $reason2;
4530       $Totals{'hostnameverification'}++; return unless ($Collecting{'hostnameverification'});
4531       $Counts{'hostnameverification'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4532
4533    } elsif (($warning =~ /^$re_QID: queue file size limit exceeded$/o) or
4534             ($warning =~ /^uid=\d+: File too large$/o)) {
4535       $Totals{'warnfiletoobig'}++;
4536
4537    } elsif ($warning =~ /^database (?:[^ ]*) is older than source file ([\w\/]+)$/o) {
4538       #TD warning: database /etc/postfix/client_checks.db is older than source file /etc/postfix/client_checks
4539       $Totals{'databasegeneration'}++; return unless ($Collecting{'databasegeneration'});
4540       $Counts{'databasegeneration'}{$1}++;
4541
4542    } elsif (($reason,$qid,$reason2) = ($warning =~ /^(open active) ($re_QID): (.*)$/o) or
4543             ($reason,$qid,$reason2) = ($warning =~ /^qmgr_active_corrupt: (save corrupt file queue active) id ($re_QID): (.*)$/o) or
4544             ($qid,$reason,$reason2) = ($warning =~ /^($re_QID): (write queue file): (.*)$/o)) {
4545
4546       #TD warning: open active BDB9B1309F7: No such file or directory
4547       #TD warning: qmgr_active_corrupt: save corrupt file queue active id 4F4272F342: No such file or directory
4548       #TD warning: E669DE52: write queue file: No such file or directory
4549
4550       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4551       $Counts{'queuewriteerror'}{"$reason: $reason2"}{$qid}++;
4552
4553    } elsif (($qid,$reason) = ($warning =~ /^qmgr_active_done_3_generic: remove ($re_QID) from active: (.*)$/o)) {
4554       #TD warning: qmgr_active_done_3_generic: remove AF0F223FC05 from active: No such file or directory
4555       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4556       $Counts{'queuewriteerror'}{"remove from active: $reason"}{$qid}++;
4557
4558    } elsif (($queue,$qid) = ($warning =~ /^([^\/]*)\/($re_QID): Error writing message file$/o )) {
4559       #TD warning: maildrop/C9E66ADF: Error writing message file
4560       $Totals{'messagewriteerror'}++; return unless ($Collecting{'messagewriteerror'});
4561       $Counts{'messagewriteerror'}{$queue}{$qid}++;
4562
4563    } elsif (($process,$status) = ($warning =~ /^process ([^ ]*) pid \d+ exit status (\d+)$/o)) {
4564       #TD warning: process /usr/lib/postfix/smtp pid 9724 exit status 1
4565       $Totals{'processexit'}++; return unless ($Collecting{'processexit'});
4566       $Counts{'processexit'}{"Exit status $status"}{$process}++;
4567
4568    } elsif ($warning =~ /^mailer loop: (.*)$/o) {
4569       #TD warning: mailer loop: best MX host for example.com is local
4570       $Totals{'mailerloop'}++; return unless ($Collecting{'mailerloop'});
4571       $Counts{'mailerloop'}{$1}++;
4572
4573    } elsif ($warning =~ /^no (\S+) host for (\S+) has a valid address record$/) {
4574       #TDs warning: no MX host for example.com has a valid address record
4575       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4576       $Counts{'dnserror'}{"No $1 host has a valid address record"}{$2}{$END_KEY}++;
4577
4578    } elsif ($warning =~ /^(Unable to look up \S+ host) (.+)$/) {
4579       #TDsd warning: Unable to look up MX host for example.com: Host not found
4580       #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known
4581       #TDsd warning: Unable to look up NS host ns1.example.logal for Sender address bounce@example.local: No address associated with hostname
4582       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4583
4584       my ($problem,$target,$reason) = ($1, split(/: /,$2));
4585       $reason =~ s/, try again//;
4586
4587       if ($target =~ /^for (\S+)$/) {
4588          $Counts{'dnserror'}{$problem}{ucfirst($reason)}{$1}{$END_KEY}++;
4589       }
4590       elsif ($target =~ /^(\S+)( for \S+ address) (\S+)$/) {
4591          $Counts{'dnserror'}{$problem . lc($2)}{ucfirst($reason)}{$1}{$3}++;
4592       }
4593
4594    } elsif ($warning =~ /^((?:malformed|numeric) domain name in .+? of \S+ record) for (.*):(.*)?$/) {
4595       my ($problem,$domain,$reason) = ($1,$2,$3);
4596       #TDsd warning: malformed domain name in resource data of MX record for example.com:
4597       #TDsd warning: malformed domain name in resource data of MX record for example.com: mail.example.com\\032
4598       #TDsd warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1
4599       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4600       $Counts{'dnserror'}{ucfirst($problem)}{$domain}{$reason eq '' ? '*unknown' : $reason}{$END_KEY}++;
4601
4602    } elsif ($warning =~ /^numeric hostname: ([\S]+)$/) {
4603       #TD warning: numeric hostname: 192.168.0.1
4604       $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'});
4605       $Counts{'numerichostname'}{$1}++;
4606
4607    } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/)  or
4608              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[([^]]+)\](?::(\d+))?: (.*)$/) or
4609              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[([^]]+)\](?::(\d+))?:(?: (.*))?$/o)) {
4610       # ancient
4611       #TDsd warning: example.com[192.168.0.1] sent message header instead of SMTP command: From: "Someone" <40245426501example.com>
4612       # current
4613       #TDsd warning: non-SMTP command from sample.net[10.0.0.1]: Received: from 192.168.0.1 (HELO bogus.sample.com)
4614       #TDs warning: 6B01A8DEF: non-ESMTP response from mail.example.com[192.168.0.1]:25:
4615
4616       $Totals{'smtpconversationerror'}++; return unless ($Collecting{'smtpconversationerror'});
4617       $host .= ' :' . $port   if ($port and $port ne '25');
4618       $Counts{'smtpconversationerror'}{ucfirst($type)}{formathost($hostip,$host)}{$reason}++;
4619
4620    } elsif ($warning =~ /^valid_hostname: (.*)$/o) {
4621       #TD warning: valid_hostname: empty hostname
4622       $Totals{'hostnamevalidationerror'}++; return unless ($Collecting{'hostnamevalidationerror'});
4623       $Counts{'hostnamevalidationerror'}{$1}++;
4624
4625    } elsif (($host,$hostip,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::\d+)?: SASL (.*) authentication failed(.*)$/)) {
4626       #TDsd warning: unknown[10.0.0.1]: SASL LOGIN authentication failed: bad protocol / cancel
4627       #TDsd warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed
4628       # see saslauthfail elsewhere
4629       $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'});
4630       if ($reason) { $reason = $type . $reason; }
4631       else         { $reason = $type; }
4632       $Counts{'saslauthfail'}{$reason}{formathost($hostip,$host)}++;
4633
4634    } elsif (($host,$reason) = ($warning =~ /^(\S+): RBL lookup error:.* Name service error for (?:name=)?\1(?: type=[^:]+)?: (.*)$/o)) {
4635       #TD warning: 192.168.0.1.sbl.spamhaus.org: RBL lookup error: Host or domain name not found. Name service error for name=192.168.0.1.sbl.spamhaus.org type=A: Host not found, try again
4636
4637       #TD warning: 10.0.0.1.relays.osirusoft.com: RBL lookup error: Name service error for 10.0.0.1.relays.osirusoft.com: Host not found, try again
4638       $Totals{'rblerror'}++; return unless ($Collecting{'rblerror'});
4639       $Counts{'rblerror'}{$reason}{$host}++;
4640
4641    } elsif (
4642          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/ ) or
4643          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/ )) {
4644       #TDs warning: host example.com[192.168.0.1] greeted me with my own hostname example.com
4645       #TDs warning: host example.com[192.168.0.1] replied to HELO/EHLO with my own hostname example.com
4646       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4647       $Counts{'heloerror'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4648
4649    } elsif (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[([^]]+)\](?::\d+)?$/ )) {
4650       #TD warning: bad size limit "-679215104" in EHLO reply from example.com[192.168.0.1]
4651       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4652       $Counts{'heloerror'}{"Bad size limit in EHLO reply"}{formathost($hostip,$host)}{"$size"}++;
4653
4654    } elsif ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[([^]]+)\](?::\d+)? in ([^ ]*) command: (.*)/ )) {
4655       #TD warning: Illegal address syntax from example.com[192.168.0.1] in MAIL command: user@sample.net
4656       $addr =~ s/[<>]//g   unless ($addr eq '<>');
4657       $Totals{'illegaladdrsyntax'}++; return unless ($Collecting{'illegaladdrsyntax'});
4658       $Counts{'illegaladdrsyntax'}{$cmd}{$addr}{formathost($hostip,$host)}++;
4659
4660    } elsif ($warning =~ /^(timeout|premature end-of-input) on (.+) while reading (.*)$/o
4661          or $warning =~ /^(malformed (?:base64|numerical)|unexpected end-of-input) from (.+) while reading (.*)$/o) {
4662
4663       #TDs warning: premature end-of-input on private/anvil while reading input attribute name
4664       #TDs warning: timeout on private/anvil while reading input attribute data
4665       #TDs warning: unexpected end-of-input from 127.0.0.1:10025 socket while reading input attribute name
4666       #TDs warning: malformed base64 data from %s while reading input attribute data: ...
4667       #TDs warning: malformed numerical data from %s while reading input attribute data: ...
4668
4669       $Totals{'attrerror'}++; return unless ($Collecting{'attrerror'});
4670       $Counts{'attrerror'}{$2}{$1}{$3}++;
4671
4672    } elsif ($warning =~ /^(.*): (bad command startup -- throttling)/o) {
4673       #TD warning: /usr/libexec/postfix/trivial-rewrite: bad command startup -- throttling
4674       $Totals{'startuperror'}++; return unless ($Collecting{'startuperror'});
4675       $Counts{'startuperror'}{ucfirst($2)}{$1}++;
4676
4677    } elsif ($warning =~ /(problem talking to service [^:]*): (.*)$/o) {
4678       #TD warning: problem talking to service rewrite: Connection reset by peer
4679       #TD warning: problem talking to service rewrite: Success
4680       $Totals{'communicationerror'}++; return unless ($Collecting{'communicationerror'});
4681       $Counts{'communicationerror'}{ucfirst($1)}{$2}++;
4682
4683    } elsif (my ($map,$key) = ($warning =~ /^$re_QID: ([^ ]*) map lookup problem for (.*)$/o)) {
4684       #TD warning: 6F74F74431: virtual_alias_maps map lookup problem for root@example.com
4685       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4686       $Counts{'mapproblem'}{$map}{$key}++;
4687
4688    } elsif (($map,$reason) = ($warning =~ /^pcre map ([^,]+), (.*)$/o)) {
4689       #TD warning: pcre map /etc/postfix/body_checks, line 92: unknown regexp option "F": skipping this rule
4690       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4691       $Counts{'mapproblem'}{$map}{$reason}++;
4692
4693    } elsif (($reason) = ($warning =~ /dict_ldap_lookup: (.*)$/o)) {
4694       #TD warning: dict_ldap_lookup: Search error 80: Internal (implementation specific) error
4695       $Totals{'ldaperror'}++; return unless ($Collecting{'ldaperror'});
4696       $Counts{'ldaperror'}{$reason}++;
4697
4698    } elsif (($type,$size,$host,$hostip,$service) = ($warning =~ /^(.+) limit exceeded: (\d+) from ([^[]+)\[([^]]+)\](?::\d+)? for service (.*)/ )) {
4699       #TDsd warning: Connection concurrency limit exceeded: 51 from example.com[192.168.0.1] for service smtp
4700       #TDsd warning: Connection rate limit exceeded: 20 from mail.example.com[192.168.0.1] for service smtp
4701       #TDsd warning: Connection rate limit exceeded: 30 from unknown[unknown] for service smtp
4702       #TDsd warning: Recipient address rate limit exceeded: 21 from example.com[10.0.0.1] for service smtp
4703       #TDsd warning: Message delivery request rate limit exceeded: 11 from example.com[10.0.0.1] for service smtp
4704       #TDsd warning: New TLS session rate limit exceeded: 49 from example.com[10.0.0.1] for service smtp
4705       $Totals{'anvil'}++; return unless ($Collecting{'anvil'});
4706       $Counts{'anvil'}{$service}{$type}{formathost($hostip,$host)}{$size}++;
4707
4708    } elsif (my ($extname,$intname,$limit) = ($warning =~ /service "([^"]+)" \(([^)]+)\) has reached its process limit "([^"]+)":/o)) {
4709       #TD warning: service "smtp" (25) has reached its process limit "50": new clients may experience noticeable delays
4710       $Totals{'processlimit'}++; return unless ($Collecting{'processlimit'});
4711       $Counts{'processlimit'}{'See http://www.postfix.org/STRESS_README.html'}{"$extname ($intname)"}{$limit}++;
4712
4713    } else {
4714       #TDsd warning: No server certs available. TLS won't be enabled
4715       #TDs warning: smtp_connect_addr: bind <localip>: Address already in use
4716
4717       # These two messages follow ProcessLimit message above
4718       #TDm warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client
4719       #TDm warning: see http://www.postfix.org/STRESS_README.html for examples of stress-dependent configuration settings
4720       return if ($warning =~ /^to avoid this condition,/o);
4721       return if ($warning =~ /^see http:\/\/www\.postfix\.org\/STRESS_README.html/o);
4722
4723       #TDsd warning: 009314BD9E: read timeout on cleanup socket
4724       $warning =~ s/^$re_QID: (read timeout on \S+ socket)/$1/;
4725
4726       #TDsd warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4727       #TDs warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4728       $warning =~ s/^(Read failed in network_biopair_interop) with .*$/$1/;
4729
4730 =cut
4731       $warning =~ s/^(TLS library problem: )\d+:(error:.*)$/$1$2/;
4732       $warning =~ s/^(network_biopair_interop: error reading) \d+ bytes(.*)$/$1$2/;
4733
4734 1      TLS library problem: 10212:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4735 1      TLS library problem: 10217:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4736 1      network_biopair_interop: error reading 1102 bytes from the network: Connection reset by peer
4737 1      network_biopair_interop: error reading 1120 bytes from the network: Connection reset by peer
4738 =cut
4739
4740
4741       $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'});
4742       $Counts{'warningsother'}{$warning}++;
4743    }
4744 }
4745
4746 # Handles postfix/postfix-script lines
4747 #
4748 sub postfix_script($) {
4749    my $line = shift;
4750
4751    return if ($line =~ /^the Postfix mail system is running: PID: /o);
4752
4753    if ($line =~ /^starting the Postfix mail system/o) {
4754       $Totals{'postfixstart'}++;
4755    }
4756    elsif ($line =~ /^stopping the Postfix mail system/o) {
4757       $Totals{'postfixstop'}++;
4758    }
4759    elsif ($line =~ /^refreshing the Postfix mail system/o) {
4760       $Totals{'postfixrefresh'}++;
4761    }
4762    elsif ($line =~ /^waiting for the Postfix mail system to terminate/o) {
4763       $Totals{'postfixwaiting'}++;
4764    }
4765    elsif (! in_ignore_list ($line)) {
4766       inc_unmatched('postfix_script');
4767    }
4768 }
4769
4770 # Clean up a server's reply, to give some uniformity to reports
4771 #
4772 sub cleanhostreply($ $ $ $) {
4773    my ($hostreply,$relay,$recip,$domain) = @_;
4774
4775    my $fmtdhost = '';
4776    my ($r1, $r2, $dsn, $msg, $host, $event);
4777
4778    return ('Accepted', '*unknown')  if $hostreply =~ /^25\d/o;
4779
4780    # Host or domain name not found. Name service error for name=example.com type=MX: Host not found...
4781    if ($hostreply =~ /^Host or domain name not found. Name service error for name=([^:]+): Host not found/o) {
4782       return ('Host not found', $1);
4783    }
4784
4785    if (($host,$dsn,$r1) = ($hostreply =~ /host (\S+) said: ($re_DSN)[\- :]*"?(.*)"?$/o)) {
4786       # Strip recipient address from host's reply - we already have it in $recip.
4787       $r1 =~ s/[<(]?\Q$recip\E[>)]?\W*//ig;
4788
4789       # Strip and capture "in reply to XYZ command" from host's reply
4790       if ($r1 =~ s/\s*[(]?(?:in reply to (.*) command)[)]?//o) {
4791          $r2 = ": $1";
4792       }
4793       $r1 =~ s/^Recipient address rejected: //o;
4794       # Canonicalize numerous forms of "recipient unknown"
4795       if (   $r1 =~ /^user unknown/i
4796           or $r1 =~ /^unknown user/i
4797           or $r1 =~ /^unknown recipient address/i
4798           or $r1 =~ /^invalid recipient/i
4799           or $r1 =~ /^recipient unknown/i
4800           or $r1 =~ /^sorry, no mailbox here by that name/i
4801           or $r1 =~ /^User is unknown/
4802           or $r1 =~ /^User not known/
4803           or $r1 =~ /^MAILBOX NOT FOUND/
4804           or $r1 =~ /^Recipient Rejected: No account by that name here/
4805           or $r1 =~ /^Recipient does not exist here/
4806           or $r1 =~ /The email account that you tried to reach does not exist./ # Google's long mess
4807           or $r1 =~ /(?:no such user|user unknown)/i
4808          )
4809       {
4810          $r1 = 'Unknown recipient';
4811       }
4812       elsif ($r1 =~ /greylisted/oi) {
4813          $r1 = 'Recipient greylisted';
4814       }
4815       elsif ($r1 =~ /^Message temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/o) {
4816          # Yahoo: 421 Message temporarily deferred - 4.16.51. Please refer to http://... (in reply to end of DATA command))
4817          $dsn = "$dsn $1"; $r1 = "see $2";
4818       }
4819       elsif ($r1 =~ /^Resources temporarily not available - Please try again later \[#(\d\.\d+\.\d+)\]\.$/o) {
4820          #Yahoo 451 Resources temporarily not available - Please try again later [#4.16.5].
4821          $dsn = "$dsn $1"; $r1 = "resources not available";
4822       }
4823       elsif ($r1 =~ /^Message temporarily deferred - (\[\d+\])/o) {
4824          # Yahoo: 451 Message temporarily deferred - [160]
4825          $dsn = "$dsn $1"; $r1 = '';
4826       }
4827    }
4828
4829    elsif ($hostreply =~ /^connect to (\S+): (.*)$/o) {
4830       $host = $1; $r1 = $2; $r1 =~ s/server refused to talk to me/refused/;
4831    }
4832
4833    elsif ($hostreply =~ /^host (\S+) refused to talk to me: (.*)$/o) {
4834       $host = $1; $msg = $2;
4835       #Yahoo: '421 Message from (10.0.0.1) temporarily deferred - 4.16.50. Please refer to http://...
4836       if ($msg =~ /^(\d+) Message from \([^)]+\) temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/) {
4837          $dsn = "$1 $2"; $msg = "see $3";
4838       }
4839
4840       $r1 = $msg;
4841    }
4842    elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) {
4843       $host = $2; $r1 = join(': ', $1, $3);
4844    }
4845    elsif ($hostreply =~ /^(delivery temporarily suspended: conversation) with (\S+) (.*)$/o) {
4846       # delivery temporarily suspended: conversation with example.com[10.0.0.1] timed out while receiving the initial server greeting)
4847       $host = $2; $r1 = join(' ', $1, $3);
4848    }
4849    elsif (($event,$host,$r1) = ($hostreply =~ /^(lost connection|conversation) with (\S+) (.*)$/o)) {
4850       $r1 = join(' ',$event,$r1);
4851    }
4852    elsif ($hostreply =~ /^(.*: \S+maildrop: Unable to create a dot-lock) at .*$/o) {
4853       $r1 = $1;
4854    }
4855    elsif ($hostreply =~ /^mail for (\S+) loops back to myself/o) {
4856       $host = $1; $r1 = 'mailer loop';
4857    }
4858    elsif ($hostreply =~ /^unable to find primary relay for (\S+)$/o) {
4859       $host = $1; $r1 = 'no relay found';
4860    }
4861    elsif ($hostreply =~ /^message size \d+ exceeds size limit \d+ of server (\S+)\s*$/o) {
4862       $host = $1; $r1 = 'message too big';
4863    }
4864    else {
4865       $r1 = $hostreply;
4866    }
4867
4868    $r1 =~ s/for name=\Q$domain\E //ig;
4869
4870    if ($host eq '') {
4871       if ($relay =~ /([^[]+)\[([^]]+)\]/) {
4872          $fmtdhost = formathost($2,$1);
4873       }
4874       else {
4875          $fmtdhost = '*unknown';
4876       }
4877    }
4878    elsif ($host =~ /^([^[]+)\[([^]]+)\]/) {
4879       $fmtdhost = formathost($2,$1);
4880    }
4881    else {
4882       $fmtdhost = $host;
4883    }
4884
4885    return (($dsn ? "$dsn " : '' ) . "\u$r1$r2", $fmtdhost);
4886 }
4887
4888 # Strip and return from, to, proto, and helo information from a log line
4889 # From is set to the empty envelope sender <> as necessary, and To is
4890 # always lowercased.
4891 #
4892 # Note: modifies its input for efficiency
4893 #
4894 sub strip_ftph($) {
4895    my ($helo, $proto, $to, $from);
4896    $helo  =    ($_[0] =~ s/\s+helo=<(.*?)>\s*$//) == 1 ? $1               : '*unavailable';
4897    $proto =    ($_[0] =~ s/\s+proto=(\S+)\s*$//)  == 1 ? $1               : '*unavailable';
4898    $to    =    ($_[0] =~ s/\s+to=<(.*?)>\s*$//)   == 1 ? (lc($1) || '<>') : '*unavailable';
4899    $from  =    ($_[0] =~ s/\s+from=<(.*?)>\s*$//) == 1 ? (   $1  || '<>') : '*unavailable';
4900
4901    return ($from,$to,$proto,$helo);
4902 }
4903
4904 # Initialize the Getopts option list.  Requires the Section table to
4905 # be built already.
4906 #
4907 sub init_getopts_table() {
4908    print "init_getopts_table: enter\n"  if $Opts{'debug'} & Logreporters::D_ARGS;
4909
4910    init_getopts_table_common(@supplemental_reports);
4911
4912    add_option ('recipient_delimiter=s');
4913    add_option ('delays!');
4914    add_option ('show_delays=i',             sub { $Opts{'delays'} = $_[1]; 1; });
4915    add_option ('delays_percentiles=s');
4916    add_option ('reject_reply_patterns=s');
4917    add_option ('ignore_services=s');
4918    add_option ('postgrey_delays!');
4919    add_option ('postgrey_show_delays=i',    sub { $Opts{'postgrey_delays'} = $_[1]; 1; });
4920    add_option ('postgrey_delays_percentiles=s');
4921    add_option ('unknown!',                  sub { $Opts{'unknown'} = $_[1]; 1; });
4922    add_option ('show_unknown=i',            sub { $Opts{'unknown'} = $_[1]; 1; });
4923    add_option ('enable_long_queue_ids=i',   sub { $Opts{'long_queue_ids'} = $_[1]; 1; });
4924    add_option ('long_queue_ids!');
4925
4926 =pod
4927    # aliases and backwards compatibility
4928    add_option ('msgsdeferred=s',            \$Opts{'deferred'});
4929    add_option ('msgsdelivered=s',           \$Opts{'delivered'});
4930    add_option ('msgssent=s',                \$Opts{'sent'});
4931    add_option ('msgssentlmtp=s',            \$Opts{'sentlmtp'});
4932    add_option ('msgsforwarded=s',           \$Opts{'forwarded'});
4933    add_option ('msgsresent=s',              \$Opts{'resent'});
4934    add_option ('warn=s',                    \$Opts{'warned'});
4935    add_option ('held=s',                    \$Opts{'hold'});
4936 =cut
4937 }
4938
4939 # Builds the entire @Section table used for data collection
4940 #
4941 # Each Section entry has as many as six fields:
4942 #
4943 #   1. Section array reference
4944 #   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
4945 #   3. Output in Detail report? (must also a %Counts accumulator)
4946 #   4. Numeric output format specifier for Summary report
4947 #   5. Section title for Summary and Detail reports
4948 #   6. A hash to a divisor used to calculate the percentage of a total for that key
4949 #
4950 # Use begin_section_group/end_section_group to create groupings around sections.
4951 #
4952 # Sections can be freely reordered if desired, but maintain proper group nesting.
4953 #
4954 #
4955 # The reject* entries of this table are dynamic, in that they are built based
4956 # upon the value of $Opts{'reject_reply_patterns'}, which can be specified by
4957 # either command line or configuration file.  This allows various flavors, of
4958 # reject sections based on SMTP reply code (eg. 421 45x, 5xx, etc.).  Instead
4959 # of creating special sections for each reject variant, the primary key of each
4960 # reject section could have been the SMTP reply code.  However, this would
4961 # require special-case processing to distinguish 4xx temporary rejects from 5xx
4962 # permanent rejects in various Totals{'totalrejects*'} counts, and in the
4963 # Totals{'totalrejects'} tally.
4964 #
4965 # Sections can be freely reordered if desired.
4966 sub build_sect_table() {
4967    if ($Opts{'debug'} & Logreporters::D_SECT) {
4968       print "build_sect_table: enter\n";
4969       print "\treject patterns: $Opts{'reject_reply_patterns'}\n";
4970    }
4971    my $S = \@Sections;
4972
4973    # References to these are used in the Sections table below; we'll predeclare them.
4974    $Totals{'totalrejects'} = 0;
4975    $Totals{'totalrejectswarn'} = 0;
4976    $Totals{'totalacceptplusreject'} = 0;
4977
4978    # Configuration and critical errors appear first
4979
4980    #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
4981    begin_section_group ($S, 'warnings');
4982    add_section ($S, 'panicerror',                  1, 'd', '*Panic:   General panic');
4983    add_section ($S, 'fatalfiletoobig',             0, 'd', '*Fatal:   Message file too big');
4984    add_section ($S, 'fatalconfigerror',            1, 'd', '*Fatal:   Configuration error');
4985    add_section ($S, 'fatalerror',                  1, 'd', '*Fatal:   General fatal');
4986    add_section ($S, 'error',                       1, 'd', '*Error:   General error');
4987    add_section ($S, 'processlimit',                1, 'd', '*Warning: Process limit reached, clients may delay');
4988    add_section ($S, 'warnfiletoobig',              0, 'd', '*Warning: Queue file size limit exceeded');
4989    add_section ($S, 'warninsufficientspace',       0, 'd', '*Warning: Insufficient system storage error');
4990    add_section ($S, 'warnconfigerror',             1, 'd', '*Warning: Server configuration error');
4991    add_section ($S, 'queuewriteerror',             1, 'd', '*Warning: Error writing queue file');
4992    add_section ($S, 'messagewriteerror',           1, 'd', '*Warning: Error writing message file');
4993    add_section ($S, 'databasegeneration',          1, 'd', '*Warning: Database is older than source file');
4994    add_section ($S, 'mailerloop',                  1, 'd', '*Warning: Mailer loop');
4995    add_section ($S, 'startuperror',                1, 'd', '*Warning: Startup error');
4996    add_section ($S, 'mapproblem',                  1, 'd', '*Warning: Map lookup problem');
4997    add_section ($S, 'attrerror',                   1, 'd', '*Warning: Error reading attribute data');
4998    add_section ($S, 'anvil',                       1, 'd', '*Warning: Anvil limit reached');
4999    add_section ($S, 'processexit',                 1, 'd', 'Process exited');
5000    add_section ($S, 'hold',                        1, 'd', 'Placed on hold');
5001    add_section ($S, 'communicationerror',          1, 'd', 'Postfix communications error');
5002    add_section ($S, 'saslauthfail',                1, 'd', 'SASL authentication failed');
5003    add_section ($S, 'ldaperror',                   1, 'd', 'LDAP error');
5004    add_section ($S, 'warningsother',               1, 'd', 'Miscellaneous warnings');
5005    add_section ($S, 'totalrejectswarn',            0, 'd', 'Reject warnings (warn_if_reject)');
5006    end_section_group ($S, 'warnings');
5007
5008    begin_section_group ($S, 'bytes', "\n");
5009    add_section ($S, 'bytesaccepted',               0, 'Z', 'Bytes accepted ');           # Z means print scaled as in 1k, 1m, etc.
5010    add_section ($S, 'bytessentsmtp',               0, 'Z', 'Bytes sent via SMTP');
5011    add_section ($S, 'bytessentlmtp',               0, 'Z', 'Bytes sent via LMTP');
5012    add_section ($S, 'bytesdelivered',              0, 'Z', 'Bytes delivered');
5013    add_section ($S, 'bytesforwarded',              0, 'Z', 'Bytes forwarded');
5014    end_section_group ($S, 'bytes', $sep1);
5015
5016    begin_section_group ($S, 'acceptreject', "\n");
5017    begin_section_group ($S, 'acceptreject2', "\n");
5018    add_section ($S, 'msgsaccepted',                0, 'd', 'Accepted',                          \$Totals{'totalacceptplusreject'});
5019    add_section ($S, 'totalrejects',                0, 'd', 'Rejected',                          \$Totals{'totalacceptplusreject'});
5020    end_section_group ($S, 'acceptreject2', $sep2);
5021    add_section ($S, 'totalacceptplusreject',       0, 'd', 'Total',                             \$Totals{'totalacceptplusreject'});
5022    end_section_group ($S, 'acceptreject', $sep1);
5023
5024    # The various Reject sections are built dynamically based upon a
5025    # list of reject reply keys, which are user-configured via
5026    # $Opts{'reject_reply_patterns'}
5027    @RejectPats = ();
5028    foreach my $rejpat (split /[ ,]/, $Opts{'reject_reply_patterns'}) {
5029       if ($rejpat !~ /^(warn|[45][\d.]{2})$/io) {
5030          print STDERR usage "Invalid pattern \"$rejpat\" in reject_reply_patterns";
5031          exit (2);
5032       }
5033       if (grep (/\Q$rejpat\E/, @RejectPats) == 0) {
5034          push @RejectPats, $rejpat
5035       }
5036       else {
5037          print STDERR "Ignoring duplicate pattern \"$rejpat\" in reject_reply_patterns\n";
5038       }
5039    }
5040    @RejectKeys = @RejectPats;
5041    for (@RejectKeys) {
5042       s/\./x/g;
5043    }
5044
5045    print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n"  if $Opts{'debug'} & Logreporters::D_SECT;
5046
5047    # Add reject variants
5048    foreach my $key (@RejectKeys) {
5049       $key   = lc($key);
5050       my $keyuc = ucfirst($key);
5051       my $totalsref = \$Totals{'totalrejects' . $key};
5052       print "\t   reject key: $key\n" if $Opts{'debug'} & Logreporters::D_SECT;
5053
5054       begin_section_group ($S, 'rejects', "\n");
5055       begin_section_group ($S, 'rejects2', "\n");
5056       add_section ($S, $key . 'rejectrelay',                 1, 'd', $keyuc . ' Reject relay denied',                $totalsref);
5057       add_section ($S, $key . 'rejecthelo',                  1, 'd', $keyuc . ' Reject HELO/EHLO',                   $totalsref);
5058       add_section ($S, $key . 'rejectdata',                  1, 'd', $keyuc . ' Reject DATA',                        $totalsref);
5059       add_section ($S, $key . 'rejectunknownuser',           1, 'd', $keyuc . ' Reject unknown user',                $totalsref);
5060       add_section ($S, $key . 'rejectrecip',                 1, 'd', $keyuc . ' Reject recipient address',           $totalsref);
5061       add_section ($S, $key . 'rejectsender',                1, 'd', $keyuc . ' Reject sender address',              $totalsref);
5062       add_section ($S, $key . 'rejectclient',                1, 'd', $keyuc . ' Reject client host',                 $totalsref);
5063       add_section ($S, $key . 'rejectunknownclient',         1, 'd', $keyuc . ' Reject unknown client host',         $totalsref);
5064       add_section ($S, $key . 'rejectunknownreverseclient',  1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref);
5065       add_section ($S, $key . 'rejectunverifiedclient',      1, 'd', $keyuc . ' Reject unverified client host',      $totalsref);
5066       add_section ($S, $key . 'rejectrbl',                   1, 'd', $keyuc . ' Reject RBL',                         $totalsref);
5067       add_section ($S, $key . 'rejectheader',                1, 'd', $keyuc . ' Reject header',                      $totalsref);
5068       add_section ($S, $key . 'rejectbody',                  1, 'd', $keyuc . ' Reject body',                        $totalsref);
5069       add_section ($S, $key . 'rejectcontent',               1, 'd', $keyuc . ' Reject content',                     $totalsref);
5070       add_section ($S, $key . 'rejectsize',                  1, 'd', $keyuc . ' Reject message size',                $totalsref);
5071       add_section ($S, $key . 'rejectmilter',                1, 'd', $keyuc . ' Reject milter',                      $totalsref);
5072       add_section ($S, $key . 'rejectproxy',                 1, 'd', $keyuc . ' Reject proxy',                       $totalsref);
5073       add_section ($S, $key . 'rejectinsufficientspace',     1, 'd', $keyuc . ' Reject insufficient space',          $totalsref);
5074       add_section ($S, $key . 'rejectconfigerror',           1, 'd', $keyuc . ' Reject server config error',         $totalsref);
5075       add_section ($S, $key . 'rejectverify',                1, 'd', $keyuc . ' Reject VRFY',                        $totalsref);
5076       add_section ($S, $key . 'rejectetrn',                  1, 'd', $keyuc . ' Reject ETRN',                        $totalsref);
5077       add_section ($S, $key . 'rejectlookupfailure',         1, 'd', $keyuc . ' Reject temporary lookup failure',    $totalsref);
5078       end_section_group ($S, 'rejects2', $sep2);
5079       add_section ($S, 'totalrejects' . $key,                0, 'd', "Total $keyuc Rejects",                         $totalsref);
5080       end_section_group ($S, 'rejects', $sep1);
5081
5082       $Totals{'totalrejects' . $key} = 0;
5083    }
5084
5085    begin_section_group ($S, 'byiprejects', "\n");
5086    add_section ($S,  'byiprejects',                 1, 'd', 'Reject by IP');
5087    end_section_group ($S, 'byiprejects');
5088
5089    begin_section_group ($S, 'general1', "\n");
5090    add_section ($S, 'connectioninbound',           1, 'd', 'Connections');
5091    add_section ($S, 'connectionlostinbound',       1, 'd', 'Connections lost (inbound)');
5092    add_section ($S, 'connectionlostoutbound',      1, 'd', 'Connections lost (outbound)');
5093    add_section ($S, 'disconnection',               0, 'd', 'Disconnections');
5094    add_section ($S, 'removedfromqueue',            0, 'd', 'Removed from queue');
5095    add_section ($S, 'delivered',                   1, 'd', 'Delivered');
5096    add_section ($S, 'sent',                        1, 'd', 'Sent via SMTP');
5097    add_section ($S, 'sentlmtp',                    1, 'd', 'Sent via LMTP');
5098    add_section ($S, 'forwarded',                   1, 'd', 'Forwarded');
5099    add_section ($S, 'resent',                      0, 'd', 'Resent');
5100    add_section ($S, 'deferred',                    1, 'd', 'Deferred');
5101    add_section ($S, 'deferrals',                   1, 'd', 'Deferrals');
5102    add_section ($S, 'bouncelocal',                 1, 'd', 'Bounced (local)');
5103    add_section ($S, 'bounceremote',                1, 'd', 'Bounced (remote)');
5104    add_section ($S, 'bouncefailed',                1, 'd', 'Bounce failure');
5105    add_section ($S, 'postscreen',                  1, 'd', 'Postscreen');
5106    add_section ($S, 'dnsblog',                     1, 'd', 'DNSBL log');
5107
5108    add_section ($S, 'envelopesenders',             1, 'd', 'Envelope senders');
5109    add_section ($S, 'envelopesenderdomains',       1, 'd', 'Envelope sender domains');
5110
5111    add_section ($S, 'bcced',                       1, 'd', 'BCCed');
5112    add_section ($S, 'filtered',                    1, 'd', 'Filtered');
5113    add_section ($S, 'redirected',                  1, 'd', 'Redirected');
5114    add_section ($S, 'discarded',                   1, 'd', 'Discarded');
5115    add_section ($S, 'prepended',                   1, 'd', 'Prepended');
5116    add_section ($S, 'replaced',                    1, 'd', 'Replaced');
5117    add_section ($S, 'warned',                      1, 'd', 'Warned');
5118
5119    add_section ($S, 'requeued',                    0, 'd', 'Requeued messages');
5120    add_section ($S, 'returnedtosender',            1, 'd', 'Expired and returned to sender');
5121    add_section ($S, 'notificationsent',            1, 'd', 'Notifications sent');
5122
5123    add_section ($S, 'policyspf',                   1, 'd', 'Policy SPF');
5124    add_section ($S, 'policydweight',               1, 'd', 'Policyd-weight');
5125    add_section ($S, 'postfwd',                     1, 'd', 'Postfwd');
5126    add_section ($S, 'postgrey',                    1, 'd', 'Postgrey');
5127    end_section_group ($S, 'general1');
5128
5129    begin_section_group ($S, 'general2', "\n");
5130    add_section ($S, 'connecttofailure',            1, 'd', 'Connection failures (outbound)');
5131    add_section ($S, 'timeoutinbound',              1, 'd', 'Timeouts (inbound)');
5132    add_section ($S, 'heloerror',                   1, 'd', 'HELO/EHLO conversations errors');
5133    add_section ($S, 'illegaladdrsyntax',           1, 'd', 'Illegal address syntax in SMTP command');
5134    add_section ($S, 'released',                    0, 'd', 'Released from hold');
5135    add_section ($S, 'rblerror',                    1, 'd', 'RBL lookup errors');
5136    add_section ($S, 'dnserror',                    1, 'd', 'DNS lookup errors');
5137    add_section ($S, 'numerichostname',             1, 'd', 'Numeric hostname');
5138    add_section ($S, 'smtpconversationerror',       1, 'd', 'SMTP dialog errors');
5139    add_section ($S, 'hostnameverification',        1, 'd', 'Hostname verification errors (FCRDNS)');
5140    add_section ($S, 'hostnamevalidationerror',     1, 'd', 'Hostname validation errors');
5141    add_section ($S, 'smtpprotocolviolation',       1, 'd', 'SMTP protocol violations');
5142    add_section ($S, 'deliverable',                 1, 'd', 'Deliverable (address verification)');
5143    add_section ($S, 'undeliverable',               1, 'd', 'Undeliverable (address verification)');
5144    add_section ($S, 'tablechanged',                0, 'd', 'Restarts due to lookup table change');
5145    add_section ($S, 'pixworkaround',               1, 'd', 'PIX workaround enabled');
5146    add_section ($S, 'tlsserverconnect',            1, 'd', 'TLS connections (server)');
5147    add_section ($S, 'tlsclientconnect',            1, 'd', 'TLS connections (client)');
5148    add_section ($S, 'saslauth',                    1, 'd', 'SASL authenticated messages');
5149    add_section ($S, 'tlsunverified',               1, 'd', 'TLS certificate unverified');
5150    add_section ($S, 'tlsoffered',                  1, 'd', 'Host offered TLS');
5151    end_section_group ($S, 'general2');
5152
5153    begin_section_group ($S, 'postfixstate', "\n");
5154    add_section ($S, 'postfixstart',                0, 'd', 'Postfix start');
5155    add_section ($S, 'postfixstop',                 0, 'd', 'Postfix stop');
5156    add_section ($S, 'postfixrefresh',              0, 'd', 'Postfix refresh');
5157    add_section ($S, 'postfixwaiting',              0, 'd', 'Postfix waiting to terminate');
5158    end_section_group ($S, 'postfixstate');
5159
5160
5161    if ($Opts{'debug'} & Logreporters::D_SECT) {
5162       print "\tSection table\n";
5163       printf "\t\t%s\n", (ref($_) eq 'HASH' ? $_->{NAME} : $_) foreach @Sections;
5164       print "build_sect_table: exit\n"
5165    }
5166 }
5167
5168 # XXX create array of defaults for detail <5, 5-9, >10
5169 sub init_defaults() {
5170    map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
5171    if (! $Opts{'standalone'}) {
5172       # LOGWATCH
5173       # these take affect if no env present (eg. nothing in conf file)
5174       # 0 to 4 nodelays
5175
5176       if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
5177          $Opts{'delays'}            = 0;
5178          $Opts{'postgrey_delays'}   = 0;
5179       }
5180    }
5181 }
5182
5183
5184 # XXX ensure something is matched?
5185 # XXX cache values so we don't have to substitute X for . each time
5186 #match $dsn against list for best fit
5187 sub get_reject_key($) {
5188    my $reply = shift;
5189    my $replyorig = $reply;
5190    ($reply) = split / /, $reply;
5191    for (my $i = 0; $i <= $#RejectPats; $i++) {
5192       # we'll allow extended DSNs to match (eg. 5.7.1 will match 5..)
5193       if ($reply =~ /^$RejectPats[$i]/) {    # no /o here, pattern varies
5194          return $RejectKeys[$i];
5195       }
5196    }
5197
5198    return;
5199 }
5200
5201 # Replace bare reject limiters with specific reject limiters
5202 # based on reject_reply_patterns
5203 #
5204 sub expand_bare_reject_limiters()
5205 {
5206   # don't reorder the list of limiters.  This breaks --nodetail followed by a
5207   # bare reject such as --limit rejectrbl=10.  Reordering is no longer necessary
5208   # since process_limiters was instituted and using the special __none__ pseudo-
5209   # limiter to indicate the position at which --nodefailt was found on the command
5210   # line.
5211   # my ($limiter, @reject_limiters, @non_reject_limiters);
5212    my ($limiter, @new_list);
5213
5214    # XXX check if limiter matches just one in rejectclasses
5215    while ($limiter = shift @Limiters) {
5216       if ($limiter =~ /^reject[^_]/) {
5217          foreach my $reply_code (@RejectKeys) {
5218             printf "bare_reject: \L$reply_code$limiter\n"  if $Opts{'debug'} & Logreporters::D_VARS;
5219             #push @reject_limiters, lc($reply_code) . $limiter;
5220             push @new_list, lc($reply_code) . $limiter;
5221          }
5222       }
5223       elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) {
5224          $limiter =~ s/^([45])\.\./$1xx/;
5225          #push @reject_limiters, lc $limiter;
5226          push @new_list, lc $limiter;
5227       }
5228       else {
5229          #push @non_reject_limiters, $limiter;
5230          push @new_list, $limiter;
5231       }
5232    }
5233    #@Limiters = (@reject_limiters, @non_reject_limiters);
5234    @Limiters = @new_list;
5235 }
5236
5237
5238 # Return a usage string,  built from:
5239 #    arg1 +
5240 #    $usage_str +
5241 #    a string built from each usable entry in the @Sections table.
5242 # reject patterns are special cased to minimize the number of
5243 # command line options presented.
5244 #
5245 sub usage($) {
5246    my $ret = "";
5247    $ret = "@_\n"  if ($_[0]);
5248
5249    $ret .= $usage_str;
5250    my ($name, $desc, %reject_types);
5251    foreach my $sect (get_usable_sectvars(@Sections, 0)) {
5252
5253       if (my ($code,$rej) = ($sect->{NAME} =~ /^(...|warn)(reject.*)$/oi)) {
5254          $rej = lc $rej;
5255          next if (exists $reject_types{$rej});
5256          $reject_types{$rej}++;
5257          $name = '[###]' . $rej;
5258          $desc = '###' . substr($sect->{TITLE}, length($code));
5259       }
5260       else {
5261          $name = lc $sect->{NAME};
5262          $desc = $sect->{TITLE};
5263       }
5264       $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
5265    }
5266    $ret .= "\n";
5267    return $ret;
5268 }
5269
5270 1;
5271
5272 # vi: shiftwidth=3 tabstop=3 syntax=perl et