amavis-logwatch

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