postfix-logwatch

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