]> gitweb.michael.orlitzky.com - amavis-logwatch.git/blob - amavis-logwatch
Upstream source.
[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 push @{$lines[$cur_level]},
1338 sprintf "$fmt %-23s $extra\n", $total, $desc, commify ($Totals{$keyname});
1339 }
1340 }
1341 }
1342 else {
1343 die "print_summary_report: unexpected control...";
1344 }
1345 }
1346 print @{$lines[0]};
1347 print "\n";
1348 }
1349
1350 # Prints the Detail report section
1351 #
1352 # Note: side affect; deletes each key in Totals/Counts
1353 # after printout. Only the first instance of a key in
1354 # the Section table will result in Detail output.
1355 sub print_detail_report (\@) {
1356 my ($sections) = @_;
1357 my $header_printed = 0;
1358
1359 return unless (keys %Counts);
1360
1361 #use Devel::Size qw(size total_size);
1362
1363 foreach my $sref ( @$sections ) {
1364 next unless $sref->{CLASS} eq 'DATA';
1365 # only print detail for this section if DETAIL is enabled
1366 # and there is something in $Counts{$keyname}
1367 next unless $sref->{DETAIL};
1368 next unless exists $Counts{$sref->{NAME}};
1369
1370 my $keyname = $sref->{NAME};
1371 my $max_level = undef;
1372 my $print_this_key = 0;
1373
1374 my @levelspecs = ();
1375 clear_level_specs($max_level, \@levelspecs);
1376 if (exists $Opts{$keyname}) {
1377 $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
1378 $print_this_key = 1 if ($max_level);
1379 }
1380 else {
1381 $print_this_key = 1;
1382 }
1383 #print_level_specs($max_level,\@levelspecs);
1384
1385 # at detail 5, print level 1, detail 6: level 2, ...
1386
1387 #print STDERR "building: $keyname\n";
1388 my ($count, $treeref) =
1389 buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
1390 \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);
1391
1392 if ($count > 0) {
1393 if ($print_this_key) {
1394 my $desc = $sref->{TITLE};
1395 $desc =~ s/^\s+//;
1396
1397 if (! $header_printed) {
1398 my $header = "****** Detail ($max_level) ";
1399 print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
1400 $header_printed = 1;
1401 }
1402 printf "\n%8d %s %s\n", $count, $desc,
1403 $Opts{'sect_vars'} ?
1404 ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
1405 '-' x ($Opts{'max_report_width'} - 12 - length($desc))
1406 }
1407
1408 printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
1409 $Opts{'debug'} & D_TREE);
1410 }
1411 #print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
1412 #print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
1413 $treeref = undef;
1414 $Totals{$keyname} = undef;
1415 delete $Totals{$keyname};
1416 delete $Counts{$keyname};
1417 }
1418 #print "\n";
1419 }
1420
1421 =pod
1422
1423 Print out a standard percentiles report
1424
1425 === Delivery Delays Percentiles ===============================================================
1426 0% 25% 50% 75% 90% 95% 98% 100%
1427 -----------------------------------------------------------------------------------------------
1428 Before qmgr 0.01 0.70 1.40 45483.70 72773.08 81869.54 87327.42 90966.00
1429 In qmgr 0.00 0.00 0.00 0.01 0.01 0.01 0.01 0.01
1430 Conn setup 0.00 0.00 0.00 0.85 1.36 1.53 1.63 1.70
1431 Transmission 0.03 0.47 0.92 1.61 2.02 2.16 2.24 2.30
1432 Total 0.05 1.18 2.30 45486.15 72776.46 81873.23 87331.29 90970.00
1433 ===============================================================================================
1434
1435 === Postgrey Delays Percentiles ===========================================================
1436 0% 25% 50% 75% 90% 95% 98% 100%
1437 -------------------------------------------------------------------------------------------
1438 Postgrey 727.00 727.00 727.00 727.00 727.00 727.00 727.00 727.00
1439 ===========================================================================================
1440
1441 tableref:
1442 data table: ref to array of arrays, first cell is label, subsequent cells are data
1443 title:
1444 table's title
1445 percentiles_str:
1446 string of space or comma separated integers, which are the percentiles
1447 calculated and output as table column data
1448 =cut
1449 sub print_percentiles_report2($$$) {
1450 my ($tableref, $title, $percentiles_str) = @_;
1451
1452 return unless @$tableref;
1453
1454 my $myfw2 = $fw2 - 1;
1455 my @percents = split /[ ,]/, $percentiles_str;
1456
1457 # Calc y label width from the hash's keys. Each key is padded with the
1458 # string "#: ", # where # is a single-digit sort index.
1459 my $y_label_max_width = 0;
1460 for (@$tableref) {
1461 $y_label_max_width = length($_->[0]) if (length($_->[0]) > $y_label_max_width);
1462 }
1463
1464 # Titles row
1465 my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
1466 my $table_width = length($col_titles_str);
1467
1468 # Table header row
1469 my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
1470 $table_header_str .= $sep1 x ($table_width - length($table_header_str));
1471
1472 print "\n", $table_header_str;
1473 print "\n", $col_titles_str;
1474 print "\n", $sep2 x $table_width;
1475
1476 my (@p, @coldata, @xformed);
1477 foreach (@$tableref) {
1478 my ($title, $ref) = ($_->[0], $_->[1]);
1479 #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};
1480
1481 my @byscore = ();
1482
1483 for my $bucket (sort { $a <=> $b } keys %$ref) {
1484 #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
1485 # pairs: bucket (i.e. key), tally
1486 push @byscore, $bucket, $ref->{$bucket};
1487 }
1488
1489
1490 my @p = get_percentiles2 (@byscore, @percents);
1491 printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
1492 }
1493
1494 =pod
1495 foreach (@percents) {
1496 #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
1497 printf "\n%3d%%", $title;
1498 foreach my $val (@{shift @xformed}) {
1499 my $unit;
1500 if ($val > 1000) {
1501 $unit = 's';
1502 $val /= 1000;
1503 }
1504 else {
1505 $unit = '';
1506 }
1507 printf "%${fw3}.2f%-2s", $val, $unit;
1508 }
1509 }
1510 =cut
1511
1512 print "\n", $sep1 x $table_width, "\n";
1513 }
1514
1515 sub clear_level_specs($ $) {
1516 my ($max_level,$lspecsref) = @_;
1517 #print "Zeroing $max_level rows of levelspecs\n";
1518 $max_level = 0 if (not defined $max_level);
1519 for my $x (0..$max_level) {
1520 $lspecsref->[$x]{topn} = undef;
1521 $lspecsref->[$x]{threshold} = undef;
1522 }
1523 }
1524
1525 # topn = 0 means don't limit
1526 # threshold = 0 means no min threshold
1527 sub create_level_specs($ $ $) {
1528 my ($optkey,$gdetail,$lspecref) = @_;
1529
1530 return 0 if ($optkey eq "0");
1531
1532 my $max_level = $gdetail; # default to global detail level
1533 my (@specsP1, @specsP2, @specsP3);
1534
1535 #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;
1536
1537 foreach my $sp (split /[\s,]+/, $optkey) {
1538 #print "create_level_specs: SP: \"$sp\"\n";
1539 # original level specifier
1540 if ($sp =~ /^\d+$/) {
1541 $max_level = $sp;
1542 #print "create_level_specs: max_level set: $max_level\n";
1543 }
1544 # original level specifier + topn at level 1
1545 elsif ($sp =~ /^(\d*)\.(\d+)$/) {
1546 if ($1) { $max_level = $1; }
1547 else { $max_level = $gdetail; } # top n specified, but no max level
1548
1549 # force top N at level 1 (zero based)
1550 push @specsP1, { level => 0, topn => $2, threshold => 0 };
1551 }
1552 # newer level specs
1553 elsif ($sp =~ /^::(\d+)$/) {
1554 push @specsP3, { level => undef, topn => 0, threshold => $1 };
1555 }
1556 elsif ($sp =~ /^:(\d+):(\d+)?$/) {
1557 push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
1558 }
1559 elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
1560 push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
1561 }
1562 else {
1563 print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
1564 }
1565 }
1566
1567 #foreach my $sp (@specsP3, @specsP2, @specsP1) {
1568 # printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
1569 #}
1570
1571 my ($min, $max);
1572 foreach my $sp ( @specsP3, @specsP2, @specsP1) {
1573 ($min, $max) = (0, $max_level);
1574
1575 if (defined $sp->{level}) {
1576 $min = $max = $sp->{level};
1577 }
1578 for my $level ($min..$max) {
1579 #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
1580 $lspecref->[$level]{topn} = $sp->{topn} if ($sp->{topn});
1581 $lspecref->[$level]{threshold} = $sp->{threshold} if ($sp->{threshold});
1582 }
1583 }
1584
1585 return $max_level;
1586 }
1587
1588 sub print_level_specs($ $) {
1589 my ($max_level,$lspecref) = @_;
1590 for my $level (0..$max_level) {
1591 printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
1592 }
1593 }
1594
1595
1596 1;
1597
1598
1599 package Logreporters;
1600
1601 BEGIN {
1602 import Logreporters::Utils;
1603 import Logreporters::Config;
1604 import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree);
1605 import Logreporters::Reports;
1606 }
1607 use 5.008;
1608 use strict;
1609 use warnings;
1610 no warnings "uninitialized";
1611 use re 'taint';
1612
1613 use Getopt::Long;
1614 use File::Basename;
1615
1616 our $progname = fileparse($0);
1617
1618 # the list of supplemental reports available in the Detail section
1619 #p0f
1620 my @supplemental_reports = qw(
1621 autolearn score_percentiles score_frequencies sarules timings sa_timings startinfo
1622 );
1623
1624 # Default values for various options, used if no config file exists,
1625 # or some option is not set.
1626 #
1627 # These are used to reset default values after an option has been
1628 # disabled (via undef'ing its value). This allows a report to be
1629 # disabled via config file or --nodetail, but reenabled via subsequent
1630 # command line option
1631 my %Defaults = (
1632 detail => 10, # report level detail
1633 max_report_width => 100, # maximum line width for report output
1634 line_style => undef, # lines > max_report_width, 0=truncate,1=wrap,2=full
1635 syslog_name => $progname_prefix, # amavis' syslog service name
1636 sect_vars => 0, # show section vars in detail report hdrs
1637 ipaddr_width => 15, # width for printing ip addresses
1638 first_recip_only => 0, # Show only the first recipient, or all
1639
1640 autolearn => 1, # show Autolearn report
1641 bayes => 1, # show hit Bayesian buckets
1642 #p0f => 'all all', # p0f hits report
1643 sarules => '20 20', # show SpamAssassin rules hit
1644 score_frequencies => '-10 -5 0 5 10 20 30', # buckets shown in spam scores report
1645 score_percentiles => '0 50 90 95 98 100', # percentiles shown in spam scores report
1646 startinfo => 1, # show amavis startup info
1647 timings => 95, # show top N% of the timings report
1648 timings_percentiles => '0 5 25 50 75 95 100', # percentiles shown in timing report
1649 sa_timings => 95, # show top N% of the SA timings report
1650 sa_timings_percentiles => '0 5 25 50 75 95 100', # percentiles shown in SA timing report
1651 );
1652
1653 my $usage_str = <<"END_USAGE";
1654 Usage: $progname [ ARGUMENTS ] [logfile ...]
1655
1656 ARGUMENTS can be one or more of options listed below. Later options override earlier ones.
1657 Any argument may be abbreviated to an unambiguous length. Input comes from named logfiles,
1658 or STDIN.
1659
1660 --debug AREAS provide debug output for AREAS
1661 --help print usage information
1662 --version print program version
1663
1664 --config_file FILE, -f FILE use alternate configuration file FILE
1665 --syslog_name PATTERN only consider log lines that match
1666 syslog service name PATTERN
1667
1668 --detail LEVEL print LEVEL levels of detail
1669 (default: 10)
1670 --nodetail set all detail levels to 0
1671 --[no]summary display the summary section
1672
1673 --ipaddr_width WIDTH use WIDTH chars for IP addresses in
1674 address/hostname pairs
1675 --line_style wrap|full|truncate disposition of lines > max_report_width
1676 (default: truncate)
1677 --full same as --line_style=full
1678 --truncate same as --line_style=truncate
1679 --wrap same as --line_style=wrap
1680 --max_report_width WIDTH limit report width to WIDTH chars
1681 (default: 100)
1682 --limit L=V, -l L=V set level limiter L with value V
1683 --[no]sect_vars [do not] show config file var/cmd line
1684 option names in section titles
1685
1686 --[no]autolearn show autolearn report
1687 --[no]by_ccat_summary include by contents category grouping in summary
1688 --[no]first_recip_only show first recipient only, or all recipients
1689 --nosarules disable SpamAssassin spam and ham rules hit reports
1690 --sarules "S,H" enable SpamAssassin spam and ham rules reports, showing
1691 --sarules "default" showing the top S spam and top H ham rules hit (range:
1692 0..., "all", or the keyword "default").
1693 --noscore_frequencies disable spam score frequency report
1694 --score_frequencies "B1 [B2 ...]" enable spam score frequency report, using buckets
1695 --score_frequencies "default" specified with B1 [B2 ...] (range: real numbers), or using their
1696 internal default values when the keyword "default" is given
1697 --noscore_percentiles disable spam score percentiles report
1698 --score_percentiles "P1 [P2 ...]" enable spam score percentiles report, using percentiles
1699 --score_percentiles "default" specified with P1 [P2 ...] (range: 0...100), or using their
1700 internal default values when the keyword "default" is given
1701 --[no]startinfo show latest amavis startup details, if available
1702
1703 --nosa_timings disable the SA timings report (same as --sa_timings 0)
1704 --sa_timings PERCENT show top PERCENT percent of the SA timings report (range: 0...100)
1705 --sa_timings_percentiles "P1 [P2 ...]"
1706 set SA timings report percentiles to P1 [P2 ...] (range: 0...100)
1707
1708 --notimings disable the timings report (same as --timings 0)
1709 --timings PERCENT show top PERCENT percent of the timings report (range: 0...100)
1710 --timings_percentiles "P1 [P2 ...]" set timings report percentiles to P1 [P2 ...] (range: 0...100)
1711 END_USAGE
1712
1713 # local prototypes
1714 sub usage($);
1715 sub init_getopts_table();
1716 sub init_defaults();
1717 sub build_sect_table();
1718
1719 sub parse_vals($$);
1720 sub triway_opts($$);
1721
1722 sub printSpamScorePercentilesReport;
1723 sub printSpamScoreFrequencyReport;
1724 sub printAutolearnReport;
1725 sub printSARulesReport;
1726 sub printTimingsReport($$$$);
1727 sub printStartupInfoReport;
1728 sub strip_trace($);
1729 sub prioritize_cmdline(@);
1730
1731 sub create_ignore_list();
1732 sub check_ignore_list($ \@);
1733
1734 # lines that match any RE in this list will be ignored.
1735 # see create_ignore_list();
1736 my @ignore_list_final = ();
1737
1738 # The Sections table drives Summary and Detail reports. For each entry in the
1739 # table, if there is data avaialable, a line will be output in the Summary report.
1740 # Additionally, a sub-section will be output in the Detail report if both the
1741 # global --detail, and the section's limiter variable, are sufficiently high (a
1742 # non-existent section limiter variable is considered to be sufficiently high).
1743 #
1744 my @Sections;
1745
1746 # Initialize main running mode and basic opts
1747 init_run_mode($config_file);
1748
1749 # Configure the Getopts options table
1750 init_getopts_table();
1751
1752 # Place configuration file/environment variables onto command line
1753 init_cmdline();
1754
1755 # Initialize default values
1756 init_defaults();
1757
1758 # Process command line arguments, 0=no_permute,no_pass_through
1759 get_options(0);
1760
1761 # Build the Section table
1762 build_sect_table();
1763
1764 # Run through the list of Limiters, setting the limiters in %Opts.
1765 process_limiters(@Sections);
1766
1767 # Set collection for any enabled supplemental sections
1768 foreach (@supplemental_reports) {
1769 $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
1770 }
1771
1772 # Don't collect SpamScores when not necessary
1773 $Collecting{'spamscores'} = ($Opts{'detail'} >= 5 && ($Opts{'score_percentiles'} || $Opts{'score_frequencies'})) ? 1 : 0;
1774
1775 if (! defined $Opts{'line_style'}) {
1776 # default line style to full if detail >= 11, or truncate otherwise
1777 $Opts{'line_style'} =
1778 ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
1779 }
1780
1781 # Create the list of REs used to match against log lines
1782 create_ignore_list();
1783
1784 my (%Timings, %TimingsSA, @TimingsTotals, @TimingsSATotals);
1785 my (%SaveLine, %StartInfo);
1786 my (%SpamScores, %spamtags, %p0ftags);
1787
1788 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
1789 my %ccatmajor_to_sectkey = (
1790 'INFECTED' => 'malware',
1791 'BANNED' => 'bannedname',
1792 'UNCHECKED' => 'unchecked',
1793 'SPAM' => 'spam',
1794 'SPAMMY' => 'spammy',
1795 'BAD-HEADER' => 'badheader',
1796 'OVERSIZED' => 'oversized',
1797 'MTA-BLOCKED' => 'mta',
1798 'CLEAN' => 'clean',
1799 'TEMPFAIL' => 'tempfail',
1800 'OTHER' => 'other',
1801 );
1802
1803 my %ccatmajor_to_priority = (
1804 'INFECTED' => 9,
1805 'BANNED' => 8,
1806 'UNCHECKED' => 7,
1807 'SPAM' => 6,
1808 'SPAMMY' => 5,
1809 'BAD-HEADER' => 4,
1810 'OVERSIZED' => 3,
1811 'MTA-BLOCKED' => 2,
1812 'CLEAN' => 1,
1813 'TEMPFAIL' => 0,
1814 'OTHER' => 0,
1815 );
1816
1817 # for reports
1818 my %ccatmajor_to_spamham = (
1819 'INFECTED' => 'malware',
1820 'BANNED' => 'bannedname',
1821 'UNCHECKED' => 'unchecked',
1822 'SPAM' => 'spam',
1823 'SPAMMY' => 'spam',
1824 'BAD-HEADER' => 'ham',
1825 'OVERSIZED' => 'ham',
1826 'MTA-BLOCKED' => 'ham',
1827 'CLEAN' => 'ham',
1828 'TEMPFAIL' => 'ham',
1829 'OTHER' => 'ham',
1830 );
1831
1832 my $logline_maxlen = 980;
1833
1834 # Create the list of REs against which log lines are matched.
1835 # Lines that match any of the patterns in this list are ignored.
1836 #
1837 # Note: This table is created at runtime, due to a Perl bug which
1838 # I reported as perl bug #56202:
1839 #
1840 # http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
1841 #
1842
1843 sub create_ignore_list() {
1844 push @ignore_list_final, qr/^lookup_ip_acl/;
1845 push @ignore_list_final, qr/^lookup_acl/;
1846 push @ignore_list_final, qr/^lookup_hash/;
1847 push @ignore_list_final, qr/^lookup_re/;
1848 push @ignore_list_final, qr/^lookup_ldap/;
1849 push @ignore_list_final, qr/^lookup_sql_field.* result=[YN]$/;
1850 push @ignore_list_final, qr/^lookup .* does not match$/;
1851 push @ignore_list_final, qr/^lookup [[(]/;
1852 push @ignore_list_final, qr/^lookup => /;
1853 push @ignore_list_final, qr/^lookup: /;
1854 push @ignore_list_final, qr/^save_info_preliminary/; # log level 4
1855 push @ignore_list_final, qr/^save_info_final/; # log level 4
1856 push @ignore_list_final, qr/^sql: /;
1857 push @ignore_list_final, qr/^sql_storage: retrying/;
1858 push @ignore_list_final, qr/^sql flush: /;
1859 push @ignore_list_final, qr/^sql print/;
1860 push @ignore_list_final, qr/^sql begin transaction/;
1861 push @ignore_list_final, qr/^sql rollback/;
1862 push @ignore_list_final, qr/^mail_via_sql: /;
1863 push @ignore_list_final, qr/^CALLING SA check$/;
1864 push @ignore_list_final, qr/^calling SA parse,/;
1865 push @ignore_list_final, qr/^timer set to \d+/;
1866 push @ignore_list_final, qr/^query_keys/;
1867 push @ignore_list_final, qr/^find_or_save_addr: /;
1868 push @ignore_list_final, qr/^header: /;
1869 push @ignore_list_final, qr/^DO_QUARANTINE, /;
1870 push @ignore_list_final, qr/^DEBUG_ONESHOT: /;
1871 push @ignore_list_final, qr/^TempDir::/;
1872 push @ignore_list_final, qr/^check_mail_begin_task: /;
1873 push @ignore_list_final, qr/^program: .*?(anomy|altermime|disclaimer).*? said: /; # log_level 2
1874 push @ignore_list_final, qr/^body (?:type|hash): /;
1875 push @ignore_list_final, qr/^\d+\.From: <.*>, \d+.Mail_From:/;
1876 push @ignore_list_final, qr/^The amavisd daemon is (?:apparently )?not running/;
1877 push @ignore_list_final, qr/^rw_loop/;
1878 push @ignore_list_final, qr/^[SL]MTP[><]/;
1879 push @ignore_list_final, qr/^[SL]MTP response for/;
1880 push @ignore_list_final, qr/^dsn:/i, # DSN or dsn
1881 push @ignore_list_final, qr/^enqueue: /;
1882 push @ignore_list_final, qr/^write_header: /;
1883 push @ignore_list_final, qr/^banned check: /;
1884 push @ignore_list_final, qr/^child_finish_hook/;
1885 push @ignore_list_final, qr/^inspect_dsn:/;
1886 push @ignore_list_final, qr/^client IP address unknown/;
1887 push @ignore_list_final, qr/^final_destiny/;
1888 push @ignore_list_final, qr/^one_response_for_all/;
1889 push @ignore_list_final, qr/^headers CLUSTERING/;
1890 push @ignore_list_final, qr/^notif=/;
1891 push @ignore_list_final, qr/^\(about to connect/;
1892 push @ignore_list_final, qr/^Original mail size/;
1893 push @ignore_list_final, qr/^TempDir removal/;
1894 push @ignore_list_final, qr/^Issued a new file name/;
1895 push @ignore_list_final, qr/^starting banned checks/;
1896 push @ignore_list_final, qr/^skip admin notification/;
1897 push @ignore_list_final, qr/^do_notify_and_quarantine - done/;
1898 push @ignore_list_final, qr/^do_[a-zA-Z]+.* done$/i;
1899 push @ignore_list_final, qr/^Remote host presents itself as:/;
1900 push @ignore_list_final, qr/^connect_to_ldap/;
1901 push @ignore_list_final, qr/^connect_to_sql: trying /;
1902 push @ignore_list_final, qr/^ldap begin_work/;
1903 push @ignore_list_final, qr/^Connecting to LDAP server/;
1904 push @ignore_list_final, qr/^loaded base policy bank/;
1905 push @ignore_list_final, qr/^\d+\.From:/;
1906 push @ignore_list_final, qr/^Syslog (retries|warnings)/;
1907 push @ignore_list_final, qr/^smtp connection cache/;
1908 push @ignore_list_final, qr/^smtp cmd> /;
1909 push @ignore_list_final, qr/^smtp session/;
1910 push @ignore_list_final, qr/^Ignoring stale PID file/;
1911 push @ignore_list_final, qr/^mime_decode_preamble/;
1912 push @ignore_list_final, qr/^doing banned check for/;
1913 push @ignore_list_final, qr/^open_on_specific_fd/;
1914 push @ignore_list_final, qr/^reparenting /;
1915 push @ignore_list_final, qr/^Issued a new pseudo part: /;
1916 push @ignore_list_final, qr/^run_command: /;
1917 push @ignore_list_final, qr/^result line from file/;
1918 push @ignore_list_final, qr/^Charging /;
1919 push @ignore_list_final, qr/^check_for_banned /;
1920 push @ignore_list_final, qr/^Extracting mime components$/;
1921 push @ignore_list_final, qr/^response to /;
1922 push @ignore_list_final, qr/^File-type of /;
1923 push @ignore_list_final, qr/^Skip admin notification, /;
1924 push @ignore_list_final, qr/^run_av: /;
1925 push @ignore_list_final, qr/^string_to_mime_entity /;
1926 push @ignore_list_final, qr/^ndn_needed=/;
1927 push @ignore_list_final, qr/^sending RCPT TO:/;
1928 push @ignore_list_final, qr/^decode_parts: /;
1929 push @ignore_list_final, qr/^decompose_part: /;
1930 push @ignore_list_final, qr/^setting body type: /;
1931 push @ignore_list_final, qr/^mime_decode_epilogue: /;
1932 push @ignore_list_final, qr/^string_to_mime_entity: /;
1933 push @ignore_list_final, qr/^at the END handler: /;
1934 push @ignore_list_final, qr/^Amavis::.* called$/;
1935 push @ignore_list_final, qr/^Amavis::.* close,/;
1936 push @ignore_list_final, qr/^dkim: /; # XXX provide stats
1937 push @ignore_list_final, qr/^collect banned table/;
1938 push @ignore_list_final, qr/^collect_results from/;
1939 push @ignore_list_final, qr/^blocking contents category is/;
1940 push @ignore_list_final, qr/^running file\(/;
1941 push @ignore_list_final, qr/^Found av scanner/;
1942 push @ignore_list_final, qr/^Found myself/;
1943 push @ignore_list_final, qr/^mail_via_smtp/;
1944 push @ignore_list_final, qr/^switch_to_client_time/;
1945 push @ignore_list_final, qr/^parse_message_id/;
1946 push @ignore_list_final, qr/^parse_received: /;
1947 push @ignore_list_final, qr/^parse_ip_address_from_received: /;
1948 push @ignore_list_final, qr/^fish_out_ip_from_received: /;
1949 push @ignore_list_final, qr/^Waiting for the process \S+ to terminate/;
1950 push @ignore_list_final, qr/^Valid PID file \(younger than sys uptime/;
1951 push @ignore_list_final, qr/^Sending SIG\S+ to amavisd/;
1952 push @ignore_list_final, qr/^Can't send SIG\S+ to process/;
1953 push @ignore_list_final, qr/^killing process/;
1954 push @ignore_list_final, qr/^no need to kill process/;
1955 push @ignore_list_final, qr/^process .* is still alive/;
1956 push @ignore_list_final, qr/^Daemon \[\d+\] terminated by SIG/;
1957 push @ignore_list_final, qr/^storage and lookups will use .* to SQL/;
1958 push @ignore_list_final, qr/^idle_proc, /;
1959 push @ignore_list_final, qr/^switch_to_my_time/;
1960 push @ignore_list_final, qr/^TempDir::strip: /;
1961 push @ignore_list_final, qr/^rmdir_recursively/;
1962 push @ignore_list_final, qr/^sending [SL]MTP response/;
1963 push @ignore_list_final, qr/^prolong_timer/;
1964 push @ignore_list_final, qr/^process_request:/;
1965 push @ignore_list_final, qr/^exiting process_request/;
1966 push @ignore_list_final, qr/^post_process_request_hook: /;
1967 push @ignore_list_final, qr/^SMTP session over/;
1968 push @ignore_list_final, qr/^updating snmp variables/;
1969 push @ignore_list_final, qr/^best_try_originator_ip/;
1970 push @ignore_list_final, qr/^mail checking ended: /; # log level 2
1971 push @ignore_list_final, qr/^The amavisd daemon is already running/;
1972 push @ignore_list_final, qr/^AUTH not needed/;
1973 push @ignore_list_final, qr/^load: \d+ %, total idle/;
1974 push @ignore_list_final, qr/^policy protocol: [^=]+=\S+(?:,\S+)*$/; # allow "policy protocol: INVALID ..." later
1975 push @ignore_list_final, qr/^penpals: /;
1976 push @ignore_list_final, qr/^Not calling virus scanners, no files to scan in/;
1977 push @ignore_list_final, qr/^local delivery: /;
1978 push @ignore_list_final, qr/^run_as_subprocess: child process \S*: Broken pipe/;
1979 push @ignore_list_final, qr/^initializing Mail::SpamAssassin/;
1980 push @ignore_list_final, qr/^Error reading mail header section/; # seems to occur gen. due to perl getline() bug
1981 push @ignore_list_final, qr/^flatten_and_tidy_dir/;
1982 push @ignore_list_final, qr/^do_7zip: member/;
1983 push @ignore_list_final, qr/^Expanding \S+ archive/;
1984 push @ignore_list_final, qr/^files_to_scan:/;
1985 push @ignore_list_final, qr/^Unzipping p\d+/;
1986 push @ignore_list_final, qr/^writing mail text to SQL/;
1987 push @ignore_list_final, qr/^strip_tempdir/;
1988 push @ignore_list_final, qr/^no parts, file/;
1989 push @ignore_list_final, qr/^warnsender_with_pass/;
1990 push @ignore_list_final, qr/^RETURNED FROM SA check/;
1991 push @ignore_list_final, qr/^mime_traverse: /;
1992 push @ignore_list_final, qr/^do_spam: /;
1993 push @ignore_list_final, qr/^prepare_tempdir: /;
1994 push @ignore_list_final, qr/^check_header: /;
1995 push @ignore_list_final, qr/^skip admin notification/;
1996 push @ignore_list_final, qr/^do_executable: not a/;
1997 push @ignore_list_final, qr/^Skip spam admin notification, no administrators$/;
1998 push @ignore_list_final, qr/^skip banned check for/;
1999 push @ignore_list_final, qr/^is_outgoing /;
2000 push @ignore_list_final, qr/^NO Disclaimer/;
2001 push @ignore_list_final, qr/^Using \(\S+\) on file/;
2002 push @ignore_list_final, qr/^no anti-spam code loaded/;
2003 push @ignore_list_final, qr/^entered child_init_hook/;
2004 push @ignore_list_final, qr/^body type/;
2005 push @ignore_list_final, qr/^establish_or_refresh/;
2006 push @ignore_list_final, qr/^get_body_digest/;
2007 push @ignore_list_final, qr/^ask_daemon_internal/;
2008 push @ignore_list_final, qr/^Turning AV infection into a spam report, name already accounted for/;
2009 push @ignore_list_final, qr/^Calling virus scanners/;
2010 push @ignore_list_final, qr/^timer stopped after /;
2011 push @ignore_list_final, qr/^virus_presence /;
2012 push @ignore_list_final, qr/^cache entry /;
2013 push @ignore_list_final, qr/^generate_mail_id /;
2014 push @ignore_list_final, qr/^Load low precedence policybank/;
2015 push @ignore_list_final, qr/^warm restart on /; # XXX could be placed instartup info
2016 push @ignore_list_final, qr/^Signalling a SIGHUP to a running daemon/;
2017 push @ignore_list_final, qr/^Deleting db files /;
2018 push @ignore_list_final, qr/^address modified \(/;
2019 push @ignore_list_final, qr/^Request: AM\.PDP /;
2020 push @ignore_list_final, qr/^DSPAM result: /;
2021 push @ignore_list_final, qr/^bind to \//;
2022 push @ignore_list_final, qr/^ZMQ enabled: /;
2023
2024 push @ignore_list_final, qr/^Inserting header field: X-Amavis-Hold: /;
2025 push @ignore_list_final, qr/^Decoding of .* failed, leaving it unpacked: /;
2026
2027 # various forms of "Using ..."
2028 # more specific, interesting variants already captured: search "Using"
2029 push @ignore_list_final, qr/^Using \(.*\) on dir:/;
2030 push @ignore_list_final, qr/^Using [^:]+: \(built-in interface\)/;
2031 push @ignore_list_final, qr/^Using \(.*\): /;
2032 push @ignore_list_final, qr/: sleeping for /;
2033 push @ignore_list_final, qr/creating socket by /;
2034
2035 # unanchored
2036 push @ignore_list_final, qr/\bRUSAGE\b/;
2037 push @ignore_list_final, qr/: Sending .* to UNIX socket/;
2038 }
2039
2040 # Notes:
2041 #
2042 # - IN REs, always use /o flag or qr// at end of RE when RE uses unchanging interpolated vars
2043 # - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<[^>]*> )
2044 # - See additional notes below, search for "Note:".
2045 # - XXX indicates change, fix or more thought required
2046
2047 # Main processing loop
2048 #
2049 while (<>) {
2050 chomp;
2051 s/ +$//;
2052 next if $_ eq '';
2053
2054 $Logreporters::Reports::origline = $_;
2055
2056 if ($Opts{'standalone'}) {
2057 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;
2058 }
2059
2060 my $p1 = $_;
2061 my ($p2, $pid);
2062 my $action = "blocked"; # default action is blocked if not present in log
2063
2064 # For now, ignore the amavis startup timing lines. Need to do this
2065 # before stripping out the amavis pid to differentiate these from the
2066 # scan timing reports
2067 next if ($p1 =~ /^TIMING/);
2068
2069 my $linelen = length $p1;
2070 # Strip amavis process id-instance id, or release id
2071 if (($pid,$p2) = ($p1 =~ /^\(([^)]+)\) (.*)$/ )) {
2072 $p1 = $p2;
2073 }
2074
2075 # Handle continuation lines. Continuation lines should be in order per PID, meaning line1, line2, line3,
2076 # but never line3, line1, line2.
2077 #
2078 # amavis log lines as chopped by sub write_log are exactly 980 characters long starting with '(' as in:
2079 # amavis[47061]: (47061-15) SPAM, etc ...
2080 # ^ <-----980------------->
2081 # but this can be changed in amavis via $logline_maxlen.
2082 # There may also be the alert markers (!) and (!!) preceeding any continuation ellipsis.
2083 #
2084
2085 # ... a continued line ...
2086 if ($p1 =~ s/^(\([!]{1,2}\))?\.\.\.//) {
2087 if (!exists($SaveLine{$pid})) {
2088 my $alert = $1;
2089 #printf "Unexpected continue line: \"%s\"\n", $p1;
2090 $SaveLine{$pid} = $alert || '';
2091 }
2092 $SaveLine{$pid} .= $p1;
2093 next if $SaveLine{$pid} =~ s/\.\.\.$//; # next if line has more pieces
2094 }
2095
2096 # this line continues ...
2097 if ($p1 =~ /\.\.\.$/ and $linelen == $logline_maxlen) {
2098 $p1 =~ s/\.\.\.$//;
2099 $SaveLine{$pid} = $p1;
2100 next;
2101 }
2102
2103 if (exists($SaveLine{$pid})) {
2104 # printf "END OF SaveLine: %s\n", $SaveLine{$pid};
2105 $p1 = delete $SaveLine{$pid};
2106 }
2107
2108 #if (length($p1) > 10000) {
2109 # printf "Long log entry %d chars: \"%s\"\n", length($p1), $p1;
2110 # next;
2111 #}
2112
2113 next if (
2114 # Place REs here that should ignore log lines otherwise caught below.
2115 # Some are located here historically, and need to be checked for candidates
2116 # to be relocated to ignore_list_final.
2117 ($p1 =~ /^do_ascii/)
2118 or ($p1 =~ /^Checking/)
2119 or ($p1 =~ /^header_edits_for_quar: /)
2120 or ($p1 =~ /^Not-Delivered/)
2121 or ($p1 =~ /^SpamControl/)
2122 or ($p1 =~ /^Perl/)
2123 or ($p1 =~ /^ESMTP/)
2124 or ($p1 =~ /^(?:\(!+\))?(\S+ )?(?:FWD|SEND) from /) # log level 4
2125 or ($p1 =~ /^(?:\(!+\))?(\S+ )?(?:ESMTP|FWD|SEND) via /) # log level 4
2126 or ($p1 =~ /^tempdir being removed/)
2127 or ($p1 =~ /^do_notify_and_quar(?:antine)?: .*ccat/)
2128 or ($p1 =~ /^cached [a-zA-Z0-9]+ /)
2129 or ($p1 =~ /^loaded policy bank/)
2130 or ($p1 =~ /^p\.path/)
2131 or ($p1 =~ /^virus_scan: /)
2132 or ($p1 =~ /^Requesting (a |)process rundown after [0-9]+ tasks/)
2133 or ($p1 =~ /^Cached (virus|spam) check expired/)
2134 or ($p1 =~ /^pr(?:esent|ovid)ing full original message to scanners as/) # log level 2
2135 or ($p1 =~ /^Actual message size [0-9]+ B(,| greater than the) declared [0-9]+ B/)
2136 or ($p1 =~ /^disabling DSN/)
2137 or ($p1 =~ /^Virus ([^,]+ )?matches [^,]+, sender addr ignored/)
2138 or ($p1 =~ /^release /)
2139 or ($p1 =~ /^adding SA score \S+ to existing/)
2140 or ($p1 =~ /^Maia:/) # redundant
2141 or ($p1 =~ /^AM\.PDP /) # this appears to be always have two spaces
2142 # because in amavisd::preprocess_policy_query() when $ampdp is
2143 # set, it will pass an unset $attr_ref->{'mail_id'} to do_log(1
2144 or ($p1 =~ /^_(?:WARN|DIE):$/) # bug: empty _WARN|_DIE: http://marc.info/?l=amavis-user&m=121725098111422&w=2
2145
2146 # non-begin anchored
2147 or ($p1 =~ /result: clean$/)
2148 or ($p1 =~ /DESTROY called$/)
2149 or ($p1 =~ /email\.txt no longer exists, can't re-use it/)
2150 or ($p1 =~ /SPAM\.TAG2/)
2151 or ($p1 =~ /BAD-HEADER\.TAG2/)
2152 or ($p1 =~ /: Connecting to socket/)
2153 or ($p1 =~ /broken pipe \(don't worry\), retrying/)
2154 or ($p1 =~ /(?:Sending|on dir:) (?:CONT)?SCAN /)
2155 );
2156
2157 my ($ip, $from, $to, $key,, $reason, $item,
2158 $decoder, $scanner, $stage, $sectkey);
2159
2160 # Coerce older "INFECTED" quarantined lines into "Blocked INFECTED",
2161 # to be processed in the Passed/Blocked section.
2162 if ($p1 =~ /^INFECTED.*, quarantine/) {
2163 $p1 = 'Blocked ' . $p1;
2164 }
2165
2166 # SPAM entry occurs at kill level
2167 # SPAM-TAG entry occurs at log level 2, when spam header is inserted
2168 # log_level >= 2 || (log_level > 2 && syslog_priority=debug)
2169 my ($tagtype,$fromto,$isspam,$tags,$tests,$autolearn);
2170
2171 # amavisd-new 2.7.0 changes SPAM-TAG to Spam-tag and its log_level to 3
2172 if (($tagtype,$fromto,$isspam,$tags,$tests,$autolearn) = ($p1 =~ /^((?i:SPAM(?:-TAG)?)), (.*), (Yes|No), score=[-+x\d.]+(.*) tests=\[([^\]]*)](?:, autolearn=(\w+))?/) or
2173 ($tagtype,$fromto,$isspam,$tags,$tests) = ($p1 =~ /^((?i:SPAM(?:-TAG)?)), (.*), (Yes|No), hits=[-+x\d.]+(.*) tests=(.*)(?:, quarantine )?/)) {
2174
2175 #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)
2176 #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)
2177 #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)
2178 #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]
2179 #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]
2180 # pre 2.3.3
2181 #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
2182 #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)
2183
2184 $Totals{'tagged'}++ if uc($tagtype) eq 'SPAM-TAG';
2185
2186 if ($tests) {
2187 my $type = $isspam =~ /^Y/ ? 'Spam' : 'Ham';
2188
2189 # Note: A SPAM line may be followed by an almost identical SPAM-TAG line. To avoid double counting,
2190 # maintain a list of (abbreviated) SPAM tag lines keyed by pid. Since pid's are recycled,
2191 # maintain an approximation of uniqueness by combining several components from the log
2192 # line (we can't use the date information, as in logwatch, it is not present).
2193 # XXX: It is safe to delete an entry when the final Passed/Block line occurs
2194
2195 #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
2196 #TD SPAM-TAG, <from@example.com> -> <to@sample.net>, Yes, score=34.939 required=6.31 tests=[DATE_IN_FUTURE_03_06=1.961]
2197 #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
2198
2199
2200 my $tagstr = $fromto . '/' . $isspam . '/' . $tests;
2201 if (uc($tagtype) eq 'SPAM-TAG' and exists $spamtags{$pid}) {
2202 next if ($spamtags{$pid} eq $tagstr);
2203 }
2204 $spamtags{$pid} = $tagstr;
2205
2206 #for (split /=[^,]+(?:, +|$)/, $tests)
2207 # amavis < 2.6.2 would double list AV names when using
2208 # @virus_name_to_spam_score_maps.
2209 my @unique_tests = unique_list (split /, +/, $tests);
2210 for (@unique_tests) {
2211 # skip possible trailing junk ("quarantine, ...") when older non-bracked tests=xxx is used
2212 next if ! /[^=]+=[\-.\d]+/;
2213 my ($id,$val) = split /=/;
2214 if ($id =~ /^BAYES_\d+$/) {
2215 $Counts{'bayes'}{$id}++ if ($Collecting{'bayes'});
2216 }
2217 if ($Opts{'sarules'}) {
2218 if ($id eq 'DKIM_POLICY_SIGNSOME') { $val = 0 }
2219 elsif ($id eq 'AWL') { $val = '-' }
2220 $Counts{'sarules'}{$type}{sprintf "%6s %s", $val, $id}++;
2221 }
2222 }
2223 # Handled below
2224 #autolearn= is available only at ll>=3 or SPAM messages; so ham doesn't naturally occur here
2225 # SA 2.5/2.6 : ham/spam/no
2226 # SA 3.0+ : ham/spam/no/disabled failed/unavailable
2227 #$Counts{'autolearn'}{$type}{$autolearn}++ if ($Opts{'autolearn'});
2228 }
2229 }
2230
2231 # Passed or Blocked
2232 elsif ($p1 =~ /^(Passed|Blocked)(.*)/) {
2233 $action = lcfirst $1;
2234 ($p1 = $2) =~ s/^\s+//;
2235
2236 $p1 =~ s/^,/CLEAN,/; # canonicalize older log entries
2237 #print "P1: \"$p1\"\n";
2238
2239 # amavis 20030616p10-5
2240 #TD Passed, <from@example.com> -> <to@sample.net>, Message-ID: <652.44494541@example.com>, Hits: 4.377
2241 #TD Passed, <from@example.com> -> <to@sample.net>, Message-ID: <B5C@example.com>, Hits: -
2242 #TD Passed, <from@example.com> -> <to@sample.net>, quarantine IJHkgliCm2Ia, Message-ID: <20080307140552.16E127641E@example.com>, Hits: 0.633
2243
2244 #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
2245 #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
2246 #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
2247 #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
2248 #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
2249 #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
2250 #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
2251 #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
2252 #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
2253 #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
2254 #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
2255 #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
2256 #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
2257 #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
2258 #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
2259 #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
2260 #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
2261 #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
2262 #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
2263 #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
2264 #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
2265 #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
2266 #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
2267 #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
2268 #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
2269 #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
2270
2271 #2.3.1
2272 #<>,<info@example.com>,Passed,Hits=-3.3,Message-ID=<200506440.1.sample.net>,Size=51458
2273 #20030616p10-5
2274 #Not-Delivered, <from@example.com> -> <to@localhost>, quarantine spam-ea32770-03, Message-ID: <BAA618FE2CB585@localhost>, Hits: 9.687
2275
2276 # malwarepassed, malwareblocked
2277 # xxx very old
2278 # Virus found - quarantined|
2279 #amavisd-new-20030616
2280 # 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: -
2281 # 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: -
2282 #XXX (?:(Passed|Blocked) )?INFECTED \(([^\)]+)\),[A-Z .]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[)>]/o ))
2283 #XXX elsif (($action, $key, $ip, $from, $to) = ( $p1 =~ /^(?:Virus found - quarantined|(?:(Passed|Blocked) )?INFECTED) \(([^\)]+)\),[A-Z .]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[(>]/o ))
2284
2285 # the first IP is the envelope sender.
2286 if ($p1 !~ /^(CLEAN|SPAM(?:MY)?|INFECTED \(.*?\)|BANNED \(.*?\)|BAD-HEADER(?:-\d)?|UNCHECKED|MTA-BLOCKED|OVERSIZED|OTHER|TEMPFAIL)(?: {[^}]+})?, ([^[]+ )?(?:([^<]+) )?[<(](.*?)[>)] -> ([(<].*?[)>]), (?:.*Hits: ([-+.\d]+))(?:.* size: (\d+))?(?:.* autolearn=(\w+))?/) {
2287 inc_unmatched('passblock');
2288 next;
2289 }
2290 my $trigger;
2291 my ($ccatmajor, $pbanks, $ips, $from, $reciplist, $hits, $size, $autolearn) = ($1, $2, $3, $4, $5, $6, $7, $8);
2292
2293 $Totals{'bytesscanned'} += $size if defined $size;
2294
2295 #print "ccatmajor: \"$ccatmajor\", pbanks: \"$pbanks\"\n";
2296 if ($ccatmajor =~ /^(INFECTED|BANNED) \((.*)\)$/) {
2297 ($ccatmajor, $trigger) = ($1, $2);
2298 #print "\tccatmajor: \"$ccatmajor\", trigger: \"$trigger\"\n";
2299 }
2300
2301 $ccatmajor =~ s/(BAD-HEADER)-\d/$1/; # strip amavis 2.7's [:ccat|minor] BAD-HEADER sub-classification
2302 $sectkey = $ccatmajor_to_sectkey{$ccatmajor} . $action;
2303 $Totals{$sectkey}++;
2304
2305 # Not checked by spamassassin, due to $sa_mail_body_size_limit or @bypass_spam_checks_maps
2306 if ($hits eq '-') {
2307 # Don't increment sabypassed for INFECTED (SA intentionally not called)
2308 unless ($ccatmajor eq 'INFECTED') {
2309 # The following order is used, the first condition met decides the outcome:
2310 # 1. a virus is detected: mail is considered infected;
2311 # 2. contains banned name or type: mail is considered banned;
2312 # 3. spam level is above kill level for at least one recipient, or a sender is blacklisted: mail is considered spam;
2313 # 4. bad (invalid) headers: mail is considered as having a bad header.
2314 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
2315 $Totals{'sabypassed'}++;
2316 }
2317 } else {
2318 if ($Collecting{'spamscores'}) {
2319 no re 'taint';
2320 if ($hits =~ /^(-?[.\d]+)([-+])([.\d]+)$/) {
2321 $hits = eval $1.$2.$3; # untaint $hits, to sum $1 and $3 values
2322 }
2323 # SA not called for ccats INFECTED and BANNED (Hits: -).
2324 # UNCHECKED may have a score, so we can't distinguish Ham from Spam
2325 push @{$SpamScores{$ccatmajor_to_spamham{$ccatmajor}}}, $hits;
2326 }
2327 }
2328
2329 # autolearn is available here only if enabled in amavis template
2330 if ($autolearn ne '' and $Opts{'autolearn'}) {
2331 #if ($autolearn ne '' and ($ccatmajor eq 'SPAM' or $ccatmajor eq 'CLEAN')) {
2332 # SA 2.5/2.6 : ham/spam/no
2333 # SA 3.0+ : ham/spam/no/disabled/failed/unavailable
2334 # printf "INC: autolearn: %s, %s: %d\n", $ccatmajor eq 'SPAM' ? 'Spam' : 'Ham', $autolearn, $Opts{'autolearn'};;
2335 # Priorities other than SPAM will be considered HAM for autolearn stats
2336 $Counts{'autolearn'}{$ccatmajor eq 'SPAM' ? 'Spam' : 'Ham'}{$autolearn}++;
2337 }
2338
2339 # p0f fingerprinting
2340 if (exists $p0ftags{$pid}) {
2341 my ($ip,$score,$os) = split(/\//, $p0ftags{$pid});
2342 $Counts{'p0f'}{ucfirst($ccatmajor_to_spamham{$ccatmajor})}{$os}{$ip}++;
2343 #print "Deleting p0ftag: $pid\n";
2344 delete $p0ftags{$pid};
2345 }
2346
2347 next unless ($Collecting{$sectkey});
2348 # cleanpassed never gets here...
2349
2350 # prefer xforward IP if it exists
2351 # $ip_a => %a original SMTP session client IP address (empty if unknown, e.g. no XFORWARD)
2352 # $ip_e => %e best guess of the originator IP address collected from the Received trace
2353 my ($ip_a, $ip_e) = split(/ /, $ips, 2);
2354
2355 $ip = $ip_a ? $ip_a : $ip_e;
2356 $ip =~ s/[[\]]//g;
2357 #print "ip: \"$ip\", ip_a: \"$ip_a\", ip_e: \"$ip_e\", from: \"$from\", reciplist: \"$reciplist\"; hits: \"$hits\"\n";
2358 $ip = '*unknown IP' if ($ip eq '');
2359 $from = '<>' if ($from eq '');
2360
2361 # Show first recipient only, or all
2362 my @recips = split /,/, $reciplist;
2363 @recips = map { /^<(.+)>$/ } @recips;
2364 # show only first recipient
2365 $to = lc ($Opts{'first_recip_only'} ? $recips[0] : "@recips");
2366
2367 if ($ccatmajor eq 'INFECTED') { # $ccatmajor: INFECTED malwarepassed, malwareblocked
2368 $Counts{$sectkey}{$trigger}{$to}{$ip}{$from}++;
2369 }
2370 elsif ($ccatmajor eq 'BANNED') { # $ccatmajor: BANNED bannednamepassed, bannednameblocked
2371 $Counts{$sectkey}{$to}{$trigger}{$ip}{$from}++;
2372 } else {
2373 # $ccatmajor: CLEAN | SPAM{MY} | BAD-HEADER | UNCHECKED | MTA-BLOCKED | OVERSIZED | OTHER | TEMPFAIL
2374 # cleanpassed, cleanblocked, spampassed, spamblocked, badheaderpassed, badheaderblocked
2375 # uncheckedpassed, uncheckblocked, mtapassed, mtablocked, oversizedpassed, oversizedblocked
2376 # otherpassed, otherblocked, tempfailpassed, tempfailblocked
2377 $Counts{$sectkey}{$to}{$ip}{$from}++;
2378 }
2379
2380 # old...
2381 #XXX elsif (($action, $item, $ip, $from, $to) = ( $p1 =~ /^(?:(Blocked|Passed) )?BANNED (?:name\/type )?\((.+)\),[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^(<]+)[(>]/o))
2382 #XXXX elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Passed|Blocked) )?UNCHECKED,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^>)]*)[)>]/o ))
2383 #XXX elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Passed|Blocked) )?TEMPFAIL,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [<(]([^>)]*)[>)] -> [(<]([^>)]*)[)>]/o ))
2384 #XXX elsif (($action, $ip, $from, $to) = ( $p1 =~ /^(?:(Blocked|Passed) )?BAD-HEADER,[^[]*(?: \[($re_IP)\])?(?: \[$re_IP\])* [(<]([^>)]*)[)>](?: -> [(<]([^>)]+)[)>])[^:]*/o ))
2385 # amavis 2.3.1
2386 #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]
2387 } # end Passed or Blocked
2388
2389 # MAIA
2390 elsif ($p1 =~ /^FAKE SENDER, ([^:]+): ($[^,]+), (.*)$/o) {
2391 #TD FAKE SENDER, SPAM: 192.168.0.1, bogus@example.com
2392 $Totals{'fakesender'}++; next unless ($Collecting{'fakesender'});
2393 $Counts{'fakesender'}{$1}{$2}{$3}++;
2394 }
2395
2396 elsif ($p1 =~ /^p\d+ \d+(?:\/\d+)* Content-Type: ([^,]+)(?:, size: [^,]+, name: (.*))?/) {
2397 my ($ts, $name) = ($1, $2);
2398 #TD p006 1 Content-Type: multipart/mixed
2399 #TD p008 1/1 Content-Type: multipart/signed
2400 #TD p001 1/1/1 Content-Type: text/plain, size: 460 B, name:
2401 #TD p002 1/1/2 Content-Type: application/pgp-signature, size: 189 B, name:
2402 #TD p002 1/2 Content-Type: application/octet-stream, size: 3045836 B, name: abc.pdf
2403 next unless ($Collecting{'contenttype'});
2404 my ($type, $subtype) = $ts !~ '""' ? split /\//, $ts : ('unspecified', 'unspecified');
2405
2406 $name = '' if !defined $name or $name =~ /^\s*$/;
2407 $Counts{'contenttype'}{$type}{$subtype}{$name}++;
2408 }
2409
2410 # LMTP/SMTP connection
2411 # NOTE: no longer used. size data now being obtained from Passed/Block line, as size info may not be available here
2412 #elsif (my ($size) = ($p1 =~ /^[LS]MTP:(?:\[$re_IP\])?:\d+ [^:]+: [<(](?:.*?)[>)] -> \S+ (?:SIZE=(\d+))?.*?Received: / )) {
2413 elsif ($p1 =~ /^[LS]MTP:/) {
2414 #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)
2415 #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)
2416 #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)
2417 #$Totals{'bytesscanned'} += $size if defined $size;
2418 }
2419
2420 #(\S+) ([^[(]+)(.*)$
2421 elsif ($p1 =~ /^OS_fingerprint: (\S+) ([-\d.]+) (\S+)(?: ([^[(]+|\[[^]]+\]))?/o) {
2422 #TD OS_fingerprint: 213.193.24.113 29.789 Linux 2.6 (newer, 1) (up: 1812 hrs), (distance 14, link: ethernet/modem)
2423 #TD OS_fingerprint: 10.47.2.155 -1.312 MYNETWORKS
2424 # Note: safe to delete entry when the final Passed/Block line occurs
2425 if ($Collecting{'p0f'}) {
2426 my ($genre,$vers) = ($3,$4);
2427 #print "p0f:\t$3\t\t$vers\n";
2428 if ($genre eq 'Windows') {
2429 local($1);
2430 $vers = $1 if $vers =~ /^(\S+) /;
2431 $genre .= ' ' . $vers;
2432 }
2433 elsif ($genre eq 'UNKNOWN') {
2434 $genre = 'Unknown';
2435 }
2436 $p0ftags{$pid} = join('/', $1,$2,$genre);
2437 #print "Added PID: $pid, $p0ftags{$pid}\n";
2438 }
2439 }
2440
2441 elsif ( ($reason) = ( $p1 =~ /^BAD HEADER from [^:]+: (.+)$/) or
2442 ($reason) = ( $p1 =~ /check_header: \d, (.+)$/)) {
2443 # When log_level > 1, provide additional header or MIME violations
2444
2445 # amavisd < 2.4.0, log_level >= 1
2446 #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]
2447 #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
2448 #TD BAD HEADER from <bogus@example.com>: MIME error: error: part did not end with expected boundary
2449 #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
2450 #TD BAD HEADER from (list) <bogus@bounces@lists.example.com>: MIME error: error: part did not end with expected boundary
2451 # amavisd >= 2.4.3, log_level >= 2
2452 #TD check_header: 2, Non-encoded 8-bit data (char AE hex): Subject: RegionsNet\\256 Online Banking\\n
2453 #TD check_header: 2, Non-encoded 8-bit data (char E1 hex): From: "any user" <from\\341k@example.com>\\n
2454 #TD check_header: 3, Improper use of control character (char 0D hex): Content-type: text/html; charset=i...
2455 #TD check_header: 8, Duplicate header field: "Reply-To"
2456 #TD check_header: 8, Duplicate header field: "Subject"
2457 #TD check_header: 4, Improper folded header field made up entirely of whitespace (char 09 hex): X-Loop-Detect: 3\\n\\t\\n
2458 #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
2459
2460
2461 my $subreason;
2462 if ($reason =~ /^(.*?) \((char \S+ hex)\)(.*)$/) {
2463 $reason = $1;
2464 my ($char,$sub) = ($2,$3);
2465
2466 $sub =~ s/^in message header '[^:]+': //;
2467 $sub =~ s/^: //;
2468 $subreason = "$char: $sub";
2469 }
2470 elsif ($reason =~ /^(Improper folded header field made up entirely of whitespace):? (.*)/) {
2471 $reason = $1;
2472 $subreason = $2;
2473 }
2474 elsif ($reason =~ /^(Duplicate header field): "(.+)"$/) {
2475 $reason = $1;
2476 $subreason = $2;
2477 }
2478 elsif ($reason =~ /^(MIME error): (?:error: )?(.+)$/) {
2479 $reason = $1;
2480 $subreason = $2;
2481 }
2482
2483 $Totals{'badheadersupp'}++; next unless ($Collecting{'badheadersupp'});
2484 $Counts{'badheadersupp'}{$reason}{$subreason}++;
2485 }
2486
2487 elsif ($p1 =~ /^truncating a message passed to SA at/) {
2488 #TD truncating a message passed to SA at 431018 bytes, orig 1875912
2489 $Totals{'truncatedmsg'}++;
2490 }
2491
2492 elsif ($p1 =~ /: spam level exceeds quarantine cutoff level/ or
2493 $p1 =~ /: cutoff, blacklisted/) {
2494 #TD do_notify_and_quarantine: spam level exceeds quarantine cutoff level 20
2495 #TD do_notify_and_quarantine: cutoff, blacklisted
2496 $Totals{'spamdiscarded'}++;
2497 }
2498
2499 elsif ( $p1 =~ /^spam_scan: (.*)$/) {
2500 #if ($1 =~ /^not wasting time on SA, message longer than/ ) {
2501 #TD spam_scan: not wasting time on SA, message longer than 409600 bytes: 1326+4115601
2502 # this causes duplicate counts, and the subsequent Passed/Blocked log line
2503 # will have "Hits: -," whereby sabypassed is incremented.
2504 #$Totals{'sabypassed'}++;
2505 #}
2506 # ignore other spam_scan lines
2507 }
2508
2509 # WARN:
2510 elsif ( ($reason) = ( $p1 =~ /^WARN: MIME::Parser error: (.*)$/ )) {
2511 # WARN: MIME::Parser error: unexpected end of header
2512 $Totals{'mimeerror'}++; next unless ($Collecting{'mimeerror'});
2513 $Counts{'mimeerror'}{$reason}++;
2514 }
2515
2516 elsif ($p1 =~ /^WARN: address modified \((\w+)\): <(.*?)> -> <(.*)>$/) {
2517 #TD WARN: address modified (sender): <root> -> <root@>
2518 #TD WARN: address modified (recip): <root> -> <root@>
2519 #TD WARN: address modified (recip): <postmaster> -> <postmaster@>
2520 #TD WARN: address modified (recip): <"test@example.com"@> -> <"teszt@example.com">
2521 #TD WARN: address modified (sender): <fr\344om@sample.net> -> <"fr\344om"@sample.net>
2522 $Totals{'warningaddressmodified'}++; next unless ($Collecting{'warningaddressmodified'});
2523 $Counts{'warningaddressmodified'}{$1 eq 'sender' ? "Sender address" : "Recipient address"}{"$2 -> $3"}++;
2524 }
2525
2526 # NOTICE:
2527 elsif ($p1 =~ /^NOTICE: (.*)$/) {
2528 # uninteresting
2529 #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.
2530 next if ($1 =~ /^Disconnected from SQL server/); # redundant
2531 next if ($1 =~ /^do_search: trying again: LDAP_OPERATIONS_ERROR/);
2532 next if ($1 =~ /^reconnecting in response to: /);
2533
2534
2535 if ($1 =~ /^Not sending DSN, spam level ([\d.]+ )?exceeds DSN cutoff level/) {
2536 #TD NOTICE: Not sending DSN, spam level exceeds DSN cutoff level for all recips, mail intentionally dropped
2537 $Totals{'dsnsuppressed'}++;
2538 $Counts{'dsnsuppressed'}{'DSN cutoff exceeded'}++;
2539 }
2540 elsif ($1 =~ /^Not sending DSN to believed-to-be-faked sender/) {
2541 #TD NOTICE: Not sending DSN to believed-to-be-faked sender <user@example.com>, mail containing VIRUS intentionally dropped
2542 $Totals{'dsnsuppressed'}++;
2543 $Counts{'dsnsuppressed'}{'Sender likely faked'}++;
2544 }
2545 elsif ($1 =~ /^DSN contains [^;]+; bounce is not bounc[ai]ble, mail intentionally dropped/) {
2546 $Totals{'dsnsuppressed'}++;
2547 $Counts{'dsnsuppressed'}{'Not bounceable'}++;
2548 }
2549 elsif ($1 =~ /^UNABLE TO SEND DSN to /) {
2550 #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
2551 $Totals{'dsnsuppressed'}++;
2552 $Counts{'dsnsuppressed'}{'Unable to send'}++;
2553 }
2554
2555 elsif ($1 =~ /^Skipping (?:bad|extra) output from file\(1\)/) {
2556 #TD NOTICE: Skipping extra output from file(1): blah
2557 #TD NOTICE: Skipping bad output from file(1) at [1, p002], got: blah
2558 $Totals{'fileoutputskipped'}++;
2559 }
2560 elsif (($p1) = ($1 =~ /^Virus scanning skipped: (.*)$/)) {
2561 #TD NOTICE: Virus scanning skipped: Maximum number of files (1500) exceeded at (eval 57) line 1283, <GEN212> line 1501.
2562 $Totals{'virusscanskipped'}++; next unless ($Collecting{'virusscanskipped'});
2563 $Counts{'virusscanskipped'}{strip_trace($p1)}++;
2564 }
2565 else {
2566 inc_unmatched('NOTICE');
2567 next;
2568 }
2569 }
2570
2571 # INFO:
2572 elsif ($p1 =~ /^INFO: (.*)$/) {
2573 next if ($1 =~ /^unfolded \d+ illegal all-whitespace continuation line/);
2574 next if ($1 =~ /^removed bare CR/);
2575
2576 if ($1 =~ /^truncat(ed|ing)/) {
2577 #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...
2578 #TD INFO: truncated 1 header line(s) longer than 998 characters
2579 $Totals{'truncatedheader'}++;
2580 } elsif ( $1 =~ /^no existing header field 'Subject', inserting it/) {
2581 $Totals{'nosubject'}++;
2582 }
2583 elsif (my ($savers1, $savers2, $item) = ( $1 =~ /^(?:SA version: ([^,]+), ([^,]+), )?no optional modules: (.+)$/)) {
2584 #TD INFO: SA version: 3.1.8, 3.001008, no optional modules: DBD::mysql Mail::SpamAssassin::Plugin::DKIM Mail::SpamAssassin::Plugin::URIDetail Error
2585 next unless ($Opts{'startinfo'});
2586 if ($savers1 ne '') {
2587 $StartInfo{'sa_version'} = "$savers1 ($savers2)";
2588 }
2589 foreach my $code (split / /, $item) {
2590 $StartInfo{'Code'}{'Not loaded'}{$code} = "";
2591 }
2592 }
2593 elsif (my ($name) = ( $1 =~ /^(unknown banned table name \S+), .+$/)) {
2594 #TD INFO: unknown banned table name 1, recip=r@example.com
2595 $Totals{'warning'}++; next unless ($Collecting{'warning'});
2596 $Counts{'warning'}{ucfirst $name}++;
2597 }
2598 else {
2599 inc_unmatched('INFO');
2600 next;
2601 }
2602 }
2603
2604 elsif ( ($action,$reason,$from,$to) = ($p1 =~ /^DSN: NOTIFICATION: Action:([^,]+), ([^,]+), <(.*?)> -> <(.*?)>/)) {
2605 #TD DSN: NOTIFICATION: Action:failed, LOCAL 554 Banned, <from@example.net> -> <to@example.com>
2606 #TD DSN: NOTIFICATION: Action:delayed, LOCAL 454 Banned, <from@example.com> -> <to@example.net>
2607
2608 $Totals{'dsnnotification'}++; next unless ($Collecting{'dsnnotification'});
2609 $Counts{'dsnnotification'}{$action}{$reason}{"$from -> $to"}++;
2610 }
2611
2612 elsif (($item, $from, $to) = ( $p1 =~ /^Quarantined message release(?: \([^)]+\))?: ([^ ]+) <(.*?)> -> (.+)$/) or
2613 ($item, $from, $to) = ( $p1 =~ /^Quarantine release ([^ ]+): overriding recips <([^>]*)> by (.+)$/)) {
2614 #TD Quarantine release arQcr95dNHaW: overriding recips <TO@EXAMPLE.COM> by <to@example.com>
2615 #TD Quarantined message release: hiyPJOsD2m9Z <from@sample.net> -> <to@example.com>
2616 #TD Quarantined message release: hiyPJOsD2m9Z <> -> <to@recipient.maildir>,<anyone@example.com>
2617 # 2.6+
2618 #TD Quarantined message release (miscategorized): Iu6+0u1voOA <from@example.com> -> <to@example.net>
2619 $Totals{'released'}++; next unless ($Collecting{'released'});
2620 $from = '<>' if ($from eq '');
2621 $to =~ s/[<>]//g;
2622 $Counts{'released'}{"\L$from"}{$to}{$item}++;
2623 }
2624 elsif ($p1 =~ /^Quarantine release ([^:]+): missing X-Quarantine-ID$/) {
2625 #TD Quarantine release 7ejEBC7MThSc: missing X-Quarantine-ID
2626 $Totals{'warningnoquarantineid'}++; next unless ($Collecting{'warningnoquarantineid'});
2627 $Counts{'warningnoquarantineid'}{$1}++;
2628 }
2629
2630 elsif ( ($stage,$reason) = ($p1 =~ /^Negative SMTP resp\S* +to ([^:]+): *(.*)$/)) {
2631 #TD Negative SMTP response to data-dot (<u@example.com>): 550 5.7.1 Header Spam Rule 4
2632 $Totals{'smtpresponse'}++; next unless ($Collecting{'smtpresponse'});
2633 $Counts{'smtpresponse'}{'Negative response'}{$stage}{$reason}++;
2634 }
2635 elsif ( ($stage,$reason) = ($p1 =~ /^smtp resp to ([^:]+): *(.*)$/)) {
2636 #TD smtp resp to NOOP (idle 4799.4 s): 421 4.4.2 nops.overtops.org Error: timeout exceeded
2637 #TD smtp resp to MAIL (pip): 250 2.1.0 Ok
2638 $Totals{'smtpresponse'}++; next unless ($Collecting{'smtpresponse'});
2639 $stage =~ s/ [\d.]+ s//;
2640 $Counts{'smtpresponse'}{'Response'}{$stage}{$reason}++;
2641 }
2642
2643 elsif ( ($item) = ($p1 =~ /^response to RCPT TO for <([^>]*)>: "501 Bad address syntax"/)) {
2644 #TD response to RCPT TO for <""@example.com>: "501 Bad address syntax"
2645 $Totals{'badaddress'}++; next unless ($Collecting{'badaddress'});
2646 $Counts{'badaddress'}{$item}++;
2647 }
2648
2649 # do_unip: archive extraction
2650 elsif ($p1 =~ s/^do_unzip: \S+, //) {
2651 $Totals{'archiveextract'}++; next unless ($Collecting{'archiveextract'});
2652
2653 if ( $p1 =~ s/^\d+ members are encrypted, //) {
2654 #TD do_unzip: p003, 4 members are encrypted, none extracted, archive retained
2655 $Counts{'archiveextract'}{'Encrypted'}{$p1}++;
2656
2657 } elsif ( $p1 =~ /^zero length members, archive retained/) {
2658 #TD do_unzip: p002, zero length members, archive retained
2659 $Counts{'archiveextract'}{'Empty member'}{''}++;
2660
2661 } elsif ($p1 =~ s/^unsupported compr\. method: //) {
2662 #TD do_unzip: p003, unsupported compr. method: 99
2663 $Counts{'archiveextract'}{'Unsupported compression'}{$p1}++;
2664 }
2665 else {
2666 $Counts{'archiveextract'}{'*unknown'}{$p1}++;
2667 }
2668 }
2669
2670 # do_cabextract: archive extraction
2671 elsif ($p1 =~ s/^do_cabextract: //) {
2672 #TD do_cabextract: can't parse toc line: File size | Date Time | Name
2673 #TD do_cabextract: can't parse toc line: All done, no errors.
2674 $Totals{'archiveextract'}++; next unless ($Collecting{'archiveextract'});
2675
2676 if ($p1 =~ /^([^:]+):\s*(.*)/) {
2677 $Counts{'archiveextract'}{"\u$1"}{$2}++;
2678 } else {
2679 $Counts{'archiveextract'}{$p1}{''}++;
2680 }
2681 }
2682
2683 elsif ($p1 =~ /^(?:\(!\) *)?SA TIMED OUT,/) {
2684 $Totals{'satimeout'}++;
2685 }
2686
2687 elsif ($p1 =~ /^mangling (.*)$/) {
2688 $p1 = $1;
2689 if ($p1 =~ /^by (.+?) failed: (.+?), mail will pass unmodified$/) {
2690 #TD mangling by altermine failed: SomeText, mail will pass unmodified
2691 $Totals{'defangerror'}++; next unless ($Collecting{'defangerror'});
2692 $Counts{'defangerror'}{$1}{$2}++;
2693 }
2694 # other mangle message skipped
2695 else {
2696 #TD mangling YES: 1 (orig: 1), discl_allowed=0, <from@example.com> -> <to@sample.net>
2697 #TD mangling by built-in defanger: 1, <user@example.com>
2698 next;
2699 }
2700 }
2701 elsif ($p1 =~ /^DEFANGING MAIL: (.+)$/) {
2702 # log_level 1
2703 #TD DEFANGING MAIL: WARNING: possible mail bomb, NOT CHECKED FOR VIRUSES:\n Exceeded storage quota 5961070 bytes by d...
2704 #TD DEFANGING MAIL: WARNING: bad headers - Improper use of control character (char 0D hex): To: <to@example.com\\r>,\\n\\t<to@example.com>
2705 # could use instead...
2706 #do_log(1,"mangling by %s (%s) done, new size: %d, orig %d bytes", $actual_mail_mangle, $mail_mangle, $repl_size, $msginfo->msg_size);
2707 $Totals{'defanged'}++; next unless ($Collecting{'defanged'});
2708 $Counts{'defanged'}{$1}++;
2709 }
2710
2711 elsif ($p1 =~ /^PenPalsSavedFromKill [-.\d]+,/) {
2712 #TD PenPalsSavedFromKill 8.269-3.160, <ulyanov@steelpro.com.ua> -> <recipient1@recipientdomain.com>
2713 $Totals{'penpalsaved'}++;
2714 }
2715
2716 # I don't know how many variants of time outs there are... I suppose we'll fix as we go
2717 elsif (($p1 =~ /^\(!+\)([^ ]*) is taking longer than \d+ s and will be killed/) or
2718 ($p1 =~ /^\(!+\)(.*) av-scanner FAILED: timed out/) or
2719 ($p1 =~ /^(?:\(!+\))?(.*): timed out/))
2720 {
2721 #TD (!)/usr/local/bin/uvscan is taking longer than 10 s and will be killed
2722 #TD (!!)NAI McAfee AntiVirus (uvscan) av-scanner FAILED: timed out
2723 #TD ClamAV-clamd: timed out, retrying (1)
2724 #TD (!)Sophie: timed out, retrying (2)
2725
2726 $Totals{'avtimeout'}++; next unless ($Collecting{'avtimeout'});
2727 $Counts{'avtimeout'}{$1}++;
2728 }
2729 elsif (($p2) = ($p1 =~ /SMTP shutdown: (.*)$/)) { # log level -1
2730 #TD SMTP shutdown: Error writing a SMTP response to the socket: Broken pipe at (eval 49) line 836, <GEN232> line 51.
2731 #TD SMTP shutdown: tempdir is to be PRESERVED: /var/amavis/tmp/amavis-20070704T095350-13145
2732 strip_trace($p2);
2733 if ($p2 =~ /^tempdir is to be PRESERVED: (.*)\/([^\/]+)$/) {
2734 $Totals{'tmppreserved'}++;
2735 $Counts{'tmppreserved'}{$1}{$2}++ if ($Collecting{'tmppreserved'});
2736 $p2 = "Preserved tempdir in $1";
2737 }
2738 $Totals{'warningsmtpshutdown'}++; next unless ($Collecting{'warningsmtpshutdown'});
2739 $Counts{'warningsmtpshutdown'}{ucfirst($p2)}++;
2740 }
2741
2742 elsif (($p1 =~ /PRESERVING EVIDENCE in (.*)\/([^\/]+)$/) or
2743 ($p1 =~ /tempdir is to be PRESERVED: (.*)\/([^\/]+)$/)) {
2744 #TD (!)TempDir removal: tempdir is to be PRESERVED: /var/amavis/tmp/amavis-20080110T173606-05767
2745 # log level -1
2746 #TD PRESERVING EVIDENCE in /var/amavis/tmp/amavis-20070704T111558-14883
2747 $Totals{'tmppreserved'}++; next unless ($Collecting{'tmppreserved'});
2748 $Counts{'tmppreserved'}{$1}{$2}++;
2749 }
2750
2751 elsif ($p1 =~ /^Open relay\? Nonlocal recips but not originating/) {
2752 $Totals{'warningsecurity'}++;
2753 $Counts{'warningsecurity'}{$p1}++ if ($Collecting{'warningsecurity'});
2754 }
2755
2756 # keep before general warnings below, so sadiag gets first crack at log
2757 # lines beginning with "(!) ...".
2758 elsif ($p1 =~ /^(?:\(!+\))?\!?SA (warn|info|error): (.*)$/) {
2759 #TD SA warn: FuzzyOcr: Cannot find executable for gocr
2760 my ($level,$msg) = ($1,$2);
2761
2762 # XXX later, maybe break out stats on FuzzyOcr
2763 # skip "image too small" for now
2764 if ($msg =~ /^FuzzyOcr: Skipping .+, image too small$/) {
2765 #TD SA warn: FuzzyOcr: Skipping ocrad, image too small
2766 #TD SA warn: FuzzyOcr: Skipping ocrad-decolorize, image too small
2767 #$Counts{'sadiags'}{'fuzzyocr'}{'image too small'}++;
2768 next;
2769 }
2770 elsif ($msg =~ /dns: \[\.\.\.\]/) {
2771 #TD SA info: dns: [...] ;; ADDITIONAL SECTION (1 record)
2772 next;
2773 }
2774 # canonicalize some PIDs and IDs
2775 elsif ($msg =~ s/^pyzor: \[\d+\] error/pyzor: [<PID>] error/) {
2776 #TD SA info: pyzor: [11550] error: TERMINATED, signal 15 (000f)
2777 }
2778 elsif ($msg =~ /dns: no likely matching queries for id \d+/) {
2779 $msg =~ s/\d+/<ID>/;
2780 }
2781 elsif ($msg =~ /dns: no callback for id \d+/) {
2782 $msg =~ s/\d+.*$/<ID>.../;
2783 }
2784
2785 # report other SA warn's
2786 $Totals{'sadiags'}++;
2787 next unless ($Collecting{'sadiags'});
2788 $Counts{'sadiags'}{ucfirst($level)}{$msg}++;
2789 }
2790
2791 # catchall for most other warnings
2792 elsif (($p1 =~ /^\(!+\)/) or
2793 ($p1 =~ /^TROUBLE/) or
2794 ($p1 =~ /Can't (?:connect to UNIX|send to) socket/) or
2795 ($p1 =~ /: Empty result from /) or
2796 ($p1 =~ /: Error reading from socket: Connection reset by peer/) or
2797 ($p1 =~ /open\(.*\): Permission denied/) or
2798 ($p1 =~ /^_?WARN: /) or
2799 ($p1 =~ /Can't send SIG \d+ to process \[\d+\]: Operation not permitted/) or
2800 ($p1 =~ /(policy protocol: INVALID(?: AM\.PDP)? ATTRIBUTE LINE: .*)$/) or
2801 ($p1 =~ /(DKIM signature verification disabled, corresponding features not available. If not intentional.*)$/)
2802 )
2803 {
2804 #TD (!)loading policy bank "AM.PDP-SOCK": unknown field "0"
2805 #TD (!!)policy_server FAILED: SQL quarantine code not enabled at (eval 37) line 306, <GEN6> line 4.
2806 #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.
2807 #TD ClamAV-clamd: Empty result from /var/run/clamav/clamd, retrying (1)
2808 #TDdcc open(/var/dcc/map): Permission denied
2809 #TD TROUBLE in check_mail: FAILED: Died at /usr/sbin/amavisd-maia line 2872, <GEN4> line 22.
2810 #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.
2811 #TD TROUBLE in process_request: DBD::mysql::st execute failed: MySQL server has gone away at (eval 35) line 258, <GEN18> line 3.
2812 #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.
2813 #TD TROUBLE in process_request: Can't call method "disconnect" on an undefined value at /usr/sbin/amavisd-maia line 2895, <GEN4> line 22.
2814 #TD TROUBLE: recipient not done: <to@example.com> smtp response ...
2815 #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.
2816 #TD TROUBLE: lookup table is an unknown object: object ...
2817 #TD (!) policy protocol: INVALID ATTRIBUTE LINE: /var/spool/courier/tmp/114528/D967099\n
2818 #TD (!) policy protocol: INVALID AM.PDP ATTRIBUTE LINE: /var/spool/courier/tmp/114528/D967099\n
2819 #TD _WARN: bayes: cannot open bayes databases /var/spool/amavis/.spamassassin/bayes_* R/W: lock failed: Interrupted system call\n
2820
2821 $p1 =~ s/^\(!+\)s*//;
2822
2823 if ($p1 =~ /^WARN: (Using cpio instead of pax .*)$/) {
2824 #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!
2825 $Totals{'warningsecurity'}++;
2826 $Counts{'warningsecurity'}{$1}++ if ($Collecting{'warningsecurity'});
2827 next;
2828 }
2829
2830 $p1 =~ s/, retrying\s+\(\d+\)$//;
2831 strip_trace($p1);
2832
2833 # canonicalize variations of the same message
2834 $p1 =~ s/^run_av \(([^,]+), built-in i\/f\)/$1/;
2835 $p1 =~ s/ av-scanner FAILED: CODE\(0x[^)]+\)/:/;
2836 $p1 =~ s/^(.+: Too many retries to talk to \S+) .*/$1/;
2837
2838 if (($p1 =~ /(\S+): Can't (?:connect|send) to (?:UNIX )?(.*)$/) or
2839 ($p1 =~ /(\S+): (Too many retries to talk to .*)$/))
2840 {
2841
2842 #TD (!)ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd.socket: No such file or directory, retrying (2)
2843 #TD (!)ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd: Connection refused, retrying (2)
2844 #TD ClamAV-clamd: Can't connect to UNIX socket /var/run/clamav/clamd: Connection refused, retrying (1)
2845 #TD ClamAV-clamd: Can't send to socket /var/run/clamav/clamd: Transport endpoint is not connected, retrying (1)
2846 #TD Sophie: Can't send to socket /var/run/sophie: Transport endpoint is not connected, retrying (1)
2847 #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.
2848 #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.
2849 #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.
2850 #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.
2851
2852 $Totals{'avconnectfailure'}++;
2853 $Counts{'avconnectfailure'}{$1}{ucfirst($2)}++ if ($Collecting{'avconnectfailure'});
2854 next;
2855 }
2856
2857 # simplify or canonicalize variations of the same message
2858 $p1 =~ s/^TROUBLE(:| in) //;
2859 $p1 =~ s/^_?WARN: //;
2860 $p1 =~ s/Can't create file \S+: (.+)$/Can't create file: $1/;
2861 $p1 =~ s/Can't send SIG \d+ to process \[\d+\]/Can't send SIG to process/;
2862
2863 $Totals{'warning'}++; next unless ($Collecting{'warning'});
2864 $Counts{'warning'}{$p1}++;
2865 }
2866
2867 # Begin forced warnings: Keep this code below warning catchall
2868 elsif ($p1 =~ /^lookup_sql: /) {
2869 #TD lookup_sql: 2006, MySQL server has gone away
2870 $Totals{'warningsql'}++; next unless ($Collecting{'warningsql'});
2871 $Counts{'warningsql'}{'SQL died'}++;
2872
2873 } elsif (($reason,$item) = ($p1 =~ /^connect_to_sql: ([^']+) '\S+': (.*?)(?: \(\d+\))?$/) or
2874 ($item,$reason) = ($p1 =~ /^lookup_sql_field\((.*)\) \(WARN: (no such field in the SQL table)\)/)) {
2875 #TD connect_to_sql: unable to connect to DSN 'DBI:mysql:maia:sqlhost1.example.com': Lost connection to MySQL server during query
2876 #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)
2877 #TD lookup_sql_field(id) (WARN: no such field in the SQL table), "from@example.com" result=undef
2878 $Totals{'warningsql'}++; next unless ($Collecting{'warningsql'});
2879 $Counts{'warningsql'}{ucfirst("$reason: $item")}++;
2880 }
2881 # End forced warnings
2882
2883 # panic
2884 elsif ( ($p2) = ($p1 =~ /^(?:\(!\)\s*)?PANIC, (.*)$/)) {
2885 #TD PANIC, PANIC, SA produced a clone process of [19122], TERMINATING CLONE [19123]
2886
2887 $Totals{'panic'}++; next unless ($Collecting{'panic'});
2888 $Counts{'panic'}{$p2}++;
2889
2890 }
2891
2892 # fatal
2893 elsif ( $p1 =~ /^Requesting process rundown after fatal error$/) {
2894 #TD Requesting process rundown after fatal error
2895 $Totals{'fatal'}++; next unless ($Collecting{'fatal'});
2896 $Counts{'fatal'}{$p1}++;
2897
2898 # DCC
2899 } elsif (($reason) = ($p1 =~ /^(missing message body; fatal error)/) or
2900 ($reason) = ($p1 =~ /^(try to start dccifd)/)) {
2901 $Totals{'dccerror'}++; next unless ($Collecting{'dccerror'});
2902 $Counts{'dccerror'}{ucfirst($reason)}++;
2903 }
2904 elsif ($p1 =~ /^continue not asking DCC \d+ seconds after failure/) {
2905 $Totals{'dccerror'}++; next unless ($Collecting{'dccerror'});
2906 $Counts{'dccerror'}{'Continue not asking DCC after failure'}++;
2907 }
2908 elsif ($p1 =~ /^no DCC answer from (\S+) after \d+ ms$/) {
2909 $Totals{'dccerror'}++; next unless ($Collecting{'dccerror'});
2910 $Counts{'dccerror'}{"No answer from $1"}++;
2911 }
2912
2913 elsif ( ($reason, $from, $to) = ($p1 =~ /^skip local delivery\((\d+)\): <(.*?)> -> <(.*?)>$/)) {
2914 $Totals{'localdeliveryskipped'}++; next unless ($Collecting{'localdeliveryskipped'});
2915 $from = '<>' if ($from eq '');
2916 $reason = $reason == 1 ? "No localpart" : $reason == 2 ? "Local alias is null" : "Other";
2917 $Counts{'localdeliveryskipped'}{$reason}{$from}{$to}++;
2918 }
2919
2920 # hard and soft whitelisted/blacklisted
2921 elsif ($p1 =~ /^wbl: (.*)$/) {
2922 # ignore wbl entries, can't think of good way to reliably summarize.
2923 # and 'black or whitelisted by all' makes using by-white or -black list
2924 # groupings impossible
2925 next;
2926 =cut
2927 $p1 = $1;
2928
2929 # TD wbl: black or whitelisted by all recips
2930 next if ($p1 =~ /^black or whitelisted/); # not clear how to report this, so skip
2931 next if ($p1 =~ /^checking sender/); # ll 4
2932 next if ($p1 =~ /^(LDAP) query keys/); # ll 5
2933 next if ($p1 =~ /^(LDAP) recip/); # ll 5
2934 next if ($p1 =~ /^recip <[^>]*> (?:black|white)listed sender/); # ll 5
2935
2936 # lookup order: SQL, LDAP, static
2937 if ($p1 =~ s/^\(SQL\) recip <[^>]*>//) {
2938 next if ($p1 =~ /^, \S+ matches$/); # ll 5
2939 next if ($p1 =~ /^, rid=/); # ll 4
2940 next if ($p1 =~ /^ is neutral to sender/); # ll 5
2941 next if ($p1 =~ /^ (?:white|black)listed sender </); # ll 5
2942 # ll -1
2943 #wbl: (SQL) recip <%s> whitelisted sender <%s>, '. unexpected wb field value
2944 }
2945 #ll2
2946 # wbl: (SQL) soft-(white|black)listed (%s) sender <%s> => <%s> (rid=%s)', $val, $sender, $recip, $user_id);
2947 # multiple senders: message sender, then "from", etc.
2948 #ll2
2949 # wbl: soft-(white|black)listed (%s) sender <%s> => <%s>,
2950
2951 #TD wbl: whitelisted sender <sender@example.com>
2952 #TD wbl: soft-whitelisted (-3) sender <from@example.com> => <to@sample.net>, recip_key="."
2953 #TD wbl: whitelisted by user@example.com, but not by all, sender <bounces@example.net>, <user@example.org>
2954 # wbl: (whitelisted|blacklisted|black or whitelisted by all recips|(white|black)listed by xxx,yyy,... but not by all) sender %s
2955
2956 if ($p1 =~ /^(?:\(SQL\) )?(?:(soft)-)?((?:white|black)listed)(?: \([^)]+\))? sender <([^>]*)>/) {
2957 my ($type,$list,$sender) = ($1,$2,$3);
2958 $Totals{$list}++; next unless ($Collecting{$list});
2959 $type = $type ? 'Soft' : 'Hard' ;
2960 my ($localpart, $domainpart) = split (/@/, lc $sender);
2961 ($localpart, $domainpart) = ($sender, '*unspecified') if ($domainpart eq '');
2962 $Counts{$list}{$type}{$domainpart}{$localpart}++;
2963 }
2964 else {
2965 inc_unmatched('wbl');
2966 next;
2967 }
2968 =cut
2969 }
2970
2971 # XXX: WHITELISTED or BLACKLISTED should be caught in SPAM tag above
2972 elsif (($p1 =~ /^white_black_list: whitelisted sender/) or
2973 ($p1 =~ /.* WHITELISTED/) ) {
2974 $Totals{'whitelisted'}++;
2975
2976 } elsif (($p1 =~ /^white_black_list: blacklisted sender/) or
2977 ( $p1 =~ /.* BLACKLISTED/) ) {
2978 $Totals{'blacklisted'}++;
2979
2980 } elsif ($p1 =~ /^Turning AV infection into a spam report: score=([^,]+), (.+)$/) {
2981 #TD Turning AV infection into a spam report: score=4.1, AV:Sanesecurity.ScamL.375.UNOFFICIAL=4.1
2982 #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
2983 #BAT.Backdoor.Poisonivy.E178-SecuriteInfo.com
2984
2985 next unless ($Collecting{'malwaretospam'});
2986 #my $score_max = $1;
2987 my @list = split (/,/, $2);
2988 @list = unique_list(\@list);
2989 foreach (@list) {
2990 my ($name,$score) = split (/=/,$_);
2991 $name =~ s/^AV://;
2992 my $type = $name =~ s/\.UNOFFICIAL$// ? 'Unofficial' : 'Official';
2993 # strip trailing numeric variant (...Phishing.Cur.863)
2994 my $variant = $name =~ s/([.-]\d+)$// ? $1 : '*invariant';
2995 $Counts{'malwaretospam'}{$type}{$name}{$variant}{$score}++
2996 }
2997
2998 # The virus_scan line reports only the one virus name when more than one scanner detects a virus.
2999 # Use instead the ask_av and run_av lines (see below)
3000 #
3001 #} elsif ( my ($malware, $scanners) = ($p1 =~ /virus_scan: \(([^)]+)\), detected by \d+ scanners: (.*)$/ )) {
3002 #TD virus_scan: (HTML.Phishing.Bank-43), detected by 1 scanners: ClamAV-clamd
3003 #TD virus_scan: (Worm.SomeFool.D, Worm.SomeFool.D), detected by 1 scanners: ClamAV-clamd
3004 #TD virus_scan: (Trojan.Downloader.Small-9993), detected by 2 scanners: ClamAV-clamd, NAI McAfee AntiVirus (uvscan)
3005 # foreach (split /, /, $scanners) {
3006 # #$Totals{'malwarebyscanner'}++; # No summary output: redundant w/malwarepassed,malwareblocked}
3007 # $Counts{'malwarebyscanner'}{"$_"}{$malware}++;
3008 # }
3009
3010 } elsif ($p1 =~ /^(?:ask_av|run_av) (.*)$/) {
3011 next unless ($Collecting{'malwarebyscanner'});
3012
3013 if (my ($scanner, $name) = ($1 =~ /^\((.+)\):(?: [^:]+)? INFECTED: ([^,]+)/)) {
3014 #TD ask_av (ClamAV-clamd): /var/amavis/tmp/amavis-20070830T070403-13776/parts INFECTED: Email.Malware.Sanesecurity.07082700
3015 #TD run_av (NAI McAfee AntiVirus (uvscan)): INFECTED: W32/Zhelatin.gen!eml, W32/Zhelatin.gen!eml
3016 my $type = $name =~ s/\.UNOFFICIAL$// ? 'Unofficial' : 'Official';
3017 my $variant = '';
3018 if ($name =~ s/([.-]\d+)$//) { # strip trailing numeric variant (...Phishing.Cur.863)
3019 $variant = $1;
3020 }
3021 $Counts{'malwarebyscanner'}{$scanner}{$type}{$name}{$variant}++;
3022 }
3023 # currently ignoring other ask_av or run_av lines
3024 }
3025
3026 # Extra Modules loaded at runtime
3027 #TD extra modules loaded after daemonizing/chrooting: Mail/SPF/Query.pm
3028 elsif (($item) = ( $p1 =~ /^extra modules loaded(?: after daemonizing(?:\/chrooting)?)?: (.+)$/)) {
3029 #TD extra modules loaded: PerlIO.pm, PerlIO/scalar.pm
3030 foreach my $code (split /, /, $item) {
3031 #TD extra modules loaded: unicore/lib/gc_sc/Digit.pl, unicore/lib/gc_sc/SpacePer.pl
3032 # avoid useless reporting of pseudo-modules which can't be pre-loaded once
3033 unless ($code =~ m#^unicore/lib/#) {
3034 $Totals{'extramodules'}++;
3035 $Counts{'extramodules'}{$code}++ if ($Collecting{'extramodules'});
3036 }
3037 }
3038
3039 # Timing report
3040 } elsif (my ($total,$report) = ( $p1 =~ /^(?:size: \d+, )?TIMING \[total (\d+) ms(?:, [^]]+)?\] - (.+)$/)) {
3041 next if ($report =~ /^got data/); # skip amavis release timing
3042 #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
3043 # older format, maia mailguard
3044 #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%)
3045 # v2.8.1
3046 # .... size: 3815, TIMING [total 1901 ms, cpu 657 ms] - ...
3047
3048
3049 # Timing line is incomplete - let's report it
3050 if ($p1 !~ /\d+ \(\d+%\)\d+$/ and $p1 !~ /\d+ \(\d+%\)$/) {
3051 inc_unmatched('timing');
3052 next;
3053 }
3054
3055 if ($Opts{'timings'}) {
3056 my @pairs = split(/[,:] /, $report);
3057 while (my ($key,$value) = @pairs) {
3058 #4 (0%)0
3059 my ($ms) = ($value =~ /^([\d.]+) /);
3060 # maintain a per-test list of timings
3061 push @{$Timings{$key}}, $ms;
3062 shift @pairs; shift @pairs;
3063 }
3064 push @TimingsTotals, $total;
3065 }
3066
3067 } elsif ((($total,$report) = ( $p1 =~ /^TIMING-SA total (\d+) ms - (.+)$/ )) or
3068 (($total,$report) = ( $p1 =~ /^TIMING-SA \[total (\d+) ms, cpu \d+ ms\] - (.+)$/ ))) {
3069 #TIMING-SA [total 3219 ms, cpu 432 ms] - parse: 6 (0.2%), ext
3070 #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%)
3071
3072 # Timing line is incomplete - let's report it
3073 if ($p1 !~ /[\d.]+ \([\d.]+%\)[\d.]+$/ and $p1 !~ /[\d.]+ \([\d.]+%\)$/) {
3074 inc_unmatched('timing-sa');
3075 next;
3076 }
3077 if ($Opts{'sa_timings'}) {
3078 my @pairs = split(/[,:] /, $report);
3079 while (my ($key,$value) = @pairs) {
3080 #4 (0%)0
3081 my ($ms) = ($value =~ /^([\d.]+) /);
3082 # maintain a per-SA test list of timings
3083 push @{$TimingsSA{$key}}, $ms;
3084 shift @pairs; shift @pairs;
3085 }
3086 push @TimingsSATotals, $total;
3087 }
3088
3089 # Bounce killer: 2.6+
3090 } elsif ($p1 =~ /^bounce (.*)$/) {
3091 #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>
3092 #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>
3093 #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>
3094 #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>
3095 $p2 = $1;
3096
3097 if ($p2 =~ /^killed, <(.+?)> -> /) {
3098 $Totals{'bouncekilled'}++;
3099 $Counts{'bouncekilled'}{$1 eq '' ? '<>' : $1}++ if ($Collecting{'bouncekilled'});
3100 }
3101 elsif ($p2 =~ /^rescued by ([^,]+), <(.+?)> -> /) {
3102 # note: ignores "rescued by: pen pals disabled"
3103 $Totals{'bouncerescued'}++;
3104 $Counts{'bouncerescued'}{'By ' . $1}{$2 eq '' ? '<>' : $2}++ if ($Collecting{'bouncerescued'});
3105 }
3106 elsif ($p2 =~ /^unverifiable, <(.+?)> -> /) {
3107 # note: ignores "rescued by: pen pals disabled"
3108 $Totals{'bounceunverifiable'}++;
3109 $Counts{'bounceunverifiable'}{$1 eq '' ? '<>' : $1}++ if ($Collecting{'bounceunverifiable'});
3110 }
3111 #TD bounce unverifiable, <postmaster@nurturegood.com> -> <dave@davewolloch.com>
3112 #TD bounce unverifiable, <> -> <Dave@davewolloch.com>
3113 }
3114
3115 # Decoders
3116 elsif (my ($suffix, $info) = ( $p1 =~ /^Internal decoder for (\.\S*)\s*(?:\(([^)]*)\))?$/)) {
3117 #TD Internal decoder for .gz (backup, not used)
3118 #TD Internal decoder for .zip
3119 next unless ($Opts{'startinfo'});
3120 $StartInfo{'Decoders'}{'Internal'}{$suffix} = $info;
3121 }
3122
3123 elsif (($suffix, $decoder) = ( $p1 =~ /^No decoder for\s+(\.\S*)\s*(?:tried:\s+(.*))?$/)) {
3124 #TD No decoder for .tnef tried: tnef
3125 # older
3126 #TD No decoder for .doc
3127 next unless ($Opts{'startinfo'});
3128 $StartInfo{'Decoders'}{'None'}{$suffix} = "tried: " . ($decoder ? $decoder : "unknown");
3129 }
3130
3131 elsif (($suffix, $decoder) = ( $p1 =~ /^Found decoder for\s+(\.\S*)\s+at\s+(.*)$/)) {
3132 #TD Found decoder for .bz2 at /usr/bin/bzip2 -d
3133 #TD Found decoder for .bz2 at /usr/bin/7za (backup, not used)
3134 next unless ($Opts{'startinfo'});
3135 $StartInfo{'Decoders'}{'External'}{$suffix} = exists $StartInfo{'Decoders'}{'External'}{$suffix} ?
3136 join '; ', $StartInfo{'Decoders'}{'External'}{$suffix}, $decoder : $decoder;
3137 }
3138
3139 # AV Scanners
3140 elsif (my ($tier, $scanner, $location) = ( $p1 =~ /^Found (primary|secondary) av scanner (.+) at (.+)$/)) {
3141 #TD Found primary av scanner NAI McAfee AntiVirus (uvscan) at /usr/local/bin/uvscan
3142 #TD Found secondary av scanner ClamAV-clamscan at /usr/local/bin/clamscan
3143 next unless ($Opts{'startinfo'});
3144 $StartInfo{'AVScanner'}{"\u$tier"}{$scanner} = $location;
3145
3146 } elsif (($tier, $scanner, $location) = ( $p1 =~ /^No (primary|secondary) av scanner: (.+)$/)) {
3147 #TD No primary av scanner: CyberSoft VFind
3148 next unless ($Opts{'startinfo'});
3149 $StartInfo{'AVScanner'}{"\u$tier (not found)"}{$scanner} = '';
3150
3151 } elsif ( (($tier, $scanner) = ( $p1 =~ /^Using internal av scanner code for \(([^)]+)\) (.+)$/)) or
3152 (($tier, $scanner) = ( $p1 =~ /^Using (.*) internal av scanner code for (.+)$/))) {
3153 #TD Using internal av scanner code for (primary) ClamAV-clamd
3154 #TD Using primary internal av scanner code for ClamAV-clamd
3155 next unless ($Opts{'startinfo'});
3156 $StartInfo{'AVScanner'}{"\u$tier internal"}{$scanner} = '';
3157
3158 # (Un)Loaded code, protocols, etc.
3159 } elsif (my ($code, $loaded) = ( $p1 =~ /^(\S+)\s+(?:proto? |base |protocol )?\s*(?:code)?\s+((?:NOT )?loaded)$/)) {
3160 next unless ($Opts{'startinfo'});
3161 $StartInfo{'Code'}{"\u\L$loaded"}{$code} = "";
3162
3163 } elsif (my ($module, $vers) = ( $p1 =~ /^Module (\S+)\s+(.+)$/)) {
3164 #TD Module Amavis::Conf 2.086
3165 next unless ($Opts{'startinfo'});
3166 $StartInfo{'Code'}{'Loaded'}{$module} = $vers;
3167
3168 } elsif (($module, my $families) = ( $p1 =~ /^socket module (\S+),\s+(.+)$/)) {
3169 #TD socket module IO::Socket::IP, protocol families available: INET, INET6
3170 next unless ($Opts{'startinfo'});
3171 $StartInfo{'Code'}{'Loaded'}{$module} = $families;
3172
3173 } elsif (($code, $location) = ( $p1 =~ /^Found \$(\S+)\s+at\s+(.+)$/)) {
3174 #TD Found $file at /usr/bin/file
3175 #TD Found $uncompress at /usr/bin/gzip -d
3176 next unless ($Opts{'startinfo'});
3177 $StartInfo{'Code'}{'Loaded'}{$code} = $location;
3178
3179 } elsif (($code, $location) = ( $p1 =~ /^No \$(\S+),\s+not using it/)) {
3180 #TD No $dspam, not using it
3181 next unless ($Opts{'startinfo'});
3182 $StartInfo{'Code'}{'Not loaded'}{$code} = $location;
3183
3184 } elsif (($code, $location) = ( $p1 =~ /^No ext program for\s+([^,]+), (tried: .+)/)) {
3185 #TD No ext program for .kmz, tried: 7za, 7z
3186 #TD No ext program for .F, tried: unfreeze, freeze -d, melt, fcat
3187 next unless ($Opts{'startinfo'});
3188 $StartInfo{'Code'}{'Not found'}{$code} = $location;
3189
3190
3191 } elsif ( $p1 =~ /^starting\.\s+(.+) at \S+ (?:amavisd-new-|Maia Mailguard )([^,]+),/) {
3192 #TD starting. /usr/local/sbin/amavisd at mailhost.example.com amavisd-new-2.5.0 (20070423), Unicode aware, LANG="C"
3193 #TD starting. /usr/sbin/amavisd-maia at vwsw02.eon.no Maia Mailguard 1.0.2, Unicode aware, LANG=en_US.UTF-8
3194 next unless ($Opts{'startinfo'});
3195 %StartInfo = () if !exists $StartInfo{'Logging'};
3196 $StartInfo{'ampath'} = $1;
3197 $StartInfo{'amversion'} = $2;
3198
3199 } elsif ( $p1 =~ /^config files read: (.*)$/) {
3200 #TD config files read: /etc/amavisd.conf, /etc/amavisd-overrides.conf
3201 next unless ($Opts{'startinfo'});
3202 $StartInfo{'Configs'} = "$1";
3203
3204 } elsif ($p1 =~ /^Creating db in ([^;]+); [^,]+, (.*)$/) {
3205 #TD Creating db in /var/spool/amavis/db/; BerkeleyDB 0.31, libdb 4.4
3206 next unless ($Opts{'startinfo'});
3207 $StartInfo{'db'} = "$1\t($2)";
3208
3209 } elsif ($p1 =~ /^BerkeleyDB-based Amavis::Cache not available, using memory-based local cache$/) {
3210 #TD BerkeleyDB-based Amavis::Cache not available, using memory-based local cache
3211 next unless ($Opts{'startinfo'});
3212 $StartInfo{'db'} = "BerkeleyDB\t(memory-based cache: Amavis::Cache unavailable)";
3213
3214 } elsif (my ($log) = ($p1 =~ /^logging initialized, log (level \d+, (?:STDERR|syslog: \S+))/)) {
3215 next unless ($Opts{'startinfo'});
3216 %StartInfo = (); # first amavis log entry, clear out previous start info
3217 $StartInfo{'Logging'} = $log;
3218
3219 } elsif (( $p1 =~ /^(:?perl=[^,]*, )?user=([^,]*), EUID: (\d+) [(](\d+)[)];\s+group=([^,]*), EGID: ([\d ]+)[(]([\d ]+)[)]/)) {
3220 # uninteresting...
3221 #next unless ($Opts{'startinfo'});
3222 #$StartInfo{'IDs'}{'user'} = $1;
3223 #$StartInfo{'IDs'}{'euid'} = $2;
3224 #$StartInfo{'IDs'}{'uid'} = $3;
3225 #$StartInfo{'IDs'}{'group'} = $4;
3226 #$StartInfo{'IDs'}{'egid'} = $5;
3227 #$StartInfo{'IDs'}{'gid'} = $6;
3228 } elsif ($p1 =~ /^after_chroot_init: EUID: (\d+) [(](\d+)[)]; +EGID: ([\d ]+)[(]([\d ]+)[)]/) {
3229 #TD after_chroot_init: EUID: 999 (999); EGID: 54322 54322 54322 (54322 54322 54322)
3230 # uninteresting...
3231
3232 } elsif ($p1 =~ /^SpamAssassin debug facilities: (.*)$/) {
3233 next unless ($Opts{'startinfo'});
3234 $StartInfo{'sa_debug'} = $1;
3235
3236 # amavis >= 2.6.3
3237 } elsif ($p1 =~ /^SpamAssassin loaded plugins: (.*)$/) {
3238 #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
3239 next unless ($Opts{'startinfo'});
3240 map { $StartInfo{'SAPlugins'}{'Loaded'}{$_} = '' } split(/, /, $1);
3241
3242 } elsif (($p2) = ( $p1 =~ /^Net::Server: (.*)$/ )) {
3243 next unless ($Opts{'startinfo'});
3244 if ($p2 =~ /^.*starting! pid\((\d+)\)/) {
3245 #TD Net::Server: 2007/05/02-11:05:24 Amavis (type Net::Server::PreForkSimple) starting! pid(4405)
3246 $StartInfo{'Server'}{'pid'} = $1;
3247 } elsif ($p2 =~ /^Binding to UNIX socket file (.*) using/) {
3248 #TD Net::Server: Binding to UNIX socket file /var/spool/amavis/amavisd.sock using SOCK_STREAM
3249 $StartInfo{'Server'}{'socket'} = $1;
3250 } elsif ($p2 =~ /^Binding to TCP port (\d+) on host (.*)$/) {
3251 #TD Net::Server: Binding to TCP port 10024 on host 127.0.0.1
3252 $StartInfo{'Server'}{'ip'} = "$2:$1";
3253 } elsif ($p2 =~ /^Setting ([ug]id) to "([^"]+)"$/) {
3254 $StartInfo{'Server'}{$1} = $2;
3255 #TD Net::Server: Setting gid to "91 91"
3256 #TD Net::Server: Setting uid to "91"
3257 }
3258 # skip others
3259 }
3260
3261 # higher debug level or rare messages skipped last
3262 elsif (! check_ignore_list ($p1, @ignore_list_final)) {
3263 inc_unmatched('final');
3264 }
3265 }
3266
3267 ########################################
3268 # Final tabulations, and report printing
3269
3270
3271 # spamblocked includes spamdiscarded; adjust here
3272 $Totals{'spamblocked'} -= $Totals{'spamdiscarded'};
3273
3274
3275 #Totals: Blocked/Passed totals
3276 $Totals{'totalblocked'} += $Totals{$_} foreach (
3277 qw(
3278 malwareblocked
3279 bannednameblocked
3280 uncheckedblocked
3281 spamblocked
3282 spamdiscarded
3283 spammyblocked
3284 badheaderblocked
3285 oversizedblocked
3286 mtablocked
3287 cleanblocked
3288 tempfailblocked
3289 otherblocked
3290 ));
3291
3292 $Totals{'totalpassed'} += $Totals{$_} foreach (
3293 qw(
3294 malwarepassed
3295 bannednamepassed
3296 uncheckedpassed
3297 spampassed
3298 spammypassed
3299 badheaderpassed
3300 oversizedpassed
3301 mtapassed
3302 cleanpassed
3303 tempfailpassed
3304 otherpassed
3305 ));
3306
3307 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
3308 #Totals: Ham/Spam
3309
3310 $Totals{'totalmalware'} += $Totals{$_} foreach (
3311 qw(malwarepassed malwareblocked));
3312
3313 $Totals{'totalbanned'} += $Totals{$_} foreach (
3314 qw(bannednamepassed bannednameblocked));
3315
3316 $Totals{'totalunchecked'} += $Totals{$_} foreach (
3317 qw(uncheckedpassed uncheckedblocked));
3318
3319 $Totals{'totalspammy'} += $Totals{$_} foreach (
3320 qw(spammypassed spammyblocked));
3321
3322 $Totals{'totalbadheader'} += $Totals{$_} foreach (
3323 qw(badheaderpassed badheaderblocked));
3324
3325 $Totals{'totaloversized'} += $Totals{$_} foreach (
3326 qw(oversizedpassed oversizedblocked));
3327
3328 $Totals{'totalmta'} += $Totals{$_} foreach (
3329 qw(mtapassed mtablocked));
3330
3331 $Totals{'totalclean'} += $Totals{$_} foreach (
3332 qw(cleanpassed cleanblocked));
3333
3334 $Totals{'totalother'} += $Totals{$_} foreach (
3335 qw(tempfailpassed tempfailblocked otherpassed otherblocked));
3336
3337 $Totals{'totalspam'} += $Totals{$_} foreach (
3338 qw(spampassed spamblocked spamdiscarded totalspammy));
3339
3340 # everything lower priority than SPAMMY is considered HAM
3341 $Totals{'totalham'} += $Totals{$_} foreach (
3342 qw(totalbadheader totaloversized totalmta totalclean));
3343
3344 $Totals{'totalmsgs'} += $Totals{$_} foreach (
3345 qw(totalmalware totalbanned totalunchecked totalspam totalham totalother));
3346
3347 # Print the summary report if any key has non-zero data.
3348 # Note: must explicitely check for any non-zero data,
3349 # as Totals always has some keys extant.
3350 #
3351 if ($Opts{'summary'}) {
3352 for (keys %Totals) {
3353 if ($Totals{$_}) {
3354 print_summary_report (@Sections);
3355 last;
3356 }
3357 }
3358 }
3359
3360 # Print the detailed report, if detail is sufficiently high
3361 #
3362 if ($Opts{'detail'} >= 5) {
3363 print_detail_report (@Sections);
3364 printAutolearnReport;
3365 printSpamScorePercentilesReport;
3366 printSpamScoreFrequencyReport;
3367 printSARulesReport;
3368 printTimingsReport("Scan Timing Percentiles", \%Timings, \@TimingsTotals, $Opts{'timings'});
3369 printTimingsReport("SA Timing Percentiles", \%TimingsSA, \@TimingsSATotals, 0-$Opts{'sa_timings'});
3370 printStartupInfoReport if ($Opts{'detail'} >= 10);
3371 }
3372
3373 #{
3374 #use Data::Dumper;
3375 #print Dumper(\%p0ftags);
3376 #print Dumper($Counts{'p0f'});
3377 #}
3378
3379 # Finally, print any unmatched lines
3380 #
3381 print_unmatched_report();
3382
3383 # Evaluates a given line against the list of ignore patterns.
3384 #
3385 sub check_ignore_list($ \@) {
3386 my ($line, $listref) = @_;
3387
3388 foreach (@$listref) {
3389 return 1 if $line =~ /$_/;
3390 }
3391
3392 return 0;
3393 }
3394
3395
3396 # Spam score percentiles report
3397 #
3398 =pod
3399 ==================================================================================
3400 Spam Score Percentiles 0% 50% 90% 95% 98% 100%
3401 ----------------------------------------------------------------------------------
3402 Score Spam (100) 6.650 21.906 34.225 36.664 38.196 42.218
3403 Score Ham (1276) -17.979 -2.599 0.428 2.261 3.472 6.298
3404 ==================================================================================
3405 =cut
3406 sub printSpamScorePercentilesReport {
3407 return unless ($Opts{'score_percentiles'} and keys %SpamScores);
3408
3409 #printf "Scores $_ (%d): @{$SpamScores{$_}}\n", scalar @{$SpamScores{$_}} foreach keys %SpamScores;
3410 my (@p, @sorted);
3411 my @percents = split /[\s,]+/, $Opts{'score_percentiles'};
3412 my $myfw2 = $fw2 - 1;
3413
3414 print "\n", $sep1 x $fw1, $sep1 x $fw2 x @percents;
3415 printf "\n%-${fw1}s" . "%${myfw2}s%%" x @percents , "Spam Score Percentiles", @percents;
3416 print "\n", $sep2 x $fw1, $sep2 x $fw2 x @percents;
3417
3418 foreach my $ccat (keys %SpamScores) {
3419 @sorted = sort { $a <=> $b } @{$SpamScores{$ccat}};
3420 @p = get_percentiles (@sorted, @percents);
3421 printf "\n%-${fw1}s" . "%${fw2}.3f" x scalar (@p), "Score \u$ccat (" . scalar (@sorted) . ')', @p;
3422 }
3423
3424 print "\n", $sep1 x $fw1, $sep1 x $fw2 x @percents, "\n";
3425 }
3426
3427 # Spam score frequency report
3428 #
3429 =pod
3430 ======================================================================================================
3431 Spam Score Frequency <= -10 <= -5 <= 0 <= 5 <= 10 <= 20 <= 30 > 30
3432 ------------------------------------------------------------------------------------------------------
3433 Hits (1376) 29 168 921 170 29 33 1 25
3434 Percent of Hits 2.11% 12.21% 66.93% 12.35% 2.11% 2.40% 0.07% 1.82%
3435 ======================================================================================================
3436 =cut
3437 sub printSpamScoreFrequencyReport {
3438 return unless ($Opts{'score_frequencies'} and keys %SpamScores);
3439
3440 my @scores = ();
3441 push @scores, @{$SpamScores{$_}} foreach (keys %SpamScores);
3442 my $nscores = scalar @scores;
3443
3444 my @sorted = sort { $a <=> $b } @scores;
3445 my @buckets = sort { $a <=> $b } split /[\s,]+/, $Opts{'score_frequencies'};
3446 push @buckets, $buckets[-1] + 1;
3447 #print "Scores: @sorted\n";
3448
3449 my @p = get_frequencies (@sorted, @buckets);
3450
3451 my @ranges = ( 0 ) x @buckets;
3452 my $last = @buckets - 1;
3453 $ranges[0] = sprintf "%${fw2}s", " <= $buckets[0]";
3454 $ranges[-1] = sprintf "%${fw2}s", " > $buckets[-2]";
3455 for my $i (1 .. @buckets - 2) {
3456 $ranges[$i] = sprintf "%${fw2}s", " <= $buckets[$i]";
3457 }
3458
3459 print "\n", $sep1 x $fw1, $sep1 x $fw2 x @buckets;
3460 printf "\n%-${fw1}s" . "%-${fw2}s" x @buckets , "Spam Score Frequency", @ranges;
3461 print "\n", $sep2 x $fw1, $sep2 x $fw2 x @buckets;
3462 printf "\n%-${fw1}s" . "%${fw2}d" x scalar (@p), "Hits ($nscores)", @p;
3463 my $myfw2 = $fw2 - 1;
3464 printf "\n%-${fw1}s" . "%${myfw2}.2f%%" x scalar (@p), "Percent of Hits", map {($_ / $nscores) * 100.0; } @p;
3465 print "\n", $sep1 x $fw1, $sep1 x $fw2 x @buckets, "\n";
3466 }
3467
3468 # SpamAssassin rules report
3469 #
3470 =pod
3471 ===========================================================================
3472 SpamAssassin Rule Hits: Spam
3473 ---------------------------------------------------------------------------
3474 Rank Hits % Msgs % Spam % Ham Score Rule
3475 ---- ---- ------ ------ ----- ----- ----
3476 1 44 81.48% 93.62% 0.00% 1.961 URIBL_BLACK
3477 2 44 81.48% 93.62% 14.29% 0.001 HTML_MESSAGE
3478 3 42 77.78% 89.36% 0.00% 2.857 URIBL_JP_SURBL
3479 4 38 70.37% 80.85% 14.29% 2.896 RCVD_IN_XBL
3480 5 37 68.52% 78.72% 0.00% 2.188 RCVD_IN_BL_SPAMCOP_NET
3481 ...
3482 ===========================================================================
3483
3484 ===========================================================================
3485 SpamAssassin Rule Hits: Ham
3486 ---------------------------------------------------------------------------
3487 Rank Hits % Msgs % Spam % Ham Score Rule
3488 ---- ---- ------ ------ ----- ----- ----
3489 1 5 9.26% 2.13% 71.43% 0.001 STOX_REPLY_TYPE
3490 2 4 7.41% 0.00% 57.14% -0.001 SPF_PASS
3491 3 4 7.41% 6.38% 57.14% - AWL
3492 4 1 1.85% 0.00% 14.29% 0.303 TVD_RCVD_SINGLE
3493 5 1 1.85% 25.53% 14.29% 0.1 RDNS_DYNAMIC
3494 ...
3495 ===========================================================================
3496 =cut
3497 sub printSARulesReport {
3498 return unless (keys %{$Counts{'sarules'}});
3499
3500 our $maxlen = 0;
3501
3502 sub getSAHitsReport($ $) {
3503 my ($type, $topn) = @_;
3504 my $i = 1;
3505 my @report = ();
3506
3507 return if ($topn eq '0'); # topn can be numeric, or the string "all"
3508
3509 for (sort { $Counts{'sarules'}{$type}{$b} <=> $Counts{'sarules'}{$type}{$a} } keys %{$Counts{'sarules'}{$type}}) {
3510
3511 # only show top n lines; all when topn is "all"
3512 if ($topn ne 'all' and $i > $topn) {
3513 push @report, "...\n";
3514 last;
3515 }
3516 my $n = $Counts{'sarules'}{$type}{$_};
3517 my $nham = $Counts{'sarules'}{'Ham'}{$_};
3518 my $nspam = $Counts{'sarules'}{'Spam'}{$_};
3519 # rank, count, % msgs, % spam, % ham
3520 push @report, sprintf "%4d %8d %6.2f%% %6.2f%% %6.2f%% %s\n",
3521 $i++,
3522 $n,
3523 $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * $n / $Totals{'totalmsgs'},
3524 $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspam / $Totals{'totalspam'},
3525 $Totals{'totalham'} == 0 ? 0 : 100.0 * $nham / $Totals{'totalham'},
3526 $_;
3527 my $len = length($report[-1]) - 1;
3528 $maxlen = $len if ($len > $maxlen);
3529 }
3530
3531 if (scalar @report) {
3532 print "\n", $sep1 x $maxlen, "\n";
3533 print "SpamAssassin Rule Hits: $type\n";
3534 print $sep2 x $maxlen, "\n";
3535 print "Rank Hits % Msgs % Spam % Ham Score Rule\n";
3536 print "---- ---- ------ ------ ----- ----- ----\n";
3537 print @report;
3538 print $sep1 x $maxlen, "\n";
3539 }
3540 }
3541
3542 my ($def_limit_spam, $def_limit_ham) = split /[\s,]+/, $Defaults{'sarules'};
3543 my ($limit_spam, $limit_ham) = split /[\s,]+/, $Opts{'sarules'};
3544 $limit_spam = $def_limit_spam if $limit_spam eq '';
3545 $limit_ham = $def_limit_ham if $limit_ham eq '';
3546
3547 getSAHitsReport('Spam', $limit_spam);
3548 getSAHitsReport('Ham', $limit_ham);
3549 }
3550
3551 # Autolearn report, only available if enabled in amavis $log_templ template
3552 #
3553 =pod
3554 ======================================================================
3555 Autolearn Msgs Spam Ham % Msgs % Spam % Ham
3556 ----------------------------------------------------------------------
3557 Spam 36 36 0 66.67% 76.60% 0.00%
3558 Ham 2 0 2 3.70% 0.00% 28.57%
3559 No 7 4 3 12.96% 8.51% 42.86%
3560 Disabled 6 6 0 11.11% 12.77% 0.00%
3561 Failed 2 1 1 3.70% 2.13% 14.29%
3562 ----------------------------------------------------------------------
3563 Totals 53 47 6 98.15% 100.00% 85.71%
3564 ======================================================================
3565 =cut
3566 sub printAutolearnReport {
3567 #print "printAutolearnReport:\n" if ($Opts{'debug'});
3568 return unless (keys %{$Counts{'autolearn'}});
3569
3570 our $maxlen = 0;
3571 our ($nhamtotal, $nspamtotal);
3572
3573 sub getAutolearnReport($) {
3574 my ($type) = @_;
3575 my @report = ();
3576
3577 # SA 2.5/2.6 : ham/spam/no
3578 # SA 3.0+ : ham/spam/no/disabled/failed/unavailable
3579 for (qw(spam ham no disabled failed unavailable)) {
3580
3581 next unless (exists $Counts{'autolearn'}{'Spam'}{$_} or exists $Counts{'autolearn'}{'Ham'}{$_});
3582 #print "printAutolearnReport: type: $_\n" if ($Opts{'debug'});
3583
3584 my $nham = exists $Counts{'autolearn'}{'Ham'}{$_} ? $Counts{'autolearn'}{'Ham'}{$_} : 0;
3585 my $nspam = exists $Counts{'autolearn'}{'Spam'}{$_} ? $Counts{'autolearn'}{'Spam'}{$_} : 0;
3586 my $nboth = $nham + $nspam;
3587 $nhamtotal += $nham; $nspamtotal += $nspam;
3588 # type, nspam, nham, % msgs, % spam, % ham
3589 push @report, sprintf "%-13s %9d %9d %9d %6.2f%% %6.2f%% %6.2f%%\n",
3590 ucfirst $_,
3591 $nspam + $nham,
3592 $nspam,
3593 $nham,
3594 $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * $nboth / $Totals{'totalmsgs'},
3595 $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspam / $Totals{'totalspam'},
3596 $Totals{'totalham'} == 0 ? 0 : 100.0 * $nham / $Totals{'totalham'};
3597
3598 my $len = length($report[-1]) - 1;
3599 $maxlen = $len if ($len > $maxlen);
3600 }
3601 return @report;
3602 }
3603
3604 my @report_spam = getAutolearnReport('Spam');
3605
3606 if (scalar @report_spam) {
3607 print "\n", $sep1 x $maxlen, "\n";
3608 print "Autolearn Msgs Spam Ham % Msgs % Spam % Ham\n";
3609 print $sep2 x $maxlen, "\n";
3610 print @report_spam;
3611 print $sep2 x $maxlen, "\n";
3612
3613 printf "%-13s %9d %9d %9d %6.2f%% %6.2f%% %6.2f%%\n",
3614 'Totals',
3615 $nspamtotal + $nhamtotal,
3616 $nspamtotal,
3617 $nhamtotal,
3618 $Totals{'totalmsgs'} == 0 ? 0 : 100.0 * ($nspamtotal + $nhamtotal) / $Totals{'totalmsgs'},
3619 $Totals{'totalspam'} == 0 ? 0 : 100.0 * $nspamtotal / $Totals{'totalspam'},
3620 $Totals{'totalham'} == 0 ? 0 : 100.0 * $nhamtotal / $Totals{'totalham'};
3621 print $sep1 x $maxlen, "\n";
3622 }
3623 }
3624
3625
3626 # Timings percentiles report, used for amavis message scanning and spamassassin timings
3627 =pod
3628 ========================================================================================================================
3629 Scan Timing Percentiles % Time Total (ms) 0% 5% 25% 50% 75% 95% 100%
3630 ------------------------------------------------------------------------------------------------------------------------
3631 AV-scan-2 (3) 69.23% 7209.00 2392.00 2393.50 2399.50 2407.00 2408.50 2409.70 2410.00
3632 SA check (2) 19.74% 2056.00 942.00 950.60 985.00 1028.00 1071.00 1105.40 1114.00
3633 SMTP DATA (3) 5.49% 572.00 189.00 189.20 190.00 191.00 191.50 191.90 192.00
3634 AV-scan-1 (3) 0.82% 85.00 11.00 12.60 19.00 27.00 37.00 45.00 47.00
3635 ...
3636 ------------------------------------------------------------------------------------------------------------------------
3637 Total 10413.00 2771.00 2867.10 3251.50 3732.00 3821.00 3892.20 3910.00
3638 ========================================================================================================================
3639
3640 ========================================================================================================================
3641 SA Timing Percentiles % Time Total (ms) 0% 5% 25% 50% 75% 95% 100%
3642 ------------------------------------------------------------------------------------------------------------------------
3643 tests_pri_0 (1) 97.17% 5323.00 5323.00 5323.00 5323.00 5323.00 5323.00 5323.00 5323.00
3644 check_razor2 (1) 91.68% 5022.00 5022.00 5022.00 5022.00 5022.00 5022.00 5022.00 5022.00
3645 check_dcc (1) 3.50% 192.00 192.00 192.00 192.00 192.00 192.00 192.00 192.00
3646 learn (1) 0.66% 36.00 36.00 36.00 36.00 36.00 36.00 36.00 36.00
3647 tests_pri_-1000 (1) 0.46% 25.00 25.00 25.00 25.00 25.00 25.00 25.00 25.00
3648 ...
3649 ------------------------------------------------------------------------------------------------------------------------
3650 Total 5478.00 5478.00 5478.00 5478.00 5478.00 5478.00 5478.00 5478.00
3651 ========================================================================================================================
3652 =cut
3653 sub printTimingsReport($$$$) {
3654 my ($title, $timingsref, $totalsref, $cutoff) = @_;
3655 my @tkeys = keys %$timingsref;
3656 return unless scalar @tkeys;
3657
3658 my (@p, @sorted, %perkey_totals, @col_subtotals);
3659 my ($pcnt,$max_pcnt,$max_rows,$time_total_actual,$time_total_hypo,$subtotal_pcnt);
3660 my @percents = split /[\s,]+/, $Opts{'timings_percentiles'};
3661 my $header_footer = $sep1 x 50 . ($sep1 x 10) x @percents;
3662 my $header_end = $sep2 x 50 . ($sep2 x 10) x @percents;
3663 my $title_width = '-28';
3664
3665 print "\n$header_footer\n";
3666 printf "%${title_width}s %6s %13s" ." %8s%%" x @percents , $title, "% Time", "Total (ms)", @percents;
3667 print "\n$header_end\n";
3668
3669 # Sum the total time for each timing key
3670 foreach my $key (@tkeys) {
3671 foreach my $timeval (@{$$timingsref{$key}}) {
3672 $perkey_totals{$key} += $timeval;
3673 }
3674 }
3675
3676 # Sum total time spent scanning
3677 map {$time_total_actual += $_} @$totalsref;
3678
3679 # cutoff value used to limit the number of rows of output
3680 # positive cutoff is a percentage of cummulative time
3681 # negative cutoff limits number of rows
3682 if ($cutoff >= 0) {
3683 $max_pcnt = $cutoff != 100 ? $cutoff : 150; # 150% avoids roundoff errors
3684 }
3685 else {
3686 $max_rows = -$cutoff;
3687 }
3688 my $rows = 0;
3689 # sort each timing key's values, required to compute the list of percentiles
3690 for (sort { $perkey_totals{$b} <=> $perkey_totals{$a} } @tkeys) {
3691 last if (($max_rows and $rows >= $max_rows) or ($max_pcnt and $subtotal_pcnt >= $max_pcnt));
3692
3693 $pcnt = ($perkey_totals{$_} / $time_total_actual) * 100,
3694 @sorted = sort { $a <=> $b } @{$$timingsref{$_}};
3695 @p = get_percentiles (@sorted, @percents);
3696
3697 $subtotal_pcnt += $pcnt;
3698 printf "%${title_width}s %6.2f%% %13.2f" . " %9.2f" x scalar (@p) . "\n",
3699 $_ . ' (' . scalar(@{$$timingsref{$_}}) . ')', # key ( number of elements )
3700 $pcnt, # percent of total time
3701 #$perkey_totals{$_} / 1000, # total time for this test
3702 $perkey_totals{$_}, # total time for this test
3703 #map {$_ / 1000} @p; # list of percentiles
3704 @p; # list of percentiles
3705 $rows++;
3706 }
3707 print "...\n" if ($rows != scalar @tkeys);
3708
3709 print "$header_end\n";
3710 # actual total time as reported by amavis
3711 @sorted = sort { $a <=> $b } @$totalsref;
3712 @p = get_percentiles (@sorted, @percents);
3713 printf "%${title_width}s %13.2f" . " %9.2f" x scalar (@p) . "\n",
3714 'Total',
3715 #$time_total_actual / 1000,
3716 $time_total_actual,
3717 #map {$_ / 1000} @p;
3718 @p;
3719
3720 print "$header_footer\n";
3721 }
3722
3723 # Most recent startup info report
3724 #
3725 sub printStartupInfoReport {
3726
3727 return unless (keys %StartInfo);
3728
3729 sub print2col($ $) {
3730 my ($label,$val) = @_;
3731 printf "%-50s %s\n", $label, $val;
3732 }
3733
3734 print "\nAmavis Startup\n";
3735
3736 print2col (" Amavis", $StartInfo{'ampath'}) if (exists $StartInfo{'ampath'});
3737 print2col (" Version", $StartInfo{'amversion'}) if (exists $StartInfo{'amversion'});
3738 print2col (" PID", $StartInfo{'Server'}{'pid'}) if (exists $StartInfo{'Server'}{'pid'});
3739 print2col (" Socket", $StartInfo{'Server'}{'socket'}) if (exists $StartInfo{'Server'}{'socket'});
3740 print2col (" TCP port", $StartInfo{'Server'}{'ip'}) if (exists $StartInfo{'Server'}{'ip'});
3741 print2col (" UID", $StartInfo{'Server'}{'uid'}) if (exists $StartInfo{'Server'}{'uid'});
3742 print2col (" GID", $StartInfo{'Server'}{'gid'}) if (exists $StartInfo{'Server'}{'gid'});
3743 print2col (" Logging", $StartInfo{'Logging'}) if (exists $StartInfo{'Logging'});
3744 print2col (" Configuration Files", $StartInfo{'Configs'}) if (exists $StartInfo{'Configs'});
3745 print2col (" SpamAssassin", $StartInfo{'sa_version'}) if (exists $StartInfo{'sa_version'});
3746 print2col (" SpamAssassin Debug Facilities", $StartInfo{'sa_debug'}) if (exists $StartInfo{'sa_debug'});
3747 print2col (" Database", $StartInfo{'db'}) if (exists $StartInfo{'db'});
3748 #if (keys %{$StartInfo{'IDs'}}) {
3749 # print " Process startup user/group:\n";
3750 # print " User: $StartInfo{'IDs'}{'user'}, EUID: $StartInfo{'IDs'}{'euid'}, UID: $StartInfo{'IDs'}{'uid'}\n";
3751 # print " Group: $StartInfo{'IDs'}{'group'}, EGID: $StartInfo{'IDs'}{'egid'}, GID: $StartInfo{'IDs'}{'gid'}\n";
3752 #}
3753
3754 sub print_modules ($ $) {
3755 my ($key, $label) = @_;
3756 print " $label\n";
3757 foreach (sort keys %{$StartInfo{$key}}) {
3758 print " $_\n";
3759 foreach my $module (sort keys %{$StartInfo{$key}{$_}}) {
3760 if ($StartInfo{$key}{$_}{$module}) {
3761 print2col (" " . $module, $StartInfo{$key}{$_}{$module});
3762 }
3763 else {
3764 print2col (" " . $module, "");
3765 }
3766 }
3767 }
3768 };
3769 print_modules('AVScanner', 'Antivirus scanners');
3770 print_modules('Code', 'Code, modules and external programs');
3771 print_modules('Decoders', 'Decoders');
3772 print_modules('SAPlugins', 'SpamAssassin plugins');
3773 }
3774
3775 # Initialize the Getopts option list. Requires the Section table to
3776 # be built already.
3777 #
3778 sub init_getopts_table() {
3779 print "init_getopts_table: enter\n" if $Opts{'debug'} & D_ARGS;
3780
3781 init_getopts_table_common(@supplemental_reports);
3782
3783 add_option ('first_recip_only!');
3784 add_option ('show_first_recip_only=i', sub { $Opts{'first_recip_only'} = $_[1]; 1;});
3785 add_option ('startinfo!');
3786 add_option ('show_startinfo=i', sub { $Opts{'startinfo'} = $_[1]; 1; });
3787 add_option ('by_ccat_summary!');
3788 add_option ('show_by_ccat_summary=i', sub { $Opts{'by_ccat_summary'} = $_[1]; 1; });
3789 add_option ('noscore_percentiles', \&triway_opts);
3790 add_option ('score_percentiles=s', \&triway_opts);
3791 add_option ('noscore_frequencies', \&triway_opts);
3792 add_option ('score_frequencies=s', \&triway_opts);
3793 add_option ('nosa_timings', sub { $Opts{'sa_timings'} = 0; 1; });
3794 add_option ('sa_timings=i');
3795 add_option ('sa_timings_percentiles=s');
3796 add_option ('notimings', sub { $Opts{'timings'} = 0; 1; });
3797 add_option ('timings=i');
3798 add_option ('timings_percentiles=s');
3799 add_option ('nosarules', \&triway_opts);
3800 add_option ('sarules=s', \&triway_opts);
3801 #add_option ('nop0f', \&triway_opts);
3802 #add_option ('p0f=s', \&triway_opts);
3803 add_option ('autolearn!');
3804 add_option ('show_autolearn=i', sub { $Opts{'autolearn'} = $_[1]; 1; });
3805 }
3806
3807 # Builds the entire @Section table used for data collection
3808 #
3809 # Each Section entry has as many as six fields:
3810 #
3811 # 1. Section array reference
3812 # 2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
3813 # 3. Output in Detail report? (must also a %Counts accumulator)
3814 # 4. Numeric output format specifier for Summary report
3815 # 5. Section title for Summary and Detail reports
3816 # 6. A hash to a divisor used to calculate the percentage of a total for that key
3817 #
3818 # Use begin_section_group/end_section_group to create groupings around sections.
3819 #
3820 # Sections can be freely reordered if desired, but maintain proper group nesting.
3821 #
3822 sub build_sect_table() {
3823 print "build_sect_table: enter\n" if $Opts{'debug'} & D_SECT;
3824 my $S = \@Sections;
3825
3826 # References to these are used in the Sections table below; we'll predeclare them.
3827 $Totals{'totalmsgs'} = 0;
3828
3829 # Place configuration and critical errors first
3830
3831 # SECTIONREF, NAME, DETAIL, FMT, TITLE, DIVISOR
3832 begin_section_group ($S, 'warnings');
3833 add_section ($S, 'fatal', 1, 'd', '*Fatal');
3834 add_section ($S, 'panic', 1, 'd', '*Panic');
3835 add_section ($S, 'warningsecurity', 1, 'd', '*Warning: Security risk');
3836 add_section ($S, 'avtimeout', 1, 'd', '*Warning: Virus scanner timeout');
3837 add_section ($S, 'avconnectfailure', 1, 'd', '*Warning: Virus scanner connection failure');
3838 add_section ($S, 'warningsmtpshutdown', 1, 'd', '*Warning: SMTP shutdown');
3839 add_section ($S, 'warningsql', 1, 'd', '*Warning: SQL problem');
3840 add_section ($S, 'warningaddressmodified', 1, 'd', '*Warning: Email address modified');
3841 add_section ($S, 'warningnoquarantineid', 1, 'd', '*Warning: Message missing X-Quarantine-ID header');
3842 add_section ($S, 'warning', 1, 'd', 'Miscellaneous warnings');
3843 end_section_group ($S, 'warnings');
3844
3845 begin_section_group ($S, 'scanned', "\n");
3846 add_section ($S, 'totalmsgs', 0, 'd', [ 'Total messages scanned', '-' ], \$Totals{'totalmsgs'});
3847 add_section ($S, 'bytesscanned', 0, 'Z', 'Total bytes scanned'); # Z means print scaled as in 1k, 1m, etc.
3848 end_section_group ($S, 'scanned', $sep1);
3849
3850 # Blocked / Passed
3851 # Priority: VIRUS BANNED UNCHECKED SPAM SPAMMY BADH OVERSIZED MTA CLEAN
3852 begin_section_group ($S, 'passblock', "\n");
3853 begin_section_group ($S, 'blocked', "\n");
3854 add_section ($S, 'totalblocked', 0, 'd', [ 'Blocked', '-' ], \$Totals{'totalmsgs'});
3855 add_section ($S, 'malwareblocked', 1, 'd', ' Malware blocked', \$Totals{'totalmsgs'});
3856 add_section ($S, 'bannednameblocked', 1, 'd', ' Banned name blocked', \$Totals{'totalmsgs'});
3857 add_section ($S, 'uncheckedblocked', 1, 'd', ' Unchecked blocked', \$Totals{'totalmsgs'});
3858 add_section ($S, 'spamblocked', 1, 'd', ' Spam blocked', \$Totals{'totalmsgs'});
3859 add_section ($S, 'spamdiscarded', 0, 'd', ' Spam discarded (no quarantine)', \$Totals{'totalmsgs'});
3860 add_section ($S, 'spammyblocked', 1, 'd', ' Spammy blocked', \$Totals{'totalmsgs'});
3861 add_section ($S, 'badheaderblocked', 1, 'd', ' Bad header blocked', \$Totals{'totalmsgs'});
3862 add_section ($S, 'oversizedblocked', 1, 'd', ' Oversized blocked', \$Totals{'totalmsgs'});
3863 add_section ($S, 'mtablocked', 1, 'd', ' MTA blocked', \$Totals{'totalmsgs'});
3864 add_section ($S, 'cleanblocked', 1, 'd', ' Clean blocked', \$Totals{'totalmsgs'});
3865 add_section ($S, 'tempfailblocked', 1, 'd', ' Tempfail blocked', \$Totals{'totalmsgs'});
3866 add_section ($S, 'otherblocked', 1, 'd', ' Other blocked', \$Totals{'totalmsgs'});
3867 end_section_group ($S, 'blocked');
3868
3869 begin_section_group ($S, 'passed', "\n");
3870 add_section ($S, 'totalpassed', 0, 'd', [ 'Passed', '-' ], \$Totals{'totalmsgs'});
3871 add_section ($S, 'malwarepassed', 1, 'd', ' Malware passed', \$Totals{'totalmsgs'});
3872 add_section ($S, 'bannednamepassed', 1, 'd', ' Banned name passed', \$Totals{'totalmsgs'});
3873 add_section ($S, 'uncheckedpassed', 1, 'd', ' Unchecked passed', \$Totals{'totalmsgs'});
3874 add_section ($S, 'spampassed', 1, 'd', ' Spam passed', \$Totals{'totalmsgs'});
3875 add_section ($S, 'spammypassed', 1, 'd', ' Spammy passed', \$Totals{'totalmsgs'});
3876 add_section ($S, 'badheaderpassed', 1, 'd', ' Bad header passed', \$Totals{'totalmsgs'});
3877 add_section ($S, 'oversizedpassed', 1, 'd', ' Oversized passed', \$Totals{'totalmsgs'});
3878 add_section ($S, 'mtapassed', 1, 'd', ' MTA passed', \$Totals{'totalmsgs'});
3879 add_section ($S, 'cleanpassed', 1, 'd', ' Clean passed', \$Totals{'totalmsgs'});
3880 add_section ($S, 'tempfailpassed', 1, 'd', ' Tempfail passed', \$Totals{'totalmsgs'});
3881 add_section ($S, 'otherpassed', 1, 'd', ' Other passed', \$Totals{'totalmsgs'});
3882 end_section_group ($S, 'passed');
3883 end_section_group ($S, 'passblock', $sep1);
3884
3885 if ($Opts{'by_ccat_summary'}) {
3886 # begin level 1 group
3887 begin_section_group ($S, 'by_ccat', "\n");
3888
3889 # begin level 2 groupings
3890 begin_section_group ($S, 'malware', "\n"); # level 2
3891 add_section ($S, 'totalmalware', 0, 'd', [ 'Malware', '-' ], \$Totals{'totalmsgs'});
3892 add_section ($S, 'malwarepassed', 0, 'd', ' Malware passed', \$Totals{'totalmsgs'});
3893 add_section ($S, 'malwareblocked', 0, 'd', ' Malware blocked', \$Totals{'totalmsgs'});
3894 end_section_group ($S, 'malware');
3895
3896 begin_section_group ($S, 'banned', "\n");
3897 add_section ($S, 'totalbanned', 0, 'd', [ 'Banned', '-' ], \$Totals{'totalmsgs'});
3898 add_section ($S, 'bannednamepassed', 0, 'd', ' Banned file passed', \$Totals{'totalmsgs'});
3899 add_section ($S, 'bannednameblocked', 0, 'd', ' Banned file blocked', \$Totals{'totalmsgs'});
3900 end_section_group ($S, 'banned');
3901
3902 begin_section_group ($S, 'unchecked', "\n");
3903 add_section ($S, 'totalunchecked', 0, 'd', [ 'Unchecked', '-' ], \$Totals{'totalmsgs'});
3904 add_section ($S, 'uncheckedpassed', 0, 'd', ' Unchecked passed', \$Totals{'totalmsgs'});
3905 add_section ($S, 'uncheckedblocked', 0, 'd', ' Unchecked blocked', \$Totals{'totalmsgs'});
3906 end_section_group ($S, 'unchecked');
3907
3908 begin_section_group ($S, 'spam', "\n");
3909 add_section ($S, 'totalspam', 0, 'd', [ 'Spam', '-' ], \$Totals{'totalmsgs'});
3910 add_section ($S, 'spammypassed', 0, 'd', ' Spammy passed', \$Totals{'totalmsgs'});
3911 add_section ($S, 'spammyblocked', 0, 'd', ' Spammy blocked', \$Totals{'totalmsgs'});
3912 add_section ($S, 'spampassed', 0, 'd', ' Spam passed', \$Totals{'totalmsgs'});
3913 add_section ($S, 'spamblocked', 0, 'd', ' Spam blocked', \$Totals{'totalmsgs'});
3914 add_section ($S, 'spamdiscarded', 0, 'd', ' Spam discarded (no quarantine)', \$Totals{'totalmsgs'});
3915 end_section_group ($S, 'spam');
3916
3917 begin_section_group ($S, 'ham', "\n");
3918 add_section ($S, 'totalham', 0, 'd', [ 'Ham', '-' ], \$Totals{'totalmsgs'});
3919 add_section ($S, 'badheaderpassed', 0, 'd', ' Bad header passed', \$Totals{'totalmsgs'});
3920 add_section ($S, 'badheaderblocked', 0, 'd', ' Bad header blocked', \$Totals{'totalmsgs'});
3921 add_section ($S, 'oversizedpassed', 0, 'd', ' Oversized passed', \$Totals{'totalmsgs'});
3922 add_section ($S, 'oversizedblocked', 0, 'd', ' Oversized blocked', \$Totals{'totalmsgs'});
3923 add_section ($S, 'mtapassed', 0, 'd', ' MTA passed', \$Totals{'totalmsgs'});
3924 add_section ($S, 'mtablocked', 0, 'd', ' MTA blocked', \$Totals{'totalmsgs'});
3925 add_section ($S, 'cleanpassed', 0, 'd', ' Clean passed', \$Totals{'totalmsgs'});
3926 add_section ($S, 'cleanblocked', 0, 'd', ' Clean blocked', \$Totals{'totalmsgs'});
3927 end_section_group ($S, 'ham');
3928
3929 begin_section_group ($S, 'other', "\n");
3930 add_section ($S, 'totalother', 0, 'd', [ 'Other', '-' ], \$Totals{'totalmsgs'});
3931 add_section ($S, 'tempfailpassed', 0, 'd', ' Tempfail passed', \$Totals{'totalmsgs'});
3932 add_section ($S, 'tempfailblocked', 0, 'd', ' Tempfail blocked', \$Totals{'totalmsgs'});
3933 add_section ($S, 'otherpassed', 0, 'd', ' Other passed', \$Totals{'totalmsgs'});
3934 add_section ($S, 'otherblocked', 0, 'd', ' Other blocked', \$Totals{'totalmsgs'});
3935 end_section_group ($S, 'other');
3936 # end level 2 groupings
3937
3938 # end level 1 group
3939 end_section_group ($S, 'by_ccat', $sep1);
3940 }
3941
3942 begin_section_group ($S, 'misc', "\n");
3943 add_section ($S, 'virusscanskipped', 1, 'd', 'Virus scan skipped');
3944 add_section ($S, 'sabypassed', 0, 'd', 'SpamAssassin bypassed');
3945 add_section ($S, 'satimeout', 0, 'd', 'SpamAssassin timeout');
3946 add_section ($S, 'released', 1, 'd', 'Released from quarantine');
3947 add_section ($S, 'defanged', 1, 'd', 'Defanged');
3948 add_section ($S, 'truncatedheader', 0, 'd', 'Truncated headers > 998 characters');
3949 add_section ($S, 'truncatedmsg', 0, 'd', 'Truncated message passed to SpamAssassin');
3950 add_section ($S, 'tagged', 0, 'd', 'Spam tagged');
3951 add_section ($S, 'smtpresponse', 1, 'd', 'SMTP response');
3952 add_section ($S, 'badaddress', 1, 'd', 'Bad address syntax');
3953 add_section ($S, 'fakesender', 1, 'd', 'Fake sender');
3954 add_section ($S, 'archiveextract', 1, 'd', 'Archive extraction problem');
3955 add_section ($S, 'dsnsuppressed', 1, 'd', 'DSN suppressed');
3956 add_section ($S, 'dsnnotification', 1, 'd', 'DSN notification (debug supplemental)');
3957 add_section ($S, 'bouncekilled', 1, 'd', 'Bounce killed');
3958 add_section ($S, 'bouncerescued', 1, 'd', 'Bounce rescued');
3959 add_section ($S, 'bounceunverifiable', 1, 'd', 'Bounce unverifiable');
3960 add_section ($S, 'nosubject', 0, 'd', 'Subject header inserted');
3961 add_section ($S, 'whitelisted', 1, 'd', 'Whitelisted');
3962 add_section ($S, 'blacklisted', 1, 'd', 'Blacklisted');
3963 add_section ($S, 'penpalsaved', 1, 'd', 'Penpals saved from kill');
3964 add_section ($S, 'tmppreserved', 1, 'd', 'Preserved temporary directory');
3965 add_section ($S, 'dccerror', 1, 'd', 'DCC error');
3966 add_section ($S, 'mimeerror', 1, 'd', 'MIME error');
3967 add_section ($S, 'defangerror', 1, 'd', 'Defang error');
3968 add_section ($S, 'badheadersupp', 1, 'd', 'Bad header (debug supplemental)');
3969 add_section ($S, 'fileoutputskipped', 0, 'd', 'File(1) output skipped');
3970 add_section ($S, 'localdeliveryskipped', 1, 'd', 'Local delivery skipped');
3971 add_section ($S, 'extramodules', 1, 'd', 'Extra code modules loaded at runtime');
3972 add_section ($S, 'malwarebyscanner', 1, 'd', 'Malware by scanner');
3973 add_section ($S, 'malwaretospam', 1, 'd', 'Malware to spam conversion');
3974 add_section ($S, 'contenttype', 1, 'd', 'Content types');
3975 add_section ($S, 'bayes', 1, 'd', 'Bayes probability');
3976 add_section ($S, 'p0f', 1, 'd', 'p0f fingerprint');
3977 add_section ($S, 'sadiags', 1, 'd', 'SpamAssassin diagnostics');
3978 end_section_group ($S, 'misc');
3979
3980 print "build_sect_table: exit\n" if $Opts{'debug'} & D_SECT;
3981 }
3982
3983 # XXX create array of defaults for detail <5, 5-9, >10
3984 sub init_defaults() {
3985 map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
3986 if (! $Opts{'standalone'}) {
3987 # LOGWATCH these take affect if no env present (eg. nothing in conf file)
3988 # 0 to 4 nostartinfo, notimings, nosarules, score_frequencies=0, score_percentiles=0, noautolearn
3989 # 5 to 9 nostartinfo, timings=95, sarules = 20 20, score_frequencies=defaults, score_percentiles=defaults, autolearn
3990 # 10 + startinfo, timings=100, sarules = all all score_frequencies=defaults, score_percentiles=defaults, autolearn
3991
3992 if ($Opts{'detail'} < 5) { # detail 0 to 4, disable all supplimental reports
3993 $Opts{'autolearn'} = 0;
3994 #$Opts{'p0f'} = 0;
3995 $Opts{'timings'} = 0;
3996 $Opts{'sa_timings'} = 0;
3997 $Opts{'sarules'} = 0;
3998 $Opts{'startinfo'} = 0;
3999 $Opts{'score_frequencies'} = '';
4000 $Opts{'score_percentiles'} = '';
4001 }
4002 elsif ($Opts{'detail'} < 10) { # detail 5 to 9, disable startinfo report
4003 $Opts{'startinfo'} = 0;
4004 }
4005 else { # detail 10 and up, full reports
4006 #$Opts{'p0f'} = 'all all';
4007 $Opts{'timings'} = 100;
4008 $Opts{'sa_timings'} = 100;
4009 $Opts{'sarules'} = 'all all';
4010 }
4011 }
4012 }
4013
4014 # Return a usage string, built from:
4015 # arg1 +
4016 # $usage_str +
4017 # a string built from each usable entry in the @Sections table.
4018 #
4019 sub usage($) {
4020 my $ret = "";
4021 $ret = "@_\n" if ($_[0]);
4022 $ret .= $usage_str;
4023 my ($name, $desc);
4024 foreach my $sect (get_usable_sectvars(@Sections, 0)) {
4025 $name = lc $sect->{NAME};
4026 $desc = $sect->{TITLE};
4027 $ret .= sprintf " --%-38s%s\n", "$name" . ' LEVEL', "$desc";
4028 }
4029 $ret .= "\n";
4030 return $ret;
4031 }
4032
4033 sub strip_trace($) {
4034 # at (eval 37) line 306, <GEN6> line 4.
4035 # at /usr/sbin/amavisd-maia line 2895, <GEN4> line 22.
4036 #$_[0] =~ s/ at \(.+\) line \d+(?:, \<GEN\d+\> line \d+)?\.$//;
4037 #$_[0] =~ s/ at (\S+) line \d+(?:, \<GEN\d+\> line \d+)?\.$/: $1/;
4038 while ($_[0] =~ s/ at (?:\(eval \d+\)|\S+) line \d+(?:, \<GEN\d+\> line \d+)?\.//) {
4039 ;
4040 }
4041 #print "strip_trace: \"$_[0]\"\n";
4042 return $_[0];
4043 }
4044
4045 # Getopt helper, sets an option in Opts hash to one of three
4046 # values: its default, the specified value, or 0 if the option
4047 # was the "no" prefixed variant.
4048 #
4049 sub triway_opts ($ $) {
4050 my ($opt,$val) = @_;
4051
4052 print "triway_opts: OPT: $opt, VAL: $val\n" if $Opts{'debug'} & D_ARGS;
4053 die "Option \"--${opt}\" requires an argument" if ($val =~ /^--/);
4054
4055 if ($opt =~ s/^no//i) {
4056 $Opts{$opt} = 0;
4057 } elsif ('default' =~ /^${val}$/i) {
4058 $Opts{$opt} = $Defaults{$opt};
4059 }
4060 else {
4061 $Opts{$opt} = $val;
4062 }
4063 }
4064
4065 exit(0);
4066
4067 # vi: shiftwidth=3 tabstop=3 syntax=perl et