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   Whitelisted
1282           3   Blacklisted
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    #print "mailhost: $mailhost, servername: $server_name, servicename: $service_name, p1: $p1\n";
2719
2720    $service_name = $server_name unless $service_name;
2721    #print "service_name: $service_name\n";
2722
2723    # ignored postfix services...
2724    next if $service_name eq 'postlog';
2725    next if $service_name =~ /^$Opts{'ignore_services'}$/o;
2726
2727    # common log entries up front
2728    if ($p1 =~ s/^connect from //) {
2729       #TD25 connect from sample.net[10.0.0.1]
2730       #TD connect from mail.example.com[2001:dead:beef::1]
2731       #TD connect from localhost.localdomain[127.0.0.1]
2732       #TD connect from unknown[unknown]
2733       $Totals{'connectioninbound'}++;
2734       next unless ($Collecting{'connectioninbound'});
2735
2736       my $host = $p1;  my $hostip;
2737       if (($host,$hostip) = ($host =~ /^([^[]+)\[([^]]+)\]/)) {
2738          $host = formathost($hostip,$host);
2739       }
2740       $Counts{'connectioninbound'}{$host}++;
2741       next;
2742    }
2743
2744    if ($p1 =~ /^disconnect from /) {
2745       #TD25 disconnect from sample.net[10.0.0.1]
2746       #TD disconnect from mail.example.com[2001:dead:beef::1]
2747       $Totals{'disconnection'}++;
2748       next;
2749    }
2750
2751    if ($p1 =~ s/^connect to //) {
2752       next if ($p1 =~ /^subsystem /);
2753       $Totals{'connecttofailure'}++;
2754       next unless ($Collecting{'connecttofailure'});
2755
2756       my ($host,$hostip,$reason,$port) = ($p1 =~ /^([^[]+)\[([^]]+)\](?::\d+)?: (.*?)(?:\s+\(port (\d+)\))?$/);
2757       # all "connect to" messages indicate a problem with the connection
2758       #TDs connect to example.org[10.0.0.1]: Connection refused (port 25)
2759       #TDs connect to mail.sample.com[10.0.0.1]: No route to host (port 25)
2760       #TDs connect to sample.net[192.168.0.1]: read timeout (port 25)
2761       #TDs connect to mail.example.com[10.0.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2762       #TDs connect to mail.example.com[192.168.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2763       #TDs connect to ipv6-1.example.com[2001:dead:beef::1]: Connection refused (port 25)
2764       #TDs connect to ipv6-2.example.com[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]: Connection refused (port 25)
2765       #TDs connect to ipv6-3.example.com[1080:0:0:0:8:800:200C:4171]: Connection refused (port 25)
2766       #TDs connect to ipv6-4.example.com[3ffe:2a00:100:7031::1]: Connection refused (port 25)
2767       #TDs connect to ipv6-5.example.com[1080::8:800:200C:417A]: Connection refused (port 25)
2768       #TDs connect to ipv6-6.example.com[::192.9.5.5]: Connection refused (port 25)
2769       #TDs connect to ipv6-7.example.com[::FFFF:129.144.52.38]: Connection refused (port 25)
2770       #TDs connect to ipv6-8.example.com[2010:836B:4179::836B:4179]: Connection refused (port 25)
2771       #TDs connect to mail.example.com[10.0.0.1]: server refused to talk to me: 452 try later   (port 25)
2772
2773       $host = join(' :', $host, $port)   if ($port and $port ne '25');
2774       # Note: See ConnectToFailure below
2775       if ($reason =~ /^server (refused to talk to me): (.*)$/) {
2776          $Counts{'connecttofailure'}{ucfirst($1)}{formathost($hostip,$host)}{$2}++;
2777       } else {
2778          $Counts{'connecttofailure'}{ucfirst($reason)}{formathost($hostip,$host)}{''}++;
2779       }
2780       next;
2781    }
2782
2783 =pod
2784 real    3m43.997s
2785 user    3m39.038s
2786 sys     0m3.005s
2787 =pod
2788    # Handle before panic, fatal, warning, so that service-specific code gets first crack
2789    # XXX replace w/dispatch table for add-ins, so user's can add their own...
2790    if ($service_name eq 'postfwd')          { postfix_postfwd($p1);       next; }
2791    if ($service_name eq 'postgrey')         { postfix_postgrey($p1);      next; }
2792    if ($service_name =~ /^policyd?-spf/)    { postfix_policy_spf($p1);    next; } # postfix/policy-spf
2793    if ($service_name =~ /^policyd-?weight/) { postfix_policydweight($p1); next; } # postfix/policydweight
2794
2795 =cut
2796    # Handle policy service handlers before panic, fatal, warning, etc.
2797    # messages so that service-specific code gets first crack.
2798    # 5:25
2799    foreach (@policy_services) {
2800       if ($service_name =~ $_->[0]) {
2801          #print "Calling policy service helper: $service_name:('$p1')\n";
2802          &{$_->[1]}($p1);
2803          next LINE;
2804       }
2805    };
2806 #=cut
2807
2808    # ^warning: ...
2809    # ^fatal: ...
2810    # ^panic: ...
2811    # ^error: ...
2812    if ($p1 =~ /^warning: +(.*)$/)           { postfix_warning($1); next; }
2813    if ($p1 =~ /^fatal: +(.*)$/)             { postfix_fatal($1);   next; }
2814    if ($p1 =~ /^panic: +(.*)$/)             { postfix_panic($1);   next; }
2815    if ($p1 =~ /^error: +(.*)$/)             { postfix_error($1);   next; }
2816
2817    # output by all services that use table lookups - process before specific messages
2818    if ($p1 =~ /(?:lookup )?table (?:[^ ]+ )?has changed -- (?:restarting|exiting)$/) {
2819       #TD table hash:/var/mailman/data/virtual-mailman(0,lock|fold_fix) has changed -- restarting
2820       #TD table hash:/etc/postfix/helo_checks has changed -- restarting
2821       $Totals{'tablechanged'}++;
2822       next;
2823    }
2824
2825    # postfix/postscreen and postfix/verify services
2826    if ($service_name eq 'postscreen'
2827     or $service_name eq 'verify')          { postfix_postscreen($p1); next; }    # postfix/postscreen, postfix/verify
2828    if ($service_name eq 'dnsblog')         { postfix_dnsblog($p1);    next; }    # postfix/dnsblog
2829    if ($service_name =~ /^cleanup/)        { postfix_cleanup($p1);    next; }    # postfix/cleanup*
2830    if ($service_name =~ /^bounce/)         { postfix_bounce($p1);     next; }    # postfix/bounce*
2831    if ($service_name eq 'postfix-script')  { postfix_script($p1);     next; }    # postfix/postfix-script
2832    if ($service_name eq 'postsuper')       { postfix_postsuper($p1);  next; }    # postfix/postsuper
2833
2834    # ignore tlsproxy for now
2835    if ($service_name eq 'tlsproxy')        { next; }                             # postfix/tlsproxy
2836
2837    my ($helo, $relay, $from, $origto, $to, $domain, $status,
2838        $type, $reason, $reason2, $filter, $site, $cmd, $qid,
2839        $rej_type, $reject_name, $host, $hostip, $dsn, $reply, $fmthost, $bytes);
2840
2841    $rej_type = undef;
2842
2843    # ^$re_QID: ...
2844    if ($p1 =~ s/^($re_QID): //o) {
2845       $qid = $1;
2846
2847       next if ($p1 =~ /^host \S*\[\S*\] said: 4\d\d/);  # deferrals, picked up in "status=deferred"
2848
2849       if ($p1 =~ /^removed\s*$/ ) {
2850          # Note: See REMOVED elsewhere
2851          # 52CBDC2E0F: removed
2852          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
2853          $Totals{'removedfromqueue'}++;
2854          next;
2855       }
2856
2857       # coerce into general warning
2858       if (($p1 =~ /^Cannot start TLS: handshake failure/) or
2859           ($p1 =~ /^non-E?SMTP response from/)) {
2860          postfix_warning($p1);
2861          next;
2862       }
2863
2864       if ($p1 eq 'status=deferred (bounce failed)') {
2865          #TDqQ status=deferred (bounce failed)
2866          $Totals{'bouncefailed'}++;
2867          next;
2868       }
2869
2870       # this test must preceed access checks below
2871       #TDsQ  replace: header From:     "Postmaster" <postmaster@webmail.example.com>: From:     "Postmaster" <postmaster@webmail.example.org>
2872       if ($service_name eq 'smtp' and header_body_checks($p1)) {
2873          #print "main: header_body_checks\n";
2874          next;
2875       }
2876
2877       # Postfix access actions
2878       #   REJECT optional text...
2879       #   DISCARD optional text...
2880       #   HOLD optional text...
2881       #   WARN optional text...
2882       #   FILTER transport:destination
2883       #   REDIRECT user@domain
2884       #   BCC user@domain  (2.6 experimental branch)
2885       # The following actions are indistinguishable in the logs
2886       #   4NN text
2887       #   5NN text
2888       #   DEFER_IF_REJECT optional text...
2889       #   DEFER_IF_PERMIT optional text...
2890       #   UCE restriction...
2891       # The following actions are not logged
2892       #   PREPEND headername: headervalue
2893       #   DUNNO
2894       #
2895       # Reject actions based on remote client information:
2896       #     - one of host name, network address, envelope sender
2897       #   or
2898       #     - recipient address
2899
2900       # Template of access controls.  Rejects look like the first line, other access actions the second.
2901       # ftph is envelope from, envelope to, proto and helo.
2902       # QID: ACTION  STAGE from host[hostip]: DSN       trigger: explanation; ftph
2903       # QID: ACTION  STAGE from host[hostip]: trigger:           explanation; ftph
2904
2905       # $re_QID: reject: RCPT|MAIL|CONNECT|HELO|DATA from ...
2906       # $re_QID: reject_warning: RCPT|MAIL|CONNECT|HELO|DATA from ...
2907       if ($p1 =~ /^(reject(?:_warning)?|discard|filter|hold|redirect|warn|bcc|replace): /) {
2908          my $action = $1;
2909          $p1 = substr($p1, length($action) + 2);
2910
2911          #print "action: \"$action\", p1: \"$p1\"\n";
2912          if ($p1 !~ /^(RCPT|MAIL|CONNECT|HELO|EHLO|DATA|VRFY|ETRN|END-OF-MESSAGE) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
2913             inc_unmatched('unexpected access');
2914             next;
2915          }
2916          my ($stage,$host,$hostip,$p1) = ($1,$2,$3,$4);    #print "stage: \"$stage\", host: \"$host\", hostip: \"$hostip\", p1: \"$p1\"\n";
2917          my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);  #print "efrom: \"$efrom\", eto: \"$eto\", proto: \"$proto\", helo: \"$helo\"\n";
2918                                                            #print "p1 now: \"$p1\"\n";
2919
2920 # QID: ACTION         STAGE from host[hostip]:   DSN       trigger:          explanation;                                                       ftph
2921 #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>
2922 #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>
2923 #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
2924 #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
2925 #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>
2926 #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>
2927 #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>
2928 #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>
2929 #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>
2930 #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]>
2931 #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>
2932 #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>
2933 #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>
2934 #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>
2935 #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>
2936 #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>
2937 #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>
2938 #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>
2939 #TDsdN reject_warning: HELO from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                                                                        proto=SMTP  helo=<example.com>
2940 #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>
2941 #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>
2942 #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>
2943 #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>
2944 #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>
2945 #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
2946
2947 #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>
2948 #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>
2949 #TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];                                                proto=ESMTP
2950 #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]
2951 #TDsdN reject:      CONNECT from unk[unknown]:  421 4.7.1                    Client host rejected: cannot find your reverse hostname, [unknown];                                         proto=SMTP
2952
2953 #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>
2954 #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>
2955 #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>
2956 #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>
2957 #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>
2958 #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>
2959 #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>
2960 #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>
2961 #TDsdN reject:         RCPT from host[10.0.0.1]: 452                         Insufficient system storage;                                      from=<f@sample.com> to=<eto@sample.net>
2962 #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>
2963 #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>
2964 #TDsdN reject:         MAIL from host[10.0.0.1]: 552                         Message size exceeds fixed limit;                                                                          proto=ESMTP helo=<localhost>
2965 #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>
2966 #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>
2967
2968          # reject, reject_warning
2969          if ($action =~ /^reject/) {
2970             my ($recip);
2971
2972             if ($p1 !~ /^($re_DSN) (.*)$/o) {
2973                inc_unmatched('reject1');
2974                next;
2975             }
2976             ($dsn,$p1) = ($1,$2);                        #print "dsn: $dsn, p1: \"$p1\"\n";
2977             $fmthost = formathost($hostip,$host);
2978
2979             # reject_warning override temp or perm reject types
2980             $rej_type = ($action eq 'reject_warning' ? 'warn' : get_reject_key($dsn));
2981             #print "REJECT stage: '$rej_type'\n";
2982
2983             if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
2984                $Counts{'byiprejects'}{$fmthost}++;
2985             }
2986
2987             if ($stage eq 'VRFY') {
2988                if ($p1 =~ /^(?:<(\S*)>: )?(.*);$/) {
2989                   my ($trigger,$reason) = ($1,$2);
2990                   $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name});
2991
2992                   if ($reason =~ /^Service unavailable; Client host \[[^]]+\] (blocked using [^;]*);/) {
2993                      $reason = join (' ', 'Client host blocked using', $1);
2994                      $trigger = '';
2995                   }
2996                   $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++;
2997                } else {
2998                   inc_unmatched('vrfyfrom');
2999                }
3000                next;
3001             }
3002
3003             # XXX there may be several semicolon-separated messages
3004             # Recipient address rejected: Unknown users and via check_recipient_access
3005             if ($p1 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/) {
3006                ($recip,$reason) = ($1,$2);
3007
3008                my ($localpart,$domainpart);
3009                # Unknown users; local mailbox, alias, virtual, relay user, unspecified
3010                if ($recip eq '') { ($localpart, $domainpart) = ('<>', '*unspecified'); }
3011                else {
3012                   ($localpart, $domainpart) = split (/@/, lc $recip);
3013                   ($localpart, $domainpart) = ($recip, '*unspecified')   if ($domainpart eq '');
3014                }
3015
3016                if ($reason =~ s/^User unknown *//) {
3017                   $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name});
3018
3019                   my ($table) = ($reason =~ /^in ((?:\w+ )+table)/);
3020                   $table = 'Address table unavailable'  if ($table eq '');     # when show_user_unknown_table_name=no
3021                   $Counts{$reject_name}{ucfirst($table)}{$domainpart}{$localpart}{$fmthost}++;
3022                } else {
3023                   # check_recipient_access
3024                   $Totals{$reject_name = "${rej_type}rejectrecip" }++; next unless ($Collecting{$reject_name});
3025
3026                   if ($reason =~ m{^Please see http://[^/]+/why\.html}) {
3027                      $reason = 'SPF reject';
3028                   }
3029                   elsif ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3030                      $reason = 'undeliverable address: remote host rejected recipient';
3031                   }
3032                   $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++;
3033                }
3034
3035             } elsif ($p1 =~ /^<(.*?)>.* Relay access denied/) {
3036                $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name});
3037                $Counts{$reject_name}{$fmthost}{$eto}++;
3038
3039             } elsif ($p1 =~ /^<(.*)>: Sender address rejected: (.*);/) {
3040                $Totals{$reject_name = "${rej_type}rejectsender" }++;  next unless ($Collecting{$reject_name});
3041                ($from,$reason) =  ($1,$2);
3042
3043                if ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3044                   $reason = 'undeliverable address: remote host rejected sender';
3045                }
3046                $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++;
3047
3048             } elsif ($p1 =~ /^(?:<.*>: )?Unverified Client host rejected: /) {
3049                # check_reverse_client_hostname_access (postfix 2.6+)
3050                $Totals{$reject_name = "${rej_type}rejectunverifiedclient" }++; next unless ($Collecting{$reject_name});
3051                $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3052
3053             } elsif ($p1 =~ s/^(?:<.*>: )?Client host rejected: //) {
3054                # reject_unknown_client
3055                #   client IP->name mapping fails
3056                #   name->IP mapping fails
3057                #   name->IP mapping =! client IP
3058                if ($p1 =~ /^cannot find your hostname/) {
3059                   $Totals{$reject_name = "${rej_type}rejectunknownclient" }++; next unless ($Collecting{$reject_name});
3060                   $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3061                }
3062                # reject_unknown_reverse_client_hostname (no PTR record for client's IP)
3063                elsif ($p1 =~ /^cannot find your reverse hostname/) {
3064                   $Totals{$reject_name = "${rej_type}rejectunknownreverseclient" }++; next unless ($Collecting{$reject_name});
3065                   $Counts{$reject_name}{$hostip}++
3066                }
3067                else {
3068                   $Totals{$reject_name = "${rej_type}rejectclient" }++; next unless ($Collecting{$reject_name});
3069                   $p1 =~ s/;$//;
3070                   $Counts{$reject_name}{ucfirst($p1)}{$fmthost}{$eto}{$efrom}++;
3071                }
3072             } elsif ($p1 =~ /^Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/) {
3073                # Note: similar code below: search RejectRBL
3074
3075                # postfix 2.1
3076                #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>
3077                # postfix 2.3+
3078                #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>
3079                #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>
3080
3081                $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3082                ($site,$reason) = ($1 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3083                $reason =~ s/^reason: // if ($reason);
3084                $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++;
3085
3086             } elsif ($p1 =~ /^<.*>: Helo command rejected: (.*);$/) {
3087                $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name});
3088                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3089
3090             } elsif ($p1 =~ /^<.*>: Etrn command rejected: (.*);$/) {
3091                $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name});
3092                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3093
3094             } elsif ($p1 =~ /^<.*>: Data command rejected: (.*);$/) {
3095                $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name});
3096                $Counts{$reject_name}{$1}{$fmthost}{$helo}++;
3097
3098             } elsif ($p1 =~ /^Insufficient system storage;/) {
3099                $Totals{'warninsufficientspace'}++;    # force display in Warnings section also
3100                $Totals{$reject_name = "${rej_type}rejectinsufficientspace" }++; next unless ($Collecting{$reject_name});
3101                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3102
3103             } elsif ($p1 =~ /^Server configuration (?:error|problem);/) {
3104                $Totals{'warnconfigerror'}++;          # force display in Warnings section also
3105                $Totals{$reject_name = "${rej_type}rejectconfigerror" }++; next unless ($Collecting{$reject_name});
3106                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3107
3108             } elsif ($p1 =~ /^Message size exceeds fixed limit;$/) {
3109                # Postfix responds with this message after a MAIL FROM:<...> SIZE=nnn  command, where postfix consider's nnn excessive
3110                # Note: similar code below: search RejectSize
3111                # Note: reject_warning does not seem to occur
3112                $Totals{$reject_name = "${rej_type}rejectsize" }++; next unless ($Collecting{$reject_name});
3113                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3114
3115             } elsif ($p1 =~ /^<(.*?)>: Temporary lookup failure;/) {
3116                $Totals{$reject_name = "${rej_type}rejectlookupfailure" }++; next unless ($Collecting{$reject_name});
3117                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3118
3119             # This would capture all other rejects, but I think it might be more useful to add
3120             # additional capture sections based on user reports of uncapture lines.
3121             #
3122             #} elsif ( ($reason) = ($p1 =~ /^([^;]+);/)) {
3123             #  $Totals{$rej_type . 'rejectother'}++;
3124             #  $Counts{$rej_type . 'rejectother'}{$reason}++;
3125             } else {
3126                inc_unmatched('rejectother');
3127             }
3128          }
3129          # end of $re_QID: reject:
3130
3131 # QID: ACTION         STAGE from host[hostip]:   trigger:                    reason;                                                            ftph
3132 #
3133 #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>
3134 #TDsdN warn:           RCPT from host[10.0.0.1]:                             ;                                                                  from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.net>
3135 #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>
3136 #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>
3137 #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>
3138 #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>
3139 #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>
3140 #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>
3141 #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>
3142 #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>
3143 #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>
3144 #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>
3145 #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>
3146
3147 # BCC action (postfix 2.6+)
3148 #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>
3149
3150          # $re_QID: discard, filter, hold, redirect, warn, bcc, replace ...
3151          else {
3152             my $trigger;
3153             ($trigger,$reason) = ($p1 =~ /^(?:<(\S*)>: )?(.*);$/ );
3154             if ($trigger eq '') {   $trigger = '*unavailable';  }
3155             else {                  $trigger =~ s/^<(.+)>$/$1/; }
3156             $reason  = '*unavailable' if ($reason eq '');
3157             $fmthost = formathost ($hostip,$host);
3158             #print "trigger: \"$trigger\", reason: \"$reason\"\n";
3159
3160             # reason -> subject text
3161             #           subject -> "Helo command"           : smtpd_helo_restrictions
3162             #           subject -> "Client host"            : smtpd_client_restrictions
3163             #           subject -> "Unverified Client host" : smtpd_client_restrictions
3164             #           subject -> "Client certificate"     : smtpd_client_restrictions
3165             #           subject -> "Sender address"         : smtpd_sender_restrictions
3166             #           subject -> "Recipient address"      : smtpd_recipient_restrictions
3167
3168             #           subject -> "Data command"           : smtpd_data_restrictions
3169             #           subject -> "End-of-data"            : smtpd_end_of_data_restrictions
3170             #           subject -> "Etrn command"           : smtpd_etrn_restrictions
3171
3172             #           text    -> triggers <ACTION> action|triggers <ACTION> <destination>|optional text...
3173
3174             my ($subject, $text) =
3175                ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o);
3176             #printf "ACTION: '$action', SUBJECT: %-30s TEXT: \"$text\"\n", '"' . $subject . '"';
3177
3178             if ($action eq 'filter') {
3179                $Totals{'filtered'}++; next unless ($Collecting{'filtered'});
3180                # See "Note: Counts" before changing $Counts below re: Filtered
3181                $text =~ s/triggers FILTER //;
3182                if    ($subject eq 'Recipient address') { $Counts{'filtered'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3183                elsif ($subject =~ /Client host$/)      { $Counts{'filtered'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3184                else                                    { $Counts{'filtered'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3185             }
3186             elsif ($action eq 'redirect') {
3187                $Totals{'redirected'}++; next unless ($Collecting{'redirected'});
3188                $text =~ s/triggers REDIRECT //;
3189                # See "Note: Counts" before changing $Counts below re: Redirected
3190                if    ($subject eq 'Recipient address') { $Counts{'redirected'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3191                elsif ($subject =~ /Client host$/)      { $Counts{'redirected'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3192                else                                    { $Counts{'redirected'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3193             }
3194             # hold, discard, and warn allow "optional text"
3195             elsif ($action eq 'hold') {
3196                $Totals{'hold'}++; next unless ($Collecting{'hold'});
3197                # See "Note: Counts" before changing $Counts below re: Hold
3198                $subject = $reason unless $text eq 'triggers HOLD action';
3199                if    ($subject eq 'Recipient address') { $Counts{'hold'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3200                elsif ($subject =~ /Client host$/)      { $Counts{'hold'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3201                else                                    { $Counts{'hold'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3202             }
3203             elsif ($action eq 'discard') {
3204                $Totals{'discarded'}++; next unless ($Collecting{'discarded'});
3205                # See "Note: Counts" before changing $Counts below re: Discarded
3206                $subject = $reason unless $text eq 'triggers DISCARD action';
3207                if    ($subject eq 'Recipient address') { $Counts{'discarded'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3208                elsif ($subject =~ /Client host$/)      { $Counts{'discarded'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3209                else                                    { $Counts{'discarded'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3210             }
3211             elsif ($action eq 'warn') {
3212                $Totals{'warned'}++; next unless ($Collecting{'warned'});
3213                $Counts{'warned'}{$reason}{$fmthost}{$eto}{''}++;
3214                # See "Note: Counts" before changing $Counts above...
3215             }
3216             elsif ($action eq 'bcc') {
3217                $Totals{'bcced'}++; next unless ($Collecting{'bcced'});
3218                # See "Note: Counts" before changing $Counts below re: Filtered
3219                $text =~ s/triggers BCC //o;
3220                if    ($subject eq 'Recipient address') { $Counts{'bcced'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3221                elsif ($subject =~ /Client host$/)      { $Counts{'bcced'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3222                else                                    { $Counts{'bcced'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3223             }
3224             else {
3225                die "Unexpected ACTION: '$action'";
3226             }
3227          }
3228       }
3229
3230       elsif ($p1 =~ s/^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)//) {
3231          my ($hip,$host,$hostip) = ($1,$2,$3);
3232
3233          # Increment accepted when the client connection is made and smtpd has a QID.
3234          # Previously, accepted was being incorrectly incremented when the first qmgr
3235          # "from=xxx, size=nnn ..." line was seen.  This is erroneous when the smtpd
3236          # client connection occurred outside the date range of the log being analyzed.
3237          $AcceptedByQid{$qid} = $hip;
3238          $Totals{'msgsaccepted'}++;
3239
3240          #TDsdQ client=unknown[192.168.0.1]
3241          #TDsdQ client=unknown[192.168.0.1]:unknown
3242          #TDsdQ client=unknown[192.168.0.1]:10025
3243          #TDsd client=example.com[192.168.0.1], helo=example.com
3244          #TDsdQ client=mail.example.com[2001:dead:beef::1]
3245
3246          #TDsdQ client=localhost[127.0.0.1], sasl_sender=someone@example.com
3247          #TDsdQ client=example.com[192.168.0.1], sasl_method=PLAIN, sasl_username=anyone@sample.net
3248          #TDsdQ client=example.com[192.168.0.1], sasl_method=LOGIN, sasl_username=user@example.com, sasl_sender=<id352ib@sample.net>
3249          #TDsdQ client=unknown[10.0.0.1], sasl_sender=user@examine.com
3250          next if ($p1 eq '');
3251          my ($method,$user,$sender) = ($p1 =~ /^(?:, sasl_method=([^,]+))?(?:, sasl_username=([^,]+))?(?:, sasl_sender=<?(.*)>?)?$/);
3252
3253          # sasl_sender occurs when AUTH verb is present in MAIL FROM, typically used for relaying
3254          # the username (eg. sasl_username) of authenticated users.
3255          if ($sender or $method or $user) {
3256             $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'});
3257             $method ||= '*unknown method';
3258             $user   ||= '*unknown user';
3259             $Counts{'saslauth'}{$user . ($sender ? " ($sender)" : '')}{$method}{formathost($hostip,$host)}++;
3260          }
3261       }
3262
3263       # ^$re_QID: ...  (not access(5) action)
3264       elsif ($p1 =~ /^from=<(.*?)>, size=(\d+), nrcpt=(\d+)/) {
3265          my ($efrom,$bytes,$nrcpt) = ($1,$2,$3);
3266          #TDsdQ from=<FROM: SOME USER@example.com>, size=4051, nrcpt=1 (queue active)
3267          #TDsdQ(12) from=<anyone@example.com>, size=25302, nrcpt=2 (queue active)
3268          #TDsdQ from=<from@example.com>, size=5529, nrcpt=1 (queue active)
3269          #TDsdQ from=<from@example.net, @example.com>, size=5335, nrcpt=1 (queue active)
3270
3271          # Distinguish bytes accepted vs. bytes delivered due to multiple recips
3272
3273          # Increment bytes accepted on the first qmgr "from=..." line...
3274          next if (exists $SizeByQid{$qid});
3275          $SizeByQid{$qid}          = $bytes;
3276          # ...but only when the smtpd "client=..." line has been seen too.
3277          # This under-counts when the smtpd "client=..." connection log entry and the
3278          # qmgr "from=..." log entry span differnt periods (as fed to postfix-logwatch).
3279          next if (! exists $AcceptedByQid{$qid});
3280
3281          $Totals{'bytesaccepted'} += $bytes;
3282
3283          $Counts{'envelopesenders'}{$efrom ne '' ? $efrom : '<>'}++      if ($Collecting{'envelopesenders'});
3284          if ($Collecting{'envelopesenderdomains'}) {
3285             my ($localpart, $domain);
3286             if ($efrom eq '') { ($localpart, $domain) = ('<>', '*unknown'); }
3287             else              { ($localpart, $domain) = split (/@/, lc $efrom); }
3288
3289             $Counts{'envelopesenderdomains'}{$domain ne '' ? $domain : '*unknown'}{$localpart}++;
3290          }
3291          delete $AcceptedByQid{$qid};           # prevent incrementing BytesAccepted again
3292       }
3293
3294       ### sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3295       elsif ($p1 =~ s/^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=(\S+) //o) {
3296          ($relay,$status) = ($3,$5);
3297
3298          my ($to,$origto,$localpart,$domainpart,$dsn,$p1) = process_delivery_attempt ($1,$2,$4,$p1);
3299
3300          #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)
3301          #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)
3302          #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)
3303
3304          ### sent
3305          if ($status eq 'sent') {
3306             if ($p1 =~ /forwarded as /) {
3307                $Totals{'bytesforwarded'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3308                $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'});
3309                $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++;
3310             }
3311             else {
3312                if ($service_name eq 'lmtp') {
3313                   $Totals{'bytessentlmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3314                   $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'});
3315                   $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++;
3316                }
3317                elsif ($service_name eq 'smtp') {
3318                   $Totals{'bytessentsmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3319                   $Totals{'sent'}++; next unless ($Collecting{'sent'});
3320                   $Counts{'sent'}{$domainpart}{$localpart}{$origto}++;
3321                }
3322                # virtual, command, ...
3323                else {
3324                   $Totals{'bytesdelivered'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3325                   $Totals{'delivered'}++; next unless ($Collecting{'delivered'});
3326                   $Counts{'delivered'}{$domainpart}{$localpart}{$origto}++;
3327                }
3328             }
3329          }
3330
3331          elsif ($status eq 'deferred') {
3332             #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)
3333             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused)
3334             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused)
3335             #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)
3336             #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)
3337             #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)
3338             #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)
3339             #TDsQ to=<to@localhost>, orig_to=<toalias@localhost>, relay=none, delay=238024, status=deferred (delivery temporarily suspended: transport is unavailable)
3340
3341             # XXX postfix reports dsn=5.0.0, host's reply may contain its own dsn's such as 511 and #5.1.1
3342             # XXX should these be used instead?
3343             #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))
3344             #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))
3345             #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))
3346
3347             ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3348
3349             $Totals{'deferred'}++      if ($DeferredByQid{$qid}++ == 0);
3350             $Totals{'deferrals'}++;    next unless ($Collecting{'deferrals'});
3351             $Counts{'deferrals'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3352          }
3353
3354          ### bounced
3355          elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') {
3356             # local agent
3357             #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")
3358
3359             # smtp agent
3360             #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))
3361
3362             #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))
3363             #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))
3364
3365
3366             #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)
3367             #TDsQ to=<>,                                   relay=none,  delay=1,                                       status=bounced (mail for sample.net loops back to myself)
3368             #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)
3369             # XXX verify these...
3370             #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=none, delay=1, status=bounced (User unknown in virtual alias table)
3371             #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)
3372             #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")
3373             #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")
3374
3375             #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))
3376             #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))
3377             #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))
3378             #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))
3379             #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))
3380             #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))
3381             #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")
3382
3383             # print "bounce message from " . $to . " msg : " . $relay . "\n";
3384
3385             # See same code elsewhere "Note: Bounce"
3386             ### local bounce
3387             # XXX local v. remote bounce seems iffy, relative
3388             if ($relay =~ /^(?:none|local|virtual|127\.0\.0\.1|maildrop|avcheck)/) {
3389                $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'});
3390                $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($p1)}{$localpart}++;
3391             }
3392             else {
3393                $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'});
3394                ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3395                $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
3396             }
3397          }
3398
3399
3400          elsif ($status =~ 'undeliverable') {
3401             #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)
3402             #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))
3403             #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")
3404             #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")
3405             $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'});
3406             if ($p1 =~ /^unknown user: ".+?"$/) {
3407                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{'Unknown user'}{$domainpart}{$localpart}{$origto ? $origto : ''}++;
3408             }
3409             else {
3410                my ($reply,$fmthost) = cleanhostreply($p1,'',$to ne '' ? $to : '<>',$domainpart);
3411                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3412             }
3413          }
3414
3415          elsif ($status eq 'deliverable') {
3416             # address verification, sendmail -bv deliverable reports
3417             #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)
3418             $Totals{'deliverable'}++; next unless ($Collecting{'deliverable'});
3419             my $dsn = ($p1 =~ s/^($re_DSN) // ? $1 : '*unavailable');
3420             $Counts{'deliverable'}{$dsn}{$p1}{$origto ? "$to ($origto)" : $to}++;
3421          }
3422
3423          else {
3424             # keep this as the last condition in this else clause
3425             inc_unmatched('unknownstatus');
3426          }
3427       } # end of sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3428
3429       # pickup
3430       elsif ($p1 =~ /^(uid=\S* from=<.*?>)/) {
3431          #TDpQ2 uid=0 from=<root>
3432          $AcceptedByQid{$qid} = $1;
3433          $Totals{'msgsaccepted'}++;
3434       }
3435
3436       elsif ($p1 =~ /^from=<(.*?)>, status=expired, returned to sender$/) {
3437          #TDqQ from=<from@example.com>, status=expired, returned to sender
3438          $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'});
3439          $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++;
3440       }
3441
3442       elsif ($p1 =~ s/^host ([^[]+)\[([^]]+)\](?::\d+)? refused to talk to me://) {
3443          #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
3444          #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 501 Connection from 192.168.2.1 (XY) rejected
3445          # Note: See ConnectToFailure above
3446          $Totals{'connecttofailure'}++; next unless ($Collecting{'connecttofailure'});
3447          $Counts{'connecttofailure'}{'Refused to talk to me'}{formathost($2,$1)}{$p1}++;
3448       }
3449
3450       elsif ($p1 =~ /^lost connection with ([^[]*)\[([^]]+)\](?::\d+)? (while .*)$/) {
3451          # outbound smtp
3452          #TDsQ lost connection with sample.net[10.0.0.1] while sending MAIL FROM
3453          #TDsQ lost connection with sample.net[10.0.0.2] while receiving the initial server greeting
3454          $Totals{'connectionlostoutbound'}++; next unless ($Collecting{'connectionlostoutbound'});
3455          $Counts{'connectionlostoutbound'}{ucfirst($3)}{formathost($2,$1)}++;
3456       }
3457
3458       elsif ($p1 =~ /^conversation with ([^[]*)\[([^]]+)\](?::\d+)? timed out (while .*)$/) {
3459          #TDsQ conversation with sample.net[10.0.0.1] timed out while receiving the initial SMTP greeting
3460          # Note: see TimeoutInbound below
3461          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3462          $Counts{'timeoutinbound'}{ucfirst($3)}{formathost($2,$1)}{''}++;
3463       }
3464
3465       elsif ($p1 =~ /^enabling PIX (<CRLF>\.<CRLF>) workaround for ([^[]+)\[([^]]+)\](?::\d+)?/ or
3466              $p1 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[([^]]+)\](?::\d+)?/) {
3467          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for example.com[192.168.0.1]
3468          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for mail.sample.net[10.0.0.1]:25
3469          #TDsQ enabling PIX workarounds: disable_esmtp delay_dotcrlf for spam.example.org[10.0.0.1]:25
3470          $Totals{'pixworkaround'}++; next unless ($Collecting{'pixworkaround'});
3471          $Counts{'pixworkaround'}{$1}{formathost($3,$2)}++;
3472       }
3473
3474       # milter-reject, milter-hold, milter-discard
3475       elsif ($p1 =~ s/^milter-//) {
3476          milter_common($p1);
3477       }
3478
3479       elsif ($p1 =~ s/^SASL (\[CACHED\] )?authentication failed; //) {
3480          #TDsQ SASL authentication failed; cannot authenticate to server smtp.example.com[10.0.0.1]: no mechanism available
3481          #TDsQ SASL authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3482          #TDsQ SASL [CACHED] authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3483          # see saslauthfail elsewhere
3484
3485          $Totals{'saslauthfail'}++; next unless ($Collecting{'saslauthfail'});
3486          my $cached = $1;
3487
3488          if ($p1 =~ /^(authentication protocol loop with server): ([^[]+)\[([^]]+)\](?::\d+)?$/) {
3489             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,'');
3490          }
3491          elsif ($p1 =~ /^(cannot authenticate to server) ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
3492             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,$4);
3493          }
3494          elsif ($p1 =~ /^server ([^[]+)\[([^]]+)\](?::\d+)? said: (.+)$/) {
3495             ($reason,$host,$hostip,$reason2) = ('server ... said',$1,$2,$3);
3496          }
3497          else {
3498             inc_unmatched('saslauthfail');
3499             next;
3500          }
3501
3502          $reason .= ': ' . $reason2  if $reason2;
3503          $Counts{'saslauthfail'}{$cached . $reason}{formathost($hostip,$host)}++;
3504       }
3505
3506       else {
3507          # keep this as the last condition in this else clause
3508          inc_unmatched('unknownqid')  if  ! in_ignore_list ($p1);
3509       }
3510    }
3511    # end of $re_QID section
3512
3513    elsif ($p1 =~ /^(timeout|lost connection) (after [^ ]+)(?: \((?:approximately )?(\d+) bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3514       my ($lort,$reason,$bytes,$host,$hostip) = ($1,$2,$3,$4,$5);
3515       if ($lort eq 'timeout') {
3516          # see also TimeoutInbound in $re_QID section
3517          #TDsd timeout after RSET from example.com[192.168.0.1]
3518          #TDsd timeout after DATA (6253 bytes) from example.com[10.0.0.1]
3519
3520          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3521          $Counts{'timeoutinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3522       } else {
3523          #TDsd lost connection after CONNECT from mail.example.com[192.168.0.1]
3524          # postfix 2.5:20071003
3525          #TDsd lost connection after DATA (494133 bytes) from localhost[127.0.0.1]
3526          # postfix 2.6:20080621
3527          #TDsd lost connection after DATA (approximately 0 bytes) from example.com[10.0.0.1]
3528
3529          $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'});
3530          $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3531       }
3532    }
3533
3534    elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ($re_DSN) Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/o) {
3535       my ($rej_type,$host,$hostip,$dsn,)  = ($1,$2,$3,$4);
3536       ($site,$reason) = ($5 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3537       $reason =~ s/^reason: // if ($reason);
3538       $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn));
3539       #print "REJECT RBL NOQ: '$rej_type'\n";
3540       # Note: similar code above: search RejectRBL
3541
3542       # This section required: postfix didn't always log QID (eg. postfix 1.1)
3543       # Also, "reason:" was probably always present in this case, but I'm not certain
3544       # postfix 1.1
3545       #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>
3546       #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>
3547       #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>
3548       #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>
3549
3550       if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
3551          $fmthost = formathost($hostip,$host);
3552          $Counts{'byiprejects'}{$fmthost}++;
3553       }
3554
3555       $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3556       $Counts{$reject_name}{$site}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reason ? $reason : ''}++;
3557    }
3558
3559    # proxy-reject, proxy-accept
3560    elsif ($p1 =~ s/^proxy-(reject|accept): ([^:]+): //) {
3561       # 2.7
3562       #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>
3563       #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>
3564       #TDsdN proxy-reject: END-OF-MESSAGE: ; from=<user@example.com> to=<user@example.org> proto=SMTP helo=<mail.example.net>
3565
3566       next if $1 eq 'accept';    #ignore accepts
3567
3568       my ($stage) = ($2);
3569       my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
3570       #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
3571       #print "stage: '$stage', reply: '$p1'\n";
3572
3573       my ($dsn,$reject_name);
3574       ($dsn,$reply) = ($1,$2)    if $p1 =~ /^($re_DSN) (.*)$/o;
3575       #print "   dsn: '$dsn', reply: '$reply', key: ", get_reject_key($dsn), "\n";
3576       # DSN may not be present. Can occur, for example, when queue file size limit is reached,
3577       # which is logged as a Warning.  Ignore these, since they can't be add to any
3578       # reject section (no SMTP reply code).
3579       if (! defined $dsn) {
3580          next;
3581       }
3582
3583       $Totals{$reject_name = get_reject_key($dsn) . 'rejectproxy' }++; next unless ($Collecting{$reject_name});
3584       $Counts{$reject_name}{$stage}{$reply}{$eto}++;
3585    }
3586
3587    ### smtpd_tls_loglevel >= 1
3588    # Server TLS messages
3589    elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/)) {
3590       #TDsd TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3591       # Postfix 2.5+: status: Untrusted or Trusted
3592       #TDsd Untrusted TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3593       #TDsd Anonymous TLS connection established from localhost[127.0.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3594
3595       $Totals{'tlsserverconnect'}++; next unless ($Collecting{'tlsserverconnect'});
3596       $Counts{'tlsserverconnect'}{$status ? "$status: $type" : $type}{formathost($hostip,$host)}++;
3597    }
3598
3599    # Client TLS messages
3600    elsif ( ($status,$host,$type) = ($p1 =~ /^(?:(Verified|Trusted|Untrusted|Anonymous) )?TLS connection established to ([^ ]*): (.*)$/o)) {
3601       #TD TLS connection established to example.com: TLSv1 with cipher AES256-SHA (256/256 bits)
3602       # Postfix 2.5+: peer verification status: Untrusted, Trusted or Verified when
3603       # server's trust chain is valid and peername is matched
3604       #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)
3605
3606       $Totals{'tlsclientconnect'}++; next unless ($Collecting{'tlsclientconnect'});
3607       $Counts{'tlsclientconnect'}{$status ? "$status: $type" : $type}{$host}++;
3608    }
3609
3610    # smtp_tls_note_starttls_offer=yes
3611    elsif ($p1 =~ /^Host offered STARTTLS: \[(.*)\]$/o) {
3612       #TD Host offered STARTTLS: [mail.example.com]
3613       $Totals{'tlsoffered'}++; next unless ($Collecting{'tlsoffered'});
3614       $Counts{'tlsoffered'}{$1}++;
3615    }
3616
3617    ### smtpd_tls_loglevel >= 1
3618    elsif ($p1 =~ /^Unverified: (.*)/o) {
3619       #TD Unverified: subject_CN=(www|smtp|mailhost).(example.com|sample.net), issuer=someuser
3620       $Totals{'tlsunverified'}++; next unless ($Collecting{'tlsunverified'});
3621       $Counts{'tlsunverified'}{$1}++;
3622    }
3623
3624    # Note: no QID
3625    elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<(.*?)> to=<(.*?)>/)) {
3626       #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>
3627       #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>
3628       # Note: similar code above: search RejectSize
3629       # Note: reject_warning does not seem to occur
3630       if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
3631          $fmthost = formathost($hostip,$host);
3632          $Counts{'byiprejects'}{$fmthost}++;
3633       }
3634       $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name});
3635       $Counts{$reject_name}{$fmthost ? $fmthost : formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++;
3636    }
3637
3638    elsif ($p1 =~ /looking for plugins in (.*)$/) {
3639     #TD looking for plugins in '/usr/lib/sasl2', failed to open directory, error: No such file or directory
3640       $Totals{'warnconfigerror'}++; next unless ($Collecting{'warnconfigerror'});
3641       $Counts{'warnconfigerror'}{$1}++;
3642    }
3643
3644    # SMTP/ESMTP protocol violations
3645    elsif ($p1 =~ /^(improper command pipelining) (after \S+) from ([^[]*)\[([^]]+)\](?::\d+)?/) {
3646       # ProtocolViolation
3647       #TDsd postfix/smtpd[24928]: improper command pipelining after RCPT from unknown[192.168.0.1]
3648       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3649       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3650       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3651    }
3652
3653    elsif ($p1 =~ /^(too many errors) (after [^ ]*)(?: \((?:approximately )?\d+ bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3654       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3655       #TDsd too many errors after AUTH from sample.net[10.0.0.1]
3656       #TDsd too many errors after DATA (0 bytes) from 1-0-0-10.example.com[10.0.0.1]
3657       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3658       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3659    }
3660
3661    # coerce these into general warnings
3662    elsif ( $p1 =~ /^cannot load Certificate Authority data/ or
3663            $p1 =~ /^SSL_connect error to /)
3664    {
3665       #TDsQ Cannot start TLS: handshake failure
3666       #TDsd cannot load Certificate Authority data
3667       #TDs SSL_connect error to mail.example.com: 0
3668
3669       postfix_warning($p1);
3670    }
3671
3672    else {
3673       # add to the unmatched list if not on the ignore_list
3674       inc_unmatched('final')   if ! in_ignore_list ($p1);
3675    }
3676 }
3677
3678 ########################################
3679 # Final tabulations, and report printing
3680
3681 for my $code (@RejectKeys) {
3682    for my $type (@RejectClasses) {
3683       $Totals{'totalrejects' . $code} += $Totals{$code . $type};
3684    }
3685
3686    if ($code =~ /^5/o) {
3687       $Totals{'totalrejects'} += $Totals{'totalrejects' . $code};
3688    }
3689 }
3690
3691 # XXX this was naive - the goal was to avoid recounting messages
3692 # released from quarantine, but externally introduced messages may
3693 # contain resent-message-id; trying to track only internally resent
3694 # messages does not seem useful.
3695 # make some corrections now, due to double counting
3696 #$Totals{'msgsaccepted'} -= $Totals{'resent'}   if ($Totals{'msgsaccepted'} >= $Totals{'resent'});
3697
3698 $Totals{'totalacceptplusreject'} = $Totals{'msgsaccepted'} + $Totals{'totalrejects'};
3699
3700 # Print the Summary report if any key has non-zero data.
3701 # Note: must explicitely check for any non-zero data,
3702 # as Totals always has some keys extant.
3703 #
3704 if ($Opts{'summary'}) {
3705    for (keys %Totals) {
3706       if ($Totals{$_}) {
3707          print_summary_report (@Sections);
3708          last;
3709       }
3710    }
3711 }
3712
3713 # Print the Detail report, if detail is sufficiently high
3714 #
3715 if ($Opts{'detail'} >= 5) {
3716    #print STDERR "Counts     memory usage: ", commify(Devel::Size::total_size(\%Counts)), "\n";
3717    #print STDERR "Delays     memory usage: ", commify(Devel::Size::total_size(\%Delays)), "\n";
3718    print_detail_report(@Sections);
3719
3720    if ($Opts{'delays'}) {
3721       my @table;
3722       for (sort keys %Delays) {
3723          # anon array ref: label, array ref of $Delay{key}
3724          push @table, [ substr($_,3), $Delays{$_} ];
3725       }
3726       if (@table) {
3727          print_percentiles_report2(\@table, "Delivery Delays Percentiles", $Opts{'delays_percentiles'});
3728       }
3729    }
3730
3731    print_postgrey_reports();
3732
3733 }
3734
3735 # debug: show which ignore_list items are hit most
3736 #my %IGNORED;
3737 #for (sort { $IGNORED{$b} <=> $IGNORED{$a} } keys %IGNORED) {
3738 #   printf "%10d: KEY: %s\n", $IGNORED{$_}, $_;
3739 #}
3740
3741 # Finally, print any unmatched lines
3742 #
3743 print_unmatched_report();
3744
3745 #
3746 # End of main
3747 #
3748 ##################################################
3749
3750 # Create the list of REs against which log lines are matched.
3751 # Lines that match any of the patterns in this list are ignored.
3752 #
3753 # Note: This table is created at runtime, due to a Perl bug which
3754 # I reported as perl bug #56202:
3755 #
3756 #    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
3757 #
3758 sub create_ignore_list() {
3759    # top 3 hitters up front
3760    push @ignore_list, qr/^statistics:/;
3761    push @ignore_list, qr/^setting up TLS connection (?:from|to)/;
3762    push @ignore_list, qr/^Verified: /;
3763    push @ignore_list, qr/^skipped, still being delivered/;
3764
3765    # SSL info at/above mail.info level
3766    push @ignore_list, qr/^read from [a-fA-F\d]{8}/;
3767    push @ignore_list, qr/^write to [a-fA-F\d]{8}/;
3768    push @ignore_list, qr/^[a-f\d]{4} [a-f\d]{2}/;
3769    push @ignore_list, qr/^[a-f\d]{4} - <SPACES/;
3770    push @ignore_list, qr/^[<>]+ /;
3771
3772    push @ignore_list, qr/^premature end-of-input (?:on|from) .* socket while reading input attribute name$/;
3773    push @ignore_list, qr/^certificate peer name verification failed/;
3774    push @ignore_list, qr/^Peer certi?ficate could not be verified$/;   # missing i was a postfix typo
3775    push @ignore_list, qr/^Peer cert verify depth=/;
3776    push @ignore_list, qr/^Peer verification:/;
3777    push @ignore_list, qr/^Server certificate could not be verified/;
3778    push @ignore_list, qr/^cannot load .SA certificate and key data/;
3779    push @ignore_list, qr/^tlsmgr_cache_run_event/;
3780    push @ignore_list, qr/^SSL_accept/;
3781    push @ignore_list, qr/^SSL_connect:/;
3782    push @ignore_list, qr/^connection (?:closed|established)/;
3783    push @ignore_list, qr/^delete smtpd session/;
3784    push @ignore_list, qr/^put smtpd session/;
3785    push @ignore_list, qr/^save session/;
3786    push @ignore_list, qr/^Reusing old/;
3787    push @ignore_list, qr/^looking up session/;
3788    push @ignore_list, qr/^lookup smtpd session/;
3789    push @ignore_list, qr/^lookup \S+ type/;
3790    push @ignore_list, qr/^xsasl_(?:cyrus|dovecot)_/;
3791    push @ignore_list, qr/^watchdog_/;
3792    push @ignore_list, qr/^read smtpd TLS/;
3793    push @ignore_list, qr/^open smtpd TLS/;
3794    push @ignore_list, qr/^write smtpd TLS/;
3795    push @ignore_list, qr/^read smtp TLS cache entry/;
3796    push @ignore_list, qr/^starting TLS engine$/;
3797    push @ignore_list, qr/^initializing the server-side TLS/;
3798    push @ignore_list, qr/^global TLS level: /;
3799    push @ignore_list, qr/^auto_clnt_/;
3800    push @ignore_list, qr/^generic_checks:/;
3801    push @ignore_list, qr/^inet_addr_/;
3802    push @ignore_list, qr/^mac_parse:/;
3803    push @ignore_list, qr/^cert has expired/;
3804    push @ignore_list, qr/^daemon started/;
3805    push @ignore_list, qr/^master_notify:/;
3806    push @ignore_list, qr/^rewrite_clnt:/;
3807    push @ignore_list, qr/^rewrite stream/;
3808    push @ignore_list, qr/^dict_/;
3809    push @ignore_list, qr/^send attr /;
3810    push @ignore_list, qr/^match_/;
3811    push @ignore_list, qr/^input attribute /;
3812    push @ignore_list, qr/^Run-time/;
3813    push @ignore_list, qr/^Compiled against/;
3814    push @ignore_list, qr/^private\//;
3815    push @ignore_list, qr/^reject_unknown_/;    # don't combine or shorten these reject_ patterns
3816    push @ignore_list, qr/^reject_unauth_/;
3817    push @ignore_list, qr/^reject_non_/;
3818    push @ignore_list, qr/^permit_/;
3819    push @ignore_list, qr/^idle timeout/;
3820    push @ignore_list, qr/^get_dns_/;
3821    push @ignore_list, qr/^dns_/;
3822    push @ignore_list, qr/^chroot /;
3823    push @ignore_list, qr/^process generation/;
3824    push @ignore_list, qr/^fsspace:/;
3825    push @ignore_list, qr/^master disconnect/;
3826    push @ignore_list, qr/^resolve_clnt/;
3827    push @ignore_list, qr/^ctable_/;
3828    push @ignore_list, qr/^extract_addr/;
3829    push @ignore_list, qr/^mynetworks:/;
3830    push @ignore_list, qr/^name_mask:/;
3831       #TDm reload -- version 2.6-20080814, configuration /etc/postfix
3832       #TDm reload configuration /etc/postfix
3833    push @ignore_list, qr/^reload (?:-- version \S+, )?configuration/;
3834    push @ignore_list, qr/^terminating on signal 15$/;
3835    push @ignore_list, qr/^verify error:num=/;
3836    push @ignore_list, qr/^verify return:/;
3837    push @ignore_list, qr/^nss_ldap: /;
3838    push @ignore_list, qr/^discarding EHLO keywords: /;
3839    push @ignore_list, qr/^sql auxprop plugin/;
3840    push @ignore_list, qr/^sql plugin/;
3841    push @ignore_list, qr/^sql_select/;
3842    push @ignore_list, qr/^auxpropfunc error/;
3843    push @ignore_list, qr/^commit transaction/;
3844    push @ignore_list, qr/^begin transaction/;
3845    push @ignore_list, qr/^maps_find: /;
3846    push @ignore_list, qr/^check_access: /;
3847    push @ignore_list, qr/^check_domain_access: /;
3848    push @ignore_list, qr/^check_mail_access: /;
3849    push @ignore_list, qr/^check_table_result: /;
3850    push @ignore_list, qr/^mail_addr_find: /;
3851    push @ignore_list, qr/^mail_addr_map: /;
3852    push @ignore_list, qr/^mail_flow_put: /;
3853    push @ignore_list, qr/^smtp_addr_one: /;
3854    push @ignore_list, qr/^smtp_connect_addr: /;
3855    push @ignore_list, qr/^smtp_connect_unix: trying: /;
3856    push @ignore_list, qr/^smtp_find_self: /;
3857    push @ignore_list, qr/^smtp_get: /;
3858    push @ignore_list, qr/^smtp_fputs: /;
3859    push @ignore_list, qr/^smtp_parse_destination: /;
3860    push @ignore_list, qr/^smtp_sasl_passwd_lookup: /;
3861    push @ignore_list, qr/^smtpd_check_/;
3862    push @ignore_list, qr/^smtpd_chat_notify: /;
3863    push @ignore_list, qr/^been_here: /;
3864    push @ignore_list, qr/^set_eugid: /;
3865    push @ignore_list, qr/^deliver_/;
3866    push @ignore_list, qr/^flush_send_file: queue_id/;
3867    push @ignore_list, qr/^milter_macro_lookup/;
3868    push @ignore_list, qr/^milter8/;
3869    push @ignore_list, qr/^skipping non-protocol event/;
3870    push @ignore_list, qr/^reply: /;
3871    push @ignore_list, qr/^event: /;
3872    push @ignore_list, qr/^trying... /;
3873    push @ignore_list, qr/ all milters$/;
3874    push @ignore_list, qr/^vstream_/;
3875    push @ignore_list, qr/^server features/;
3876    push @ignore_list, qr/^skipping event/;
3877    push @ignore_list, qr/^Using /;
3878    push @ignore_list, qr/^rec_(?:put|get): /;
3879    push @ignore_list, qr/^subject=/;
3880    push @ignore_list, qr/^issuer=/;
3881    push @ignore_list, qr/^pref  /;  # yes, multiple spaces
3882    push @ignore_list, qr/^request: \d/;
3883    push @ignore_list, qr/^done incoming queue scan$/;
3884    push @ignore_list, qr/^qmgr_/;
3885    push @ignore_list, qr/^trigger_server_accept_fifo: /;
3886    push @ignore_list, qr/^proxymap stream/;
3887    push @ignore_list, qr/^(?:start|end) sorted recipient list$/;
3888    push @ignore_list, qr/^connecting to \S+ port /;
3889    push @ignore_list, qr/^Write \d+ chars/;
3890    push @ignore_list, qr/^Read \d+ chars/;
3891    push @ignore_list, qr/^(?:lookup|delete) smtp session/;
3892    push @ignore_list, qr/^delete smtp session/;
3893    push @ignore_list, qr/^(?:reloaded|remove|looking for) session .* cache$/;
3894    push @ignore_list, qr/^(?:begin|end) \S+ address list$/;
3895    push @ignore_list, qr/^mapping DSN status/;
3896    push @ignore_list, qr/^record [A-Z]/;
3897    push @ignore_list, qr/^dir_/;
3898    push @ignore_list, qr/^transport_event/;
3899    push @ignore_list, qr/^read [A-Z](?: |$)/;
3900    push @ignore_list, qr/^relay: /;
3901    push @ignore_list, qr/^why: /;
3902    push @ignore_list, qr/^fp: /;
3903    push @ignore_list, qr/^path: /;
3904    push @ignore_list, qr/^level: /;
3905    push @ignore_list, qr/^recipient: /;
3906    push @ignore_list, qr/^delivered: /;
3907    push @ignore_list, qr/^queue_id: /;
3908    push @ignore_list, qr/^queue_name: /;
3909    push @ignore_list, qr/^user: /;
3910    push @ignore_list, qr/^sender: /;
3911    push @ignore_list, qr/^offset: /;
3912    push @ignore_list, qr/^offset: /;
3913    push @ignore_list, qr/^verify stream disconnect/;
3914    push @ignore_list, qr/^event_request_timer: /;
3915    push @ignore_list, qr/^smtp_sasl_authenticate: /;
3916    push @ignore_list, qr/^flush_add: /;
3917    push @ignore_list, qr/^disposing SASL state information/;
3918    push @ignore_list, qr/^starting new SASL client/;
3919    push @ignore_list, qr/^error: dict_ldap_connect: /;
3920    push @ignore_list, qr/^error: to submit mail, use the Postfix sendmail command/;
3921    push @ignore_list, qr/^local_deliver[:[]/;
3922    push @ignore_list, qr/^_sasl_plugin_load /;
3923    push @ignore_list, qr/^exp_type: /;
3924    push @ignore_list, qr/^wakeup [\dA-Z]/;
3925    push @ignore_list, qr/^defer (?:site|transport) /;
3926    push @ignore_list, qr/^local: /;
3927    push @ignore_list, qr/^exp_from: /;
3928    push @ignore_list, qr/^extension: /;
3929    push @ignore_list, qr/^owner: /;
3930    push @ignore_list, qr/^unmatched: /;
3931    push @ignore_list, qr/^domain: /;
3932    push @ignore_list, qr/^initializing the client-side TLS engine/;
3933    push @ignore_list, qr/^header_token: /;
3934    push @ignore_list, qr/^(?:PUSH|POP) boundary/;
3935    push @ignore_list, qr/^recipient limit \d+$/;
3936    push @ignore_list, qr/^scan_dir_next: found/;
3937    push @ignore_list, qr/^open (?:btree|incoming)/;
3938    push @ignore_list, qr/^Renamed to match inode number/;
3939    push @ignore_list, qr/^cleanup_[^:]+:/;
3940    push @ignore_list, qr/^(?:before|after) input_transp_cleanup: /;
3941    push @ignore_list, qr/^event_enable_read: /;
3942    push @ignore_list, qr/^report recipient to all milters /;
3943    push @ignore_list, qr/_action = defer_if_permit$/;
3944    push @ignore_list, qr/^reject_invalid_hostname: /;
3945    push @ignore_list, qr/^cfg_get_/;
3946    push @ignore_list, qr/^sacl_check: /;
3947
3948    # non-anchored
3949    #push @ignore_list, qr/: Greylisted for /;
3950    push @ignore_list, qr/certificate verification (?:depth|failed for)/;
3951    push @ignore_list, qr/re-using session with untrusted certificate, look for details earlier in the log$/;
3952    push @ignore_list, qr/socket: wanted attribute: /;
3953    push @ignore_list, qr/ smtpd cache$/;
3954    push @ignore_list, qr/ old session$/;
3955    push @ignore_list, qr/fingerprint=/;
3956    push @ignore_list, qr/TLS cipher list "/;
3957 }
3958
3959 # Evaluates a given line against the list of ignore patterns.
3960 #
3961 sub in_ignore_list($) {
3962    my $line = shift;
3963
3964    foreach (@ignore_list) {
3965       #return 1 if $line =~ /$_/;
3966       if ($line =~ /$_/) {
3967          #$IGNORED{$_}++;
3968          return 1;
3969       }
3970    }
3971
3972    return 0;
3973 }
3974
3975 # Accepts common fields from a standard delivery attempt, processing then
3976 # and returning modified values
3977 #
3978 sub process_delivery_attempt ($ $ $ $) {
3979    my ($to,$origto,$DDD,$reason) = @_;
3980
3981    $reason =~ s/\((.*)\)/$1/;   # Makes capturing nested parens easier
3982    # leave $to/$origto undefined, or strip < > chars if not null address (<>).
3983    defined $to     and $to =     ($to eq '')     ? '<>' : lc $to;
3984    defined $origto and $origto = ($origto eq '') ? '<>' : lc $origto;
3985    my ($localpart, $domainpart) = split ('@', $to);
3986    ($localpart, $domainpart) = ($to, '*unspecified')   if ($domainpart eq '');
3987    my ($dsn);
3988
3989    # If recipient_delimiter is set, break localpart into user + extension
3990    # and save localpart in origto if origto is empty
3991    #
3992    if ($Opts{'recipient_delimiter'} and $localpart =~ /\Q$Opts{'recipient_delimiter'}\E/o) {
3993
3994       # special cases: never split mailer-daemon or double-bounce
3995       # or owner- or -request if delim is "-" (dash).
3996       unless ($localpart =~ /^(?:mailer-daemon|double-bounce)$/i or
3997           ($Opts{'recipient_delimiter'} eq '-' and $localpart =~ /^owner-.|.-request$/i)) {
3998          my ($user,$extension) = split (/\Q$Opts{'recipient_delimiter'}\E/, $localpart, 2);
3999          $origto = $localpart    if ($origto eq '');
4000          $localpart = $user;
4001       }
4002    }
4003
4004    unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) {
4005       $dsn = '';
4006    }
4007
4008    if ($Collecting{'delays'} and $DDD =~ m{delay=([\d.]+)(?:, delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+))?}) {
4009       # Message delivery time stamps
4010       # delays=a/b/c/d, where
4011       #   a = time before queue manager, including message transmission
4012       #   b = time in queue manager
4013       #   c = connection setup including DNS, HELO and TLS;
4014       #   d = message transmission time.
4015       if (defined $2) {
4016          $Delays{'1: Before qmgr'}{$2}++;
4017          $Delays{'2: In qmgr'}{$3}++;
4018          $Delays{'3: Conn setup'}{$4}++;
4019          $Delays{'4: Transmission'}{$5}++;
4020       }
4021       $Delays{'5: Total'}{$1}++;
4022    }
4023
4024    return ($to,$origto,$localpart,$domainpart,$dsn,$reason);
4025 }
4026
4027 # Processes postfix/bounce messages
4028 #
4029 sub postfix_bounce($) {
4030    my $line = shift;
4031    my $type;
4032
4033    $line =~ s/^(?:$re_QID): //o;
4034    if ($line =~ /^(sender|postmaster) non-delivery notification/o) {
4035       #TDbQ postmaster non-delivery notification: 7446BCD68
4036       #TDbQ sender non-delivery notification: 7446BCD68
4037       $type = 'Non-delivery';
4038    }
4039    elsif ($line =~ /^(sender|postmaster) delivery status notification/o ) {
4040       #TDbQ sender delivery status notification: 7446BCD68
4041       $type = 'Delivery';
4042    }
4043    elsif ($line =~ /^(sender|postmaster) delay notification: /o) {
4044       #TDbQ sender delay notification: AA61EC2F9A
4045       $type = 'Delayed';
4046    }
4047    else {
4048       inc_unmatched('bounce')   if ! in_ignore_list($line);
4049       return;
4050    }
4051
4052    $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'});
4053    $Counts{'notificationsent'}{$type}{$1}++;
4054 }
4055
4056 # Processes postfix/cleanup messages
4057 #   cleanup always has a QID
4058 #
4059 sub postfix_cleanup($) {
4060    my $line = shift;
4061    my ($qid,$reply,$fmthost,$reject_name);
4062
4063    ($qid, $line) = ($1, $2)  if ($line =~ /^($re_QID): (.*)$/o );
4064
4065    #TDcQ message-id=<C1BEA2A0.188572%from@example.com>
4066    return if ($line =~ /^message-id=/);
4067
4068    # milter-reject, milter-hold, milter-discard
4069    if ($line =~ s/^milter-//) {
4070       milter_common($line);
4071       return;
4072    }
4073
4074    ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps)
4075    # Note: Bounce
4076    #   See same code elsewhere "Note: Bounce"
4077    #TDcQ to=<envto@example.com>,                  relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text...
4078    #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...
4079    if ($line =~ /^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o) {
4080       # ($to,$origto,$relay,$DDD,$status,$reason) = ($1,$2,$3,$4,$5,$6);
4081       if ($5 ne 'bounced' and $5 ne 'SOFTBOUNCE') {
4082          inc_unmatched('cleanupbounce');
4083          return;
4084       }
4085
4086       my ($to,$origto,$relay,$DDD,$reason) = ($1,$2,$3,$4,$6);
4087       my ($localpart,$domainpart,$dsn);
4088       ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$DDD,$reason);
4089
4090       ### local bounce
4091       # XXX local v. remote bounce seems iffy, relative
4092       if ($relay =~ /^(?:none|local|virtual|maildrop|127\.0\.0\.1|avcheck)/) {
4093          $Totals{'bouncelocal'}++; return unless ($Collecting{'bouncelocal'});
4094          $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++;
4095       }
4096       ### remote bounce
4097       else {
4098          ($reply,$fmthost) = cleanhostreply($reason,$relay,$to ne '' ? $to : '<>',$domainpart);
4099          $Totals{'bounceremote'}++; return unless ($Collecting{'bounceremote'});
4100          $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
4101       }
4102    }
4103
4104    # *header_checks and body_checks
4105    elsif (header_body_checks($line)) {
4106       #print "cleanup: header_body_checks\n";
4107       return;
4108    }
4109
4110    #TDcQ resent-message-id=4739073.1
4111    #TDcQ resent-message-id=<ARF+DXZwLECdxm@mail.example.com>
4112    #TDcQ resent-message-id=<B19-DVD42188E0example.com>?    <120B11@samplepc>
4113    elsif ( ($line =~ /^resent-message-id=<?.+>?$/o  )) {
4114       $Totals{'resent'}++;
4115    }
4116
4117    #TDcN unable to dlopen .../sasl2/libplain.so.2: .../sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted
4118    elsif ($line =~ /^unable to dlopen /) {
4119       # strip extraneous doubling of library path
4120       $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/);
4121       postfix_warning($line);
4122    }
4123
4124    else {
4125       inc_unmatched('cleanup(last)')   if ! in_ignore_list($line);
4126    }
4127 }
4128
4129 =pod
4130  header_body_checks
4131
4132   Handle cleanup's header_checks and body_checks, and smtp's smtp_body_checks/smtp_*header_checks
4133
4134   Possible actions that log are:
4135
4136      REJECT optional text...
4137      DISCARD optional text...
4138      FILTER transport:destination
4139      HOLD optional text...
4140      REDIRECT user@domain
4141      PREPEND text...
4142      REPLACE text...
4143      WARN optional text...
4144
4145      DUNNO and IGNORE are not logged
4146
4147 Returns:
4148    1: if line matched or handled
4149    0: otherwise
4150 =cut
4151
4152 sub header_body_checks($)
4153 {
4154    my $line = shift;
4155
4156    # bcc, discard, filter, hold, prepend, redirect, reject, replace, warning
4157    return 0 if ($line !~ /^[bdfhprw]/) or   # short circuit alternation when no match possible
4158                ($line !~ /^(re(?:ject|direct|place)|filter|hold|discard|prepend|warning|bcc): (header|body|content) (.*)$/);
4159
4160    my ($action,$part,$p3) = ($1,$2,$3);
4161
4162    #print "header_body_checks: action: \"$action\", part: \"$part\", p3: \"$p3\"\n";
4163
4164    my ($trigger,$host,$eto,$p4,$fmthost,$reject_name);
4165    # $re_QID: reject: body ...
4166    # $re_QID: reject: header ...
4167    # $re_QID: reject: content ...
4168
4169
4170    if ($p3 =~ /^(.*) from ([^;]+); from=<.*?>(?: to=<(.*?)>)?(?: proto=\S*)?(?: helo=<.*?>)?(?:: (.*)|$)/) {
4171       ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4);
4172
4173       #    $action   $part  $trigger                                 $host                                              $eto                                                $p4
4174       #TDcQ reject:   body   Subject: Cheap cialis               from local;                    from=<root@localhost>:                                                       optional text...
4175       #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...
4176       #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...
4177       # message_reject_characters (postfix >= 2.3)
4178       #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
4179
4180       #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
4181       #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...
4182       #TDcQ hold:     header Subject: Hold Test                  from local;                    from=<efrom@example.com> to=<eto@sample.net>:                                optional text...
4183       #TDcQ hold:     header Received: by example.com...from x   from local;                    from=<efrom@example.com>
4184       #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>
4185       #      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
4186       #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
4187       #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
4188       #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
4189       #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>
4190       #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...
4191       #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...
4192       #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...
4193       # BCC action (2.6 experimental branch)
4194       #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
4195
4196       # Note: reject_warning does not seem to occur
4197    }
4198
4199    else {
4200       # smtp_body_checks, smtp_header_checks, smtp_mime_header_checks, smtp_nested_header_checks (postfix >= 2.5)
4201       #TDsQ replace:  header Sender:   <from@example.com>                                                                                                                  : Sender:   <fm2@sample.net>
4202
4203       $trigger = $p3; $host = ''; $eto = ''; $p4 = $part eq 'body' ? 'smtp_body_checks' : 'smtp_*header_checks';
4204
4205       #inc_unmatched('header_body_checks');
4206       #return 1;
4207    }
4208
4209    #print "   trigger: \"$trigger\", host: \"$host\", eto: \"$eto\", p4: \"$p4\"\n";
4210    $trigger =~ s/\s+/ /g;
4211    $trigger = '*unknown reason'    if ($trigger eq '');
4212    $eto     = '*unknown'           if ($eto     eq '');
4213
4214    my ($trig,$trig_opt,$text);
4215    if    ($part eq 'header')               { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; }
4216    elsif ($part eq 'body')                 { $trig = "Body check"; }
4217    else                                    { $trig = "Content check"; }  # message_reject_characters (postfix >= 2.3)
4218
4219    if ($p4 eq '')                          { $text = '*generic'; $trig_opt = $trig; }
4220    else                                    { $text = $p4;        $trig_opt = "$trig ($p4)"; }
4221
4222    if    ($host eq 'local')                { $fmthost = formathost('127.0.0.1', 'local'); }
4223    elsif ($host =~ /([^[]+)\[([^]]+)\]/)   { $fmthost = formathost($2,$1); }
4224    else                                    { $fmthost = '*unknown'; }
4225
4226    # Note: Counts
4227    #   Ensure each $Counts{key} accumulator is consistently
4228    #   used with the same number of hash key levels throughout the code.
4229    #   For example, $Counts{'hold'} below has 4 keys; ensure that every
4230    #   other usage of $Counts{'hold'} also has 4 keys.  Currently, it is
4231    #   OK to set the last key as '', but only the last.
4232
4233    if ($action eq 'reject') {
4234       $Counts{'byiprejects'}{$fmthost}++                                if $Collecting{'byiprejects'};
4235
4236       # Note: no temporary or reject_warning
4237       # Note: no reply code - force into a 5xx reject
4238       # XXX this won't be seen if the user has no 5.. entry in reject_reply_patterns
4239       $Totals{$reject_name = "5xxreject$part" }++;
4240       $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++          if $Collecting{$reject_name};
4241    }
4242    elsif ( $action eq 'filter' ) {
4243       $Totals{'filtered'}++;
4244       $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++     if $Collecting{'filtered'};
4245    }
4246    elsif ( $action eq 'hold' ) {
4247       $Totals{'hold'}++;
4248       $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++            if $Collecting{'hold'};
4249    }
4250    elsif ( $action eq 'redirect' ) {
4251       $Totals{'redirected'}++;
4252       $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++   if $Collecting{'redirected'};
4253    }
4254    elsif ( $action eq 'discard' ) {
4255       $Totals{'discarded'}++;
4256       $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++           if $Collecting{'discarded'};
4257    }
4258    elsif ( $action eq 'prepend' ) {
4259       $Totals{'prepended'}++;
4260       $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++ if $Collecting{'prepended'};
4261    }
4262    elsif ( $action eq 'replace' ) {
4263       $Totals{'replaced'}++;
4264       $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++  if $Collecting{'replaced'};
4265    }
4266    elsif ( $action eq 'warning' ) {
4267       $Totals{'warned'}++;
4268       $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++              if $Collecting{'warned'};
4269    }
4270    elsif ( $action eq 'bcc' ) {
4271       $Totals{'bcced'}++;
4272       $Counts{'bcced'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++        if $Collecting{'bcced'};
4273    }
4274    else {
4275       inc_unmatched('header_body_checks unexpected action');
4276    }
4277
4278    return 1;
4279 }
4280
4281
4282 # Handle common milter actions:
4283 #    milter-reject, milter-hold, milter-discard
4284 # which are created by both smtpd and cleanup
4285 #
4286 sub milter_common($) {
4287    my $line = shift;
4288
4289    #TDsdN milter-reject: MAIL           from milterS.example.com[10.0.0.1]: 553 5.1.7 address incomplete;                                                                          proto=ESMTP helo=<example.com>
4290    #TDsdN milter-reject: CONNECT        from milterS.example.com[10.0.0.2]: 451 4.7.1 Service unavailable - try again later; proto=SMTP
4291    #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>
4292    #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>
4293
4294    #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>
4295    #TDcQ milter-reject:  CONNECT        from milterC.example.com[10.0.0.2]: 5.7.1 Some problem;                                                                                    proto=SMTP
4296    #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>
4297    #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>
4298 #   84B82AC8B3: milter-reject: END-OF-MESSAGE from localhost[127.0.0.1]: 5.7.1 Blocked
4299
4300    my ($efrom,$eto,$proto,$helo) = strip_ftph($line);
4301    #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
4302    $line =~ s/;$//;
4303
4304    if ($line =~ /^(reject|hold|discard): (\S+) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
4305
4306       my ($action,$stage,$host,$hostip,$reply) = ($1,$2,$3,$4,$5);
4307       #print "action: '$action', stage: '$stage', host: '$host', hostip: '$hostip', reply: '$reply'\n";
4308
4309       if ($action eq 'reject') {
4310          my ($dsn,$fmthost,$reject_name);
4311          ($dsn,$reply) = ($1,$2)    if $reply =~ /^($re_DSN) (.*)$/o;
4312          #print "   dsn: '$dsn', reply: '$reply'\n";
4313
4314          if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
4315             $fmthost = formathost($hostip,$host);
4316             $Counts{'byiprejects'}{$fmthost}++;
4317          }
4318          # Note: reject_warning does not seem to occur
4319          # Note: See rejectmilter elsewhere
4320          $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; return unless ($Collecting{$reject_name});
4321          $Counts{$reject_name}{$stage}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reply}++;
4322       }
4323       # milter-hold
4324       elsif ($action eq 'hold') {
4325          $Totals{'hold'}++; return unless ($Collecting{'hold'});
4326          $Counts{'hold'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4327       }
4328       # milter-discard
4329       else { # $action eq 'discard'
4330          $Totals{'discarded'}++; return unless ($Collecting{'discarded'});
4331          $Counts{'discarded'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4332       }
4333
4334    }
4335    else {
4336       inc_unmatched('milter_common)');
4337    }
4338 }
4339
4340 sub postfix_dnsblog {
4341    my $line = shift;
4342
4343    #postfix/dnsblog[16943]: addr 192.168.0.1 listed by domain bl.spamcop.net as 127.0.0.2
4344    #postfix/dnsblog[78598]: addr 192.168.0.1 blocked by domain zen.spamhaus.org as 127.0.0.11
4345    if ($line =~ /^addr (\S+) (?:listed|blocked) by domain (\S+) as (\S+)$/) {
4346       $Counts{'dnsblog'}{$2}{$1}{$3}++  if $Collecting{'dnsblog'};
4347    }
4348    else {
4349       inc_unmatched('dnsblog')   if ! in_ignore_list($line);
4350       return;
4351    }
4352 }
4353
4354 sub postfix_postscreen {
4355    my $line = shift;
4356
4357    return if (
4358       $line =~ /^cache / or
4359       $line =~ /discarding EHLO keywords: / or
4360       $line =~ /: discard_mask / or
4361       $line =~ /: sq=\d+ cq=\d+ event/ or
4362       $line =~ /: replacing command "/
4363    );
4364
4365
4366    if (($line =~ /^(PREGREET) \d+ (?:after \S+)? from \[([^]]+)\](?::\d+)?/) or
4367       # PREGREET 20 after 0.31 from [192.168.0.1]:12345: HELO 10.0.0.1??
4368       # HANGUP after 0.7 from [192.168.0.4]:12345
4369        ($line =~ /^(HANGUP) (?:after \S+)? from \[([^]]+)\](?::\d+)?/)) {
4370       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4371    }
4372    elsif ($line =~ /^(WHITELISTED|BLACKLISTED|PASS \S+) \[([^]]+)\](?::\d+)?$/) {
4373       # PASS NEW [192.168.0.2]:12345
4374       # PASS OLD [192.168.0.3]:12345
4375       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4376    }
4377    elsif ($line =~ /^DNSBL rank (\S+) for \[([^]]+)\](?::\d+)?$/) {
4378       $Counts{'postscreen'}{'dnsbl'}{$2}{$1}++      if $Collecting{'postscreen'};
4379    }
4380
4381    elsif ($line =~ /^(CONNECT|COMMAND (?:(?:TIME|COUNT|LENGTH) LIMIT|PIPELINING)|NON-SMTP COMMAND|BARE NEWLINE) from \[([^\]]+)\]:\d+/) {
4382       # CONNECT from [192.168.1.1]:12345
4383       $Counts{'postscreen'}{lc($1)}{$2}{$END_KEY}++             if $Collecting{'postscreen'};
4384    }
4385    elsif ($line =~ /^DISCONNECT \[([^\]]+)\]:\d+$/) {
4386       # DISCONNECT [192.168.1.1]:12345
4387       $Counts{'postscreen'}{'disconnect'}{$1}{$END_KEY}++       if $Collecting{'postscreen'};
4388    }
4389
4390    elsif ($line =~ /^NOQUEUE: reject: RCPT from \[([^]]+)\](?::\d+)?: ($re_DSN) ([^;]+)/o) {
4391       #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>
4392       my ($ip,$dsn,$msg) = ($1,$2,$3);
4393
4394       if ($dsn =~ /^([54])/) {
4395          $Counts{'postscreen'}{$1 . 'xx reject'}{"$dsn $msg"}{$ip}++      if $Collecting{'postscreen'};
4396       }
4397       else {
4398          $Counts{'postscreen'}{'reject'}{"$dsn $msg"}{$ip}{$END_KEY}++      if $Collecting{'postscreen'};
4399       }
4400    }
4401
4402    elsif ($line =~ /^(NOQUEUE: )?reject: (connect|CONNECT) from \[([^]]+)\](?::\d+)?: (.+)$/) {
4403        # NOQUEUE: reject: CONNECT from [192.168.0.1]:7197: too many connections
4404        # NOQUEUE: reject: CONNECT from [192.168.0.1]:39410: all server ports busy
4405        # reject: connect from [192.168.0.1]:21225: all screening ports busy
4406       $Counts{'postscreen'}{'reject'}{"\u$4"}{$3}{$END_KEY}++      if $Collecting{'postscreen'};
4407    }
4408
4409    elsif ($line =~ /^(?:WHITELIST VETO) \[([^]]+)\](?::\d+)?$/) {
4410       # WHITELIST VETO [192.168.0.8]:43579
4411       $Counts{'postscreen'}{'whitelist veto'}{$1}{$END_KEY}++   if $Collecting{'postscreen'};
4412    }
4413
4414    elsif ($line =~ /^(entering|leaving) STRESS mode with (\d+) connections$/) {
4415       # entering STRESS mode with 90 connections
4416       $Counts{'postscreen'}{'stress mode: ' . $1}{$2}{$END_KEY}++      if $Collecting{'postscreen'};
4417    }
4418
4419    elsif ($line =~ /^close database (\S+): No such file or directory/) {
4420       # close database /var/lib/postfix/postscreen_cache.db: No such file or directory (possible Berkeley DB bug)
4421       $Counts{'postscreen'}{'close database'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4422    }
4423
4424    else {
4425       inc_unmatched('postscreen')   if ! in_ignore_list($line);
4426       return;
4427    }
4428
4429    $Totals{'postscreen'}++;
4430 }
4431
4432
4433 # Handles postfix/postsuper lines
4434 #
4435 sub postfix_postsuper($) {
4436    my $line = shift;
4437
4438    return if $line =~ /^Deleted: \d+ messages?$/;
4439
4440    if ($line =~ /^Placed on hold: (\d+) messages?$/o) {
4441       #TDps Placed on hold: 2 messages
4442       # Note: See Hold elsewhere
4443       $Totals{'hold'} += $1; return unless ($Collecting{'hold'});
4444       $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1;
4445    }
4446    elsif ($line =~ /^Released from hold: (\d+) messages?$/o) {
4447       #TDps Released from hold: 1 message
4448       $Totals{'releasedfromhold'} += $1;
4449    }
4450    elsif ($line =~ /^Requeued: (\d+) messages?$/o) {
4451       #TDps Requeued: 1 message
4452       $Totals{'requeued'} += $1;
4453    }
4454    elsif (my($qid,$p2) = ($line =~ /($re_QID): (.*)$/)) {
4455       # postsuper double reports the following 3 lines
4456       return if ($p2 eq 'released from hold');
4457       return if ($p2 eq 'placed on hold');
4458       return if ($p2 eq 'requeued');
4459
4460       if ($p2 =~ /^removed\s*$/o) {
4461          # Note: See REMOVED elsewhere
4462          # 52CBDC2E0F: removed
4463          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
4464          $Totals{'removedfromqueue'}++;
4465       }
4466       elsif (! in_ignore_list ($p2)) {
4467          inc_unmatched('postsuper2');
4468       }
4469    }
4470    elsif (! in_ignore_list ($line)) {
4471       inc_unmatched('postsuper1');
4472    }
4473 }
4474
4475 # Handles postfix panic: lines
4476 #
4477 sub postfix_panic($) {
4478    #TD panic: myfree: corrupt or unallocated memory block
4479    $Totals{'panicerror'}++; return unless ($Collecting{'panicerror'});
4480    $Counts{'panicerror'}{ucfirst($1)}++;
4481 }
4482
4483 # Handles postfix fatal: lines
4484 #
4485 sub postfix_fatal($) {
4486    my ($reason) = shift;
4487
4488    if ($reason =~ /^\S*\(\d+\): Message file too big$/o) {
4489       #TD fatal: root(0): Message file too big
4490       $Totals{'fatalfiletoobig'}++;
4491
4492
4493    # XXX its not clear this is at all useful - consider falling through to last case
4494    } elsif ( $reason =~ /^config variable (\S*): (.*)$/o ) {
4495       #TD fatal: config variable inet_interfaces: host not found: 10.0.0.1:2525
4496       #TD fatal: config variable inet_interfaces: host not found: all:2525
4497       $Totals{'fatalconfigerror'}++; return unless ($Collecting{'fatalconfigerror'});
4498       $Counts{'fatalconfigerror'}{ucfirst($reason)}++;
4499    }
4500    else {
4501       #TD fatal: watchdog timeout
4502       #TD fatal: bad boolean configuration: smtpd_use_tls =
4503
4504       #TDvN fatal: update queue file active/4B709F060E: File too large
4505       $reason =~ s/(^update queue file \w+\/)\w+:/$1*:/;
4506
4507       $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'});
4508       $Counts{'fatalerror'}{ucfirst($reason)}++;
4509    }
4510 }
4511 # Handles postfix fatal: lines
4512 #
4513 sub postfix_error($) {
4514    my ($reason) = shift;
4515    # postfix/postfix-script[4271]: error: unknown command: 'rel'
4516
4517    $Totals{'error'}++; return unless ($Collecting{'fatalerror'});
4518    $Counts{'error'}{ucfirst($reason)}++;
4519 }
4520
4521 # Handles postfix warning: lines
4522 # and additional lines coerced into warnings
4523 #
4524 sub postfix_warning($) {
4525    my ($warning) = shift;
4526
4527    # Skip these
4528    return if ($warning =~ /$re_QID: skipping further client input$/o);
4529    return if ($warning =~ /^Mail system is down -- accessing queue directly$/o);
4530    return if ($warning =~ /^SASL authentication failure: (?:Password verification failed|no secret in database)$/o);
4531    return if ($warning =~ /^no MX host for .* has a valid A record$/o);
4532    return if ($warning =~ /^uid=\d+: Broken pipe$/o);
4533
4534    #TD warning: connect to 127.0.0.1:12525: Connection refused
4535    #TD warning: problem talking to server 127.0.0.1:12525: Connection refused
4536    #TD warning: valid_ipv4_hostaddr: invalid octet count:
4537
4538    my ($domain,$to,$type,$site,$helo,$cmd);
4539    my ($addr,$size,$hostip,$host,$port,$reason,$qid,$queue,$reason2,$process,$status,$service);
4540
4541    if (($hostip,$host,$reason) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): hostname ([^ ]+) verification failed: (.*)$/) or
4542        ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): (address not listed for hostname) (.*)$/) or
4543        ($host,$reason,$hostip,$reason2) = ($warning =~ /^(?:smtpd_peer_init: )?hostname (\S+) (does not resolve to address) ([\d.]+)(: host not found, try again)?$/)) {
4544       #TD warning: 10.0.0.1: hostname sample.com verification failed: Host not found
4545       #TD warning: smtpd_peer_init: 192.168.0.1: hostname example.com verification failed: Name or service not known
4546       #TD warning: 192.168.0.1: address not listed for hostname sample.net
4547       # post 2.8
4548       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1: host not found, try again
4549       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1
4550
4551       $reason .= $reason2 if $reason2;
4552       $Totals{'hostnameverification'}++; return unless ($Collecting{'hostnameverification'});
4553       $Counts{'hostnameverification'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4554
4555    } elsif (($warning =~ /^$re_QID: queue file size limit exceeded$/o) or
4556             ($warning =~ /^uid=\d+: File too large$/o)) {
4557       $Totals{'warnfiletoobig'}++;
4558
4559    } elsif ($warning =~ /^database (?:[^ ]*) is older than source file ([\w\/]+)$/o) {
4560       #TD warning: database /etc/postfix/client_checks.db is older than source file /etc/postfix/client_checks
4561       $Totals{'databasegeneration'}++; return unless ($Collecting{'databasegeneration'});
4562       $Counts{'databasegeneration'}{$1}++;
4563
4564    } elsif (($reason,$qid,$reason2) = ($warning =~ /^(open active) ($re_QID): (.*)$/o) or
4565             ($reason,$qid,$reason2) = ($warning =~ /^qmgr_active_corrupt: (save corrupt file queue active) id ($re_QID): (.*)$/o) or
4566             ($qid,$reason,$reason2) = ($warning =~ /^($re_QID): (write queue file): (.*)$/o)) {
4567
4568       #TD warning: open active BDB9B1309F7: No such file or directory
4569       #TD warning: qmgr_active_corrupt: save corrupt file queue active id 4F4272F342: No such file or directory
4570       #TD warning: E669DE52: write queue file: No such file or directory
4571
4572       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4573       $Counts{'queuewriteerror'}{"$reason: $reason2"}{$qid}++;
4574
4575    } elsif (($qid,$reason) = ($warning =~ /^qmgr_active_done_3_generic: remove ($re_QID) from active: (.*)$/o)) {
4576       #TD warning: qmgr_active_done_3_generic: remove AF0F223FC05 from active: No such file or directory
4577       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4578       $Counts{'queuewriteerror'}{"remove from active: $reason"}{$qid}++;
4579
4580    } elsif (($queue,$qid) = ($warning =~ /^([^\/]*)\/($re_QID): Error writing message file$/o )) {
4581       #TD warning: maildrop/C9E66ADF: Error writing message file
4582       $Totals{'messagewriteerror'}++; return unless ($Collecting{'messagewriteerror'});
4583       $Counts{'messagewriteerror'}{$queue}{$qid}++;
4584
4585    } elsif (($process,$status) = ($warning =~ /^process ([^ ]*) pid \d+ exit status (\d+)$/o)) {
4586       #TD warning: process /usr/lib/postfix/smtp pid 9724 exit status 1
4587       $Totals{'processexit'}++; return unless ($Collecting{'processexit'});
4588       $Counts{'processexit'}{"Exit status $status"}{$process}++;
4589
4590    } elsif ($warning =~ /^mailer loop: (.*)$/o) {
4591       #TD warning: mailer loop: best MX host for example.com is local
4592       $Totals{'mailerloop'}++; return unless ($Collecting{'mailerloop'});
4593       $Counts{'mailerloop'}{$1}++;
4594
4595    } elsif ($warning =~ /^no (\S+) host for (\S+) has a valid address record$/) {
4596       #TDs warning: no MX host for example.com has a valid address record
4597       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4598       $Counts{'dnserror'}{"No $1 host has a valid address record"}{$2}{$END_KEY}++;
4599
4600    } elsif ($warning =~ /^(Unable to look up \S+ host) (.+)$/) {
4601       #TDsd warning: Unable to look up MX host for example.com: Host not found
4602       #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known
4603       #TDsd warning: Unable to look up NS host ns1.example.logal for Sender address bounce@example.local: No address associated with hostname
4604       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4605
4606       my ($problem,$target,$reason) = ($1, split(/: /,$2));
4607       $reason =~ s/, try again//;
4608
4609       if ($target =~ /^for (\S+)$/) {
4610          $Counts{'dnserror'}{$problem}{ucfirst($reason)}{$1}{$END_KEY}++;
4611       }
4612       elsif ($target =~ /^(\S+)( for \S+ address) (\S+)$/) {
4613          $Counts{'dnserror'}{$problem . lc($2)}{ucfirst($reason)}{$1}{$3}++;
4614       }
4615
4616    } elsif ($warning =~ /^((?:malformed|numeric) domain name in .+? of \S+ record) for (.*):(.*)?$/) {
4617       my ($problem,$domain,$reason) = ($1,$2,$3);
4618       #TDsd warning: malformed domain name in resource data of MX record for example.com:
4619       #TDsd warning: malformed domain name in resource data of MX record for example.com: mail.example.com\\032
4620       #TDsd warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1
4621       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4622       $Counts{'dnserror'}{ucfirst($problem)}{$domain}{$reason eq '' ? '*unknown' : $reason}{$END_KEY}++;
4623
4624    } elsif ($warning =~ /^numeric hostname: ([\S]+)$/) {
4625       #TD warning: numeric hostname: 192.168.0.1
4626       $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'});
4627       $Counts{'numerichostname'}{$1}++;
4628
4629    } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/)  or
4630              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[([^]]+)\](?::(\d+))?: (.*)$/) or
4631              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[([^]]+)\](?::(\d+))?:(?: (.*))?$/o)) {
4632       # ancient
4633       #TDsd warning: example.com[192.168.0.1] sent message header instead of SMTP command: From: "Someone" <40245426501example.com>
4634       # current
4635       #TDsd warning: non-SMTP command from sample.net[10.0.0.1]: Received: from 192.168.0.1 (HELO bogus.sample.com)
4636       #TDs warning: 6B01A8DEF: non-ESMTP response from mail.example.com[192.168.0.1]:25:
4637
4638       $Totals{'smtpconversationerror'}++; return unless ($Collecting{'smtpconversationerror'});
4639       $host .= ' :' . $port   if ($port and $port ne '25');
4640       $Counts{'smtpconversationerror'}{ucfirst($type)}{formathost($hostip,$host)}{$reason}++;
4641
4642    } elsif ($warning =~ /^valid_hostname: (.*)$/o) {
4643       #TD warning: valid_hostname: empty hostname
4644       $Totals{'hostnamevalidationerror'}++; return unless ($Collecting{'hostnamevalidationerror'});
4645       $Counts{'hostnamevalidationerror'}{$1}++;
4646
4647    } elsif (($host,$hostip,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::\d+)?: SASL (.*) authentication failed(.*)$/)) {
4648       #TDsd warning: unknown[10.0.0.1]: SASL LOGIN authentication failed: bad protocol / cancel
4649       #TDsd warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed
4650       # see saslauthfail elsewhere
4651       $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'});
4652       if ($reason) { $reason = $type . $reason; }
4653       else         { $reason = $type; }
4654       $Counts{'saslauthfail'}{$reason}{formathost($hostip,$host)}++;
4655
4656    } elsif (($host,$reason) = ($warning =~ /^(\S+): RBL lookup error:.* Name service error for (?:name=)?\1(?: type=[^:]+)?: (.*)$/o)) {
4657       #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
4658
4659       #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
4660       $Totals{'rblerror'}++; return unless ($Collecting{'rblerror'});
4661       $Counts{'rblerror'}{$reason}{$host}++;
4662
4663    } elsif (
4664          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/ ) or
4665          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/ )) {
4666       #TDs warning: host example.com[192.168.0.1] greeted me with my own hostname example.com
4667       #TDs warning: host example.com[192.168.0.1] replied to HELO/EHLO with my own hostname example.com
4668       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4669       $Counts{'heloerror'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4670
4671    } elsif (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[([^]]+)\](?::\d+)?$/ )) {
4672       #TD warning: bad size limit "-679215104" in EHLO reply from example.com[192.168.0.1]
4673       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4674       $Counts{'heloerror'}{"Bad size limit in EHLO reply"}{formathost($hostip,$host)}{"$size"}++;
4675
4676    } elsif ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[([^]]+)\](?::\d+)? in ([^ ]*) command: (.*)/ )) {
4677       #TD warning: Illegal address syntax from example.com[192.168.0.1] in MAIL command: user@sample.net
4678       $addr =~ s/[<>]//g   unless ($addr eq '<>');
4679       $Totals{'illegaladdrsyntax'}++; return unless ($Collecting{'illegaladdrsyntax'});
4680       $Counts{'illegaladdrsyntax'}{$cmd}{$addr}{formathost($hostip,$host)}++;
4681
4682    } elsif ($warning =~ /^(timeout|premature end-of-input) on (.+) while reading (.*)$/o
4683          or $warning =~ /^(malformed (?:base64|numerical)|unexpected end-of-input) from (.+) while reading (.*)$/o) {
4684
4685       #TDs warning: premature end-of-input on private/anvil while reading input attribute name
4686       #TDs warning: timeout on private/anvil while reading input attribute data
4687       #TDs warning: unexpected end-of-input from 127.0.0.1:10025 socket while reading input attribute name
4688       #TDs warning: malformed base64 data from %s while reading input attribute data: ...
4689       #TDs warning: malformed numerical data from %s while reading input attribute data: ...
4690
4691       $Totals{'attrerror'}++; return unless ($Collecting{'attrerror'});
4692       $Counts{'attrerror'}{$2}{$1}{$3}++;
4693
4694    } elsif ($warning =~ /^(.*): (bad command startup -- throttling)/o) {
4695       #TD warning: /usr/libexec/postfix/trivial-rewrite: bad command startup -- throttling
4696       $Totals{'startuperror'}++; return unless ($Collecting{'startuperror'});
4697       $Counts{'startuperror'}{ucfirst($2)}{$1}++;
4698
4699    } elsif ($warning =~ /(problem talking to service [^:]*): (.*)$/o) {
4700       #TD warning: problem talking to service rewrite: Connection reset by peer
4701       #TD warning: problem talking to service rewrite: Success
4702       $Totals{'communicationerror'}++; return unless ($Collecting{'communicationerror'});
4703       $Counts{'communicationerror'}{ucfirst($1)}{$2}++;
4704
4705    } elsif (my ($map,$key) = ($warning =~ /^$re_QID: ([^ ]*) map lookup problem for (.*)$/o)) {
4706       #TD warning: 6F74F74431: virtual_alias_maps map lookup problem for root@example.com
4707       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4708       $Counts{'mapproblem'}{$map}{$key}++;
4709
4710    } elsif (($map,$reason) = ($warning =~ /^pcre map ([^,]+), (.*)$/o)) {
4711       #TD warning: pcre map /etc/postfix/body_checks, line 92: unknown regexp option "F": skipping this rule
4712       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4713       $Counts{'mapproblem'}{$map}{$reason}++;
4714
4715    } elsif (($reason) = ($warning =~ /dict_ldap_lookup: (.*)$/o)) {
4716       #TD warning: dict_ldap_lookup: Search error 80: Internal (implementation specific) error
4717       $Totals{'ldaperror'}++; return unless ($Collecting{'ldaperror'});
4718       $Counts{'ldaperror'}{$reason}++;
4719
4720    } elsif (($type,$size,$host,$hostip,$service) = ($warning =~ /^(.+) limit exceeded: (\d+) from ([^[]+)\[([^]]+)\](?::\d+)? for service (.*)/ )) {
4721       #TDsd warning: Connection concurrency limit exceeded: 51 from example.com[192.168.0.1] for service smtp
4722       #TDsd warning: Connection rate limit exceeded: 20 from mail.example.com[192.168.0.1] for service smtp
4723       #TDsd warning: Connection rate limit exceeded: 30 from unknown[unknown] for service smtp
4724       #TDsd warning: Recipient address rate limit exceeded: 21 from example.com[10.0.0.1] for service smtp
4725       #TDsd warning: Message delivery request rate limit exceeded: 11 from example.com[10.0.0.1] for service smtp
4726       #TDsd warning: New TLS session rate limit exceeded: 49 from example.com[10.0.0.1] for service smtp
4727       $Totals{'anvil'}++; return unless ($Collecting{'anvil'});
4728       $Counts{'anvil'}{$service}{$type}{formathost($hostip,$host)}{$size}++;
4729
4730    } elsif (my ($extname,$intname,$limit) = ($warning =~ /service "([^"]+)" \(([^)]+)\) has reached its process limit "([^"]+)":/o)) {
4731       #TD warning: service "smtp" (25) has reached its process limit "50": new clients may experience noticeable delays
4732       $Totals{'processlimit'}++; return unless ($Collecting{'processlimit'});
4733       $Counts{'processlimit'}{'See http://www.postfix.org/STRESS_README.html'}{"$extname ($intname)"}{$limit}++;
4734
4735    } else {
4736       #TDsd warning: No server certs available. TLS won't be enabled
4737       #TDs warning: smtp_connect_addr: bind <localip>: Address already in use
4738
4739       # These two messages follow ProcessLimit message above
4740       #TDm warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client
4741       #TDm warning: see http://www.postfix.org/STRESS_README.html for examples of stress-dependent configuration settings
4742       return if ($warning =~ /^to avoid this condition,/o);
4743       return if ($warning =~ /^see http:\/\/www\.postfix\.org\/STRESS_README.html/o);
4744
4745       #TDsd warning: 009314BD9E: read timeout on cleanup socket
4746       $warning =~ s/^$re_QID: (read timeout on \S+ socket)/$1/;
4747
4748       #TDsd warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4749       #TDs warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4750       $warning =~ s/^(Read failed in network_biopair_interop) with .*$/$1/;
4751
4752 =cut
4753       $warning =~ s/^(TLS library problem: )\d+:(error:.*)$/$1$2/;
4754       $warning =~ s/^(network_biopair_interop: error reading) \d+ bytes(.*)$/$1$2/;
4755
4756 1      TLS library problem: 10212:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4757 1      TLS library problem: 10217:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4758 1      network_biopair_interop: error reading 1102 bytes from the network: Connection reset by peer
4759 1      network_biopair_interop: error reading 1120 bytes from the network: Connection reset by peer
4760 =cut
4761
4762
4763       $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'});
4764       $Counts{'warningsother'}{$warning}++;
4765    }
4766 }
4767
4768 # Handles postfix/postfix-script lines
4769 #
4770 sub postfix_script($) {
4771    my $line = shift;
4772
4773    return if ($line =~ /^the Postfix mail system is running: PID: /o);
4774
4775    if ($line =~ /^starting the Postfix mail system/o) {
4776       $Totals{'postfixstart'}++;
4777    }
4778    elsif ($line =~ /^stopping the Postfix mail system/o) {
4779       $Totals{'postfixstop'}++;
4780    }
4781    elsif ($line =~ /^refreshing the Postfix mail system/o) {
4782       $Totals{'postfixrefresh'}++;
4783    }
4784    elsif ($line =~ /^waiting for the Postfix mail system to terminate/o) {
4785       $Totals{'postfixwaiting'}++;
4786    }
4787    elsif (! in_ignore_list ($line)) {
4788       inc_unmatched('postfix_script');
4789    }
4790 }
4791
4792 # Clean up a server's reply, to give some uniformity to reports
4793 #
4794 sub cleanhostreply($ $ $ $) {
4795    my ($hostreply,$relay,$recip,$domain) = @_;
4796
4797    my $fmtdhost = '';
4798    my ($r1, $r2, $dsn, $msg, $host, $event);
4799
4800    #print "RELAY: $relay, RECIP: $recip, DOMAIN: $domain\n";
4801    #print "HOSTREPLY: \"$hostreply\"\n";
4802    return ('Accepted', '*unknown')  if $hostreply =~ /^25\d/o;
4803
4804    # Host or domain name not found. Name service error for name=example.com type=MX: Host not found...
4805    if ($hostreply =~ /^Host or domain name not found. Name service error for name=([^:]+): Host not found/o) {
4806       return ('Host not found', $1);
4807    }
4808
4809    if (($host,$dsn,$r1) = ($hostreply =~ /host (\S+) said: ($re_DSN)[\- :]*"?(.*)"?$/o)) {
4810       # Strip recipient address from host's reply - we already have it in $recip.
4811       $r1 =~ s/[<(]?\Q$recip\E[>)]?\W*//ig;
4812
4813       # Strip and capture "in reply to XYZ command" from host's reply
4814       if ($r1 =~ s/\s*[(]?(?:in reply to (.*) command)[)]?//o) {
4815          $r2 = ": $1";
4816       }
4817       $r1 =~ s/^Recipient address rejected: //o;
4818       # Canonicalize numerous forms of "recipient unknown"
4819       if (   $r1 =~ /^user unknown/i
4820           or $r1 =~ /^unknown user/i
4821           or $r1 =~ /^unknown recipient address/i
4822           or $r1 =~ /^invalid recipient/i
4823           or $r1 =~ /^recipient unknown/i
4824           or $r1 =~ /^sorry, no mailbox here by that name/i
4825           or $r1 =~ /^User is unknown/
4826           or $r1 =~ /^User not known/
4827           or $r1 =~ /^MAILBOX NOT FOUND/
4828           or $r1 =~ /^Recipient Rejected: No account by that name here/
4829           or $r1 =~ /^Recipient does not exist here/
4830           or $r1 =~ /The email account that you tried to reach does not exist./ # Google's long mess
4831           or $r1 =~ /(?:no such user|user unknown)/i
4832          )
4833       {
4834          #print "UNKNOWN RECIP: $r1\n";
4835          $r1 = 'Unknown recipient';
4836       }
4837       elsif ($r1 =~ /greylisted/oi) {
4838          #print "GREYLISTED RECIP: $r1\n";
4839          $r1 = 'Recipient greylisted';
4840       }
4841       elsif ($r1 =~ /^Message temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/o) {
4842          # Yahoo: 421 Message temporarily deferred - 4.16.51. Please refer to http://... (in reply to end of DATA command))
4843          $dsn = "$dsn $1"; $r1 = "see $2";
4844       }
4845       elsif ($r1 =~ /^Resources temporarily not available - Please try again later \[#(\d\.\d+\.\d+)\]\.$/o) {
4846          #Yahoo 451 Resources temporarily not available - Please try again later [#4.16.5].
4847          $dsn = "$dsn $1"; $r1 = "resources not available";
4848       }
4849       elsif ($r1 =~ /^Message temporarily deferred - (\[\d+\])/o) {
4850          # Yahoo: 451 Message temporarily deferred - [160]
4851          $dsn = "$dsn $1"; $r1 = '';
4852       }
4853    }
4854
4855    elsif ($hostreply =~ /^connect to (\S+): (.*)$/o) {
4856       #print "CONNECT: $hostreply\n";
4857       $host = $1; $r1 = $2; $r1 =~ s/server refused to talk to me/refused/;
4858    }
4859
4860    elsif ($hostreply =~ /^host (\S+) refused to talk to me: (.*)$/o) {
4861       $host = $1; $msg = $2;
4862       #print "HOSTREFUSED: $hostreply\n";
4863       #Yahoo: '421 Message from (10.0.0.1) temporarily deferred - 4.16.50. Please refer to http://...
4864       if ($msg =~ /^(\d+) Message from \([^)]+\) temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/) {
4865          $dsn = "$1 $2"; $msg = "see $3";
4866       }
4867       #$r1 = join(': ', 'refused', $msg);
4868       $r1 = $msg;
4869    }
4870    elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) {
4871       #print "DELIVERY SUSP: $hostreply\n";
4872       $host = $2; $r1 = join(': ', $1, $3);
4873    }
4874    elsif ($hostreply =~ /^(delivery temporarily suspended: conversation) with (\S+) (.*)$/o) {
4875       # delivery temporarily suspended: conversation with example.com[10.0.0.1] timed out while receiving the initial server greeting)
4876       #print "DELIVERY SUSP2: $hostreply\n";
4877       $host = $2; $r1 = join(' ', $1, $3);
4878    }
4879    elsif (($event,$host,$r1) = ($hostreply =~ /^(lost connection|conversation) with (\S+) (.*)$/o)) {
4880       #print "LOST conv/conn: $hostreply\n";
4881       $r1 = join(' ',$event,$r1);
4882    }
4883    elsif ($hostreply =~ /^(.*: \S+maildrop: Unable to create a dot-lock) at .*$/o) {
4884       #print "MAILDROP: $hostreply\n";
4885       $r1 = $1;
4886    }
4887    elsif ($hostreply =~ /^mail for (\S+) loops back to myself/o) {
4888       #print "LOOP: $hostreply\n";
4889       $host = $1; $r1 = 'mailer loop';
4890    }
4891    elsif ($hostreply =~ /^unable to find primary relay for (\S+)$/o) {
4892       #print "NORELAY: $hostreply\n";
4893       $host = $1; $r1 = 'no relay found';
4894    }
4895    elsif ($hostreply =~ /^message size \d+ exceeds size limit \d+ of server (\S+)\s*$/o) {
4896       #print "TOOBIG: $hostreply\n";
4897       $host = $1; $r1 = 'message too big';
4898    }
4899    else {
4900       #print "UNMATCH: $hostreply\n";
4901       $r1 = $hostreply;
4902    }
4903
4904    #print "R1: $r1, R2: $r2\n";
4905    $r1 =~ s/for name=\Q$domain\E //ig;
4906
4907    if ($host eq '') {
4908       if ($relay =~ /([^[]+)\[([^]]+)\]/) {
4909          $fmtdhost = formathost($2,$1);
4910       }
4911       else {
4912          $fmtdhost = '*unknown';
4913       }
4914    }
4915    elsif ($host =~ /^([^[]+)\[([^]]+)\]/) {
4916       $fmtdhost = formathost($2,$1);
4917    }
4918    else {
4919       $fmtdhost = $host;
4920    }
4921
4922    return (($dsn ? "$dsn " : '' ) . "\u$r1$r2", $fmtdhost);
4923 }
4924
4925 # Strip and return from, to, proto, and helo information from a log line
4926 # From is set to the empty envelope sender <> as necessary, and To is
4927 # always lowercased.
4928 #
4929 # Note: modifies its input for efficiency
4930 #
4931 sub strip_ftph($) {
4932    my ($helo, $proto, $to, $from);
4933    #print "strip_ftph: '$_[0]\n";
4934    $helo  =    ($_[0] =~ s/\s+helo=<(.*?)>\s*$//) == 1 ? $1               : '*unavailable';
4935    $proto =    ($_[0] =~ s/\s+proto=(\S+)\s*$//)  == 1 ? $1               : '*unavailable';
4936    $to    =    ($_[0] =~ s/\s+to=<(.*?)>\s*$//)   == 1 ? (lc($1) || '<>') : '*unavailable';
4937    $from  =    ($_[0] =~ s/\s+from=<(.*?)>\s*$//) == 1 ? (   $1  || '<>') : '*unavailable';
4938
4939    #print "helo: $helo, proto: $proto, to: $to, from: $from\n";
4940    #print "strip_ftph: final: '$_[0]'\n";
4941    return ($from,$to,$proto,$helo);
4942 }
4943
4944 # Initialize the Getopts option list.  Requires the Section table to
4945 # be built already.
4946 #
4947 sub init_getopts_table() {
4948    print "init_getopts_table: enter\n"  if $Opts{'debug'} & Logreporters::D_ARGS;
4949
4950    init_getopts_table_common(@supplemental_reports);
4951
4952    add_option ('recipient_delimiter=s');
4953    add_option ('delays!');
4954    add_option ('show_delays=i',             sub { $Opts{'delays'} = $_[1]; 1; });
4955    add_option ('delays_percentiles=s');
4956    add_option ('reject_reply_patterns=s');
4957    add_option ('ignore_services=s');
4958    add_option ('postgrey_delays!');
4959    add_option ('postgrey_show_delays=i',    sub { $Opts{'postgrey_delays'} = $_[1]; 1; });
4960    add_option ('postgrey_delays_percentiles=s');
4961    add_option ('unknown!',                  sub { $Opts{'unknown'} = $_[1]; 1; });
4962    add_option ('show_unknown=i',            sub { $Opts{'unknown'} = $_[1]; 1; });
4963    add_option ('enable_long_queue_ids=i',   sub { $Opts{'long_queue_ids'} = $_[1]; 1; });
4964    add_option ('long_queue_ids!');
4965
4966 =pod
4967    # aliases and backwards compatibility
4968    add_option ('msgsdeferred=s',            \$Opts{'deferred'});
4969    add_option ('msgsdelivered=s',           \$Opts{'delivered'});
4970    add_option ('msgssent=s',                \$Opts{'sent'});
4971    add_option ('msgssentlmtp=s',            \$Opts{'sentlmtp'});
4972    add_option ('msgsforwarded=s',           \$Opts{'forwarded'});
4973    add_option ('msgsresent=s',              \$Opts{'resent'});
4974    add_option ('warn=s',                    \$Opts{'warned'});
4975    add_option ('held=s',                    \$Opts{'hold'});
4976 =cut
4977 }
4978
4979 # Builds the entire @Section table used for data collection
4980 #
4981 # Each Section entry has as many as six fields:
4982 #
4983 #   1. Section array reference
4984 #   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
4985 #   3. Output in Detail report? (must also a %Counts accumulator)
4986 #   4. Numeric output format specifier for Summary report
4987 #   5. Section title for Summary and Detail reports
4988 #   6. A hash to a divisor used to calculate the percentage of a total for that key
4989 #
4990 # Use begin_section_group/end_section_group to create groupings around sections.
4991 #
4992 # Sections can be freely reordered if desired, but maintain proper group nesting.
4993 #
4994 #
4995 # The reject* entries of this table are dynamic, in that they are built based
4996 # upon the value of $Opts{'reject_reply_patterns'}, which can be specified by
4997 # either command line or configuration file.  This allows various flavors, of
4998 # reject sections based on SMTP reply code (eg. 421 45x, 5xx, etc.).  Instead
4999 # of creating special sections for each reject variant, the primary key of each
5000 # reject section could have been the SMTP reply code.  However, this would
5001 # require special-case processing to distinguish 4xx temporary rejects from 5xx
5002 # permanent rejects in various Totals{'totalrejects*'} counts, and in the
5003 # Totals{'totalrejects'} tally.
5004 #
5005 # Sections can be freely reordered if desired.
5006 sub build_sect_table() {
5007    if ($Opts{'debug'} & Logreporters::D_SECT) {
5008       print "build_sect_table: enter\n";
5009       print "\treject patterns: $Opts{'reject_reply_patterns'}\n";
5010    }
5011    my $S = \@Sections;
5012
5013    # References to these are used in the Sections table below; we'll predeclare them.
5014    $Totals{'totalrejects'} = 0;
5015    $Totals{'totalrejectswarn'} = 0;
5016    $Totals{'totalacceptplusreject'} = 0;
5017
5018    # Configuration and critical errors appear first
5019
5020    #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
5021    begin_section_group ($S, 'warnings');
5022    add_section ($S, 'panicerror',                  1, 'd', '*Panic:   General panic');
5023    add_section ($S, 'fatalfiletoobig',             0, 'd', '*Fatal:   Message file too big');
5024    add_section ($S, 'fatalconfigerror',            1, 'd', '*Fatal:   Configuration error');
5025    add_section ($S, 'fatalerror',                  1, 'd', '*Fatal:   General fatal');
5026    add_section ($S, 'error',                       1, 'd', '*Error:   General error');
5027    add_section ($S, 'processlimit',                1, 'd', '*Warning: Process limit reached, clients may delay');
5028    add_section ($S, 'warnfiletoobig',              0, 'd', '*Warning: Queue file size limit exceeded');
5029    add_section ($S, 'warninsufficientspace',       0, 'd', '*Warning: Insufficient system storage error');
5030    add_section ($S, 'warnconfigerror',             1, 'd', '*Warning: Server configuration error');
5031    add_section ($S, 'queuewriteerror',             1, 'd', '*Warning: Error writing queue file');
5032    add_section ($S, 'messagewriteerror',           1, 'd', '*Warning: Error writing message file');
5033    add_section ($S, 'databasegeneration',          1, 'd', '*Warning: Database is older than source file');
5034    add_section ($S, 'mailerloop',                  1, 'd', '*Warning: Mailer loop');
5035    add_section ($S, 'startuperror',                1, 'd', '*Warning: Startup error');
5036    add_section ($S, 'mapproblem',                  1, 'd', '*Warning: Map lookup problem');
5037    add_section ($S, 'attrerror',                   1, 'd', '*Warning: Error reading attribute data');
5038    add_section ($S, 'anvil',                       1, 'd', '*Warning: Anvil limit reached');
5039    add_section ($S, 'processexit',                 1, 'd', 'Process exited');
5040    add_section ($S, 'hold',                        1, 'd', 'Placed on hold');
5041    add_section ($S, 'communicationerror',          1, 'd', 'Postfix communications error');
5042    add_section ($S, 'saslauthfail',                1, 'd', 'SASL authentication failed');
5043    add_section ($S, 'ldaperror',                   1, 'd', 'LDAP error');
5044    add_section ($S, 'warningsother',               1, 'd', 'Miscellaneous warnings');
5045    add_section ($S, 'totalrejectswarn',            0, 'd', 'Reject warnings (warn_if_reject)');
5046    end_section_group ($S, 'warnings');
5047
5048    begin_section_group ($S, 'bytes', "\n");
5049    add_section ($S, 'bytesaccepted',               0, 'Z', 'Bytes accepted ');           # Z means print scaled as in 1k, 1m, etc.
5050    add_section ($S, 'bytessentsmtp',               0, 'Z', 'Bytes sent via SMTP');
5051    add_section ($S, 'bytessentlmtp',               0, 'Z', 'Bytes sent via LMTP');
5052    add_section ($S, 'bytesdelivered',              0, 'Z', 'Bytes delivered');
5053    add_section ($S, 'bytesforwarded',              0, 'Z', 'Bytes forwarded');
5054    end_section_group ($S, 'bytes', $sep1);
5055
5056    begin_section_group ($S, 'acceptreject', "\n");
5057    begin_section_group ($S, 'acceptreject2', "\n");
5058    add_section ($S, 'msgsaccepted',                0, 'd', 'Accepted',                          \$Totals{'totalacceptplusreject'});
5059    add_section ($S, 'totalrejects',                0, 'd', 'Rejected',                          \$Totals{'totalacceptplusreject'});
5060    end_section_group ($S, 'acceptreject2', $sep2);
5061    add_section ($S, 'totalacceptplusreject',       0, 'd', 'Total',                             \$Totals{'totalacceptplusreject'});
5062    end_section_group ($S, 'acceptreject', $sep1);
5063
5064    # The various Reject sections are built dynamically based upon a list of reject reply keys,
5065    # which are user-configured via $Opts{'reject_reply_patterns'}
5066    @RejectPats = ();
5067    foreach my $rejpat (split /[ ,]/, $Opts{'reject_reply_patterns'}) {
5068       if ($rejpat !~ /^(warn|[45][\d.]{2})$/io) {
5069          print STDERR usage "Invalid pattern \"$rejpat\" in reject_reply_patterns";
5070          exit (2);
5071       }
5072       if (grep (/\Q$rejpat\E/, @RejectPats) == 0) {
5073          push @RejectPats, $rejpat
5074       }
5075       else {
5076          print STDERR "Ignoring duplicate pattern \"$rejpat\" in reject_reply_patterns\n";
5077       }
5078    }
5079    @RejectKeys = @RejectPats;
5080    for (@RejectKeys) {
5081       s/\./x/g;
5082    }
5083
5084    print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n"  if $Opts{'debug'} & Logreporters::D_SECT;
5085
5086    # Add reject variants
5087    foreach my $key (@RejectKeys) {
5088       $key   = lc($key);
5089       my $keyuc = ucfirst($key);
5090       my $totalsref = \$Totals{'totalrejects' . $key};
5091       print "\t   reject key: $key\n" if $Opts{'debug'} & Logreporters::D_SECT;
5092
5093       begin_section_group ($S, 'rejects', "\n");
5094       begin_section_group ($S, 'rejects2', "\n");
5095       add_section ($S, $key . 'rejectrelay',                 1, 'd', $keyuc . ' Reject relay denied',                $totalsref);
5096       add_section ($S, $key . 'rejecthelo',                  1, 'd', $keyuc . ' Reject HELO/EHLO',                   $totalsref);
5097       add_section ($S, $key . 'rejectdata',                  1, 'd', $keyuc . ' Reject DATA',                        $totalsref);
5098       add_section ($S, $key . 'rejectunknownuser',           1, 'd', $keyuc . ' Reject unknown user',                $totalsref);
5099       add_section ($S, $key . 'rejectrecip',                 1, 'd', $keyuc . ' Reject recipient address',           $totalsref);
5100       add_section ($S, $key . 'rejectsender',                1, 'd', $keyuc . ' Reject sender address',              $totalsref);
5101       add_section ($S, $key . 'rejectclient',                1, 'd', $keyuc . ' Reject client host',                 $totalsref);
5102       add_section ($S, $key . 'rejectunknownclient',         1, 'd', $keyuc . ' Reject unknown client host',         $totalsref);
5103       add_section ($S, $key . 'rejectunknownreverseclient',  1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref);
5104       add_section ($S, $key . 'rejectunverifiedclient',      1, 'd', $keyuc . ' Reject unverified client host',      $totalsref);
5105       add_section ($S, $key . 'rejectrbl',                   1, 'd', $keyuc . ' Reject RBL',                         $totalsref);
5106       add_section ($S, $key . 'rejectheader',                1, 'd', $keyuc . ' Reject header',                      $totalsref);
5107       add_section ($S, $key . 'rejectbody',                  1, 'd', $keyuc . ' Reject body',                        $totalsref);
5108       add_section ($S, $key . 'rejectcontent',               1, 'd', $keyuc . ' Reject content',                     $totalsref);
5109       add_section ($S, $key . 'rejectsize',                  1, 'd', $keyuc . ' Reject message size',                $totalsref);
5110       add_section ($S, $key . 'rejectmilter',                1, 'd', $keyuc . ' Reject milter',                      $totalsref);
5111       add_section ($S, $key . 'rejectproxy',                 1, 'd', $keyuc . ' Reject proxy',                       $totalsref);
5112       add_section ($S, $key . 'rejectinsufficientspace',     1, 'd', $keyuc . ' Reject insufficient space',          $totalsref);
5113       add_section ($S, $key . 'rejectconfigerror',           1, 'd', $keyuc . ' Reject server config error',         $totalsref);
5114       add_section ($S, $key . 'rejectverify',                1, 'd', $keyuc . ' Reject VRFY',                        $totalsref);
5115       add_section ($S, $key . 'rejectetrn',                  1, 'd', $keyuc . ' Reject ETRN',                        $totalsref);
5116       add_section ($S, $key . 'rejectlookupfailure',         1, 'd', $keyuc . ' Reject temporary lookup failure',    $totalsref);
5117       end_section_group ($S, 'rejects2', $sep2);
5118       add_section ($S, 'totalrejects' . $key,                0, 'd', "Total $keyuc Rejects",                         $totalsref);
5119       end_section_group ($S, 'rejects', $sep1);
5120
5121       $Totals{'totalrejects' . $key} = 0;
5122    }
5123
5124    begin_section_group ($S, 'byiprejects', "\n");
5125    add_section ($S,  'byiprejects',                 1, 'd', 'Reject by IP');
5126    end_section_group ($S, 'byiprejects');
5127
5128    begin_section_group ($S, 'general1', "\n");
5129    add_section ($S, 'connectioninbound',           1, 'd', 'Connections');
5130    add_section ($S, 'connectionlostinbound',       1, 'd', 'Connections lost (inbound)');
5131    add_section ($S, 'connectionlostoutbound',      1, 'd', 'Connections lost (outbound)');
5132    add_section ($S, 'disconnection',               0, 'd', 'Disconnections');
5133    add_section ($S, 'removedfromqueue',            0, 'd', 'Removed from queue');
5134    add_section ($S, 'delivered',                   1, 'd', 'Delivered');
5135    add_section ($S, 'sent',                        1, 'd', 'Sent via SMTP');
5136    add_section ($S, 'sentlmtp',                    1, 'd', 'Sent via LMTP');
5137    add_section ($S, 'forwarded',                   1, 'd', 'Forwarded');
5138    add_section ($S, 'resent',                      0, 'd', 'Resent');
5139    add_section ($S, 'deferred',                    1, 'd', 'Deferred');
5140    add_section ($S, 'deferrals',                   1, 'd', 'Deferrals');
5141    add_section ($S, 'bouncelocal',                 1, 'd', 'Bounced (local)');
5142    add_section ($S, 'bounceremote',                1, 'd', 'Bounced (remote)');
5143    add_section ($S, 'bouncefailed',                1, 'd', 'Bounce failure');
5144    add_section ($S, 'postscreen',                  1, 'd', 'Postscreen');
5145    add_section ($S, 'dnsblog',                     1, 'd', 'DNSBL log');
5146
5147    add_section ($S, 'envelopesenders',             1, 'd', 'Envelope senders');
5148    add_section ($S, 'envelopesenderdomains',       1, 'd', 'Envelope sender domains');
5149
5150    add_section ($S, 'bcced',                       1, 'd', 'BCCed');
5151    add_section ($S, 'filtered',                    1, 'd', 'Filtered');
5152    add_section ($S, 'redirected',                  1, 'd', 'Redirected');
5153    add_section ($S, 'discarded',                   1, 'd', 'Discarded');
5154    add_section ($S, 'prepended',                   1, 'd', 'Prepended');
5155    add_section ($S, 'replaced',                    1, 'd', 'Replaced');
5156    add_section ($S, 'warned',                      1, 'd', 'Warned');
5157
5158    add_section ($S, 'requeued',                    0, 'd', 'Requeued messages');
5159    add_section ($S, 'returnedtosender',            1, 'd', 'Expired and returned to sender');
5160    add_section ($S, 'notificationsent',            1, 'd', 'Notifications sent');
5161
5162    add_section ($S, 'policyspf',                   1, 'd', 'Policy SPF');
5163    add_section ($S, 'policydweight',               1, 'd', 'Policyd-weight');
5164    add_section ($S, 'postfwd',                     1, 'd', 'Postfwd');
5165    add_section ($S, 'postgrey',                    1, 'd', 'Postgrey');
5166    end_section_group ($S, 'general1');
5167
5168    begin_section_group ($S, 'general2', "\n");
5169    add_section ($S, 'connecttofailure',            1, 'd', 'Connection failures (outbound)');
5170    add_section ($S, 'timeoutinbound',              1, 'd', 'Timeouts (inbound)');
5171    add_section ($S, 'heloerror',                   1, 'd', 'HELO/EHLO conversations errors');
5172    add_section ($S, 'illegaladdrsyntax',           1, 'd', 'Illegal address syntax in SMTP command');
5173    add_section ($S, 'released',                    0, 'd', 'Released from hold');
5174    add_section ($S, 'rblerror',                    1, 'd', 'RBL lookup errors');
5175    add_section ($S, 'dnserror',                    1, 'd', 'DNS lookup errors');
5176    add_section ($S, 'numerichostname',             1, 'd', 'Numeric hostname');
5177    add_section ($S, 'smtpconversationerror',       1, 'd', 'SMTP dialog errors');
5178    add_section ($S, 'hostnameverification',        1, 'd', 'Hostname verification errors (FCRDNS)');
5179    add_section ($S, 'hostnamevalidationerror',     1, 'd', 'Hostname validation errors');
5180    add_section ($S, 'smtpprotocolviolation',       1, 'd', 'SMTP protocol violations');
5181    add_section ($S, 'deliverable',                 1, 'd', 'Deliverable (address verification)');
5182    add_section ($S, 'undeliverable',               1, 'd', 'Undeliverable (address verification)');
5183    add_section ($S, 'tablechanged',                0, 'd', 'Restarts due to lookup table change');
5184    add_section ($S, 'pixworkaround',               1, 'd', 'PIX workaround enabled');
5185    add_section ($S, 'tlsserverconnect',            1, 'd', 'TLS connections (server)');
5186    add_section ($S, 'tlsclientconnect',            1, 'd', 'TLS connections (client)');
5187    add_section ($S, 'saslauth',                    1, 'd', 'SASL authenticated messages');
5188    add_section ($S, 'tlsunverified',               1, 'd', 'TLS certificate unverified');
5189    add_section ($S, 'tlsoffered',                  1, 'd', 'Host offered TLS');
5190    end_section_group ($S, 'general2');
5191
5192    begin_section_group ($S, 'postfixstate', "\n");
5193    add_section ($S, 'postfixstart',                0, 'd', 'Postfix start');
5194    add_section ($S, 'postfixstop',                 0, 'd', 'Postfix stop');
5195    add_section ($S, 'postfixrefresh',              0, 'd', 'Postfix refresh');
5196    add_section ($S, 'postfixwaiting',              0, 'd', 'Postfix waiting to terminate');
5197    end_section_group ($S, 'postfixstate');
5198
5199
5200    if ($Opts{'debug'} & Logreporters::D_SECT) {
5201       print "\tSection table\n";
5202       printf "\t\t%s\n", (ref($_) eq 'HASH' ? $_->{NAME} : $_) foreach @Sections;
5203       print "build_sect_table: exit\n"
5204    }
5205 }
5206
5207 # XXX create array of defaults for detail <5, 5-9, >10
5208 sub init_defaults() {
5209    map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
5210    if (! $Opts{'standalone'}) {
5211       # LOGWATCH
5212       # these take affect if no env present (eg. nothing in conf file)
5213       # 0 to 4 nodelays
5214
5215       if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
5216          $Opts{'delays'}            = 0;
5217          $Opts{'postgrey_delays'}   = 0;
5218       }
5219    }
5220 }
5221
5222
5223 # XXX ensure something is matched?
5224 # XXX cache values so we don't have to substitute X for . each time
5225 #match $dsn against list for best fit
5226 sub get_reject_key($) {
5227    my $reply = shift;
5228    my $replyorig = $reply;
5229    ($reply) = split / /, $reply;
5230    for (my $i = 0; $i <= $#RejectPats; $i++) {
5231       #print "TRYING: $RejectPats[$i]\n";
5232       # we'll allow extended DSNs to match (eg. 5.7.1 will match 5..)
5233       if ($reply =~ /^$RejectPats[$i]/) {    # no /o here, pattern varies
5234          #print "MATCHED: orig: $replyorig, reply $reply matched pattern $RejectPats[$i], returning $RejectKeys[$i]\n";
5235          return $RejectKeys[$i];
5236       }
5237    }
5238    #print "NOT MATCHED: REPLY CODE: '$replyorig', '$reply'\n";
5239    return;
5240 }
5241
5242 # Replace bare reject limiters with specific reject limiters
5243 # based on reject_reply_patterns
5244 #
5245 sub expand_bare_reject_limiters()
5246 {
5247   # don't reorder the list of limiters.  This breaks --nodetail followed by a
5248   # bare reject such as --limit rejectrbl=10.  Reordering is no longer necessary
5249   # since process_limiters was instituted and using the special __none__ pseudo-
5250   # limiter to indicate the position at which --nodefailt was found on the command
5251   # line.
5252   # my ($limiter, @reject_limiters, @non_reject_limiters);
5253    my ($limiter, @new_list);
5254
5255    # XXX check if limiter matches just one in rejectclasses
5256    while ($limiter = shift @Limiters) {
5257       if ($limiter =~ /^reject[^_]/) {
5258          foreach my $reply_code (@RejectKeys) {
5259             printf "bare_reject: \L$reply_code$limiter\n"  if $Opts{'debug'} & Logreporters::D_VARS;
5260             #push @reject_limiters, lc($reply_code) . $limiter;
5261             push @new_list, lc($reply_code) . $limiter;
5262          }
5263       }
5264       elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) {
5265          $limiter =~ s/^([45])\.\./$1xx/;
5266          #push @reject_limiters, lc $limiter;
5267          push @new_list, lc $limiter;
5268       }
5269       else {
5270          #push @non_reject_limiters, $limiter;
5271          push @new_list, $limiter;
5272       }
5273    }
5274    #@Limiters = (@reject_limiters, @non_reject_limiters);
5275    @Limiters = @new_list;
5276 }
5277
5278
5279 # Return a usage string,  built from:
5280 #    arg1 +
5281 #    $usage_str +
5282 #    a string built from each usable entry in the @Sections table.
5283 # reject patterns are special cased to minimize the number of
5284 # command line options presented.
5285 #
5286 sub usage($) {
5287    my $ret = "";
5288    $ret = "@_\n"  if ($_[0]);
5289
5290    $ret .= $usage_str;
5291    my ($name, $desc, %reject_types);
5292    foreach my $sect (get_usable_sectvars(@Sections, 0)) {
5293
5294       if (my ($code,$rej) = ($sect->{NAME} =~ /^(...|warn)(reject.*)$/oi)) {
5295          $rej = lc $rej;
5296          next if (exists $reject_types{$rej});
5297          $reject_types{$rej}++;
5298          $name = '[###]' . $rej;
5299          $desc = '###' . substr($sect->{TITLE}, length($code));
5300       }
5301       else {
5302          $name = lc $sect->{NAME};
5303          $desc = $sect->{TITLE};
5304       }
5305       $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
5306    }
5307    $ret .= "\n";
5308    return $ret;
5309 }
5310
5311 1;
5312
5313 # vi: shiftwidth=3 tabstop=3 syntax=perl et