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                 my $new_line;
1382                 if ($extra eq '') {
1383                     $new_line = sprintf("$fmt  %-23s \n", $total, $desc);
1384                 }
1385                 else {
1386                     $new_line = sprintf("$fmt  %-23s $extra\n",
1387                                         $total,
1388                                         $desc,
1389                                         commify ($Totals{$keyname}));
1390                 }
1391                 push @{$lines[$cur_level]}, $new_line
1392             }
1393          }
1394       }
1395       else {
1396          die "print_summary_report: unexpected control...";
1397       }
1398    }
1399    print @{$lines[0]};
1400    print "\n";
1401 }
1402
1403 # Prints the Detail report section
1404 #
1405 # Note: side affect; deletes each key in Totals/Counts
1406 # after printout.  Only the first instance of a key in
1407 # the Section table will result in Detail output.
1408 sub print_detail_report (\@) {
1409    my ($sections) = @_;
1410    my $header_printed = 0;
1411
1412    return unless (keys %Counts);
1413
1414 #use Devel::Size qw(size total_size);
1415
1416    foreach my $sref ( @$sections ) {
1417       next unless $sref->{CLASS} eq 'DATA';
1418       # only print detail for this section if DETAIL is enabled
1419       # and there is something in $Counts{$keyname}
1420       next unless $sref->{DETAIL};
1421       next unless exists $Counts{$sref->{NAME}};
1422
1423       my $keyname = $sref->{NAME};
1424       my $max_level = undef;
1425       my $print_this_key = 0;
1426
1427       my @levelspecs = ();
1428       clear_level_specs($max_level, \@levelspecs);
1429       if (exists $Opts{$keyname}) {
1430          $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
1431          $print_this_key = 1  if ($max_level);
1432       }
1433       else {
1434          $print_this_key = 1;
1435       }
1436       #print_level_specs($max_level,\@levelspecs);
1437
1438       # at detail 5, print level 1, detail 6: level 2, ...
1439
1440 #print STDERR "building: $keyname\n";
1441       my ($count, $treeref) =
1442             buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
1443                        \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);
1444
1445       if ($count > 0) {
1446          if ($print_this_key) {
1447             my $desc = $sref->{TITLE};
1448             $desc =~ s/^\s+//;
1449
1450             if (! $header_printed) {
1451                my $header = "****** Detail ($max_level) ";
1452                print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
1453                $header_printed = 1;
1454             }
1455             printf "\n%8d   %s %s\n", $count, $desc,
1456                      $Opts{'sect_vars'} ?
1457                        ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
1458                         '-' x ($Opts{'max_report_width'} - 12 - length($desc))
1459          }
1460
1461          printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
1462                     $Opts{'debug'} & D_TREE);
1463       }
1464 #print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
1465 #print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
1466       $treeref = undef;
1467       $Totals{$keyname} = undef;
1468       delete $Totals{$keyname};
1469       delete $Counts{$keyname};
1470    }
1471    #print "\n";
1472 }
1473
1474 =pod
1475
1476 Print out a standard percentiles report
1477
1478    === Delivery Delays Percentiles ===============================================================
1479                           0%       25%       50%       75%       90%       95%       98%      100%
1480    -----------------------------------------------------------------------------------------------
1481    Before qmgr          0.01      0.70      1.40  45483.70  72773.08  81869.54  87327.42  90966.00
1482    In qmgr              0.00      0.00      0.00      0.01      0.01      0.01      0.01      0.01
1483    Conn setup           0.00      0.00      0.00      0.85      1.36      1.53      1.63      1.70
1484    Transmission         0.03      0.47      0.92      1.61      2.02      2.16      2.24      2.30
1485    Total                0.05      1.18      2.30  45486.15  72776.46  81873.23  87331.29  90970.00
1486    ===============================================================================================
1487
1488    === Postgrey Delays Percentiles ===========================================================
1489                       0%       25%       50%       75%       90%       95%       98%      100%
1490    -------------------------------------------------------------------------------------------
1491    Postgrey       727.00    727.00    727.00    727.00    727.00    727.00    727.00    727.00
1492    ===========================================================================================
1493
1494  tableref:
1495    data table: ref to array of arrays, first cell is label, subsequent cells are data
1496  title:
1497    table's title
1498  percentiles_str:
1499    string of space or comma separated integers, which are the percentiles
1500    calculated and output as table column data
1501 =cut
1502 sub print_percentiles_report2($$$) {
1503    my ($tableref, $title, $percentiles_str) = @_;
1504
1505    return unless @$tableref;
1506
1507    my $myfw2 = $fw2 - 1;
1508    my @percents = split /[ ,]/, $percentiles_str;
1509
1510    # Calc y label width from the hash's keys. Each key is padded with the
1511    # string "#: ", # where # is a single-digit sort index.
1512    my $y_label_max_width = 0;
1513    for (@$tableref) {
1514       $y_label_max_width = length($_->[0])   if (length($_->[0]) > $y_label_max_width);
1515    }
1516
1517    # Titles row
1518    my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
1519    my $table_width = length($col_titles_str);
1520
1521    # Table header row
1522    my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
1523    $table_header_str .= $sep1 x ($table_width - length($table_header_str));
1524
1525    print "\n", $table_header_str;
1526    print "\n", $col_titles_str;
1527    print "\n", $sep2 x $table_width;
1528
1529    my (@p, @coldata, @xformed);
1530    foreach (@$tableref) {
1531       my ($title, $ref) = ($_->[0], $_->[1]);
1532       #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};
1533
1534       my @byscore = ();
1535
1536       for my $bucket (sort { $a <=> $b } keys %$ref) {
1537       #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
1538       # pairs: bucket (i.e. key), tally
1539          push @byscore, $bucket, $ref->{$bucket};
1540       }
1541
1542
1543       my @p = get_percentiles2 (@byscore, @percents);
1544       printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
1545    }
1546
1547 =pod
1548    foreach (@percents) {
1549       #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
1550       printf "\n%3d%%", $title;
1551       foreach my $val (@{shift @xformed}) {
1552          my $unit;
1553          if ($val > 1000) {
1554             $unit = 's';
1555             $val /= 1000;
1556          }
1557          else {
1558             $unit = '';
1559          }
1560          printf "%${fw3}.2f%-2s", $val, $unit;
1561       }
1562    }
1563 =cut
1564
1565    print "\n", $sep1 x $table_width, "\n";
1566 }
1567
1568 sub clear_level_specs($ $) {
1569    my ($max_level,$lspecsref) = @_;
1570    #print "Zeroing $max_level rows of levelspecs\n";
1571    $max_level = 0 if (not defined $max_level);
1572    for my $x (0..$max_level) {
1573       $lspecsref->[$x]{topn}      = undef;
1574       $lspecsref->[$x]{threshold} = undef;
1575    }
1576 }
1577
1578 # topn      = 0 means don't limit
1579 # threshold = 0 means no min threshold
1580 sub create_level_specs($ $ $) {
1581    my ($optkey,$gdetail,$lspecref) = @_;
1582
1583    return 0 if ($optkey eq "0");
1584
1585    my $max_level = $gdetail;            # default to global detail level
1586    my (@specsP1, @specsP2, @specsP3);
1587
1588    #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;
1589
1590    foreach my $sp (split /[\s,]+/, $optkey) {
1591       #print "create_level_specs:  SP: \"$sp\"\n";
1592       # original level specifier
1593       if ($sp =~ /^\d+$/) {
1594          $max_level = $sp;
1595          #print "create_level_specs:  max_level set: $max_level\n";
1596       }
1597       # original level specifier + topn at level 1
1598       elsif ($sp =~ /^(\d*)\.(\d+)$/) {
1599          if ($1) { $max_level = $1; }
1600          else    { $max_level = $gdetail; }           # top n specified, but no max level
1601
1602          # force top N at level 1 (zero based)
1603          push @specsP1, { level => 0, topn => $2, threshold => 0 };
1604       }
1605       # newer level specs
1606       elsif ($sp =~ /^::(\d+)$/) {
1607          push @specsP3, { level => undef, topn => 0, threshold => $1 };
1608       }
1609       elsif ($sp =~ /^:(\d+):(\d+)?$/) {
1610          push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
1611       }
1612       elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
1613          push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
1614       }
1615       else {
1616          print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
1617       }
1618    }
1619
1620    #foreach my $sp (@specsP3, @specsP2, @specsP1) {
1621    #   printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
1622    #}
1623
1624    my ($min, $max);
1625    foreach my $sp ( @specsP3, @specsP2, @specsP1) {
1626       ($min, $max) = (0, $max_level);
1627
1628       if (defined $sp->{level}) {
1629          $min = $max = $sp->{level};
1630       }
1631       for my $level ($min..$max) {
1632          #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
1633          $lspecref->[$level]{topn}      = $sp->{topn}          if ($sp->{topn});
1634          $lspecref->[$level]{threshold} = $sp->{threshold}     if ($sp->{threshold});
1635       }
1636    }
1637
1638    return $max_level;
1639 }
1640
1641 sub print_level_specs($ $) {
1642    my ($max_level,$lspecref) = @_;
1643    for my $level (0..$max_level) {
1644       printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
1645    }
1646 }
1647
1648
1649 1;
1650
1651 #MODULE: ../Logreporters/RFC3463.pm
1652 package Logreporters::RFC3463;
1653
1654 use 5.008;
1655 use strict;
1656 use re 'taint';
1657 use warnings;
1658
1659 BEGIN {
1660    use Exporter ();
1661    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1662    $VERSION = '1.000';
1663    @ISA = qw(Exporter);
1664    @EXPORT = qw(&get_dsn_msg);
1665 }
1666
1667 use subs @EXPORT;
1668
1669 #-------------------------------------------------
1670 # Enhanced Mail System Status Codes (aka: extended status codes)
1671 #
1672 #   RFC 3463   http://www.ietf.org/rfc/rfc3463.txt
1673 #   RFC 4954   http://www.ietf.org/rfc/rfc4954.txt
1674 #
1675 # Class.Subject.Detail
1676 #
1677 my %dsn_codes = (
1678     class => {
1679       '2' => 'Success',
1680       '4' => 'Transient failure',
1681       '5' => 'Permanent failure',
1682     },
1683
1684     subject => {
1685       '0' => 'Other/Undefined status',
1686       '1' => 'Addressing status',
1687       '2' => 'Mailbox status',
1688       '3' => 'Mail system status',
1689       '4' => 'Network & routing status',
1690       '5' => 'Mail delivery protocol status',
1691       '6' => 'Message content/media status',
1692       '7' => 'Security/policy status',
1693     },
1694
1695     detail => {
1696       '0.0' => 'Other undefined status',
1697       '1.0' => 'Other address status',
1698       '1.1' => 'Bad destination mailbox address',
1699       '1.2' => 'Bad destination system address',
1700       '1.3' => 'Bad destination mailbox address syntax',
1701       '1.4' => 'Destination mailbox address ambiguous',
1702       '1.5' => 'Destination mailbox address valid',
1703       '1.6' => 'Mailbox has moved',
1704       '1.7' => 'Bad sender\'s mailbox address syntax',
1705       '1.8' => 'Bad sender\'s system address',
1706
1707       '2.0' => 'Other/Undefined mailbox status',
1708       '2.1' => 'Mailbox disabled, not accepting messages',
1709       '2.2' => 'Mailbox full',
1710       '2.3' => 'Message length exceeds administrative limit.',
1711       '2.4' => 'Mailing list expansion problem',
1712
1713       '3.0' => 'Other/Undefined mail system status',
1714       '3.1' => 'Mail system full',
1715       '3.2' => 'System not accepting network messages',
1716       '3.3' => 'System not capable of selected features',
1717       '3.4' => 'Message too big for system',
1718
1719       '4.0' => 'Other/Undefined network or routing status',
1720       '4.1' => 'No answer from host',
1721       '4.2' => 'Bad connection',
1722       '4.3' => 'Routing server failure',
1723       '4.4' => 'Unable to route',
1724       '4.5' => 'Network congestion',
1725       '4.6' => 'Routing loop detected',
1726       '4.7' => 'Delivery time expired',
1727
1728       '5.0' => 'Other/Undefined protocol status',
1729       '5.1' => 'Invalid command',
1730       '5.2' => 'Syntax error',
1731       '5.3' => 'Too many recipients',
1732       '5.4' => 'Invalid command arguments',
1733       '5.5' => 'Wrong protocol version',
1734       '5.6' => 'Authentication Exchange line too long',
1735
1736       '6.0' => 'Other/Undefined media error',
1737       '6.1' => 'Media not supported',
1738       '6.2' => 'Conversion required & prohibited',
1739       '6.3' => 'Conversion required but not supported',
1740       '6.4' => 'Conversion with loss performed',
1741       '6.5' => 'Conversion failed',
1742
1743       '7.0' => 'Other/Undefined security status',
1744       '7.1' => 'Delivery not authorized, message refused',
1745       '7.2' => 'Mailing list expansion prohibited',
1746       '7.3' => 'Security conversion required but not possible',
1747       '7.4' => 'Security features not supported',
1748       '7.5' => 'Cryptographic failure',
1749       '7.6' => 'Cryptographic algorithm not supported',
1750       '7.7' => 'Message integrity failure',
1751     },
1752
1753     # RFC 4954
1754     complete => {
1755       '2.7.0'  => 'Authentication succeeded',
1756       '4.7.0'  => 'Temporary authentication failure',
1757       '4.7.12' => 'Password transition needed',
1758       '5.7.0'  => 'Authentication required',
1759       '5.7.8'  => 'Authentication credentials invalid',
1760       '5.7.9'  => 'Authentication mechanism too weak',
1761       '5.7.11' => 'Encryption required for requested authentication mechanism',
1762     },
1763 );
1764
1765 # Returns an RFC 3463 DSN messages given a DSN code
1766 #
1767 sub get_dsn_msg ($) {
1768    my $dsn = shift;
1769    my ($msg, $class, $subject, $detail);
1770
1771    return "*DSN unavailable"  if ($dsn =~ /^$/);
1772
1773    unless ($dsn =~ /^(\d)\.((\d{1,3})\.\d{1,3})$/) {
1774       print "Error: not a DSN code $dsn\n";
1775       return "Invalid DSN";
1776    }
1777
1778    $class = $1; $subject = $3; $detail = $2;
1779
1780    #print "DSN: $dsn, Class: $class, Subject: $subject, Detail: $detail\n";
1781
1782    if (exists $dsn_codes{'class'}{$class}) {
1783       $msg = $dsn_codes{'class'}{$class};
1784    }
1785    if (exists $dsn_codes{'subject'}{$subject}) {
1786       $msg .= ': ' . $dsn_codes{'subject'}{$subject};
1787    }
1788    if (exists $dsn_codes{'complete'}{$dsn}) {
1789       $msg .= ': ' . $dsn_codes{'complete'}{$dsn};
1790    }
1791    elsif (exists $dsn_codes{'detail'}{$detail}) {
1792       $msg .= ': ' . $dsn_codes{'detail'}{$detail};
1793    }
1794
1795    #print "get_dsn_msg: $msg\n" if ($msg);
1796    return $dsn . ': ' . $msg;
1797 }
1798
1799 1;
1800
1801 #MODULE: ../Logreporters/PolicySPF.pm
1802 package Logreporters::PolicySPF;
1803
1804 use 5.008;
1805 use strict;
1806 use re 'taint';
1807 use warnings;
1808
1809 BEGIN {
1810    use Exporter ();
1811    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1812    $VERSION = '1.000';
1813    @ISA = qw(Exporter);
1814    @EXPORT = qw(&postfix_policy_spf);
1815 }
1816
1817 use subs @EXPORT;
1818
1819 BEGIN {
1820    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
1821    import Logreporters::Utils;
1822    import Logreporters::Reports qw(&inc_unmatched);
1823 }
1824
1825 # Handle postfix/policy_spf entries
1826 #
1827 # Mail::SPF::Result
1828 #   Pass      the SPF record designates the host to be allowed to send accept
1829 #   Fail      the SPF record has designated the host as NOT being allowed to send  reject
1830 #   SoftFail  the SPF record has designated the host as NOT being allowed to send but is in transition  accept but mark
1831 #   Neutral   the SPF record specifies explicitly that nothing can be said about validity   accept
1832 #   None      the domain does not have an SPF record or the SPF record does not evaluate to a result accept
1833 #   PermError a permanent error has occured (eg. badly formatted SPF record) unspecified
1834 #   TempError a transient error has occured accept or reject
1835
1836 sub postfix_policy_spf($) {
1837    my $line = shift;
1838
1839    if (
1840         $line =~ /^Attribute: / or
1841         # handler sender_policy_framework: is decisive.
1842         $line =~ /^handler [^:]+/ or
1843         # decided action=REJECT Please see http://www.openspf.org/why.html?sender=jrzjcez%40telecomitalia.it&ip=81.178.62.236&receiver=protegate1.zmi.at
1844         $line =~ /^decided action=/ or
1845
1846         # pypolicyd-spf-0.7.1
1847         #
1848         # Read line: "request=smtpd_access_policy"
1849         # Found the end of entry
1850         # 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'}
1851         # spfcheck: pyspf result: "['Pass', 'sender SPF authorized', 'helo']"
1852         # ERROR: Could not match line "#helo pass and mfrom none"
1853         # Traceback (most recent call last):
1854         #   File "/usr/local/bin/policyd-spf", line 405, in <module>
1855         #     line = sys.stdin.readline()
1856         # KeyboardInterrupt
1857         $line =~ /^Read line: "/ or
1858         $line =~ /^Found the end of entry$/ or
1859         $line =~ /^Config: \{/ or
1860         $line =~ /^spfcheck: pyspf result/ or
1861         $line =~ /^Starting$/ or
1862         $line =~ /^Normal exit$/ or
1863         $line =~ /^ERROR: Could not match line/ or
1864         $line =~ /^Traceback / or
1865         $line =~ /^KeyboardInterrupt/ or
1866         $line =~ /^\s\s+/
1867       )
1868    {
1869       #print "IGNORING...\n\tORIG: $::OrigLine\n";
1870       return
1871    }
1872
1873    # Keep policy-spf warnings in its section
1874    if (my ($warn,$msg) = $line =~ /^warning: ([^:]+): (.*)$/) {
1875       #TDspf warning: ignoring garbage: # No SPF
1876
1877       $msg =~ s/^# ?//;
1878       $Totals{'policyspf'}++;
1879       $Counts{'policyspf'}{'*Warning'}{ucfirst $warn}{$msg}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
1880       return;
1881    }
1882
1883    # pypolicyd-spf-0.7.1
1884
1885    # Fail;      identity=helo;     client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1886    # Fail;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1887    # Neutral;   identity=helo;     client-ip=192.168.0.3; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1888    # None;      identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1889    # None;      identity=helo;     client-ip=192.168.0.5; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1890    # None;      identity=mailfrom; client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1891    # None;      identity=mailfrom; client-ip=192.168.0.2; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1892    # Pass;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1893    # Permerror; identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1894    # Softfail;  identity=mailfrom; client-ip=192.168.0.6; helo=example.com; envelope-from=f@example.com; receiver=yahl@example.org
1895    if ($line =~ /^(Pass|Fail|None|Neutral|Permerror|Softfail|Temperror); (.*)$/) {
1896          my $result = $1;
1897          my %params = $2 =~ /([-\w]+)=([^;]+)/g;
1898          #$params{'s'} = '*unknown' unless $params{'s'};
1899          $Totals{'policyspf'}++;
1900          if ($Logreporters::TreeData::Collecting{'policyspf'}) {
1901             my ($id) = $params{'identity'};
1902             $id =~ s/mailfrom/envelope-from/;
1903
1904             $Counts{'policyspf'}{'Policy Action'}{"SPF: $result"}{join(': ',$params{'identity'},$params{$id})}{$params{'client-ip'}}{$params{'receiver'}}++;
1905          }
1906          return;
1907    }
1908    elsif ($line =~ /^ERROR /) {
1909       $line =~ s/^ERROR //;
1910       $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
1911       $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
1912       return;
1913    }
1914
1915    # Strip QID if it exists, and trailing ": ", leaving just the message.
1916    $line =~ s/^(?:$Logreporters::re_QID|): //;
1917
1918    # other ignored
1919    if (
1920         $line =~ /^SPF \S+ \(.+?\): .*$/ or
1921         $line =~ /^Mail From/ or
1922         $line =~ /^:HELO check failed/ or     # log entry has no space after :
1923         $line =~ /^testing:/
1924       )
1925    {
1926         #TDspf testing: stripped sender=jrzjcez@telecomitalia.it, stripped rcpt=hengstberger@adv.at
1927         # postfix-policyd-spf-perl-2.007
1928         #TDspf SPF pass (Mechanism 'ip4:10.0.0.2/22' matched): Envelope-from: foo@example.com
1929         #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): Envelope-from: anyone@sample.net
1930         #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): HELO/EHLO (Null Sender): mailout2.example.com
1931         #TDspf SPF fail (Mechanism '-all' matched): HELO/EHLO: mailout1.example.com
1932         #TDspf SPF none (No applicable sender policy available): Envelope-from: efrom@example.com
1933         #TDspf SPF permerror (Included domain 'example.com' has no applicable sender policy): Envelope-from: efrom@example.com
1934         #TDspf SPF permerror (Maximum DNS-interactive terms limit (10) exceeded): Envelope-from: efrom@example.com
1935         #TDspf Mail From (sender) check failed - Mail::SPF->new(10.0.0.1, , test.DNSreport.com) failed: 'identity' option must not be empty
1936         #TDspf HELO check failed - Mail::SPF->new(, , ) failed: Missing required 'identity' option
1937
1938         #TDspf SPF not applicable to localhost connection - skipped check
1939
1940         #print "IGNORING...\n\tLINE: $line\n\tORIG: \"$Logreporters::Reports::origline\"\n";
1941         return;
1942    }
1943
1944    my ($action, $domain, $ip, $message, $mechanism);
1945    ($domain, $ip, $message, $mechanism) = ('*unknown', '*unknown', '', '*unavailable');
1946    #print "LINE: '$line'\n";
1947
1948    # postfix-policyd-spf-perl: http://www.openspf.org/Software
1949    if ($line =~ /^Policy action=(.*)$/) {
1950       $line = $1;
1951
1952       #: Policy action=DUNNO
1953       return if $line =~ /^DUNNO/;
1954       # Policy action=PREPEND X-Comment: SPF not applicable to localhost connection - skipped check
1955       return if $line =~ /^PREPEND X-Comment: SPF not applicable to localhost connection - skipped check$/;
1956
1957       #print "LINE: '$line'\n";
1958       if ($line =~ /^DEFER_IF_PERMIT SPF-Result=\[?(.*?)\]?: (.*) of .*$/) {
1959          my ($lookup,$message) = ($1,$2);
1960          # Policy action=DEFER_IF_PERMIT SPF-Result=[10.0.0.1]: Time-out on DNS 'SPF' lookup of '[10.0.0.1]'
1961          # Policy action=DEFER_IF_PERMIT SPF-Result=example.com: 'SERVFAIL' error on DNS 'SPF' lookup of 'example.com'
1962          $message =~ s/^(.*?) on (DNS SPF lookup)$/$2: $1/;
1963          $message =~ s/'//g;
1964          $Totals{'policyspf'}++;
1965          $Counts{'policyspf'}{'Policy Action'}{'defer_if_permit'}{$message}{$lookup}{$END_KEY}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1966          return;
1967       }
1968
1969       if ($line =~ /^550 Please see http:\/\/www\.openspf\.org\/Why\?(.*)$/) {
1970          # Policy action=550 Please see http://www.openspf.org/Why?s=mfrom&id=from%40example.com&ip=10.0.0.1&r=example.net
1971          # 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
1972          # Policy action=550 Please see http://www.openspf.org/Why?id=someone%40example.com&ip=10.0.0.1&receiver=vps.example.net
1973
1974          my %params;
1975          for (split /[&;]/, $1) {
1976             my ($id,$val) = split /=/, $_;
1977             $params{$id} = $val;
1978          }
1979          $params{'id'} =~ s/^.*%40//;
1980          $params{'s'} = '*unknown' unless $params{'s'};
1981          #print "Please see...:\n\tMessage: $message\n\tIP: $ip\n\tDomain: $domain\n";
1982          $Totals{'policyspf'}++;
1983          $Counts{'policyspf'}{'Policy Action'}{'550 reject'}{'See http://www.openspf.org/Why?...'}{$params{'s'}}{$params{'ip'}}{$params{'id'}}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1984          return;
1985       }
1986
1987       if ($line =~ /^[^:]+: (none|pass|fail|softfail|neutral|permerror|temperror) \((.+?)\) receiver=[^;]+(?:; (.*))?$/) {
1988          # iehc is identity, envelope-from, helo, client-ip
1989          my ($result,$message,$iehc,$subject) = ($1,$2,$3,undef);
1990          my %params = ();
1991          #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
1992
1993          # Note: "identity=mailfrom" new in Mail::SPF version 2.006 Aug. 17
1994          #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
1995
1996          #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
1997
1998          #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
1999
2000          #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
2001          #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=mx1.example
2002
2003          #print "LINE: $iehc\n";
2004          if ($iehc) {
2005             %params = $iehc =~ /([-\w]+)=([^;]+)/g;
2006
2007             if (exists $params{'identity'}) {
2008                $params{'identity'} =~ s/identity=//;
2009                if ($params{'identity'} eq 'mfrom' or $params{'identity'} eq 'mailfrom') {
2010                   $params{'identity'} = 'mail from';
2011                }
2012                $params{'identity'} = uc $params{'identity'};
2013             }
2014             $params{'envelope-from'} =~ s/"//g        if exists $params{'envelope-from'};
2015             #($helo    = $params{'helo'}) =~ s/"//g   if exists $params{'helo'};
2016             $ip       = $params{'client-ip'}          if exists $params{'client-ip'};
2017          }
2018
2019          $message =~ s/^([^:]+): // and $subject = $1;
2020
2021          if ($message =~ /^No applicable sender policy available$/) {
2022             $message = 'No sender policy';
2023          }
2024          elsif ($message =~ s/^(Junk encountered in mechanism) '(.*?)'/$1/) {
2025             #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
2026             $ip = formathost ($ip, 'mech: ' . $2);
2027          }
2028          elsif ($message =~ s/^(Included domain) '(.*?)' (has no .*)$/$1 $3/) {
2029             #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
2030             $subject .= "  (included: $2)";
2031          }
2032          elsif ($message =~ /^Domain does not state whether sender is authorized to use '.*?' in '\S+' identity \(mechanism '(.+?)' matched\)$/) {
2033             # Domain does not state whether sender is authorized to use 'returns@example.com' in 'mfrom' identity                                            (mechanism '?all' matched))
2034             ($mechanism,$message) = ($1,'Domain does not state if sender authorized to use');
2035          }
2036          elsif ($message =~ /^(\S+) is (not )?authorized( by default)? to use '.*?' in '\S+' identity(?:, however domain is not currently prepared for false failures)? \(mechanism '(.+?)' matched\)$/) {
2037             # 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))
2038             # 192.168.1.10 is     authorized by default to use 'from@example.com' in 'mfrom' identity                                                              (mechanism 'all' matched))
2039             $message = join (' ',
2040                              $1 eq 'Sender' ? 'Sender' : 'IP',   # canonicalize IP address
2041                              $2 ? 'not authorized' : 'authorized',
2042                              $3 ? 'by default to use' : 'to use',
2043                             );
2044             $mechanism = $4;
2045          }
2046          elsif ($message =~ /^Maximum DNS-interactive terms limit \S+ exceeded$/) {
2047             $message = 'Maximum DNS-interactive terms limit exceeded';
2048          }
2049          elsif ($message =~ /^Invalid IPv4 prefix length encountered in (.*)$/) {
2050             $subject .= " (invalid: $1)";
2051             $message = 'Invalid IPv4 prefix length encountered';
2052          }
2053
2054          #print "Result: $result, Identity: $params{'identity'}, Mech: $mechanism, Subject: $subject, IP: $ip\n";
2055          $Totals{'policyspf'}++;
2056          if ($Logreporters::TreeData::Collecting{'policyspf'}) {
2057             $message = join (' ', $message, $params{'identity'})  if exists $params{'identity'};
2058             $Counts{'policyspf'}{'Policy Action'}{"SPF $result"}{$message}{'mech: ' .$mechanism}{$subject}{$ip}++
2059          }
2060          return;
2061       }
2062
2063       inc_unmatched('postfix_policy_spf(2)');
2064       return;
2065    }
2066
2067 =pod
2068    Mail::SPF::Query
2069    libmail-spf-query-perl 1:1.999
2070
2071     XXX incomplete
2072
2073     Some possible smtp_comment results:
2074      pass         "localhost is always allowed."
2075      none         "SPF", "domain of sender $query->{sender} does not designate mailers
2076      unknown      $explanation, "domain of sender $query->{sender} does not exist"
2077                   $query->{spf_error_explanation}, $query->is_looping
2078                   $query->{spf_error_explanation}, $directive_set->{hard_syntax_error}
2079                   $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}"
2080      error        $query->{spf_error_explanation}, $query->{error}
2081
2082      $result      $explanation, $comment, $query->{directive_set}->{orig_txt}
2083
2084     Possible header_comment results:
2085      pass         "$query->{spf_source} designates $ip as permitted sender"
2086      fail         "$query->{spf_source} does not designate $ip as permitted sender"
2087      softfail     "transitioning $query->{spf_source} does not designate $ip as permitted sender"
2088      /^unknown /  "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
2089      unknown      "error in processing during lookup of $query->{sender}"
2090      neutral      "$ip is neither permitted nor denied by domain of $query->{sender}"
2091      error        "encountered temporary error during SPF processing of $query->{spf_source}"
2092      none         "$query->{spf_source} does not designate permitted sender hosts"
2093                   "could not perform SPF query for $query->{spf_source}" );
2094 =cut
2095
2096    #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
2097    #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
2098    #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
2099    #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
2100    #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
2101
2102    if (my ($result, $reply) = ($line =~ /^(SPF [^:]+): (.*)$/)) {
2103
2104       #print "result: $result\n\treply: $reply\n\tORIG: \"$Logreporters::Reports::origline\"\n";
2105
2106       if ($reply =~ /^(?:smtp_comment=)(.*)$/) {
2107          $reply = $1;
2108
2109          # SPF none
2110          if ($reply =~ /^SPF: domain of sender (?:(?:[^@]+@)?(\S+) )?does not designate mailers/) {
2111             $domain = $1 ? $1 : '*unknown';
2112             #print "result: $result: domain: $domain\n";
2113          }
2114          elsif ($reply =~ /^Please see http:\/\/[^\/]+\/why\.html\?sender=(?:.+%40)?([^&]+)&ip=([^&]+)/) {
2115             ($domain,$ip) = ($1,$2);
2116             #print "result: $result: domain: $domain, IP: $ip\n";
2117          }
2118
2119          # SPF unknown
2120          elsif ($reply =~ /^SPF record error: ([^,]+), .*: error in processing during lookup of (?:[^@]+\@)?(\S+)/) {
2121             ($message, $domain) = ($1, $2);
2122             #print "result: $result: domain: $domain, Problem: $message\n";
2123          }
2124          elsif ($reply =~ /^SPF record error: ([^,]+), .*: encountered unrecognized mechanism during SPF processing of domain (?:[^@]+\@)?(\S+)/) {
2125             ($message, $domain) = ($1,$2);
2126             #print "result: \"$result\": domain: $domain, Problem: $message\n";
2127             $result = "SPF permerror"   if ($result =~ /SPF unknown mx-all/);
2128          }
2129          else {
2130             inc_unmatched('postfix_policy_spf(3)');
2131             return;
2132          }
2133       }
2134       else {
2135          inc_unmatched('postfix_policy_spf(4)');
2136          return;
2137       }
2138
2139       $Totals{'policyspf'}++;
2140       if ($message) {
2141          $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$message}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2142       }
2143       else {
2144          $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2145       }
2146       return;
2147    }
2148
2149
2150    inc_unmatched('postfix_policy_spf(5)');
2151 }
2152
2153 1;
2154
2155 #MODULE: ../Logreporters/Postfwd.pm
2156 package Logreporters::Postfwd;
2157
2158 use 5.008;
2159 use strict;
2160 use re 'taint';
2161 use warnings;
2162
2163 BEGIN {
2164    use Exporter ();
2165    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2166    $VERSION = '1.000';
2167    @ISA = qw(Exporter);
2168    @EXPORT = qw(&postfix_postfwd);
2169 }
2170
2171 use subs @EXPORT;
2172
2173 BEGIN {
2174    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2175    import Logreporters::Utils;
2176    import Logreporters::Reports qw(&inc_unmatched);
2177 }
2178
2179 # postfwd: http://postfwd.org/
2180 #
2181 #
2182 sub postfix_postfwd($) {
2183    my $line = shift;
2184
2185    return if (
2186       #TDpfw [STATS] Counters: 213000 seconds uptime, 39 rules
2187       #TDpfw [LOGS info]: compare rbl: "example.com[10.1.0.7]"  ->  "localrbl.local"
2188       #TDpfw [DNSBL] object 10.0.0.1 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2189       $line =~ /^\[STATS\] / or
2190       $line =~ /^\[DNSBL\] / or
2191       $line =~ /^\[LOGS info\]/ or
2192       $line =~ /^Process Backgrounded/ or
2193       $line =~ /^Setting [ug]id to/ or
2194       $line =~ /^Binding to TCP port/ or
2195       $line =~ /^terminating\.\.\./ or
2196       $line =~ /^Setting status interval to \S+ seconds/ or
2197       $line =~ /^postfwd .+ ready for input$/ or
2198       $line =~ /postfwd .+ (?:starting|terminated)/
2199    );
2200
2201    my ($type,$rule,$id,$action,$host,$hostip,$recipient);
2202
2203    if ($line =~ /^\[(RULES|CACHE)\] rule=(\d+), id=([^,]+), client=([^[]+)\[([^]]+)\], sender=.*?, recipient=<(.*?)>,.*? action=(.*)$/) {
2204       #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
2205       #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
2206       ($type,$rule,$id,$host,$hostip,$recipient,$action) = ($1,$2,$3,$4,$5,$6,$7);
2207       $recipient  = '*unknown' if (not defined $recipient);
2208       $Counts{'postfwd'}{"Rule $rule"}{$id}{$action}{$type}{$recipient}{formathost($hostip,$host)}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2209    }
2210    elsif (($line =~ /Can't connect to TCP port/) or
2211           ($line =~ /Pid_file already exists for running process/)
2212          )
2213     {
2214       $line =~ s/^[-\d\/:]+ //; # strip leading date/time stamps 2009/07/18-20:09:49
2215       $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
2216       $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
2217       return;
2218    }
2219
2220    # ignoring [DNSBL] lines
2221    #elsif ($line =~ /^\[DNSBL\] object (\S+) listed on (\S+) \(answer: ([^,]+), .*\)$/) {
2222    #   #TDpfw [DNSBL] object 10.0.0.60 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2223    #   ($type,$rbl) = split (/:/, $2);
2224    #   $Counts{'postfwd'}{"DNSBL: $type"}{$rbl}{$1}{$3}{''}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2225    #}
2226    else {
2227       inc_unmatched('postfwd');
2228       return;
2229    }
2230
2231    $Totals{'postfwd'}++;
2232 }
2233
2234 1;
2235
2236 #MODULE: ../Logreporters/Postgrey.pm
2237 package Logreporters::Postgrey;
2238
2239 use 5.008;
2240 use strict;
2241 use re 'taint';
2242 use warnings;
2243
2244 my (%pgDelays,%pgDelayso);
2245
2246 BEGIN {
2247    use Exporter ();
2248    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2249    $VERSION = '1.000';
2250    @ISA = qw(Exporter);
2251    @EXPORT = qw(&postfix_postgrey &print_postgrey_reports);
2252 }
2253
2254 use subs @EXPORT;
2255
2256 BEGIN {
2257    import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2258    import Logreporters::Utils;
2259    import Logreporters::Config qw(%Opts);
2260    import Logreporters::Reports qw(&inc_unmatched &print_percentiles_report2);
2261 }
2262
2263 # postgrey: http://postgrey.schweikert.ch/
2264 #
2265 # Triplet: (client IP, envelope sender, envelope recipient address)
2266 #
2267 sub postfix_postgrey($) {
2268    my $line = shift;
2269
2270    return if (
2271       #TDpg cleaning up old logs...
2272       #TDpg cleaning up old entries...
2273       #TDpg cleaning clients database finished. before: 207, after: 207
2274       #TDpg cleaning main database finished. before: 3800, after: 2539
2275       #TDpg delayed 603 seconds: client=10.0.example.com, from=anyone@sample.net, to=joe@example.com
2276
2277       #TDpg Setting uid to "504"
2278       #TDpg Setting gid to "1002 1002"
2279       #TDpg Process Backgrounded
2280       #TDpg 2008/03/08-15:54:49 postgrey (type Net::Server::Multiplex) starting! pid(21961)
2281       #TDpg Binding to TCP port 10023 on host 127.0.0.1
2282       #TDpg 2007/01/25-14:58:24 Server closing!
2283       #TDpg Couldn't unlink "/var/run/postgrey.pid" [Permission denied]
2284       #TDpg ignoring garbage: <help>
2285       #TDpg unrecognized request type: ''
2286       #TDpg rm /var/spool/postfix/postgrey/log.0000000002
2287       #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
2288
2289
2290       $line =~ /^cleaning / or
2291       $line =~ /^delayed / or
2292       $line =~ /^cleaning / or
2293       $line =~ /^Setting [ug]id/ or
2294       $line =~ /^Process Backgrounded/ or
2295       $line =~ /^Binding to / or
2296       $line =~ /^Couldn't unlink / or
2297       $line =~ /^ignoring garbage: / or
2298       $line =~ /^unrecognized request type/ or
2299       $line =~ /^rm / or
2300       # unanchored last
2301       $line =~ /Pid_file already exists/ or
2302       $line =~ /postgrey .* starting!/ or
2303       $line =~ /Server closing!/
2304    );
2305
2306    my ($action,$reason,$delay,$host,$ip,$sender,$recip);
2307
2308    if ($line =~ /^(?:$Logreporters::re_QID: )?action=(.*?), reason=(.*?)(?:, delay=(\d+))?, client_name=(.*?), client_address=(.*?)(?:, sender=(.*?))?(?:, +recipient=(.*))?$/o) {
2309       #TDpg  action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2310       #TDpgQ action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com
2311       #TDpgQ action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2312       #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2313       #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2314       #TDpg  action=pass,     reason=triplet found, delay=99, client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2315       ($action,$reason,$delay,$host,$ip,$sender,$recip) = ($1,$2,$3,$4,$5,$6,$7);
2316       $reason =~ s/^(early-retry) \(.* missing\)$/$1/;
2317       $recip  = '*unknown' if (not defined $recip);
2318       $sender = ''         if (not defined $sender);
2319
2320       $Totals{'postgrey'}++;
2321       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2322          $Counts{'postgrey'}{"\u$action"}{"\u$reason"}{formathost($ip,$host)}{$recip}{$sender}++;
2323
2324          if (defined $delay and $Logreporters::TreeData::Collecting{'postgrey_delays'}) {
2325             $pgDelays{'1: Total'}{$delay}++;
2326
2327             push @{$pgDelayso{'Postgrey'}}, $delay
2328          }
2329       }
2330    }
2331    elsif ($line =~ /^whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2332       #TDpg: whitelisted: example.com[10.0.0.1]
2333       $Totals{'postgrey'}++;
2334       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2335          $Counts{'postgrey'}{'Whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2336       }
2337    }
2338    elsif ($line =~ /^tarpit whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2339       #TDpg: tarpit whitelisted: example.com[10.0.0.1]
2340       $Totals{'postgrey'}++;
2341       if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2342          $Counts{'postgrey'}{'Tarpit whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2343       }
2344    }
2345    else {
2346       inc_unmatched('postgrey');
2347    }
2348
2349    return;
2350 }
2351
2352 sub print_postgrey_reports() {
2353    #print STDERR "pgDelays     memory usage: ", commify(Devel::Size::total_size(\%pgDelays)), "\n";
2354
2355    if ($Opts{'postgrey_delays'}) {
2356       my @table;
2357       for (sort keys %pgDelays) {
2358          # anon array ref: label, array ref of $Delay{key}
2359          push @table, [ substr($_,3), $pgDelays{$_} ];
2360       }
2361       if (@table) {
2362          print_percentiles_report2(\@table, "Postgrey Delays Percentiles", $Opts{'postgrey_delays_percentiles'});
2363       }
2364    }
2365 }
2366
2367 1;
2368
2369 #MODULE: ../Logreporters/PolicydWeight.pm
2370 package Logreporters::PolicydWeight;
2371
2372 use 5.008;
2373 use strict;
2374 use re 'taint';
2375 use warnings;
2376
2377 BEGIN {
2378    use Exporter ();
2379    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2380    $VERSION = '1.000';
2381    @ISA = qw(Exporter);
2382    @EXPORT = qw(&postfix_policydweight);
2383 }
2384
2385 use subs @EXPORT;
2386
2387 BEGIN {
2388    import Logreporters::Reports qw(&inc_unmatched);
2389    import Logreporters::TreeData qw(%Totals %Counts);
2390    import Logreporters::Utils;
2391 }
2392
2393 # Handle postfix/policydweight entries
2394 #
2395 sub postfix_policydweight($) {
2396    my $line = shift;
2397    my ($r1, $code, $reason, $reason2);
2398
2399    if (
2400         $line =~ /^weighted check/ or
2401         $line =~ /^policyd-weight .* started and daemonized/ or
2402         $line =~ /^(cache|child|master): / or
2403         $line =~ /^cache (?:spawned|killed)/ or
2404         $line =~ /^child \d+ exited/ or
2405         $line =~ /^Daemon terminated/ or
2406         $line =~ /^Daemon terminated/
2407       )
2408    {
2409       #print "$OrigLine\n";
2410       return;
2411    }
2412
2413    if ($line =~ s/^decided action=//) {
2414       $line =~ s/; delay: \d+s$//;     # ignore, eg.: "delay: 3s"
2415       #print "....\n\tLINE: $line\n\tORIG: '$Logreporters::Reports::origline'\n";
2416       if (($code,$r1) = ($line =~ /^(\d+)\s+(.*)$/ )) {
2417          my @problems = ();
2418          for (split /; */, $r1) {
2419
2420             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/ ) {
2421                push @problems, 'spam/forged: bad DNS/hit DNSRBLs';
2422             }
2423             elsif (/^Your MTA is listed in too many DNSBLs/) {
2424                push @problems, 'too many DNSBLs';
2425             }
2426             elsif (/^temporarily blocked because of previous errors - retrying too fast\. penalty: \d+ seconds x \d+ retries\./) {
2427                push @problems, 'temp blocked: retrying too fast';
2428             }
2429             elsif (/^Please use DynDNS/) {
2430                push @problems, 'use DynDNS';
2431             }
2432             elsif (/^please relay via your ISP \([^)]+\)/) {
2433                push @problems, 'use ISP\'s relay';
2434             }
2435             elsif (/^in (.*)/) {
2436                push @problems, $1;
2437             }
2438             elsif (m#^check http://rbls\.org/\?q=#) {
2439                push @problems, 'see http://rbls.org';
2440             }
2441             elsif (/^MTA helo: .* \(helo\/hostname mismatch\)/) {
2442                push @problems, 'helo/hostname mismatch';
2443             }
2444             elsif (/^No DNS entries for your MTA, HELO and Domain\. Contact YOUR administrator\s+/) {
2445                push @problems, 'no DNS entries';
2446             }
2447             else {
2448                push @problems, $_;
2449             }
2450          }
2451
2452          $reason = $code; $reason2 = join (', ', @problems);
2453       }
2454       elsif ($line =~ s/^DUNNO\s+//) {
2455          #decided action=DUNNO multirecipient-mail - already accepted by previous query; delay: 0s
2456          $reason = 'DUNNO'; $reason2 = $line;
2457       }
2458       elsif ($line =~ s/^check_greylist//) {
2459          #decided action=check_greylist; delay: 16s
2460          $reason = 'Check greylist'; $reason2 = $line;
2461       }
2462       elsif ($line =~ s/^PREPEND X-policyd-weight:\s+//) {
2463          #decided action=PREPEND X-policyd-weight: using cached result; rate: -7.6; delay: 0s
2464          if ($line =~ /(using cached result); rate:/) {
2465             $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = "\u$1";
2466          }
2467          else {
2468             #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
2469             $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = 'Varies';
2470          }
2471       }
2472       else {
2473          return;
2474       }
2475    }
2476    elsif ($line =~ /^err/) {
2477       # coerrce policyd-weight err's into general warnings
2478       $Totals{'startuperror'}++;
2479       $Counts{'startuperror'}{'Service: policyd-weight'}{$line}++    if ($Logreporters::TreeData::Collecting{'startuperror'});
2480       return;
2481    }
2482    else {
2483       inc_unmatched('policydweight');
2484       return;
2485    }
2486
2487    $Totals{'policydweight'}++;
2488    $Counts{'policydweight'}{$reason}{$reason2}++   if ($Logreporters::TreeData::Collecting{'policydweight'});
2489 }
2490
2491 1;
2492
2493
2494 package Logreporters;
2495
2496 BEGIN {
2497    import Logreporters::Utils;
2498    import Logreporters::Config;
2499    import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree $END_KEY);
2500    import Logreporters::RegEx;
2501    import Logreporters::Reports;
2502    import Logreporters::RFC3463;
2503    import Logreporters::PolicySPF;
2504    import Logreporters::Postfwd;
2505    import Logreporters::Postgrey;
2506    import Logreporters::PolicydWeight;
2507 }
2508 use 5.008;
2509 use strict;
2510 use warnings;
2511 no warnings "uninitialized";
2512 use re 'taint';
2513
2514 use File::Basename;
2515 our $progname =  fileparse($0);
2516
2517 my @supplemental_reports = qw(delays postgrey_delays);
2518
2519 # Default values for various options.  These are used
2520 # to reset default values after an option has been
2521 # disabled (via undef'ing its value).  This allows
2522 # a report to be disabled via config file or --nodetail,
2523 # but reenabled via subsequent command line option
2524 my %Defaults = (
2525    detail                      => 10,                        # report level detail
2526    max_report_width            => 100,                       # maximum line width for report output
2527    line_style                  => undef,                     # lines > max_report_width, 0=truncate,1=wrap,2=full
2528    syslog_name                 => 'postfix',                 # service name (postconf(5), syslog_name)
2529    sect_vars                   => 0,                         # show section vars in detail report hdrs
2530    unknown                     => 1,                         # show 'unknown' in address/hostname pairs
2531    ipaddr_width                => 15,                        # width for printing ip addresses
2532    long_queue_ids              => 0,                         # enable long queue ids (2.9+)
2533    delays                      => 1,                         # show message delivery delays report
2534    delays_percentiles          => '0 25 50 75 90 95 98 100', # percentiles shown in delays report
2535    reject_reply_patterns       => '5.. 4.. warn',            # reject reply grouping patterns
2536    postgrey_delays             => 1,                         # show postgrey delays report
2537    postgrey_delays_percentiles => '0 25 50 75 90 95 98 100', # percentiles shown in postgrey delays report
2538 );
2539
2540 my $usage_str = <<"END_USAGE";
2541 Usage: $progname [ ARGUMENTS ] [logfile ...]
2542    ARGUMENTS can be one or more of options listed below.  Later options
2543    override earlier ones.  Any argument may be abbreviated to an unambiguous
2544    length.  Input is read from the named logfile(s), or STDIN.
2545
2546    --debug AREAS                          provide debug output for AREAS
2547    --help                                 print usage information
2548    --version                              print program version
2549
2550    --config_file FILE, -f FILE            use alternate configuration file FILE
2551    --ignore_services PATTERN              ignore postfix/PATTERN services
2552    --syslog_name PATTERN                  only consider log lines that match
2553                                           syslog service name PATTERN
2554
2555    --detail LEVEL                         print LEVEL levels of detail
2556                                           (default: 10)
2557    --nodetail                             set all detail levels to 0
2558    --[no]summary                          display the summary section
2559
2560    --ipaddr_width WIDTH                   use WIDTH chars for IP addresses in
2561                                           address/hostname pairs
2562    --line_style wrap|full|truncate        disposition of lines > max_report_width
2563                                           (default: truncate)
2564    --full                                 same as --line_style=full
2565    --truncate                             same as --line_style=truncate
2566    --wrap                                 same as --line_style=wrap
2567    --max_report_width WIDTH               limit report width to WIDTH chars
2568                                           (default: 100)
2569    --limit L=V, -l L=V                    set level limiter L with value V
2570    --[no]long_queue_ids                   use long queue ids
2571    --[no]unknown                          show the 'unknown' hostname in
2572                                           formatted address/hostnames pairs
2573    --[no]sect_vars                        [do not] show config file var/cmd line
2574                                           option names in section titles
2575
2576    --recipient_delimiter C                split delivery addresses using
2577                                           recipient delimiter char C
2578    --reject_reply_patterns "R1 [R2 ...]"  set reject reply patterns used in
2579                                           to group rejects to R1, [R2 ...],
2580                                           where patterns are [45][.0-9][.0-9]
2581                                           or "Warn" (default: 5.. 4.. Warn)
2582    Supplimental reports
2583    --[no]delays                           [do not] show msg delays percentiles report
2584    --delays_percentiles "P1 [P2 ...]"     set delays report percentiles to
2585                                           P1 [P2 ...] (range: 0...100)
2586    --[no]postgrey_delays                  [do not] show postgrey delays percentiles
2587                                           report
2588    --postgrey_delays_percentiles "P1 [P2 ...]"
2589                                           set postgrey delays report percentiles to
2590                                           P1 [P2 ...] (range: 0...100)
2591 END_USAGE
2592
2593 my @RejectPats;      # pattern list used to match against reject replys
2594 my @RejectKeys;      # 1-to-1 with RejectPats, but with 'x' replacing '.' (for report output)
2595 my (%DeferredByQid, %SizeByQid, %AcceptedByQid, %Delays);
2596
2597 # local prototypes
2598 sub usage;
2599 sub init_getopts_table;
2600 sub init_defaults;
2601 sub build_sect_table;
2602 sub postfix_bounce;
2603 sub postfix_cleanup;
2604 sub postfix_panic;
2605 sub postfix_fatal;
2606 sub postfix_error;
2607 sub postfix_warning;
2608 sub postfix_script;
2609 sub postfix_postsuper;
2610 sub process_delivery_attempt;
2611 sub cleanhostreply;
2612 sub strip_ftph;
2613 sub get_reject_key;
2614 sub expand_bare_reject_limiters;
2615 sub create_ignore_list;
2616 sub in_ignore_list;
2617 sub header_body_checks;
2618 sub milter_common;
2619
2620 # lines that match any RE in this list will be ignored.
2621 # see create_ignore_list();
2622 my @ignore_list = ();
2623
2624 # The Sections table drives Summary and Detail reports.  For each entry in the
2625 # table, if there is data avaialable, a line will be output in the Summary report.
2626 # Additionally, a sub-section will be output in the Detail report if both the
2627 # global --detail, and the section's limiter variable, are sufficiently high (a
2628 # non-existent section limiter variable is considered to be sufficiently high).
2629 #
2630 my @Sections = ();
2631
2632 # List of reject variants.  See also: "Add reject variants" below, and conf file(s).
2633 my @RejectClasses = qw(
2634    rejectrelay rejecthelo rejectdata rejectunknownuser rejectrecip rejectsender
2635    rejectclient rejectunknownclient rejectunknownreverseclient rejectunverifiedclient
2636    rejectrbl rejectheader rejectbody rejectcontent rejectsize rejectmilter rejectproxy
2637    rejectinsufficientspace rejectconfigerror rejectverify rejectetrn rejectlookupfailure
2638 );
2639
2640 # Dispatch table of the list of supported policy services
2641 # XXX have add-ins register into the dispatch table
2642 my @policy_services = (
2643    [ qr/^postfwd/,         \&Logreporters::Postfwd::postfix_postfwd ],
2644    [ qr/^postgrey/,        \&Logreporters::Postgrey::postfix_postgrey ],
2645    [ qr/^policyd?-spf/,    \&Logreporters::PolicySPF::postfix_policy_spf ],
2646    [ qr/^policyd-?weight/, \&Logreporters::PolicydWeight::postfix_policydweight ],
2647 );
2648
2649 # Initialize main running mode and basic opts
2650 init_run_mode($config_file);
2651
2652 # Configure the Getopts options table
2653 init_getopts_table();
2654
2655 # Place configuration file/environment variables onto command line
2656 init_cmdline();
2657
2658 # Initialize default values
2659 init_defaults();
2660
2661 # Process command line arguments, 0=no_permute,no_pass_through
2662 get_options(0);
2663
2664 # Build the Section table, after reject_reply_patterns is final
2665 build_sect_table();
2666
2667 # Expand bare rejects before generic processing
2668 expand_bare_reject_limiters();
2669
2670 # Run through the list of Limiters, setting the limiters in %Opts.
2671 process_limiters(@Sections);
2672
2673 # Set collection for any enabled supplemental sections
2674 foreach (@supplemental_reports) {
2675    $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
2676 }
2677
2678 if (! defined $Opts{'line_style'}) {
2679    # default line style to full if detail >= 11, or truncate otherwise
2680    $Opts{'line_style'} =
2681       ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
2682 }
2683
2684 # Set the QID RE to capture either pre-2.9 short style or 2.9+ long style.
2685 $re_QID = $Opts{'long_queue_ids'} ? $re_QID_l : $re_QID_s;
2686
2687 # Create the list of REs used to match against log lines
2688 create_ignore_list();
2689
2690 # Notes:
2691 #
2692 #   - IN REs, always use /o flag or qr// at end of RE when RE uses interpolated vars
2693 #   - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<.*?> )
2694 #   - See additional notes below, search for "Note:".
2695 #   - XXX indicates change, fix or thought required
2696
2697
2698 # Main processing loop
2699 #
2700 LINE: while ( <> ) {
2701    chomp;
2702    s/\s+$//;
2703    next unless length $_;
2704
2705    $Logreporters::Reports::origline = $_;
2706
2707    # Linux:   Jul  1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2708    # FreeBSD: Jul  1 20:08:06 <mail.info> mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2709    #          Aug 17 15:16:12 mailhost postfix/cleanup[14194]: [ID 197553 mail.info] EC2B339E5: message-id=<2616.EC2B339E5@example.com>
2710    #          Dec 25 05:20:28 mailhost policyd-spf[14194]: [ID 27553 mail.info] ... policyd-spf stuff ...
2711
2712    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;
2713
2714    our $service_name = $3;
2715    my ($mailhost,$server_name,$p1) = ($1,$2,$4);
2716    #print "mailhost: $mailhost, servername: $server_name, servicename: $service_name, p1: $p1\n";
2717
2718    $service_name = $server_name unless $service_name;
2719    #print "service_name: $service_name\n";
2720
2721    # ignored postfix services...
2722    next if $service_name eq 'postlog';
2723    next if $service_name =~ /^$Opts{'ignore_services'}$/o;
2724
2725    # common log entries up front
2726    if ($p1 =~ s/^connect from //) {
2727       #TD25 connect from sample.net[10.0.0.1]
2728       #TD connect from mail.example.com[2001:dead:beef::1]
2729       #TD connect from localhost.localdomain[127.0.0.1]
2730       #TD connect from unknown[unknown]
2731       $Totals{'connectioninbound'}++;
2732       next unless ($Collecting{'connectioninbound'});
2733
2734       my $host = $p1;  my $hostip;
2735       if (($host,$hostip) = ($host =~ /^([^[]+)\[([^]]+)\]/)) {
2736          $host = formathost($hostip,$host);
2737       }
2738       $Counts{'connectioninbound'}{$host}++;
2739       next;
2740    }
2741
2742    if ($p1 =~ /^disconnect from /) {
2743       #TD25 disconnect from sample.net[10.0.0.1]
2744       #TD disconnect from mail.example.com[2001:dead:beef::1]
2745       $Totals{'disconnection'}++;
2746       next;
2747    }
2748
2749    if ($p1 =~ s/^connect to //) {
2750       next if ($p1 =~ /^subsystem /);
2751       $Totals{'connecttofailure'}++;
2752       next unless ($Collecting{'connecttofailure'});
2753
2754       my ($host,$hostip,$reason,$port) = ($p1 =~ /^([^[]+)\[([^]]+)\](?::\d+)?: (.*?)(?:\s+\(port (\d+)\))?$/);
2755       # all "connect to" messages indicate a problem with the connection
2756       #TDs connect to example.org[10.0.0.1]: Connection refused (port 25)
2757       #TDs connect to mail.sample.com[10.0.0.1]: No route to host (port 25)
2758       #TDs connect to sample.net[192.168.0.1]: read timeout (port 25)
2759       #TDs connect to mail.example.com[10.0.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2760       #TDs connect to mail.example.com[192.168.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2761       #TDs connect to ipv6-1.example.com[2001:dead:beef::1]: Connection refused (port 25)
2762       #TDs connect to ipv6-2.example.com[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]: Connection refused (port 25)
2763       #TDs connect to ipv6-3.example.com[1080:0:0:0:8:800:200C:4171]: Connection refused (port 25)
2764       #TDs connect to ipv6-4.example.com[3ffe:2a00:100:7031::1]: Connection refused (port 25)
2765       #TDs connect to ipv6-5.example.com[1080::8:800:200C:417A]: Connection refused (port 25)
2766       #TDs connect to ipv6-6.example.com[::192.9.5.5]: Connection refused (port 25)
2767       #TDs connect to ipv6-7.example.com[::FFFF:129.144.52.38]: Connection refused (port 25)
2768       #TDs connect to ipv6-8.example.com[2010:836B:4179::836B:4179]: Connection refused (port 25)
2769       #TDs connect to mail.example.com[10.0.0.1]: server refused to talk to me: 452 try later   (port 25)
2770
2771       $host = join(' :', $host, $port)   if ($port and $port ne '25');
2772       # Note: See ConnectToFailure below
2773       if ($reason =~ /^server (refused to talk to me): (.*)$/) {
2774          $Counts{'connecttofailure'}{ucfirst($1)}{formathost($hostip,$host)}{$2}++;
2775       } else {
2776          $Counts{'connecttofailure'}{ucfirst($reason)}{formathost($hostip,$host)}{''}++;
2777       }
2778       next;
2779    }
2780
2781 =pod
2782 real    3m43.997s
2783 user    3m39.038s
2784 sys     0m3.005s
2785 =pod
2786    # Handle before panic, fatal, warning, so that service-specific code gets first crack
2787    # XXX replace w/dispatch table for add-ins, so user's can add their own...
2788    if ($service_name eq 'postfwd')          { postfix_postfwd($p1);       next; }
2789    if ($service_name eq 'postgrey')         { postfix_postgrey($p1);      next; }
2790    if ($service_name =~ /^policyd?-spf/)    { postfix_policy_spf($p1);    next; } # postfix/policy-spf
2791    if ($service_name =~ /^policyd-?weight/) { postfix_policydweight($p1); next; } # postfix/policydweight
2792
2793 =cut
2794    # Handle policy service handlers before panic, fatal, warning, etc.
2795    # messages so that service-specific code gets first crack.
2796    # 5:25
2797    foreach (@policy_services) {
2798       if ($service_name =~ $_->[0]) {
2799          #print "Calling policy service helper: $service_name:('$p1')\n";
2800          &{$_->[1]}($p1);
2801          next LINE;
2802       }
2803    };
2804 #=cut
2805
2806    # ^warning: ...
2807    # ^fatal: ...
2808    # ^panic: ...
2809    # ^error: ...
2810    if ($p1 =~ /^warning: +(.*)$/)           { postfix_warning($1); next; }
2811    if ($p1 =~ /^fatal: +(.*)$/)             { postfix_fatal($1);   next; }
2812    if ($p1 =~ /^panic: +(.*)$/)             { postfix_panic($1);   next; }
2813    if ($p1 =~ /^error: +(.*)$/)             { postfix_error($1);   next; }
2814
2815    # output by all services that use table lookups - process before specific messages
2816    if ($p1 =~ /(?:lookup )?table (?:[^ ]+ )?has changed -- (?:restarting|exiting)$/) {
2817       #TD table hash:/var/mailman/data/virtual-mailman(0,lock|fold_fix) has changed -- restarting
2818       #TD table hash:/etc/postfix/helo_checks has changed -- restarting
2819       $Totals{'tablechanged'}++;
2820       next;
2821    }
2822
2823    # postfix/postscreen and postfix/verify services
2824    if ($service_name eq 'postscreen'
2825     or $service_name eq 'verify')          { postfix_postscreen($p1); next; }    # postfix/postscreen, postfix/verify
2826    if ($service_name eq 'dnsblog')         { postfix_dnsblog($p1);    next; }    # postfix/dnsblog
2827    if ($service_name =~ /^cleanup/)        { postfix_cleanup($p1);    next; }    # postfix/cleanup*
2828    if ($service_name =~ /^bounce/)         { postfix_bounce($p1);     next; }    # postfix/bounce*
2829    if ($service_name eq 'postfix-script')  { postfix_script($p1);     next; }    # postfix/postfix-script
2830    if ($service_name eq 'postsuper')       { postfix_postsuper($p1);  next; }    # postfix/postsuper
2831
2832    # ignore tlsproxy for now
2833    if ($service_name eq 'tlsproxy')        { next; }                             # postfix/tlsproxy
2834
2835    my ($helo, $relay, $from, $origto, $to, $domain, $status,
2836        $type, $reason, $reason2, $filter, $site, $cmd, $qid,
2837        $rej_type, $reject_name, $host, $hostip, $dsn, $reply, $fmthost, $bytes);
2838
2839    $rej_type = undef;
2840
2841    # ^$re_QID: ...
2842    if ($p1 =~ s/^($re_QID): //o) {
2843       $qid = $1;
2844
2845       next if ($p1 =~ /^host \S*\[\S*\] said: 4\d\d/);  # deferrals, picked up in "status=deferred"
2846
2847       if ($p1 =~ /^removed\s*$/ ) {
2848          # Note: See REMOVED elsewhere
2849          # 52CBDC2E0F: removed
2850          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
2851          $Totals{'removedfromqueue'}++;
2852          next;
2853       }
2854
2855       # coerce into general warning
2856       if (($p1 =~ /^Cannot start TLS: handshake failure/) or
2857           ($p1 =~ /^non-E?SMTP response from/)) {
2858          postfix_warning($p1);
2859          next;
2860       }
2861
2862       if ($p1 eq 'status=deferred (bounce failed)') {
2863          #TDqQ status=deferred (bounce failed)
2864          $Totals{'bouncefailed'}++;
2865          next;
2866       }
2867
2868       # this test must preceed access checks below
2869       #TDsQ  replace: header From:     "Postmaster" <postmaster@webmail.example.com>: From:     "Postmaster" <postmaster@webmail.example.org>
2870       if ($service_name eq 'smtp' and header_body_checks($p1)) {
2871          #print "main: header_body_checks\n";
2872          next;
2873       }
2874
2875       # Postfix access actions
2876       #   REJECT optional text...
2877       #   DISCARD optional text...
2878       #   HOLD optional text...
2879       #   WARN optional text...
2880       #   FILTER transport:destination
2881       #   REDIRECT user@domain
2882       #   BCC user@domain  (2.6 experimental branch)
2883       # The following actions are indistinguishable in the logs
2884       #   4NN text
2885       #   5NN text
2886       #   DEFER_IF_REJECT optional text...
2887       #   DEFER_IF_PERMIT optional text...
2888       #   UCE restriction...
2889       # The following actions are not logged
2890       #   PREPEND headername: headervalue
2891       #   DUNNO
2892       #
2893       # Reject actions based on remote client information:
2894       #     - one of host name, network address, envelope sender
2895       #   or
2896       #     - recipient address
2897
2898       # Template of access controls.  Rejects look like the first line, other access actions the second.
2899       # ftph is envelope from, envelope to, proto and helo.
2900       # QID: ACTION  STAGE from host[hostip]: DSN       trigger: explanation; ftph
2901       # QID: ACTION  STAGE from host[hostip]: trigger:           explanation; ftph
2902
2903       # $re_QID: reject: RCPT|MAIL|CONNECT|HELO|DATA from ...
2904       # $re_QID: reject_warning: RCPT|MAIL|CONNECT|HELO|DATA from ...
2905       if ($p1 =~ /^(reject(?:_warning)?|discard|filter|hold|redirect|warn|bcc|replace): /) {
2906          my $action = $1;
2907          $p1 = substr($p1, length($action) + 2);
2908
2909          #print "action: \"$action\", p1: \"$p1\"\n";
2910          if ($p1 !~ /^(RCPT|MAIL|CONNECT|HELO|EHLO|DATA|VRFY|ETRN|END-OF-MESSAGE) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
2911             inc_unmatched('unexpected access');
2912             next;
2913          }
2914          my ($stage,$host,$hostip,$p1) = ($1,$2,$3,$4);    #print "stage: \"$stage\", host: \"$host\", hostip: \"$hostip\", p1: \"$p1\"\n";
2915          my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);  #print "efrom: \"$efrom\", eto: \"$eto\", proto: \"$proto\", helo: \"$helo\"\n";
2916                                                            #print "p1 now: \"$p1\"\n";
2917
2918 # QID: ACTION         STAGE from host[hostip]:   DSN       trigger:          explanation;                                                       ftph
2919 #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>
2920 #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>
2921 #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
2922 #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
2923 #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>
2924 #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>
2925 #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>
2926 #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>
2927 #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>
2928 #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]>
2929 #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>
2930 #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>
2931 #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>
2932 #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>
2933 #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>
2934 #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>
2935 #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>
2936 #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>
2937 #TDsdN reject_warning: HELO from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                                                                        proto=SMTP  helo=<example.com>
2938 #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>
2939 #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>
2940 #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>
2941 #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>
2942 #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>
2943 #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
2944
2945 #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>
2946 #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>
2947 #TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];                                                proto=ESMTP
2948 #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]
2949 #TDsdN reject:      CONNECT from unk[unknown]:  421 4.7.1                    Client host rejected: cannot find your reverse hostname, [unknown];                                         proto=SMTP
2950
2951 #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>
2952 #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>
2953 #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>
2954 #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>
2955 #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>
2956 #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>
2957 #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>
2958 #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>
2959 #TDsdN reject:         RCPT from host[10.0.0.1]: 452                         Insufficient system storage;                                      from=<f@sample.com> to=<eto@sample.net>
2960 #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>
2961 #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>
2962 #TDsdN reject:         MAIL from host[10.0.0.1]: 552                         Message size exceeds fixed limit;                                                                          proto=ESMTP helo=<localhost>
2963 #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>
2964 #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>
2965
2966          # reject, reject_warning
2967          if ($action =~ /^reject/) {
2968             my ($recip);
2969
2970             if ($p1 !~ /^($re_DSN) (.*)$/o) {
2971                inc_unmatched('reject1');
2972                next;
2973             }
2974             ($dsn,$p1) = ($1,$2);                        #print "dsn: $dsn, p1: \"$p1\"\n";
2975             $fmthost = formathost($hostip,$host);
2976
2977             # reject_warning override temp or perm reject types
2978             $rej_type = ($action eq 'reject_warning' ? 'warn' : get_reject_key($dsn));
2979             #print "REJECT stage: '$rej_type'\n";
2980
2981             if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
2982                $Counts{'byiprejects'}{$fmthost}++;
2983             }
2984
2985             if ($stage eq 'VRFY') {
2986                if ($p1 =~ /^(?:<(\S*)>: )?(.*);$/) {
2987                   my ($trigger,$reason) = ($1,$2);
2988                   $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name});
2989
2990                   if ($reason =~ /^Service unavailable; Client host \[[^]]+\] (blocked using [^;]*);/) {
2991                      $reason = join (' ', 'Client host blocked using', $1);
2992                      $trigger = '';
2993                   }
2994                   $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++;
2995                } else {
2996                   inc_unmatched('vrfyfrom');
2997                }
2998                next;
2999             }
3000
3001             # XXX there may be several semicolon-separated messages
3002             # Recipient address rejected: Unknown users and via check_recipient_access
3003             if ($p1 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/) {
3004                ($recip,$reason) = ($1,$2);
3005
3006                my ($localpart,$domainpart);
3007                # Unknown users; local mailbox, alias, virtual, relay user, unspecified
3008                if ($recip eq '') { ($localpart, $domainpart) = ('<>', '*unspecified'); }
3009                else {
3010                   ($localpart, $domainpart) = split (/@/, lc $recip);
3011                   ($localpart, $domainpart) = ($recip, '*unspecified')   if ($domainpart eq '');
3012                }
3013
3014                if ($reason =~ s/^User unknown *//) {
3015                   $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name});
3016
3017                   my ($table) = ($reason =~ /^in ((?:\w+ )+table)/);
3018                   $table = 'Address table unavailable'  if ($table eq '');     # when show_user_unknown_table_name=no
3019                   $Counts{$reject_name}{ucfirst($table)}{$domainpart}{$localpart}{$fmthost}++;
3020                } else {
3021                   # check_recipient_access
3022                   $Totals{$reject_name = "${rej_type}rejectrecip" }++; next unless ($Collecting{$reject_name});
3023
3024                   if ($reason =~ m{^Please see http://[^/]+/why\.html}) {
3025                      $reason = 'SPF reject';
3026                   }
3027                   elsif ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3028                      $reason = 'undeliverable address: remote host rejected recipient';
3029                   }
3030                   $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++;
3031                }
3032
3033             } elsif ($p1 =~ /^<(.*?)>.* Relay access denied/) {
3034                $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name});
3035                $Counts{$reject_name}{$fmthost}{$eto}++;
3036
3037             } elsif ($p1 =~ /^<(.*)>: Sender address rejected: (.*);/) {
3038                $Totals{$reject_name = "${rej_type}rejectsender" }++;  next unless ($Collecting{$reject_name});
3039                ($from,$reason) =  ($1,$2);
3040
3041                if ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3042                   $reason = 'undeliverable address: remote host rejected sender';
3043                }
3044                $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++;
3045
3046             } elsif ($p1 =~ /^(?:<.*>: )?Unverified Client host rejected: /) {
3047                # check_reverse_client_hostname_access (postfix 2.6+)
3048                $Totals{$reject_name = "${rej_type}rejectunverifiedclient" }++; next unless ($Collecting{$reject_name});
3049                $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3050
3051             } elsif ($p1 =~ s/^(?:<.*>: )?Client host rejected: //) {
3052                # reject_unknown_client
3053                #   client IP->name mapping fails
3054                #   name->IP mapping fails
3055                #   name->IP mapping =! client IP
3056                if ($p1 =~ /^cannot find your hostname/) {
3057                   $Totals{$reject_name = "${rej_type}rejectunknownclient" }++; next unless ($Collecting{$reject_name});
3058                   $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3059                }
3060                # reject_unknown_reverse_client_hostname (no PTR record for client's IP)
3061                elsif ($p1 =~ /^cannot find your reverse hostname/) {
3062                   $Totals{$reject_name = "${rej_type}rejectunknownreverseclient" }++; next unless ($Collecting{$reject_name});
3063                   $Counts{$reject_name}{$hostip}++
3064                }
3065                else {
3066                   $Totals{$reject_name = "${rej_type}rejectclient" }++; next unless ($Collecting{$reject_name});
3067                   $p1 =~ s/;$//;
3068                   $Counts{$reject_name}{ucfirst($p1)}{$fmthost}{$eto}{$efrom}++;
3069                }
3070             } elsif ($p1 =~ /^Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/) {
3071                # Note: similar code below: search RejectRBL
3072
3073                # postfix 2.1
3074                #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>
3075                # postfix 2.3+
3076                #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>
3077                #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>
3078
3079                $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3080                ($site,$reason) = ($1 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3081                $reason =~ s/^reason: // if ($reason);
3082                $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++;
3083
3084             } elsif ($p1 =~ /^<.*>: Helo command rejected: (.*);$/) {
3085                $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name});
3086                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3087
3088             } elsif ($p1 =~ /^<.*>: Etrn command rejected: (.*);$/) {
3089                $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name});
3090                $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3091
3092             } elsif ($p1 =~ /^<.*>: Data command rejected: (.*);$/) {
3093                $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name});
3094                $Counts{$reject_name}{$1}{$fmthost}{$helo}++;
3095
3096             } elsif ($p1 =~ /^Insufficient system storage;/) {
3097                $Totals{'warninsufficientspace'}++;    # force display in Warnings section also
3098                $Totals{$reject_name = "${rej_type}rejectinsufficientspace" }++; next unless ($Collecting{$reject_name});
3099                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3100
3101             } elsif ($p1 =~ /^Server configuration (?:error|problem);/) {
3102                $Totals{'warnconfigerror'}++;          # force display in Warnings section also
3103                $Totals{$reject_name = "${rej_type}rejectconfigerror" }++; next unless ($Collecting{$reject_name});
3104                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3105
3106             } elsif ($p1 =~ /^Message size exceeds fixed limit;$/) {
3107                # Postfix responds with this message after a MAIL FROM:<...> SIZE=nnn  command, where postfix consider's nnn excessive
3108                # Note: similar code below: search RejectSize
3109                # Note: reject_warning does not seem to occur
3110                $Totals{$reject_name = "${rej_type}rejectsize" }++; next unless ($Collecting{$reject_name});
3111                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3112
3113             } elsif ($p1 =~ /^<(.*?)>: Temporary lookup failure;/) {
3114                $Totals{$reject_name = "${rej_type}rejectlookupfailure" }++; next unless ($Collecting{$reject_name});
3115                $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3116
3117             # This would capture all other rejects, but I think it might be more useful to add
3118             # additional capture sections based on user reports of uncapture lines.
3119             #
3120             #} elsif ( ($reason) = ($p1 =~ /^([^;]+);/)) {
3121             #  $Totals{$rej_type . 'rejectother'}++;
3122             #  $Counts{$rej_type . 'rejectother'}{$reason}++;
3123             } else {
3124                inc_unmatched('rejectother');
3125             }
3126          }
3127          # end of $re_QID: reject:
3128
3129 # QID: ACTION         STAGE from host[hostip]:   trigger:                    reason;                                                            ftph
3130 #
3131 #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>
3132 #TDsdN warn:           RCPT from host[10.0.0.1]:                             ;                                                                  from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.net>
3133 #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>
3134 #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>
3135 #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>
3136 #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>
3137 #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>
3138 #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>
3139 #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>
3140 #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>
3141 #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>
3142 #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>
3143 #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>
3144
3145 # BCC action (postfix 2.6+)
3146 #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>
3147
3148          # $re_QID: discard, filter, hold, redirect, warn, bcc, replace ...
3149          else {
3150             my $trigger;
3151             ($trigger,$reason) = ($p1 =~ /^(?:<(\S*)>: )?(.*);$/ );
3152             if ($trigger eq '') {   $trigger = '*unavailable';  }
3153             else {                  $trigger =~ s/^<(.+)>$/$1/; }
3154             $reason  = '*unavailable' if ($reason eq '');
3155             $fmthost = formathost ($hostip,$host);
3156             #print "trigger: \"$trigger\", reason: \"$reason\"\n";
3157
3158             # reason -> subject text
3159             #           subject -> "Helo command"           : smtpd_helo_restrictions
3160             #           subject -> "Client host"            : smtpd_client_restrictions
3161             #           subject -> "Unverified Client host" : smtpd_client_restrictions
3162             #           subject -> "Client certificate"     : smtpd_client_restrictions
3163             #           subject -> "Sender address"         : smtpd_sender_restrictions
3164             #           subject -> "Recipient address"      : smtpd_recipient_restrictions
3165
3166             #           subject -> "Data command"           : smtpd_data_restrictions
3167             #           subject -> "End-of-data"            : smtpd_end_of_data_restrictions
3168             #           subject -> "Etrn command"           : smtpd_etrn_restrictions
3169
3170             #           text    -> triggers <ACTION> action|triggers <ACTION> <destination>|optional text...
3171
3172             my ($subject, $text) =
3173                ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o);
3174             #printf "ACTION: '$action', SUBJECT: %-30s TEXT: \"$text\"\n", '"' . $subject . '"';
3175
3176             if ($action eq 'filter') {
3177                $Totals{'filtered'}++; next unless ($Collecting{'filtered'});
3178                # See "Note: Counts" before changing $Counts below re: Filtered
3179                $text =~ s/triggers FILTER //;
3180                if    ($subject eq 'Recipient address') { $Counts{'filtered'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3181                elsif ($subject =~ /Client host$/)      { $Counts{'filtered'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3182                else                                    { $Counts{'filtered'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3183             }
3184             elsif ($action eq 'redirect') {
3185                $Totals{'redirected'}++; next unless ($Collecting{'redirected'});
3186                $text =~ s/triggers REDIRECT //;
3187                # See "Note: Counts" before changing $Counts below re: Redirected
3188                if    ($subject eq 'Recipient address') { $Counts{'redirected'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3189                elsif ($subject =~ /Client host$/)      { $Counts{'redirected'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3190                else                                    { $Counts{'redirected'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3191             }
3192             # hold, discard, and warn allow "optional text"
3193             elsif ($action eq 'hold') {
3194                $Totals{'hold'}++; next unless ($Collecting{'hold'});
3195                # See "Note: Counts" before changing $Counts below re: Hold
3196                $subject = $reason unless $text eq 'triggers HOLD action';
3197                if    ($subject eq 'Recipient address') { $Counts{'hold'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3198                elsif ($subject =~ /Client host$/)      { $Counts{'hold'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3199                else                                    { $Counts{'hold'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3200             }
3201             elsif ($action eq 'discard') {
3202                $Totals{'discarded'}++; next unless ($Collecting{'discarded'});
3203                # See "Note: Counts" before changing $Counts below re: Discarded
3204                $subject = $reason unless $text eq 'triggers DISCARD action';
3205                if    ($subject eq 'Recipient address') { $Counts{'discarded'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3206                elsif ($subject =~ /Client host$/)      { $Counts{'discarded'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3207                else                                    { $Counts{'discarded'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3208             }
3209             elsif ($action eq 'warn') {
3210                $Totals{'warned'}++; next unless ($Collecting{'warned'});
3211                $Counts{'warned'}{$reason}{$fmthost}{$eto}{''}++;
3212                # See "Note: Counts" before changing $Counts above...
3213             }
3214             elsif ($action eq 'bcc') {
3215                $Totals{'bcced'}++; next unless ($Collecting{'bcced'});
3216                # See "Note: Counts" before changing $Counts below re: Filtered
3217                $text =~ s/triggers BCC //o;
3218                if    ($subject eq 'Recipient address') { $Counts{'bcced'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3219                elsif ($subject =~ /Client host$/)      { $Counts{'bcced'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3220                else                                    { $Counts{'bcced'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3221             }
3222             else {
3223                die "Unexpected ACTION: '$action'";
3224             }
3225          }
3226       }
3227
3228       elsif ($p1 =~ s/^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)//) {
3229          my ($hip,$host,$hostip) = ($1,$2,$3);
3230
3231          # Increment accepted when the client connection is made and smtpd has a QID.
3232          # Previously, accepted was being incorrectly incremented when the first qmgr
3233          # "from=xxx, size=nnn ..." line was seen.  This is erroneous when the smtpd
3234          # client connection occurred outside the date range of the log being analyzed.
3235          $AcceptedByQid{$qid} = $hip;
3236          $Totals{'msgsaccepted'}++;
3237
3238          #TDsdQ client=unknown[192.168.0.1]
3239          #TDsdQ client=unknown[192.168.0.1]:unknown
3240          #TDsdQ client=unknown[192.168.0.1]:10025
3241          #TDsd client=example.com[192.168.0.1], helo=example.com
3242          #TDsdQ client=mail.example.com[2001:dead:beef::1]
3243
3244          #TDsdQ client=localhost[127.0.0.1], sasl_sender=someone@example.com
3245          #TDsdQ client=example.com[192.168.0.1], sasl_method=PLAIN, sasl_username=anyone@sample.net
3246          #TDsdQ client=example.com[192.168.0.1], sasl_method=LOGIN, sasl_username=user@example.com, sasl_sender=<id352ib@sample.net>
3247          #TDsdQ client=unknown[10.0.0.1], sasl_sender=user@examine.com
3248          next if ($p1 eq '');
3249          my ($method,$user,$sender) = ($p1 =~ /^(?:, sasl_method=([^,]+))?(?:, sasl_username=([^,]+))?(?:, sasl_sender=<?(.*)>?)?$/);
3250
3251          # sasl_sender occurs when AUTH verb is present in MAIL FROM, typically used for relaying
3252          # the username (eg. sasl_username) of authenticated users.
3253          if ($sender or $method or $user) {
3254             $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'});
3255             $method ||= '*unknown method';
3256             $user   ||= '*unknown user';
3257             $Counts{'saslauth'}{$user . ($sender ? " ($sender)" : '')}{$method}{formathost($hostip,$host)}++;
3258          }
3259       }
3260
3261       # ^$re_QID: ...  (not access(5) action)
3262       elsif ($p1 =~ /^from=<(.*?)>, size=(\d+), nrcpt=(\d+)/) {
3263          my ($efrom,$bytes,$nrcpt) = ($1,$2,$3);
3264          #TDsdQ from=<FROM: SOME USER@example.com>, size=4051, nrcpt=1 (queue active)
3265          #TDsdQ(12) from=<anyone@example.com>, size=25302, nrcpt=2 (queue active)
3266          #TDsdQ from=<from@example.com>, size=5529, nrcpt=1 (queue active)
3267          #TDsdQ from=<from@example.net, @example.com>, size=5335, nrcpt=1 (queue active)
3268
3269          # Distinguish bytes accepted vs. bytes delivered due to multiple recips
3270
3271          # Increment bytes accepted on the first qmgr "from=..." line...
3272          next if (exists $SizeByQid{$qid});
3273          $SizeByQid{$qid}          = $bytes;
3274          # ...but only when the smtpd "client=..." line has been seen too.
3275          # This under-counts when the smtpd "client=..." connection log entry and the
3276          # qmgr "from=..." log entry span differnt periods (as fed to postfix-logwatch).
3277          next if (! exists $AcceptedByQid{$qid});
3278
3279          $Totals{'bytesaccepted'} += $bytes;
3280
3281          $Counts{'envelopesenders'}{$efrom ne '' ? $efrom : '<>'}++      if ($Collecting{'envelopesenders'});
3282          if ($Collecting{'envelopesenderdomains'}) {
3283             my ($localpart, $domain);
3284             if ($efrom eq '') { ($localpart, $domain) = ('<>', '*unknown'); }
3285             else              { ($localpart, $domain) = split (/@/, lc $efrom); }
3286
3287             $Counts{'envelopesenderdomains'}{$domain ne '' ? $domain : '*unknown'}{$localpart}++;
3288          }
3289          delete $AcceptedByQid{$qid};           # prevent incrementing BytesAccepted again
3290       }
3291
3292       ### sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3293       elsif ($p1 =~ s/^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=(\S+) //o) {
3294          ($relay,$status) = ($3,$5);
3295
3296          my ($to,$origto,$localpart,$domainpart,$dsn,$p1) = process_delivery_attempt ($1,$2,$4,$p1);
3297
3298          #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)
3299          #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)
3300          #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)
3301
3302          ### sent
3303          if ($status eq 'sent') {
3304             if ($p1 =~ /forwarded as /) {
3305                $Totals{'bytesforwarded'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3306                $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'});
3307                $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++;
3308             }
3309             else {
3310                if ($service_name eq 'lmtp') {
3311                   $Totals{'bytessentlmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3312                   $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'});
3313                   $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++;
3314                }
3315                elsif ($service_name eq 'smtp') {
3316                   $Totals{'bytessentsmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3317                   $Totals{'sent'}++; next unless ($Collecting{'sent'});
3318                   $Counts{'sent'}{$domainpart}{$localpart}{$origto}++;
3319                }
3320                # virtual, command, ...
3321                else {
3322                   $Totals{'bytesdelivered'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3323                   $Totals{'delivered'}++; next unless ($Collecting{'delivered'});
3324                   $Counts{'delivered'}{$domainpart}{$localpart}{$origto}++;
3325                }
3326             }
3327          }
3328
3329          elsif ($status eq 'deferred') {
3330             #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)
3331             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused)
3332             #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused)
3333             #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)
3334             #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)
3335             #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)
3336             #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)
3337             #TDsQ to=<to@localhost>, orig_to=<toalias@localhost>, relay=none, delay=238024, status=deferred (delivery temporarily suspended: transport is unavailable)
3338
3339             # XXX postfix reports dsn=5.0.0, host's reply may contain its own dsn's such as 511 and #5.1.1
3340             # XXX should these be used instead?
3341             #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))
3342             #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))
3343             #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))
3344
3345             ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3346
3347             $Totals{'deferred'}++      if ($DeferredByQid{$qid}++ == 0);
3348             $Totals{'deferrals'}++;    next unless ($Collecting{'deferrals'});
3349             $Counts{'deferrals'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3350          }
3351
3352          ### bounced
3353          elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') {
3354             # local agent
3355             #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")
3356
3357             # smtp agent
3358             #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))
3359
3360             #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))
3361             #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))
3362
3363
3364             #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)
3365             #TDsQ to=<>,                                   relay=none,  delay=1,                                       status=bounced (mail for sample.net loops back to myself)
3366             #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)
3367             # XXX verify these...
3368             #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=none, delay=1, status=bounced (User unknown in virtual alias table)
3369             #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)
3370             #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")
3371             #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")
3372
3373             #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))
3374             #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))
3375             #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))
3376             #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))
3377             #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))
3378             #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))
3379             #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")
3380
3381             # print "bounce message from " . $to . " msg : " . $relay . "\n";
3382
3383             # See same code elsewhere "Note: Bounce"
3384             ### local bounce
3385             # XXX local v. remote bounce seems iffy, relative
3386             if ($relay =~ /^(?:none|local|virtual|127\.0\.0\.1|maildrop|avcheck)/) {
3387                $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'});
3388                $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($p1)}{$localpart}++;
3389             }
3390             else {
3391                $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'});
3392                ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3393                $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
3394             }
3395          }
3396
3397
3398          elsif ($status =~ 'undeliverable') {
3399             #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)
3400             #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))
3401             #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")
3402             #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")
3403             $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'});
3404             if ($p1 =~ /^unknown user: ".+?"$/) {
3405                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{'Unknown user'}{$domainpart}{$localpart}{$origto ? $origto : ''}++;
3406             }
3407             else {
3408                my ($reply,$fmthost) = cleanhostreply($p1,'',$to ne '' ? $to : '<>',$domainpart);
3409                $Counts{'undeliverable'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3410             }
3411          }
3412
3413          elsif ($status eq 'deliverable') {
3414             # address verification, sendmail -bv deliverable reports
3415             #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)
3416             $Totals{'deliverable'}++; next unless ($Collecting{'deliverable'});
3417             my $dsn = ($p1 =~ s/^($re_DSN) // ? $1 : '*unavailable');
3418             $Counts{'deliverable'}{$dsn}{$p1}{$origto ? "$to ($origto)" : $to}++;
3419          }
3420
3421          else {
3422             # keep this as the last condition in this else clause
3423             inc_unmatched('unknownstatus');
3424          }
3425       } # end of sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3426
3427       # pickup
3428       elsif ($p1 =~ /^(uid=\S* from=<.*?>)/) {
3429          #TDpQ2 uid=0 from=<root>
3430          $AcceptedByQid{$qid} = $1;
3431          $Totals{'msgsaccepted'}++;
3432       }
3433
3434       elsif ($p1 =~ /^from=<(.*?)>, status=expired, returned to sender$/) {
3435          #TDqQ from=<from@example.com>, status=expired, returned to sender
3436          $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'});
3437          $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++;
3438       }
3439
3440       elsif ($p1 =~ s/^host ([^[]+)\[([^]]+)\](?::\d+)? refused to talk to me://) {
3441          #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
3442          #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 501 Connection from 192.168.2.1 (XY) rejected
3443          # Note: See ConnectToFailure above
3444          $Totals{'connecttofailure'}++; next unless ($Collecting{'connecttofailure'});
3445          $Counts{'connecttofailure'}{'Refused to talk to me'}{formathost($2,$1)}{$p1}++;
3446       }
3447
3448       elsif ($p1 =~ /^lost connection with ([^[]*)\[([^]]+)\](?::\d+)? (while .*)$/) {
3449          # outbound smtp
3450          #TDsQ lost connection with sample.net[10.0.0.1] while sending MAIL FROM
3451          #TDsQ lost connection with sample.net[10.0.0.2] while receiving the initial server greeting
3452          $Totals{'connectionlostoutbound'}++; next unless ($Collecting{'connectionlostoutbound'});
3453          $Counts{'connectionlostoutbound'}{ucfirst($3)}{formathost($2,$1)}++;
3454       }
3455
3456       elsif ($p1 =~ /^conversation with ([^[]*)\[([^]]+)\](?::\d+)? timed out (while .*)$/) {
3457          #TDsQ conversation with sample.net[10.0.0.1] timed out while receiving the initial SMTP greeting
3458          # Note: see TimeoutInbound below
3459          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3460          $Counts{'timeoutinbound'}{ucfirst($3)}{formathost($2,$1)}{''}++;
3461       }
3462
3463       elsif ($p1 =~ /^enabling PIX (<CRLF>\.<CRLF>) workaround for ([^[]+)\[([^]]+)\](?::\d+)?/ or
3464              $p1 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[([^]]+)\](?::\d+)?/) {
3465          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for example.com[192.168.0.1]
3466          #TDsQ enabling PIX <CRLF>.<CRLF> workaround for mail.sample.net[10.0.0.1]:25
3467          #TDsQ enabling PIX workarounds: disable_esmtp delay_dotcrlf for spam.example.org[10.0.0.1]:25
3468          $Totals{'pixworkaround'}++; next unless ($Collecting{'pixworkaround'});
3469          $Counts{'pixworkaround'}{$1}{formathost($3,$2)}++;
3470       }
3471
3472       # milter-reject, milter-hold, milter-discard
3473       elsif ($p1 =~ s/^milter-//) {
3474          milter_common($p1);
3475       }
3476
3477       elsif ($p1 =~ s/^SASL (\[CACHED\] )?authentication failed; //) {
3478          #TDsQ SASL authentication failed; cannot authenticate to server smtp.example.com[10.0.0.1]: no mechanism available
3479          #TDsQ SASL authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3480          #TDsQ SASL [CACHED] authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3481          # see saslauthfail elsewhere
3482
3483          $Totals{'saslauthfail'}++; next unless ($Collecting{'saslauthfail'});
3484          my $cached = $1;
3485
3486          if ($p1 =~ /^(authentication protocol loop with server): ([^[]+)\[([^]]+)\](?::\d+)?$/) {
3487             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,'');
3488          }
3489          elsif ($p1 =~ /^(cannot authenticate to server) ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
3490             ($reason,$host,$hostip,$reason2) = ($1,$2,$3,$4);
3491          }
3492          elsif ($p1 =~ /^server ([^[]+)\[([^]]+)\](?::\d+)? said: (.+)$/) {
3493             ($reason,$host,$hostip,$reason2) = ('server ... said',$1,$2,$3);
3494          }
3495          else {
3496             inc_unmatched('saslauthfail');
3497             next;
3498          }
3499
3500          $reason .= ': ' . $reason2  if $reason2;
3501          $Counts{'saslauthfail'}{$cached . $reason}{formathost($hostip,$host)}++;
3502       }
3503
3504       else {
3505          # keep this as the last condition in this else clause
3506          inc_unmatched('unknownqid')  if  ! in_ignore_list ($p1);
3507       }
3508    }
3509    # end of $re_QID section
3510
3511    elsif ($p1 =~ /^(timeout|lost connection) (after [^ ]+)(?: \((?:approximately )?(\d+) bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3512       my ($lort,$reason,$bytes,$host,$hostip) = ($1,$2,$3,$4,$5);
3513       if ($lort eq 'timeout') {
3514          # see also TimeoutInbound in $re_QID section
3515          #TDsd timeout after RSET from example.com[192.168.0.1]
3516          #TDsd timeout after DATA (6253 bytes) from example.com[10.0.0.1]
3517
3518          $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3519          $Counts{'timeoutinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3520       } else {
3521          #TDsd lost connection after CONNECT from mail.example.com[192.168.0.1]
3522          # postfix 2.5:20071003
3523          #TDsd lost connection after DATA (494133 bytes) from localhost[127.0.0.1]
3524          # postfix 2.6:20080621
3525          #TDsd lost connection after DATA (approximately 0 bytes) from example.com[10.0.0.1]
3526
3527          $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'});
3528          $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3529       }
3530    }
3531
3532    elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ($re_DSN) Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/o) {
3533       my ($rej_type,$host,$hostip,$dsn,)  = ($1,$2,$3,$4);
3534       ($site,$reason) = ($5 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3535       $reason =~ s/^reason: // if ($reason);
3536       $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn));
3537       #print "REJECT RBL NOQ: '$rej_type'\n";
3538       # Note: similar code above: search RejectRBL
3539
3540       # This section required: postfix didn't always log QID (eg. postfix 1.1)
3541       # Also, "reason:" was probably always present in this case, but I'm not certain
3542       # postfix 1.1
3543       #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>
3544       #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>
3545       #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>
3546       #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>
3547
3548       if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
3549          $fmthost = formathost($hostip,$host);
3550          $Counts{'byiprejects'}{$fmthost}++;
3551       }
3552
3553       $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3554       $Counts{$reject_name}{$site}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reason ? $reason : ''}++;
3555    }
3556
3557    # proxy-reject, proxy-accept
3558    elsif ($p1 =~ s/^proxy-(reject|accept): ([^:]+): //) {
3559       # 2.7
3560       #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>
3561       #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>
3562       #TDsdN proxy-reject: END-OF-MESSAGE: ; from=<user@example.com> to=<user@example.org> proto=SMTP helo=<mail.example.net>
3563
3564       next if $1 eq 'accept';    #ignore accepts
3565
3566       my ($stage) = ($2);
3567       my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
3568       #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
3569       #print "stage: '$stage', reply: '$p1'\n";
3570
3571       my ($dsn,$reject_name);
3572       ($dsn,$reply) = ($1,$2)    if $p1 =~ /^($re_DSN) (.*)$/o;
3573       #print "   dsn: '$dsn', reply: '$reply', key: ", get_reject_key($dsn), "\n";
3574       # DSN may not be present. Can occur, for example, when queue file size limit is reached,
3575       # which is logged as a Warning.  Ignore these, since they can't be add to any
3576       # reject section (no SMTP reply code).
3577       if (! defined $dsn) {
3578          next;
3579       }
3580
3581       $Totals{$reject_name = get_reject_key($dsn) . 'rejectproxy' }++; next unless ($Collecting{$reject_name});
3582       $Counts{$reject_name}{$stage}{$reply}{$eto}++;
3583    }
3584
3585    ### smtpd_tls_loglevel >= 1
3586    # Server TLS messages
3587    elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/)) {
3588       #TDsd TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3589       # Postfix 2.5+: status: Untrusted or Trusted
3590       #TDsd Untrusted TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3591       #TDsd Anonymous TLS connection established from localhost[127.0.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3592
3593       $Totals{'tlsserverconnect'}++; next unless ($Collecting{'tlsserverconnect'});
3594       $Counts{'tlsserverconnect'}{$status ? "$status: $type" : $type}{formathost($hostip,$host)}++;
3595    }
3596
3597    # Client TLS messages
3598    elsif ( ($status,$host,$type) = ($p1 =~ /^(?:(Verified|Trusted|Untrusted|Anonymous) )?TLS connection established to ([^ ]*): (.*)$/o)) {
3599       #TD TLS connection established to example.com: TLSv1 with cipher AES256-SHA (256/256 bits)
3600       # Postfix 2.5+: peer verification status: Untrusted, Trusted or Verified when
3601       # server's trust chain is valid and peername is matched
3602       #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)
3603
3604       $Totals{'tlsclientconnect'}++; next unless ($Collecting{'tlsclientconnect'});
3605       $Counts{'tlsclientconnect'}{$status ? "$status: $type" : $type}{$host}++;
3606    }
3607
3608    # smtp_tls_note_starttls_offer=yes
3609    elsif ($p1 =~ /^Host offered STARTTLS: \[(.*)\]$/o) {
3610       #TD Host offered STARTTLS: [mail.example.com]
3611       $Totals{'tlsoffered'}++; next unless ($Collecting{'tlsoffered'});
3612       $Counts{'tlsoffered'}{$1}++;
3613    }
3614
3615    ### smtpd_tls_loglevel >= 1
3616    elsif ($p1 =~ /^Unverified: (.*)/o) {
3617       #TD Unverified: subject_CN=(www|smtp|mailhost).(example.com|sample.net), issuer=someuser
3618       $Totals{'tlsunverified'}++; next unless ($Collecting{'tlsunverified'});
3619       $Counts{'tlsunverified'}{$1}++;
3620    }
3621
3622    # Note: no QID
3623    elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<(.*?)> to=<(.*?)>/)) {
3624       #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>
3625       #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>
3626       # Note: similar code above: search RejectSize
3627       # Note: reject_warning does not seem to occur
3628       if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
3629          $fmthost = formathost($hostip,$host);
3630          $Counts{'byiprejects'}{$fmthost}++;
3631       }
3632       $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name});
3633       $Counts{$reject_name}{$fmthost ? $fmthost : formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++;
3634    }
3635
3636    elsif ($p1 =~ /looking for plugins in (.*)$/) {
3637     #TD looking for plugins in '/usr/lib/sasl2', failed to open directory, error: No such file or directory
3638       $Totals{'warnconfigerror'}++; next unless ($Collecting{'warnconfigerror'});
3639       $Counts{'warnconfigerror'}{$1}++;
3640    }
3641
3642    # SMTP/ESMTP protocol violations
3643    elsif ($p1 =~ /^(improper command pipelining) (after \S+) from ([^[]*)\[([^]]+)\](?::\d+)?/) {
3644       # ProtocolViolation
3645       #TDsd postfix/smtpd[24928]: improper command pipelining after RCPT from unknown[192.168.0.1]
3646       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3647       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3648       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3649    }
3650
3651    elsif ($p1 =~ /^(too many errors) (after [^ ]*)(?: \((?:approximately )?\d+ bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3652       my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3653       #TDsd too many errors after AUTH from sample.net[10.0.0.1]
3654       #TDsd too many errors after DATA (0 bytes) from 1-0-0-10.example.com[10.0.0.1]
3655       $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3656       $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3657    }
3658
3659    # coerce these into general warnings
3660    elsif ( $p1 =~ /^cannot load Certificate Authority data/ or
3661            $p1 =~ /^SSL_connect error to /)
3662    {
3663       #TDsQ Cannot start TLS: handshake failure
3664       #TDsd cannot load Certificate Authority data
3665       #TDs SSL_connect error to mail.example.com: 0
3666
3667       postfix_warning($p1);
3668    }
3669
3670    else {
3671       # add to the unmatched list if not on the ignore_list
3672       inc_unmatched('final')   if ! in_ignore_list ($p1);
3673    }
3674 }
3675
3676 ########################################
3677 # Final tabulations, and report printing
3678
3679 for my $code (@RejectKeys) {
3680    for my $type (@RejectClasses) {
3681       $Totals{'totalrejects' . $code} += $Totals{$code . $type};
3682    }
3683
3684    if ($code =~ /^5/o) {
3685       $Totals{'totalrejects'} += $Totals{'totalrejects' . $code};
3686    }
3687 }
3688
3689 # XXX this was naive - the goal was to avoid recounting messages
3690 # released from quarantine, but externally introduced messages may
3691 # contain resent-message-id; trying to track only internally resent
3692 # messages does not seem useful.
3693 # make some corrections now, due to double counting
3694 #$Totals{'msgsaccepted'} -= $Totals{'resent'}   if ($Totals{'msgsaccepted'} >= $Totals{'resent'});
3695
3696 $Totals{'totalacceptplusreject'} = $Totals{'msgsaccepted'} + $Totals{'totalrejects'};
3697
3698 # Print the Summary report if any key has non-zero data.
3699 # Note: must explicitely check for any non-zero data,
3700 # as Totals always has some keys extant.
3701 #
3702 if ($Opts{'summary'}) {
3703    for (keys %Totals) {
3704       if ($Totals{$_}) {
3705          print_summary_report (@Sections);
3706          last;
3707       }
3708    }
3709 }
3710
3711 # Print the Detail report, if detail is sufficiently high
3712 #
3713 if ($Opts{'detail'} >= 5) {
3714    #print STDERR "Counts     memory usage: ", commify(Devel::Size::total_size(\%Counts)), "\n";
3715    #print STDERR "Delays     memory usage: ", commify(Devel::Size::total_size(\%Delays)), "\n";
3716    print_detail_report(@Sections);
3717
3718    if ($Opts{'delays'}) {
3719       my @table;
3720       for (sort keys %Delays) {
3721          # anon array ref: label, array ref of $Delay{key}
3722          push @table, [ substr($_,3), $Delays{$_} ];
3723       }
3724       if (@table) {
3725          print_percentiles_report2(\@table, "Delivery Delays Percentiles", $Opts{'delays_percentiles'});
3726       }
3727    }
3728
3729    print_postgrey_reports();
3730
3731 }
3732
3733 # debug: show which ignore_list items are hit most
3734 #my %IGNORED;
3735 #for (sort { $IGNORED{$b} <=> $IGNORED{$a} } keys %IGNORED) {
3736 #   printf "%10d: KEY: %s\n", $IGNORED{$_}, $_;
3737 #}
3738
3739 # Finally, print any unmatched lines
3740 #
3741 print_unmatched_report();
3742
3743 #
3744 # End of main
3745 #
3746 ##################################################
3747
3748 # Create the list of REs against which log lines are matched.
3749 # Lines that match any of the patterns in this list are ignored.
3750 #
3751 # Note: This table is created at runtime, due to a Perl bug which
3752 # I reported as perl bug #56202:
3753 #
3754 #    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
3755 #
3756 sub create_ignore_list() {
3757    # top 3 hitters up front
3758    push @ignore_list, qr/^statistics:/;
3759    push @ignore_list, qr/^setting up TLS connection (?:from|to)/;
3760    push @ignore_list, qr/^Verified: /;
3761    push @ignore_list, qr/^skipped, still being delivered/;
3762
3763    # SSL info at/above mail.info level
3764    push @ignore_list, qr/^read from [a-fA-F\d]{8}/;
3765    push @ignore_list, qr/^write to [a-fA-F\d]{8}/;
3766    push @ignore_list, qr/^[a-f\d]{4} [a-f\d]{2}/;
3767    push @ignore_list, qr/^[a-f\d]{4} - <SPACES/;
3768    push @ignore_list, qr/^[<>]+ /;
3769
3770    push @ignore_list, qr/^premature end-of-input (?:on|from) .* socket while reading input attribute name$/;
3771    push @ignore_list, qr/^certificate peer name verification failed/;
3772    push @ignore_list, qr/^Peer certi?ficate could not be verified$/;   # missing i was a postfix typo
3773    push @ignore_list, qr/^Peer cert verify depth=/;
3774    push @ignore_list, qr/^Peer verification:/;
3775    push @ignore_list, qr/^Server certificate could not be verified/;
3776    push @ignore_list, qr/^cannot load .SA certificate and key data/;
3777    push @ignore_list, qr/^tlsmgr_cache_run_event/;
3778    push @ignore_list, qr/^SSL_accept/;
3779    push @ignore_list, qr/^SSL_connect:/;
3780    push @ignore_list, qr/^connection (?:closed|established)/;
3781    push @ignore_list, qr/^delete smtpd session/;
3782    push @ignore_list, qr/^put smtpd session/;
3783    push @ignore_list, qr/^save session/;
3784    push @ignore_list, qr/^Reusing old/;
3785    push @ignore_list, qr/^looking up session/;
3786    push @ignore_list, qr/^lookup smtpd session/;
3787    push @ignore_list, qr/^lookup \S+ type/;
3788    push @ignore_list, qr/^xsasl_(?:cyrus|dovecot)_/;
3789    push @ignore_list, qr/^watchdog_/;
3790    push @ignore_list, qr/^read smtpd TLS/;
3791    push @ignore_list, qr/^open smtpd TLS/;
3792    push @ignore_list, qr/^write smtpd TLS/;
3793    push @ignore_list, qr/^read smtp TLS cache entry/;
3794    push @ignore_list, qr/^starting TLS engine$/;
3795    push @ignore_list, qr/^initializing the server-side TLS/;
3796    push @ignore_list, qr/^global TLS level: /;
3797    push @ignore_list, qr/^auto_clnt_/;
3798    push @ignore_list, qr/^generic_checks:/;
3799    push @ignore_list, qr/^inet_addr_/;
3800    push @ignore_list, qr/^mac_parse:/;
3801    push @ignore_list, qr/^cert has expired/;
3802    push @ignore_list, qr/^daemon started/;
3803    push @ignore_list, qr/^master_notify:/;
3804    push @ignore_list, qr/^rewrite_clnt:/;
3805    push @ignore_list, qr/^rewrite stream/;
3806    push @ignore_list, qr/^dict_/;
3807    push @ignore_list, qr/^send attr /;
3808    push @ignore_list, qr/^match_/;
3809    push @ignore_list, qr/^input attribute /;
3810    push @ignore_list, qr/^Run-time/;
3811    push @ignore_list, qr/^Compiled against/;
3812    push @ignore_list, qr/^private\//;
3813    push @ignore_list, qr/^reject_unknown_/;    # don't combine or shorten these reject_ patterns
3814    push @ignore_list, qr/^reject_unauth_/;
3815    push @ignore_list, qr/^reject_non_/;
3816    push @ignore_list, qr/^permit_/;
3817    push @ignore_list, qr/^idle timeout/;
3818    push @ignore_list, qr/^get_dns_/;
3819    push @ignore_list, qr/^dns_/;
3820    push @ignore_list, qr/^chroot /;
3821    push @ignore_list, qr/^process generation/;
3822    push @ignore_list, qr/^fsspace:/;
3823    push @ignore_list, qr/^master disconnect/;
3824    push @ignore_list, qr/^resolve_clnt/;
3825    push @ignore_list, qr/^ctable_/;
3826    push @ignore_list, qr/^extract_addr/;
3827    push @ignore_list, qr/^mynetworks:/;
3828    push @ignore_list, qr/^name_mask:/;
3829       #TDm reload -- version 2.6-20080814, configuration /etc/postfix
3830       #TDm reload configuration /etc/postfix
3831    push @ignore_list, qr/^reload (?:-- version \S+, )?configuration/;
3832    push @ignore_list, qr/^terminating on signal 15$/;
3833    push @ignore_list, qr/^verify error:num=/;
3834    push @ignore_list, qr/^verify return:/;
3835    push @ignore_list, qr/^nss_ldap: /;
3836    push @ignore_list, qr/^discarding EHLO keywords: /;
3837    push @ignore_list, qr/^sql auxprop plugin/;
3838    push @ignore_list, qr/^sql plugin/;
3839    push @ignore_list, qr/^sql_select/;
3840    push @ignore_list, qr/^auxpropfunc error/;
3841    push @ignore_list, qr/^commit transaction/;
3842    push @ignore_list, qr/^begin transaction/;
3843    push @ignore_list, qr/^maps_find: /;
3844    push @ignore_list, qr/^check_access: /;
3845    push @ignore_list, qr/^check_domain_access: /;
3846    push @ignore_list, qr/^check_mail_access: /;
3847    push @ignore_list, qr/^check_table_result: /;
3848    push @ignore_list, qr/^mail_addr_find: /;
3849    push @ignore_list, qr/^mail_addr_map: /;
3850    push @ignore_list, qr/^mail_flow_put: /;
3851    push @ignore_list, qr/^smtp_addr_one: /;
3852    push @ignore_list, qr/^smtp_connect_addr: /;
3853    push @ignore_list, qr/^smtp_connect_unix: trying: /;
3854    push @ignore_list, qr/^smtp_find_self: /;
3855    push @ignore_list, qr/^smtp_get: /;
3856    push @ignore_list, qr/^smtp_fputs: /;
3857    push @ignore_list, qr/^smtp_parse_destination: /;
3858    push @ignore_list, qr/^smtp_sasl_passwd_lookup: /;
3859    push @ignore_list, qr/^smtpd_check_/;
3860    push @ignore_list, qr/^smtpd_chat_notify: /;
3861    push @ignore_list, qr/^been_here: /;
3862    push @ignore_list, qr/^set_eugid: /;
3863    push @ignore_list, qr/^deliver_/;
3864    push @ignore_list, qr/^flush_send_file: queue_id/;
3865    push @ignore_list, qr/^milter_macro_lookup/;
3866    push @ignore_list, qr/^milter8/;
3867    push @ignore_list, qr/^skipping non-protocol event/;
3868    push @ignore_list, qr/^reply: /;
3869    push @ignore_list, qr/^event: /;
3870    push @ignore_list, qr/^trying... /;
3871    push @ignore_list, qr/ all milters$/;
3872    push @ignore_list, qr/^vstream_/;
3873    push @ignore_list, qr/^server features/;
3874    push @ignore_list, qr/^skipping event/;
3875    push @ignore_list, qr/^Using /;
3876    push @ignore_list, qr/^rec_(?:put|get): /;
3877    push @ignore_list, qr/^subject=/;
3878    push @ignore_list, qr/^issuer=/;
3879    push @ignore_list, qr/^pref  /;  # yes, multiple spaces
3880    push @ignore_list, qr/^request: \d/;
3881    push @ignore_list, qr/^done incoming queue scan$/;
3882    push @ignore_list, qr/^qmgr_/;
3883    push @ignore_list, qr/^trigger_server_accept_fifo: /;
3884    push @ignore_list, qr/^proxymap stream/;
3885    push @ignore_list, qr/^(?:start|end) sorted recipient list$/;
3886    push @ignore_list, qr/^connecting to \S+ port /;
3887    push @ignore_list, qr/^Write \d+ chars/;
3888    push @ignore_list, qr/^Read \d+ chars/;
3889    push @ignore_list, qr/^(?:lookup|delete) smtp session/;
3890    push @ignore_list, qr/^delete smtp session/;
3891    push @ignore_list, qr/^(?:reloaded|remove|looking for) session .* cache$/;
3892    push @ignore_list, qr/^(?:begin|end) \S+ address list$/;
3893    push @ignore_list, qr/^mapping DSN status/;
3894    push @ignore_list, qr/^record [A-Z]/;
3895    push @ignore_list, qr/^dir_/;
3896    push @ignore_list, qr/^transport_event/;
3897    push @ignore_list, qr/^read [A-Z](?: |$)/;
3898    push @ignore_list, qr/^relay: /;
3899    push @ignore_list, qr/^why: /;
3900    push @ignore_list, qr/^fp: /;
3901    push @ignore_list, qr/^path: /;
3902    push @ignore_list, qr/^level: /;
3903    push @ignore_list, qr/^recipient: /;
3904    push @ignore_list, qr/^delivered: /;
3905    push @ignore_list, qr/^queue_id: /;
3906    push @ignore_list, qr/^queue_name: /;
3907    push @ignore_list, qr/^user: /;
3908    push @ignore_list, qr/^sender: /;
3909    push @ignore_list, qr/^offset: /;
3910    push @ignore_list, qr/^offset: /;
3911    push @ignore_list, qr/^verify stream disconnect/;
3912    push @ignore_list, qr/^event_request_timer: /;
3913    push @ignore_list, qr/^smtp_sasl_authenticate: /;
3914    push @ignore_list, qr/^flush_add: /;
3915    push @ignore_list, qr/^disposing SASL state information/;
3916    push @ignore_list, qr/^starting new SASL client/;
3917    push @ignore_list, qr/^error: dict_ldap_connect: /;
3918    push @ignore_list, qr/^error: to submit mail, use the Postfix sendmail command/;
3919    push @ignore_list, qr/^local_deliver[:[]/;
3920    push @ignore_list, qr/^_sasl_plugin_load /;
3921    push @ignore_list, qr/^exp_type: /;
3922    push @ignore_list, qr/^wakeup [\dA-Z]/;
3923    push @ignore_list, qr/^defer (?:site|transport) /;
3924    push @ignore_list, qr/^local: /;
3925    push @ignore_list, qr/^exp_from: /;
3926    push @ignore_list, qr/^extension: /;
3927    push @ignore_list, qr/^owner: /;
3928    push @ignore_list, qr/^unmatched: /;
3929    push @ignore_list, qr/^domain: /;
3930    push @ignore_list, qr/^initializing the client-side TLS engine/;
3931    push @ignore_list, qr/^header_token: /;
3932    push @ignore_list, qr/^(?:PUSH|POP) boundary/;
3933    push @ignore_list, qr/^recipient limit \d+$/;
3934    push @ignore_list, qr/^scan_dir_next: found/;
3935    push @ignore_list, qr/^open (?:btree|incoming)/;
3936    push @ignore_list, qr/^Renamed to match inode number/;
3937    push @ignore_list, qr/^cleanup_[^:]+:/;
3938    push @ignore_list, qr/^(?:before|after) input_transp_cleanup: /;
3939    push @ignore_list, qr/^event_enable_read: /;
3940    push @ignore_list, qr/^report recipient to all milters /;
3941    push @ignore_list, qr/_action = defer_if_permit$/;
3942    push @ignore_list, qr/^reject_invalid_hostname: /;
3943    push @ignore_list, qr/^cfg_get_/;
3944    push @ignore_list, qr/^sacl_check: /;
3945
3946    # non-anchored
3947    #push @ignore_list, qr/: Greylisted for /;
3948    push @ignore_list, qr/certificate verification (?:depth|failed for)/;
3949    push @ignore_list, qr/re-using session with untrusted certificate, look for details earlier in the log$/;
3950    push @ignore_list, qr/socket: wanted attribute: /;
3951    push @ignore_list, qr/ smtpd cache$/;
3952    push @ignore_list, qr/ old session$/;
3953    push @ignore_list, qr/fingerprint=/;
3954    push @ignore_list, qr/TLS cipher list "/;
3955 }
3956
3957 # Evaluates a given line against the list of ignore patterns.
3958 #
3959 sub in_ignore_list($) {
3960    my $line = shift;
3961
3962    foreach (@ignore_list) {
3963       #return 1 if $line =~ /$_/;
3964       if ($line =~ /$_/) {
3965          #$IGNORED{$_}++;
3966          return 1;
3967       }
3968    }
3969
3970    return 0;
3971 }
3972
3973 # Accepts common fields from a standard delivery attempt, processing then
3974 # and returning modified values
3975 #
3976 sub process_delivery_attempt ($ $ $ $) {
3977    my ($to,$origto,$DDD,$reason) = @_;
3978
3979    $reason =~ s/\((.*)\)/$1/;   # Makes capturing nested parens easier
3980    # leave $to/$origto undefined, or strip < > chars if not null address (<>).
3981    defined $to     and $to =     ($to eq '')     ? '<>' : lc $to;
3982    defined $origto and $origto = ($origto eq '') ? '<>' : lc $origto;
3983    my ($localpart, $domainpart) = split ('@', $to);
3984    ($localpart, $domainpart) = ($to, '*unspecified')   if ($domainpart eq '');
3985    my ($dsn);
3986
3987    # If recipient_delimiter is set, break localpart into user + extension
3988    # and save localpart in origto if origto is empty
3989    #
3990    if ($Opts{'recipient_delimiter'} and $localpart =~ /\Q$Opts{'recipient_delimiter'}\E/o) {
3991
3992       # special cases: never split mailer-daemon or double-bounce
3993       # or owner- or -request if delim is "-" (dash).
3994       unless ($localpart =~ /^(?:mailer-daemon|double-bounce)$/i or
3995           ($Opts{'recipient_delimiter'} eq '-' and $localpart =~ /^owner-.|.-request$/i)) {
3996          my ($user,$extension) = split (/\Q$Opts{'recipient_delimiter'}\E/, $localpart, 2);
3997          $origto = $localpart    if ($origto eq '');
3998          $localpart = $user;
3999       }
4000    }
4001
4002    unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) {
4003       $dsn = '';
4004    }
4005
4006    if ($Collecting{'delays'} and $DDD =~ m{delay=([\d.]+)(?:, delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+))?}) {
4007       # Message delivery time stamps
4008       # delays=a/b/c/d, where
4009       #   a = time before queue manager, including message transmission
4010       #   b = time in queue manager
4011       #   c = connection setup including DNS, HELO and TLS;
4012       #   d = message transmission time.
4013       if (defined $2) {
4014          $Delays{'1: Before qmgr'}{$2}++;
4015          $Delays{'2: In qmgr'}{$3}++;
4016          $Delays{'3: Conn setup'}{$4}++;
4017          $Delays{'4: Transmission'}{$5}++;
4018       }
4019       $Delays{'5: Total'}{$1}++;
4020    }
4021
4022    return ($to,$origto,$localpart,$domainpart,$dsn,$reason);
4023 }
4024
4025 # Processes postfix/bounce messages
4026 #
4027 sub postfix_bounce($) {
4028    my $line = shift;
4029    my $type;
4030
4031    $line =~ s/^(?:$re_QID): //o;
4032    if ($line =~ /^(sender|postmaster) non-delivery notification/o) {
4033       #TDbQ postmaster non-delivery notification: 7446BCD68
4034       #TDbQ sender non-delivery notification: 7446BCD68
4035       $type = 'Non-delivery';
4036    }
4037    elsif ($line =~ /^(sender|postmaster) delivery status notification/o ) {
4038       #TDbQ sender delivery status notification: 7446BCD68
4039       $type = 'Delivery';
4040    }
4041    elsif ($line =~ /^(sender|postmaster) delay notification: /o) {
4042       #TDbQ sender delay notification: AA61EC2F9A
4043       $type = 'Delayed';
4044    }
4045    else {
4046       inc_unmatched('bounce')   if ! in_ignore_list($line);
4047       return;
4048    }
4049
4050    $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'});
4051    $Counts{'notificationsent'}{$type}{$1}++;
4052 }
4053
4054 # Processes postfix/cleanup messages
4055 #   cleanup always has a QID
4056 #
4057 sub postfix_cleanup($) {
4058    my $line = shift;
4059    my ($qid,$reply,$fmthost,$reject_name);
4060
4061    ($qid, $line) = ($1, $2)  if ($line =~ /^($re_QID): (.*)$/o );
4062
4063    #TDcQ message-id=<C1BEA2A0.188572%from@example.com>
4064    return if ($line =~ /^message-id=/);
4065
4066    # milter-reject, milter-hold, milter-discard
4067    if ($line =~ s/^milter-//) {
4068       milter_common($line);
4069       return;
4070    }
4071
4072    ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps)
4073    # Note: Bounce
4074    #   See same code elsewhere "Note: Bounce"
4075    #TDcQ to=<envto@example.com>,                  relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text...
4076    #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...
4077    if ($line =~ /^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o) {
4078       # ($to,$origto,$relay,$DDD,$status,$reason) = ($1,$2,$3,$4,$5,$6);
4079       if ($5 ne 'bounced' and $5 ne 'SOFTBOUNCE') {
4080          inc_unmatched('cleanupbounce');
4081          return;
4082       }
4083
4084       my ($to,$origto,$relay,$DDD,$reason) = ($1,$2,$3,$4,$6);
4085       my ($localpart,$domainpart,$dsn);
4086       ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$DDD,$reason);
4087
4088       ### local bounce
4089       # XXX local v. remote bounce seems iffy, relative
4090       if ($relay =~ /^(?:none|local|virtual|maildrop|127\.0\.0\.1|avcheck)/) {
4091          $Totals{'bouncelocal'}++; return unless ($Collecting{'bouncelocal'});
4092          $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++;
4093       }
4094       ### remote bounce
4095       else {
4096          ($reply,$fmthost) = cleanhostreply($reason,$relay,$to ne '' ? $to : '<>',$domainpart);
4097          $Totals{'bounceremote'}++; return unless ($Collecting{'bounceremote'});
4098          $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
4099       }
4100    }
4101
4102    # *header_checks and body_checks
4103    elsif (header_body_checks($line)) {
4104       #print "cleanup: header_body_checks\n";
4105       return;
4106    }
4107
4108    #TDcQ resent-message-id=4739073.1
4109    #TDcQ resent-message-id=<ARF+DXZwLECdxm@mail.example.com>
4110    #TDcQ resent-message-id=<B19-DVD42188E0example.com>?    <120B11@samplepc>
4111    elsif ( ($line =~ /^resent-message-id=<?.+>?$/o  )) {
4112       $Totals{'resent'}++;
4113    }
4114
4115    #TDcN unable to dlopen .../sasl2/libplain.so.2: .../sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted
4116    elsif ($line =~ /^unable to dlopen /) {
4117       # strip extraneous doubling of library path
4118       $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/);
4119       postfix_warning($line);
4120    }
4121
4122    else {
4123       inc_unmatched('cleanup(last)')   if ! in_ignore_list($line);
4124    }
4125 }
4126
4127 =pod
4128  header_body_checks
4129
4130   Handle cleanup's header_checks and body_checks, and smtp's smtp_body_checks/smtp_*header_checks
4131
4132   Possible actions that log are:
4133
4134      REJECT optional text...
4135      DISCARD optional text...
4136      FILTER transport:destination
4137      HOLD optional text...
4138      REDIRECT user@domain
4139      PREPEND text...
4140      REPLACE text...
4141      WARN optional text...
4142
4143      DUNNO and IGNORE are not logged
4144
4145 Returns:
4146    1: if line matched or handled
4147    0: otherwise
4148 =cut
4149
4150 sub header_body_checks($)
4151 {
4152    my $line = shift;
4153
4154    # bcc, discard, filter, hold, prepend, redirect, reject, replace, warning
4155    return 0 if ($line !~ /^[bdfhprw]/) or   # short circuit alternation when no match possible
4156                ($line !~ /^(re(?:ject|direct|place)|filter|hold|discard|prepend|warning|bcc): (header|body|content) (.*)$/);
4157
4158    my ($action,$part,$p3) = ($1,$2,$3);
4159
4160    #print "header_body_checks: action: \"$action\", part: \"$part\", p3: \"$p3\"\n";
4161
4162    my ($trigger,$host,$eto,$p4,$fmthost,$reject_name);
4163    # $re_QID: reject: body ...
4164    # $re_QID: reject: header ...
4165    # $re_QID: reject: content ...
4166
4167
4168    if ($p3 =~ /^(.*) from ([^;]+); from=<.*?>(?: to=<(.*?)>)?(?: proto=\S*)?(?: helo=<.*?>)?(?:: (.*)|$)/) {
4169       ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4);
4170
4171       #    $action   $part  $trigger                                 $host                                              $eto                                                $p4
4172       #TDcQ reject:   body   Subject: Cheap cialis               from local;                    from=<root@localhost>:                                                       optional text...
4173       #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...
4174       #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...
4175       # message_reject_characters (postfix >= 2.3)
4176       #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
4177
4178       #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
4179       #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...
4180       #TDcQ hold:     header Subject: Hold Test                  from local;                    from=<efrom@example.com> to=<eto@sample.net>:                                optional text...
4181       #TDcQ hold:     header Received: by example.com...from x   from local;                    from=<efrom@example.com>
4182       #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>
4183       #      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
4184       #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
4185       #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
4186       #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
4187       #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>
4188       #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...
4189       #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...
4190       #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...
4191       # BCC action (2.6 experimental branch)
4192       #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
4193
4194       # Note: reject_warning does not seem to occur
4195    }
4196
4197    else {
4198       # smtp_body_checks, smtp_header_checks, smtp_mime_header_checks, smtp_nested_header_checks (postfix >= 2.5)
4199       #TDsQ replace:  header Sender:   <from@example.com>                                                                                                                  : Sender:   <fm2@sample.net>
4200
4201       $trigger = $p3; $host = ''; $eto = ''; $p4 = $part eq 'body' ? 'smtp_body_checks' : 'smtp_*header_checks';
4202
4203       #inc_unmatched('header_body_checks');
4204       #return 1;
4205    }
4206
4207    #print "   trigger: \"$trigger\", host: \"$host\", eto: \"$eto\", p4: \"$p4\"\n";
4208    $trigger =~ s/\s+/ /g;
4209    $trigger = '*unknown reason'    if ($trigger eq '');
4210    $eto     = '*unknown'           if ($eto     eq '');
4211
4212    my ($trig,$trig_opt,$text);
4213    if    ($part eq 'header')               { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; }
4214    elsif ($part eq 'body')                 { $trig = "Body check"; }
4215    else                                    { $trig = "Content check"; }  # message_reject_characters (postfix >= 2.3)
4216
4217    if ($p4 eq '')                          { $text = '*generic'; $trig_opt = $trig; }
4218    else                                    { $text = $p4;        $trig_opt = "$trig ($p4)"; }
4219
4220    if    ($host eq 'local')                { $fmthost = formathost('127.0.0.1', 'local'); }
4221    elsif ($host =~ /([^[]+)\[([^]]+)\]/)   { $fmthost = formathost($2,$1); }
4222    else                                    { $fmthost = '*unknown'; }
4223
4224    # Note: Counts
4225    #   Ensure each $Counts{key} accumulator is consistently
4226    #   used with the same number of hash key levels throughout the code.
4227    #   For example, $Counts{'hold'} below has 4 keys; ensure that every
4228    #   other usage of $Counts{'hold'} also has 4 keys.  Currently, it is
4229    #   OK to set the last key as '', but only the last.
4230
4231    if ($action eq 'reject') {
4232       $Counts{'byiprejects'}{$fmthost}++                                if $Collecting{'byiprejects'};
4233
4234       # Note: no temporary or reject_warning
4235       # Note: no reply code - force into a 5xx reject
4236       # XXX this won't be seen if the user has no 5.. entry in reject_reply_patterns
4237       $Totals{$reject_name = "5xxreject$part" }++;
4238       $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++          if $Collecting{$reject_name};
4239    }
4240    elsif ( $action eq 'filter' ) {
4241       $Totals{'filtered'}++;
4242       $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++     if $Collecting{'filtered'};
4243    }
4244    elsif ( $action eq 'hold' ) {
4245       $Totals{'hold'}++;
4246       $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++            if $Collecting{'hold'};
4247    }
4248    elsif ( $action eq 'redirect' ) {
4249       $Totals{'redirected'}++;
4250       $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++   if $Collecting{'redirected'};
4251    }
4252    elsif ( $action eq 'discard' ) {
4253       $Totals{'discarded'}++;
4254       $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++           if $Collecting{'discarded'};
4255    }
4256    elsif ( $action eq 'prepend' ) {
4257       $Totals{'prepended'}++;
4258       $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++ if $Collecting{'prepended'};
4259    }
4260    elsif ( $action eq 'replace' ) {
4261       $Totals{'replaced'}++;
4262       $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++  if $Collecting{'replaced'};
4263    }
4264    elsif ( $action eq 'warning' ) {
4265       $Totals{'warned'}++;
4266       $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++              if $Collecting{'warned'};
4267    }
4268    elsif ( $action eq 'bcc' ) {
4269       $Totals{'bcced'}++;
4270       $Counts{'bcced'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++        if $Collecting{'bcced'};
4271    }
4272    else {
4273       inc_unmatched('header_body_checks unexpected action');
4274    }
4275
4276    return 1;
4277 }
4278
4279
4280 # Handle common milter actions:
4281 #    milter-reject, milter-hold, milter-discard
4282 # which are created by both smtpd and cleanup
4283 #
4284 sub milter_common($) {
4285    my $line = shift;
4286
4287    #TDsdN milter-reject: MAIL           from milterS.example.com[10.0.0.1]: 553 5.1.7 address incomplete;                                                                          proto=ESMTP helo=<example.com>
4288    #TDsdN milter-reject: CONNECT        from milterS.example.com[10.0.0.2]: 451 4.7.1 Service unavailable - try again later; proto=SMTP
4289    #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>
4290    #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>
4291
4292    #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>
4293    #TDcQ milter-reject:  CONNECT        from milterC.example.com[10.0.0.2]: 5.7.1 Some problem;                                                                                    proto=SMTP
4294    #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>
4295    #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>
4296 #   84B82AC8B3: milter-reject: END-OF-MESSAGE from localhost[127.0.0.1]: 5.7.1 Blocked
4297
4298    my ($efrom,$eto,$proto,$helo) = strip_ftph($line);
4299    #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
4300    $line =~ s/;$//;
4301
4302    if ($line =~ /^(reject|hold|discard): (\S+) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
4303
4304       my ($action,$stage,$host,$hostip,$reply) = ($1,$2,$3,$4,$5);
4305       #print "action: '$action', stage: '$stage', host: '$host', hostip: '$hostip', reply: '$reply'\n";
4306
4307       if ($action eq 'reject') {
4308          my ($dsn,$fmthost,$reject_name);
4309          ($dsn,$reply) = ($1,$2)    if $reply =~ /^($re_DSN) (.*)$/o;
4310          #print "   dsn: '$dsn', reply: '$reply'\n";
4311
4312          if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
4313             $fmthost = formathost($hostip,$host);
4314             $Counts{'byiprejects'}{$fmthost}++;
4315          }
4316          # Note: reject_warning does not seem to occur
4317          # Note: See rejectmilter elsewhere
4318          $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; return unless ($Collecting{$reject_name});
4319          $Counts{$reject_name}{$stage}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reply}++;
4320       }
4321       # milter-hold
4322       elsif ($action eq 'hold') {
4323          $Totals{'hold'}++; return unless ($Collecting{'hold'});
4324          $Counts{'hold'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4325       }
4326       # milter-discard
4327       else { # $action eq 'discard'
4328          $Totals{'discarded'}++; return unless ($Collecting{'discarded'});
4329          $Counts{'discarded'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4330       }
4331
4332    }
4333    else {
4334       inc_unmatched('milter_common)');
4335    }
4336 }
4337
4338 sub postfix_dnsblog {
4339    my $line = shift;
4340
4341    #postfix/dnsblog[16943]: addr 192.168.0.1 listed by domain bl.spamcop.net as 127.0.0.2
4342    #postfix/dnsblog[78598]: addr 192.168.0.1 blocked by domain zen.spamhaus.org as 127.0.0.11
4343    if ($line =~ /^addr (\S+) (?:listed|blocked) by domain (\S+) as (\S+)$/) {
4344       $Counts{'dnsblog'}{$2}{$1}{$3}++  if $Collecting{'dnsblog'};
4345    }
4346    else {
4347       inc_unmatched('dnsblog')   if ! in_ignore_list($line);
4348       return;
4349    }
4350 }
4351
4352 sub postfix_postscreen {
4353    my $line = shift;
4354
4355    return if (
4356       $line =~ /^cache / or
4357       $line =~ /discarding EHLO keywords: / or
4358       $line =~ /: discard_mask / or
4359       $line =~ /: sq=\d+ cq=\d+ event/ or
4360       $line =~ /: replacing command "/
4361    );
4362
4363
4364    if (($line =~ /^(PREGREET) \d+ (?:after \S+)? from \[([^]]+)\](?::\d+)?/) or
4365       # PREGREET 20 after 0.31 from [192.168.0.1]:12345: HELO 10.0.0.1??
4366       # HANGUP after 0.7 from [192.168.0.4]:12345
4367        ($line =~ /^(HANGUP) (?:after \S+)? from \[([^]]+)\](?::\d+)?/)) {
4368       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4369    }
4370    elsif ($line =~ /^(WHITELISTED|BLACKLISTED|PASS \S+) \[([^]]+)\](?::\d+)?$/) {
4371       # PASS NEW [192.168.0.2]:12345
4372       # PASS OLD [192.168.0.3]:12345
4373       $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4374    }
4375    elsif ($line =~ /^DNSBL rank (\S+) for \[([^]]+)\](?::\d+)?$/) {
4376       $Counts{'postscreen'}{'dnsbl'}{$2}{$1}++      if $Collecting{'postscreen'};
4377    }
4378
4379    elsif ($line =~ /^(CONNECT|COMMAND (?:(?:TIME|COUNT|LENGTH) LIMIT|PIPELINING)|NON-SMTP COMMAND|BARE NEWLINE) from \[([^\]]+)\]:\d+/) {
4380       # CONNECT from [192.168.1.1]:12345
4381       $Counts{'postscreen'}{lc($1)}{$2}{$END_KEY}++             if $Collecting{'postscreen'};
4382    }
4383    elsif ($line =~ /^DISCONNECT \[([^\]]+)\]:\d+$/) {
4384       # DISCONNECT [192.168.1.1]:12345
4385       $Counts{'postscreen'}{'disconnect'}{$1}{$END_KEY}++       if $Collecting{'postscreen'};
4386    }
4387
4388    elsif ($line =~ /^NOQUEUE: reject: RCPT from \[([^]]+)\](?::\d+)?: ($re_DSN) ([^;]+)/o) {
4389       #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>
4390       my ($ip,$dsn,$msg) = ($1,$2,$3);
4391
4392       if ($dsn =~ /^([54])/) {
4393          $Counts{'postscreen'}{$1 . 'xx reject'}{"$dsn $msg"}{$ip}++      if $Collecting{'postscreen'};
4394       }
4395       else {
4396          $Counts{'postscreen'}{'reject'}{"$dsn $msg"}{$ip}{$END_KEY}++      if $Collecting{'postscreen'};
4397       }
4398    }
4399
4400    elsif ($line =~ /^NOQUEUE: reject: CONNECT from \[([^]]+)\](?::\d+)?: too many connections/) {
4401       # NOQUEUE: reject: CONNECT from [192.168.0.1]:7197: too many connections
4402       $Counts{'postscreen'}{'reject'}{'Too many connections'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4403    }
4404
4405    elsif ($line =~ /^reject: connect from \[([^]]+)\](?::\d+)?: (.+)$/) {
4406       # reject: connect from [192.168.0.1]:21225: all screening ports busy
4407       $Counts{'postscreen'}{'reject'}{"\u$2"}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4408    }
4409
4410    elsif ($line =~ /^(?:WHITELIST VETO) \[([^]]+)\](?::\d+)?$/) {
4411       # WHITELIST VETO [192.168.0.8]:43579
4412       $Counts{'postscreen'}{'whitelist veto'}{$1}{$END_KEY}++   if $Collecting{'postscreen'};
4413    }
4414
4415    elsif ($line =~ /^(entering|leaving) STRESS mode with (\d+) connections$/) {
4416       # entering STRESS mode with 90 connections
4417       $Counts{'postscreen'}{'stress mode: ' . $1}{$2}{$END_KEY}++      if $Collecting{'postscreen'};
4418    }
4419
4420    elsif ($line =~ /^close database (\S+): No such file or directory/) {
4421       # close database /var/lib/postfix/postscreen_cache.db: No such file or directory (possible Berkeley DB bug)
4422       $Counts{'postscreen'}{'close database'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4423    }
4424
4425    else {
4426       inc_unmatched('postscreen')   if ! in_ignore_list($line);
4427       return;
4428    }
4429
4430    $Totals{'postscreen'}++;
4431 }
4432
4433
4434 # Handles postfix/postsuper lines
4435 #
4436 sub postfix_postsuper($) {
4437    my $line = shift;
4438
4439    return if $line =~ /^Deleted: \d+ messages?$/;
4440
4441    if ($line =~ /^Placed on hold: (\d+) messages?$/o) {
4442       #TDps Placed on hold: 2 messages
4443       # Note: See Hold elsewhere
4444       $Totals{'hold'} += $1; return unless ($Collecting{'hold'});
4445       $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1;
4446    }
4447    elsif ($line =~ /^Released from hold: (\d+) messages?$/o) {
4448       #TDps Released from hold: 1 message
4449       $Totals{'releasedfromhold'} += $1;
4450    }
4451    elsif ($line =~ /^Requeued: (\d+) messages?$/o) {
4452       #TDps Requeued: 1 message
4453       $Totals{'requeued'} += $1;
4454    }
4455    elsif (my($qid,$p2) = ($line =~ /($re_QID): (.*)$/)) {
4456       # postsuper double reports the following 3 lines
4457       return if ($p2 eq 'released from hold');
4458       return if ($p2 eq 'placed on hold');
4459       return if ($p2 eq 'requeued');
4460
4461       if ($p2 =~ /^removed\s*$/o) {
4462          # Note: See REMOVED elsewhere
4463          # 52CBDC2E0F: removed
4464          delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
4465          $Totals{'removedfromqueue'}++;
4466       }
4467       elsif (! in_ignore_list ($p2)) {
4468          inc_unmatched('postsuper2');
4469       }
4470    }
4471    elsif (! in_ignore_list ($line)) {
4472       inc_unmatched('postsuper1');
4473    }
4474 }
4475
4476 # Handles postfix panic: lines
4477 #
4478 sub postfix_panic($) {
4479    #TD panic: myfree: corrupt or unallocated memory block
4480    $Totals{'panicerror'}++; return unless ($Collecting{'panicerror'});
4481    $Counts{'panicerror'}{ucfirst($1)}++;
4482 }
4483
4484 # Handles postfix fatal: lines
4485 #
4486 sub postfix_fatal($) {
4487    my ($reason) = shift;
4488
4489    if ($reason =~ /^\S*\(\d+\): Message file too big$/o) {
4490       #TD fatal: root(0): Message file too big
4491       $Totals{'fatalfiletoobig'}++;
4492
4493
4494    # XXX its not clear this is at all useful - consider falling through to last case
4495    } elsif ( $reason =~ /^config variable (\S*): (.*)$/o ) {
4496       #TD fatal: config variable inet_interfaces: host not found: 10.0.0.1:2525
4497       #TD fatal: config variable inet_interfaces: host not found: all:2525
4498       $Totals{'fatalconfigerror'}++; return unless ($Collecting{'fatalconfigerror'});
4499       $Counts{'fatalconfigerror'}{ucfirst($reason)}++;
4500    }
4501    else {
4502       #TD fatal: watchdog timeout
4503       #TD fatal: bad boolean configuration: smtpd_use_tls =
4504
4505       #TDvN fatal: update queue file active/4B709F060E: File too large
4506       $reason =~ s/(^update queue file \w+\/)\w+:/$1*:/;
4507
4508       $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'});
4509       $Counts{'fatalerror'}{ucfirst($reason)}++;
4510    }
4511 }
4512 # Handles postfix fatal: lines
4513 #
4514 sub postfix_error($) {
4515    my ($reason) = shift;
4516    # postfix/postfix-script[4271]: error: unknown command: 'rel'
4517
4518    $Totals{'error'}++; return unless ($Collecting{'fatalerror'});
4519    $Counts{'error'}{ucfirst($reason)}++;
4520 }
4521
4522 # Handles postfix warning: lines
4523 # and additional lines coerced into warnings
4524 #
4525 sub postfix_warning($) {
4526    my ($warning) = shift;
4527
4528    # Skip these
4529    return if ($warning =~ /$re_QID: skipping further client input$/o);
4530    return if ($warning =~ /^Mail system is down -- accessing queue directly$/o);
4531    return if ($warning =~ /^SASL authentication failure: (?:Password verification failed|no secret in database)$/o);
4532    return if ($warning =~ /^no MX host for .* has a valid A record$/o);
4533    return if ($warning =~ /^uid=\d+: Broken pipe$/o);
4534
4535    #TD warning: connect to 127.0.0.1:12525: Connection refused
4536    #TD warning: problem talking to server 127.0.0.1:12525: Connection refused
4537    #TD warning: valid_ipv4_hostaddr: invalid octet count:
4538
4539    my ($domain,$to,$type,$site,$helo,$cmd);
4540    my ($addr,$size,$hostip,$host,$port,$reason,$qid,$queue,$reason2,$process,$status,$service);
4541
4542    if (($hostip,$host,$reason) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): hostname ([^ ]+) verification failed: (.*)$/) or
4543        ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): (address not listed for hostname) (.*)$/) or
4544        ($host,$reason,$hostip,$reason2) = ($warning =~ /^(?:smtpd_peer_init: )?hostname (\S+) (does not resolve to address) ([\d.]+)(: host not found, try again)?$/)) {
4545       #TD warning: 10.0.0.1: hostname sample.com verification failed: Host not found
4546       #TD warning: smtpd_peer_init: 192.168.0.1: hostname example.com verification failed: Name or service not known
4547       #TD warning: 192.168.0.1: address not listed for hostname sample.net
4548       # post 2.8
4549       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1: host not found, try again
4550       #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1
4551
4552       $reason .= $reason2 if $reason2;
4553       $Totals{'hostnameverification'}++; return unless ($Collecting{'hostnameverification'});
4554       $Counts{'hostnameverification'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4555
4556    } elsif (($warning =~ /^$re_QID: queue file size limit exceeded$/o) or
4557             ($warning =~ /^uid=\d+: File too large$/o)) {
4558       $Totals{'warnfiletoobig'}++;
4559
4560    } elsif ($warning =~ /^database (?:[^ ]*) is older than source file ([\w\/]+)$/o) {
4561       #TD warning: database /etc/postfix/client_checks.db is older than source file /etc/postfix/client_checks
4562       $Totals{'databasegeneration'}++; return unless ($Collecting{'databasegeneration'});
4563       $Counts{'databasegeneration'}{$1}++;
4564
4565    } elsif (($reason,$qid,$reason2) = ($warning =~ /^(open active) ($re_QID): (.*)$/o) or
4566             ($reason,$qid,$reason2) = ($warning =~ /^qmgr_active_corrupt: (save corrupt file queue active) id ($re_QID): (.*)$/o) or
4567             ($qid,$reason,$reason2) = ($warning =~ /^($re_QID): (write queue file): (.*)$/o)) {
4568
4569       #TD warning: open active BDB9B1309F7: No such file or directory
4570       #TD warning: qmgr_active_corrupt: save corrupt file queue active id 4F4272F342: No such file or directory
4571       #TD warning: E669DE52: write queue file: No such file or directory
4572
4573       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4574       $Counts{'queuewriteerror'}{"$reason: $reason2"}{$qid}++;
4575
4576    } elsif (($qid,$reason) = ($warning =~ /^qmgr_active_done_3_generic: remove ($re_QID) from active: (.*)$/o)) {
4577       #TD warning: qmgr_active_done_3_generic: remove AF0F223FC05 from active: No such file or directory
4578       $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4579       $Counts{'queuewriteerror'}{"remove from active: $reason"}{$qid}++;
4580
4581    } elsif (($queue,$qid) = ($warning =~ /^([^\/]*)\/($re_QID): Error writing message file$/o )) {
4582       #TD warning: maildrop/C9E66ADF: Error writing message file
4583       $Totals{'messagewriteerror'}++; return unless ($Collecting{'messagewriteerror'});
4584       $Counts{'messagewriteerror'}{$queue}{$qid}++;
4585
4586    } elsif (($process,$status) = ($warning =~ /^process ([^ ]*) pid \d+ exit status (\d+)$/o)) {
4587       #TD warning: process /usr/lib/postfix/smtp pid 9724 exit status 1
4588       $Totals{'processexit'}++; return unless ($Collecting{'processexit'});
4589       $Counts{'processexit'}{"Exit status $status"}{$process}++;
4590
4591    } elsif ($warning =~ /^mailer loop: (.*)$/o) {
4592       #TD warning: mailer loop: best MX host for example.com is local
4593       $Totals{'mailerloop'}++; return unless ($Collecting{'mailerloop'});
4594       $Counts{'mailerloop'}{$1}++;
4595
4596    } elsif ($warning =~ /^no (\S+) host for (\S+) has a valid address record$/) {
4597       #TDs warning: no MX host for example.com has a valid address record
4598       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4599       $Counts{'dnserror'}{"No $1 host has a valid address record"}{$2}{$END_KEY}++;
4600
4601    } elsif ($warning =~ /^(Unable to look up \S+ host) (.+)$/) {
4602       #TDsd warning: Unable to look up MX host for example.com: Host not found
4603       #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known
4604       #TDsd warning: Unable to look up NS host ns1.example.logal for Sender address bounce@example.local: No address associated with hostname
4605       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4606
4607       my ($problem,$target,$reason) = ($1, split(/: /,$2));
4608       $reason =~ s/, try again//;
4609
4610       if ($target =~ /^for (\S+)$/) {
4611          $Counts{'dnserror'}{$problem}{ucfirst($reason)}{$1}{$END_KEY}++;
4612       }
4613       elsif ($target =~ /^(\S+)( for \S+ address) (\S+)$/) {
4614          $Counts{'dnserror'}{$problem . lc($2)}{ucfirst($reason)}{$1}{$3}++;
4615       }
4616
4617    } elsif ($warning =~ /^((?:malformed|numeric) domain name in .+? of \S+ record) for (.*):(.*)?$/) {
4618       my ($problem,$domain,$reason) = ($1,$2,$3);
4619       #TDsd warning: malformed domain name in resource data of MX record for example.com:
4620       #TDsd warning: malformed domain name in resource data of MX record for example.com: mail.example.com\\032
4621       #TDsd warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1
4622       $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4623       $Counts{'dnserror'}{ucfirst($problem)}{$domain}{$reason eq '' ? '*unknown' : $reason}{$END_KEY}++;
4624
4625    } elsif ($warning =~ /^numeric hostname: ([\S]+)$/) {
4626       #TD warning: numeric hostname: 192.168.0.1
4627       $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'});
4628       $Counts{'numerichostname'}{$1}++;
4629
4630    } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/)  or
4631              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[([^]]+)\](?::(\d+))?: (.*)$/) or
4632              ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[([^]]+)\](?::(\d+))?:(?: (.*))?$/o)) {
4633       # ancient
4634       #TDsd warning: example.com[192.168.0.1] sent message header instead of SMTP command: From: "Someone" <40245426501example.com>
4635       # current
4636       #TDsd warning: non-SMTP command from sample.net[10.0.0.1]: Received: from 192.168.0.1 (HELO bogus.sample.com)
4637       #TDs warning: 6B01A8DEF: non-ESMTP response from mail.example.com[192.168.0.1]:25:
4638
4639       $Totals{'smtpconversationerror'}++; return unless ($Collecting{'smtpconversationerror'});
4640       $host .= ' :' . $port   if ($port and $port ne '25');
4641       $Counts{'smtpconversationerror'}{ucfirst($type)}{formathost($hostip,$host)}{$reason}++;
4642
4643    } elsif ($warning =~ /^valid_hostname: (.*)$/o) {
4644       #TD warning: valid_hostname: empty hostname
4645       $Totals{'hostnamevalidationerror'}++; return unless ($Collecting{'hostnamevalidationerror'});
4646       $Counts{'hostnamevalidationerror'}{$1}++;
4647
4648    } elsif (($host,$hostip,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::\d+)?: SASL (.*) authentication failed(.*)$/)) {
4649       #TDsd warning: unknown[10.0.0.1]: SASL LOGIN authentication failed: bad protocol / cancel
4650       #TDsd warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed
4651       # see saslauthfail elsewhere
4652       $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'});
4653       if ($reason) { $reason = $type . $reason; }
4654       else         { $reason = $type; }
4655       $Counts{'saslauthfail'}{$reason}{formathost($hostip,$host)}++;
4656
4657    } elsif (($host,$reason) = ($warning =~ /^(\S+): RBL lookup error:.* Name service error for (?:name=)?\1(?: type=[^:]+)?: (.*)$/o)) {
4658       #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
4659
4660       #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
4661       $Totals{'rblerror'}++; return unless ($Collecting{'rblerror'});
4662       $Counts{'rblerror'}{$reason}{$host}++;
4663
4664    } elsif (
4665          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/ ) or
4666          ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/ )) {
4667       #TDs warning: host example.com[192.168.0.1] greeted me with my own hostname example.com
4668       #TDs warning: host example.com[192.168.0.1] replied to HELO/EHLO with my own hostname example.com
4669       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4670       $Counts{'heloerror'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4671
4672    } elsif (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[([^]]+)\](?::\d+)?$/ )) {
4673       #TD warning: bad size limit "-679215104" in EHLO reply from example.com[192.168.0.1]
4674       $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4675       $Counts{'heloerror'}{"Bad size limit in EHLO reply"}{formathost($hostip,$host)}{"$size"}++;
4676
4677    } elsif ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[([^]]+)\](?::\d+)? in ([^ ]*) command: (.*)/ )) {
4678       #TD warning: Illegal address syntax from example.com[192.168.0.1] in MAIL command: user@sample.net
4679       $addr =~ s/[<>]//g   unless ($addr eq '<>');
4680       $Totals{'illegaladdrsyntax'}++; return unless ($Collecting{'illegaladdrsyntax'});
4681       $Counts{'illegaladdrsyntax'}{$cmd}{$addr}{formathost($hostip,$host)}++;
4682
4683    } elsif ($warning =~ /^(timeout|premature end-of-input) on (.+) while reading (.*)$/o
4684          or $warning =~ /^(malformed (?:base64|numerical)|unexpected end-of-input) from (.+) while reading (.*)$/o) {
4685
4686       #TDs warning: premature end-of-input on private/anvil while reading input attribute name
4687       #TDs warning: timeout on private/anvil while reading input attribute data
4688       #TDs warning: unexpected end-of-input from 127.0.0.1:10025 socket while reading input attribute name
4689       #TDs warning: malformed base64 data from %s while reading input attribute data: ...
4690       #TDs warning: malformed numerical data from %s while reading input attribute data: ...
4691
4692       $Totals{'attrerror'}++; return unless ($Collecting{'attrerror'});
4693       $Counts{'attrerror'}{$2}{$1}{$3}++;
4694
4695    } elsif ($warning =~ /^(.*): (bad command startup -- throttling)/o) {
4696       #TD warning: /usr/libexec/postfix/trivial-rewrite: bad command startup -- throttling
4697       $Totals{'startuperror'}++; return unless ($Collecting{'startuperror'});
4698       $Counts{'startuperror'}{ucfirst($2)}{$1}++;
4699
4700    } elsif ($warning =~ /(problem talking to service [^:]*): (.*)$/o) {
4701       #TD warning: problem talking to service rewrite: Connection reset by peer
4702       #TD warning: problem talking to service rewrite: Success
4703       $Totals{'communicationerror'}++; return unless ($Collecting{'communicationerror'});
4704       $Counts{'communicationerror'}{ucfirst($1)}{$2}++;
4705
4706    } elsif (my ($map,$key) = ($warning =~ /^$re_QID: ([^ ]*) map lookup problem for (.*)$/o)) {
4707       #TD warning: 6F74F74431: virtual_alias_maps map lookup problem for root@example.com
4708       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4709       $Counts{'mapproblem'}{$map}{$key}++;
4710
4711    } elsif (($map,$reason) = ($warning =~ /^pcre map ([^,]+), (.*)$/o)) {
4712       #TD warning: pcre map /etc/postfix/body_checks, line 92: unknown regexp option "F": skipping this rule
4713       $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4714       $Counts{'mapproblem'}{$map}{$reason}++;
4715
4716    } elsif (($reason) = ($warning =~ /dict_ldap_lookup: (.*)$/o)) {
4717       #TD warning: dict_ldap_lookup: Search error 80: Internal (implementation specific) error
4718       $Totals{'ldaperror'}++; return unless ($Collecting{'ldaperror'});
4719       $Counts{'ldaperror'}{$reason}++;
4720
4721    } elsif (($type,$size,$host,$hostip,$service) = ($warning =~ /^(.+) limit exceeded: (\d+) from ([^[]+)\[([^]]+)\](?::\d+)? for service (.*)/ )) {
4722       #TDsd warning: Connection concurrency limit exceeded: 51 from example.com[192.168.0.1] for service smtp
4723       #TDsd warning: Connection rate limit exceeded: 20 from mail.example.com[192.168.0.1] for service smtp
4724       #TDsd warning: Connection rate limit exceeded: 30 from unknown[unknown] for service smtp
4725       #TDsd warning: Recipient address rate limit exceeded: 21 from example.com[10.0.0.1] for service smtp
4726       #TDsd warning: Message delivery request rate limit exceeded: 11 from example.com[10.0.0.1] for service smtp
4727       #TDsd warning: New TLS session rate limit exceeded: 49 from example.com[10.0.0.1] for service smtp
4728       $Totals{'anvil'}++; return unless ($Collecting{'anvil'});
4729       $Counts{'anvil'}{$service}{$type}{formathost($hostip,$host)}{$size}++;
4730
4731    } elsif (my ($extname,$intname,$limit) = ($warning =~ /service "([^"]+)" \(([^)]+)\) has reached its process limit "([^"]+)":/o)) {
4732       #TD warning: service "smtp" (25) has reached its process limit "50": new clients may experience noticeable delays
4733       $Totals{'processlimit'}++; return unless ($Collecting{'processlimit'});
4734       $Counts{'processlimit'}{'See http://www.postfix.org/STRESS_README.html'}{"$extname ($intname)"}{$limit}++;
4735
4736    } else {
4737       #TDsd warning: No server certs available. TLS won't be enabled
4738       #TDs warning: smtp_connect_addr: bind <localip>: Address already in use
4739
4740       # These two messages follow ProcessLimit message above
4741       #TDm warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client
4742       #TDm warning: see http://www.postfix.org/STRESS_README.html for examples of stress-dependent configuration settings
4743       return if ($warning =~ /^to avoid this condition,/o);
4744       return if ($warning =~ /^see http:\/\/www\.postfix\.org\/STRESS_README.html/o);
4745
4746       #TDsd warning: 009314BD9E: read timeout on cleanup socket
4747       $warning =~ s/^$re_QID: (read timeout on \S+ socket)/$1/;
4748
4749       #TDsd warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4750       #TDs warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4751       $warning =~ s/^(Read failed in network_biopair_interop) with .*$/$1/;
4752
4753 =cut
4754       $warning =~ s/^(TLS library problem: )\d+:(error:.*)$/$1$2/;
4755       $warning =~ s/^(network_biopair_interop: error reading) \d+ bytes(.*)$/$1$2/;
4756
4757 1      TLS library problem: 10212:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4758 1      TLS library problem: 10217:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
4759 1      network_biopair_interop: error reading 1102 bytes from the network: Connection reset by peer
4760 1      network_biopair_interop: error reading 1120 bytes from the network: Connection reset by peer
4761 =cut
4762
4763
4764       $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'});
4765       $Counts{'warningsother'}{$warning}++;
4766    }
4767 }
4768
4769 # Handles postfix/postfix-script lines
4770 #
4771 sub postfix_script($) {
4772    my $line = shift;
4773
4774    return if ($line =~ /^the Postfix mail system is running: PID: /o);
4775
4776    if ($line =~ /^starting the Postfix mail system/o) {
4777       $Totals{'postfixstart'}++;
4778    }
4779    elsif ($line =~ /^stopping the Postfix mail system/o) {
4780       $Totals{'postfixstop'}++;
4781    }
4782    elsif ($line =~ /^refreshing the Postfix mail system/o) {
4783       $Totals{'postfixrefresh'}++;
4784    }
4785    elsif ($line =~ /^waiting for the Postfix mail system to terminate/o) {
4786       $Totals{'postfixwaiting'}++;
4787    }
4788    elsif (! in_ignore_list ($line)) {
4789       inc_unmatched('postfix_script');
4790    }
4791 }
4792
4793 # Clean up a server's reply, to give some uniformity to reports
4794 #
4795 sub cleanhostreply($ $ $ $) {
4796    my ($hostreply,$relay,$recip,$domain) = @_;
4797
4798    my $fmtdhost = '';
4799    my ($r1, $r2, $dsn, $msg, $host, $event);
4800
4801    #print "RELAY: $relay, RECIP: $recip, DOMAIN: $domain\n";
4802    #print "HOSTREPLY: \"$hostreply\"\n";
4803    return ('Accepted', '*unknown')  if $hostreply =~ /^25\d/o;
4804
4805    # Host or domain name not found. Name service error for name=example.com type=MX: Host not found...
4806    if ($hostreply =~ /^Host or domain name not found. Name service error for name=([^:]+): Host not found/o) {
4807       return ('Host not found', $1);
4808    }
4809
4810    if (($host,$dsn,$r1) = ($hostreply =~ /host (\S+) said: ($re_DSN)[\- :]*"?(.*)"?$/o)) {
4811       # Strip recipient address from host's reply - we already have it in $recip.
4812       $r1 =~ s/[<(]?\Q$recip\E[>)]?\W*//ig;
4813
4814       # Strip and capture "in reply to XYZ command" from host's reply
4815       if ($r1 =~ s/\s*[(]?(?:in reply to (.*) command)[)]?//o) {
4816          $r2 = ": $1";
4817       }
4818       $r1 =~ s/^Recipient address rejected: //o;
4819       # Canonicalize numerous forms of "recipient unknown"
4820       if (   $r1 =~ /^user unknown/i
4821           or $r1 =~ /^unknown user/i
4822           or $r1 =~ /^unknown recipient address/i
4823           or $r1 =~ /^invalid recipient/i
4824           or $r1 =~ /^recipient unknown/i
4825           or $r1 =~ /^sorry, no mailbox here by that name/i
4826           or $r1 =~ /^User is unknown/
4827           or $r1 =~ /^User not known/
4828           or $r1 =~ /^MAILBOX NOT FOUND/
4829           or $r1 =~ /^Recipient Rejected: No account by that name here/
4830           or $r1 =~ /^Recipient does not exist here/
4831           or $r1 =~ /The email account that you tried to reach does not exist./ # Google's long mess
4832           or $r1 =~ /(?:no such user|user unknown)/i
4833          )
4834       {
4835          #print "UNKNOWN RECIP: $r1\n";
4836          $r1 = 'Unknown recipient';
4837       }
4838       elsif ($r1 =~ /greylisted/oi) {
4839          #print "GREYLISTED RECIP: $r1\n";
4840          $r1 = 'Recipient greylisted';
4841       }
4842       elsif ($r1 =~ /^Message temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/o) {
4843          # Yahoo: 421 Message temporarily deferred - 4.16.51. Please refer to http://... (in reply to end of DATA command))
4844          $dsn = "$dsn $1"; $r1 = "see $2";
4845       }
4846       elsif ($r1 =~ /^Resources temporarily not available - Please try again later \[#(\d\.\d+\.\d+)\]\.$/o) {
4847          #Yahoo 451 Resources temporarily not available - Please try again later [#4.16.5].
4848          $dsn = "$dsn $1"; $r1 = "resources not available";
4849       }
4850       elsif ($r1 =~ /^Message temporarily deferred - (\[\d+\])/o) {
4851          # Yahoo: 451 Message temporarily deferred - [160]
4852          $dsn = "$dsn $1"; $r1 = '';
4853       }
4854    }
4855
4856    elsif ($hostreply =~ /^connect to (\S+): (.*)$/o) {
4857       #print "CONNECT: $hostreply\n";
4858       $host = $1; $r1 = $2; $r1 =~ s/server refused to talk to me/refused/;
4859    }
4860
4861    elsif ($hostreply =~ /^host (\S+) refused to talk to me: (.*)$/o) {
4862       $host = $1; $msg = $2;
4863       #print "HOSTREFUSED: $hostreply\n";
4864       #Yahoo: '421 Message from (10.0.0.1) temporarily deferred - 4.16.50. Please refer to http://...
4865       if ($msg =~ /^(\d+) Message from \([^)]+\) temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/) {
4866          $dsn = "$1 $2"; $msg = "see $3";
4867       }
4868       #$r1 = join(': ', 'refused', $msg);
4869       $r1 = $msg;
4870    }
4871    elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) {
4872       #print "DELIVERY SUSP: $hostreply\n";
4873       $host = $2; $r1 = join(': ', $1, $3);
4874    }
4875    elsif ($hostreply =~ /^(delivery temporarily suspended: conversation) with (\S+) (.*)$/o) {
4876       # delivery temporarily suspended: conversation with example.com[10.0.0.1] timed out while receiving the initial server greeting)
4877       #print "DELIVERY SUSP2: $hostreply\n";
4878       $host = $2; $r1 = join(' ', $1, $3);
4879    }
4880    elsif (($event,$host,$r1) = ($hostreply =~ /^(lost connection|conversation) with (\S+) (.*)$/o)) {
4881       #print "LOST conv/conn: $hostreply\n";
4882       $r1 = join(' ',$event,$r1);
4883    }
4884    elsif ($hostreply =~ /^(.*: \S+maildrop: Unable to create a dot-lock) at .*$/o) {
4885       #print "MAILDROP: $hostreply\n";
4886       $r1 = $1;
4887    }
4888    elsif ($hostreply =~ /^mail for (\S+) loops back to myself/o) {
4889       #print "LOOP: $hostreply\n";
4890       $host = $1; $r1 = 'mailer loop';
4891    }
4892    elsif ($hostreply =~ /^unable to find primary relay for (\S+)$/o) {
4893       #print "NORELAY: $hostreply\n";
4894       $host = $1; $r1 = 'no relay found';
4895    }
4896    elsif ($hostreply =~ /^message size \d+ exceeds size limit \d+ of server (\S+)\s*$/o) {
4897       #print "TOOBIG: $hostreply\n";
4898       $host = $1; $r1 = 'message too big';
4899    }
4900    else {
4901       #print "UNMATCH: $hostreply\n";
4902       $r1 = $hostreply;
4903    }
4904
4905    #print "R1: $r1, R2: $r2\n";
4906    $r1 =~ s/for name=\Q$domain\E //ig;
4907
4908    if ($host eq '') {
4909       if ($relay =~ /([^[]+)\[([^]]+)\]/) {
4910          $fmtdhost = formathost($2,$1);
4911       }
4912       else {
4913          $fmtdhost = '*unknown';
4914       }
4915    }
4916    elsif ($host =~ /^([^[]+)\[([^]]+)\]/) {
4917       $fmtdhost = formathost($2,$1);
4918    }
4919    else {
4920       $fmtdhost = $host;
4921    }
4922
4923    return (($dsn ? "$dsn " : '' ) . "\u$r1$r2", $fmtdhost);
4924 }
4925
4926 # Strip and return from, to, proto, and helo information from a log line
4927 # From is set to the empty envelope sender <> as necessary, and To is
4928 # always lowercased.
4929 #
4930 # Note: modifies its input for efficiency
4931 #
4932 sub strip_ftph($) {
4933    my ($helo, $proto, $to, $from);
4934    #print "strip_ftph: '$_[0]\n";
4935    $helo  =    ($_[0] =~ s/\s+helo=<(.*?)>\s*$//) == 1 ? $1               : '*unavailable';
4936    $proto =    ($_[0] =~ s/\s+proto=(\S+)\s*$//)  == 1 ? $1               : '*unavailable';
4937    $to    =    ($_[0] =~ s/\s+to=<(.*?)>\s*$//)   == 1 ? (lc($1) || '<>') : '*unavailable';
4938    $from  =    ($_[0] =~ s/\s+from=<(.*?)>\s*$//) == 1 ? (   $1  || '<>') : '*unavailable';
4939
4940    #print "helo: $helo, proto: $proto, to: $to, from: $from\n";
4941    #print "strip_ftph: final: '$_[0]'\n";
4942    return ($from,$to,$proto,$helo);
4943 }
4944
4945 # Initialize the Getopts option list.  Requires the Section table to
4946 # be built already.
4947 #
4948 sub init_getopts_table() {
4949    print "init_getopts_table: enter\n"  if $Opts{'debug'} & Logreporters::D_ARGS;
4950
4951    init_getopts_table_common(@supplemental_reports);
4952
4953    add_option ('recipient_delimiter=s');
4954    add_option ('delays!');
4955    add_option ('show_delays=i',             sub { $Opts{'delays'} = $_[1]; 1; });
4956    add_option ('delays_percentiles=s');
4957    add_option ('reject_reply_patterns=s');
4958    add_option ('ignore_services=s');
4959    add_option ('postgrey_delays!');
4960    add_option ('postgrey_show_delays=i',    sub { $Opts{'postgrey_delays'} = $_[1]; 1; });
4961    add_option ('postgrey_delays_percentiles=s');
4962    add_option ('unknown!',                  sub { $Opts{'unknown'} = $_[1]; 1; });
4963    add_option ('show_unknown=i',            sub { $Opts{'unknown'} = $_[1]; 1; });
4964    add_option ('enable_long_queue_ids=i',   sub { $Opts{'long_queue_ids'} = $_[1]; 1; });
4965    add_option ('long_queue_ids!');
4966
4967 =pod
4968    # aliases and backwards compatibility
4969    add_option ('msgsdeferred=s',            \$Opts{'deferred'});
4970    add_option ('msgsdelivered=s',           \$Opts{'delivered'});
4971    add_option ('msgssent=s',                \$Opts{'sent'});
4972    add_option ('msgssentlmtp=s',            \$Opts{'sentlmtp'});
4973    add_option ('msgsforwarded=s',           \$Opts{'forwarded'});
4974    add_option ('msgsresent=s',              \$Opts{'resent'});
4975    add_option ('warn=s',                    \$Opts{'warned'});
4976    add_option ('held=s',                    \$Opts{'hold'});
4977 =cut
4978 }
4979
4980 # Builds the entire @Section table used for data collection
4981 #
4982 # Each Section entry has as many as six fields:
4983 #
4984 #   1. Section array reference
4985 #   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
4986 #   3. Output in Detail report? (must also a %Counts accumulator)
4987 #   4. Numeric output format specifier for Summary report
4988 #   5. Section title for Summary and Detail reports
4989 #   6. A hash to a divisor used to calculate the percentage of a total for that key
4990 #
4991 # Use begin_section_group/end_section_group to create groupings around sections.
4992 #
4993 # Sections can be freely reordered if desired, but maintain proper group nesting.
4994 #
4995 #
4996 # The reject* entries of this table are dynamic, in that they are built based
4997 # upon the value of $Opts{'reject_reply_patterns'}, which can be specified by
4998 # either command line or configuration file.  This allows various flavors, of
4999 # reject sections based on SMTP reply code (eg. 421 45x, 5xx, etc.).  Instead
5000 # of creating special sections for each reject variant, the primary key of each
5001 # reject section could have been the SMTP reply code.  However, this would
5002 # require special-case processing to distinguish 4xx temporary rejects from 5xx
5003 # permanent rejects in various Totals{'totalrejects*'} counts, and in the
5004 # Totals{'totalrejects'} tally.
5005 #
5006 # Sections can be freely reordered if desired.
5007 sub build_sect_table() {
5008    if ($Opts{'debug'} & Logreporters::D_SECT) {
5009       print "build_sect_table: enter\n";
5010       print "\treject patterns: $Opts{'reject_reply_patterns'}\n";
5011    }
5012    my $S = \@Sections;
5013
5014    # References to these are used in the Sections table below; we'll predeclare them.
5015    $Totals{'totalrejects'} = 0;
5016    $Totals{'totalrejectswarn'} = 0;
5017    $Totals{'totalacceptplusreject'} = 0;
5018
5019    # Configuration and critical errors appear first
5020
5021    #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
5022    begin_section_group ($S, 'warnings');
5023    add_section ($S, 'panicerror',                  1, 'd', '*Panic:   General panic');
5024    add_section ($S, 'fatalfiletoobig',             0, 'd', '*Fatal:   Message file too big');
5025    add_section ($S, 'fatalconfigerror',            1, 'd', '*Fatal:   Configuration error');
5026    add_section ($S, 'fatalerror',                  1, 'd', '*Fatal:   General fatal');
5027    add_section ($S, 'error',                       1, 'd', '*Error:   General error');
5028    add_section ($S, 'processlimit',                1, 'd', '*Warning: Process limit reached, clients may delay');
5029    add_section ($S, 'warnfiletoobig',              0, 'd', '*Warning: Queue file size limit exceeded');
5030    add_section ($S, 'warninsufficientspace',       0, 'd', '*Warning: Insufficient system storage error');
5031    add_section ($S, 'warnconfigerror',             1, 'd', '*Warning: Server configuration error');
5032    add_section ($S, 'queuewriteerror',             1, 'd', '*Warning: Error writing queue file');
5033    add_section ($S, 'messagewriteerror',           1, 'd', '*Warning: Error writing message file');
5034    add_section ($S, 'databasegeneration',          1, 'd', '*Warning: Database is older than source file');
5035    add_section ($S, 'mailerloop',                  1, 'd', '*Warning: Mailer loop');
5036    add_section ($S, 'startuperror',                1, 'd', '*Warning: Startup error');
5037    add_section ($S, 'mapproblem',                  1, 'd', '*Warning: Map lookup problem');
5038    add_section ($S, 'attrerror',                   1, 'd', '*Warning: Error reading attribute data');
5039    add_section ($S, 'anvil',                       1, 'd', '*Warning: Anvil limit reached');
5040    add_section ($S, 'processexit',                 1, 'd', 'Process exited');
5041    add_section ($S, 'hold',                        1, 'd', 'Placed on hold');
5042    add_section ($S, 'communicationerror',          1, 'd', 'Postfix communications error');
5043    add_section ($S, 'saslauthfail',                1, 'd', 'SASL authentication failed');
5044    add_section ($S, 'ldaperror',                   1, 'd', 'LDAP error');
5045    add_section ($S, 'warningsother',               1, 'd', 'Miscellaneous warnings');
5046    add_section ($S, 'totalrejectswarn',            0, 'd', 'Reject warnings (warn_if_reject)');
5047    end_section_group ($S, 'warnings');
5048
5049    begin_section_group ($S, 'bytes', "\n");
5050    add_section ($S, 'bytesaccepted',               0, 'Z', 'Bytes accepted ');           # Z means print scaled as in 1k, 1m, etc.
5051    add_section ($S, 'bytessentsmtp',               0, 'Z', 'Bytes sent via SMTP');
5052    add_section ($S, 'bytessentlmtp',               0, 'Z', 'Bytes sent via LMTP');
5053    add_section ($S, 'bytesdelivered',              0, 'Z', 'Bytes delivered');
5054    add_section ($S, 'bytesforwarded',              0, 'Z', 'Bytes forwarded');
5055    end_section_group ($S, 'bytes', $sep1);
5056
5057    begin_section_group ($S, 'acceptreject', "\n");
5058    begin_section_group ($S, 'acceptreject2', "\n");
5059    add_section ($S, 'msgsaccepted',                0, 'd', 'Accepted',                          \$Totals{'totalacceptplusreject'});
5060    add_section ($S, 'totalrejects',                0, 'd', 'Rejected',                          \$Totals{'totalacceptplusreject'});
5061    end_section_group ($S, 'acceptreject2', $sep2);
5062    add_section ($S, 'totalacceptplusreject',       0, 'd', 'Total',                             \$Totals{'totalacceptplusreject'});
5063    end_section_group ($S, 'acceptreject', $sep1);
5064
5065    # The various Reject sections are built dynamically based upon a list of reject reply keys,
5066    # which are user-configured via $Opts{'reject_reply_patterns'}
5067    @RejectPats = ();
5068    foreach my $rejpat (split /[ ,]/, $Opts{'reject_reply_patterns'}) {
5069       if ($rejpat !~ /^(warn|[45][\d.]{2})$/io) {
5070          print STDERR usage "Invalid pattern \"$rejpat\" in reject_reply_patterns";
5071          exit (2);
5072       }
5073       if (grep (/\Q$rejpat\E/, @RejectPats) == 0) {
5074          push @RejectPats, $rejpat
5075       }
5076       else {
5077          print STDERR "Ignoring duplicate pattern \"$rejpat\" in reject_reply_patterns\n";
5078       }
5079    }
5080    @RejectKeys = @RejectPats;
5081    for (@RejectKeys) {
5082       s/\./x/g;
5083    }
5084
5085    print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n"  if $Opts{'debug'} & Logreporters::D_SECT;
5086
5087    # Add reject variants
5088    foreach my $key (@RejectKeys) {
5089       $key   = lc($key);
5090       my $keyuc = ucfirst($key);
5091       my $totalsref = \$Totals{'totalrejects' . $key};
5092       print "\t   reject key: $key\n" if $Opts{'debug'} & Logreporters::D_SECT;
5093
5094       begin_section_group ($S, 'rejects', "\n");
5095       begin_section_group ($S, 'rejects2', "\n");
5096       add_section ($S, $key . 'rejectrelay',                 1, 'd', $keyuc . ' Reject relay denied',                $totalsref);
5097       add_section ($S, $key . 'rejecthelo',                  1, 'd', $keyuc . ' Reject HELO/EHLO',                   $totalsref);
5098       add_section ($S, $key . 'rejectdata',                  1, 'd', $keyuc . ' Reject DATA',                        $totalsref);
5099       add_section ($S, $key . 'rejectunknownuser',           1, 'd', $keyuc . ' Reject unknown user',                $totalsref);
5100       add_section ($S, $key . 'rejectrecip',                 1, 'd', $keyuc . ' Reject recipient address',           $totalsref);
5101       add_section ($S, $key . 'rejectsender',                1, 'd', $keyuc . ' Reject sender address',              $totalsref);
5102       add_section ($S, $key . 'rejectclient',                1, 'd', $keyuc . ' Reject client host',                 $totalsref);
5103       add_section ($S, $key . 'rejectunknownclient',         1, 'd', $keyuc . ' Reject unknown client host',         $totalsref);
5104       add_section ($S, $key . 'rejectunknownreverseclient',  1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref);
5105       add_section ($S, $key . 'rejectunverifiedclient',      1, 'd', $keyuc . ' Reject unverified client host',      $totalsref);
5106       add_section ($S, $key . 'rejectrbl',                   1, 'd', $keyuc . ' Reject RBL',                         $totalsref);
5107       add_section ($S, $key . 'rejectheader',                1, 'd', $keyuc . ' Reject header',                      $totalsref);
5108       add_section ($S, $key . 'rejectbody',                  1, 'd', $keyuc . ' Reject body',                        $totalsref);
5109       add_section ($S, $key . 'rejectcontent',               1, 'd', $keyuc . ' Reject content',                     $totalsref);
5110       add_section ($S, $key . 'rejectsize',                  1, 'd', $keyuc . ' Reject message size',                $totalsref);
5111       add_section ($S, $key . 'rejectmilter',                1, 'd', $keyuc . ' Reject milter',                      $totalsref);
5112       add_section ($S, $key . 'rejectproxy',                 1, 'd', $keyuc . ' Reject proxy',                       $totalsref);
5113       add_section ($S, $key . 'rejectinsufficientspace',     1, 'd', $keyuc . ' Reject insufficient space',          $totalsref);
5114       add_section ($S, $key . 'rejectconfigerror',           1, 'd', $keyuc . ' Reject server config error',         $totalsref);
5115       add_section ($S, $key . 'rejectverify',                1, 'd', $keyuc . ' Reject VRFY',                        $totalsref);
5116       add_section ($S, $key . 'rejectetrn',                  1, 'd', $keyuc . ' Reject ETRN',                        $totalsref);
5117       add_section ($S, $key . 'rejectlookupfailure',         1, 'd', $keyuc . ' Reject temporary lookup failure',    $totalsref);
5118       end_section_group ($S, 'rejects2', $sep2);
5119       add_section ($S, 'totalrejects' . $key,                0, 'd', "Total $keyuc Rejects",                         $totalsref);
5120       end_section_group ($S, 'rejects', $sep1);
5121
5122       $Totals{'totalrejects' . $key} = 0;
5123    }
5124
5125    begin_section_group ($S, 'byiprejects', "\n");
5126    add_section ($S,  'byiprejects',                 1, 'd', 'Reject by IP');
5127    end_section_group ($S, 'byiprejects');
5128
5129    begin_section_group ($S, 'general1', "\n");
5130    add_section ($S, 'connectioninbound',           1, 'd', 'Connections');
5131    add_section ($S, 'connectionlostinbound',       1, 'd', 'Connections lost (inbound)');
5132    add_section ($S, 'connectionlostoutbound',      1, 'd', 'Connections lost (outbound)');
5133    add_section ($S, 'disconnection',               0, 'd', 'Disconnections');
5134    add_section ($S, 'removedfromqueue',            0, 'd', 'Removed from queue');
5135    add_section ($S, 'delivered',                   1, 'd', 'Delivered');
5136    add_section ($S, 'sent',                        1, 'd', 'Sent via SMTP');
5137    add_section ($S, 'sentlmtp',                    1, 'd', 'Sent via LMTP');
5138    add_section ($S, 'forwarded',                   1, 'd', 'Forwarded');
5139    add_section ($S, 'resent',                      0, 'd', 'Resent');
5140    add_section ($S, 'deferred',                    1, 'd', 'Deferred');
5141    add_section ($S, 'deferrals',                   1, 'd', 'Deferrals');
5142    add_section ($S, 'bouncelocal',                 1, 'd', 'Bounced (local)');
5143    add_section ($S, 'bounceremote',                1, 'd', 'Bounced (remote)');
5144    add_section ($S, 'bouncefailed',                1, 'd', 'Bounce failure');
5145    add_section ($S, 'postscreen',                  1, 'd', 'Postscreen');
5146    add_section ($S, 'dnsblog',                     1, 'd', 'DNSBL log');
5147
5148    add_section ($S, 'envelopesenders',             1, 'd', 'Envelope senders');
5149    add_section ($S, 'envelopesenderdomains',       1, 'd', 'Envelope sender domains');
5150
5151    add_section ($S, 'bcced',                       1, 'd', 'BCCed');
5152    add_section ($S, 'filtered',                    1, 'd', 'Filtered');
5153    add_section ($S, 'redirected',                  1, 'd', 'Redirected');
5154    add_section ($S, 'discarded',                   1, 'd', 'Discarded');
5155    add_section ($S, 'prepended',                   1, 'd', 'Prepended');
5156    add_section ($S, 'replaced',                    1, 'd', 'Replaced');
5157    add_section ($S, 'warned',                      1, 'd', 'Warned');
5158
5159    add_section ($S, 'requeued',                    0, 'd', 'Requeued messages');
5160    add_section ($S, 'returnedtosender',            1, 'd', 'Expired and returned to sender');
5161    add_section ($S, 'notificationsent',            1, 'd', 'Notifications sent');
5162
5163    add_section ($S, 'policyspf',                   1, 'd', 'Policy SPF');
5164    add_section ($S, 'policydweight',               1, 'd', 'Policyd-weight');
5165    add_section ($S, 'postfwd',                     1, 'd', 'Postfwd');
5166    add_section ($S, 'postgrey',                    1, 'd', 'Postgrey');
5167    end_section_group ($S, 'general1');
5168
5169    begin_section_group ($S, 'general2', "\n");
5170    add_section ($S, 'connecttofailure',            1, 'd', 'Connection failures (outbound)');
5171    add_section ($S, 'timeoutinbound',              1, 'd', 'Timeouts (inbound)');
5172    add_section ($S, 'heloerror',                   1, 'd', 'HELO/EHLO conversations errors');
5173    add_section ($S, 'illegaladdrsyntax',           1, 'd', 'Illegal address syntax in SMTP command');
5174    add_section ($S, 'released',                    0, 'd', 'Released from hold');
5175    add_section ($S, 'rblerror',                    1, 'd', 'RBL lookup errors');
5176    add_section ($S, 'dnserror',                    1, 'd', 'DNS lookup errors');
5177    add_section ($S, 'numerichostname',             1, 'd', 'Numeric hostname');
5178    add_section ($S, 'smtpconversationerror',       1, 'd', 'SMTP dialog errors');
5179    add_section ($S, 'hostnameverification',        1, 'd', 'Hostname verification errors (FCRDNS)');
5180    add_section ($S, 'hostnamevalidationerror',     1, 'd', 'Hostname validation errors');
5181    add_section ($S, 'smtpprotocolviolation',       1, 'd', 'SMTP protocol violations');
5182    add_section ($S, 'deliverable',                 1, 'd', 'Deliverable (address verification)');
5183    add_section ($S, 'undeliverable',               1, 'd', 'Undeliverable (address verification)');
5184    add_section ($S, 'tablechanged',                0, 'd', 'Restarts due to lookup table change');
5185    add_section ($S, 'pixworkaround',               1, 'd', 'PIX workaround enabled');
5186    add_section ($S, 'tlsserverconnect',            1, 'd', 'TLS connections (server)');
5187    add_section ($S, 'tlsclientconnect',            1, 'd', 'TLS connections (client)');
5188    add_section ($S, 'saslauth',                    1, 'd', 'SASL authenticated messages');
5189    add_section ($S, 'tlsunverified',               1, 'd', 'TLS certificate unverified');
5190    add_section ($S, 'tlsoffered',                  1, 'd', 'Host offered TLS');
5191    end_section_group ($S, 'general2');
5192
5193    begin_section_group ($S, 'postfixstate', "\n");
5194    add_section ($S, 'postfixstart',                0, 'd', 'Postfix start');
5195    add_section ($S, 'postfixstop',                 0, 'd', 'Postfix stop');
5196    add_section ($S, 'postfixrefresh',              0, 'd', 'Postfix refresh');
5197    add_section ($S, 'postfixwaiting',              0, 'd', 'Postfix waiting to terminate');
5198    end_section_group ($S, 'postfixstate');
5199
5200
5201    if ($Opts{'debug'} & Logreporters::D_SECT) {
5202       print "\tSection table\n";
5203       printf "\t\t%s\n", (ref($_) eq 'HASH' ? $_->{NAME} : $_) foreach @Sections;
5204       print "build_sect_table: exit\n"
5205    }
5206 }
5207
5208 # XXX create array of defaults for detail <5, 5-9, >10
5209 sub init_defaults() {
5210    map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
5211    if (! $Opts{'standalone'}) {
5212       # LOGWATCH
5213       # these take affect if no env present (eg. nothing in conf file)
5214       # 0 to 4 nodelays
5215
5216       if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
5217          $Opts{'delays'}            = 0;
5218          $Opts{'postgrey_delays'}   = 0;
5219       }
5220    }
5221 }
5222
5223
5224 # XXX ensure something is matched?
5225 # XXX cache values so we don't have to substitute X for . each time
5226 #match $dsn against list for best fit
5227 sub get_reject_key($) {
5228    my $reply = shift;
5229    my $replyorig = $reply;
5230    ($reply) = split / /, $reply;
5231    for (my $i = 0; $i <= $#RejectPats; $i++) {
5232       #print "TRYING: $RejectPats[$i]\n";
5233       # we'll allow extended DSNs to match (eg. 5.7.1 will match 5..)
5234       if ($reply =~ /^$RejectPats[$i]/) {    # no /o here, pattern varies
5235          #print "MATCHED: orig: $replyorig, reply $reply matched pattern $RejectPats[$i], returning $RejectKeys[$i]\n";
5236          return $RejectKeys[$i];
5237       }
5238    }
5239    #print "NOT MATCHED: REPLY CODE: '$replyorig', '$reply'\n";
5240    return;
5241 }
5242
5243 # Replace bare reject limiters with specific reject limiters
5244 # based on reject_reply_patterns
5245 #
5246 sub expand_bare_reject_limiters()
5247 {
5248   # don't reorder the list of limiters.  This breaks --nodetail followed by a
5249   # bare reject such as --limit rejectrbl=10.  Reordering is no longer necessary
5250   # since process_limiters was instituted and using the special __none__ pseudo-
5251   # limiter to indicate the position at which --nodefailt was found on the command
5252   # line.
5253   # my ($limiter, @reject_limiters, @non_reject_limiters);
5254    my ($limiter, @new_list);
5255
5256    # XXX check if limiter matches just one in rejectclasses
5257    while ($limiter = shift @Limiters) {
5258       if ($limiter =~ /^reject[^_]/) {
5259          foreach my $reply_code (@RejectKeys) {
5260             printf "bare_reject: \L$reply_code$limiter\n"  if $Opts{'debug'} & Logreporters::D_VARS;
5261             #push @reject_limiters, lc($reply_code) . $limiter;
5262             push @new_list, lc($reply_code) . $limiter;
5263          }
5264       }
5265       elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) {
5266          $limiter =~ s/^([45])\.\./$1xx/;
5267          #push @reject_limiters, lc $limiter;
5268          push @new_list, lc $limiter;
5269       }
5270       else {
5271          #push @non_reject_limiters, $limiter;
5272          push @new_list, $limiter;
5273       }
5274    }
5275    #@Limiters = (@reject_limiters, @non_reject_limiters);
5276    @Limiters = @new_list;
5277 }
5278
5279
5280 # Return a usage string,  built from:
5281 #    arg1 +
5282 #    $usage_str +
5283 #    a string built from each usable entry in the @Sections table.
5284 # reject patterns are special cased to minimize the number of
5285 # command line options presented.
5286 #
5287 sub usage($) {
5288    my $ret = "";
5289    $ret = "@_\n"  if ($_[0]);
5290
5291    $ret .= $usage_str;
5292    my ($name, $desc, %reject_types);
5293    foreach my $sect (get_usable_sectvars(@Sections, 0)) {
5294
5295       if (my ($code,$rej) = ($sect->{NAME} =~ /^(...|warn)(reject.*)$/oi)) {
5296          $rej = lc $rej;
5297          next if (exists $reject_types{$rej});
5298          $reject_types{$rej}++;
5299          $name = '[###]' . $rej;
5300          $desc = '###' . substr($sect->{TITLE}, length($code));
5301       }
5302       else {
5303          $name = lc $sect->{NAME};
5304          $desc = $sect->{TITLE};
5305       }
5306       $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
5307    }
5308    $ret .= "\n";
5309    return $ret;
5310 }
5311
5312 1;
5313
5314 # vi: shiftwidth=3 tabstop=3 syntax=perl et