Subversion Repositories configs

Rev

Details | Last modification | View Log | RSS feed

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