amavis-logwatch

   1 #!/usr/bin/perl -T
   2
   3 ##########################################################################
   4 # Amavis-logwatch: written and maintained by:
   5 #
   6 #    Mike "MrC" Cappella <mike (at) cappella (dot) us>
   7 #      http://logreporters.sourceforge.net/
   8 #
   9 # Please send all comments, suggestions, bug reports regarding this
  10 # program/module to the email address above.  I will respond as quickly
  11 # as possible. [MrC]
  12 #
  13 # Questions regarding the logwatch program itself should be directed to
  14 # the logwatch project at:
  15 #   http://sourceforge.net/projects/logwatch/support
  16 #
  17 #######################################################
  18 ### All work since Dec 12, 2006 (logwatch CVS revision 1.28)
  19 ### Copyright (c) 2006-2012  Mike Cappella
  20 ###
  21 ### Covered under the included MIT/X-Consortium License:
  22 ###    http://www.opensource.org/licenses/mit-license.php
  23 ### All modifications and contributions by other persons to
  24 ### this script are assumed to have been donated to the
  25 ### Logwatch project and thus assume the above copyright
  26 ### and licensing terms.  If you want to make contributions
  27 ### under your own copyright or a different license this
  28 ### must be explicitly stated in the contribution an the
  29 ### Logwatch project reserves the right to not accept such
  30 ### contributions.  If you have made significant
  31 ### contributions to this script and want to claim
  32 ### copyright please contact logwatch-devel@lists.sourceforge.net.
  33 ##########################################################
  34
  35 ##########################################################################
  36 # The original amavis logwatch filter was written by
  37 # Jim O'Halloran <jim @ kendle.com.au>, and has had many contributors over
  38 # the years.
  39 #
  40 # CVS log removed: see Changes file for amavis-logwatch at
  41 #    http://logreporters.sourceforge.net/
  42 # or included with the standalone amavis-logwatch distribution
  43 ##########################################################################
  44
  45 package Logreporters;
  46 use 5.008;
  47 use strict;
  48 use warnings;
  49 no warnings "uninitialized";
  50 use re 'taint';
  51
  52 our $Version         = '1.51.03';
  53 our $progname_prefix = 'amavis';
  54
  55 # Specifies the default configuration file for use in standalone mode.
  56 my $config_file = "/usr/local/etc/${progname_prefix}-logwatch.conf";
  57
  58 #MODULE: ../Logreporters/Utils.pm
  59 package Logreporters::Utils;
  60
  61 use 5.008;
  62 use strict;
  63 use re 'taint';
  64 use warnings;
  65
  66 BEGIN {
  67    use Exporter ();
  68    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  69    $VERSION = '1.003';
  70    @ISA = qw(Exporter);
  71    @EXPORT = qw(&formathost &get_percentiles &get_percentiles2 &get_frequencies &commify &unitize
  72                 &get_usable_sectvars &add_section &begin_section_group &end_section_group
  73                 &get_version &unique_list);
  74    @EXPORT_OK = qw(&gen_test_log);
  75 }
  76
  77 use subs qw (@EXPORT @EXPORT_OK);
  78
  79
  80 # Formats IP and hostname for even column spacing
  81 #
  82 sub formathost($ $) {
  83    # $_[0] : hostip
  84    # $_[1] : hostname;
  85
  86    if (! $Logreporters::Config::Opts{'unknown'} and $_[1] eq 'unknown') {
  87       return $_[0];
  88    }
  89
  90    return sprintf "%-$Logreporters::Config::Opts{'ipaddr_width'}s  %s",
  91       $_[0] eq '' ? '*unknown' :    $_[0],
  92       $_[1] eq '' ? '*unknown' : lc $_[1];
  93 }
  94
  95 # Add a new section to the end of a section table
  96 #
  97 sub add_section($$$$$;$) {
  98    my $sref = shift;
  99    die "Improperly specified Section entry: $_[0]" if !defined $_[3];
 100
 101    my $entry  = {
 102       CLASS     => 'DATA',
 103       NAME      => $_[0],
 104       DETAIL    => $_[1],
 105       FMT       => $_[2],
 106       TITLE     => $_[3],
 107    };
 108    $entry->{'DIVISOR'}   = $_[4] if defined $_[4];
 109    push @$sref, $entry;
 110 }
 111
 112 {
 113 my $group_level = 0;
 114
 115 # Begin a new section group.  Groups can nest.
 116 #
 117 sub begin_section_group($;@) {
 118    my $sref = shift;
 119    my $group_name = shift;
 120    my $entry  = {
 121       CLASS     => 'GROUP_BEGIN',
 122       NAME      => $group_name,
 123       LEVEL     => ++$group_level,
 124       HEADERS   => [ @_ ],
 125    };
 126    push @$sref, $entry;
 127 }
 128
 129 # Ends a section group.
 130 #
 131 sub end_section_group($;@) {
 132    my $sref = shift;
 133    my $group_name = shift;
 134    my $entry  = {
 135       CLASS     => 'GROUP_END',
 136       NAME      => $group_name,
 137       LEVEL     => --$group_level,
 138       FOOTERS   => [ @_ ],
 139    };
 140    push @$sref, $entry;
 141 }
 142 }
 143
 144 # Generate and return a list of section table entries or
 145 # limiter key names, skipping any formatting entries.
 146 # If 'namesonly' is set, limiter key names are returned,
 147 # otherwise an array of section array records is returned.
 148 sub get_usable_sectvars(\@ $) {
 149    my ($sectref,$namesonly) = @_;
 150    my (@sect_list, %unique_names);
 151
 152    foreach my $sref (@$sectref) {
 153       #print "get_usable_sectvars: $sref->{NAME}\n";
 154       next unless $sref->{CLASS} eq 'DATA';
 155       if ($namesonly) {
 156          $unique_names{$sref->{NAME}} = 1;
 157       }
 158       else {
 159          push @sect_list, $sref;
 160       }
 161    }
 162    # return list of unique names
 163    if ($namesonly) {
 164       return keys %unique_names;
 165    }
 166    return @sect_list;
 167 }
 168
 169 # Print program and version info, preceeded by an optional string, and exit.
 170 #
 171 sub get_version() {
 172
 173    print STDOUT "@_\n"  if ($_[0]);
 174    print STDOUT "$Logreporters::progname: $Logreporters::Version\n";
 175    exit 0;
 176 }
 177
 178
 179 # Returns a list of percentile values given a
 180 # sorted array of numeric values.  Uses the formula:
 181 #
 182 # r = 1 + (p(n-1)/100) = i + d  (Excel method)
 183 #
 184 # r = rank
 185 # p = desired percentile
 186 # n = number of items
 187 # i = integer part
 188 # d = decimal part
 189 #
 190 # Arg1 is an array ref to the sorted series
 191 # Arg2 is a list of percentiles to use
 192
 193 sub get_percentiles(\@ @) {
 194    my ($aref,@plist) = @_;
 195    my ($n, $last, $r, $d, $i, @vals, $Yp);
 196
 197    $last = $#$aref;
 198    $n = $last + 1;
 199    #printf "%6d" x $n . "\n", @{$aref};
 200
 201    #printf "n: %4d, last: %d\n", $n, $last;
 202    foreach my $p (@plist) {
 203       $r = 1 + ($p * ($n - 1) / 100.0);
 204       $i = int ($r);            # integer part
 205       # domain: $i = 1 .. n
 206       if ($i == $n) {
 207         $Yp = $aref->[$last];
 208       }
 209       elsif ($i == 0) {
 210         $Yp = $aref->[0];
 211         print "CAN'T HAPPEN: $Yp\n";
 212       }
 213       else {
 214          $d = $r - $i;          # decimal part
 215          #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
 216          $Yp = $aref->[$i-1] + ($d * ($aref->[$i] - $aref->[$i-1]));
 217       }
 218       #printf "\np(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d", $p, $r, $i, $d, $Yp;
 219       push @vals, $Yp;
 220    }
 221
 222    return @vals;
 223 }
 224
 225 sub get_num_scores($) {
 226    my $scoretab_r = shift;
 227
 228    my $totalscores = 0;
 229
 230    for (my $i = 0; $i < @$scoretab_r; $i += 2) {
 231       $totalscores += $scoretab_r->[$i+1]
 232    }
 233
 234    return $totalscores;
 235 }
 236
 237 # scoretab
 238 #
 239 #  (score1, n1), (score2, n2), ... (scoreN, nN)
 240 #     $i   $i+1
 241 #
 242 # scores are 0 based (0 = 1st score)
 243 sub get_nth_score($ $) {
 244    my ($scoretab_r, $n) = @_;
 245
 246    my $i = 0;
 247    my $n_cur_scores = 0;
 248    #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";
 249
 250    while ($i < $#$scoretab_r) {
 251       #print "Samples_seen: $n_cur_scores\n";
 252       $n_cur_scores += $scoretab_r->[$i+1];
 253       if ($n_cur_scores >= $n) {
 254          #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];
 255          #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];
 256          return $scoretab_r->[$i];
 257       }
 258
 259       $i += 2;
 260    }
 261    print "returning last score $scoretab_r->[$i]\n";
 262    return $scoretab_r->[$i];
 263 }
 264
 265 sub get_percentiles2(\@ @) {
 266    my ($scoretab_r, @plist) = @_;
 267    my ($n, $last, $r, $d, $i, @vals, $Yp);
 268
 269    #$last = $#$scoretab_r - 1;
 270    $n = get_num_scores($scoretab_r);
 271    #printf "\n%6d" x $n . "\n", @{$scoretab_r};
 272
 273    #printf "\n\tn: %4d, @$scoretab_r\n", $n;
 274    foreach my $p (@plist) {
 275   ###print "\nPERCENTILE: $p\n";
 276       $r = 1 + ($p * ($n - 1) / 100.0);
 277       $i = int ($r);            # integer part
 278       if ($i == $n) {
 279         #print "last:\n";
 280         #$Yp = $scoretab_r->[$last];
 281         $Yp = get_nth_score($scoretab_r, $n);
 282       }
 283       elsif ($i == 0) {
 284         #$Yp = $scoretab_r->[0];
 285         print "1st: CAN'T HAPPEN\n";
 286         $Yp = get_nth_score($scoretab_r, 1);
 287       }
 288       else {
 289          $d = $r - $i;          # decimal part
 290          #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
 291          my $ithvalprev = get_nth_score($scoretab_r, $i);
 292          my $ithval     = get_nth_score($scoretab_r, $i+1);
 293          $Yp = $ithvalprev + ($d * ($ithval - $ithvalprev));
 294       }
 295       #printf "p(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d\n", $p, $r, $i, $d, $Yp;
 296       push @vals, $Yp;
 297    }
 298
 299    return @vals;
 300 }
 301
 302
 303
 304 # Returns a list of frequency distributions given an incrementally sorted
 305 # set of sorted scores, and an incrementally sorted list of buckets
 306 #
 307 # Arg1 is an array ref to the sorted series
 308 # Arg2 is a list of frequency buckets to use
 309 sub get_frequencies(\@ @) {
 310    my ($aref,@blist) = @_;
 311
 312    my @vals = ( 0 ) x (@blist);
 313    my @sorted_blist = sort { $a <=> $b } @blist;
 314    my $bucket_index = 0;
 315
 316 OUTER: foreach my $score (@$aref) {
 317       #print "Score: $score\n";
 318       for my $i ($bucket_index .. @sorted_blist - 1) {
 319          #print "\tTrying Bucket[$i]: $sorted_blist[$i]\n";
 320          if ($score > $sorted_blist[$i]) {
 321             $bucket_index++;
 322          }
 323          else {
 324             #printf "\t\tinto Bucket[%d]\n", $bucket_index;
 325             $vals[$bucket_index]++;
 326             next OUTER;
 327          }
 328       }
 329       #printf "\t\tinto Bucket[%d]\n", $bucket_index - 1;
 330       $vals[$bucket_index - 1]++;
 331    }
 332
 333    return @vals;
 334 }
 335
 336 # Inserts commas in numbers for easier readability
 337 #
 338 sub commify ($) {
 339     return undef if ! defined ($_[0]);
 340
 341     my $text = reverse $_[0];
 342     $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
 343     return scalar reverse $text;
 344 }
 345
 346 # Unitize a number, and return appropriate printf formatting string
 347 #
 348 sub unitize($ $) {
 349    my ($num, $fmt) = @_;
 350    my $kilobyte = 2**10;
 351    my $megabyte = 2**20;
 352    my $gigabyte = 2**30;
 353    my $terabyte = 2**40;
 354
 355    if ($num >= $terabyte) {
 356       $num /= $terabyte;
 357       $fmt .= '.3fT';
 358    } elsif ($num >= $gigabyte) {
 359       $num /= $gigabyte;
 360       $fmt .= '.3fG';
 361    } elsif ($num >= $megabyte) {
 362       $num /= $megabyte;
 363       $fmt .= '.3fM';
 364    } elsif ($num >= $kilobyte) {
 365       $num /= $kilobyte;
 366       $fmt .= '.3fK';
 367    } else {
 368       $fmt .= 'd ';
 369    }
 370
 371    return ($num, $fmt);
 372 }
 373
 374 # Returns a sublist of the supplied list of elements in an unchanged order,
 375 # where only the first occurrence of each defined element is retained
 376 # and duplicates removed
 377 #
 378 # Borrowed from amavis 2.6.2
 379 #
 380 sub unique_list(@) {
 381    my ($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_;  # accept list, or a list ref
 382    my (%seen);
 383    my (@unique) = grep { defined($_) && !$seen{$_}++ } @$r;
 384
 385    return @unique;
 386 }
 387
 388 # Generate a test maillog file from the '#TD' test data lines
 389 # The test data file is placed in /var/tmp/maillog.autogen
 390 #
 391 # arg1: "postfix" or "amavis"
 392 # arg2: path to postfix-logwatch or amavis-logwatch from which to read '#TD' data
 393 #
 394 # Postfix TD syntax:
 395 #    TD<service><QID>(<count>) log entry
 396 #
 397 sub gen_test_log($) {
 398    my $scriptpath = shift;
 399
 400    my $toolname = $Logreporters::progname_prefix;
 401    my $datafile = "/var/tmp/maillog-${toolname}.autogen";
 402
 403    die "gen_test_log: invalid toolname $toolname"  if ($toolname !~ /^(postfix|amavis)$/);
 404
 405    eval {
 406       require Sys::Hostname;
 407       require Fcntl;
 408    } or die "Unable to create test data file: required module(s) not found\n$@";
 409
 410    my $syslogtime = localtime;
 411    $syslogtime =~ s/^....(.*) \d{4}$/$1/;
 412
 413    my ($hostname) = split /\./, Sys::Hostname::hostname();
 414
 415   # # avoid -T issues
 416   # delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 417
 418    my $flags = &Fcntl::O_CREAT|&Fcntl::O_WRONLY|&Fcntl::O_TRUNC;
 419    sysopen(FH, $datafile, $flags) or die "Can't create test data file: $!";
 420    print "Generating test log data file from $scriptpath: $datafile\n";
 421
 422    my $id;
 423    @ARGV = ($scriptpath);
 424    if ($toolname eq 'postfix') {
 425       my %services = (
 426           DEF   => 'smtpd',
 427           bQ    => 'bounce',
 428           cN    => 'cleanup',
 429           cQ    => 'cleanup',
 430           lQ    => 'local',
 431           m     => 'master',
 432           p     => 'pickup',
 433           pQ    => 'pickup',
 434           ppQ   => 'pipe',
 435           pfw   => 'postfwd',
 436           pg    => 'postgrey',
 437           pgQ   => 'postgrey',
 438           ps    => 'postsuper',
 439           qQ    => 'qmgr',
 440           s     => 'smtp',
 441           sQ    => 'smtp',
 442           sd    => 'smtpd',
 443           sdN   => 'smtpd',
 444           sdQ   => 'smtpd',
 445           spf   => 'policy-spf',
 446           vN    => 'virtual',
 447           vQ    => 'virtual',
 448       );
 449       $id = 'postfix/smtp[12345]';
 450
 451       while (<>) {
 452          if (/^\s*#TD([a-zA-Z]*[NQ]?)(\d+)?(?:\(([^)]+)\))? (.*)$/) {
 453             my ($service,$count,$qid,$line) = ($1, $2, $3, $4);
 454
 455             #print "SERVICE: %s, QID: %s, COUNT: %s, line: %s\n", $service, $qid, $count, $line;
 456
 457             if ($service eq '') {
 458                $service = 'DEF';
 459             }
 460             die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
 461
 462             $id = $services{$service} . '[123]';
 463             $id = 'postfix/' . $id    unless $services{$service} eq 'postgrey';
 464             #print "searching for service: \"$service\"\n\tFound $id\n";
 465             if    ($service =~ /N$/) { $id .= ': NOQUEUE'; }
 466             elsif ($service =~ /Q$/) { $id .= $qid ? $qid : ': DEADBEEF'; }
 467
 468             $line =~ s/ +/ /g;
 469             $line =~ s/^ //g;
 470             #print "$syslogtime $hostname $id: \"$line\"\n" x ($count ? $count : 1);
 471             print FH "$syslogtime $hostname $id: $line\n" x ($count ? $count : 1);
 472          }
 473       }
 474    }
 475    else { #amavis
 476       my %services = (
 477           DEF   => 'amavis',
 478           dcc   => 'dccproc',
 479       );
 480       while (<>) {
 481          if (/^\s*#TD([a-z]*)(\d+)? (.*)$/) {
 482             my ($service,$count,$line) = ($1, $2, $3);
 483             if ($service eq '') {
 484                $service = 'DEF';
 485             }
 486             die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
 487             $id = $services{$service} . '[123]:';
 488             if ($services{$service} eq 'amavis') {
 489                $id .= ' (9999-99)';
 490             }
 491             print FH "$syslogtime $hostname $id $line\n" x ($count ? $count : 1)
 492          }
 493       }
 494    }
 495
 496    close FH or die "Can't close $datafile: $!";
 497 }
 498
 499 1;
 500
 501 #MODULE: ../Logreporters/Config.pm
 502 package Logreporters::Config;
 503
 504 use 5.008;
 505 use strict;
 506 use re 'taint';
 507 use warnings;
 508
 509
 510 BEGIN {
 511    use Exporter ();
 512    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 513    $VERSION = '1.002';
 514    @ISA = qw(Exporter);
 515    @EXPORT = qw(&init_run_mode &add_option &get_options &init_cmdline &get_vars_from_file
 516                 &process_limiters &process_debug_opts &init_getopts_table_common &zero_opts
 517                 @Optspec %Opts %Configvars @Limiters %line_styles $fw1 $fw2 $sep1 $sep2
 518                 &D_CONFIG &D_ARGS &D_VARS &D_TREE &D_SECT &D_UNMATCHED &D_TEST &D_ALL
 519              );
 520 }
 521
 522 use subs @EXPORT;
 523
 524 our  @Optspec = ();      # options table used by Getopts
 525
 526 our %Opts = ();         # program-wide options
 527 our %Configvars = ();   # configuration file variables
 528 our @Limiters;
 529
 530 # Report separator characters and widths
 531 our ($fw1,$fw2)   = (22, 10);
 532 our ($sep1,$sep2) = ('=', '-');
 533
 534 use Getopt::Long;
 535
 536
 537 BEGIN {
 538    import Logreporters::Utils qw(&get_usable_sectvars);
 539 }
 540
 541 our %line_styles = (
 542    truncate => 0,
 543    wrap     => 1,
 544    full     => 2,
 545 );
 546
 547 sub init_run_mode($);
 548 sub confighash_to_cmdline(\%);
 549 sub get_vars_from_file(\% $);
 550 sub process_limiters(\@);
 551 sub add_option(@);
 552 sub get_options($);
 553 sub init_getopts_table_common(@);
 554 sub set_supplemental_reports($$);
 555 # debug constants
 556 sub D_CONFIG ()    { 1<<0 }
 557 sub D_ARGS ()      { 1<<1 }
 558 sub D_VARS ()      { 1<<2 }
 559 sub D_TREE ()      { 1<<3 }
 560 sub D_SECT ()      { 1<<4 }
 561 sub D_UNMATCHED () { 1<<5 }
 562
 563 sub D_TEST ()      { 1<<30 }
 564 sub D_ALL ()       { 1<<31 }
 565
 566 my %debug_words = (
 567    config     => D_CONFIG,
 568    args       => D_ARGS,
 569    vars       => D_VARS,
 570    tree       => D_TREE,
 571    sect       => D_SECT,
 572    unmatched  => D_UNMATCHED,
 573
 574    test       => D_TEST,
 575    all        => 0xffffffff,
 576 );
 577
 578 # Clears %Opts hash and initializes basic running mode options in
 579 # %Opts hash by setting keys: 'standalone', 'detail', and 'debug'.
 580 # Call early.
 581 #
 582 sub init_run_mode($) {
 583    my $config_file = shift;
 584    $Opts{'debug'} = 0;
 585
 586    # Logwatch passes a filter's options via environment variables.
 587    # When running standalone (w/out logwatch), use command line options
 588    $Opts{'standalone'} = exists ($ENV{LOGWATCH_DETAIL_LEVEL}) ? 0 : 1;
 589
 590    # Show summary section by default
 591    $Opts{'summary'} = 1;
 592
 593    if ($Opts{'standalone'}) {
 594       process_debug_opts($ENV{'LOGREPORTERS_DEBUG'}) if exists ($ENV{'LOGREPORTERS_DEBUG'});
 595    }
 596    else {
 597       $Opts{'detail'} = $ENV{'LOGWATCH_DETAIL_LEVEL'};
 598       # XXX
 599       #process_debug_opts($ENV{'LOGWATCH_DEBUG'}) if exists ($ENV{'LOGWATCH_DEBUG'});
 600    }
 601
 602    # first process --debug, --help, and --version options
 603    add_option ('debug=s',                   sub { process_debug_opts($_[1]); 1});
 604    add_option ('version',                   sub { &Logreporters::Utils::get_version(); 1;});
 605    get_options(1);
 606
 607    # now process --config_file, so that all config file vars are read first
 608    add_option ('config_file|f=s',           sub { get_vars_from_file(%Configvars, $_[1]); 1;});
 609    get_options(1);
 610
 611    # if no config file vars were read
 612    if ($Opts{'standalone'} and ! keys(%Configvars) and -f $config_file) {
 613       print "Using default config file: $config_file\n" if $Opts{'debug'} & D_CONFIG;
 614       get_vars_from_file(%Configvars, $config_file);
 615    }
 616 }
 617
 618 sub get_options($) {
 619    my $pass_through = shift;
 620    #$SIG{__WARN__} = sub { print "*** $_[0]*** options error\n" };
 621    # ensure we're called after %Opts is initialized
 622    die "get_options: program error: %Opts is emtpy" unless exists $Opts{'debug'};
 623
 624    my $p = new Getopt::Long::Parser;
 625
 626    if ($pass_through) {
 627       $p->configure(qw(pass_through permute));
 628    }
 629    else {
 630       $p->configure(qw(no_pass_through no_permute));
 631    }
 632    #$p->configure(qw(debug));
 633
 634    if ($Opts{'debug'} & D_ARGS) {
 635       print "\nget_options($pass_through): enter\n";
 636       printf "\tARGV(%d): ", scalar @ARGV;
 637       print @ARGV, "\n";
 638       print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
 639    }
 640
 641    if ($p->getoptions(\%Opts, @Optspec) == 0) {
 642       print STDERR "Use ${Logreporters::progname} --help for options\n";
 643       exit 1;
 644    }
 645    if ($Opts{'debug'} & D_ARGS) {
 646       print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
 647       printf "\tARGV(%d): ", scalar @ARGV;
 648       print @ARGV, "\n";
 649       print "get_options: exit\n";
 650    }
 651 }
 652
 653 sub add_option(@) {
 654    push @Optspec, @_;
 655 }
 656
 657 # untaint string, borrowed from amavisd-new
 658 sub untaint($) {
 659    no re 'taint';
 660
 661    my ($str);
 662    if (defined($_[0])) {
 663       local($1);            # avoid Perl taint bug: tainted global $1 propagates taintedness
 664       $str = $1  if $_[0] =~ /^(.*)$/;
 665    }
 666
 667    return $str;
 668 }
 669
 670 sub init_getopts_table_common(@) {
 671    my @supplemental_reports = @_;
 672
 673    print "init_getopts_table_common: enter\n"   if $Opts{'debug'} & D_ARGS;
 674
 675    add_option ('help',                       sub { print STDOUT Logreporters::usage(undef); exit 0 });
 676    add_option ('gen_test_log=s',             sub { Logreporters::Utils::gen_test_log($_[1]); exit 0; });
 677    add_option ('detail=i');
 678    add_option ('nodetail',                   sub {
 679       # __none__ will set all limiters to 0 in process_limiters
 680       # since they are not known (Sections table is not yet built).
 681       push @Limiters, '__none__';
 682       # 0 = disable supplemental_reports
 683       set_supplemental_reports(0, \@supplemental_reports);
 684    });
 685    add_option ('max_report_width=i');
 686    add_option ('summary!');
 687    add_option ('show_summary=i',             sub { $Opts{'summary'} = $_[1]; 1; });
 688    # untaint ipaddr_width for use w/sprintf() in Perl v5.10
 689    add_option ('ipaddr_width=i',             sub { $Opts{'ipaddr_width'} = untaint ($_[1]); 1; });
 690
 691    add_option ('sect_vars!');
 692    add_option ('show_sect_vars=i',           sub { $Opts{'sect_vars'} = $_[1]; 1; });
 693
 694    add_option ('syslog_name=s');
 695    add_option ('wrap',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 696    add_option ('full',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 697    add_option ('truncate',                   sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
 698    add_option ('line_style=s',               sub {
 699       my $style = lc($_[1]);
 700       my @list = grep (/^$style/, keys %line_styles);
 701       if (! @list) {
 702          print STDERR "Invalid line_style argument \"$_[1]\"\n";
 703          print STDERR "Option line_style argument must be one of \"wrap\", \"full\", or \"truncate\".\n";
 704          print STDERR "Use $Logreporters::progname --help for options\n";
 705          exit 1;
 706       }
 707       $Opts{'line_style'} = $line_styles{lc($list[0])};
 708       1;
 709    });
 710
 711    add_option ('limit|l=s',                 sub {
 712       my ($limiter,$lspec) = split(/=/, $_[1]);
 713       if (!defined $lspec) {
 714          printf STDERR "Limiter \"%s\" requires value (ex. --limit %s=10)\n", $_[1],$_[1];
 715          exit 2;
 716       }
 717       foreach my $val (split(/(?:\s+|\s*,\s*)/, $lspec)) {
 718          if ($val !~ /^\d+$/ and
 719              $val !~ /^(\d*)\.(\d+)$/ and
 720              $val !~ /^::(\d+)$/ and
 721              $val !~ /^:(\d+):(\d+)?$/ and
 722              $val !~ /^(\d+):(\d+)?:(\d+)?$/)
 723          {
 724             printf STDERR "Limiter value \"$val\" invalid in \"$limiter=$lspec\"\n";
 725             exit 2;
 726          }
 727       }
 728       push @Limiters, lc $_[1];
 729    });
 730
 731    print "init_getopts_table_common: exit\n"   if $Opts{'debug'} & D_ARGS;
 732 }
 733
 734 sub get_option_names() {
 735    my (@ret, @tmp);
 736    foreach (@Optspec) {
 737       if (ref($_) eq '') {       # process only the option names
 738          my $spec = $_;
 739          $spec =~ s/=.*$//;
 740          $spec =~ s/([^|]+)\!$/$1|no$1/g;
 741          @tmp = split /[|]/, $spec;
 742          #print "PUSHING: @tmp\n";
 743          push @ret, @tmp;
 744       }
 745    }
 746    return @ret;
 747 }
 748
 749 # Set values for the configuration variables passed via hashref.
 750 # Variables are of the form ${progname_prefix}_KEYNAME.
 751 #
 752 # Because logwatch lowercases all config file entries, KEYNAME is
 753 # case-insensitive.
 754 #
 755 sub init_cmdline() {
 756    my ($href, $configvar, $value, $var);
 757
 758    # logwatch passes all config vars via environment variables
 759    $href = $Opts{'standalone'} ? \%Configvars : \%ENV;
 760
 761    # XXX: this is cheeze: need a list of valid limiters, but since
 762    # the Sections table is not built yet, we don't know what is
 763    # a limiter and what is an option, as there is no distinction in
 764    # variable names in the config file (perhaps this should be changed).
 765    my @valid_option_names = get_option_names();
 766    die "Options table not yet set" if ! scalar @valid_option_names;
 767
 768    print "confighash_to_cmdline: @valid_option_names\n"  if $Opts{'debug'} & D_ARGS;
 769    my @cmdline = ();
 770    while (($configvar, $value) = each %$href) {
 771       if ($configvar =~ s/^${Logreporters::progname_prefix}_//o) {
 772          # distinguish level limiters from general options
 773          # would be easier if limiters had a unique prefix
 774          $configvar = lc $configvar;
 775          my $ret = grep (/^$configvar$/i, @valid_option_names);
 776          if ($ret == 0) {
 777             print "\tLIMITER($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
 778             push @cmdline, '-l', "$configvar" . "=$value";
 779          }
 780          else {
 781             print "\tOPTION($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
 782             unshift @cmdline, $value  if defined ($value);
 783             unshift @cmdline, "--$configvar";
 784          }
 785       }
 786    }
 787    unshift @ARGV, @cmdline;
 788 }
 789
 790 # Obtains the variables from a logwatch-style .conf file, for use
 791 # in standalone mode.  Returns an ENV-style hash of key/value pairs.
 792 #
 793 sub get_vars_from_file(\% $) {
 794    my ($href, $file) = @_;
 795    my ($var, $val);
 796
 797    print "get_vars_from_file: enter: processing file: $file\n" if $Opts{'debug'} & D_CONFIG;
 798
 799    my  $message = undef;
 800    my $ret = stat ($file);
 801    if ($ret == 0) { $message = $!; }
 802    elsif (! -r _) { $message = "Permission denied"; }
 803    elsif (  -d _) { $message = "Is a directory"; }
 804    elsif (! -f _) { $message = "Not a regular file"; }
 805
 806    if ($message) {
 807       print STDERR "Configuration file \"$file\": $message\n";
 808       exit 2;
 809    }
 810
 811    my $prog = $Logreporters::progname_prefix;
 812    open FILE, '<', "$file" or die "unable to open configuration file $file: $!";
 813    while (<FILE>) {
 814       chomp;
 815       next if (/^\s*$/);   # ignore all whitespace lines
 816       next if (/^\*/);     # ignore logwatch's *Service lines
 817       next if (/^\s*#/);   # ignore comment lines
 818       if (/^\s*\$(${prog}_[^=\s]+)\s*=\s*"?([^"]+)"?$/o) {
 819          ($var,$val) = ($1,$2);
 820          if    ($val =~ /^(?:no|false)$/i) { $val = 0; }
 821          elsif ($val =~ /^(?:yes|true)$/i) { $val = 1; }
 822          elsif ($val eq '')                { $var =~ s/${prog}_/${prog}_no/; $val = undef; }
 823
 824          print "\t\"$var\" => \"$val\"\n"  if $Opts{'debug'} & D_CONFIG;
 825
 826          $href->{$var} = $val;
 827       }
 828    }
 829    close FILE         or die "failed to close configuration handle for $file: $!";
 830    print "get_vars_from_file: exit\n" if $Opts{'debug'} & D_CONFIG;
 831 }
 832
 833 sub process_limiters(\@) {
 834    my ($sectref) = @_;
 835
 836    my ($limiter, $var, $val, @errors);
 837    my @l = get_usable_sectvars(@$sectref, 1);
 838
 839    if ($Opts{'debug'} & D_VARS) {
 840       print "process_limiters: enter\n";
 841       print "\tLIMITERS: @Limiters\n";
 842    }
 843    while ($limiter = shift @Limiters) {
 844       my @matched = ();
 845
 846       printf "\t%-30s  ",$limiter   if $Opts{'debug'} & D_VARS;
 847       # disable all limiters when limiter is __none__: see 'nodetail' cmdline option
 848       if ($limiter eq '__none__') {
 849          $Opts{$_} = 0 foreach @l;
 850          next;
 851       }
 852
 853       ($var,$val) = split /=/, $limiter;
 854
 855       if ($val eq '') {
 856          push @errors, "Limiter \"$var\" requires value (ex. --limit limiter=10)";
 857          next;
 858       }
 859
 860       # try exact match first, then abbreviated match next
 861       if (scalar (@matched = grep(/^$var$/, @l)) == 1 or scalar (@matched = grep(/^$var/, @l)) == 1) {
 862          $limiter = $matched[0];    # unabbreviate limiter
 863          print "MATCH: $var: $limiter => $val\n" if $Opts{'debug'} & D_VARS;
 864          # XXX move limiters into section hash entry...
 865          $Opts{$limiter} = $val;
 866          next;
 867       }
 868       print "matched=", scalar @matched, ": @matched\n" if $Opts{'debug'} & D_VARS;
 869
 870       push @errors, "Limiter \"$var\" is " . (scalar @matched == 0 ? "invalid" : "ambiguous: @matched");
 871    }
 872    print "\n" if $Opts{'debug'} & D_VARS;
 873
 874    if (@errors) {
 875       print STDERR "$_\n" foreach @errors;
 876       exit 2;
 877    }
 878
 879    # Set the default value of 10 for each section if no limiter exists.
 880    # This allows output for each section should there be no configuration
 881    # file or missing limiter within the configuration file.
 882    foreach (@l) {
 883       $Opts{$_} = 10 unless exists $Opts{$_};
 884    }
 885
 886    # Enable collection for each section if a limiter is non-zero.
 887    foreach (@l) {
 888       #print "L is: $_\n";
 889       #print "DETAIL: $Opts{'detail'}, OPTS: $Opts{$_}\n";
 890       $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
 891    }
 892    #print "OPTS: \n"; map { print "$_ => $Opts{$_}\n"} keys %Opts;
 893    #print "COLLECTING: \n"; map { print "$_ => $Logreporters::TreeData::Collecting{$_}\n"} keys %Logreporters::TreeData::Collecting;
 894 }
 895
 896 # Enable/disable supplemental reports
 897 # arg1:     0=off, 1=on
 898 # arg2,...: list of supplemental report keywords
 899 sub set_supplemental_reports($$) {
 900    my ($onoff,$aref) = @_;
 901
 902    $Opts{$_} = $onoff foreach (@$aref);
 903 }
 904
 905 sub process_debug_opts($) {
 906    my $optstring = shift;
 907
 908    my @errors = ();
 909    foreach (split(/\s*,\s*/, $optstring)) {
 910       my $word = lc $_;
 911       my @matched = grep (/^$word/, keys %debug_words);
 912
 913       if (scalar @matched == 1) {
 914          $Opts{'debug'} |= $debug_words{$matched[0]};
 915          next;
 916       }
 917
 918       if (scalar @matched == 0) {
 919          push @errors, "Unknown debug keyword \"$word\"";
 920       }
 921       else {  # > 1
 922          push @errors, "Ambiguous debug keyword abbreviation \"$word\": (matches: @matched)";
 923       }
 924    }
 925    if (@errors) {
 926       print STDERR "$_\n" foreach @errors;
 927       print STDERR "Debug keywords: ", join (' ', sort keys %debug_words), "\n";
 928       exit 2;
 929    }
 930 }
 931
 932 # Zero the options controlling level specs and those
 933 # any others passed via Opts key.
 934 #
 935 # Zero the options controlling level specs in the
 936 # Detailed section, and set all other report options
 937 # to disabled. This makes it easy via command line to
 938 # disable the entire summary section, and then re-enable
 939 # one or more sections for specific reports.
 940 #
 941 #   eg. progname --nodetail --limit forwarded=2
 942 #
 943 sub zero_opts ($ @) {
 944    my $sectref = shift;
 945    # remaining args: list of Opts keys to zero
 946
 947    map { $Opts{$_} = 0; print "zero_opts: $_ => 0\n" if $Opts{'debug'} & D_VARS;} @_;
 948    map { $Opts{$_} = 0 } get_usable_sectvars(@$sectref, 1);
 949 }
 950
 951 1;
 952
 953 #MODULE: ../Logreporters/TreeData.pm
 954 package Logreporters::TreeData;
 955
 956 use 5.008;
 957 use strict;
 958 use re 'taint';
 959 use warnings;
 960 no warnings "uninitialized";
 961
 962 BEGIN {
 963    use Exporter ();
 964    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 965    $VERSION = '1.001';
 966    @ISA = qw(Exporter);
 967    @EXPORT = qw(%Totals %Counts %Collecting $END_KEY);
 968    @EXPORT_OK = qw(&printTree &buildTree);
 969
 970 }
 971
 972 use subs @EXPORT_OK;
 973
 974 BEGIN {
 975    import Logreporters::Config qw(%line_styles);
 976 }
 977
 978 # Totals and Counts are the log line accumulator hashes.
 979 # Totals: maintains per-section grand total tallies for use in Summary section
 980 # Counts: is a multi-level hash, which maintains per-level key totals.
 981 our (%Totals, %Counts);
 982
 983 # The Collecting hash determines which sections will be captured in
 984 # the Counts hash.  Counts are collected only if a section is enabled,
 985 # and this hash obviates the need to test both existence and
 986 # non-zero-ness of the Opts{'keyname'} (either of which cause capture).
 987 # XXX The Opts hash could be used ....
 988 our %Collecting = ();
 989
 990 sub buildTree(\% $ $ $ $ $);
 991 sub printTree($ $ $ $ $);
 992 =pod
 993 [ a:b:c, ... ]
 994
 995 which would be interpreted as follows:
 996
 997 a = show level a detail
 998 b = show at most b items at this level
 999 c = minimun count that will be shown
1000 =cut
1001
1002 sub printTree($ $ $ $ $) {
1003    my ($treeref, $lspecsref, $line_style, $max_report_width, $debug) = @_;
1004    my ($entry, $line);
1005    my $cutlength = $max_report_width - 3;
1006
1007    my $topn = 0;
1008    foreach $entry (sort bycount @$treeref) {
1009       ref($entry) ne "HASH" and die "Unexpected entry in tree: $entry\n";
1010
1011       #print "LEVEL: $entry->{LEVEL}, TOTAL: $entry->{TOTAL}, HASH: $entry, DATA: $entry->{DATA}\n";
1012
1013       # Once the top N lines have been printed, we're done
1014       if ($lspecsref->[$entry->{LEVEL}]{topn}) {
1015          if ($topn++ >= $lspecsref->[$entry->{LEVEL}]{topn} ) {
1016             print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1017                unless ($debug) and do {
1018                      $line = '     ' . '   ' x ($entry->{LEVEL} + 3) . '...';
1019                      printf "%-130s L%d: topn reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{topn};
1020                };
1021             last;
1022          }
1023       }
1024
1025       # Once the item's count falls below the given threshold, we're done at this level
1026       # unless a top N is specified, as threshold has lower priority than top N
1027       elsif ($lspecsref->[$entry->{LEVEL}]{threshold}) {
1028          if ($entry->{TOTAL} <= $lspecsref->[$entry->{LEVEL}]{threshold}) {
1029             print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1030                unless ($debug) and do {
1031                   $line = '     ' . ('   ' x ($entry->{LEVEL} + 3)) . '...';
1032                   printf "%-130s L%d: threshold reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{threshold};
1033                };
1034             last;
1035          }
1036       }
1037
1038       $line = sprintf "%8d%s%s", $entry->{TOTAL}, '   ' x ($entry->{LEVEL} + 2),  $entry->{DATA};
1039
1040       if ($debug) {
1041          printf "%-130s %-60s\n", $line, $entry->{DEBUG};
1042       }
1043
1044       # line_style full, or lines < max_report_width
1045
1046       #printf "MAX: $max_report_width, LEN: %d, CUTLEN $cutlength\n", length($line);
1047       if ($line_style == $line_styles{'full'} or length($line) <= $max_report_width) {
1048          print $line, "\n";
1049       }
1050       elsif ($line_style == $line_styles{'truncate'}) {
1051          print substr ($line,0,$cutlength), '...', "\n";
1052       }
1053       elsif ($line_style == $line_styles{'wrap'}) {
1054          my $leader = ' ' x 8 . '   ' x ($entry->{LEVEL} + 2);
1055          print substr ($line, 0, $max_report_width, ''), "\n";
1056          while (length($line)) {
1057             print $leader, substr ($line, 0, $max_report_width - length($leader), ''), "\n";
1058          }
1059       }
1060       else {
1061          die ('unexpected line style');
1062       }
1063
1064       printTree ($entry->{CHILDREF}, $lspecsref, $line_style, $max_report_width, $debug)   if (exists $entry->{CHILDREF});
1065    }
1066 }
1067
1068 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/;
1069 # XXX optimize this using packed default sorting.  Analysis shows speed isn't an issue though
1070 sub bycount {
1071    # Sort by totals, then IP address if one exists, and finally by data as a string
1072
1073    local $SIG{__WARN__} = sub { print "*** PLEASE REPORT:\n*** $_[0]*** Unexpected: \"$a->{DATA}\", \"$b->{DATA}\"\n" };
1074
1075    $b->{TOTAL} <=> $a->{TOTAL}
1076
1077       ||
1078
1079    pack('C4' => $a->{DATA} =~ /^$re_IP_strict/o) cmp pack('C4' => $b->{DATA} =~ /^$re_IP_strict/o)
1080
1081       ||
1082
1083    $a->{DATA} cmp $b->{DATA}
1084 }
1085
1086 #
1087 # Builds a tree of REC structures from the multi-key %Counts hashes
1088 #
1089 # Parameters:
1090 #    Hash:  A multi-key hash, with keys being used as category headings, and leaf data
1091 #           being tallies for that set of keys
1092 #    Level: This current recursion level.  Call with 0.
1093 #
1094 # Returns:
1095 #    Listref: A listref, where each item in the list is a rec record, described as:
1096 #           DATA:      a string: a heading, or log data
1097 #           TOTAL:     an integer: which is the subtotal of this item's children
1098 #           LEVEL:     an integer > 0: representing this entry's level in the tree
1099 #           CHILDREF:  a listref: references a list consisting of this node's children
1100 #    Total: The cummulative total of items found for a given invocation
1101 #
1102 # Use the special key variable $END_KEY, which is "\a\a" (two ASCII bell's) to end a,
1103 # nested hash early, or the empty string '' may be used as the last key.
1104
1105 our $END_KEY = "\a\a";
1106
1107 sub buildTree(\% $ $ $ $ $) {
1108    my ($href, $max_level_section, $levspecref, $max_level_global, $recurs_level, $show_unique, $debug) = @_;
1109    my ($subtotal, $childList, $rec);
1110
1111    my @treeList = ();
1112    my $total = 0;
1113
1114    foreach my $item (sort keys %$href) {
1115       if (ref($href->{$item}) eq "HASH") {
1116          #print " " x ($recurs_level * 4), "HASH: LEVEL $recurs_level: Item: $item, type: \"", ref($href->{$item}), "\"\n";
1117
1118          ($subtotal, $childList) = buildTree (%{$href->{$item}}, $max_level_section, $levspecref, $max_level_global, $recurs_level + 1, $debug);
1119
1120          if ($recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1121             # me + children
1122             $rec = {
1123                DATA     => $item,
1124                TOTAL    => $subtotal,
1125                LEVEL    => $recurs_level,
1126                CHILDREF => $childList,
1127             };
1128
1129             if ($debug) {
1130                $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1131                      $recurs_level + 1, $max_level_global, $max_level_section,
1132                      $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $subtotal;
1133             }
1134             push (@treeList, $rec);
1135          }
1136       }
1137       else {
1138          if ($item ne '' and $item ne $END_KEY and $recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1139             $rec = {
1140                DATA  => $item,
1141                TOTAL => $href->{$item},
1142                LEVEL => $recurs_level,
1143                #CHILDREF => undef,
1144             };
1145             if ($debug) {
1146                $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1147                      $recurs_level, $max_level_global, $max_level_section,
1148                      $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $href->{$item};
1149             }
1150             push (@treeList,  $rec);
1151          }
1152          $subtotal = $href->{$item};
1153       }
1154
1155       $total += $subtotal;
1156    }
1157
1158    #print " " x ($recurs_level * 4), "LEVEL $recurs_level: Returning from recurs_level $recurs_level\n";
1159
1160    return ($total, \@treeList);
1161 }
1162
1163 1;
1164
1165 #MODULE: ../Logreporters/Reports.pm
1166 package Logreporters::Reports;
1167
1168 use 5.008;
1169 use strict;
1170 use re 'taint';
1171 use warnings;
1172 no warnings "uninitialized";
1173
1174 BEGIN {
1175    use Exporter ();
1176    use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1177    $VERSION = '1.002';
1178    @ISA = qw(Exporter);
1179    @EXPORT = qw(&inc_unmatched &print_unmatched_report &print_percentiles_report2
1180                 &print_summary_report &print_detail_report);
1181    @EXPORT_OK = qw();
1182 }
1183
1184 use subs @EXPORT_OK;
1185
1186 BEGIN {
1187    import Logreporters::Config qw(%Opts $fw1 $fw2 $sep1 $sep2 &D_UNMATCHED &D_TREE);
1188    import Logreporters::Utils qw(&commify &unitize &get_percentiles &get_percentiles2);
1189    import Logreporters::TreeData qw(%Totals %Counts &buildTree &printTree);
1190 }
1191
1192 my (%unmatched_list);
1193
1194 our $origline;       # unmodified log line, for error reporting and debug
1195
1196 sub inc_unmatched($) {
1197    my ($id) = @_;
1198    $unmatched_list{$origline}++;
1199    print "UNMATCHED($id): \"$origline\"\n"  if $Opts{'debug'} & D_UNMATCHED;
1200 }
1201
1202 # Print unmatched lines
1203 #
1204 sub print_unmatched_report() {
1205    return unless (keys %unmatched_list);
1206
1207    print "\n\n**Unmatched Entries**\n";
1208    foreach my $line (sort {$unmatched_list{$b}<=>$unmatched_list{$a} } keys %unmatched_list) {
1209       printf "%8d   %s\n", $unmatched_list{$line}, $line;
1210    }
1211 }
1212
1213 =pod
1214    ****** Summary ********************************************************
1215           2   Miscellaneous warnings
1216
1217       20621   Total messages scanned ----------------  100.00%
1218     662.993M  Total bytes scanned                  695,198,092
1219    ========   ================================================
1220
1221       19664   Ham -----------------------------------   95.36%
1222       19630     Clean passed                            95.19%
1223          34     Bad header passed                        0.16%
1224
1225         942   Spam ----------------------------------    4.57%
1226         514     Spam blocked                             2.49%
1227         428     Spam discarded (no quarantine)           2.08%
1228
1229          15   Malware -------------------------------    0.07%
1230          15     Malware blocked                          0.07%
1231
1232
1233        1978   SpamAssassin bypassed
1234          18   Released from quarantine
1235        1982   Whitelisted
1236           3   Blacklisted
1237          12   MIME error
1238          51   Bad header (debug supplemental)
1239          28   Extra code modules loaded at runtime
1240 =cut
1241 # Prints the Summary report section
1242 #
1243 sub print_summary_report (\@) {
1244    my ($sections) = @_;
1245    my ($keyname,$cur_level);
1246    my @lines;
1247
1248    my $expand_header_footer = sub {
1249       my $line = undef;
1250
1251       foreach my $horf (@_) {
1252          # print blank line if keyname is newline
1253          if ($horf eq "\n") {
1254             $line .= "\n";
1255          }
1256          elsif (my ($sepchar) = ($horf =~ /^(.)$/o)) {
1257             $line .= sprintf "%s   %s\n", $sepchar x 8, $sepchar x 50;
1258          }
1259          else {
1260             die "print_summary_report: unsupported header or footer type \"$horf\"";
1261          }
1262       }
1263       return $line;
1264    };
1265
1266    if ($Opts{'detail'} >= 5) {
1267       my $header = "****** Summary ";
1268       print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n\n";
1269    }
1270
1271    my @headers;
1272    foreach my $sref (@$sections) {
1273       # headers and separators
1274       die "Unexpected Section $sref"  if (ref($sref) ne 'HASH');
1275
1276       # Start of a new section group.
1277       # Expand and save headers to output at end of section group.
1278       if ($sref->{CLASS} eq 'GROUP_BEGIN') {
1279          $cur_level = $sref->{LEVEL};
1280          $headers[$cur_level] = &$expand_header_footer(@{$sref->{HEADERS}});
1281       }
1282
1283       elsif ($sref->{CLASS} eq 'GROUP_END') {
1284          my $prev_level = $sref->{LEVEL};
1285
1286          # If this section had lines to output, tack on headers and footers,
1287          # removing extraneous newlines.
1288          if ($lines[$cur_level]) {
1289             # squish multiple blank lines
1290             if ($headers[$cur_level] and substr($headers[$cur_level],0,1) eq "\n") {
1291                if ( ! defined $lines[$prev_level][-1] or $lines[$prev_level][-1] eq "\n") {
1292                   $headers[$cur_level] =~ s/^\n+//;
1293                }
1294             }
1295
1296             push @{$lines[$prev_level]}, $headers[$cur_level]  if $headers[$cur_level];
1297             push @{$lines[$prev_level]}, @{$lines[$cur_level]};
1298             my $f = &$expand_header_footer(@{$sref->{FOOTERS}});
1299             push @{$lines[$prev_level]}, $f   if $f;
1300             $lines[$cur_level] = undef;
1301          }
1302
1303          $headers[$cur_level] = undef;
1304          $cur_level = $prev_level;
1305       }
1306
1307       elsif ($sref->{CLASS} eq 'DATA') {
1308          # Totals data
1309          $keyname = $sref->{NAME};
1310          if ($Totals{$keyname} > 0) {
1311             my ($numfmt, $desc, $divisor) = ($sref->{FMT}, $sref->{TITLE}, $sref->{DIVISOR});
1312
1313             my $fmt   = '%8';
1314             my $extra = ' %25s';
1315             my $total = $Totals{$keyname};
1316
1317             # Z format provides  unitized or unaltered totals, as appropriate
1318             if ($numfmt eq 'Z') {
1319                ($total, $fmt) = unitize ($total, $fmt);
1320             }
1321             else {
1322                $fmt .= "$numfmt ";
1323                $extra = '';
1324             }
1325
1326             if ($divisor and $$divisor) {
1327                # XXX generalize this
1328                if (ref ($desc) eq 'ARRAY') {
1329                   $desc = @$desc[0] . ' ' . @$desc[1] x (42 - 2 - length(@$desc[0]));
1330                }
1331
1332                push @{$lines[$cur_level]},
1333                   sprintf "$fmt  %-42s %6.2f%%\n", $total, $desc,
1334                      $$divisor == $Totals{$keyname} ? 100.00 : $Totals{$keyname} * 100 / $$divisor;
1335             }
1336             else {
1337                 my $new_line;
1338                 if ($extra eq '') {
1339                     $new_line = sprintf("$fmt  %-23s \n", $total, $desc);
1340                 }
1341                 else {
1342                     $new_line = sprintf("$fmt  %-23s $extra\n",
1343                                         $total,
1344                                         $desc,
1345                                         commify ($Totals{$keyname}));
1346                 }
1347                 push @{$lines[$cur_level]}, $new_line
1348             }
1349          }
1350       }
1351       else {
1352          die "print_summary_report: unexpected control...";
1353       }
1354    }
1355    print @{$lines[0]};
1356    print "\n";
1357 }
1358
1359 # Prints the Detail report section
1360 #
1361 # Note: side affect; deletes each key in Totals/Counts
1362 # after printout.  Only the first instance of a key in
1363 # the Section table will result in Detail output.
1364 sub print_detail_report (\@) {
1365    my ($sections) = @_;
1366    my $header_printed = 0;
1367
1368    return unless (keys %Counts);
1369
1370 #use Devel::Size qw(size total_size);
1371
1372    foreach my $sref ( @$sections ) {
1373       next unless $sref->{CLASS} eq 'DATA';
1374       # only print detail for this section if DETAIL is enabled
1375       # and there is something in $Counts{$keyname}
1376       next unless $sref->{DETAIL};
1377       next unless exists $Counts{$sref->{NAME}};
1378
1379       my $keyname = $sref->{NAME};
1380       my $max_level = undef;
1381       my $print_this_key = 0;
1382
1383       my @levelspecs = ();
1384       clear_level_specs($max_level, \@levelspecs);
1385       if (exists $Opts{$keyname}) {
1386          $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
1387          $print_this_key = 1  if ($max_level);
1388       }
1389       else {
1390          $print_this_key = 1;
1391       }
1392       #print_level_specs($max_level,\@levelspecs);
1393
1394       # at detail 5, print level 1, detail 6: level 2, ...
1395
1396 #print STDERR "building: $keyname\n";
1397       my ($count, $treeref) =
1398             buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
1399                        \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);
1400
1401       if ($count > 0) {
1402          if ($print_this_key) {
1403             my $desc = $sref->{TITLE};
1404             $desc =~ s/^\s+//;
1405
1406             if (! $header_printed) {
1407                my $header = "****** Detail ($max_level) ";
1408                print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
1409                $header_printed = 1;
1410             }
1411             printf "\n%8d   %s %s\n", $count, $desc,
1412                      $Opts{'sect_vars'} ?
1413                        ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
1414                         '-' x ($Opts{'max_report_width'} - 12 - length($desc))
1415          }
1416
1417          printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
1418                     $Opts{'debug'} & D_TREE);
1419       }
1420 #print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
1421 #print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
1422       $treeref = undef;
1423       $Totals{$keyname} = undef;
1424       delete $Totals{$keyname};
1425       delete $Counts{$keyname};
1426    }
1427    #print "\n";
1428 }
1429
1430 =pod
1431
1432 Print out a standard percentiles report
1433
1434    === Delivery Delays Percentiles ===============================================================
1435                           0%       25%       50%       75%       90%       95%       98%      100%
1436    -----------------------------------------------------------------------------------------------
1437    Before qmgr          0.01      0.70      1.40  45483.70  72773.08  81869.54  87327.42  90966.00
1438    In qmgr              0.00      0.00      0.00      0.01      0.01      0.01      0.01      0.01
1439    Conn setup           0.00      0.00      0.00      0.85      1.36      1.53      1.63      1.70
1440    Transmission         0.03      0.47      0.92      1.61      2.02      2.16      2.24      2.30
1441    Total                0.05      1.18      2.30  45486.15  72776.46  81873.23  87331.29  90970.00
1442    ===============================================================================================
1443
1444    === Postgrey Delays Percentiles ===========================================================
1445                       0%       25%       50%       75%       90%       95%       98%      100%
1446    -------------------------------------------------------------------------------------------
1447    Postgrey       727.00    727.00    727.00    727.00    727.00    727.00    727.00    727.00
1448    ===========================================================================================
1449
1450  tableref:
1451    data table: ref to array of arrays, first cell is label, subsequent cells are data
1452  title:
1453    table's title
1454  percentiles_str:
1455    string of space or comma separated integers, which are the percentiles
1456    calculated and output as table column data
1457 =cut
1458 sub print_percentiles_report2($$$) {
1459    my ($tableref, $title, $percentiles_str) = @_;
1460
1461    return unless @$tableref;
1462
1463    my $myfw2 = $fw2 - 1;
1464    my @percents = split /[ ,]/, $percentiles_str;
1465
1466    # Calc y label width from the hash's keys. Each key is padded with the
1467    # string "#: ", # where # is a single-digit sort index.
1468    my $y_label_max_width = 0;
1469    for (@$tableref) {
1470       $y_label_max_width = length($_->[0])   if (length($_->[0]) > $y_label_max_width);
1471    }
1472
1473    # Titles row
1474    my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
1475    my $table_width = length($col_titles_str);
1476
1477    # Table header row
1478    my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
1479    $table_header_str .= $sep1 x ($table_width - length($table_header_str));
1480
1481    print "\n", $table_header_str;
1482    print "\n", $col_titles_str;
1483    print "\n", $sep2 x $table_width;
1484
1485    my (@p, @coldata, @xformed);
1486    foreach (@$tableref) {
1487       my ($title, $ref) = ($_->[0], $_->[1]);
1488       #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};
1489
1490       my @byscore = ();
1491
1492       for my $bucket (sort { $a <=> $b } keys %$ref) {
1493       #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
1494       # pairs: bucket (i.e. key), tally
1495          push @byscore, $bucket, $ref->{$bucket};
1496       }
1497
1498
1499       my @p = get_percentiles2 (@byscore, @percents);
1500       printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
1501    }
1502
1503 =pod
1504    foreach (@percents) {
1505       #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
1506       printf "\n%3d%%", $title;
1507       foreach my $val (@{shift @xformed}) {
1508          my $unit;
1509          if ($val > 1000) {
1510             $unit = 's';
1511             $val /= 1000;
1512          }
1513          else {
1514             $unit = '';
1515          }
1516          printf "%${fw3}.2f%-2s", $val, $unit;
1517       }
1518    }
1519 =cut
1520
1521    print "\n", $sep1 x $table_width, "\n";
1522 }
1523
1524 sub clear_level_specs($ $) {
1525    my ($max_level,$lspecsref) = @_;
1526    #print "Zeroing $max_level rows of levelspecs\n";
1527    $max_level = 0 if (not defined $max_level);
1528    for my $x (0..$max_level) {
1529       $lspecsref->[$x]{topn}      = undef;
1530       $lspecsref->[$x]{threshold} = undef;
1531    }
1532 }
1533
1534 # topn      = 0 means don't limit
1535 # threshold = 0 means no min threshold
1536 sub create_level_specs($ $ $) {
1537    my ($optkey,$gdetail,$lspecref) = @_;
1538
1539    return 0 if ($optkey eq "0");
1540
1541    my $max_level = $gdetail;            # default to global detail level
1542    my (@specsP1, @specsP2, @specsP3);
1543
1544    #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;
1545
1546    foreach my $sp (split /[\s,]+/, $optkey) {
1547       #print "create_level_specs:  SP: \"$sp\"\n";
1548       # original level specifier
1549       if ($sp =~ /^\d+$/) {
1550          $max_level = $sp;
1551          #print "create_level_specs:  max_level set: $max_level\n";
1552       }
1553       # original level specifier + topn at level 1
1554       elsif ($sp =~ /^(\d*)\.(\d+)$/) {
1555          if ($1) { $max_level = $1; }
1556          else    { $max_level = $gdetail; }           # top n specified, but no max level
1557
1558          # force top N at level 1 (zero based)
1559          push @specsP1, { level => 0, topn => $2, threshold => 0 };
1560       }
1561       # newer level specs
1562       elsif ($sp =~ /^::(\d+)$/) {
1563          push @specsP3, { level => undef, topn => 0, threshold => $1 };
1564       }
1565       elsif ($sp =~ /^:(\d+):(\d+)?$/) {
1566          push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
1567       }
1568       elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
1569          push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
1570       }
1571       else {
1572          print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
1573       }
1574    }
1575
1576    #foreach my $sp (@specsP3, @specsP2, @specsP1) {
1577    #   printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
1578    #}
1579
1580    my ($min, $max);
1581    foreach my $sp ( @specsP3, @specsP2, @specsP1) {
1582       ($min, $max) = (0, $max_level);
1583
1584       if (defined $sp->{level}) {
1585          $min = $max = $sp->{level};
1586       }
1587       for my $level ($min..$max) {
1588          #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
1589          $lspecref->[$level]{topn}      = $sp->{topn}          if ($sp->{topn});
1590          $lspecref->[$level]{threshold} = $sp->{threshold}     if ($sp->{threshold});
1591       }
1592    }
1593
1594    return $max_level;
1595 }
1596
1597 sub print_level_specs($ $) {
1598    my ($max_level,$lspecref) = @_;
1599    for my $level (0..$max_level) {
1600       printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
1601    }
1602 }
1603
1604
1605 1;
1606
1607
1608 package Logreporters;
1609
1610 BEGIN {
1611    import Logreporters::Utils;
1612    import Logreporters::Config;
1613    import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree);
1614    import Logreporters::Reports;
1615 }
1616 use 5.008;
1617 use strict;
1618 use warnings;
1619 no warnings "uninitialized";
1620 use re 'taint';
1621
1622 use Getopt::Long;
1623 use File::Basename;
1624
1625 our $progname        =  fileparse($0);
1626
1627 # the list of supplemental reports available in the Detail section
1628 #p0f
1629 my @supplemental_reports = qw(
1630    autolearn score_percentiles score_frequencies sarules timings sa_timings startinfo
1631 );
1632
1633 # Default values for various options, used if no config file exists,
1634 # or some option is not set.
1635 #
1636 # These are used to reset default values after an option has been
1637 # disabled (via undef'ing its value).  This allows a report to be
1638 # disabled via config file or --nodetail, but reenabled via subsequent
1639 # command line option
1640 my %Defaults = (
1641    detail                 => 10,                      # report level detail
1642    max_report_width       => 100,                     # maximum line width for report output
1643    line_style             => undef,                   # lines > max_report_width, 0=truncate,1=wrap,2=full
1644    syslog_name            => $progname_prefix,        # amavis' syslog service name
1645    sect_vars              => 0,                       # show section vars in detail report hdrs
1646    ipaddr_width           => 15,                      # width for printing ip addresses
1647    first_recip_only       => 0,                       # Show only the first recipient, or all
1648
1649    autolearn              => 1,                       # show Autolearn report
1650    bayes                  => 1,                       # show hit Bayesian buckets
1651    #p0f                    => 'all all',               # p0f hits report
1652    sarules                => '20 20',                 # show SpamAssassin rules hit
1653    score_frequencies      => '-10 -5 0 5 10 20 30',   # buckets shown in spam scores report
1654    score_percentiles      => '0 50 90 95 98 100',     # percentiles shown in spam scores report
1655    startinfo              => 1,                       # show amavis startup info
1656    timings                => 95,                      # show top N% of the timings report
1657    timings_percentiles    => '0 5 25 50 75 95 100',   # percentiles shown in timing report
1658    sa_timings             => 95,                      # show top N% of the SA timings report
1659    sa_timings_percentiles => '0 5 25 50 75 95 100',   # percentiles shown in SA timing report
1660 );
1661
1662 my $usage_str = <<"END_USAGE";
1663 Usage: $progname [ ARGUMENTS ] [logfile ...]
1664
1665    ARGUMENTS can be one or more of options listed below.  Later options override earlier ones.
1666    Any argument may be abbreviated to an unambiguous length.  Input comes from named logfiles,
1667    or STDIN.
1668
1669    --debug AREAS                       provide debug output for AREAS
1670    --help                              print usage information
1671    --version                           print program version
1672
1673    --config_file FILE, -f FILE         use alternate configuration file FILE
1674    --syslog_name PATTERN               only consider log lines that match
1675                                        syslog service name PATTERN
1676
1677    --detail LEVEL                      print LEVEL levels of detail
1678                                        (default: 10)
1679    --nodetail                          set all detail levels to 0
1680    --[no]summary                       display the summary section
1681
1682    --ipaddr_width WIDTH                use WIDTH chars for IP addresses in
1683                                        address/hostname pairs
1684    --line_style wrap|full|truncate     disposition of lines > max_report_width
1685                                        (default: truncate)
1686    --full                              same as --line_style=full
1687    --truncate                          same as --line_style=truncate
1688    --wrap                              same as --line_style=wrap
1689    --max_report_width WIDTH            limit report width to WIDTH chars
1690                                        (default: 100)
1691    --limit L=V, -l L=V                 set level limiter L with value V
1692    --[no]sect_vars                     [do not] show config file var/cmd line
1693                                        option names in section titles
1694
1695    --[no]autolearn                     show autolearn report
1696    --[no]by_ccat_summary               include by contents category grouping in summary
1697    --[no]first_recip_only              show first recipient only, or all recipients
1698    --nosarules                         disable SpamAssassin spam and ham rules hit reports
1699    --sarules "S,H"                     enable SpamAssassin spam and ham rules reports, showing
1700    --sarules "default"                 showing the top S spam and top H ham rules hit (range:
1701                                        0..., "all", or the keyword "default").
1702    --noscore_frequencies               disable spam score frequency report
1703    --score_frequencies "B1 [B2 ...]"   enable spam score frequency report, using buckets
1704    --score_frequencies "default"       specified with B1 [B2 ...] (range: real numbers), or using their
1705                                        internal default values when the keyword "default" is given
1706    --noscore_percentiles               disable spam score percentiles report
1707    --score_percentiles "P1 [P2 ...]"   enable spam score percentiles report, using percentiles
1708    --score_percentiles "default"       specified with P1 [P2 ...] (range: 0...100), or using their
1709                                        internal default values when the keyword "default" is given
1710    --[no]startinfo                     show latest amavis startup details, if available
1711
1712    --nosa_timings                      disable the SA timings report (same as --sa_timings 0)
1713    --sa_timings PERCENT                show top PERCENT percent of the SA timings report (range: 0...100)
1714    --sa_timings_percentiles "P1 [P2 ...]"
1715                                        set SA timings report percentiles to P1 [P2 ...]  (range: 0...100)
1716
1717    --notimings                         disable the timings report (same as --timings 0)
1718    --timings PERCENT                   show top PERCENT percent of the timings report (range: 0...100)
1719    --timings_percentiles "P1 [P2 ...]" set timings report percentiles to P1 [P2 ...]  (range: 0...100)
1720 END_USAGE
1721
1722 # local prototypes
1723 sub usage($);
1724 sub init_getopts_table();
1725 sub init_defaults();
1726 sub build_sect_table();
1727
1728 sub parse_vals($$);
1729 sub triway_opts($$);
1730
1731 sub printSpamScorePercentilesReport;
1732 sub printSpamScoreFrequencyReport;
1733 sub printAutolearnReport;
1734 sub printSARulesReport;
1735 sub printTimingsReport($$$$);
1736 sub printStartupInfoReport;
1737 sub strip_trace($);
1738 sub prioritize_cmdline(@);
1739
1740 sub create_ignore_list();
1741 sub check_ignore_list($ \@);
1742
1743 # lines that match any RE in this list will be ignored.
1744 # see create_ignore_list();
1745 my @ignore_list_final = ();
1746
1747 # The Sections table drives Summary and Detail reports.  For each entry in the
1748 # table, if there is data avaialable, a line will be output in the Summary report.
1749 # Additionally, a sub-section will be output in the Detail report if both the
1750 # global --detail, and the section's limiter variable, are sufficiently high (a
1751 # non-existent section limiter variable is considered to be sufficiently high).
1752 #
1753 my @Sections;
1754
1755 # Initialize main running mode and basic opts
1756 init_run_mode($config_file);
1757
1758 # Configure the Getopts options table
1759 init_getopts_table();
1760
1761 # Place configuration file/environment variables onto command line
1762 init_cmdline();
1763
1764 # Initialize default values
1765 init_defaults();
1766
1767 # Process command line arguments, 0=no_permute,no_pass_through
1768 get_options(0);
1769
1770 # Build the Section table
1771 build_sect_table();
1772
1773 # Run through the list of Limiters, setting the limiters in %Opts.
1774 process_limiters(@Sections);
1775
1776 # Set collection for any enabled supplemental sections
1777 foreach (@supplemental_reports) {
1778    $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
1779 }
1780
1781 # Don't collect SpamScores when not necessary
1782 $Collecting{'spamscores'} = ($Opts{'detail'} >= 5 && ($Opts{'score_percentiles'} || $Opts{'score_frequencies'})) ? 1 : 0;
1783
1784 if (! defined $Opts{'line_style'}) {
1785    # default line style to full if detail >= 11, or truncate otherwise
1786    $Opts{'line_style'} =
1787       ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
1788 }
1789
1790 # Create the list of REs used to match against log lines
1791 create_ignore_list();
1792
1793 my (%Timings, %TimingsSA, @TimingsTotals, @TimingsSATotals);
1794 my (%SaveLine, %StartInfo);
1795 my (%SpamScores, %spamtags, %p0ftags);
1796
1797 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
1798 my %ccatmajor_to_sectkey = (
1799    'INFECTED'    => 'malware',
1800    'BANNED'      => 'bannedname',
1801    'UNCHECKED'   => 'unchecked',
1802    'UNCHECKED-ENCRYPTED' => 'unchecked',
1803    'SPAM'        => 'spam',
1804    'SPAMMY'      => 'spammy',
1805    'BAD-HEADER'  => 'badheader',
1806    'OVERSIZED'   => 'oversized',
1807    'MTA-BLOCKED' => 'mta',
1808    'CLEAN'       => 'clean',
1809    'TEMPFAIL'    => 'tempfail',
1810    'OTHER'       => 'other',
1811 );
1812
1813 my %ccatmajor_to_priority = (
1814    'INFECTED'    => 9,
1815    'BANNED'      => 8,
1816    'UNCHECKED'   => 7,
1817    'SPAM'        => 6,
1818    'SPAMMY'      => 5,
1819    'BAD-HEADER'  => 4,
1820    'OVERSIZED'   => 3,
1821    'MTA-BLOCKED' => 2,
1822    'CLEAN'       => 1,
1823    'TEMPFAIL'    => 0,
1824    'OTHER'       => 0,
1825 );
1826
1827 # for reports
1828 my %ccatmajor_to_spamham = (
1829    'INFECTED'    => 'malware',
1830    'BANNED'      => 'bannedname',
1831    'UNCHECKED'   => 'unchecked',
1832    'SPAM'        => 'spam',
1833    'SPAMMY'      => 'spam',
1834    'BAD-HEADER'  => 'ham',
1835    'OVERSIZED'   => 'ham',
1836    'MTA-BLOCKED' => 'ham',
1837    'CLEAN'       => 'ham',
1838    'TEMPFAIL'    => 'ham',
1839    'OTHER'       => 'ham',
1840 );
1841
1842 my $logline_maxlen = 980;
1843
1844 # Create the list of REs against which log lines are matched.
1845 # Lines that match any of the patterns in this list are ignored.
1846 #
1847 # Note: This table is created at runtime, due to a Perl bug which
1848 # I reported as perl bug #56202:
1849 #
1850 #    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
1851 #
1852
1853 sub create_ignore_list() {
1854    push @ignore_list_final, qr/^lookup_ip_acl/;
1855    push @ignore_list_final, qr/^lookup_acl/;
1856    push @ignore_list_final, qr/^lookup_hash/;
1857    push @ignore_list_final, qr/^lookup_re/;
1858    push @ignore_list_final, qr/^lookup_ldap/;
1859    push @ignore_list_final, qr/^lookup_sql_field.* result=[YN]$/;
1860    push @ignore_list_final, qr/^lookup .* does not match$/;
1861    push @ignore_list_final, qr/^lookup [[(]/;
1862    push @ignore_list_final, qr/^lookup => /;
1863    push @ignore_list_final, qr/^lookup: /;
1864    push @ignore_list_final, qr/^save_info_preliminary/; # log level 4
1865    push @ignore_list_final, qr/^save_info_final/;       # log level 4
1866    push @ignore_list_final, qr/^sql: /;
1867    push @ignore_list_final, qr/^sql_storage: retrying/;
1868    push @ignore_list_final, qr/^sql flush: /;
1869    push @ignore_list_final, qr/^sql print/;
1870    push @ignore_list_final, qr/^sql begin transaction/;
1871    push @ignore_list_final, qr/^sql rollback/;
1872    push @ignore_list_final, qr/^mail_via_sql: /;
1873    push @ignore_list_final, qr/^CALLING SA check$/;
1874    push @ignore_list_final, qr/^calling SA parse,/;
1875    push @ignore_list_final, qr/^timer set to \d+/;
1876    push @ignore_list_final, qr/^query_keys/;
1877    push @ignore_list_final, qr/^find_or_save_addr: /;
1878    push @ignore_list_final, qr/^header: /;
1879    push @ignore_list_final, qr/^DO_QUARANTINE, /;
1880    push @ignore_list_final, qr/^DEBUG_ONESHOT: /;
1881    push @ignore_list_final, qr/^TempDir::/;
1882    push @ignore_list_final, qr/^check_mail_begin_task: /;
1883    push @ignore_list_final, qr/^program: .*?(anomy|altermime|disclaimer).*? said: /; # log_level 2
1884    push @ignore_list_final, qr/^body (?:type|hash): /;
1885    push @ignore_list_final, qr/^\d+\.From: <.*>, \d+.Mail_From:/;
1886    push @ignore_list_final, qr/^The amavisd daemon is (?:apparently )?not running/;
1887    push @ignore_list_final, qr/^rw_loop/;
1888    push @ignore_list_final, qr/^[SL]MTP[><]/;
1889    push @ignore_list_final, qr/^[SL]MTP response for/;
1890    push @ignore_list_final, qr/^dsn:/i,   # DSN or dsn
1891    push @ignore_list_final, qr/^enqueue: /;
1892    push @ignore_list_final, qr/^write_header: /;
1893    push @ignore_list_final, qr/^banned check: /;
1894    push @ignore_list_final, qr/^child_finish_hook/;
1895    push @ignore_list_final, qr/^inspect_dsn:/;
1896    push @ignore_list_final, qr/^client IP address unknown/;
1897    push @ignore_list_final, qr/^final_destiny/;
1898    push @ignore_list_final, qr/^one_response_for_all/;
1899    push @ignore_list_final, qr/^headers CLUSTERING/;
1900    push @ignore_list_final, qr/^notif=/;
1901    push @ignore_list_final, qr/^\(about to connect/;
1902    push @ignore_list_final, qr/^Original mail size/;
1903    push @ignore_list_final, qr/^TempDir removal/;
1904    push @ignore_list_final, qr/^Issued a new file name/;
1905    push @ignore_list_final, qr/^starting banned checks/;
1906    push @ignore_list_final, qr/^skip admin notification/;
1907    push @ignore_list_final, qr/^do_notify_and_quarantine - done/;
1908    push @ignore_list_final, qr/^do_[a-zA-Z]+.* done$/i;
1909    push @ignore_list_final, qr/^Remote host presents itself as:/;
1910    push @ignore_list_final, qr/^connect_to_ldap/;
1911    push @ignore_list_final, qr/^connect_to_sql: trying /;
1912    push @ignore_list_final, qr/^ldap begin_work/;
1913    push @ignore_list_final, qr/^Connecting to LDAP server/;
1914    push @ignore_list_final, qr/^loaded base policy bank/;
1915    push @ignore_list_final, qr/^\d+\.From:/;
1916    push @ignore_list_final, qr/^Syslog (retries|warnings)/;
1917    push @ignore_list_final, qr/^smtp connection cache/;
1918    push @ignore_list_final, qr/^smtp cmd> /;
1919    push @ignore_list_final, qr/^smtp session/;
1920    push @ignore_list_final, qr/^Ignoring stale PID file/;
1921    push @ignore_list_final, qr/^mime_decode_preamble/;
1922    push @ignore_list_final, qr/^doing banned check for/;
1923    push @ignore_list_final, qr/^open_on_specific_fd/;
1924    push @ignore_list_final, qr/^reparenting /;
1925    push @ignore_list_final, qr/^Issued a new pseudo part: /;
1926    push @ignore_list_final, qr/^run_command: /;
1927    push @ignore_list_final, qr/^result line from file/;
1928    push @ignore_list_final, qr/^Charging /;
1929    push @ignore_list_final, qr/^check_for_banned /;
1930    push @ignore_list_final, qr/^Extracting mime components$/;
1931    push @ignore_list_final, qr/^response to /;
1932    push @ignore_list_final, qr/^File-type of /;
1933    push @ignore_list_final, qr/^Skip admin notification, /;
1934    push @ignore_list_final, qr/^run_av: /;
1935    push @ignore_list_final, qr/^string_to_mime_entity /;
1936    push @ignore_list_final, qr/^ndn_needed=/;
1937    push @ignore_list_final, qr/^sending RCPT TO:/;
1938    push @ignore_list_final, qr/^decode_parts: /;
1939    push @ignore_list_final, qr/^decompose_part: /;
1940    push @ignore_list_final, qr/^setting body type: /;
1941    push @ignore_list_final, qr/^mime_decode_epilogue: /;
1942    push @ignore_list_final, qr/^string_to_mime_entity: /;
1943    push @ignore_list_final, qr/^at the END handler: /;
1944    push @ignore_list_final, qr/^Amavis::.* called$/;
1945    push @ignore_list_final, qr/^Amavis::.* close,/;
1946    push @ignore_list_final, qr/^dkim: /;         # XXX provide stats
1947    push @ignore_list_final, qr/^collect banned table/;
1948    push @ignore_list_final, qr/^collect_results from/;
1949    push @ignore_list_final, qr/^blocking contents category is/;
1950    push @ignore_list_final, qr/^running file\(/;
1951    push @ignore_list_final, qr/^Found av scanner/;
1952    push @ignore_list_final, qr/^Found myself/;
1953    push @ignore_list_final, qr/^mail_via_smtp/;
1954    push @ignore_list_final, qr/^switch_to_client_time/;
1955    push @ignore_list_final, qr/^parse_message_id/;
1956    push @ignore_list_final, qr/^parse_received: /;
1957    push @ignore_list_final, qr/^parse_ip_address_from_received: /;
1958    push @ignore_list_final, qr/^fish_out_ip_from_received: /;
1959    push @ignore_list_final, qr/^Waiting for the process \S+ to terminate/;
1960    push @ignore_list_final, qr/^Valid PID file \(younger than sys uptime/;
1961    push @ignore_list_final, qr/^no \$pid_file configured, not checking it/;
1962    push @ignore_list_final, qr/^Sending SIG\S+ to amavisd/;
1963    push @ignore_list_final, qr/^Can't send SIG\S+ to process/;
1964    push @ignore_list_final, qr/^killing process/;
1965    push @ignore_list_final, qr/^no need to kill process/;
1966    push @ignore_list_final, qr/^process .* is still alive/;
1967    push @ignore_list_final, qr/^Daemon \[\d+\] terminated by SIG/;
1968    push @ignore_list_final, qr/^storage and lookups will use .* to SQL/;
1969    push @ignore_list_final, qr/^idle_proc, /;
1970    push @ignore_list_final, qr/^switch_to_my_time/;
1971    push @ignore_list_final, qr/^TempDir::strip: /;
1972    push @ignore_list_final, qr/^rmdir_recursively/;
1973    push @ignore_list_final, qr/^sending [SL]MTP response/;
1974    push @ignore_list_final, qr/^prolong_timer/;
1975    push @ignore_list_final, qr/^process_request:/;
1976    push @ignore_list_final, qr/^exiting process_request/;
1977    push @ignore_list_final, qr/^post_process_request_hook: /;
1978    push @ignore_list_final, qr/^SMTP session over/;
1979    push @ignore_list_final, qr/^updating snmp variables/;
1980    push @ignore_list_final, qr/^best_try_originator_ip/;
1981    push @ignore_list_final, qr/^mail checking ended: /; # log level 2
1982    push @ignore_list_final, qr/^The amavisd daemon is already running/;
1983    push @ignore_list_final, qr/^AUTH not needed/;
1984    push @ignore_list_final, qr/^load: \d+ %, total idle/;
1985    push @ignore_list_final, qr/^policy protocol: [^=]+=\S+(?:,\S+)*$/;   # allow "policy protocol: INVALID ..." later
1986    push @ignore_list_final, qr/^penpals: /;
1987    push @ignore_list_final, qr/^Not calling virus scanners, no files to scan in/;
1988    push @ignore_list_final, qr/^local delivery: /;
1989    push @ignore_list_final, qr/^run_as_subprocess: child process \S*: Broken pipe/;
1990    push @ignore_list_final, qr/^initializing Mail::SpamAssassin/;
1991    push @ignore_list_final, qr/^Error reading mail header section/;   # seems to occur gen. due to perl getline() bug
1992    push @ignore_list_final, qr/^flatten_and_tidy_dir/;
1993    push @ignore_list_final, qr/^do_7zip: member/;
1994    push @ignore_list_final, qr/^Expanding \S+ archive/;
1995    push @ignore_list_final, qr/^files_to_scan:/;
1996    push @ignore_list_final, qr/^Unzipping p\d+/;
1997    push @ignore_list_final, qr/^writing mail text to SQL/;
1998    push @ignore_list_final, qr/^strip_tempdir/;
1999    push @ignore_list_final, qr/^no parts, file/;
2000    push @ignore_list_final, qr/^warnsender_with_pass/;
2001    push @ignore_list_final, qr/^RETURNED FROM SA check/;
2002    push @ignore_list_final, qr/^mime_traverse: /;
2003    push @ignore_list_final, qr/^do_spam: /;
2004    push @ignore_list_final, qr/^prepare_tempdir: /;
2005    push @ignore_list_final, qr/^check_header: /;
2006    push @ignore_list_final, qr/^skip admin notification/;
2007    push @ignore_list_final, qr/^do_executable: not a/;
2008    push @ignore_list_final, qr/^Skip spam admin notification, no administrators$/;
2009    push @ignore_list_final, qr/^skip banned check for/;
2010    push @ignore_list_final, qr/^is_outgoing /;
2011    push @ignore_list_final, qr/^NO Disclaimer/;
2012    push @ignore_list_final, qr/^Using \(\S+\) on file/;
2013    push @ignore_list_final, qr/^no anti-spam code loaded/;
2014    push @ignore_list_final, qr/^entered child_init_hook/;
2015    push @ignore_list_final, qr/^body type/;
2016    push @ignore_list_final, qr/^establish_or_refresh/;
2017    push @ignore_list_final, qr/^get_body_digest/;
2018    push @ignore_list_final, qr/^ask_daemon_internal/;
2019    push @ignore_list_final, qr/^Turning AV infection into a spam report, name already accounted for/;
2020    push @ignore_list_final, qr/^Calling virus scanners/;
2021    push @ignore_list_final, qr/^timer stopped after /;
2022    push @ignore_list_final, qr/^virus_presence /;
2023    push @ignore_list_final, qr/^cache entry /;
2024    push @ignore_list_final, qr/^generate_mail_id /;
2025    push @ignore_list_final, qr/^Load low precedence policybank/;
2026    push @ignore_list_final, qr/^warm restart on /;              # XXX could be placed instartup info
2027    push @ignore_list_final, qr/^Signalling a SIGHUP to a running daemon/;
2028    push @ignore_list_final, qr/^Deleting db files /;
2029    push @ignore_list_final, qr/^address modified \(/;
2030    push @ignore_list_final, qr/^Request: AM\.PDP /;
2031    push @ignore_list_final, qr/^DSPAM result: /;
2032    push @ignore_list_final, qr/^(will )?bind to \//;
2033    push @ignore_list_final, qr/^ZMQ enabled: /;
2034
2035    push @ignore_list_final, qr/^Inserting header field: X-Amavis-Hold: /;
2036    push @ignore_list_final, qr/^Decoding of .* failed, leaving it unpacked: /;
2037    push @ignore_list_final, qr/^File::LibMagic::describe_filename failed on p\d+: /;
2038
2039       # various forms of "Using ..."
2040       # more specific, interesting variants already captured: search "Using"
2041    push @ignore_list_final, qr/^Using \(.*\) on dir:/;
2042    push @ignore_list_final, qr/^Using [^:]+: \(built-in interface\)/;
2043    push @ignore_list_final, qr/^Using \(.*\): /;
2044    push @ignore_list_final, qr/: sleeping for /;
2045    push @ignore_list_final, qr/creating socket by /;
2046
2047         # unanchored
2048    push @ignore_list_final, qr/\bRUSAGE\b/;
2049    push @ignore_list_final, qr/: Sending .* to UNIX socket/;
2050
2051    # Lines beginning with "sd_notify:" or "sd_notify (no socket):"
2052    # describe what is being sent to the systemd notification socket,
2053    # if one exists.
2054    push @ignore_list_final, qr/^sd_notify( \(no socket\))?:/;
2055
2056    # In amavisd-new-2.11.0-rc1 and later, amavis will replace any null
2057    # bytes that it finds in the body of a message with a "modified
2058    # UTF-8" encoded null. The number of times it does this is then
2059    # logged with the following message.
2060    push @ignore_list_final, qr/^smtp forwarding: SANITIZED (\d+) NULL byte\(s\)/;
2061 }
2062
2063 # Notes:
2064 #
2065 #   - IN REs, always use /o flag or qr// at end of RE when RE uses unchanging interpolated vars
2066 #   - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<[^>]*> )
2067 #   - See additional notes below, search for "Note:".
2068 #   - XXX indicates change, fix or more thought required
2069
2070 # Main processing loop
2071 #
2072 while (<>) {
2073    chomp;
2074    s/ +$//;
2075    next if $_ eq '';
2076
2077    $Logreporters::Reports::origline = $_;
2078
2079    if ($Opts{'standalone'}) {
2080       next unless s/^[A-Z][a-z]{2} [ \d]\d \d{2}:\d{2}:\d{2} (?:<[^>]+> )?\S+ $Opts{'syslog_name'}(?:\[\d+\])?: (?:\[ID \d+ \w+\.\w+\] )?//o;
2081    }
2082
2083    my $p1 = $_;
2084    my ($p2, $pid);
2085    my $action = "blocked";    # default action is blocked if not present in log
2086
2087    # For now, ignore the amavis startup timing lines.  Need to do this
2088    # before stripping out the amavis pid to differentiate these from the
2089    # scan timing reports
2090    next if ($p1 =~ /^TIMING/);
2091
2092    my $linelen = length $p1;
2093    # Strip amavis process id-instance id, or release id
2094    if (($pid,$p2) = ($p1 =~ /^\(([^)]+)\) (.*)$/ )) {
2095       $p1 = $p2;
2096    }
2097
2098    # Handle continuation lines.  Continuation lines should be in order per PID, meaning line1, line2, line3,
2099    # but never line3, line1, line2.
2100    #
2101    # amavis log lines as chopped by sub write_log are exactly 980 characters long starting with '(' as in:
2102    #  amavis[47061]: (47061-15) SPAM, etc  ...
2103    #                 ^ <-----980------------->
2104    # but this can be changed in amavis via $logline_maxlen.
2105    # There may also be the alert markers (!) and (!!) preceeding any continuation ellipsis.
2106    #
2107
2108    # ... a continued line ...
2109    if ($p1 =~ s/^(\([!]{1,2}\))?\.\.\.//) {
2110       if (!exists($SaveLine{$pid})) {
2111          my $alert = $1;
2112          #printf "Unexpected continue line: \"%s\"\n", $p1;
2113          $SaveLine{$pid} = $alert || '';
2114       }
2115       $SaveLine{$pid} .= $p1;
2116       next if $SaveLine{$pid} =~ s/\.\.\.$//;  # next if line has more pieces
2117    }
2118
2119    # this line continues ...
2120    if ($p1 =~ /\.\.\.$/ and $linelen == $logline_maxlen) {
2121       $p1 =~ s/\.\.\.$//;
2122       $SaveLine{$pid} = $p1;
2123       next;
2124    }
2125
2126    if (exists($SaveLine{$pid})) {
2127       # printf "END OF SaveLine: %s\n", $SaveLine{$pid};
2128       $p1 = delete $SaveLine{$pid};
2129    }
2130
2131    #if (length($p1) > 10000) {
2132    #   printf "Long log entry %d chars: \"%s\"\n", length($p1), $p1;
2133    #   next;
2134    #}
2135
2136    next if (
2137         # Place REs here that should ignore log lines otherwise caught below.
2138         # Some are located here historically, and need to be checked for candidates
2139         # to be relocated to ignore_list_final.
2140            ($p1 =~ /^do_ascii/)
2141         or ($p1 =~ /^Checking/)
2142         or ($p1 =~ /^header_edits_for_quar: /)
2143         or ($p1 =~ /^Not-Delivered/)
2144         or ($p1 =~ /^SpamControl/)
2145         or ($p1 =~ /^Perl/)
2146         or ($p1 =~ /^ESMTP/)
2147         or ($p1 =~ /^UTF8SMTP/)
2148         or ($p1 =~ /^(?:\(!+\))?(\S+ )?(?:FWD|SEND) from /)            # log level 4
2149         or ($p1 =~ /^(?:\(!+\))?(\S+ )?(?:ESMTP|FWD|SEND) via /)       # log level 4
2150         or ($p1 =~ /^tempdir being removed/)
2151         or ($p1 =~ /^do_notify_and_quar(?:antine)?: .*ccat/)
2152         or ($p1 =~ /^cached [a-zA-Z0-9]+ /)
2153         or ($p1 =~ /^loaded policy bank/)
2154         or ($p1 =~ /^p\.path/)
2155         or ($p1 =~ /^virus_scan: /)
2156         or ($p1 =~ /^Requesting (a |)process rundown after [0-9]+ tasks/)
2157         or ($p1 =~ /^Cached (virus|spam) check expired/)
2158         or ($p1 =~ /^pr(?:esent|ovid)ing full original message to scanners as/)  # log level 2
2159         or ($p1 =~ /^Actual message size [0-9]+ B(,| greater than the) declared [0-9]+ B/)
2160         or ($p1 =~ /^disabling DSN/)
2161         or ($p1 =~ /^Virus ([^,]+ )?matches [^,]+, sender addr ignored/)
2162         or ($p1 =~ /^release /)
2163         or ($p1 =~ /^adding SA score \S+ to existing/)
2164         or ($p1 =~ /^Maia:/)   # redundant
2165         or ($p1 =~ /^AM\.PDP  /)  # this appears to be always have two spaces
2166                                   # because in amavisd::preprocess_policy_query() when $ampdp is
2167                                   # set, it will pass an unset $attr_ref->{'mail_id'} to do_log(1
2168         or ($p1 =~ /^_(?:WARN|DIE):$/)  # bug: empty _WARN|_DIE: http://marc.info/?l=amavis-user&m=121725098111422&w=2
2169
2170         # non-begin anchored
2171         or ($p1 =~ /result: clean$/)
2172         or ($p1 =~ /DESTROY called$/)
2173         or ($p1 =~ /email\.txt no longer exists, can't re-use it/)
2174         or ($p1 =~ /SPAM\.TAG2/)
2175         or ($p1 =~ /BAD-HEADER\.TAG2/)
2176         or ($p1 =~ /: Connecting to socket/)
2177         or ($p1 =~ /broken pipe \(don't worry\), retrying/)
2178         or ($p1 =~ /(?:Sending|on dir:) (?:CONT)?SCAN /)
2179    );
2180
2181    my ($ip, $from, $to, $key,, $reason, $item,
2182        $decoder, $scanner, $stage, $sectkey);
2183
2184    # Coerce older "INFECTED" quarantined lines into "Blocked INFECTED",
2185    # to be processed in the Passed/Blocked section.
2186    if ($p1 =~ /^INFECTED.*, quarantine/) {
2187       $p1 = 'Blocked ' . $p1;
2188    }
2189
2190    # SPAM entry occurs at kill level
2191    # SPAM-TAG entry occurs at log level 2, when spam header is inserted
2192    # log_level >= 2 || (log_level > 2 && syslog_priority=debug)
2193    my ($tagtype,$fromto,$isspam,$tags,$tests,$autolearn);
2194
2195    # amavisd-new 2.7.0 changes SPAM-TAG to Spam-tag and its log_level to 3
2196    if (($tagtype,$fromto,$isspam,$tags,$tests,$autolearn) = ($p1 =~ /^((?i:SPAM(?:-TAG)?)), (.*), (Yes|No), score=[-+x\d.]+(.*) tests=\[([^\]]*)](?:, autolearn=(\w+))?/) or
2197        ($tagtype,$fromto,$isspam,$tags,$tests) =            ($p1 =~ /^((?i:SPAM(?:-TAG)?)), (.*), (Yes|No), hits=[-+x\d.]+(.*) tests=(.*)(?:, quarantine )?/)) {
2198
2199       #TD SPAM, <from@example.com> -> <to@sample.com>, Yes, score=17.709 tag=-10 tag2=6.31 kill=6.31 tests=[AWL=-0.678, BAYES_99=4], autolearn=spam, quarantine Cc4+GUJhgpqh (spam-quarantine)
2200       #TD SPAM, <from@example.com> -> <to@sample.net>, Yes, score=21.161 tag=x tag2=8.15 kill=8.15 tests=[BAYES_99=2.5, FORGED_RCVD_HELO=0.135], autolearn=no, quarantine m6lWPoTGJ2O (spam-quarantine)
2201       #TD SPAM, <from@example.com> -> <to@sample.net>, Yes, score=17.887 tag=-10 tag2=6.31 kill=6.31 tests=[BAYES_99=4], autolearn=spam, quarantine VFYjDOVTW4zd (spam-quarantine)
2202       #TD SPAM-TAG, <from@example.com> -> <to@sample.net>, No, score=-0.069 tagged_above=-10 required=6.31 tests=[BAYES_00=-2.599, FROM_ENDS_IN_NUMS=2.53]
2203       #TD SPAM-TAG, <from@example.com> -> <to@sample.net>, No, score=-1.294 required=8.15 tests=[BAYES_00=-2.599, FROM_LOCAL_HEX=1.305]
2204       # pre 2.3.3
2205       #TD SPAM-TAG, <from@example.com> -> <to@sample.net>, Yes, hits=6.159 tagged_above=-999 required=3.4 tests=BAYES_99=3.5, FUZZY_CPILL=0.518, HTML_MESSAGE=0.001, URIBL_WS_SURBL=2.14
2206       #TD SPAM, <from@example.com> -> <to@sample.net>, Yes, hits=8.1 tag1=-999.0 tag2=7.0 kill=7.0 tests=MANGLED_TAKE, UPPERCASE_25_50, quarantine spam-14156-09 (maia-spam-quarantine)
2207
2208       $Totals{'tagged'}++   if uc($tagtype) eq 'SPAM-TAG';
2209
2210       if ($tests) {
2211          my $type = $isspam =~ /^Y/ ? 'Spam' : 'Ham';
2212
2213          # Note: A SPAM line may be followed by an almost identical SPAM-TAG line.  To avoid double counting,
2214          # maintain a list of (abbreviated) SPAM tag lines keyed by pid.  Since pid's are recycled,
2215          # maintain an approximation of uniqueness by combining several components from the log
2216          # line (we can't use the date information, as in logwatch, it is not present).
2217          # XXX: It is safe to delete an entry when the final Passed/Block line occurs
2218
2219          #TD SPAM, <from@example.com> -> <to@sample.net>, Yes, score=34.939 tag=x tag2=6.31 kill=6.31 tests=[DATE_IN_FUTURE_03_06=1.961], autolearn=disabled
2220          #TD SPAM-TAG, <from@example.com> -> <to@sample.net>, Yes, score=34.939 required=6.31 tests=[DATE_IN_FUTURE_03_06=1.961]
2221          #TD SPAM, <from@example.com> -> tod@sample.net>, Yes, score=31.565 tag=x tag2=6.9 kill=6.9 tests=[AV:Sanesecurity.Phishing.Bank.2666.UNOFFICIAL=4.1, AV:Sanesecurity.Phishing.Bank.2666.UNOFFICIAL=4.1, BAYES_99=4, DCC_CHECK=4, DIGEST_MULTIPLE=0.001, FORGED_MUA_OUTLOOK=3.116, FORGED_OUTLOOK_HTML=0.001, FORGED_OUTLOOK_TAGS=0.001, HTML_MESSAGE=0.001, L_AV_SS_Phish=5, MIME_HTML_ONLY=1.457, NORMAL_HTTP_TO_IP=0.001, RAZOR2_CF_RANGE_51_100=2, RAZOR2_CF_RANGE_E4_51_100=1.5, RAZOR2_CF_RANGE_E8_51_100=1.5, RAZOR2_CHECK=3, RDNS_NONE=0.1, URIBL_PH_SURBL=1.787] autolearn=spam
2222
2223
2224          my $tagstr = $fromto . '/' . $isspam . '/' . $tests;
2225          if (uc($tagtype) eq 'SPAM-TAG' and exists $spamtags{$pid}) {
2226             next if ($spamtags{$pid} eq $tagstr);
2227          }
2228          $spamtags{$pid} = $tagstr;
2229
2230          #for (split /=[^,]+(?:, +|$)/, $tests)
2231          # amavis < 2.6.2 would double list AV names when using
2232          # @virus_name_to_spam_score_maps.
2233          my @unique_tests = unique_list (split /, +/, $tests);
2234          for (@unique_tests) {
2235             # skip possible trailing junk ("quarantine, ...") when older non-bracked tests=xxx is used
2236             next if ! /[^=]+=[\-.\d]+/;
2237             my ($id,$val) = split /=/;
2238             if ($id =~ /^BAYES_\d+$/) {
2239                $Counts{'bayes'}{$id}++    if ($Collecting{'bayes'});
2240             }
2241             if ($Opts{'sarules'}) {
2242                if    ($id eq 'DKIM_POLICY_SIGNSOME') { $val = 0   }
2243                elsif ($id eq 'AWL')                  { $val = '-' }
2244                $Counts{'sarules'}{$type}{sprintf "%6s %s", $val, $id}++;
2245             }
2246          }
2247          # Handled below
2248          #autolearn= is available only at ll>=3 or SPAM messages; so ham doesn't naturally occur here
2249          # SA 2.5/2.6 : ham/spam/no
2250          # SA 3.0+    : ham/spam/no/disabled failed/unavailable
2251          #$Counts{'autolearn'}{$type}{$autolearn}++    if ($Opts{'autolearn'});
2252       }
2253    }
2254
2255    # Passed or Blocked
2256    elsif ($p1 =~ /^(Passed|Blocked)(.*)/) {
2257       $action = lcfirst $1;
2258       ($p1 = $2) =~ s/^\s+//;
2259
2260       $p1 =~ s/^,/CLEAN,/;      # canonicalize older log entries
2261       #print "P1: \"$p1\"\n";
2262
2263       # amavis 20030616p10-5
2264       #TD Passed, <from@example.com> -> <to@sample.net>, Message-ID: <652.44494541@example.com>, Hits: 4.377
2265       #TD Passed, <from@example.com> -> <to@sample.net>, Message-ID: <B5C@example.com>, Hits: -
2266       #TD Passed, <from@example.com> -> <to@sample.net>, quarantine IJHkgliCm2Ia, Message-ID: <20080307140552.16E127641E@example.com>, Hits: 0.633
2267
2268       #TD Passed CLEAN, [10.0.0.1] [10.0.0.1] <from@example.com> -> <to@sample.net>, Message-ID: <2qxz191@example.com>, mail_id: w4DHD8, Hits: -2.599, size: 3045, queued_as: 2056, 2664 ms
2269       #TD Passed CLEAN, [10.0.0.1] [10.0.0.1] <from@example.com> -> <to@sample.net>, Message-ID: <2qxz191@example.com>, mail_id: w4DHD8, Hits: -2.541-3, size: 3045, queued_as: 2056, 2664 ms
2270       #TD Blocked SPAM, [10.0.0.1] [192.168.0.1] <bogus@example.com> -> <to@sample.net>, quarantine: spam-EzEbE9W, Message-ID: <117894@example.com>, mail_id: EzEbE9W, Hits: 6.364, size: 16493, 6292 ms
2271       #TD Blocked SPAM, LOCAL [10.0.0.1] [10.0.0.2] <bogus@example.com> -> <to@sample.net>, quarantine: spam-EzEbE9W, Message-ID: <110394@example.com>, mail_id: EzEbE9W, Hits: 6.364, size: 16493, 6292 ms
2272       #TD Blocked SPAM, [IPv6:2001:630:d0:f102:230:48ff:fe77:96e] [192.168.0.1] <joe@example.com> -> <user@sample.net>, quarantine: spam-EzEbE9W, Message-ID: <11780394@example.com>, mail_id: EzEbE9W, Hits: 6.364, size: 16493, 6292 ms
2273       #TD Passed SPAMMY, ORIGINATING/MYNETS LOCAL [10.0.0.1] [10.0.0.1] <from@example.com> -> <to1@sample.net>,<to2@sample.net>, quarantine: spam-EzEbE9W, Message-ID: <11780394@example.com>, mail_id: EzEbE9W, Hits: 6.364, size: 16493, 6292 ms
2274       #TD Blocked SPAM, B-BANK/C-BANK/B-BANK [10.0.0.1] [10.0.0.1] <from@sample.net> -> <to@example.com>, quarantine: spam-EzEbE9W, Message-ID: <11780394@example.com>, mail_id: EzEbE9W, Hits: 6.364, size: 16493, 6292 ms
2275       #TD Blocked SPAM, [10.0.0.1] [10.0.0.1] <from@example.com> -> <to@sample.net>, quarantine: spam-AV49p5, Message-ID: <1.007@sample.net>, mail_id: AV49p5, Hits: 7.487, size: 27174, 4406 ms
2276       #TD Passed SPAM, MYNETS <root@example.com> -> <root@example.com>, quarantine: spam-V3Wq, Message-ID: <220.1B@example.com>, mail_id: V3Wq, Hits: 7, size: 8838, queued_as: C63EC, 18 ms
2277       #TD Passed SPAM, <> -> <"fred).flintstone"@domain.tld>, Message-ID: <200801180104.CAA23669@aserver.sub.adomain.tld>, mail_id: 6AzQ1g0l5RgP, Hits: 9.061, size: 5555, queued_as: C1840506CB8, 8766 ms
2278       #TD Blocked INFECTED (HTML.Phishing.Bank-43), [198.168.0.1] [10.0.0.1] <bogus@example.com> -> <to@sample.net>, quarantine: virus-SCwJcs, Message-ID: <509@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2279       #TD Blocked INFECTED (Trojan.Downloader.Small-9993), LOCAL [10.0.0.2] [10.0.0.2] <bogus@example.net> -> <to@example.com>, quarantine: virus-SCwJcs, Message-ID: <9009@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2280       #TD Blocked BANNED (multipart/report | message/partial,.txt), [192.168.0.1] [10.0.0.2] <> -> <someuser@sample.net>, quarantine: virus-SCwJcs, Message-ID: <509@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2281       #TD Blocked BANNED (multipart/report | message/partial,.txt), LOCAL [192.168.0.1] [10.0.0.2] <> -> <someuser@sample.net>, quarantine: virus-SCwJcs, Message-ID: <509@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2282       #TD Blocked BANNED (multipart/mixed | application/octet-stream,.asc,=?iso-8859-1?Q?FTP=5FFile=5F (1)=File(1).reg), [192.168.0.0] [192.168.0.0] <from@example.com> -> <to@sample.us>, quarantine: virus-SCwJcs, Message-ID: <509@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2283       #TD Blocked BANNED (multipart/related | application/zip,.zip,card.zip | .exe,.exe-ms,Card.exe), [10.0.0.2] [10.0.0.2] <from@example.com> -> <to@sample.net>, quarantine: banned-9OXm4Q3ah, Message-ID: <08517$@from>, mail_id: 9OXm4Q3ah, Hits: -, size: 2366, 3803 ms
2284       #TD Passed BAD-HEADER, [192.168.0.1] [10.0.0.2] <bogus@example.com> -> <someuser@sample.net>, quarantine: virus-SCwJcs, Message-ID: <df@acm.org>, mail_id: SCwJcs, Hits: 2.54 size: 4134, 3721 ms
2285       #TD Passed BAD-HEADER, LOCAL [192.168.0.1] [10.0.0.2] <bogus@example.com> -> <someuser@sample.net>, quarantine: virus-SCwJcs, Message-ID: <df@acm.org>, mail_id: SCwJcs, Hits: 3.2 size: 4134, 3721 ms
2286       #TD Passed BAD-HEADER, MYNETS AM.PDP [127.0.0.1] [127.0.0.1] <bogus@example.com> -> <someuser@sample.net>, quarantine: virus-SCwJcs, Message-ID: <df@acm.org>, mail_id: SCwJcs, Hits: 1.2 size: 4134, 3721 ms
2287       #TD Passed BAD-HEADER, ORIGINATING/MYNETS LOCAL [10.0.0.1] [10.0.0.1] <from@sample.net> -> <to1@sample.net>,<to2@sample.net>,<to3@example.com>, quarantine: virus-SCwJcs, Message-ID: <df@acm.org>, mail_id: SCwJcs, Hits: -, size: 4134, 3721 ms
2288       #TD Passed BAD-HEADER, [10.0.0.1] [10.0.0.2] <from@example.com> -> <to@sample.net>, quarantine: badh-lxR, Message-ID: <7fm@example.com>, mail_id: lxR, Hits: -2.292, size: 422, queued_as: E3B, 981 ms
2289       #TD Passed UNCHECKED, MYNETS LOCAL [192.168.0.1] [192.168.0.1] <from@sample.net> -> <to@example.com> Message-ID: <002e01c759c7$5de437b0$0a02a8c0@somehost>, mail_id: 7vtR-7BAvHZV, Hits: -, queued_as: B5420C2E10, 6585 ms
2290       #TD Blocked MTA-BLOCKED, LOCAL [192.168.0.1] [192.168.0.2] <from@example.com> -> <to@sample.net>, Message-ID: <438548@example.com>, mail_id: tfgTCiyvFw, Hits: -2.54, size: 4895, 31758 ms
2291       #TD Blocked OVERSIZED, LOCAL [10.0.0.1] [10.0.0.1] <f@example.com> -> <t@sample.net>, Message-ID: <435@example.com>, mail_id: tfTivFw, Hits: -2.54, size: 444444895, 31758 ms
2292       #TD Blocked OTHER, LOCAL [10.0.0.1] [10.0.0.1] <f@example.com> -> <t@sample.net>, Message-ID: <435@example.com>, mail_id: tfTivFw, Hits: -2.54, size: 495, 31758 ms
2293       #TD Blocked TEMPFAIL, [10.0.0.2] [10.0.0.1] <user@example.com> -> <to@sample.net>, Message-ID: <200703302301.9f1899470@example.com>, mail_id: bgf52ZCNbPo, Hits: -2.586, 3908 ms
2294
2295       #2.3.1
2296       #<>,<info@example.com>,Passed,Hits=-3.3,Message-ID=<200506440.1.sample.net>,Size=51458
2297       #20030616p10-5
2298       #Not-Delivered, <from@example.com> -> <to@localhost>, quarantine spam-ea32770-03, Message-ID: <BAA618FE2CB585@localhost>, Hits: 9.687
2299
2300       # malwarepassed, malwareblocked
2301       # xxx very old
2302       # Virus found - quarantined|
2303       #amavisd-new-20030616
2304       # INFECTED (JS/IllWill-A), <from@[127.0.0.1]> -> <to@sample.net>, quarantine virus-20040811-207-0-03, Message-ID: <0440.5577-101@sample.net>, Hits: -
2305       # INFECTED (Exploit.HTML.IFrame, Worm.SomeFool.P), <from@sample.net> -> <to@example.com>,<to2@example.com>, quarantine qiO2ZG4K, Message-ID: <200608.5A5@mail.example.com>, Hits: -
2306       #XXX (?:(Passed|Blocked) )?INFECTED \(([^\)]+)\),[A-Z .]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[)>]/o ))
2307       #XXX elsif (($action, $key, $ip, $from, $to) = ( $p1 =~ /^(?:Virus found - quarantined|(?:(Passed|Blocked) )?INFECTED) \(([^\)]+)\),[A-Z .]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[(>]/o ))
2308
2309       # the first IP is the envelope sender.
2310       if ($p1 !~ /^(CLEAN|SPAM(?:MY)?|INFECTED \(.*?\)|BANNED \(.*?\)|BAD-HEADER(?:-\d)?|UNCHECKED|UNCHECKED-ENCRYPTED|MTA-BLOCKED|OVERSIZED|OTHER|TEMPFAIL)(?: \{[^}]+})?, ([^[]+ )?(?:([^<]+) )?[<(](.*?)[>)] -> ([(<].*?[)>]), (?:.*Hits: ([-+.\d]+))(?:.* size: (\d+))?(?:.* autolearn=(\w+))?/) {
2311          inc_unmatched('passblock');
2312          next;
2313       }
2314       my $trigger;
2315       my ($ccatmajor, $pbanks, $ips, $from, $reciplist, $hits, $size, $autolearn) = ($1, $2, $3, $4, $5, $6, $7, $8);
2316
2317       $Totals{'bytesscanned'} += $size  if defined $size;
2318
2319       #print "ccatmajor: \"$ccatmajor\", pbanks: \"$pbanks\"\n";
2320       if ($ccatmajor =~ /^(INFECTED|BANNED) \((.*)\)$/) {
2321          ($ccatmajor, $trigger) = ($1, $2);
2322          #print "\tccatmajor: \"$ccatmajor\", trigger: \"$trigger\"\n";
2323       }
2324
2325       $ccatmajor =~ s/(BAD-HEADER)-\d/$1/; # strip amavis 2.7's [:ccat|minor] BAD-HEADER sub-classification
2326       $sectkey = $ccatmajor_to_sectkey{$ccatmajor} . $action;
2327       $Totals{$sectkey}++;
2328
2329       # Not checked by spamassassin, due to $sa_mail_body_size_limit or @bypass_spam_checks_maps
2330       if ($hits eq '-') {
2331          # Don't increment sabypassed for INFECTED (SA intentionally not called)
2332          unless ($ccatmajor eq 'INFECTED') {
2333             # The following order is used, the first condition met decides the outcome:
2334             #  1. a virus is detected: mail is considered infected;
2335             #  2. contains banned name or type: mail is considered banned;
2336             #  3. spam level is above kill level for at least one recipient, or a sender is blacklisted: mail is considered spam;
2337             #  4. bad (invalid) headers: mail is considered as having a bad header.
2338             # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
2339             $Totals{'sabypassed'}++;
2340          }
2341       } else {
2342          if ($Collecting{'spamscores'}) {
2343             no re 'taint';
2344             if ($hits =~ /^(-?[.\d]+)([-+])([.\d]+)$/) {
2345                $hits = eval $1.$2.$3;   # untaint $hits, to sum $1 and $3 values
2346             }
2347             # SA not called for ccats INFECTED and BANNED (Hits: -).
2348             # UNCHECKED may have a score, so we can't distinguish Ham from Spam
2349             push @{$SpamScores{$ccatmajor_to_spamham{$ccatmajor}}}, $hits;
2350          }
2351       }
2352
2353       # autolearn is available here only if enabled in amavis template
2354       if ($autolearn ne '' and $Opts{'autolearn'}) {
2355       #if ($autolearn ne '' and ($ccatmajor eq 'SPAM' or $ccatmajor eq 'CLEAN')) {
2356          #  SA 2.5/2.6 : ham/spam/no
2357          #  SA 3.0+    : ham/spam/no/disabled/failed/unavailable
2358          # printf "INC: autolearn: %s, %s: %d\n", $ccatmajor eq 'SPAM' ? 'Spam' : 'Ham', $autolearn, $Opts{'autolearn'};;
2359          # Priorities other than SPAM will be considered HAM for autolearn stats
2360          $Counts{'autolearn'}{$ccatmajor eq 'SPAM' ? 'Spam' : 'Ham'}{$autolearn}++;
2361       }
2362
2363       # p0f fingerprinting
2364       if (exists $p0ftags{$pid}) {
2365          my ($ip,$score,$os) = split(/\//, $p0ftags{$pid});
2366          $Counts{'p0f'}{ucfirst($ccatmajor_to_spamham{$ccatmajor})}{$os}{$ip}++;
2367          #print "Deleting p0ftag: $pid\n";
2368          delete $p0ftags{$pid};
2369       }
2370
2371       next unless ($Collecting{$sectkey});
2372       # cleanpassed never gets here...
2373
2374       # prefer xforward IP if it exists
2375       # $ip_a => %a  original SMTP session client IP address (empty if unknown, e.g. no XFORWARD)
2376       # $ip_e => %e  best guess of the originator IP address collected from the Received trace
2377       my ($ip_a, $ip_e) = split(/ /, $ips, 2);
2378
2379       $ip = $ip_a ? $ip_a : $ip_e;
2380       $ip =~ s/[[\]]//g;
2381       #print "ip: \"$ip\", ip_a: \"$ip_a\", ip_e: \"$ip_e\", from: \"$from\", reciplist: \"$reciplist\"; hits: \"$hits\"\n";
2382       $ip   = '*unknown IP'  if ($ip   eq '');
2383       $from = '<>'           if ($from eq '');
2384
2385       # Show first recipient only, or all
2386       my @recips = split /,/, $reciplist;
2387       @recips = map { /^<(.+)>$/ } @recips;
2388       # show only first recipient
2389       $to = lc ($Opts{'first_recip_only'} ? $recips[0] : "@recips");
2390
2391       if ($ccatmajor eq 'INFECTED') {        # $ccatmajor: INFECTED  malwarepassed, malwareblocked
2392          $Counts{$sectkey}{$trigger}{$to}{$ip}{$from}++;
2393       }
2394       elsif ($ccatmajor eq 'BANNED') {       # $ccatmajor: BANNED  bannednamepassed, bannednameblocked
2395          $Counts{$sectkey}{$to}{$trigger}{$ip}{$from}++;
2396       } else {
2397          # $ccatmajor: CLEAN | SPAM{MY} | BAD-HEADER | UNCHECKED | MTA-BLOCKED | OVERSIZED | OTHER | TEMPFAIL
2398          # cleanpassed, cleanblocked, spampassed, spamblocked, badheaderpassed, badheaderblocked
2399          # uncheckedpassed, uncheckblocked, mtapassed, mtablocked, oversizedpassed, oversizedblocked
2400          # otherpassed, otherblocked, tempfailpassed, tempfailblocked
2401          $Counts{$sectkey}{$to}{$ip}{$from}++;
2402       }
2403
2404       # old...
2405       #XXX elsif (($action, $item, $ip, $from, $to) = ( $p1 =~ /^(?:(Blocked|Passed) )?BANNED (?:name\/type )?\((.+)\),[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[(>]/o))
2406       #XXXX  elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Passed|Blocked) )?UNCHECKED,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^>)]*)[)>]/o ))
2407       #XXX elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Passed|Blocked) )?TEMPFAIL,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^>)]*)[)>]/o ))
2408       #XXX elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Blocked|Passed) )?BAD-HEADER,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [(<]([^>)]*)[)>](?: -> [(<]([^>)]+)[)>])[^:]*/o ))
2409       # amavis 2.3.1
2410       #BAD-HEADER, <> -> <info@example.com>, Message-ID: <200506440.1.sample.net>, Hits=-3.3 tag1=3.0 tag2=7.5 kill=7.5, tests=ALL_TRUSTED=-3.3, [10.0.0.1]
2411    } # end Passed or Blocked
2412
2413    # MAIA
2414    elsif ($p1 =~ /^FAKE SENDER, ([^:]+): ($[^,]+), (.*)$/o) {
2415       #TD FAKE SENDER, SPAM: 192.168.0.1, bogus@example.com
2416       $Totals{'fakesender'}++;            next unless ($Collecting{'fakesender'});
2417       $Counts{'fakesender'}{$1}{$2}{$3}++;
2418    }
2419
2420    elsif ($p1 =~ /^p\d+ \d+(?:\/\d+)* Content-Type: ([^,]+)(?:, size: [^,]+, name: (.*))?/) {
2421       my ($ts, $name) = ($1, $2);
2422       #TD p006 1 Content-Type: multipart/mixed
2423       #TD p008 1/1 Content-Type: multipart/signed
2424       #TD p001 1/1/1 Content-Type: text/plain, size: 460 B, name:
2425       #TD p002 1/1/2 Content-Type: application/pgp-signature, size: 189 B, name:
2426       #TD p002 1/2 Content-Type: application/octet-stream, size: 3045836 B, name: abc.pdf
2427       next unless ($Collecting{'contenttype'});
2428       my ($type, $subtype) = $ts !~ '""' ? split /\//, $ts : ('unspecified', 'unspecified');
2429
2430       $name = '' if !defined $name or $name =~ /^\s*$/;
2431       $Counts{'contenttype'}{$type}{$subtype}{$name}++;
2432    }
2433
2434    # LMTP/SMTP connection
2435    # NOTE:  no longer used. size data now being obtained from Passed/Block line, as size info may not be available here
2436    #elsif (my ($size) = ($p1 =~ /^[LS]MTP:(?:\[$re_IP\])?:\d+ [^:]+: [<(](?:.*?)[>)] -> \S+ (?:SIZE=(\d+))?.*?Received: / )) {
2437    elsif ($p1 =~ /^[LS]MTP:/) {
2438      #TD LMTP::10024 /var/spool/amavis/tmp/amavis-20070119T144757-09086: <from@example.com> -> <to@sample.net> SIZE=1000 Received: from mail.sample.net ([127.0.0.1]) by localhost (mail.sample.net [127.0.0.1]) (amavisd-new, port 10024) with LMTP for <to@sample.net>; Fri, 19 Jan 2007 15:41:45 -0800 (PST)
2439      #TD SMTP:[127.0.0.1]:10024 /var/spool/amavis/tmp/amavis-20070119T144757-09086: <from@example.com> -> <to@sample.net>,<recip@sample.net> SIZE=2500000 Received: from mail.sample.net ([127.0.0.1]) by localhost (mail.sample.net [127.0.0.1]) (amavisd-new, port 10024) with LMTP for <to@sample.net>; Fri, 19 Jan 2007 15:41:45 -0800 (PST)
2440      #TD SMTP::10024 /var/lib/amavis/tmp/amavis-27-26927: <from@example.com> -> <to@example.net> Received: from localhost ([127.0.0.1]) by localhost (example.com [127.0.0.1]) (amavisd-new, port 10024) with SMTP for <to@example.net>; Sat,  7 Jun 2008 23:09:34 +0200 (CEST)
2441      #$Totals{'bytesscanned'} += $size  if defined $size;
2442    }
2443
2444    #(\S+) ([^[(]+)(.*)$
2445    elsif ($p1 =~ /^OS_fingerprint: (\S+) ([-\d.]+) (\S+)(?: ([^[(]+|\[[^]]+\]))?/o) {
2446       #TD OS_fingerprint: 213.193.24.113 29.789 Linux 2.6 (newer, 1) (up: 1812 hrs), (distance 14, link: ethernet/modem)
2447       #TD OS_fingerprint: 10.47.2.155 -1.312 MYNETWORKS
2448       # Note: safe to delete entry when the final Passed/Block line occurs
2449       if ($Collecting{'p0f'}) {
2450          my ($genre,$vers) = ($3,$4);
2451          #print "p0f:\t$3\t\t$vers\n";
2452          if ($genre eq 'Windows') {
2453             local($1);
2454             $vers = $1  if $vers =~ /^(\S+) /;
2455             $genre .= ' ' . $vers;
2456          }
2457          elsif ($genre eq 'UNKNOWN') {
2458             $genre = 'Unknown';
2459          }
2460          $p0ftags{$pid} = join('/', $1,$2,$genre);
2461          #print "Added PID: $pid, $p0ftags{$pid}\n";
2462       }
2463    }
2464
2465    elsif ( ($reason) = ( $p1 =~ /^BAD HEADER from [^:]+: (.+)$/) or
2466            ($reason) = ( $p1 =~ /check_header: \d, (.+)$/)) {
2467       # When log_level > 1, provide additional header or MIME violations
2468
2469       # amavisd < 2.4.0, log_level >= 1
2470       #TD BAD HEADER from <bogus@example.com>: Improper use of control character (char 0D hex) in message header 'Received': Received: example.com[10.0.0.1\r]
2471       #TD BAD HEADER from <bogus@example.com>: Non-encoded 8-bit data (char F7 hex) in message header 'Subject': Subject: \367\345\370\361 \344\351\351\362\345\365\n
2472       #TD BAD HEADER from <bogus@example.com>: MIME error: error: part did not end with expected boundary
2473       #TD BAD HEADER from (bulk ) <bogus@bounces@lists.example.com>: Non-encoded 8-bit data (char E6 hex) in message header 'Subject': Subject: spam\\346ham\\n
2474       #TD BAD HEADER from (list) <bogus@bounces@lists.example.com>: MIME error: error: part did not end with expected boundary
2475       #  amavisd >= 2.4.3, log_level >= 2
2476       #TD check_header: 2, Non-encoded 8-bit data (char AE hex): Subject: RegionsNet\\256 Online Banking\\n
2477       #TD check_header: 2, Non-encoded 8-bit data (char E1 hex): From: "any user" <from\\341k@example.com>\\n
2478       #TD check_header: 3, Improper use of control character (char 0D hex): Content-type: text/html; charset=i...
2479       #TD check_header: 8, Duplicate header field: "Reply-To"
2480       #TD check_header: 8, Duplicate header field: "Subject"
2481       #TD check_header: 4, Improper folded header field made up entirely of whitespace (char 09 hex): X-Loop-Detect: 3\\n\\t\\n
2482       #TD check_header: 4, Improper folded header field made up entirely of whitespace: Received: ...8 ;         Thu, 10 Jan 2008 03:41:35 +0100\\n\\t \\n
2483
2484
2485       my $subreason;
2486       if ($reason =~ /^(.*?) \((char \S+ hex)\)(.*)$/) {
2487          $reason = $1;
2488          my ($char,$sub) = ($2,$3);
2489
2490          $sub =~ s/^in message header '[^:]+': //;
2491          $sub =~ s/^: //;
2492          $subreason = "$char: $sub";
2493       }
2494       elsif ($reason =~ /^(Improper folded header field made up entirely of whitespace):? (.*)/) {
2495          $reason = $1;
2496          $subreason = $2;
2497       }
2498       elsif ($reason =~ /^(Duplicate header field): "(.+)"$/) {
2499          $reason = $1;
2500          $subreason = $2;
2501       }
2502       elsif ($reason =~ /^(MIME error): (?:error: )?(.+)$/) {
2503          $reason = $1;
2504          $subreason = $2;
2505       }
2506
2507       $Totals{'badheadersupp'}++;            next unless ($Collecting{'badheadersupp'});
2508       $Counts{'badheadersupp'}{$reason}{$subreason}++;
2509    }
2510
2511    elsif ($p1 =~ /^truncating a message passed to SA at/) {
2512       #TD truncating a message passed to SA at 431018 bytes, orig 1875912
2513       $Totals{'truncatedmsg'}++;
2514    }
2515
2516    elsif ($p1 =~ /: spam level exceeds quarantine cutoff level/ or
2517           $p1 =~ /: cutoff, blacklisted/) {
2518       #TD do_notify_and_quarantine: spam level exceeds quarantine cutoff level 20
2519       #TD do_notify_and_quarantine: cutoff, blacklisted
2520       $Totals{'spamdiscarded'}++;
2521    }
2522
2523    elsif ( $p1 =~ /^spam_scan: (.*)$/) {
2524       #if ($1 =~ /^not wasting time on SA, message longer than/ ) {
2525          #TD spam_scan: not wasting time on SA, message longer than 409600 bytes: 1326+4115601
2526          # this causes duplicate counts, and the subsequent Passed/Blocked log line
2527          # will have "Hits: -," whereby sabypassed is incremented.
2528          #$Totals{'sabypassed'}++;
2529       #}
2530       # ignore other spam_scan lines
2531    }
2532
2533    # WARN:
2534    elsif ( ($reason) = ( $p1 =~ /^WARN: MIME::Parser error: (.*)$/ )) {
2535       # WARN: MIME::Parser error: unexpected end of header
2536       $Totals{'mimeerror'}++;                next unless ($Collecting{'mimeerror'});
2537       $Counts{'mimeerror'}{$reason}++;
2538    }
2539
2540    elsif ($p1 =~ /^WARN: address modified \((\w+)\): <(.*?)> -> <(.*)>$/) {
2541       #TD WARN: address modified (sender): <root> -> <root@>
2542       #TD WARN: address modified (recip): <root> -> <root@>
2543       #TD WARN: address modified (recip): <postmaster> -> <postmaster@>
2544       #TD WARN: address modified (recip): <"test@example.com"@> -> <"teszt@example.com">
2545       #TD WARN: address modified (sender): <fr\344om@sample.net> -> <"fr\344om"@sample.net>
2546       $Totals{'warningaddressmodified'}++;   next unless ($Collecting{'warningaddressmodified'});
2547       $Counts{'warningaddressmodified'}{$1 eq 'sender' ? "Sender address" : "Recipient address"}{"$2 -> $3"}++;
2548    }
2549
2550    # NOTICE:
2551    elsif ($p1 =~ /^NOTICE: (.*)$/) {
2552       # uninteresting
2553       #TD NOTICE: reconnecting in response to: err=2006, HY000, DBD::mysql::st execute failed: MySQL server has gone away at (eval 71) line 166, <GEN168> line 4.
2554       next if ($1 =~ /^Disconnected from SQL server/); # redundant
2555       next if ($1 =~ /^do_search: trying again: LDAP_OPERATIONS_ERROR/);
2556       next if ($1 =~ /^reconnecting in response to: /);
2557
2558
2559       if ($1 =~ /^Not sending DSN, spam level ([\d.]+ )?exceeds DSN cutoff level/) {
2560          #TD NOTICE: Not sending DSN, spam level exceeds DSN cutoff level for all recips, mail intentionally dropped
2561          $Totals{'dsnsuppressed'}++;
2562          $Counts{'dsnsuppressed'}{'DSN cutoff exceeded'}++;
2563       }
2564       elsif ($1 =~ /^Not sending DSN to believed-to-be-faked sender/) {
2565          #TD NOTICE: Not sending DSN to believed-to-be-faked sender <user@example.com>, mail containing VIRUS intentionally dropped
2566          $Totals{'dsnsuppressed'}++;
2567          $Counts{'dsnsuppressed'}{'Sender likely faked'}++;
2568       }
2569       elsif ($1 =~ /^DSN contains [^;]+; bounce is not bounc[ai]ble, mail intentionally dropped/) {
2570          $Totals{'dsnsuppressed'}++;
2571          $Counts{'dsnsuppressed'}{'Not bounceable'}++;
2572       }
2573       elsif ($1 =~ /^UNABLE TO SEND DSN to /) {
2574          #TD NOTICE: UNABLE TO SEND DSN to <user@example.com>: 554 5.7.1 Failed, id=19838-01, from MTA([127.0.0.1]:10025): 554 5.7.1 <user@example.com>: Recipient address rejected: Access denied
2575          $Totals{'dsnsuppressed'}++;
2576          $Counts{'dsnsuppressed'}{'Unable to send'}++;
2577       }
2578
2579       elsif ($1 =~ /^Skipping (?:bad|extra) output from file\(1\)/) {
2580          #TD NOTICE: Skipping extra output from file(1): blah
2581          #TD NOTICE: Skipping bad output from file(1) at [1, p002], got: blah
2582          $Totals{'fileoutputskipped'}++;
2583       }
2584       elsif (($p1) = ($1 =~ /^Virus scanning skipped: (.*)$/)) {
2585          #TD NOTICE: Virus scanning skipped: Maximum number of files (1500) exceeded at (eval 57) line 1283, <GEN212> line 1501.
2586          $Totals{'virusscanskipped'}++;      next unless ($Collecting{'virusscanskipped'});
2587          $Counts{'virusscanskipped'}{strip_trace($p1)}++;
2588       }
2589       else {
2590          inc_unmatched('NOTICE');
2591          next;
2592       }
2593    }
2594
2595    # INFO:
2596    elsif ($p1 =~ /^INFO: (.*)$/) {
2597       next if ($1 =~ /^unfolded \d+ illegal all-whitespace continuation line/);
2598       next if ($1 =~ /^removed bare CR/);
2599
2600       if ($1 =~ /^truncat(ed|ing)/) {
2601          #TD INFO: truncating long header field (len=2639): X-Spam-Report: =?iso-8859-1?Q?=0A=0A*__1=2E7_SUBJECT=5FENCODED=5FTWICE_Subject=3A_MIME_e?= =?iso-885...
2602          #TD INFO: truncated 1 header line(s) longer than 998 characters
2603          $Totals{'truncatedheader'}++;
2604       } elsif ( $1 =~ /^no existing header field 'Subject', inserting it/) {
2605          $Totals{'nosubject'}++;
2606       }
2607       elsif (my ($savers1, $savers2, $item) = ( $1 =~ /^(?:SA version: ([^,]+), ([^,]+), )?no optional modules: (.+)$/)) {
2608          #TD INFO: SA version: 3.1.8, 3.001008, no optional modules: DBD::mysql Mail::SpamAssassin::Plugin::DKIM Mail::SpamAssassin::Plugin::URIDetail Error
2609          next unless ($Opts{'startinfo'});
2610          if ($savers1 ne '') {
2611             $StartInfo{'sa_version'} = "$savers1 ($savers2)";
2612          }
2613          foreach my $code (split / /, $item) {
2614             $StartInfo{'Code'}{'Not loaded'}{$code} = "";
2615          }
2616       }
2617       elsif (my ($name) = ( $1 =~ /^(unknown banned table name \S+), .+$/)) {
2618          #TD INFO: unknown banned table name 1, recip=r@example.com
2619          $Totals{'warning'}++;      next unless ($Collecting{'warning'});
2620          $Counts{'warning'}{ucfirst $name}++;
2621       }
2622       else {
2623          inc_unmatched('INFO');
2624          next;
2625       }
2626    }
2627
2628    elsif ( ($action,$reason,$from,$to) = ($p1 =~ /^DSN: NOTIFICATION: Action:([^,]+), ([^,]+), <(.*?)> -> <(.*?)>/)) {
2629       #TD DSN: NOTIFICATION: Action:failed, LOCAL 554 Banned, <from@example.net> -> <to@example.com>
2630       #TD DSN: NOTIFICATION: Action:delayed, LOCAL 454 Banned, <from@example.com> -> <to@example.net>
2631
2632       $Totals{'dsnnotification'}++;    next unless ($Collecting{'dsnnotification'});
2633       $Counts{'dsnnotification'}{$action}{$reason}{"$from -> $to"}++;
2634    }
2635
2636    elsif (($item, $from, $to) = ( $p1 =~ /^Quarantined message release(?: \([^)]+\))?: ([^ ]+) <(.*?)> -> (.+)$/) or
2637           ($item, $from, $to) = ( $p1 =~ /^Quarantine release ([^ ]+): overriding recips <([^>]*)> by (.+)$/)) {
2638       #TD Quarantine release arQcr95dNHaW: overriding recips <TO@EXAMPLE.COM> by <to@example.com>
2639       #TD Quarantined message release: hiyPJOsD2m9Z <from@sample.net> -> <to@example.com>
2640       #TD Quarantined message release: hiyPJOsD2m9Z <> -> <to@recipient.maildir>,<anyone@example.com>
2641       # 2.6+
2642       #TD Quarantined message release (miscategorized): Iu6+0u1voOA <from@example.com> -> <to@example.net>
2643       $Totals{'released'}++;           next unless ($Collecting{'released'});
2644       $from = '<>' if ($from eq '');
2645       $to =~ s/[<>]//g;
2646       $Counts{'released'}{"\L$from"}{$to}{$item}++;
2647    }
2648    elsif ($p1 =~ /^Quarantine release ([^:]+): missing X-Quarantine-ID$/) {
2649       #TD Quarantine release 7ejEBC7MThSc: missing X-Quarantine-ID
2650       $Totals{'warningnoquarantineid'}++; next unless ($Collecting{'warningnoquarantineid'});
2651       $Counts{'warningnoquarantineid'}{$1}++;
2652    }
2653
2654    elsif ( ($stage,$reason) = ($p1 =~ /^Negative SMTP resp\S* +to ([^:]+): *(.*)$/)) {
2655       #TD Negative SMTP response to data-dot (<u@example.com>): 550 5.7.1 Header Spam Rule 4
2656       $Totals{'smtpresponse'}++;       next unless ($Collecting{'smtpresponse'});
2657       $Counts{'smtpresponse'}{'Negative response'}{$stage}{$reason}++;
2658    }
2659    elsif ( ($stage,$reason) = ($p1 =~ /^smtp resp to ([^:]+): *(.*)$/)) {
2660       #TD smtp resp to NOOP (idle 4799.4 s): 421 4.4.2 nops.overtops.org Error: timeout exceeded
2661       #TD smtp resp to MAIL (pip): 250 2.1.0 Ok
2662       $Totals{'smtpresponse'}++;       next unless ($Collecting{'smtpresponse'});
2663       $stage =~ s/ [\d.]+ s//;
2664       $Counts{'smtpresponse'}{'Response'}{$stage}{$reason}++;
2665    }
2666
2667    elsif ( ($item) = ($p1 =~ /^response to RCPT TO for <([^>]*)>: "501 Bad address syntax"/)) {
2668       #TD response to RCPT TO for <""@example.com>: "501 Bad address syntax"
2669       $Totals{'badaddress'}++;         next unless ($Collecting{'badaddress'});
2670       $Counts{'badaddress'}{$item}++;
2671    }
2672
2673    # do_unip: archive extraction
2674    elsif ($p1 =~ s/^do_unzip: \S+, //) {
2675       $Totals{'archiveextract'}++;     next unless ($Collecting{'archiveextract'});
2676
2677       if ( $p1 =~ s/^\d+ members are encrypted, //) {
2678          #TD do_unzip: p003, 4 members are encrypted, none extracted, archive retained
2679          $Counts{'archiveextract'}{'Encrypted'}{$p1}++;
2680
2681       } elsif ( $p1 =~ /^zero length members, archive retained/) {
2682          #TD do_unzip: p002, zero length members, archive retained
2683          $Counts{'archiveextract'}{'Empty member'}{''}++;
2684
2685       } elsif ($p1 =~ s/^unsupported compr\. method: //) {
2686          #TD do_unzip: p003, unsupported compr. method: 99
2687          $Counts{'archiveextract'}{'Unsupported compression'}{$p1}++;
2688       }
2689       else {
2690          $Counts{'archiveextract'}{'*unknown'}{$p1}++;
2691       }
2692    }
2693
2694    # do_cabextract: archive extraction
2695    elsif ($p1 =~ s/^do_cabextract: //) {
2696       #TD do_cabextract: can't parse toc line:  File size | Date       Time     | Name
2697       #TD do_cabextract: can't parse toc line: All done, no errors.
2698       $Totals{'archiveextract'}++;     next unless ($Collecting{'archiveextract'});
2699
2700       if ($p1 =~ /^([^:]+):\s*(.*)/) {
2701          $Counts{'archiveextract'}{"\u$1"}{$2}++;
2702       } else {
2703          $Counts{'archiveextract'}{$p1}{''}++;
2704       }
2705    }
2706
2707    elsif ($p1 =~ /^(?:\(!\) *)?SA TIMED OUT,/) {
2708       $Totals{'satimeout'}++;
2709    }
2710
2711    elsif ($p1 =~ /^mangling (.*)$/) {
2712       $p1 = $1;
2713       if ($p1 =~ /^by (.+?) failed: (.+?), mail will pass unmodified$/) {
2714          #TD mangling by altermine failed: SomeText, mail will pass unmodified
2715          $Totals{'defangerror'}++;        next unless ($Collecting{'defangerror'});
2716          $Counts{'defangerror'}{$1}{$2}++;
2717       }
2718       # other mangle message skipped
2719       else {
2720          #TD mangling YES: 1 (orig: 1), discl_allowed=0, <from@example.com> -> <to@sample.net>
2721          #TD mangling by built-in defanger: 1, <user@example.com>
2722          next;
2723       }
2724    }
2725    elsif ($p1 =~ /^DEFANGING MAIL: (.+)$/) {
2726       # log_level 1
2727       #TD DEFANGING MAIL: WARNING: possible mail bomb, NOT CHECKED FOR VIRUSES:\n  Exceeded storage quota 5961070 bytes by d...
2728       #TD DEFANGING MAIL: WARNING: bad headers - Improper use of control character (char 0D hex): To: <to@example.com\\r>,\\n\\t<to@example.com>
2729       # could use instead...
2730       #do_log(1,"mangling by %s (%s) done, new size: %d, orig %d bytes", $actual_mail_mangle, $mail_mangle, $repl_size, $msginfo->msg_size);
2731       $Totals{'defanged'}++;        next unless ($Collecting{'defanged'});
2732       $Counts{'defanged'}{$1}++;
2733    }
2734
2735    elsif ($p1 =~ /^PenPalsSavedFromKill [-.\d]+,/) {
2736       #TD PenPalsSavedFromKill 8.269-3.160, <ulyanov@steelpro.com.ua> -> <recipient1@recipientdomain.com>
2737       $Totals{'penpalsaved'}++;
2738    }
2739
2740    # I don't know how many variants of time outs there are... I suppose we'll fix as we go
2741    elsif (($p1 =~ /^\(!+\)([^ ]*) is taking longer than \d+ s and will be killed/) or
2742           ($p1 =~ /^\(!+\)(.*) av-scanner FAILED: timed out/) or
2743           ($p1 =~ /^(?:\(!+\))?(.*): timed out/))
2744    {
2745       #TD (!)/usr/local/bin/uvscan is taking longer than 10 s and will be killed
2746       #TD (!!)NAI McAfee AntiVirus (uvscan) av-scanner FAILED: timed out
2747       #TD ClamAV-clamd: timed out, retrying (1)
2748       #TD (!)Sophie: timed out, retrying (2)
2749
2750       $Totals{'avtimeout'}++;                next unless ($Collecting{'avtimeout'});
2751       $Counts{'avtimeout'}{$1}++;
2752    }
2753    elsif (($p2) = ($p1 =~ /SMTP shutdown: (.*)$/)) {                      # log level -1
2754       #TD SMTP shutdown: Error writing a SMTP response to the socket: Broken pipe at (eval 49) line 836, <GEN232> line 51.
2755       #TD SMTP shutdown: tempdir is to be PRESERVED: /var/amavis/tmp/amavis-20070704T095350-13145
2756       strip_trace($p2);
2757       if ($p2 =~ /^tempdir is to be PRESERVED: (.*)\/([^\/]+)$/) {
2758          $Totals{'tmppreserved'}++;
2759          $Counts{'tmppreserved'}{$1}{$2}++   if ($Collecting{'tmppreserved'});
2760          $p2 = "Preserved tempdir in $1";
2761       }
2762       $Totals{'warningsmtpshutdown'}++;      next unless ($Collecting{'warningsmtpshutdown'});
2763       $Counts{'warningsmtpshutdown'}{ucfirst($p2)}++;
2764    }
2765
2766    elsif (($p1 =~ /PRESERVING EVIDENCE in (.*)\/([^\/]+)$/) or
2767          ($p1 =~ /tempdir is to be PRESERVED: (.*)\/([^\/]+)$/)) {
2768       #TD (!)TempDir removal: tempdir is to be PRESERVED: /var/amavis/tmp/amavis-20080110T173606-05767
2769       # log level -1
2770       #TD PRESERVING EVIDENCE in /var/amavis/tmp/amavis-20070704T111558-14883
2771       $Totals{'tmppreserved'}++;             next unless ($Collecting{'tmppreserved'});
2772       $Counts{'tmppreserved'}{$1}{$2}++;
2773    }
2774
2775    elsif ($p1 =~ /^Open relay\? Nonlocal recips but not originating/) {
2776       $Totals{'warningsecurity'}++;
2777       $Counts{'warningsecurity'}{$p1}++    if ($Collecting{'warningsecurity'});
2778    }
2779
2780    # keep before general warnings below, so sadiag gets first crack at log
2781    # lines beginning with "(!) ...".
2782    elsif ($p1 =~ /^(?:\(!+\))?\!?SA (warn|info|error): (.*)$/) {
2783       #TD SA warn: FuzzyOcr: Cannot find executable for gocr
2784       my ($level,$msg) = ($1,$2);
2785
2786       # XXX later, maybe break out stats on FuzzyOcr
2787       # skip "image too small" for now
2788       if ($msg =~ /^FuzzyOcr: Skipping .+, image too small$/) {
2789          #TD SA warn: FuzzyOcr: Skipping ocrad, image too small
2790          #TD SA warn: FuzzyOcr: Skipping ocrad-decolorize, image too small
2791          #$Counts{'sadiags'}{'fuzzyocr'}{'image too small'}++;
2792          next;
2793       }
2794       elsif ($msg =~ /dns: \[\.\.\.\]/) {
2795          #TD SA info: dns: [...] ;; ADDITIONAL SECTION (1 record)
2796          next;
2797       }
2798       # canonicalize some PIDs and IDs
2799       elsif ($msg =~ s/^pyzor: \[\d+\] error/pyzor: [<PID>] error/) {
2800          #TD SA info: pyzor: [11550] error: TERMINATED, signal 15 (000f)
2801       }
2802       elsif ($msg =~ /dns: no likely matching queries for id \d+/) {
2803          $msg =~ s/\d+/<ID>/;
2804       }
2805       elsif ($msg =~ /dns: no callback for id \d+/) {
2806          $msg =~ s/\d+.*$/<ID>.../;
2807       }
2808
2809       # report other SA warn's
2810       $Totals{'sadiags'}++;
2811       next unless ($Collecting{'sadiags'});
2812       $Counts{'sadiags'}{ucfirst($level)}{$msg}++;
2813    }
2814
2815    # catchall for most other warnings
2816    elsif (($p1 =~ /^\(!+\)/) or
2817           ($p1 =~ /^TROUBLE/) or
2818           ($p1 =~ /Can't (?:connect to UNIX|send to) socket/) or
2819           ($p1 =~ /: Empty result from /) or
2820           ($p1 =~ /: Error reading from socket: Connection reset by peer/) or
2821           ($p1 =~ /open\(.*\): Permission denied/) or
2822           ($p1 =~ /^_?WARN: /) or
2823           ($p1 =~ /Can't send SIG \d+ to process \[\d+\]: Operation not permitted/) or
2824           ($p1 =~ /(policy protocol: INVALID(?: AM\.PDP)? ATTRIBUTE LINE: .*)$/) or
2825           ($p1 =~ /(DKIM signature verification disabled, corresponding features not available. If not intentional.*)$/)
2826          )
2827    {
2828       #TD (!)loading policy bank "AM.PDP-SOCK": unknown field "0"
2829       #TD (!!)policy_server FAILED: SQL quarantine code not enabled at (eval 37) line 306, <GEN6> line 4.
2830       #TD (!!)policy_server FAILED: Can't open file /var/spool/amavis/quarantine/spam-CFJYXmeS+FLy: Permission denied at (eval 37) line 330, <GEN28> line 5.
2831       #TD ClamAV-clamd: Empty result from /var/run/clamav/clamd, retrying (1)
2832       #TDdcc open(/var/dcc/map): Permission denied
2833       #TD TROUBLE in check_mail:  FAILED: Died at /usr/sbin/amavisd-maia line 2872, <GEN4> line 22.
2834       #TD TROUBLE in check_mail: spam_scan FAILED: DBD::mysql::st execute failed: MySQL server has gone away at /usr/sbin/amavisd-maia line 3786, <GEN4> line 3036.
2835       #TD TROUBLE in process_request: DBD::mysql::st execute failed: MySQL server has gone away at (eval 35) line 258, <GEN18> line 3.
2836       #TD TROUBLE in process_request: DBD::mysql::st execute failed: Lost connection to MySQL server during query at (eval 35) line 258, <GEN3> line 3.
2837       #TD TROUBLE in process_request: Can't call method "disconnect" on an undefined value at /usr/sbin/amavisd-maia line 2895, <GEN4> line 22.
2838       #TD TROUBLE: recipient not done: <to@example.com> smtp response ...
2839       #TD (!!)TROUBLE in process_request: Can't create file /var/amavis/tmp/amavis-98/email.txt: File exists at /usr/local/sbin/amavisd line 4774, <GEN12> line 4.
2840       #TD TROUBLE: lookup table is an unknown object: object ...
2841       #TD (!) policy protocol: INVALID ATTRIBUTE LINE: /var/spool/courier/tmp/114528/D967099\n
2842       #TD (!) policy protocol: INVALID AM.PDP ATTRIBUTE LINE: /var/spool/courier/tmp/114528/D967099\n
2843       #TD _WARN: bayes: cannot open bayes databases /var/spool/amavis/.spamassassin/bayes_* R/W: lock failed: Interrupted system call\n
2844
2845       $p1 =~ s/^\(!+\)s*//;
2846
2847       if ($p1 =~ /^WARN: (Using cpio instead of pax .*)$/) {
2848          #TD (!)WARN: Using cpio instead of pax can be a security risk; please add:  $pax='pax';  to amavisd.conf and check that the pax(1) utility is available on the system!
2849          $Totals{'warningsecurity'}++;
2850          $Counts{'warningsecurity'}{$1}++    if ($Collecting{'warningsecurity'});
2851          next;
2852       }
2853
2854       $p1 =~ s/, retrying\s+\(\d+\)$//;
2855       strip_trace($p1);
2856
2857       # canonicalize variations of the same message
2858       $p1 =~ s/^run_av \(([^,]+), built-in i\/f\)/$1/;
2859       $p1 =~ s/ av-scanner FAILED: CODE\(0x[^)]+\)/:/;
2860       $p1 =~ s/^(.+: Too many retries to talk to \S+) .*/$1/;
2861
2862       if (($p1 =~ /(\S+): Can't (?:connect|send) to (?:UNIX )?(.*)$/) or
2863           ($p1 =~ /(\S+): (Too many retries to talk to .*)$/))
2864       {
2865
2866          #TD (!)ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd.socket: No such file or directory, retrying (2)
2867          #TD (!)ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd: Connection refused, retrying (2)
2868          #TD ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd: Connection refused, retrying (1)
2869          #TD ClamAV-clamd: Can't send to socket /var/run/clamav/clamd: Transport endpoint is not connected, retrying (1)
2870          #TD Sophie: Can't send to socket /var/run/sophie: Transport endpoint is not connected, retrying (1)
2871          #TD (!)run_av (Sophie, built-in i/f): Too many retries to talk to /var/run/sophie (timed out) at (eval 55) line 310, <GEN16> line 16.
2872          #TD (!)run_av (ClamAV-clamd, built-in i/f): Too many retries to talk to /var/run/clamav/clamd.socket (Can't connect to UNIX socket /var/run/clamav/clamd.socket: No such file or directory) at (eval 52) line 310.
2873          #TD (!!)ClamAV-clamd av-scanner FAILED: CODE(0x804fa08) Too many retries to talk to /var/run/clamav/clamd.socket (Can't connect to UNIX socket /var/run/clamav/clamd.socket: No such file or directory) at (eval 52) line 310. at (eval 52) line 511.
2874          #TD (!!)Sophie av-scanner FAILED: CODE(0x814fd24) Too many retries to talk to /var/run/sophie (timed out) at (eval 55) line 310, <GEN16> line 16. at (eval 55) line 511, <GEN16> line 16.
2875
2876          $Totals{'avconnectfailure'}++;
2877          $Counts{'avconnectfailure'}{$1}{ucfirst($2)}++     if ($Collecting{'avconnectfailure'});
2878          next;
2879       }
2880
2881       # simplify or canonicalize variations of the same message
2882       $p1 =~ s/^TROUBLE(:| in) //;
2883       $p1 =~ s/^_?WARN: //;
2884       $p1 =~ s/Can't create file \S+: (.+)$/Can't create file: $1/;
2885       $p1 =~ s/Can't send SIG \d+ to process \[\d+\]/Can't send SIG to process/;
2886
2887       $Totals{'warning'}++;      next unless ($Collecting{'warning'});
2888       $Counts{'warning'}{$p1}++;
2889    }
2890
2891    # Begin forced warnings: Keep this code below warning catchall
2892    elsif ($p1 =~ /^lookup_sql: /) {
2893       #TD lookup_sql: 2006, MySQL server has gone away
2894       $Totals{'warningsql'}++;   next unless ($Collecting{'warningsql'});
2895       $Counts{'warningsql'}{'SQL died'}++;
2896
2897    } elsif (($reason,$item) = ($p1 =~ /^connect_to_sql: ([^']+) '\S+': (.*?)(?: \(\d+\))?$/) or
2898             ($item,$reason) = ($p1 =~ /^lookup_sql_field\((.*)\) \(WARN: (no such field in the SQL table)\)/)) {
2899       #TD connect_to_sql: unable to connect to DSN 'DBI:mysql:maia:sqlhost1.example.com': Lost connection to MySQL server during query
2900       #TD connect_to_sql: unable to connect to DSN 'DBI:mysql:maia:sqlhost2.example.com': Can't connect to MySQL server on 'sqlhost2.example.com' (111)
2901       #TD lookup_sql_field(id) (WARN: no such field in the SQL table), "from@example.com" result=undef
2902       $Totals{'warningsql'}++;   next unless ($Collecting{'warningsql'});
2903       $Counts{'warningsql'}{ucfirst("$reason: $item")}++;
2904    }
2905    # End forced warnings
2906
2907    # panic
2908    elsif ( ($p2) = ($p1 =~ /^(?:\(!\)\s*)?PANIC, (.*)$/)) {
2909       #TD PANIC, PANIC, SA produced a clone process of [19122], TERMINATING CLONE [19123]
2910
2911       $Totals{'panic'}++;        next unless ($Collecting{'panic'});
2912       $Counts{'panic'}{$p2}++;
2913
2914    }
2915
2916    # fatal
2917    elsif ( $p1 =~ /^Requesting process rundown after fatal error$/) {
2918       #TD Requesting process rundown after fatal error
2919       $Totals{'fatal'}++;        next unless ($Collecting{'fatal'});
2920       $Counts{'fatal'}{$p1}++;
2921
2922    # DCC
2923    } elsif (($reason) = ($p1 =~ /^(missing message body; fatal error)/) or
2924             ($reason) = ($p1 =~ /^(try to start dccifd)/)) {
2925       $Totals{'dccerror'}++;     next unless ($Collecting{'dccerror'});
2926       $Counts{'dccerror'}{ucfirst($reason)}++;
2927    }
2928    elsif ($p1 =~ /^continue not asking DCC \d+ seconds after failure/) {
2929       $Totals{'dccerror'}++;     next unless ($Collecting{'dccerror'});
2930       $Counts{'dccerror'}{'Continue not asking DCC after failure'}++;
2931    }
2932    elsif ($p1 =~ /^no DCC answer from (\S+) after \d+ ms$/) {
2933       $Totals{'dccerror'}++;     next unless ($Collecting{'dccerror'});
2934       $Counts{'dccerror'}{"No answer from $1"}++;
2935    }
2936
2937    elsif ( ($reason, $from, $to) = ($p1 =~ /^skip local delivery\((\d+)\): <(.*?)> -> <(.*?)>$/)) {
2938       $Totals{'localdeliveryskipped'}++;   next unless ($Collecting{'localdeliveryskipped'});
2939       $from = '<>' if ($from eq '');
2940       $reason = $reason == 1 ? "No localpart" : $reason == 2 ? "Local alias is null" : "Other";
2941       $Counts{'localdeliveryskipped'}{$reason}{$from}{$to}++;
2942    }
2943
2944    # hard and soft whitelisted/blacklisted
2945    elsif ($p1 =~ /^wbl: (.*)$/) {
2946       # ignore wbl entries, can't think of good way to reliably summarize.
2947       # and 'black or whitelisted by all' makes using by-white or -black list
2948       # groupings impossible
2949       next;
2950 =cut
2951       $p1 = $1;
2952
2953       # TD wbl: black or whitelisted by all recips
2954       next if ($p1 =~ /^black or whitelisted/); # not clear how to report this, so skip
2955       next if ($p1 =~ /^checking sender/);                    # ll 4
2956       next if ($p1 =~ /^(LDAP) query keys/);                  # ll 5
2957       next if ($p1 =~ /^(LDAP) recip/);                       # ll 5
2958       next if ($p1 =~ /^recip <[^>]*> (?:black|white)listed sender/);  # ll 5
2959
2960       # lookup order: SQL, LDAP, static
2961       if ($p1 =~ s/^\(SQL\) recip <[^>]*>//) {
2962          next if ($p1 =~ /^, \S+ matches$/);                  # ll 5
2963          next if ($p1 =~ /^, rid=/);                          # ll 4
2964          next if ($p1 =~ /^ is neutral to sender/);           # ll 5
2965          next if ($p1 =~ /^ (?:white|black)listed sender </); # ll 5
2966          # ll -1
2967          #wbl: (SQL) recip <%s> whitelisted sender <%s>, '.  unexpected wb field value
2968       }
2969       #ll2
2970       # wbl: (SQL) soft-(white|black)listed (%s) sender <%s> => <%s> (rid=%s)',  $val, $sender, $recip, $user_id);
2971       # multiple senders: message sender, then "from", etc.
2972       #ll2
2973       # wbl: soft-(white|black)listed (%s) sender <%s> => <%s>,
2974
2975       #TD wbl: whitelisted sender <sender@example.com>
2976       #TD wbl: soft-whitelisted (-3) sender <from@example.com> => <to@sample.net>, recip_key="."
2977       #TD wbl: whitelisted by user@example.com, but not by all, sender <bounces@example.net>, <user@example.org>
2978       # wbl: (whitelisted|blacklisted|black or whitelisted by all recips|(white|black)listed by xxx,yyy,... but not by all) sender %s
2979
2980       if ($p1 =~ /^(?:\(SQL\) )?(?:(soft)-)?((?:white|black)listed)(?: \([^)]+\))? sender <([^>]*)>/) {
2981          my ($type,$list,$sender) = ($1,$2,$3);
2982          $Totals{$list}++;       next unless ($Collecting{$list});
2983          $type = $type ? 'Soft' : 'Hard' ;
2984          my ($localpart, $domainpart) = split (/@/, lc $sender);
2985          ($localpart, $domainpart) = ($sender, '*unspecified')   if ($domainpart eq '');
2986          $Counts{$list}{$type}{$domainpart}{$localpart}++;
2987       }
2988       else {
2989          inc_unmatched('wbl');
2990          next;
2991       }
2992 =cut
2993    }
2994
2995    # XXX: WHITELISTED or BLACKLISTED should be caught in SPAM tag above
2996    elsif (($p1 =~ /^white_black_list: whitelisted sender/) or
2997           ($p1 =~ /.* WHITELISTED/) ) {
2998       $Totals{'whitelisted'}++;
2999
3000    } elsif (($p1 =~ /^white_black_list: blacklisted sender/) or
3001                 ( $p1 =~ /.* BLACKLISTED/) ) {
3002       $Totals{'blacklisted'}++;
3003
3004    } elsif ($p1 =~ /^Turning AV infection into a spam report: score=([^,]+), (.+)$/) {
3005       #TD Turning AV infection into a spam report: score=4.1, AV:Sanesecurity.ScamL.375.UNOFFICIAL=4.1
3006       #TD Turning AV infection into a spam report: score=3.4, AV:Sanesecurity.Phishing.Cur.180.UNOFFICIAL=3.1,AV:Sanesecurity.Phishing.Cur.180.UNOFFICIAL=3.4
3007       #BAT.Backdoor.Poisonivy.E178-SecuriteInfo.com
3008
3009       next unless ($Collecting{'malwaretospam'});
3010       #my $score_max = $1;
3011       my @list = split (/,/, $2);
3012       @list = unique_list(\@list);
3013       foreach (@list) {
3014          my ($name,$score) = split (/=/,$_);
3015          $name =~ s/^AV://;
3016          my $type = $name =~ s/\.UNOFFICIAL$// ? 'Unofficial' : 'Official';
3017          # strip trailing numeric variant (...Phishing.Cur.863)
3018          my $variant = $name =~ s/([.-]\d+)$// ?  $1 : '*invariant';
3019          $Counts{'malwaretospam'}{$type}{$name}{$variant}{$score}++
3020       }
3021
3022    # The virus_scan line reports only the one virus name when more than one scanner detects a virus.
3023    # Use instead the ask_av and run_av lines (see below)
3024    #
3025    #} elsif ( my ($malware, $scanners) = ($p1 =~ /virus_scan: \(([^)]+)\), detected by \d+ scanners: (.*)$/ )) {
3026       #TD virus_scan: (HTML.Phishing.Bank-43), detected by 1 scanners: ClamAV-clamd
3027       #TD virus_scan: (Worm.SomeFool.D, Worm.SomeFool.D), detected by 1 scanners: ClamAV-clamd
3028       #TD virus_scan: (Trojan.Downloader.Small-9993), detected by 2 scanners: ClamAV-clamd, NAI McAfee AntiVirus (uvscan)
3029    #   foreach (split /, /, $scanners) {
3030    #      #$Totals{'malwarebyscanner'}++;       # No summary output: redundant w/malwarepassed,malwareblocked}
3031    #      $Counts{'malwarebyscanner'}{"$_"}{$malware}++;
3032    #   }
3033
3034    } elsif ($p1 =~ /^(?:ask_av|run_av) (.*)$/) {
3035       next unless ($Collecting{'malwarebyscanner'});
3036
3037       if (my ($scanner, $name) = ($1 =~ /^\((.+)\):(?: [^:]+)? INFECTED: ([^,]+)/)) {
3038          #TD ask_av (ClamAV-clamd): /var/amavis/tmp/amavis-20070830T070403-13776/parts INFECTED: Email.Malware.Sanesecurity.07082700
3039          #TD run_av (NAI McAfee AntiVirus (uvscan)): INFECTED: W32/Zhelatin.gen!eml, W32/Zhelatin.gen!eml
3040          my $type = $name =~ s/\.UNOFFICIAL$// ? 'Unofficial' : 'Official';
3041          my $variant = '';
3042          if ($name =~ s/([.-]\d+)$//) {     # strip trailing numeric variant (...Phishing.Cur.863)
3043             $variant = $1;
3044          }
3045          $Counts{'malwarebyscanner'}{$scanner}{$type}{$name}{$variant}++;
3046       }
3047       # currently ignoring other ask_av or run_av lines
3048    }
3049
3050    # Extra Modules loaded at runtime
3051    #TD extra modules loaded after daemonizing/chrooting: Mail/SPF/Query.pm
3052    elsif (($item) = ( $p1 =~ /^extra modules loaded(?: after daemonizing(?:\/chrooting)?)?: (.+)$/)) {
3053       #TD extra modules loaded: PerlIO.pm, PerlIO/scalar.pm
3054       foreach my $code (split /, /, $item) {
3055          #TD extra modules loaded: unicore/lib/gc_sc/Digit.pl, unicore/lib/gc_sc/SpacePer.pl
3056          # avoid useless reporting of pseudo-modules which can't be pre-loaded once
3057          unless ($code =~ m#^unicore/lib/#) {
3058             $Totals{'extramodules'}++;
3059             $Counts{'extramodules'}{$code}++    if ($Collecting{'extramodules'});
3060          }
3061       }
3062
3063    # Timing report
3064    } elsif (my ($total,$report) = ( $p1 =~ /^(?:size: \d+, )?TIMING \[total (\d+) ms(?:, [^]]+)?\] - (.+)$/)) {
3065      next if ($report =~ /^got data/);    # skip amavis release timing
3066       #TD TIMING [total 5808 ms] - SMTP greeting: 5 (0%)0, SMTP LHLO: 1 (0%)0, SMTP pre-MAIL: 2 (0%)0, SMTP pre-DATA-flush: 5 (0%)0, SMTP DATA: 34 (1%)1, check_init: 1 (0%)1
3067       # older format, maia mailguard
3068       #TD TIMING [total 3795 ms] - SMTP EHLO: 1 (0%), SMTP pre-MAIL: 0 (0%), maia_read_system_config: 1 (0%), maia_get_mysql_size_limit: 0 (0%), SA check: 3556 (94%), rundown: 0 (0%)
3069       # v2.8.1
3070       # .... size: 3815, TIMING [total 1901 ms, cpu 657 ms] - ...
3071
3072
3073       # Timing line is incomplete - let's report it
3074       if ($p1 !~ /\d+ \(\d+%\)\d+$/ and $p1 !~ /\d+ \(\d+%\)$/) {
3075          inc_unmatched('timing');
3076          next;
3077       }
3078
3079       if ($Opts{'timings'}) {
3080          my @pairs = split(/[,:] /, $report);
3081          while (my ($key,$value) = @pairs) {
3082             #4 (0%)0
3083             my ($ms) = ($value =~ /^([\d.]+) /);
3084             # maintain a per-test list of timings
3085             push @{$Timings{$key}}, $ms;
3086             shift @pairs; shift @pairs;
3087          }
3088          push @TimingsTotals, $total;
3089       }
3090
3091    } elsif ((($total,$report) = ( $p1 =~ /^TIMING-SA total (\d+) ms - (.+)$/ )) or
3092             (($total,$report) = ( $p1 =~ /^TIMING-SA \[total (\d+) ms, cpu \d+ ms\] - (.+)$/ ))) {
3093          #TIMING-SA [total 3219 ms, cpu 432 ms] - parse: 6 (0.2%), ext
3094       #TD TIMING-SA total 5478 ms - parse: 1.69 (0.0%), extract_message_metadata: 16 (0.3%), get_uri_detail_list: 2 (0.0%), tests_pri_-1000: 25 (0.4%), tests_pri_-950: 0.67 (0.0%), tests_pri_-900: 0.83 (0.0%), tests_pri_-400: 19 (0.3%), check_bayes: 17 (0.3%), tests_pri_0: 5323 (97.2%), check_spf: 12 (0.2%), poll_dns_idle: 0.81 (0.0%), check_dkim_signature: 1.50 (0.0%), check_razo r2: 5022 (91.7%), check_dcc: 192 (3.5%), check_pyzor: 0.02 (0.0%), tests_pri_500: 9 (0.2%), tests_pri_1000: 24 (0.4%), total_awl: 23 (0.4%), check_awl: 10 (0.2%), update_awl: 8 (0.1%), learn: 36 (0.7%), get_report: 1.77 (0.0%)
3095
3096       # Timing line is incomplete - let's report it
3097       if ($p1 !~ /[\d.]+ \([\d.]+%\)[\d.]+$/ and $p1 !~ /[\d.]+ \([\d.]+%\)$/) {
3098          inc_unmatched('timing-sa');
3099          next;
3100       }
3101       if ($Opts{'sa_timings'}) {
3102          my @pairs = split(/[,:] /, $report);
3103          while (my ($key,$value) = @pairs) {
3104             #4 (0%)0
3105             my ($ms) = ($value =~ /^([\d.]+) /);
3106             # maintain a per-SA test list of timings
3107             push @{$TimingsSA{$key}}, $ms;
3108             shift @pairs; shift @pairs;
3109          }
3110          push @TimingsSATotals, $total;
3111       }
3112
3113    # Bounce killer: 2.6+
3114    } elsif ($p1 =~ /^bounce (.*)$/) {
3115       #TD bounce killed, <user@example.com> -> <to@example.net>, from: user@example.com, message-id: <CA8E335-CC-2EFB@example.com>, return-path: <user@example.com>
3116       #TD bounce rescued by domain, <user@example.com> -> <to@example.net>, from: user@example.com, message-id: <CA8E335-CC-2EFB@example.com>, return-path: <user@example.com>
3117       #TD bounce rescued by originating, <user@example.com> -> <to@example.net>, from: user@example.com, message-id: <CA8E335-CC-2EFB@example.com>, return-path: <user@example.com>
3118       #TD bounce rescued by: pen pals disabled, <user@example.com> -> <to@example.net>, from: user@example.com, message-id: <CA8E335-CC-2EFB@example.com>, return-path: <user@example.com>
3119       $p2 = $1;
3120
3121       if ($p2 =~ /^killed, <(.+?)> -> /) {
3122          $Totals{'bouncekilled'}++;
3123          $Counts{'bouncekilled'}{$1 eq '' ? '<>' : $1}++    if ($Collecting{'bouncekilled'});
3124       }
3125       elsif ($p2 =~ /^rescued by ([^,]+), <(.+?)> -> /) {
3126          # note: ignores "rescued by: pen pals disabled"
3127          $Totals{'bouncerescued'}++;
3128          $Counts{'bouncerescued'}{'By ' . $1}{$2 eq '' ? '<>' : $2}++    if ($Collecting{'bouncerescued'});
3129       }
3130       elsif ($p2 =~ /^unverifiable, <(.+?)> -> /) {
3131          # note: ignores "rescued by: pen pals disabled"
3132          $Totals{'bounceunverifiable'}++;
3133          $Counts{'bounceunverifiable'}{$1 eq '' ? '<>' : $1}++    if ($Collecting{'bounceunverifiable'});
3134       }
3135       #TD bounce unverifiable, <postmaster@nurturegood.com> -> <dave@davewolloch.com>
3136       #TD bounce unverifiable, <> -> <Dave@davewolloch.com>
3137    }
3138
3139    # Decoders
3140    elsif (my ($suffix, $info) = ( $p1 =~ /^Internal decoder for (\.\S*)\s*(?:\(([^)]*)\))?$/)) {
3141       #TD Internal decoder for .gz   (backup, not used)
3142       #TD Internal decoder for .zip
3143       next unless ($Opts{'startinfo'});
3144       $StartInfo{'Decoders'}{'Internal'}{$suffix} = $info;
3145    }
3146
3147    elsif (($suffix, $decoder) = ( $p1 =~ /^No decoder for\s+(\.\S*)\s*(?:tried:\s+(.*))?$/)) {
3148       #TD No decoder for       .tnef tried: tnef
3149       # older
3150       #TD No decoder for       .doc
3151       next unless ($Opts{'startinfo'});
3152       $StartInfo{'Decoders'}{'None'}{$suffix} = "tried: " . ($decoder ? $decoder : "unknown");
3153    }
3154
3155    elsif (($suffix, $decoder) = ( $p1 =~ /^Found decoder for\s+(\.\S*)\s+at\s+(.*)$/)) {
3156       #TD Found decoder for    .bz2  at /usr/bin/bzip2 -d
3157       #TD Found decoder for    .bz2  at /usr/bin/7za (backup, not used)
3158       next unless ($Opts{'startinfo'});
3159       $StartInfo{'Decoders'}{'External'}{$suffix} = exists $StartInfo{'Decoders'}{'External'}{$suffix} ?
3160               join '; ', $StartInfo{'Decoders'}{'External'}{$suffix}, $decoder : $decoder;
3161    }
3162
3163    # AV Scanners
3164    elsif (my ($tier, $scanner, $location) = ( $p1 =~ /^Found (primary|secondary) av scanner (.+) at (.+)$/)) {
3165       #TD Found primary av scanner NAI McAfee AntiVirus (uvscan) at /usr/local/bin/uvscan
3166       #TD Found secondary av scanner ClamAV-clamscan at /usr/local/bin/clamscan
3167       next unless ($Opts{'startinfo'});
3168       $StartInfo{'AVScanner'}{"\u$tier"}{$scanner} = $location;
3169
3170    } elsif (($tier, $scanner, $location) = ( $p1 =~ /^No (primary|secondary) av scanner: (.+)$/)) {
3171       #TD No primary av scanner: CyberSoft VFind
3172       next unless ($Opts{'startinfo'});
3173       $StartInfo{'AVScanner'}{"\u$tier (not found)"}{$scanner} = '';
3174
3175    } elsif ( (($tier, $scanner) = ( $p1 =~ /^Using internal av scanner code for \(([^)]+)\) (.+)$/)) or
3176              (($tier, $scanner) = ( $p1 =~ /^Using (.*) internal av scanner code for (.+)$/))) {
3177       #TD Using internal av scanner code for (primary) ClamAV-clamd
3178       #TD Using primary internal av scanner code for ClamAV-clamd
3179       next unless ($Opts{'startinfo'});
3180       $StartInfo{'AVScanner'}{"\u$tier internal"}{$scanner} = '';
3181
3182    # (Un)Loaded code, protocols, etc.
3183    } elsif (my ($code, $loaded) = ( $p1 =~ /^(\S+)\s+(?:proto? |base |protocol )?\s*(?:code)?\s+((?:NOT )?loaded)$/)) {
3184       next unless ($Opts{'startinfo'});
3185       $StartInfo{'Code'}{"\u\L$loaded"}{$code} = "";
3186
3187    } elsif (my ($module, $vers) = ( $p1 =~ /^Module (\S+)\s+(.+)$/)) {
3188       #TD Module Amavis::Conf        2.086
3189       next unless ($Opts{'startinfo'});
3190       $StartInfo{'Code'}{'Loaded'}{$module} = $vers;
3191
3192    } elsif (($module, my $families) = ( $p1 =~ /^socket module (\S+),\s+(.+)$/)) {
3193       #TD socket module IO::Socket::IP, protocol families available: INET, INET6
3194       next unless ($Opts{'startinfo'});
3195       $StartInfo{'Code'}{'Loaded'}{$module} = $families;
3196
3197    } elsif (($code, $location) = ( $p1 =~ /^Found \$(\S+)\s+at\s+(.+)$/)) {
3198       #TD Found $file            at /usr/bin/file
3199       #TD Found $uncompress at /usr/bin/gzip -d
3200       next unless ($Opts{'startinfo'});
3201       $StartInfo{'Code'}{'Loaded'}{$code} = $location;
3202
3203    } elsif (($code, $location) = ( $p1 =~ /^No \$(\S+),\s+not using it/)) {
3204       #TD No $dspam,             not using it
3205       next unless ($Opts{'startinfo'});
3206       $StartInfo{'Code'}{'Not loaded'}{$code} = $location;
3207
3208    } elsif (($code, $location) = ( $p1 =~ /^No ext program for\s+([^,]+), (tried: .+)/)) {
3209       #TD No ext program for   .kmz, tried: 7za, 7z
3210       #TD No ext program for   .F, tried: unfreeze, freeze -d, melt, fcat
3211       next unless ($Opts{'startinfo'});
3212       $StartInfo{'Code'}{'Not found'}{$code} = $location;
3213
3214
3215    } elsif ( $p1 =~ /^starting\.\s+(.+) at \S+ (?:amavisd-new-|Maia Mailguard )([^,]+),/) {
3216       #TD starting.  /usr/local/sbin/amavisd at mailhost.example.com amavisd-new-2.5.0 (20070423), Unicode aware, LANG="C"
3217       #TD starting.  /usr/sbin/amavisd-maia at vwsw02.eon.no Maia Mailguard 1.0.2, Unicode aware, LANG=en_US.UTF-8
3218       next unless ($Opts{'startinfo'});
3219       %StartInfo = ()  if !exists $StartInfo{'Logging'};
3220       $StartInfo{'ampath'}    = $1;
3221       $StartInfo{'amversion'} = $2;
3222
3223    } elsif ( $p1 =~ /^config files read: (.*)$/) {
3224       #TD config files read: /etc/amavisd.conf, /etc/amavisd-overrides.conf
3225       next unless ($Opts{'startinfo'});
3226       $StartInfo{'Configs'} = "$1";
3227
3228    } elsif ($p1 =~ /^Creating db in ([^;]+); [^,]+, (.*)$/) {
3229       #TD Creating db in /var/spool/amavis/db/; BerkeleyDB 0.31, libdb 4.4
3230       next unless ($Opts{'startinfo'});
3231       $StartInfo{'db'} = "$1\t($2)";
3232
3233    } elsif ($p1 =~ /^BerkeleyDB-based Amavis::Cache not available, using memory-based local cache$/) {
3234       #TD BerkeleyDB-based Amavis::Cache not available, using memory-based local cache
3235       next unless ($Opts{'startinfo'});
3236       $StartInfo{'db'} = "BerkeleyDB\t(memory-based cache: Amavis::Cache unavailable)";
3237
3238    } elsif (my ($log) = ($p1 =~ /^logging initialized, log (level \d+, (?:STDERR|syslog: \S+))/)) {
3239       next unless ($Opts{'startinfo'});
3240       %StartInfo = ();        # first amavis log entry, clear out previous start info
3241       $StartInfo{'Logging'} = $log;
3242
3243    } elsif (( $p1 =~ /^(:?perl=[^,]*, )?user=([^,]*), EUID: (\d+) [(](\d+)[)];\s+group=([^,]*), EGID: ([\d ]+)[(]([\d ]+)[)]/)) {
3244       # uninteresting...
3245       #next unless ($Opts{'startinfo'});
3246       #$StartInfo{'IDs'}{'user'} = $1;
3247       #$StartInfo{'IDs'}{'euid'} = $2;
3248       #$StartInfo{'IDs'}{'uid'} = $3;
3249       #$StartInfo{'IDs'}{'group'} = $4;
3250       #$StartInfo{'IDs'}{'egid'} = $5;
3251       #$StartInfo{'IDs'}{'gid'} = $6;
3252    } elsif ($p1 =~ /^after_chroot_init: EUID: (\d+) [(](\d+)[)]; +EGID: ([\d ]+)[(]([\d ]+)[)]/) {
3253       #TD after_chroot_init: EUID: 999 (999);  EGID: 54322 54322 54322 (54322 54322 54322)
3254       # uninteresting...
3255
3256    } elsif ($p1 =~ /^SpamAssassin debug facilities: (.*)$/) {
3257       next unless ($Opts{'startinfo'});
3258       $StartInfo{'sa_debug'} = $1;
3259
3260    # amavis >= 2.6.3
3261    } elsif ($p1 =~ /^SpamAssassin loaded plugins: (.*)$/) {
3262       #TD SpamAssassin loaded plugins: AWL, AutoLearnThreshold, Bayes, BodyEval, Check, DCC, DKIM, DNSEval, HTMLEval, HTTPSMismatch, Hashcash, HeaderEval, ImageInfo, MIMEEval, MIMEHeader, Pyzor, Razor2, RelayEval, ReplaceTags, SPF, SpamCop, URIDNSBL, URIDetail, URIEval, VBounce, WLBLEval, WhiteListSubject
3263       next unless ($Opts{'startinfo'});
3264       map { $StartInfo{'SAPlugins'}{'Loaded'}{$_} = '' } split(/, /, $1);
3265
3266    } elsif (($p2) = ( $p1 =~ /^Net::Server: (.*)$/ )) {
3267       next unless ($Opts{'startinfo'});
3268       if ($p2 =~ /^.*starting! pid\((\d+)\)/) {
3269          #TD Net::Server: 2007/05/02-11:05:24 Amavis (type Net::Server::PreForkSimple) starting! pid(4405)
3270          $StartInfo{'Server'}{'pid'} = $1;
3271       } elsif ($p2 =~ /^Binding to UNIX socket file (.*) using/) {
3272          #TD Net::Server: Binding to UNIX socket file /var/spool/amavis/amavisd.sock using SOCK_STREAM
3273          $StartInfo{'Server'}{'socket'} = $1;
3274       } elsif ($p2 =~ /^Binding to TCP port (\d+) on host (.*)$/) {
3275          #TD Net::Server: Binding to TCP port 10024 on host 127.0.0.1
3276          $StartInfo{'Server'}{'ip'} = "$2:$1";
3277       } elsif ($p2 =~ /^Setting ([ug]id) to "([^"]+)"$/) {
3278          $StartInfo{'Server'}{$1} = $2;
3279          #TD Net::Server: Setting gid to "91 91"
3280          #TD Net::Server: Setting uid to "91"
3281       }
3282       # skip others
3283    }
3284
3285    # higher debug level or rare messages skipped last
3286    elsif (! check_ignore_list ($p1, @ignore_list_final)) {
3287       inc_unmatched('final');
3288    }
3289 }
3290
3291 ########################################
3292 # Final tabulations, and report printing
3293
3294
3295 # spamblocked includes spamdiscarded; adjust here
3296 $Totals{'spamblocked'} -= $Totals{'spamdiscarded'};
3297
3298
3299 #Totals: Blocked/Passed totals
3300 $Totals{'totalblocked'} += $Totals{$_} foreach (
3301    qw(
3302       malwareblocked
3303       bannednameblocked
3304       uncheckedblocked
3305       spamblocked
3306       spamdiscarded
3307       spammyblocked
3308       badheaderblocked
3309       oversizedblocked
3310       mtablocked
3311       cleanblocked
3312       tempfailblocked
3313       otherblocked
3314    ));
3315
3316 $Totals{'totalpassed'} += $Totals{$_} foreach (
3317    qw(
3318       malwarepassed
3319       bannednamepassed
3320       uncheckedpassed
3321       spampassed
3322       spammypassed
3323       badheaderpassed
3324       oversizedpassed
3325       mtapassed
3326       cleanpassed
3327       tempfailpassed
3328       otherpassed
3329    ));
3330
3331 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
3332 #Totals: Ham/Spam
3333
3334 $Totals{'totalmalware'} += $Totals{$_} foreach (
3335    qw(malwarepassed malwareblocked));
3336
3337 $Totals{'totalbanned'} += $Totals{$_} foreach (
3338    qw(bannednamepassed bannednameblocked));
3339
3340 $Totals{'totalunchecked'} += $Totals{$_} foreach (
3341    qw(uncheckedpassed uncheckedblocked));
3342
3343 $Totals{'totalspammy'} += $Totals{$_} foreach (
3344    qw(spammypassed spammyblocked));
3345
3346 $Totals{'totalbadheader'} += $Totals{$_} foreach (
3347    qw(badheaderpassed badheaderblocked));
3348
3349 $Totals{'totaloversized'} += $Totals{$_} foreach (
3350    qw(oversizedpassed oversizedblocked));
3351
3352 $Totals{'totalmta'} += $Totals{$_} foreach (
3353    qw(mtapassed mtablocked));
3354
3355 $Totals{'totalclean'} += $Totals{$_} foreach (
3356    qw(cleanpassed cleanblocked));
3357
3358 $Totals{'totalother'} += $Totals{$_} foreach (
3359    qw(tempfailpassed tempfailblocked otherpassed otherblocked));
3360
3361 $Totals{'totalspam'} += $Totals{$_} foreach (
3362    qw(spampassed spamblocked spamdiscarded totalspammy));
3363
3364 # everything lower priority than SPAMMY is considered HAM
3365 $Totals{'totalham'} += $Totals{$_} foreach (
3366    qw(totalbadheader totaloversized totalmta totalclean));
3367
3368 $Totals{'totalmsgs'} += $Totals{$_} foreach (
3369    qw(totalmalware totalbanned totalunchecked totalspam totalham totalother));
3370
3371 # Print the summary report if any key has non-zero data.
3372 # Note: must explicitely check for any non-zero data,
3373 # as Totals always has some keys extant.
3374 #
3375 if ($Opts{'summary'}) {
3376    for (keys %Totals) {
3377       if ($Totals{$_}) {
3378          print_summary_report (@Sections);
3379          last;
3380       }
3381    }
3382 }
3383
3384 # Print the detailed report, if detail is sufficiently high
3385 #
3386 if ($Opts{'detail'} >= 5) {
3387    print_detail_report (@Sections);
3388    printAutolearnReport;
3389    printSpamScorePercentilesReport;
3390    printSpamScoreFrequencyReport;
3391    printSARulesReport;
3392    printTimingsReport("Scan Timing Percentiles", \%Timings, \@TimingsTotals, $Opts{'timings'});
3393    printTimingsReport("SA Timing Percentiles", \%TimingsSA, \@TimingsSATotals, 0-$Opts{'sa_timings'});
3394    printStartupInfoReport        if ($Opts{'detail'} >= 10);
3395 }
3396
3397 #{
3398 #use Data::Dumper;
3399 #print Dumper(\%p0ftags);
3400 #print Dumper($Counts{'p0f'});
3401 #}
3402
3403 # Finally, print any unmatched lines
3404 #
3405 print_unmatched_report();
3406
3407 # Evaluates a given line against the list of ignore patterns.
3408 #
3409 sub check_ignore_list($ \@) {
3410    my ($line, $listref) = @_;
3411
3412    foreach (@$listref) {
3413       return 1 if $line =~ /$_/;
3414    }
3415
3416    return 0;
3417 }
3418
3419
3420 # Spam score percentiles report
3421 #
3422 =pod
3423    ==================================================================================
3424    Spam Score Percentiles        0%       50%       90%       95%       98%      100%
3425    ----------------------------------------------------------------------------------
3426    Score Spam (100)           6.650    21.906    34.225    36.664    38.196    42.218
3427    Score Ham (1276)         -17.979    -2.599     0.428     2.261     3.472     6.298
3428    ==================================================================================
3429 =cut
3430 sub printSpamScorePercentilesReport {
3431    return unless ($Opts{'score_percentiles'} and keys %SpamScores);
3432
3433    #printf "Scores $_ (%d): @{$SpamScores{$_}}\n", scalar @{$SpamScores{$_}} foreach keys %SpamScores;
3434    my (@p, @sorted);
3435    my @percents = split /[\s,]+/, $Opts{'score_percentiles'};
3436    my $myfw2 = $fw2 - 1;
3437
3438    print  "\n", $sep1 x $fw1, $sep1 x $fw2 x @percents;
3439    printf "\n%-${fw1}s" . "%${myfw2}s%%" x @percents ,   "Spam Score Percentiles", @percents;
3440    print  "\n", $sep2 x $fw1, $sep2 x $fw2 x @percents;
3441
3442    foreach my $ccat (keys %SpamScores) {
3443       @sorted = sort { $a <=> $b } @{$SpamScores{$ccat}};
3444       @p = get_percentiles (@sorted, @percents);
3445       printf "\n%-${fw1}s" . "%${fw2}.3f" x scalar (@p), "Score \u$ccat (" . scalar (@sorted) . ')', @p;
3446    }
3447
3448    print  "\n", $sep1 x $fw1, $sep1 x $fw2 x @percents, "\n";
3449 }
3450
3451 # Spam score frequency report
3452 #
3453 =pod
3454    ======================================================================================================
3455    Spam Score Frequency      <= -10     <= -5      <= 0      <= 5     <= 10     <= 20     <= 30      > 30
3456    ------------------------------------------------------------------------------------------------------
3457    Hits (1376)                   29       168       921       170        29        33         1        25
3458    Percent of Hits            2.11%    12.21%    66.93%    12.35%     2.11%     2.40%     0.07%     1.82%
3459    ======================================================================================================
3460 =cut
3461 sub printSpamScoreFrequencyReport {
3462    return unless ($Opts{'score_frequencies'} and keys %SpamScores);
3463
3464    my @scores = ();
3465    push @scores, @{$SpamScores{$_}}  foreach (keys %SpamScores);
3466    my $nscores = scalar @scores;
3467
3468    my @sorted  = sort { $a <=> $b } @scores;
3469    my @buckets = sort { $a <=> $b } split /[\s,]+/, $Opts{'score_frequencies'};
3470    push @buckets, $buckets[-1] + 1;
3471    #print "Scores: @sorted\n";
3472
3473    my @p = get_frequencies (@sorted, @buckets);
3474
3475    my @ranges = ( 0 ) x @buckets;
3476    my $last = @buckets - 1;
3477    $ranges[0]   = sprintf "%${fw2}s", " <= $buckets[0]";
3478    $ranges[-1]  = sprintf "%${fw2}s", " > $buckets[-2]";
3479    for my $i (1 .. @buckets - 2) {
3480       $ranges[$i] = sprintf "%${fw2}s", " <= $buckets[$i]";
3481    }
3482
3483    print  "\n", $sep1 x $fw1, $sep1 x $fw2 x @buckets;
3484    printf "\n%-${fw1}s" . "%-${fw2}s" x @buckets ,     "Spam Score Frequency", @ranges;
3485    print  "\n", $sep2 x $fw1, $sep2 x $fw2 x @buckets;
3486    printf "\n%-${fw1}s" . "%${fw2}d" x scalar (@p),    "Hits ($nscores)", @p;
3487    my $myfw2 = $fw2 - 1;
3488    printf "\n%-${fw1}s" . "%${myfw2}.2f%%" x scalar (@p),    "Percent of Hits", map {($_ / $nscores) * 100.0; } @p;
3489    print  "\n", $sep1 x $fw1, $sep1 x $fw2 x @buckets, "\n";
3490 }
3491
3492 # SpamAssassin rules report
3493 #
3494 =pod
3495    ===========================================================================
3496    SpamAssassin Rule Hits: Spam
3497    ---------------------------------------------------------------------------
3498    Rank     Hits    % Msgs   % Spam    % Ham      Score Rule
3499    ----     ----    ------   ------    -----      ----- ----
3500       1       44    81.48%   93.62%    0.00%      1.961 URIBL_BLACK
3501       2       44    81.48%   93.62%   14.29%      0.001 HTML_MESSAGE
3502       3       42    77.78%   89.36%    0.00%      2.857 URIBL_JP_SURBL
3503       4       38    70.37%   80.85%   14.29%      2.896 RCVD_IN_XBL
3504       5       37    68.52%   78.72%    0.00%      2.188 RCVD_IN_BL_SPAMCOP_NET
3505    ...
3506    ===========================================================================
3507
3508    ===========================================================================
3509    SpamAssassin Rule Hits: Ham
3510    ---------------------------------------------------------------------------
3511    Rank     Hits    % Msgs   % Spam    % Ham      Score Rule
3512    ----     ----    ------   ------    -----      ----- ----
3513       1        5     9.26%    2.13%   71.43%      0.001 STOX_REPLY_TYPE
3514       2        4     7.41%    0.00%   57.14%     -0.001 SPF_PASS
3515       3        4     7.41%    6.38%   57.14%          - AWL
3516       4        1     1.85%    0.00%   14.29%      0.303 TVD_RCVD_SINGLE
3517       5        1     1.85%   25.53%   14.29%        0.1 RDNS_DYNAMIC
3518    ...
3519    ===========================================================================
3520 =cut
3521 sub printSARulesReport {
3522    return unless (keys %{$Counts{'sarules'}});
3523
3524    our $maxlen = 0;
3525
3526    sub getSAHitsReport($ $) {
3527       my ($type, $topn) = @_;
3528       my $i = 1;
3529       my @report = ();
3530
3531       return if ($topn eq '0');     # topn can be numeric, or the string "all"
3532
3533       for (sort { $Counts{'sarules'}{$type}{$b} <=> $Counts{'sarules'}{$type}{$a} } keys %{$Counts{'sarules'}{$type}}) {
3534
3535          # only show top n lines; all when topn is "all"
3536          if ($topn ne 'all' and $i > $topn) {
3537             push @report, "...\n";
3538             last;
3539          }
3540          my $n     = $Counts{'sarules'}{$type}{$_};
3541          my $nham  = $Counts{'sarules'}{'Ham'}{$_};
3542          my $nspam = $Counts{'sarules'}{'Spam'}{$_};
3543          # rank, count, % msgs, % spam, % ham
3544          push @report, sprintf "%4d %8d   %6.2f%%  %6.2f%%  %6.2f%%     %s\n",
3545             $i++,
3546             $n,
3547             $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * $n     / $Totals{'totalmsgs'},
3548             $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspam / $Totals{'totalspam'},
3549             $Totals{'totalham'}  == 0 ? 0 : 100.0 * $nham  / $Totals{'totalham'},
3550             $_;
3551          my $len = length($report[-1]) - 1;
3552          $maxlen = $len  if ($len > $maxlen);
3553       }
3554
3555       if (scalar @report) {
3556          print "\n", $sep1 x $maxlen, "\n";
3557          print "SpamAssassin Rule Hits: $type\n";
3558          print $sep2 x $maxlen, "\n";
3559          print "Rank     Hits    % Msgs   % Spam    % Ham      Score Rule\n";
3560          print "----     ----    ------   ------    -----      ----- ----\n";
3561          print @report;
3562          print $sep1 x $maxlen, "\n";
3563       }
3564    }
3565
3566    my ($def_limit_spam, $def_limit_ham) = split /[\s,]+/, $Defaults{'sarules'};
3567    my ($limit_spam, $limit_ham)         = split /[\s,]+/, $Opts{'sarules'};
3568    $limit_spam = $def_limit_spam    if $limit_spam eq '';
3569    $limit_ham  = $def_limit_ham     if $limit_ham  eq '';
3570
3571    getSAHitsReport('Spam', $limit_spam);
3572    getSAHitsReport('Ham',  $limit_ham);
3573 }
3574
3575 # Autolearn report, only available if enabled in amavis $log_templ template
3576 #
3577 =pod
3578    ======================================================================
3579    Autolearn          Msgs      Spam       Ham   % Msgs   % Spam    % Ham
3580    ----------------------------------------------------------------------
3581    Spam                 36        36         0   66.67%   76.60%    0.00%
3582    Ham                   2         0         2    3.70%    0.00%   28.57%
3583    No                    7         4         3   12.96%    8.51%   42.86%
3584    Disabled              6         6         0   11.11%   12.77%    0.00%
3585    Failed                2         1         1    3.70%    2.13%   14.29%
3586    ----------------------------------------------------------------------
3587    Totals               53        47         6   98.15%  100.00%   85.71%
3588    ======================================================================
3589 =cut
3590 sub printAutolearnReport {
3591    #print "printAutolearnReport:\n"    if ($Opts{'debug'});
3592    return unless (keys %{$Counts{'autolearn'}});
3593
3594    our $maxlen = 0;
3595    our ($nhamtotal, $nspamtotal);
3596
3597    sub getAutolearnReport($) {
3598       my ($type) = @_;
3599       my @report = ();
3600
3601       #  SA 2.5/2.6 : ham/spam/no
3602       #  SA 3.0+    : ham/spam/no/disabled/failed/unavailable
3603       for (qw(spam ham no disabled failed unavailable)) {
3604
3605          next unless (exists $Counts{'autolearn'}{'Spam'}{$_} or exists $Counts{'autolearn'}{'Ham'}{$_});
3606          #print "printAutolearnReport: type: $_\n"    if ($Opts{'debug'});
3607
3608          my $nham  = exists $Counts{'autolearn'}{'Ham'}{$_}  ? $Counts{'autolearn'}{'Ham'}{$_}  : 0;
3609          my $nspam = exists $Counts{'autolearn'}{'Spam'}{$_} ? $Counts{'autolearn'}{'Spam'}{$_} : 0;
3610          my $nboth = $nham + $nspam;
3611          $nhamtotal += $nham; $nspamtotal += $nspam;
3612          # type, nspam, nham, % msgs, % spam, % ham
3613          push @report, sprintf "%-13s %9d %9d %9d  %6.2f%%  %6.2f%%  %6.2f%%\n",
3614             ucfirst $_,
3615             $nspam + $nham,
3616             $nspam,
3617             $nham,
3618             $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * $nboth / $Totals{'totalmsgs'},
3619             $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspam / $Totals{'totalspam'},
3620             $Totals{'totalham'}  == 0 ? 0 : 100.0 * $nham  / $Totals{'totalham'};
3621
3622          my $len = length($report[-1]) - 1;
3623          $maxlen = $len  if ($len > $maxlen);
3624       }
3625       return @report;
3626    }
3627
3628    my @report_spam = getAutolearnReport('Spam');
3629
3630    if (scalar @report_spam) {
3631       print "\n", $sep1 x $maxlen, "\n";
3632       print "Autolearn          Msgs      Spam       Ham   % Msgs   % Spam    % Ham\n";
3633       print $sep2 x $maxlen, "\n";
3634       print @report_spam;
3635       print $sep2 x $maxlen, "\n";
3636
3637       printf "%-13s %9d %9d %9d  %6.2f%%  %6.2f%%  %6.2f%%\n",
3638             'Totals',
3639             $nspamtotal + $nhamtotal,
3640             $nspamtotal,
3641             $nhamtotal,
3642             $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * ($nspamtotal + $nhamtotal) / $Totals{'totalmsgs'},
3643             $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspamtotal / $Totals{'totalspam'},
3644             $Totals{'totalham'}  == 0 ? 0 : 100.0 * $nhamtotal  / $Totals{'totalham'};
3645       print $sep1 x $maxlen, "\n";
3646    }
3647 }
3648
3649
3650 # Timings percentiles report, used for amavis message scanning and spamassassin timings
3651 =pod
3652    ========================================================================================================================
3653    Scan Timing Percentiles       % Time    Total (ms)        0%        5%       25%       50%       75%       95%      100%
3654    ------------------------------------------------------------------------------------------------------------------------
3655    AV-scan-2 (3)                 69.23%       7209.00   2392.00   2393.50   2399.50   2407.00   2408.50   2409.70   2410.00
3656    SA check (2)                  19.74%       2056.00    942.00    950.60    985.00   1028.00   1071.00   1105.40   1114.00
3657    SMTP DATA (3)                  5.49%        572.00    189.00    189.20    190.00    191.00    191.50    191.90    192.00
3658    AV-scan-1 (3)                  0.82%         85.00     11.00     12.60     19.00     27.00     37.00     45.00     47.00
3659    ...
3660    ------------------------------------------------------------------------------------------------------------------------
3661    Total                                     10413.00   2771.00   2867.10   3251.50   3732.00   3821.00   3892.20   3910.00
3662    ========================================================================================================================
3663
3664    ========================================================================================================================
3665    SA Timing Percentiles         % Time    Total (ms)        0%        5%       25%       50%       75%       95%      100%
3666    ------------------------------------------------------------------------------------------------------------------------
3667    tests_pri_0 (1)               97.17%       5323.00   5323.00   5323.00   5323.00   5323.00   5323.00   5323.00   5323.00
3668    check_razor2 (1)              91.68%       5022.00   5022.00   5022.00   5022.00   5022.00   5022.00   5022.00   5022.00
3669    check_dcc (1)                  3.50%        192.00    192.00    192.00    192.00    192.00    192.00    192.00    192.00
3670    learn (1)                      0.66%         36.00     36.00     36.00     36.00     36.00     36.00     36.00     36.00
3671    tests_pri_-1000 (1)            0.46%         25.00     25.00     25.00     25.00     25.00     25.00     25.00     25.00
3672    ...
3673    ------------------------------------------------------------------------------------------------------------------------
3674    Total                                      5478.00   5478.00   5478.00   5478.00   5478.00   5478.00   5478.00   5478.00
3675    ========================================================================================================================
3676 =cut
3677 sub printTimingsReport($$$$) {
3678    my ($title, $timingsref, $totalsref, $cutoff) = @_;
3679    my @tkeys = keys %$timingsref;
3680    return unless scalar @tkeys;
3681
3682    my (@p, @sorted, %perkey_totals, @col_subtotals);
3683    my ($pcnt,$max_pcnt,$max_rows,$time_total_actual,$time_total_hypo,$subtotal_pcnt);
3684    my @percents = split /[\s,]+/, $Opts{'timings_percentiles'};
3685    my $header_footer = $sep1 x 50 . ($sep1 x 10) x @percents;
3686    my $header_end    = $sep2 x 50 . ($sep2 x 10) x @percents;
3687    my $title_width = '-28';
3688
3689    print "\n$header_footer\n";
3690    printf "%${title_width}s  %6s %13s" ." %8s%%" x @percents , $title, "% Time", "Total (ms)", @percents;
3691    print "\n$header_end\n";
3692
3693    # Sum the total time for each timing key
3694    foreach my $key (@tkeys) {
3695       foreach my $timeval (@{$$timingsref{$key}}) {
3696          $perkey_totals{$key} += $timeval;
3697       }
3698    }
3699
3700    # Sum total time spent scanning
3701    map {$time_total_actual += $_} @$totalsref;
3702
3703    # cutoff value used to limit the number of rows of output
3704    #   positive cutoff is a percentage of cummulative time
3705    #   negative cutoff limits number of rows
3706    if ($cutoff >= 0) {
3707       $max_pcnt = $cutoff != 100 ? $cutoff : 150;  # 150% avoids roundoff errors
3708    }
3709    else {
3710       $max_rows = -$cutoff;
3711    }
3712    my $rows = 0;
3713    # sort each timing key's values, required to compute the list of percentiles
3714    for (sort { $perkey_totals{$b} <=> $perkey_totals{$a} } @tkeys) {
3715       last if (($max_rows and $rows >= $max_rows) or ($max_pcnt and $subtotal_pcnt >= $max_pcnt));
3716
3717       $pcnt = ($perkey_totals{$_} / $time_total_actual) * 100,
3718       @sorted = sort { $a <=> $b } @{$$timingsref{$_}};
3719       @p = get_percentiles (@sorted, @percents);
3720
3721       $subtotal_pcnt += $pcnt;
3722       printf "%${title_width}s %6.2f%% %13.2f" . " %9.2f" x scalar (@p) . "\n",
3723                $_ .  ' (' . scalar(@{$$timingsref{$_}}) . ')', # key ( number of elements )
3724                $pcnt,                                          # percent of total time
3725                #$perkey_totals{$_} / 1000,                     # total time for this test
3726                $perkey_totals{$_},                             # total time for this test
3727                #map {$_ / 1000} @p;                            # list of percentiles
3728                @p;                                             # list of percentiles
3729       $rows++;
3730    }
3731    print "...\n"  if ($rows != scalar @tkeys);
3732
3733    print "$header_end\n";
3734    # actual total time as reported by amavis
3735    @sorted = sort { $a <=> $b } @$totalsref;
3736    @p = get_percentiles (@sorted, @percents);
3737    printf "%${title_width}s         %13.2f" . " %9.2f" x scalar (@p) . "\n",
3738             'Total',
3739             #$time_total_actual / 1000,
3740             $time_total_actual,
3741             #map {$_ / 1000} @p;
3742              @p;
3743
3744    print "$header_footer\n";
3745 }
3746
3747 # Most recent startup info report
3748 #
3749 sub printStartupInfoReport {
3750
3751    return unless (keys %StartInfo);
3752
3753    sub print2col($ $) {
3754       my ($label,$val) = @_;
3755       printf "%-50s %s\n", $label, $val;
3756    }
3757
3758    print "\nAmavis Startup\n";
3759
3760    print2col ("    Amavis",       $StartInfo{'ampath'})             if (exists $StartInfo{'ampath'});
3761    print2col ("        Version",  $StartInfo{'amversion'})          if (exists $StartInfo{'amversion'});
3762    print2col ("        PID",      $StartInfo{'Server'}{'pid'})      if (exists $StartInfo{'Server'}{'pid'});
3763    print2col ("        Socket",   $StartInfo{'Server'}{'socket'})   if (exists $StartInfo{'Server'}{'socket'});
3764    print2col ("        TCP port", $StartInfo{'Server'}{'ip'})       if (exists $StartInfo{'Server'}{'ip'});
3765    print2col ("        UID",      $StartInfo{'Server'}{'uid'})      if (exists $StartInfo{'Server'}{'uid'});
3766    print2col ("        GID",      $StartInfo{'Server'}{'gid'})      if (exists $StartInfo{'Server'}{'gid'});
3767    print2col ("        Logging",  $StartInfo{'Logging'})            if (exists $StartInfo{'Logging'});
3768    print2col ("        Configuration Files",  $StartInfo{'Configs'})            if (exists $StartInfo{'Configs'});
3769    print2col ("    SpamAssassin", $StartInfo{'sa_version'})         if (exists $StartInfo{'sa_version'});
3770    print2col ("    SpamAssassin Debug Facilities", $StartInfo{'sa_debug'})     if (exists $StartInfo{'sa_debug'});
3771    print2col ("    Database",     $StartInfo{'db'})                 if (exists $StartInfo{'db'});
3772    #if (keys %{$StartInfo{'IDs'}}) {
3773    #   print "    Process startup user/group:\n";
3774    #   print "        User:  $StartInfo{'IDs'}{'user'}, EUID: $StartInfo{'IDs'}{'euid'}, UID: $StartInfo{'IDs'}{'uid'}\n";
3775    #   print "        Group: $StartInfo{'IDs'}{'group'}, EGID: $StartInfo{'IDs'}{'egid'}, GID: $StartInfo{'IDs'}{'gid'}\n";
3776    #}
3777
3778    sub print_modules ($ $) {
3779       my ($key, $label) = @_;
3780       print "    $label\n";
3781       foreach (sort keys %{$StartInfo{$key}}) {
3782          print "        $_\n";
3783          foreach my $module (sort keys %{$StartInfo{$key}{$_}}) {
3784             if ($StartInfo{$key}{$_}{$module}) {
3785                print2col ("            " . $module, $StartInfo{$key}{$_}{$module});
3786             }
3787             else {
3788                print2col ("            " . $module, "");
3789             }
3790          }
3791       }
3792    };
3793    print_modules('AVScanner', 'Antivirus scanners');
3794    print_modules('Code',      'Code, modules and external programs');
3795    print_modules('Decoders',  'Decoders');
3796    print_modules('SAPlugins', 'SpamAssassin plugins');
3797 }
3798
3799 # Initialize the Getopts option list.  Requires the Section table to
3800 # be built already.
3801 #
3802 sub init_getopts_table() {
3803    print "init_getopts_table: enter\n"  if $Opts{'debug'} & D_ARGS;
3804
3805    init_getopts_table_common(@supplemental_reports);
3806
3807    add_option ('first_recip_only!');
3808    add_option ('show_first_recip_only=i',   sub { $Opts{'first_recip_only'} = $_[1]; 1;});
3809    add_option ('startinfo!');
3810    add_option ('show_startinfo=i',          sub { $Opts{'startinfo'} = $_[1]; 1; });
3811    add_option ('by_ccat_summary!');
3812    add_option ('show_by_ccat_summary=i',    sub { $Opts{'by_ccat_summary'} = $_[1]; 1; });
3813    add_option ('noscore_percentiles',       \&triway_opts);
3814    add_option ('score_percentiles=s',       \&triway_opts);
3815    add_option ('noscore_frequencies',       \&triway_opts);
3816    add_option ('score_frequencies=s',       \&triway_opts);
3817    add_option ('nosa_timings',              sub { $Opts{'sa_timings'} = 0; 1; });
3818    add_option ('sa_timings=i');
3819    add_option ('sa_timings_percentiles=s');
3820    add_option ('notimings',                 sub { $Opts{'timings'} = 0; 1; });
3821    add_option ('timings=i');
3822    add_option ('timings_percentiles=s');
3823    add_option ('nosarules',                 \&triway_opts);
3824    add_option ('sarules=s',                 \&triway_opts);
3825    #add_option ('nop0f',                     \&triway_opts);
3826    #add_option ('p0f=s',                     \&triway_opts);
3827    add_option ('autolearn!');
3828    add_option ('show_autolearn=i',          sub { $Opts{'autolearn'} = $_[1]; 1; });
3829 }
3830
3831 # Builds the entire @Section table used for data collection
3832 #
3833 # Each Section entry has as many as six fields:
3834 #
3835 #   1. Section array reference
3836 #   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
3837 #   3. Output in Detail report? (must also a %Counts accumulator)
3838 #   4. Numeric output format specifier for Summary report
3839 #   5. Section title for Summary and Detail reports
3840 #   6. A hash to a divisor used to calculate the percentage of a total for that key
3841 #
3842 # Use begin_section_group/end_section_group to create groupings around sections.
3843 #
3844 # Sections can be freely reordered if desired, but maintain proper group nesting.
3845 #
3846 sub build_sect_table() {
3847    print "build_sect_table: enter\n"  if $Opts{'debug'} & D_SECT;
3848    my $S = \@Sections;
3849
3850    # References to these are used in the Sections table below; we'll predeclare them.
3851    $Totals{'totalmsgs'} = 0;
3852
3853    # Place configuration and critical errors first
3854
3855    #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
3856    begin_section_group ($S, 'warnings');
3857    add_section ($S, 'fatal',                   1, 'd', '*Fatal');
3858    add_section ($S, 'panic',                   1, 'd', '*Panic');
3859    add_section ($S, 'warningsecurity',         1, 'd', '*Warning: Security risk');
3860    add_section ($S, 'avtimeout',               1, 'd', '*Warning: Virus scanner timeout');
3861    add_section ($S, 'avconnectfailure',        1, 'd', '*Warning: Virus scanner connection failure');
3862    add_section ($S, 'warningsmtpshutdown',     1, 'd', '*Warning: SMTP shutdown');
3863    add_section ($S, 'warningsql',              1, 'd', '*Warning: SQL problem');
3864    add_section ($S, 'warningaddressmodified',  1, 'd', '*Warning: Email address modified');
3865    add_section ($S, 'warningnoquarantineid',   1, 'd', '*Warning: Message missing X-Quarantine-ID header');
3866    add_section ($S, 'warning',                 1, 'd', 'Miscellaneous warnings');
3867    end_section_group ($S, 'warnings');
3868
3869    begin_section_group ($S, 'scanned', "\n");
3870    add_section ($S, 'totalmsgs',               0, 'd', [ 'Total messages scanned', '-' ],  \$Totals{'totalmsgs'});
3871    add_section ($S, 'bytesscanned',            0, 'Z', 'Total bytes scanned');     # Z means print scaled as in 1k, 1m, etc.
3872    end_section_group ($S, 'scanned', $sep1);
3873
3874    # Blocked / Passed
3875    # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
3876    begin_section_group ($S, 'passblock', "\n");
3877    begin_section_group ($S, 'blocked', "\n");
3878    add_section ($S, 'totalblocked',            0, 'd', [ 'Blocked', '-' ],                 \$Totals{'totalmsgs'});
3879    add_section ($S, 'malwareblocked',          1, 'd', '  Malware blocked',                \$Totals{'totalmsgs'});
3880    add_section ($S, 'bannednameblocked',       1, 'd', '  Banned name blocked',            \$Totals{'totalmsgs'});
3881    add_section ($S, 'uncheckedblocked',        1, 'd', '  Unchecked blocked',              \$Totals{'totalmsgs'});
3882    add_section ($S, 'spamblocked',             1, 'd', '  Spam blocked',                   \$Totals{'totalmsgs'});
3883    add_section ($S, 'spamdiscarded',           0, 'd', '  Spam discarded (no quarantine)', \$Totals{'totalmsgs'});
3884    add_section ($S, 'spammyblocked',           1, 'd', '  Spammy blocked',                 \$Totals{'totalmsgs'});
3885    add_section ($S, 'badheaderblocked',        1, 'd', '  Bad header blocked',             \$Totals{'totalmsgs'});
3886    add_section ($S, 'oversizedblocked',        1, 'd', '  Oversized blocked',              \$Totals{'totalmsgs'});
3887    add_section ($S, 'mtablocked',              1, 'd', '  MTA blocked',                    \$Totals{'totalmsgs'});
3888    add_section ($S, 'cleanblocked',            1, 'd', '  Clean blocked',                  \$Totals{'totalmsgs'});
3889    add_section ($S, 'tempfailblocked',         1, 'd', '  Tempfail blocked',               \$Totals{'totalmsgs'});
3890    add_section ($S, 'otherblocked',            1, 'd', '  Other blocked',                  \$Totals{'totalmsgs'});
3891    end_section_group ($S, 'blocked');
3892
3893    begin_section_group ($S, 'passed', "\n");
3894    add_section ($S, 'totalpassed',             0, 'd', [ 'Passed', '-' ],                  \$Totals{'totalmsgs'});
3895    add_section ($S, 'malwarepassed',           1, 'd', '  Malware passed',                 \$Totals{'totalmsgs'});
3896    add_section ($S, 'bannednamepassed',        1, 'd', '  Banned name passed',             \$Totals{'totalmsgs'});
3897    add_section ($S, 'uncheckedpassed',         1, 'd', '  Unchecked passed',               \$Totals{'totalmsgs'});
3898    add_section ($S, 'spampassed',              1, 'd', '  Spam passed',                    \$Totals{'totalmsgs'});
3899    add_section ($S, 'spammypassed',            1, 'd', '  Spammy passed',                  \$Totals{'totalmsgs'});
3900    add_section ($S, 'badheaderpassed',         1, 'd', '  Bad header passed',              \$Totals{'totalmsgs'});
3901    add_section ($S, 'oversizedpassed',         1, 'd', '  Oversized passed',               \$Totals{'totalmsgs'});
3902    add_section ($S, 'mtapassed',               1, 'd', '  MTA passed',                     \$Totals{'totalmsgs'});
3903    add_section ($S, 'cleanpassed',             1, 'd', '  Clean passed',                   \$Totals{'totalmsgs'});
3904    add_section ($S, 'tempfailpassed',          1, 'd', '  Tempfail passed',                \$Totals{'totalmsgs'});
3905    add_section ($S, 'otherpassed',             1, 'd', '  Other passed',                   \$Totals{'totalmsgs'});
3906    end_section_group ($S, 'passed');
3907    end_section_group ($S, 'passblock', $sep1);
3908
3909    if ($Opts{'by_ccat_summary'}) {
3910       # begin level 1 group
3911       begin_section_group ($S, 'by_ccat', "\n");
3912
3913       # begin level 2 groupings
3914       begin_section_group ($S, 'malware', "\n");     # level 2
3915       add_section ($S, 'totalmalware',            0, 'd', [ 'Malware', '-' ],                 \$Totals{'totalmsgs'});
3916       add_section ($S, 'malwarepassed',           0, 'd', '  Malware passed',                 \$Totals{'totalmsgs'});
3917       add_section ($S, 'malwareblocked',          0, 'd', '  Malware blocked',                \$Totals{'totalmsgs'});
3918       end_section_group ($S, 'malware');
3919
3920       begin_section_group ($S, 'banned', "\n");
3921       add_section ($S, 'totalbanned',             0, 'd', [ 'Banned', '-' ],                  \$Totals{'totalmsgs'});
3922       add_section ($S, 'bannednamepassed',        0, 'd', '  Banned file passed',             \$Totals{'totalmsgs'});
3923       add_section ($S, 'bannednameblocked',       0, 'd', '  Banned file blocked',            \$Totals{'totalmsgs'});
3924       end_section_group ($S, 'banned');
3925
3926       begin_section_group ($S, 'unchecked', "\n");
3927       add_section ($S, 'totalunchecked',          0, 'd', [ 'Unchecked', '-' ],               \$Totals{'totalmsgs'});
3928       add_section ($S, 'uncheckedpassed',         0, 'd', '  Unchecked passed',               \$Totals{'totalmsgs'});
3929       add_section ($S, 'uncheckedblocked',        0, 'd', '  Unchecked blocked',              \$Totals{'totalmsgs'});
3930       end_section_group ($S, 'unchecked');
3931
3932       begin_section_group ($S, 'spam', "\n");
3933       add_section ($S, 'totalspam',               0, 'd', [ 'Spam', '-' ],                    \$Totals{'totalmsgs'});
3934       add_section ($S, 'spammypassed',            0, 'd', '  Spammy passed',                  \$Totals{'totalmsgs'});
3935       add_section ($S, 'spammyblocked',           0, 'd', '  Spammy blocked',                 \$Totals{'totalmsgs'});
3936       add_section ($S, 'spampassed',              0, 'd', '  Spam passed',                    \$Totals{'totalmsgs'});
3937       add_section ($S, 'spamblocked',             0, 'd', '  Spam blocked',                   \$Totals{'totalmsgs'});
3938       add_section ($S, 'spamdiscarded',           0, 'd', '  Spam discarded (no quarantine)', \$Totals{'totalmsgs'});
3939       end_section_group ($S, 'spam');
3940
3941       begin_section_group ($S, 'ham', "\n");
3942       add_section ($S, 'totalham',                0, 'd', [ 'Ham', '-' ],                     \$Totals{'totalmsgs'});
3943       add_section ($S, 'badheaderpassed',         0, 'd', '  Bad header passed',              \$Totals{'totalmsgs'});
3944       add_section ($S, 'badheaderblocked',        0, 'd', '  Bad header blocked',             \$Totals{'totalmsgs'});
3945       add_section ($S, 'oversizedpassed',         0, 'd', '  Oversized passed',               \$Totals{'totalmsgs'});
3946       add_section ($S, 'oversizedblocked',        0, 'd', '  Oversized blocked',              \$Totals{'totalmsgs'});
3947       add_section ($S, 'mtapassed',               0, 'd', '  MTA passed',                     \$Totals{'totalmsgs'});
3948       add_section ($S, 'mtablocked',              0, 'd', '  MTA blocked',                    \$Totals{'totalmsgs'});
3949       add_section ($S, 'cleanpassed',             0, 'd', '  Clean passed',                   \$Totals{'totalmsgs'});
3950       add_section ($S, 'cleanblocked',            0, 'd', '  Clean blocked',                  \$Totals{'totalmsgs'});
3951       end_section_group ($S, 'ham');
3952
3953       begin_section_group ($S, 'other', "\n");
3954       add_section ($S, 'totalother',              0, 'd', [ 'Other', '-' ],                   \$Totals{'totalmsgs'});
3955       add_section ($S, 'tempfailpassed',          0, 'd', '  Tempfail passed',                \$Totals{'totalmsgs'});
3956       add_section ($S, 'tempfailblocked',         0, 'd', '  Tempfail blocked',               \$Totals{'totalmsgs'});
3957       add_section ($S, 'otherpassed',             0, 'd', '  Other passed',                   \$Totals{'totalmsgs'});
3958       add_section ($S, 'otherblocked',            0, 'd', '  Other blocked',                  \$Totals{'totalmsgs'});
3959       end_section_group ($S, 'other');
3960       # end level 2 groupings
3961
3962       # end level 1 group
3963       end_section_group ($S, 'by_ccat', $sep1);
3964    }
3965
3966    begin_section_group ($S, 'misc', "\n");
3967    add_section ($S, 'virusscanskipped',        1, 'd', 'Virus scan skipped');
3968    add_section ($S, 'sabypassed',              0, 'd', 'SpamAssassin bypassed');
3969    add_section ($S, 'satimeout',               0, 'd', 'SpamAssassin timeout');
3970    add_section ($S, 'released',                1, 'd', 'Released from quarantine');
3971    add_section ($S, 'defanged',                1, 'd', 'Defanged');
3972    add_section ($S, 'truncatedheader',         0, 'd', 'Truncated headers > 998 characters');
3973    add_section ($S, 'truncatedmsg',            0, 'd', 'Truncated message passed to SpamAssassin');
3974    add_section ($S, 'tagged',                  0, 'd', 'Spam tagged');
3975    add_section ($S, 'smtpresponse',            1, 'd', 'SMTP response');
3976    add_section ($S, 'badaddress',              1, 'd', 'Bad address syntax');
3977    add_section ($S, 'fakesender',              1, 'd', 'Fake sender');
3978    add_section ($S, 'archiveextract',          1, 'd', 'Archive extraction problem');
3979    add_section ($S, 'dsnsuppressed',           1, 'd', 'DSN suppressed');
3980    add_section ($S, 'dsnnotification',         1, 'd', 'DSN notification (debug supplemental)');
3981    add_section ($S, 'bouncekilled',            1, 'd', 'Bounce killed');
3982    add_section ($S, 'bouncerescued',           1, 'd', 'Bounce rescued');
3983    add_section ($S, 'bounceunverifiable',      1, 'd', 'Bounce unverifiable');
3984    add_section ($S, 'nosubject',               0, 'd', 'Subject header inserted');
3985    add_section ($S, 'whitelisted',             1, 'd', 'Whitelisted');
3986    add_section ($S, 'blacklisted',             1, 'd', 'Blacklisted');
3987    add_section ($S, 'penpalsaved',             1, 'd', 'Penpals saved from kill');
3988    add_section ($S, 'tmppreserved',            1, 'd', 'Preserved temporary directory');
3989    add_section ($S, 'dccerror',                1, 'd', 'DCC error');
3990    add_section ($S, 'mimeerror',               1, 'd', 'MIME error');
3991    add_section ($S, 'defangerror',             1, 'd', 'Defang error');
3992    add_section ($S, 'badheadersupp',           1, 'd', 'Bad header (debug supplemental)');
3993    add_section ($S, 'fileoutputskipped',       0, 'd', 'File(1) output skipped');
3994    add_section ($S, 'localdeliveryskipped',    1, 'd', 'Local delivery skipped');
3995    add_section ($S, 'extramodules',            1, 'd', 'Extra code modules loaded at runtime');
3996    add_section ($S, 'malwarebyscanner',        1, 'd', 'Malware by scanner');
3997    add_section ($S, 'malwaretospam',           1, 'd', 'Malware to spam conversion');
3998    add_section ($S, 'contenttype',             1, 'd', 'Content types');
3999    add_section ($S, 'bayes',                   1, 'd', 'Bayes probability');
4000    add_section ($S, 'p0f',                     1, 'd', 'p0f fingerprint');
4001    add_section ($S, 'sadiags',                 1, 'd', 'SpamAssassin diagnostics');
4002    end_section_group ($S, 'misc');
4003
4004    print "build_sect_table: exit\n"  if $Opts{'debug'} & D_SECT;
4005 }
4006
4007 # XXX create array of defaults for detail <5, 5-9, >10
4008 sub init_defaults() {
4009    map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
4010    if (! $Opts{'standalone'}) {
4011       # LOGWATCH these take affect if no env present (eg. nothing in conf file)
4012       #  0 to 4 nostartinfo, notimings,   nosarules,        score_frequencies=0,        score_percentiles=0,      noautolearn
4013       #  5 to 9 nostartinfo, timings=95,  sarules = 20 20,  score_frequencies=defaults, score_percentiles=defaults, autolearn
4014       # 10 +    startinfo,   timings=100, sarules = all all score_frequencies=defaults, score_percentiles=defaults, autolearn
4015
4016       if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
4017          $Opts{'autolearn'}         = 0;
4018          #$Opts{'p0f'}               = 0;
4019          $Opts{'timings'}           = 0;
4020          $Opts{'sa_timings'}        = 0;
4021          $Opts{'sarules'}           = 0;
4022          $Opts{'startinfo'}         = 0;
4023          $Opts{'score_frequencies'} = '';
4024          $Opts{'score_percentiles'} = '';
4025       }
4026       elsif ($Opts{'detail'} < 10) {      # detail 5 to 9, disable startinfo report
4027          $Opts{'startinfo'}         = 0;
4028       }
4029       else {                              # detail 10 and up, full reports
4030          #$Opts{'p0f'}              = 'all all';
4031          $Opts{'timings'}          = 100;
4032          $Opts{'sa_timings'}       = 100;
4033          $Opts{'sarules'}          = 'all all';
4034       }
4035    }
4036 }
4037
4038 # Return a usage string,  built from:
4039 #  arg1 +
4040 #  $usage_str +
4041 #  a string built from each usable entry in the @Sections table.
4042 #
4043 sub usage($) {
4044    my $ret = "";
4045    $ret = "@_\n"  if ($_[0]);
4046    $ret .= $usage_str;
4047    my ($name, $desc);
4048    foreach my $sect (get_usable_sectvars(@Sections, 0)) {
4049       $name = lc $sect->{NAME};
4050       $desc = $sect->{TITLE};
4051       $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
4052    }
4053    $ret .= "\n";
4054    return $ret;
4055 }
4056
4057 sub strip_trace($) {
4058    # at (eval 37) line 306, <GEN6> line 4.
4059    # at /usr/sbin/amavisd-maia line 2895, <GEN4> line 22.
4060    #$_[0] =~ s/ at \(.+\) line \d+(?:, \<GEN\d+\> line \d+)?\.$//;
4061    #$_[0] =~ s/ at (\S+) line \d+(?:, \<GEN\d+\> line \d+)?\.$/: $1/;
4062    while ($_[0] =~ s/ at (?:\(eval \d+\)|\S+) line \d+(?:, \<GEN\d+\> line \d+)?\.//) {
4063       ;
4064    }
4065    #print "strip_trace: \"$_[0]\"\n";
4066    return $_[0];
4067 }
4068
4069 # Getopt helper, sets an option in Opts hash to one of three
4070 # values: its default, the specified value, or 0 if the option
4071 # was the "no" prefixed variant.
4072 #
4073 sub triway_opts ($ $) {
4074    my ($opt,$val) = @_;
4075
4076    print "triway_opts: OPT: $opt, VAL: $val\n"    if $Opts{'debug'} & D_ARGS;
4077    die "Option \"--${opt}\" requires an argument" if ($val =~ /^--/);
4078
4079    if ($opt =~ s/^no//i) {
4080       $Opts{$opt} = 0;
4081    } elsif ('default' =~ /^${val}$/i) {
4082       $Opts{$opt} = $Defaults{$opt};
4083    }
4084    else {
4085       $Opts{$opt} = $val;
4086    }
4087 }
4088
4089 exit(0);
4090
4091 # vi: shiftwidth=3 tabstop=3 syntax=perl et