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