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