Subversion Repositories configs

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
4 - 1
#!/usr/bin/perl
2
 
3
##########################################################################
4
# Postfix-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 postfix logwatch filter was written by
37
# Kenneth Porter, and has had many contributors over the years.
38
#
39
# CVS log removed: see Changes file for postfix-logwatch at
40
#    http://logreporters.sourceforge.net/
41
# or included with the standalone postfix-logwatch distribution
42
##########################################################################
43
 
44
##########################################################################
45
#
46
# Test data included via inline comments starting with "#TD"
47
#
48
 
49
#use Devel::Size qw(size total_size);
50
 
51
package Logreporters;
52
use 5.008;
53
use strict;
54
use warnings;
55
no warnings "uninitialized";
56
use re 'taint';
57
 
58
our $Version          = '1.40.00';
59
our $progname_prefix  = 'postfix';
60
 
61
# Specifies the default configuration file for use in standalone mode.
62
my $config_file = "/usr/local/etc/${progname_prefix}-logwatch.conf";
63
 
64
# support postfix long (2.9+) or short queue ids
65
my $re_QID_s   = qr/[A-Z\d]+/;
66
my $re_QID_l   = qr/(?:NOQUEUE|[bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ\d]+)/;
67
our $re_QID;
68
 
69
our $re_DSN     = qr/(?:(?:\d{3})?(?: ?\d\.\d\.\d)?)/;
70
our $re_DDD     = qr/(?:(?:conn_use=\d+ )?delay=-?[\d.]+(?:, delays=[\d\/.]+)?(?:, dsn=[\d.]+)?)/;
71
 
72
#MODULE: ../Logreporters/Utils.pm
73
package Logreporters::Utils;
74
 
75
use 5.008;
76
use strict;
77
use re 'taint';
78
use warnings;
79
 
80
BEGIN {
81
   use Exporter ();
82
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
83
   $VERSION = '1.003';
84
   @ISA = qw(Exporter);
85
   @EXPORT = qw(&formathost &get_percentiles &get_percentiles2 &get_frequencies &commify &unitize
86
                &get_usable_sectvars &add_section &begin_section_group &end_section_group
87
                &get_version &unique_list);
88
   @EXPORT_OK = qw(&gen_test_log);
89
}
90
 
91
use subs qw (@EXPORT @EXPORT_OK);
92
 
93
 
94
# Formats IP and hostname for even column spacing
95
#
96
sub formathost($ $) {
97
   # $_[0] : hostip
98
   # $_[1] : hostname;
99
 
100
   if (! $Logreporters::Config::Opts{'unknown'} and $_[1] eq 'unknown') {
101
      return $_[0];
102
   }
103
 
104
   return sprintf "%-$Logreporters::Config::Opts{'ipaddr_width'}s  %s",
105
      $_[0] eq '' ? '*unknown' :    $_[0],
106
      $_[1] eq '' ? '*unknown' : lc $_[1];
107
}
108
 
109
# Add a new section to the end of a section table
110
#
111
sub add_section($$$$$;$) {
112
   my $sref = shift;
113
   die "Improperly specified Section entry: $_[0]" if !defined $_[3];
114
 
115
   my $entry  = {
116
      CLASS     => 'DATA',
117
      NAME      => $_[0],
118
      DETAIL    => $_[1],
119
      FMT       => $_[2],
120
      TITLE     => $_[3],
121
   };
122
   $entry->{'DIVISOR'}   = $_[4] if defined $_[4];
123
   push @$sref, $entry;
124
}
125
 
126
{
127
my $group_level = 0;
128
 
129
# Begin a new section group.  Groups can nest.
130
#
131
sub begin_section_group($;@) {
132
   my $sref = shift;
133
   my $group_name = shift;
134
   my $entry  = {
135
      CLASS     => 'GROUP_BEGIN',
136
      NAME      => $group_name,
137
      LEVEL     => ++$group_level,
138
      HEADERS   => [ @_ ],
139
   };
140
   push @$sref, $entry;
141
}
142
 
143
# Ends a section group.
144
#
145
sub end_section_group($;@) {
146
   my $sref = shift;
147
   my $group_name = shift;
148
   my $entry  = {
149
      CLASS     => 'GROUP_END',
150
      NAME      => $group_name,
151
      LEVEL     => --$group_level,
152
      FOOTERS   => [ @_ ],
153
   };
154
   push @$sref, $entry;
155
}
156
}
157
 
158
# Generate and return a list of section table entries or
159
# limiter key names, skipping any formatting entries.
160
# If 'namesonly' is set, limiter key names are returned,
161
# otherwise an array of section array records is returned.
162
sub get_usable_sectvars(\@ $) {
163
   my ($sectref,$namesonly) = @_;
164
   my (@sect_list, %unique_names);
165
 
166
   foreach my $sref (@$sectref) {
167
      #print "get_usable_sectvars: $sref->{NAME}\n";
168
      next unless $sref->{CLASS} eq 'DATA';
169
      if ($namesonly) {
170
         $unique_names{$sref->{NAME}} = 1;
171
      }
172
      else {
173
         push @sect_list, $sref;
174
      }
175
   }
176
   # return list of unique names
177
   if ($namesonly) {
178
      return keys %unique_names;
179
   }
180
   return @sect_list;
181
}
182
 
183
# Print program and version info, preceeded by an optional string, and exit.
184
#
185
sub get_version() {
186
 
187
   print STDOUT "@_\n"  if ($_[0]);
188
   print STDOUT "$Logreporters::progname: $Logreporters::Version\n";
189
   exit 0;
190
}
191
 
192
 
193
# Returns a list of percentile values given a
194
# sorted array of numeric values.  Uses the formula:
195
#
196
# r = 1 + (p(n-1)/100) = i + d  (Excel method)
197
#
198
# r = rank
199
# p = desired percentile
200
# n = number of items
201
# i = integer part
202
# d = decimal part
203
#
204
# Arg1 is an array ref to the sorted series
205
# Arg2 is a list of percentiles to use
206
 
207
sub get_percentiles(\@ @) {
208
   my ($aref,@plist) = @_;
209
   my ($n, $last, $r, $d, $i, @vals, $Yp);
210
 
211
   $last = $#$aref;
212
   $n = $last + 1;
213
   #printf "%6d" x $n . "\n", @{$aref};
214
 
215
   #printf "n: %4d, last: %d\n", $n, $last;
216
   foreach my $p (@plist) {
217
      $r = 1 + ($p * ($n - 1) / 100.0);
218
      $i = int ($r);		# integer part
219
      # domain: $i = 1 .. n
220
      if ($i == $n) {
221
        $Yp = $aref->[$last];
222
      }
223
      elsif ($i == 0) {
224
        $Yp = $aref->[0];
225
        print "CAN'T HAPPEN: $Yp\n";
226
      }
227
      else {
228
         $d = $r - $i;		# decimal part
229
	 #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
230
         $Yp = $aref->[$i-1] + ($d * ($aref->[$i] - $aref->[$i-1]));
231
      }
232
      #printf "\np(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d", $p, $r, $i, $d, $Yp;
233
      push @vals, $Yp;
234
   }
235
 
236
   return @vals;
237
}
238
 
239
sub get_num_scores($) {
240
   my $scoretab_r = shift;
241
 
242
   my $totalscores = 0;
243
 
244
   for (my $i = 0; $i < @$scoretab_r; $i += 2) {
245
      $totalscores += $scoretab_r->[$i+1]
246
   }
247
 
248
   return $totalscores;
249
}
250
 
251
# scoretab
252
#
253
#  (score1, n1), (score2, n2), ... (scoreN, nN)
254
#     $i   $i+1
255
#
256
# scores are 0 based (0 = 1st score)
257
sub get_nth_score($ $) {
258
   my ($scoretab_r, $n) = @_;
259
 
260
   my $i = 0;
261
   my $n_cur_scores = 0;
262
   #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";
263
 
264
   while ($i < $#$scoretab_r) {
265
      #print "Samples_seen: $n_cur_scores\n";
266
      $n_cur_scores += $scoretab_r->[$i+1];
267
      if ($n_cur_scores >= $n) {
268
         #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];
269
         #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];
270
         return $scoretab_r->[$i];
271
      }
272
 
273
      $i += 2;
274
   }
275
   print "returning last score $scoretab_r->[$i]\n";
276
   return $scoretab_r->[$i];
277
}
278
 
279
sub get_percentiles2(\@ @) {
280
   my ($scoretab_r, @plist) = @_;
281
   my ($n, $last, $r, $d, $i, @vals, $Yp);
282
 
283
   #$last = $#$scoretab_r - 1;
284
   $n = get_num_scores($scoretab_r);
285
   #printf "\n%6d" x $n . "\n", @{$scoretab_r};
286
 
287
   #printf "\n\tn: %4d, @$scoretab_r\n", $n;
288
   foreach my $p (@plist) {
289
  ###print "\nPERCENTILE: $p\n";
290
      $r = 1 + ($p * ($n - 1) / 100.0);
291
      $i = int ($r);		# integer part
292
      if ($i == $n) {
293
        #print "last:\n";
294
        #$Yp = $scoretab_r->[$last];
295
        $Yp = get_nth_score($scoretab_r, $n);
296
      }
297
      elsif ($i == 0) {
298
        #$Yp = $scoretab_r->[0];
299
        print "1st: CAN'T HAPPEN\n";
300
        $Yp = get_nth_score($scoretab_r, 1);
301
      }
302
      else {
303
         $d = $r - $i;		# decimal part
304
	 #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
305
         my $ithvalprev = get_nth_score($scoretab_r, $i);
306
         my $ithval     = get_nth_score($scoretab_r, $i+1);
307
         $Yp = $ithvalprev + ($d * ($ithval - $ithvalprev));
308
      }
309
      #printf "p(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d\n", $p, $r, $i, $d, $Yp;
310
      push @vals, $Yp;
311
   }
312
 
313
   return @vals;
314
}
315
 
316
 
317
 
318
# Returns a list of frequency distributions given an incrementally sorted
319
# set of sorted scores, and an incrementally sorted list of buckets
320
#
321
# Arg1 is an array ref to the sorted series
322
# Arg2 is a list of frequency buckets to use
323
sub get_frequencies(\@ @) {
324
   my ($aref,@blist) = @_;
325
 
326
   my @vals = ( 0 ) x (@blist);
327
   my @sorted_blist = sort { $a <=> $b } @blist;
328
   my $bucket_index = 0;
329
 
330
OUTER: foreach my $score (@$aref) {
331
      #print "Score: $score\n";
332
      for my $i ($bucket_index .. @sorted_blist - 1) {
333
         #print "\tTrying Bucket[$i]: $sorted_blist[$i]\n";
334
         if ($score > $sorted_blist[$i]) {
335
            $bucket_index++;
336
         }
337
         else {
338
            #printf "\t\tinto Bucket[%d]\n", $bucket_index;
339
            $vals[$bucket_index]++;
340
            next OUTER;
341
         }
342
      }
343
      #printf "\t\tinto Bucket[%d]\n", $bucket_index - 1;
344
      $vals[$bucket_index - 1]++;
345
   }
346
 
347
   return @vals;
348
}
349
 
350
# Inserts commas in numbers for easier readability
351
#
352
sub commify ($) {
353
    return undef if ! defined ($_[0]);
354
 
355
    my $text = reverse $_[0];
356
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
357
    return scalar reverse $text;
358
}
359
 
360
# Unitize a number, and return appropriate printf formatting string
361
#
362
sub unitize($ $) {
363
   my ($num, $fmt) = @_;
364
   my $kilobyte = 2**10;
365
   my $megabyte = 2**20;
366
   my $gigabyte = 2**30;
367
   my $terabyte = 2**40;
368
 
369
   if ($num >= $terabyte) {
370
      $num /= $terabyte;
371
      $fmt .= '.3fT';
372
   } elsif ($num >= $gigabyte) {
373
      $num /= $gigabyte;
374
      $fmt .= '.3fG';
375
   } elsif ($num >= $megabyte) {
376
      $num /= $megabyte;
377
      $fmt .= '.3fM';
378
   } elsif ($num >= $kilobyte) {
379
      $num /= $kilobyte;
380
      $fmt .= '.3fK';
381
   } else {
382
      $fmt .= 'd ';
383
   }
384
 
385
   return ($num, $fmt);
386
}
387
 
388
# Returns a sublist of the supplied list of elements in an unchanged order,
389
# where only the first occurrence of each defined element is retained
390
# and duplicates removed
391
#
392
# Borrowed from amavis 2.6.2
393
#
394
sub unique_list(@) {
395
   my ($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_;  # accept list, or a list ref
396
   my (%seen);
397
   my (@unique) = grep { defined($_) && !$seen{$_}++ } @$r;
398
 
399
   return @unique;
400
}
401
 
402
# Generate a test maillog file from the '#TD' test data lines
403
# The test data file is placed in /var/tmp/maillog.autogen
404
#
405
# arg1: "postfix" or "amavis"
406
# arg2: path to postfix-logwatch or amavis-logwatch from which to read '#TD' data
407
#
408
# Postfix TD syntax:
409
#    TD<service><QID>(<count>) log entry
410
#
411
sub gen_test_log($) {
412
   my $scriptpath = shift;
413
 
414
   my $toolname = $Logreporters::progname_prefix;
415
   my $datafile = "/var/tmp/maillog-${toolname}.autogen";
416
 
417
   die "gen_test_log: invalid toolname $toolname"  if ($toolname !~ /^(postfix|amavis)$/);
418
 
419
   eval {
420
      require Sys::Hostname;
421
      require Fcntl;
422
   } or die "Unable to create test data file: required module(s) not found\n$@";
423
 
424
   my $syslogtime = localtime;
425
   $syslogtime =~ s/^....(.*) \d{4}$/$1/;
426
 
427
   my ($hostname) = split /\./, Sys::Hostname::hostname();
428
 
429
  # # avoid -T issues
430
  # delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
431
 
432
   my $flags = &Fcntl::O_CREAT|&Fcntl::O_WRONLY|&Fcntl::O_TRUNC;
433
   sysopen(FH, $datafile, $flags) or die "Can't create test data file: $!";
434
   print "Generating test log data file from $scriptpath: $datafile\n";
435
 
436
   my $id;
437
   @ARGV = ($scriptpath);
438
   if ($toolname eq 'postfix') {
439
      my %services = (
440
          DEF   => 'smtpd',
441
          bQ    => 'bounce',
442
          cN    => 'cleanup',
443
          cQ    => 'cleanup',
444
          lQ    => 'local',
445
          m     => 'master',
446
          p     => 'pickup',
447
          pQ    => 'pickup',
448
          ppQ   => 'pipe',
449
          pfw   => 'postfwd',
450
          pg    => 'postgrey',
451
          pgQ   => 'postgrey',
452
          ps    => 'postsuper',
453
          qQ    => 'qmgr',
454
          s     => 'smtp',
455
          sQ    => 'smtp',
456
          sd    => 'smtpd',
457
          sdN   => 'smtpd',
458
          sdQ   => 'smtpd',
459
          spf   => 'policy-spf',
460
          vN    => 'virtual',
461
          vQ    => 'virtual',
462
      );
463
      $id = 'postfix/smtp[12345]';
464
 
465
      while (<>) {
466
         if (/^\s*#TD([a-zA-Z]*[NQ]?)(\d+)?(?:\(([^)]+)\))? (.*)$/) {
467
            my ($service,$count,$qid,$line) = ($1, $2, $3, $4);
468
 
469
            #print "SERVICE: %s, QID: %s, COUNT: %s, line: %s\n", $service, $qid, $count, $line;
470
 
471
            if ($service eq '') {
472
               $service = 'DEF';
473
            }
474
            die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
475
 
476
            $id = $services{$service} . '[123]';
477
            $id = 'postfix/' . $id    unless $services{$service} eq 'postgrey';
478
            #print "searching for service: \"$service\"\n\tFound $id\n";
479
            if    ($service =~ /N$/) { $id .= ': NOQUEUE'; }
480
            elsif ($service =~ /Q$/) { $id .= $qid ? $qid : ': DEADBEEF'; }
481
 
482
            $line =~ s/ +/ /g;
483
            $line =~ s/^ //g;
484
            #print "$syslogtime $hostname $id: \"$line\"\n" x ($count ? $count : 1);
485
            print FH "$syslogtime $hostname $id: $line\n" x ($count ? $count : 1);
486
         }
487
      }
488
   }
489
   else { #amavis
490
      my %services = (
491
          DEF   => 'amavis',
492
          dcc   => 'dccproc',
493
      );
494
      while (<>) {
495
         if (/^\s*#TD([a-z]*)(\d+)? (.*)$/) {
496
            my ($service,$count,$line) = ($1, $2, $3);
497
            if ($service eq '') {
498
               $service = 'DEF';
499
            }
500
            die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
501
            $id = $services{$service} . '[123]:';
502
            if ($services{$service} eq 'amavis') {
503
               $id .= ' (9999-99)';
504
            }
505
            print FH "$syslogtime $hostname $id $line\n" x ($count ? $count : 1)
506
         }
507
      }
508
   }
509
 
510
   close FH or die "Can't close $datafile: $!";
511
}
512
 
513
1;
514
 
515
#MODULE: ../Logreporters/Config.pm
516
package Logreporters::Config;
517
 
518
use 5.008;
519
use strict;
520
use re 'taint';
521
use warnings;
522
 
523
 
524
BEGIN {
525
   use Exporter ();
526
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
527
   $VERSION = '1.002';
528
   @ISA = qw(Exporter);
529
   @EXPORT = qw(&init_run_mode &add_option &get_options &init_cmdline &get_vars_from_file
530
                &process_limiters &process_debug_opts &init_getopts_table_common &zero_opts
531
                @Optspec %Opts %Configvars @Limiters %line_styles $fw1 $fw2 $sep1 $sep2
532
                &D_CONFIG &D_ARGS &D_VARS &D_TREE &D_SECT &D_UNMATCHED &D_TEST &D_ALL
533
             );
534
}
535
 
536
use subs @EXPORT;
537
 
538
our  @Optspec = ();      # options table used by Getopts
539
 
540
our %Opts = ();         # program-wide options
541
our %Configvars = ();   # configuration file variables
542
our @Limiters;
543
 
544
# Report separator characters and widths
545
our ($fw1,$fw2)   = (22, 10);
546
our ($sep1,$sep2) = ('=', '-');
547
 
548
use Getopt::Long;
549
 
550
 
551
BEGIN {
552
   import Logreporters::Utils qw(&get_usable_sectvars);
553
}
554
 
555
our %line_styles = (
556
   truncate => 0,
557
   wrap     => 1,
558
   full     => 2,
559
);
560
 
561
sub init_run_mode($);
562
sub confighash_to_cmdline(\%);
563
sub get_vars_from_file(\% $);
564
sub process_limiters(\@);
565
sub add_option(@);
566
sub get_options($);
567
sub init_getopts_table_common(@);
568
sub set_supplemental_reports($$);
569
# debug constants
570
sub D_CONFIG ()    { 1<<0 }
571
sub D_ARGS ()      { 1<<1 }
572
sub D_VARS ()      { 1<<2 }
573
sub D_TREE ()      { 1<<3 }
574
sub D_SECT ()      { 1<<4 }
575
sub D_UNMATCHED () { 1<<5 }
576
 
577
sub D_TEST ()      { 1<<30 }
578
sub D_ALL ()       { 1<<31 }
579
 
580
my %debug_words = (
581
   config     => D_CONFIG,
582
   args       => D_ARGS,
583
   vars       => D_VARS,
584
   tree       => D_TREE,
585
   sect       => D_SECT,
586
   unmatched  => D_UNMATCHED,
587
 
588
   test       => D_TEST,
589
   all        => 0xffffffff,
590
);
591
 
592
# Clears %Opts hash and initializes basic running mode options in
593
# %Opts hash by setting keys: 'standalone', 'detail', and 'debug'.
594
# Call early.
595
#
596
sub init_run_mode($) {
597
   my $config_file = shift;
598
   $Opts{'debug'} = 0;
599
 
600
   # Logwatch passes a filter's options via environment variables.
601
   # When running standalone (w/out logwatch), use command line options
602
   $Opts{'standalone'} = exists ($ENV{LOGWATCH_DETAIL_LEVEL}) ? 0 : 1;
603
 
604
   # Show summary section by default
605
   $Opts{'summary'} = 1;
606
 
607
   if ($Opts{'standalone'}) {
608
      process_debug_opts($ENV{'LOGREPORTERS_DEBUG'}) if exists ($ENV{'LOGREPORTERS_DEBUG'});
609
   }
610
   else {
611
      $Opts{'detail'} = $ENV{'LOGWATCH_DETAIL_LEVEL'};
612
      # XXX
613
      #process_debug_opts($ENV{'LOGWATCH_DEBUG'}) if exists ($ENV{'LOGWATCH_DEBUG'});
614
   }
615
 
616
   # first process --debug, --help, and --version options
617
   add_option ('debug=s',                   sub { process_debug_opts($_[1]); 1});
618
   add_option ('version',                   sub { &Logreporters::Utils::get_version(); 1;});
619
   get_options(1);
620
 
621
   # now process --config_file, so that all config file vars are read first
622
   add_option ('config_file|f=s',           sub { get_vars_from_file(%Configvars, $_[1]); 1;});
623
   get_options(1);
624
 
625
   # if no config file vars were read
626
   if ($Opts{'standalone'} and ! keys(%Configvars) and -f $config_file) {
627
      print "Using default config file: $config_file\n" if $Opts{'debug'} & D_CONFIG;
628
      get_vars_from_file(%Configvars, $config_file);
629
   }
630
}
631
 
632
sub get_options($) {
633
   my $pass_through = shift;
634
   #$SIG{__WARN__} = sub { print "*** $_[0]*** options error\n" };
635
   # ensure we're called after %Opts is initialized
636
   die "get_options: program error: %Opts is emtpy" unless exists $Opts{'debug'};
637
 
638
   my $p = new Getopt::Long::Parser;
639
 
640
   if ($pass_through) {
641
      $p->configure(qw(pass_through permute));
642
   }
643
   else {
644
      $p->configure(qw(no_pass_through no_permute));
645
   }
646
   #$p->configure(qw(debug));
647
 
648
   if ($Opts{'debug'} & D_ARGS) {
649
      print "\nget_options($pass_through): enter\n";
650
      printf "\tARGV(%d): ", scalar @ARGV;
651
      print @ARGV, "\n";
652
      print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
653
   }
654
 
655
   if ($p->getoptions(\%Opts, @Optspec) == 0) {
656
      print STDERR "Use ${Logreporters::progname} --help for options\n";
657
      exit 1;
658
   }
659
   if ($Opts{'debug'} & D_ARGS) {
660
      print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
661
      printf "\tARGV(%d): ", scalar @ARGV;
662
      print @ARGV, "\n";
663
      print "get_options: exit\n";
664
   }
665
}
666
 
667
sub add_option(@) {
668
   push @Optspec, @_;
669
}
670
 
671
# untaint string, borrowed from amavisd-new
672
sub untaint($) {
673
   no re 'taint';
674
 
675
   my ($str);
676
   if (defined($_[0])) {
677
      local($1);            # avoid Perl taint bug: tainted global $1 propagates taintedness
678
      $str = $1  if $_[0] =~ /^(.*)$/;
679
   }
680
 
681
   return $str;
682
}
683
 
684
sub init_getopts_table_common(@) {
685
   my @supplemental_reports = @_;
686
 
687
   print "init_getopts_table_common: enter\n"   if $Opts{'debug'} & D_ARGS;
688
 
689
   add_option ('help',                       sub { print STDOUT Logreporters::usage(undef); exit 0 });
690
   add_option ('gen_test_log=s',             sub { Logreporters::Utils::gen_test_log($_[1]); exit 0; });
691
   add_option ('detail=i');
692
   add_option ('nodetail',                   sub {
693
      # __none__ will set all limiters to 0 in process_limiters
694
      # since they are not known (Sections table is not yet built).
695
      push @Limiters, '__none__';
696
      # 0 = disable supplemental_reports
697
      set_supplemental_reports(0, \@supplemental_reports);
698
   });
699
   add_option ('max_report_width=i');
700
   add_option ('summary!');
701
   add_option ('show_summary=i',             sub { $Opts{'summary'} = $_[1]; 1; });
702
   # untaint ipaddr_width for use w/sprintf() in Perl v5.10
703
   add_option ('ipaddr_width=i',             sub { $Opts{'ipaddr_width'} = untaint ($_[1]); 1; });
704
 
705
   add_option ('sect_vars!');
706
   add_option ('show_sect_vars=i',           sub { $Opts{'sect_vars'} = $_[1]; 1; });
707
 
708
   add_option ('syslog_name=s');
709
   add_option ('wrap',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
710
   add_option ('full',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
711
   add_option ('truncate',                   sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
712
   add_option ('line_style=s',               sub {
713
      my $style = lc($_[1]);
714
      my @list = grep (/^$style/, keys %line_styles);
715
      if (! @list) {
716
         print STDERR "Invalid line_style argument \"$_[1]\"\n";
717
         print STDERR "Option line_style argument must be one of \"wrap\", \"full\", or \"truncate\".\n";
718
         print STDERR "Use $Logreporters::progname --help for options\n";
719
         exit 1;
720
      }
721
      $Opts{'line_style'} = $line_styles{lc($list[0])};
722
      1;
723
   });
724
 
725
   add_option ('limit|l=s',                 sub {
726
      my ($limiter,$lspec) = split(/=/, $_[1]);
727
      if (!defined $lspec) {
728
         printf STDERR "Limiter \"%s\" requires value (ex. --limit %s=10)\n", $_[1],$_[1];
729
         exit 2;
730
      }
731
      foreach my $val (split(/(?:\s+|\s*,\s*)/, $lspec)) {
732
         if ($val !~ /^\d+$/ and
733
             $val !~ /^(\d*)\.(\d+)$/ and
734
             $val !~ /^::(\d+)$/ and
735
             $val !~ /^:(\d+):(\d+)?$/ and
736
             $val !~ /^(\d+):(\d+)?:(\d+)?$/)
737
         {
738
            printf STDERR "Limiter value \"$val\" invalid in \"$limiter=$lspec\"\n";
739
            exit 2;
740
         }
741
      }
742
      push @Limiters, lc $_[1];
743
   });
744
 
745
   print "init_getopts_table_common: exit\n"   if $Opts{'debug'} & D_ARGS;
746
}
747
 
748
sub get_option_names() {
749
   my (@ret, @tmp);
750
   foreach (@Optspec) {
751
      if (ref($_) eq '') {       # process only the option names
752
         my $spec = $_;
753
         $spec =~ s/=.*$//;
754
         $spec =~ s/([^|]+)\!$/$1|no$1/g;
755
         @tmp = split /[|]/, $spec;
756
         #print "PUSHING: @tmp\n";
757
         push @ret, @tmp;
758
      }
759
   }
760
   return @ret;
761
}
762
 
763
# Set values for the configuration variables passed via hashref.
764
# Variables are of the form ${progname_prefix}_KEYNAME.
765
#
766
# Because logwatch lowercases all config file entries, KEYNAME is
767
# case-insensitive.
768
#
769
sub init_cmdline() {
770
   my ($href, $configvar, $value, $var);
771
 
772
   # logwatch passes all config vars via environment variables
773
   $href = $Opts{'standalone'} ? \%Configvars : \%ENV;
774
 
775
   # XXX: this is cheeze: need a list of valid limiters, but since
776
   # the Sections table is not built yet, we don't know what is
777
   # a limiter and what is an option, as there is no distinction in
778
   # variable names in the config file (perhaps this should be changed).
779
   my @valid_option_names = get_option_names();
780
   die "Options table not yet set" if ! scalar @valid_option_names;
781
 
782
   print "confighash_to_cmdline: @valid_option_names\n"  if $Opts{'debug'} & D_ARGS;
783
   my @cmdline = ();
784
   while (($configvar, $value) = each %$href) {
785
      if ($configvar =~ s/^${Logreporters::progname_prefix}_//o) {
786
         # distinguish level limiters from general options
787
         # would be easier if limiters had a unique prefix
788
         $configvar = lc $configvar;
789
         my $ret = grep (/^$configvar$/i, @valid_option_names);
790
         if ($ret == 0) {
791
            print "\tLIMITER($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
792
            push @cmdline, '-l', "$configvar" . "=$value";
793
         }
794
         else {
795
            print "\tOPTION($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
796
            unshift @cmdline, $value  if defined ($value);
797
            unshift @cmdline, "--$configvar";
798
         }
799
      }
800
   }
801
   unshift @ARGV, @cmdline;
802
}
803
 
804
# Obtains the variables from a logwatch-style .conf file, for use
805
# in standalone mode.  Returns an ENV-style hash of key/value pairs.
806
#
807
sub get_vars_from_file(\% $) {
808
   my ($href, $file) = @_;
809
   my ($var, $val);
810
 
811
   print "get_vars_from_file: enter: processing file: $file\n" if $Opts{'debug'} & D_CONFIG;
812
 
813
   my  $message = undef;
814
   my $ret = stat ($file);
815
   if ($ret == 0) { $message = $!; }
816
   elsif (! -r _) { $message = "Permission denied"; }
817
   elsif (  -d _) { $message = "Is a directory"; }
818
   elsif (! -f _) { $message = "Not a regular file"; }
819
 
820
   if ($message) {
821
      print STDERR "Configuration file \"$file\": $message\n";
822
      exit 2;
823
   }
824
 
825
   my $prog = $Logreporters::progname_prefix;
826
   open FILE, '<', "$file" or die "unable to open configuration file $file: $!";
827
   while (<FILE>) {
828
      chomp;
829
      next if (/^\s*$/);   # ignore all whitespace lines
830
      next if (/^\*/);     # ignore logwatch's *Service lines
831
      next if (/^\s*#/);   # ignore comment lines
832
      if (/^\s*\$(${prog}_[^=\s]+)\s*=\s*"?([^"]+)"?$/o) {
833
         ($var,$val) = ($1,$2);
834
         if    ($val =~ /^(?:no|false)$/i) { $val = 0; }
835
         elsif ($val =~ /^(?:yes|true)$/i) { $val = 1; }
836
         elsif ($val eq '')                { $var =~ s/${prog}_/${prog}_no/; $val = undef; }
837
 
838
         print "\t\"$var\" => \"$val\"\n"  if $Opts{'debug'} & D_CONFIG;
839
 
840
         $href->{$var} = $val;
841
      }
842
   }
843
   close FILE         or die "failed to close configuration handle for $file: $!";
844
   print "get_vars_from_file: exit\n" if $Opts{'debug'} & D_CONFIG;
845
}
846
 
847
sub process_limiters(\@) {
848
   my ($sectref) = @_;
849
 
850
   my ($limiter, $var, $val, @errors);
851
   my @l = get_usable_sectvars(@$sectref, 1);
852
 
853
   if ($Opts{'debug'} & D_VARS) {
854
      print "process_limiters: enter\n";
855
      print "\tLIMITERS: @Limiters\n";
856
   }
857
   while ($limiter = shift @Limiters) {
858
      my @matched = ();
859
 
860
      printf "\t%-30s  ",$limiter   if $Opts{'debug'} & D_VARS;
861
      # disable all limiters when limiter is __none__: see 'nodetail' cmdline option
862
      if ($limiter eq '__none__') {
863
         $Opts{$_} = 0 foreach @l;
864
         next;
865
      }
866
 
867
      ($var,$val) = split /=/, $limiter;
868
 
869
      if ($val eq '') {
870
         push @errors, "Limiter \"$var\" requires value (ex. --limit limiter=10)";
871
         next;
872
      }
873
 
874
      # try exact match first, then abbreviated match next
875
      if (scalar (@matched = grep(/^$var$/, @l)) == 1 or scalar (@matched = grep(/^$var/, @l)) == 1) {
876
         $limiter = $matched[0];    # unabbreviate limiter
877
         print "MATCH: $var: $limiter => $val\n" if $Opts{'debug'} & D_VARS;
878
         # XXX move limiters into section hash entry...
879
         $Opts{$limiter} = $val;
880
         next;
881
      }
882
      print "matched=", scalar @matched, ": @matched\n" if $Opts{'debug'} & D_VARS;
883
 
884
      push @errors, "Limiter \"$var\" is " . (scalar @matched == 0 ? "invalid" : "ambiguous: @matched");
885
   }
886
   print "\n" if $Opts{'debug'} & D_VARS;
887
 
888
   if (@errors) {
889
      print STDERR "$_\n" foreach @errors;
890
      exit 2;
891
   }
892
 
893
   # Set the default value of 10 for each section if no limiter exists.
894
   # This allows output for each section should there be no configuration
895
   # file or missing limiter within the configuration file.
896
   foreach (@l) {
897
      $Opts{$_} = 10 unless exists $Opts{$_};
898
   }
899
 
900
   # Enable collection for each section if a limiter is non-zero.
901
   foreach (@l) {
902
      #print "L is: $_\n";
903
      #print "DETAIL: $Opts{'detail'}, OPTS: $Opts{$_}\n";
904
      $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
905
   }
906
   #print "OPTS: \n"; map { print "$_ => $Opts{$_}\n"} keys %Opts;
907
   #print "COLLECTING: \n"; map { print "$_ => $Logreporters::TreeData::Collecting{$_}\n"} keys %Logreporters::TreeData::Collecting;
908
}
909
 
910
# Enable/disable supplemental reports
911
# arg1:     0=off, 1=on
912
# arg2,...: list of supplemental report keywords
913
sub set_supplemental_reports($$) {
914
   my ($onoff,$aref) = @_;
915
 
916
   $Opts{$_} = $onoff foreach (@$aref);
917
}
918
 
919
sub process_debug_opts($) {
920
   my $optstring = shift;
921
 
922
   my @errors = ();
923
   foreach (split(/\s*,\s*/, $optstring)) {
924
      my $word = lc $_;
925
      my @matched = grep (/^$word/, keys %debug_words);
926
 
927
      if (scalar @matched == 1) {
928
         $Opts{'debug'} |= $debug_words{$matched[0]};
929
         next;
930
      }
931
 
932
      if (scalar @matched == 0) {
933
         push @errors, "Unknown debug keyword \"$word\"";
934
      }
935
      else {  # > 1
936
         push @errors, "Ambiguous debug keyword abbreviation \"$word\": (matches: @matched)";
937
      }
938
   }
939
   if (@errors) {
940
      print STDERR "$_\n" foreach @errors;
941
      print STDERR "Debug keywords: ", join (' ', sort keys %debug_words), "\n";
942
      exit 2;
943
   }
944
}
945
 
946
# Zero the options controlling level specs and those
947
# any others passed via Opts key.
948
#
949
# Zero the options controlling level specs in the
950
# Detailed section, and set all other report options
951
# to disabled. This makes it easy via command line to
952
# disable the entire summary section, and then re-enable
953
# one or more sections for specific reports.
954
#
955
#   eg. progname --nodetail --limit forwarded=2
956
#
957
sub zero_opts ($ @) {
958
   my $sectref = shift;
959
   # remaining args: list of Opts keys to zero
960
 
961
   map { $Opts{$_} = 0; print "zero_opts: $_ => 0\n" if $Opts{'debug'} & D_VARS;} @_;
962
   map { $Opts{$_} = 0 } get_usable_sectvars(@$sectref, 1);
963
}
964
 
965
1;
966
 
967
#MODULE: ../Logreporters/TreeData.pm
968
package Logreporters::TreeData;
969
 
970
use 5.008;
971
use strict;
972
use re 'taint';
973
use warnings;
974
no warnings "uninitialized";
975
 
976
BEGIN {
977
   use Exporter ();
978
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
979
   $VERSION = '1.001';
980
   @ISA = qw(Exporter);
981
   @EXPORT = qw(%Totals %Counts %Collecting $END_KEY);
982
   @EXPORT_OK = qw(&printTree &buildTree);
983
 
984
}
985
 
986
use subs @EXPORT_OK;
987
 
988
BEGIN {
989
   import Logreporters::Config qw(%line_styles);
990
}
991
 
992
# Totals and Counts are the log line accumulator hashes.
993
# Totals: maintains per-section grand total tallies for use in Summary section
994
# Counts: is a multi-level hash, which maintains per-level key totals.
995
our (%Totals, %Counts);
996
 
997
# The Collecting hash determines which sections will be captured in
998
# the Counts hash.  Counts are collected only if a section is enabled,
999
# and this hash obviates the need to test both existence and
1000
# non-zero-ness of the Opts{'keyname'} (either of which cause capture).
1001
# XXX The Opts hash could be used ....
1002
our %Collecting = ();
1003
 
1004
sub buildTree(\% $ $ $ $ $);
1005
sub printTree($ $ $ $ $);
1006
=pod
1007
[ a:b:c, ... ]
1008
 
1009
which would be interpreted as follows:
1010
 
1011
a = show level a detail
1012
b = show at most b items at this level
1013
c = minimun count that will be shown
1014
=cut
1015
 
1016
sub printTree($ $ $ $ $) {
1017
   my ($treeref, $lspecsref, $line_style, $max_report_width, $debug) = @_;
1018
   my ($entry, $line);
1019
   my $cutlength = $max_report_width - 3;
1020
 
1021
   my $topn = 0;
1022
   foreach $entry (sort bycount @$treeref) {
1023
      ref($entry) ne "HASH" and die "Unexpected entry in tree: $entry\n";
1024
 
1025
      #print "LEVEL: $entry->{LEVEL}, TOTAL: $entry->{TOTAL}, HASH: $entry, DATA: $entry->{DATA}\n";
1026
 
1027
      # Once the top N lines have been printed, we're done
1028
      if ($lspecsref->[$entry->{LEVEL}]{topn}) {
1029
         if ($topn++ >= $lspecsref->[$entry->{LEVEL}]{topn} ) {
1030
            print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1031
               unless ($debug) and do {
1032
                     $line = '     ' . '   ' x ($entry->{LEVEL} + 3) . '...';
1033
                     printf "%-130s L%d: topn reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{topn};
1034
               };
1035
            last;
1036
         }
1037
      }
1038
 
1039
      # Once the item's count falls below the given threshold, we're done at this level
1040
      # unless a top N is specified, as threshold has lower priority than top N
1041
      elsif ($lspecsref->[$entry->{LEVEL}]{threshold}) {
1042
         if ($entry->{TOTAL} <= $lspecsref->[$entry->{LEVEL}]{threshold}) {
1043
            print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
1044
               unless ($debug) and do {
1045
                  $line = '     ' . ('   ' x ($entry->{LEVEL} + 3)) . '...';
1046
                  printf "%-130s L%d: threshold reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{threshold};
1047
               };
1048
            last;
1049
         }
1050
      }
1051
 
1052
      $line = sprintf "%8d%s%s", $entry->{TOTAL}, '   ' x ($entry->{LEVEL} + 2),  $entry->{DATA};
1053
 
1054
      if ($debug) {
1055
         printf "%-130s %-60s\n", $line, $entry->{DEBUG};
1056
      }
1057
 
1058
      # line_style full, or lines < max_report_width
1059
 
1060
      #printf "MAX: $max_report_width, LEN: %d, CUTLEN $cutlength\n", length($line);
1061
      if ($line_style == $line_styles{'full'} or length($line) <= $max_report_width) {
1062
         print $line, "\n";
1063
      }
1064
      elsif ($line_style == $line_styles{'truncate'}) {
1065
         print substr ($line,0,$cutlength), '...', "\n";
1066
      }
1067
      elsif ($line_style == $line_styles{'wrap'}) {
1068
         my $leader = ' ' x 8 . '   ' x ($entry->{LEVEL} + 2);
1069
         print substr ($line, 0, $max_report_width, ''), "\n";
1070
         while (length($line)) {
1071
            print $leader, substr ($line, 0, $max_report_width - length($leader), ''), "\n";
1072
         }
1073
      }
1074
      else {
1075
         die ('unexpected line style');
1076
      }
1077
 
1078
      printTree ($entry->{CHILDREF}, $lspecsref, $line_style, $max_report_width, $debug)   if (exists $entry->{CHILDREF});
1079
   }
1080
}
1081
 
1082
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/;
1083
# XXX optimize this using packed default sorting.  Analysis shows speed isn't an issue though
1084
sub bycount {
1085
   # Sort by totals, then IP address if one exists, and finally by data as a string
1086
 
1087
   local $SIG{__WARN__} = sub { print "*** PLEASE REPORT:\n*** $_[0]*** Unexpected: \"$a->{DATA}\", \"$b->{DATA}\"\n" };
1088
 
1089
   $b->{TOTAL} <=> $a->{TOTAL}
1090
 
1091
      ||
1092
 
1093
   pack('C4' => $a->{DATA} =~ /^$re_IP_strict/o) cmp pack('C4' => $b->{DATA} =~ /^$re_IP_strict/o)
1094
 
1095
      ||
1096
 
1097
   $a->{DATA} cmp $b->{DATA}
1098
}
1099
 
1100
#
1101
# Builds a tree of REC structures from the multi-key %Counts hashes
1102
#
1103
# Parameters:
1104
#    Hash:  A multi-key hash, with keys being used as category headings, and leaf data
1105
#           being tallies for that set of keys
1106
#    Level: This current recursion level.  Call with 0.
1107
#
1108
# Returns:
1109
#    Listref: A listref, where each item in the list is a rec record, described as:
1110
#           DATA:      a string: a heading, or log data
1111
#           TOTAL:     an integer: which is the subtotal of this item's children
1112
#           LEVEL:     an integer > 0: representing this entry's level in the tree
1113
#           CHILDREF:  a listref: references a list consisting of this node's children
1114
#    Total: The cummulative total of items found for a given invocation
1115
#
1116
# Use the special key variable $END_KEY, which is "\a\a" (two ASCII bell's) to end a,
1117
# nested hash early, or the empty string '' may be used as the last key.
1118
 
1119
our $END_KEY = "\a\a";
1120
 
1121
sub buildTree(\% $ $ $ $ $) {
1122
   my ($href, $max_level_section, $levspecref, $max_level_global, $recurs_level, $show_unique, $debug) = @_;
1123
   my ($subtotal, $childList, $rec);
1124
 
1125
   my @treeList = ();
1126
   my $total = 0;
1127
 
1128
   foreach my $item (sort keys %$href) {
1129
      if (ref($href->{$item}) eq "HASH") {
1130
         #print " " x ($recurs_level * 4), "HASH: LEVEL $recurs_level: Item: $item, type: \"", ref($href->{$item}), "\"\n";
1131
 
1132
         ($subtotal, $childList) = buildTree (%{$href->{$item}}, $max_level_section, $levspecref, $max_level_global, $recurs_level + 1, $debug);
1133
 
1134
         if ($recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1135
            # me + children
1136
            $rec = {
1137
               DATA     => $item,
1138
               TOTAL    => $subtotal,
1139
               LEVEL    => $recurs_level,
1140
               CHILDREF => $childList,
1141
            };
1142
 
1143
            if ($debug) {
1144
               $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1145
                     $recurs_level + 1, $max_level_global, $max_level_section,
1146
                     $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $subtotal;
1147
            }
1148
            push (@treeList, $rec);
1149
         }
1150
      }
1151
      else {
1152
         if ($item ne '' and $item ne $END_KEY and $recurs_level < $max_level_global and $recurs_level < $max_level_section) {
1153
            $rec = {
1154
               DATA  => $item,
1155
               TOTAL => $href->{$item},
1156
               LEVEL => $recurs_level,
1157
               #CHILDREF => undef,
1158
            };
1159
            if ($debug) {
1160
               $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
1161
                     $recurs_level, $max_level_global, $max_level_section,
1162
                     $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $href->{$item};
1163
            }
1164
            push (@treeList,  $rec);
1165
         }
1166
         $subtotal = $href->{$item};
1167
      }
1168
 
1169
      $total += $subtotal;
1170
   }
1171
 
1172
   #print " " x ($recurs_level * 4), "LEVEL $recurs_level: Returning from recurs_level $recurs_level\n";
1173
 
1174
   return ($total, \@treeList);
1175
}
1176
 
1177
1;
1178
 
1179
#MODULE: ../Logreporters/RegEx.pm
1180
package Logreporters::RegEx;
1181
 
1182
use 5.008;
1183
use strict;
1184
use re 'taint';
1185
use warnings;
1186
 
1187
BEGIN {
1188
   use Exporter ();
1189
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1190
   $VERSION = '1.000';
1191
   @ISA = qw(Exporter);
1192
#   @EXPORT = qw($re_IP);
1193
   @EXPORT_OK = qw();
1194
}
1195
 
1196
# IPv4 and IPv6
1197
# See syntax in RFC 2821 IPv6-address-literal,
1198
# eg. IPv6:2001:630:d0:f102:230:48ff:fe77:96e
1199
#our $re_IP      = '(?:(?:::(?:ffff:|FFFF:)?)?(?:\d{1,3}\.){3}\d{1,3}|(?:(?:IPv6:)?[\da-fA-F]{0,4}:){2}(?:[\da-fA-F]{0,4}:){0,5}[\da-fA-F]{0,4})';
1200
 
1201
# Modified from "dartware" case at http://forums.dartware.com/viewtopic.php?t=452#
1202
#our $re_IP		= qr/(?:(?:(?:(?:[\da-f]{1,4}:){7}(?:[\da-f]{1,4}|:))|(?:(?:[\da-f]{1,4}:){6}(?::[\da-f]{1,4}|(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[\da-f]{1,4}:){5}(?:(?:(?::[\da-f]{1,4}){1,2})|:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[\da-f]{1,4}:){4}(?:(?:(?::[\da-f]{1,4}){1,3})|(?:(?::[\da-f]{1,4})?:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){3}(?:(?:(?::[\da-f]{1,4}){1,4})|(?:(?::[\da-f]{1,4}){0,2}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){2}(?:(?:(?::[\da-f]{1,4}){1,5})|(?:(?::[\da-f]{1,4}){0,3}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[\da-f]{1,4}:){1}(?:(?:(?::[\da-f]{1,4}){1,6})|(?:(?::[\da-f]{1,4}){0,4}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?::(?:(?:(?::[\da-f]{1,4}){1,7})|(?:(?::[\da-f]{1,4}){0,5}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:)))(?:%.+)?)|(?:(?:\d{1,3}\.){3}(?:\d{1,3}))/i;
1203
 
1204
# IPv4 only
1205
#our $re_IP      = qr/(?:\d{1,3}\.){3}(?:\d{1,3})/;
1206
 
1207
1;
1208
 
1209
#MODULE: ../Logreporters/Reports.pm
1210
package Logreporters::Reports;
1211
 
1212
use 5.008;
1213
use strict;
1214
use re 'taint';
1215
use warnings;
1216
no warnings "uninitialized";
1217
 
1218
BEGIN {
1219
   use Exporter ();
1220
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1221
   $VERSION = '1.002';
1222
   @ISA = qw(Exporter);
1223
   @EXPORT = qw(&inc_unmatched &print_unmatched_report &print_percentiles_report2
1224
                &print_summary_report &print_detail_report);
1225
   @EXPORT_OK = qw();
1226
}
1227
 
1228
use subs @EXPORT_OK;
1229
 
1230
BEGIN {
1231
   import Logreporters::Config qw(%Opts $fw1 $fw2 $sep1 $sep2 &D_UNMATCHED &D_TREE);
1232
   import Logreporters::Utils qw(&commify &unitize &get_percentiles &get_percentiles2);
1233
   import Logreporters::TreeData qw(%Totals %Counts &buildTree &printTree);
1234
}
1235
 
1236
my (%unmatched_list);
1237
 
1238
our $origline;       # unmodified log line, for error reporting and debug
1239
 
1240
sub inc_unmatched($) {
1241
   my ($id) = @_;
1242
   $unmatched_list{$origline}++;
1243
   print "UNMATCHED($id): \"$origline\"\n"  if $Opts{'debug'} & D_UNMATCHED;
1244
}
1245
 
1246
# Print unmatched lines
1247
#
1248
sub print_unmatched_report() {
1249
   return unless (keys %unmatched_list);
1250
 
1251
   print "\n\n**Unmatched Entries**\n";
1252
   foreach my $line (sort {$unmatched_list{$b}<=>$unmatched_list{$a} } keys %unmatched_list) {
1253
      printf "%8d   %s\n", $unmatched_list{$line}, $line;
1254
   }
1255
}
1256
 
1257
=pod
1258
   ****** Summary ********************************************************
1259
          2   Miscellaneous warnings
1260
 
1261
      20621   Total messages scanned ----------------  100.00%
1262
    662.993M  Total bytes scanned                  695,198,092
1263
   ========   ================================================
1264
 
1265
      19664   Ham -----------------------------------   95.36%
1266
      19630     Clean passed                            95.19%
1267
         34     Bad header passed                        0.16%
1268
 
1269
        942   Spam ----------------------------------    4.57%
1270
        514     Spam blocked                             2.49%
1271
        428     Spam discarded (no quarantine)           2.08%
1272
 
1273
         15   Malware -------------------------------    0.07%
1274
         15     Malware blocked                          0.07%
1275
 
1276
 
1277
       1978   SpamAssassin bypassed
1278
         18   Released from quarantine
1279
       1982   Whitelisted
1280
          3   Blacklisted
1281
         12   MIME error
1282
         51   Bad header (debug supplemental)
1283
         28   Extra code modules loaded at runtime
1284
=cut
1285
# Prints the Summary report section
1286
#
1287
sub print_summary_report (\@) {
1288
   my ($sections) = @_;
1289
   my ($keyname,$cur_level);
1290
   my @lines;
1291
 
1292
   my $expand_header_footer = sub {
1293
      my $line = undef;
1294
 
1295
      foreach my $horf (@_) {
1296
         # print blank line if keyname is newline
1297
         if ($horf eq "\n") {
1298
            $line .= "\n";
1299
         }
1300
         elsif (my ($sepchar) = ($horf =~ /^(.)$/o)) {
1301
            $line .= sprintf "%s   %s\n", $sepchar x 8, $sepchar x 50;
1302
         }
1303
         else {
1304
            die "print_summary_report: unsupported header or footer type \"$horf\"";
1305
         }
1306
      }
1307
      return $line;
1308
   };
1309
 
1310
   if ($Opts{'detail'} >= 5) {
1311
      my $header = "****** Summary ";
1312
      print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n\n";
1313
   }
1314
 
1315
   my @headers;
1316
   foreach my $sref (@$sections) {
1317
      # headers and separators
1318
      die "Unexpected Section $sref"  if (ref($sref) ne 'HASH');
1319
 
1320
      # Start of a new section group.
1321
      # Expand and save headers to output at end of section group.
1322
      if ($sref->{CLASS} eq 'GROUP_BEGIN') {
1323
         $cur_level = $sref->{LEVEL};
1324
         $headers[$cur_level] = &$expand_header_footer(@{$sref->{HEADERS}});
1325
      }
1326
 
1327
      elsif ($sref->{CLASS} eq 'GROUP_END') {
1328
         my $prev_level = $sref->{LEVEL};
1329
 
1330
         # If this section had lines to output, tack on headers and footers,
1331
         # removing extraneous newlines.
1332
         if ($lines[$cur_level]) {
1333
            # squish multiple blank lines
1334
            if ($headers[$cur_level] and substr($headers[$cur_level],0,1) eq "\n") {
1335
               if ( ! defined $lines[$prev_level][-1] or $lines[$prev_level][-1] eq "\n") {
1336
                  $headers[$cur_level] =~ s/^\n+//;
1337
               }
1338
            }
1339
 
1340
            push @{$lines[$prev_level]}, $headers[$cur_level]  if $headers[$cur_level];
1341
            push @{$lines[$prev_level]}, @{$lines[$cur_level]};
1342
            my $f = &$expand_header_footer(@{$sref->{FOOTERS}});
1343
            push @{$lines[$prev_level]}, $f   if $f;
1344
            $lines[$cur_level] = undef;
1345
         }
1346
 
1347
         $headers[$cur_level] = undef;
1348
         $cur_level = $prev_level;
1349
      }
1350
 
1351
      elsif ($sref->{CLASS} eq 'DATA') {
1352
         # Totals data
1353
         $keyname = $sref->{NAME};
1354
         if ($Totals{$keyname} > 0) {
1355
            my ($numfmt, $desc, $divisor) = ($sref->{FMT}, $sref->{TITLE}, $sref->{DIVISOR});
1356
 
1357
            my $fmt   = '%8';
1358
            my $extra = ' %25s';
1359
            my $total = $Totals{$keyname};
1360
 
1361
            # Z format provides  unitized or unaltered totals, as appropriate
1362
            if ($numfmt eq 'Z') {
1363
               ($total, $fmt) = unitize ($total, $fmt);
1364
            }
1365
            else {
1366
               $fmt .= "$numfmt ";
1367
               $extra = '';
1368
            }
1369
 
1370
            if ($divisor and $$divisor) {
1371
               # XXX generalize this
1372
               if (ref ($desc) eq 'ARRAY') {
1373
                  $desc = @$desc[0] . ' ' . @$desc[1] x (42 - 2 - length(@$desc[0]));
1374
               }
1375
 
1376
               push @{$lines[$cur_level]},
1377
                  sprintf "$fmt  %-42s %6.2f%%\n", $total, $desc,
1378
                     $$divisor == $Totals{$keyname} ? 100.00 : $Totals{$keyname} * 100 / $$divisor;
1379
            }
1380
            else {
1381
               push @{$lines[$cur_level]},
1382
                  sprintf "$fmt  %-23s $extra\n", $total, $desc, commify ($Totals{$keyname});
1383
            }
1384
         }
1385
      }
1386
      else {
1387
         die "print_summary_report: unexpected control...";
1388
      }
1389
   }
1390
   print @{$lines[0]};
1391
   print "\n";
1392
}
1393
 
1394
# Prints the Detail report section
1395
#
1396
# Note: side affect; deletes each key in Totals/Counts
1397
# after printout.  Only the first instance of a key in
1398
# the Section table will result in Detail output.
1399
sub print_detail_report (\@) {
1400
   my ($sections) = @_;
1401
   my $header_printed = 0;
1402
 
1403
   return unless (keys %Counts);
1404
 
1405
#use Devel::Size qw(size total_size);
1406
 
1407
   foreach my $sref ( @$sections ) {
1408
      next unless $sref->{CLASS} eq 'DATA';
1409
      # only print detail for this section if DETAIL is enabled
1410
      # and there is something in $Counts{$keyname}
1411
      next unless $sref->{DETAIL};
1412
      next unless exists $Counts{$sref->{NAME}};
1413
 
1414
      my $keyname = $sref->{NAME};
1415
      my $max_level = undef;
1416
      my $print_this_key = 0;
1417
 
1418
      my @levelspecs = ();
1419
      clear_level_specs($max_level, \@levelspecs);
1420
      if (exists $Opts{$keyname}) {
1421
         $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
1422
         $print_this_key = 1  if ($max_level);
1423
      }
1424
      else {
1425
         $print_this_key = 1;
1426
      }
1427
      #print_level_specs($max_level,\@levelspecs);
1428
 
1429
      # at detail 5, print level 1, detail 6: level 2, ...
1430
 
1431
#print STDERR "building: $keyname\n";
1432
      my ($count, $treeref) =
1433
            buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
1434
                       \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);
1435
 
1436
      if ($count > 0) {
1437
         if ($print_this_key) {
1438
            my $desc = $sref->{TITLE};
1439
            $desc =~ s/^\s+//;
1440
 
1441
            if (! $header_printed) {
1442
               my $header = "****** Detail ($max_level) ";
1443
               print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
1444
               $header_printed = 1;
1445
            }
1446
            printf "\n%8d   %s %s\n", $count, $desc,
1447
                     $Opts{'sect_vars'} ?
1448
                       ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
1449
                        '-' x ($Opts{'max_report_width'} - 12 - length($desc))
1450
         }
1451
 
1452
         printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
1453
                    $Opts{'debug'} & D_TREE);
1454
      }
1455
#print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
1456
#print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
1457
      $treeref = undef;
1458
      $Totals{$keyname} = undef;
1459
      delete $Totals{$keyname};
1460
      delete $Counts{$keyname};
1461
   }
1462
   #print "\n";
1463
}
1464
 
1465
=pod
1466
 
1467
Print out a standard percentiles report
1468
 
1469
   === Delivery Delays Percentiles ===============================================================
1470
                          0%       25%       50%       75%       90%       95%       98%      100%
1471
   -----------------------------------------------------------------------------------------------
1472
   Before qmgr          0.01      0.70      1.40  45483.70  72773.08  81869.54  87327.42  90966.00
1473
   In qmgr              0.00      0.00      0.00      0.01      0.01      0.01      0.01      0.01
1474
   Conn setup           0.00      0.00      0.00      0.85      1.36      1.53      1.63      1.70
1475
   Transmission         0.03      0.47      0.92      1.61      2.02      2.16      2.24      2.30
1476
   Total                0.05      1.18      2.30  45486.15  72776.46  81873.23  87331.29  90970.00
1477
   ===============================================================================================
1478
 
1479
   === Postgrey Delays Percentiles ===========================================================
1480
                      0%       25%       50%       75%       90%       95%       98%      100%
1481
   -------------------------------------------------------------------------------------------
1482
   Postgrey       727.00    727.00    727.00    727.00    727.00    727.00    727.00    727.00
1483
   ===========================================================================================
1484
 
1485
 tableref:
1486
   data table: ref to array of arrays, first cell is label, subsequent cells are data
1487
 title:
1488
   table's title
1489
 percentiles_str:
1490
   string of space or comma separated integers, which are the percentiles
1491
   calculated and output as table column data
1492
=cut
1493
sub print_percentiles_report2($$$) {
1494
   my ($tableref, $title, $percentiles_str) = @_;
1495
 
1496
   return unless @$tableref;
1497
 
1498
   my $myfw2 = $fw2 - 1;
1499
   my @percents = split /[ ,]/, $percentiles_str;
1500
 
1501
   # Calc y label width from the hash's keys. Each key is padded with the
1502
   # string "#: ", # where # is a single-digit sort index.
1503
   my $y_label_max_width = 0;
1504
   for (@$tableref) {
1505
      $y_label_max_width = length($_->[0])   if (length($_->[0]) > $y_label_max_width);
1506
   }
1507
 
1508
   # Titles row
1509
   my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
1510
   my $table_width = length($col_titles_str);
1511
 
1512
   # Table header row
1513
   my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
1514
   $table_header_str .= $sep1 x ($table_width - length($table_header_str));
1515
 
1516
   print "\n", $table_header_str;
1517
   print "\n", $col_titles_str;
1518
   print "\n", $sep2 x $table_width;
1519
 
1520
   my (@p, @coldata, @xformed);
1521
   foreach (@$tableref) {
1522
      my ($title, $ref) = ($_->[0], $_->[1]);
1523
      #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};
1524
 
1525
      my @byscore = ();
1526
 
1527
      for my $bucket (sort { $a <=> $b } keys %$ref) {
1528
      #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
1529
      # pairs: bucket (i.e. key), tally
1530
         push @byscore, $bucket, $ref->{$bucket};
1531
      }
1532
 
1533
 
1534
      my @p = get_percentiles2 (@byscore, @percents);
1535
      printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
1536
   }
1537
 
1538
=pod
1539
   foreach (@percents) {
1540
      #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
1541
      printf "\n%3d%%", $title;
1542
      foreach my $val (@{shift @xformed}) {
1543
         my $unit;
1544
         if ($val > 1000) {
1545
            $unit = 's';
1546
            $val /= 1000;
1547
         }
1548
         else {
1549
            $unit = '';
1550
         }
1551
         printf "%${fw3}.2f%-2s", $val, $unit;
1552
      }
1553
   }
1554
=cut
1555
 
1556
   print "\n", $sep1 x $table_width, "\n";
1557
}
1558
 
1559
sub clear_level_specs($ $) {
1560
   my ($max_level,$lspecsref) = @_;
1561
   #print "Zeroing $max_level rows of levelspecs\n";
1562
   $max_level = 0 if (not defined $max_level);
1563
   for my $x (0..$max_level) {
1564
      $lspecsref->[$x]{topn}      = undef;
1565
      $lspecsref->[$x]{threshold} = undef;
1566
   }
1567
}
1568
 
1569
# topn      = 0 means don't limit
1570
# threshold = 0 means no min threshold
1571
sub create_level_specs($ $ $) {
1572
   my ($optkey,$gdetail,$lspecref) = @_;
1573
 
1574
   return 0 if ($optkey eq "0");
1575
 
1576
   my $max_level = $gdetail;       	# default to global detail level
1577
   my (@specsP1, @specsP2, @specsP3);
1578
 
1579
   #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;
1580
 
1581
   foreach my $sp (split /[\s,]+/, $optkey) {
1582
      #print "create_level_specs:  SP: \"$sp\"\n";
1583
      # original level specifier
1584
      if ($sp =~ /^\d+$/) {
1585
         $max_level = $sp;
1586
         #print "create_level_specs:  max_level set: $max_level\n";
1587
      }
1588
      # original level specifier + topn at level 1
1589
      elsif ($sp =~ /^(\d*)\.(\d+)$/) {
1590
         if ($1) { $max_level = $1; }
1591
         else    { $max_level = $gdetail; }	      # top n specified, but no max level
1592
 
1593
         # force top N at level 1 (zero based)
1594
         push @specsP1, { level => 0, topn => $2, threshold => 0 };
1595
      }
1596
      # newer level specs
1597
      elsif ($sp =~ /^::(\d+)$/) {
1598
         push @specsP3, { level => undef, topn => 0, threshold => $1 };
1599
      }
1600
      elsif ($sp =~ /^:(\d+):(\d+)?$/) {
1601
         push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
1602
      }
1603
      elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
1604
         push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
1605
      }
1606
      else {
1607
         print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
1608
      }
1609
   }
1610
 
1611
   #foreach my $sp (@specsP3, @specsP2, @specsP1) {
1612
   #   printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
1613
   #}
1614
 
1615
   my ($min, $max);
1616
   foreach my $sp ( @specsP3, @specsP2, @specsP1) {
1617
      ($min, $max) = (0, $max_level);
1618
 
1619
      if (defined $sp->{level}) {
1620
         $min = $max = $sp->{level};
1621
      }
1622
      for my $level ($min..$max) {
1623
         #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
1624
         $lspecref->[$level]{topn}      = $sp->{topn}          if ($sp->{topn});
1625
         $lspecref->[$level]{threshold} = $sp->{threshold}     if ($sp->{threshold});
1626
      }
1627
   }
1628
 
1629
   return $max_level;
1630
}
1631
 
1632
sub print_level_specs($ $) {
1633
   my ($max_level,$lspecref) = @_;
1634
   for my $level (0..$max_level) {
1635
      printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
1636
   }
1637
}
1638
 
1639
 
1640
1;
1641
 
1642
#MODULE: ../Logreporters/RFC3463.pm
1643
package Logreporters::RFC3463;
1644
 
1645
use 5.008;
1646
use strict;
1647
use re 'taint';
1648
use warnings;
1649
 
1650
BEGIN {
1651
   use Exporter ();
1652
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1653
   $VERSION = '1.000';
1654
   @ISA = qw(Exporter);
1655
   @EXPORT = qw(&get_dsn_msg);
1656
}
1657
 
1658
use subs @EXPORT;
1659
 
1660
#-------------------------------------------------
1661
# Enhanced Mail System Status Codes (aka: extended status codes)
1662
#
1663
#   RFC 3463   http://www.ietf.org/rfc/rfc3463.txt
1664
#   RFC 4954   http://www.ietf.org/rfc/rfc4954.txt
1665
#
1666
# Class.Subject.Detail
1667
#
1668
my %dsn_codes = (
1669
    class => {
1670
      '2' => 'Success',
1671
      '4' => 'Transient failure',
1672
      '5' => 'Permanent failure',
1673
    },
1674
 
1675
    subject => {
1676
      '0' => 'Other/Undefined status',
1677
      '1' => 'Addressing status',
1678
      '2' => 'Mailbox status',
1679
      '3' => 'Mail system status',
1680
      '4' => 'Network & routing status',
1681
      '5' => 'Mail delivery protocol status',
1682
      '6' => 'Message content/media status',
1683
      '7' => 'Security/policy status',
1684
    },
1685
 
1686
    detail => {
1687
      '0.0' => 'Other undefined status',
1688
      '1.0' => 'Other address status',
1689
      '1.1' => 'Bad destination mailbox address',
1690
      '1.2' => 'Bad destination system address',
1691
      '1.3' => 'Bad destination mailbox address syntax',
1692
      '1.4' => 'Destination mailbox address ambiguous',
1693
      '1.5' => 'Destination mailbox address valid',
1694
      '1.6' => 'Mailbox has moved',
1695
      '1.7' => 'Bad sender\'s mailbox address syntax',
1696
      '1.8' => 'Bad sender\'s system address',
1697
 
1698
      '2.0' => 'Other/Undefined mailbox status',
1699
      '2.1' => 'Mailbox disabled, not accepting messages',
1700
      '2.2' => 'Mailbox full',
1701
      '2.3' => 'Message length exceeds administrative limit.',
1702
      '2.4' => 'Mailing list expansion problem',
1703
 
1704
      '3.0' => 'Other/Undefined mail system status',
1705
      '3.1' => 'Mail system full',
1706
      '3.2' => 'System not accepting network messages',
1707
      '3.3' => 'System not capable of selected features',
1708
      '3.4' => 'Message too big for system',
1709
 
1710
      '4.0' => 'Other/Undefined network or routing status',
1711
      '4.1' => 'No answer from host',
1712
      '4.2' => 'Bad connection',
1713
      '4.3' => 'Routing server failure',
1714
      '4.4' => 'Unable to route',
1715
      '4.5' => 'Network congestion',
1716
      '4.6' => 'Routing loop detected',
1717
      '4.7' => 'Delivery time expired',
1718
 
1719
      '5.0' => 'Other/Undefined protocol status',
1720
      '5.1' => 'Invalid command',
1721
      '5.2' => 'Syntax error',
1722
      '5.3' => 'Too many recipients',
1723
      '5.4' => 'Invalid command arguments',
1724
      '5.5' => 'Wrong protocol version',
1725
      '5.6' => 'Authentication Exchange line too long',
1726
 
1727
      '6.0' => 'Other/Undefined media error',
1728
      '6.1' => 'Media not supported',
1729
      '6.2' => 'Conversion required & prohibited',
1730
      '6.3' => 'Conversion required but not supported',
1731
      '6.4' => 'Conversion with loss performed',
1732
      '6.5' => 'Conversion failed',
1733
 
1734
      '7.0' => 'Other/Undefined security status',
1735
      '7.1' => 'Delivery not authorized, message refused',
1736
      '7.2' => 'Mailing list expansion prohibited',
1737
      '7.3' => 'Security conversion required but not possible',
1738
      '7.4' => 'Security features not supported',
1739
      '7.5' => 'Cryptographic failure',
1740
      '7.6' => 'Cryptographic algorithm not supported',
1741
      '7.7' => 'Message integrity failure',
1742
    },
1743
 
1744
    # RFC 4954
1745
    complete => {
1746
      '2.7.0'  => 'Authentication succeeded',
1747
      '4.7.0'  => 'Temporary authentication failure',
1748
      '4.7.12' => 'Password transition needed',
1749
      '5.7.0'  => 'Authentication required',
1750
      '5.7.8'  => 'Authentication credentials invalid',
1751
      '5.7.9'  => 'Authentication mechanism too weak',
1752
      '5.7.11' => 'Encryption required for requested authentication mechanism',
1753
    },
1754
);
1755
 
1756
# Returns an RFC 3463 DSN messages given a DSN code
1757
#
1758
sub get_dsn_msg ($) {
1759
   my $dsn = shift;
1760
   my ($msg, $class, $subject, $detail);
1761
 
1762
   return "*DSN unavailable"  if ($dsn =~ /^$/);
1763
 
1764
   unless ($dsn =~ /^(\d)\.((\d{1,3})\.\d{1,3})$/) {
1765
      print "Error: not a DSN code $dsn\n";
1766
      return "Invalid DSN";
1767
   }
1768
 
1769
   $class = $1; $subject = $3; $detail = $2;
1770
 
1771
   #print "DSN: $dsn, Class: $class, Subject: $subject, Detail: $detail\n";
1772
 
1773
   if (exists $dsn_codes{'class'}{$class}) {
1774
      $msg = $dsn_codes{'class'}{$class};
1775
   }
1776
   if (exists $dsn_codes{'subject'}{$subject}) {
1777
      $msg .= ': ' . $dsn_codes{'subject'}{$subject};
1778
   }
1779
   if (exists $dsn_codes{'complete'}{$dsn}) {
1780
      $msg .= ': ' . $dsn_codes{'complete'}{$dsn};
1781
   }
1782
   elsif (exists $dsn_codes{'detail'}{$detail}) {
1783
      $msg .= ': ' . $dsn_codes{'detail'}{$detail};
1784
   }
1785
 
1786
   #print "get_dsn_msg: $msg\n" if ($msg);
1787
   return $dsn . ': ' . $msg;
1788
}
1789
 
1790
1;
1791
 
1792
#MODULE: ../Logreporters/PolicySPF.pm
1793
package Logreporters::PolicySPF;
1794
 
1795
use 5.008;
1796
use strict;
1797
use re 'taint';
1798
use warnings;
1799
 
1800
BEGIN {
1801
   use Exporter ();
1802
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
1803
   $VERSION = '1.000';
1804
   @ISA = qw(Exporter);
1805
   @EXPORT = qw(&postfix_policy_spf);
1806
}
1807
 
1808
use subs @EXPORT;
1809
 
1810
BEGIN {
1811
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
1812
   import Logreporters::Utils;
1813
   import Logreporters::Reports qw(&inc_unmatched);
1814
}
1815
 
1816
# Handle postfix/policy_spf entries
1817
#
1818
# Mail::SPF::Result
1819
#   Pass      the SPF record designates the host to be allowed to send accept
1820
#   Fail      the SPF record has designated the host as NOT being allowed to send  reject
1821
#   SoftFail  the SPF record has designated the host as NOT being allowed to send but is in transition  accept but mark
1822
#   Neutral   the SPF record specifies explicitly that nothing can be said about validity   accept
1823
#   None      the domain does not have an SPF record or the SPF record does not evaluate to a result accept
1824
#   PermError a permanent error has occured (eg. badly formatted SPF record) unspecified
1825
#   TempError a transient error has occured accept or reject
1826
 
1827
sub postfix_policy_spf($) {
1828
   my $line = shift;
1829
 
1830
   if (
1831
        $line =~ /^Attribute: / or
1832
        # handler sender_policy_framework: is decisive.
1833
        $line =~ /^handler [^:]+/ or
1834
        # decided action=REJECT Please see http://www.openspf.org/why.html?sender=jrzjcez%40telecomitalia.it&ip=81.178.62.236&receiver=protegate1.zmi.at
1835
        $line =~ /^decided action=/ or
1836
 
1837
        # pypolicyd-spf-0.7.1
1838
        #
1839
        # Read line: "request=smtpd_access_policy"
1840
        # Found the end of entry
1841
        # Config: {'Mail_From_reject': 'Fail', 'PermError_reject': 'False', 'HELO_reject': 'SPF_Not_Pass', 'defaultSeedOnly': 1, 'debugLevel': 4, 'skip_addresses': '127.0.0.0/8,::ffff:127.0.0.0//104,::1//128', 'TempError_Defer': 'False'}
1842
        # spfcheck: pyspf result: "['Pass', 'sender SPF authorized', 'helo']"
1843
        # ERROR: Could not match line "#helo pass and mfrom none"
1844
        # Traceback (most recent call last):
1845
        #   File "/usr/local/bin/policyd-spf", line 405, in <module>
1846
        #     line = sys.stdin.readline()
1847
        # KeyboardInterrupt
1848
        $line =~ /^Read line: "/ or
1849
        $line =~ /^Found the end of entry$/ or
1850
        $line =~ /^Config: {/ or
1851
        $line =~ /^spfcheck: pyspf result/ or
1852
        $line =~ /^Starting$/ or
1853
        $line =~ /^Normal exit$/ or
1854
        $line =~ /^ERROR: Could not match line/ or
1855
        $line =~ /^Traceback / or
1856
        $line =~ /^KeyboardInterrupt/ or
1857
        $line =~ /^\s\s+/
1858
      )
1859
   {
1860
      #print "IGNORING...\n\tORIG: $::OrigLine\n";
1861
      return
1862
   }
1863
 
1864
   # Keep policy-spf warnings in its section
1865
   if (my ($warn,$msg) = $line =~ /^warning: ([^:]+): (.*)$/) {
1866
      #TDspf warning: ignoring garbage: # No SPF
1867
 
1868
      $msg =~ s/^# ?//;
1869
      $Totals{'policyspf'}++;
1870
      $Counts{'policyspf'}{'*Warning'}{ucfirst $warn}{$msg}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
1871
      return;
1872
   }
1873
 
1874
   # pypolicyd-spf-0.7.1
1875
 
1876
   # Fail;      identity=helo;     client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1877
   # Fail;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1878
   # Neutral;   identity=helo;     client-ip=192.168.0.3; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1879
   # None;      identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1880
   # None;      identity=helo;     client-ip=192.168.0.5; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1881
   # None;      identity=mailfrom; client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1882
   # None;      identity=mailfrom; client-ip=192.168.0.2; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1883
   # Pass;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
1884
   # Permerror; identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
1885
   # Softfail;  identity=mailfrom; client-ip=192.168.0.6; helo=example.com; envelope-from=f@example.com; receiver=yahl@example.org
1886
   if ($line =~ /^(Pass|Fail|None|Neutral|Permerror|Softfail|Temperror); (.*)$/) {
1887
         my $result = $1;
1888
         my %params = $2 =~ /([-\w]+)=([^;]+)/g;
1889
         #$params{'s'} = '*unknown' unless $params{'s'};
1890
         $Totals{'policyspf'}++;
1891
         if ($Logreporters::TreeData::Collecting{'policyspf'}) {
1892
            my ($id) = $params{'identity'};
1893
            $id =~ s/mailfrom/envelope-from/;
1894
 
1895
            $Counts{'policyspf'}{'Policy Action'}{"SPF: $result"}{join(': ',$params{'identity'},$params{$id})}{$params{'client-ip'}}{$params{'receiver'}}++;
1896
         }
1897
         return;
1898
   }
1899
   elsif ($line =~ /^ERROR /) {
1900
      $line =~ s/^ERROR //;
1901
      $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
1902
      $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
1903
      return;
1904
   }
1905
 
1906
   # Strip QID if it exists, and trailing ": ", leaving just the message.
1907
   $line =~ s/^(?:$Logreporters::re_QID|): //;
1908
 
1909
   # other ignored
1910
   if (
1911
        $line =~ /^SPF \S+ \(.+?\): .*$/ or
1912
        $line =~ /^Mail From/ or
1913
        $line =~ /^:HELO check failed/ or     # log entry has no space after :
1914
        $line =~ /^testing:/
1915
      )
1916
   {
1917
        #TDspf testing: stripped sender=jrzjcez@telecomitalia.it, stripped rcpt=hengstberger@adv.at
1918
        # postfix-policyd-spf-perl-2.007
1919
        #TDspf SPF pass (Mechanism 'ip4:10.0.0.2/22' matched): Envelope-from: foo@example.com
1920
        #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): Envelope-from: anyone@sample.net
1921
        #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): HELO/EHLO (Null Sender): mailout2.example.com
1922
        #TDspf SPF fail (Mechanism '-all' matched): HELO/EHLO: mailout1.example.com
1923
        #TDspf SPF none (No applicable sender policy available): Envelope-from: efrom@example.com
1924
        #TDspf SPF permerror (Included domain 'example.com' has no applicable sender policy): Envelope-from: efrom@example.com
1925
        #TDspf SPF permerror (Maximum DNS-interactive terms limit (10) exceeded): Envelope-from: efrom@example.com
1926
        #TDspf Mail From (sender) check failed - Mail::SPF->new(10.0.0.1, , test.DNSreport.com) failed: 'identity' option must not be empty
1927
        #TDspf HELO check failed - Mail::SPF->new(, , ) failed: Missing required 'identity' option
1928
 
1929
        #TDspf SPF not applicable to localhost connection - skipped check
1930
 
1931
        #print "IGNORING...\n\tLINE: $line\n\tORIG: \"$Logreporters::Reports::origline\"\n";
1932
        return;
1933
   }
1934
 
1935
   my ($action, $domain, $ip, $message, $mechanism);
1936
   ($domain, $ip, $message, $mechanism) = ('*unknown', '*unknown', '', '*unavailable');
1937
   #print "LINE: '$line'\n";
1938
 
1939
   # postfix-policyd-spf-perl: http://www.openspf.org/Software
1940
   if ($line =~ /^Policy action=(.*)$/) {
1941
      $line = $1;
1942
 
1943
      #: Policy action=DUNNO
1944
      return if $line =~ /^DUNNO/;
1945
      # Policy action=PREPEND X-Comment: SPF not applicable to localhost connection - skipped check
1946
      return if $line =~ /^PREPEND X-Comment: SPF not applicable to localhost connection - skipped check$/;
1947
 
1948
      #print "LINE: '$line'\n";
1949
      if ($line =~ /^DEFER_IF_PERMIT SPF-Result=\[?(.*?)\]?: (.*) of .*$/) {
1950
         my ($lookup,$message) = ($1,$2);
1951
         # Policy action=DEFER_IF_PERMIT SPF-Result=[10.0.0.1]: Time-out on DNS 'SPF' lookup of '[10.0.0.1]'
1952
         # Policy action=DEFER_IF_PERMIT SPF-Result=example.com: 'SERVFAIL' error on DNS 'SPF' lookup of 'example.com'
1953
         $message =~ s/^(.*?) on (DNS SPF lookup)$/$2: $1/;
1954
         $message =~ s/'//g;
1955
         $Totals{'policyspf'}++;
1956
         $Counts{'policyspf'}{'Policy Action'}{'defer_if_permit'}{$message}{$lookup}{$END_KEY}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1957
         return;
1958
      }
1959
 
1960
      if ($line =~ /^550 Please see http:\/\/www\.openspf\.org\/Why\?(.*)$/) {
1961
         # Policy action=550 Please see http://www.openspf.org/Why?s=mfrom&id=from%40example.com&ip=10.0.0.1&r=example.net
1962
         # Policy action=550 Please see http://www.openspf.org/Why?s=helo;id=mailout03.example.com;ip=192.168.0.1;r=mx1.example.net
1963
         # Policy action=550 Please see http://www.openspf.org/Why?id=someone%40example.com&ip=10.0.0.1&receiver=vps.example.net
1964
 
1965
         my %params;
1966
         for (split /[&;]/, $1) {
1967
            my ($id,$val) = split /=/, $_;
1968
            $params{$id} = $val;
1969
         }
1970
         $params{'id'} =~ s/^.*%40//;
1971
         $params{'s'} = '*unknown' unless $params{'s'};
1972
         #print "Please see...:\n\tMessage: $message\n\tIP: $ip\n\tDomain: $domain\n";
1973
         $Totals{'policyspf'}++;
1974
         $Counts{'policyspf'}{'Policy Action'}{'550 reject'}{'See http://www.openspf.org/Why?...'}{$params{'s'}}{$params{'ip'}}{$params{'id'}}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
1975
         return;
1976
      }
1977
 
1978
      if ($line =~ /^[^:]+: (none|pass|fail|softfail|neutral|permerror|temperror) \((.+?)\) receiver=[^;]+(?:; (.*))?$/) {
1979
         # iehc is identity, envelope-from, helo, client-ip
1980
         my ($result,$message,$iehc,$subject) = ($1,$2,$3,undef);
1981
         my %params = ();
1982
         #TDspf Policy action=PREPEND Received-SPF: pass (bounces.example.com ... _spf.example.com: 10.0.0.1 is authorized to use 'from@bounces.example.com' in 'mfrom' identity (mechanism 'ip4:10.0.0.1/24' matched)) receiver=sample.net; identity=mfrom; envelope-from="from@bounces.example.com"; helo=out.example.com; client-ip=10.0.0.1
1983
 
1984
         # Note: "identity=mailfrom" new in Mail::SPF version 2.006 Aug. 17
1985
         #TDspf Policy action=PREPEND Received-SPF: pass (example.com: 10.0.0.1 is authorized to use 'from@example.com' in 'mfrom' identity (mechanism 'ip4:10.0.0.0/24' matched)) receiver=mx.example.com; identity=mailfrom; envelope-from="from@example.com"; helo=example.com; client-ip=10.0.0.1
1986
 
1987
         #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=sample.net; identity=mfrom; envelope-from="f@example.com"; helo=example.com; client-ip=10.0.0.1
1988
 
1989
         #TDspf Policy action=PREPEND Received-SPF: neutral (example.com: Domain does not state whether sender is authorized to use 'f@example.com' in 'mfrom' identity (mechanism '?all' matched)) receiver=sample.net identity=mfrom; envelope-from="f@example.com"; helo="[10.0.0.1]"; client-ip=192.168.0.1
1990
 
1991
         #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=sample.net; identity=helo; helo=example.com; client-ip=192.168.0.1
1992
         #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=mx1.example
1993
 
1994
         #print "LINE: $iehc\n";
1995
         if ($iehc) {
1996
            %params = $iehc =~ /([-\w]+)=([^;]+)/g;
1997
 
1998
            if (exists $params{'identity'}) {
1999
               $params{'identity'} =~ s/identity=//;
2000
               if ($params{'identity'} eq 'mfrom' or $params{'identity'} eq 'mailfrom') {
2001
                  $params{'identity'} = 'mail from';
2002
               }
2003
               $params{'identity'} = uc $params{'identity'};
2004
            }
2005
            $params{'envelope-from'} =~ s/"//g        if exists $params{'envelope-from'};
2006
            #($helo    = $params{'helo'}) =~ s/"//g   if exists $params{'helo'};
2007
            $ip       = $params{'client-ip'}          if exists $params{'client-ip'};
2008
         }
2009
 
2010
         $message =~ s/^([^:]+): // and $subject = $1;
2011
 
2012
         if ($message =~ /^No applicable sender policy available$/) {
2013
            $message = 'No sender policy';
2014
         }
2015
         elsif ($message =~ s/^(Junk encountered in mechanism) '(.*?)'/$1/) {
2016
            #TDspf Policy action=PREPEND Received-SPF: permerror (example.com: Junk encountered in mechanism 'a:10.0.0.1') receiver=example.net; identity=mfrom; envelope-from="ef@example.com"; helo=h; client-ip=10.0.0.2
2017
            $ip = formathost ($ip, 'mech: ' . $2);
2018
         }
2019
         elsif ($message =~ s/^(Included domain) '(.*?)' (has no .*)$/$1 $3/) {
2020
            #TDspf Policy action=PREPEND Received-SPF: permerror (example.com: Included domain 's.example.net' has no applicable sender policy) receiver=x.sample.com; identity=mfrom; envelope-from="ef@example.com"; helo=example.net; client-ip=10.0.0.2
2021
            $subject .= "  (included: $2)";
2022
         }
2023
         elsif ($message =~ /^Domain does not state whether sender is authorized to use '.*?' in '\S+' identity \(mechanism '(.+?)' matched\)$/) {
2024
            # Domain does not state whether sender is authorized to use 'returns@example.com' in 'mfrom' identity                                            (mechanism '?all' matched))
2025
            ($mechanism,$message) = ($1,'Domain does not state if sender authorized to use');
2026
         }
2027
         elsif ($message =~ /^(\S+) is (not )?authorized( by default)? to use '.*?' in '\S+' identity(?:, however domain is not currently prepared for false failures)? \(mechanism '(.+?)' matched\)$/) {
2028
            # Sender is not authorized by default to use 'from@example.com' in 'mfrom' identity, however domain is not currently prepared for false failures (mechanism '~all' matched))
2029
            # 192.168.1.10 is     authorized by default to use 'from@example.com' in 'mfrom' identity                                                              (mechanism 'all' matched))
2030
            $message = join (' ',
2031
                             $1 eq 'Sender' ? 'Sender' : 'IP',   # canonicalize IP address
2032
                             $2 ? 'not authorized' : 'authorized',
2033
                             $3 ? 'by default to use' : 'to use',
2034
                            );
2035
            $mechanism = $4;
2036
         }
2037
         elsif ($message =~ /^Maximum DNS-interactive terms limit \S+ exceeded$/) {
2038
            $message = 'Maximum DNS-interactive terms limit exceeded';
2039
         }
2040
         elsif ($message =~ /^Invalid IPv4 prefix length encountered in (.*)$/) {
2041
            $subject .= " (invalid: $1)";
2042
            $message = 'Invalid IPv4 prefix length encountered';
2043
         }
2044
 
2045
         #print "Result: $result, Identity: $params{'identity'}, Mech: $mechanism, Subject: $subject, IP: $ip\n";
2046
         $Totals{'policyspf'}++;
2047
         if ($Logreporters::TreeData::Collecting{'policyspf'}) {
2048
            $message = join (' ', $message, $params{'identity'})  if exists $params{'identity'};
2049
            $Counts{'policyspf'}{'Policy Action'}{"SPF $result"}{$message}{'mech: ' .$mechanism}{$subject}{$ip}++
2050
         }
2051
         return;
2052
      }
2053
 
2054
      inc_unmatched('postfix_policy_spf(2)');
2055
      return;
2056
   }
2057
 
2058
=pod
2059
   Mail::SPF::Query
2060
   libmail-spf-query-perl 1:1.999
2061
 
2062
    XXX incomplete
2063
 
2064
    Some possible smtp_comment results:
2065
     pass         "localhost is always allowed."
2066
     none         "SPF", "domain of sender $query->{sender} does not designate mailers
2067
     unknown      $explanation, "domain of sender $query->{sender} does not exist"
2068
                  $query->{spf_error_explanation}, $query->is_looping
2069
                  $query->{spf_error_explanation}, $directive_set->{hard_syntax_error}
2070
                  $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}"
2071
     error        $query->{spf_error_explanation}, $query->{error}
2072
 
2073
     $result      $explanation, $comment, $query->{directive_set}->{orig_txt}
2074
 
2075
    Possible header_comment results:
2076
     pass         "$query->{spf_source} designates $ip as permitted sender"
2077
     fail         "$query->{spf_source} does not designate $ip as permitted sender"
2078
     softfail     "transitioning $query->{spf_source} does not designate $ip as permitted sender"
2079
     /^unknown /  "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
2080
     unknown      "error in processing during lookup of $query->{sender}"
2081
     neutral      "$ip is neither permitted nor denied by domain of $query->{sender}"
2082
     error        "encountered temporary error during SPF processing of $query->{spf_source}"
2083
     none         "$query->{spf_source} does not designate permitted sender hosts"
2084
                  "could not perform SPF query for $query->{spf_source}" );
2085
=cut
2086
 
2087
   #TDspf 39053DC: SPF none: smtp_comment=SPF: domain of sender user@example.com does not designate mailers, header_comment=sample.net: domain of user@example.com does not designate permitted sender hosts
2088
   #TDspf : SPF none: smtp_comment=SPF: domain of sender user@example.com does not designate mailers, header_comment=sample.net: domain of user@example.com does not designate permitted sender hosts
2089
   #TDspf : SPF pass: smtp_comment=Please see http://www.openspf.org/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=sample.net: example.com MX mail.example.com A 10.0.0.1, header_comment=example.com: domain of user@example.com designates 10.0.0.1 as permitted sender
2090
   #TDspf : SPF fail: smtp_comment=Please see http://www.openspf.org/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=sample.net, header_comment=sample.net: domain of user@example.com does not designate 10.0.0.1 as permitted sender
2091
   #TDspf : : SPF none: smtp_comment=SPF: domain of sender does not designate mailers, header_comment=mx1.example.com: domain of does not designate permitted sender hosts
2092
 
2093
   if (my ($result, $reply) = ($line =~ /^(SPF [^:]+): (.*)$/)) {
2094
 
2095
      #print "result: $result\n\treply: $reply\n\tORIG: \"$Logreporters::Reports::origline\"\n";
2096
 
2097
      if ($reply =~ /^(?:smtp_comment=)(.*)$/) {
2098
         $reply = $1;
2099
 
2100
         # SPF none
2101
         if ($reply =~ /^SPF: domain of sender (?:(?:[^@]+@)?(\S+) )?does not designate mailers/) {
2102
            $domain = $1 ? $1 : '*unknown';
2103
            #print "result: $result: domain: $domain\n";
2104
         }
2105
         elsif ($reply =~ /^Please see http:\/\/[^\/]+\/why\.html\?sender=(?:.+%40)?([^&]+)&ip=([^&]+)/) {
2106
            ($domain,$ip) = ($1,$2);
2107
            #print "result: $result: domain: $domain, IP: $ip\n";
2108
         }
2109
 
2110
         # SPF unknown
2111
         elsif ($reply =~ /^SPF record error: ([^,]+), .*: error in processing during lookup of (?:[^@]+\@)?(\S+)/) {
2112
            ($message, $domain) = ($1, $2);
2113
            #print "result: $result: domain: $domain, Problem: $message\n";
2114
         }
2115
         elsif ($reply =~ /^SPF record error: ([^,]+), .*: encountered unrecognized mechanism during SPF processing of domain (?:[^@]+\@)?(\S+)/) {
2116
            ($message, $domain) = ($1,$2);
2117
            #print "result: \"$result\": domain: $domain, Problem: $message\n";
2118
            $result = "SPF permerror"   if ($result =~ /SPF unknown mx-all/);
2119
         }
2120
         else {
2121
            inc_unmatched('postfix_policy_spf(3)');
2122
            return;
2123
         }
2124
      }
2125
      else {
2126
         inc_unmatched('postfix_policy_spf(4)');
2127
         return;
2128
      }
2129
 
2130
      $Totals{'policyspf'}++;
2131
      if ($message) {
2132
         $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$message}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2133
      }
2134
      else {
2135
         $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
2136
      }
2137
      return;
2138
   }
2139
 
2140
 
2141
   inc_unmatched('postfix_policy_spf(5)');
2142
}
2143
 
2144
1;
2145
 
2146
#MODULE: ../Logreporters/Postfwd.pm
2147
package Logreporters::Postfwd;
2148
 
2149
use 5.008;
2150
use strict;
2151
use re 'taint';
2152
use warnings;
2153
 
2154
BEGIN {
2155
   use Exporter ();
2156
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2157
   $VERSION = '1.000';
2158
   @ISA = qw(Exporter);
2159
   @EXPORT = qw(&postfix_postfwd);
2160
}
2161
 
2162
use subs @EXPORT;
2163
 
2164
BEGIN {
2165
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2166
   import Logreporters::Utils;
2167
   import Logreporters::Reports qw(&inc_unmatched);
2168
}
2169
 
2170
# postfwd: http://postfwd.org/
2171
#
2172
#
2173
sub postfix_postfwd($) {
2174
   my $line = shift;
2175
 
2176
   return if (
2177
      #TDpfw [STATS] Counters: 213000 seconds uptime, 39 rules
2178
      #TDpfw [LOGS info]: compare rbl: "example.com[10.1.0.7]"  ->  "localrbl.local"
2179
      #TDpfw [DNSBL] object 10.0.0.1 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2180
      $line =~ /^\[STATS\] / or
2181
      $line =~ /^\[DNSBL\] / or
2182
      $line =~ /^\[LOGS info\]/ or
2183
      $line =~ /^Process Backgrounded/ or
2184
      $line =~ /^Setting [ug]id to/ or
2185
      $line =~ /^Binding to TCP port/ or
2186
      $line =~ /^terminating\.\.\./ or
2187
      $line =~ /^Setting status interval to \S+ seconds/ or
2188
      $line =~ /^postfwd .+ ready for input$/ or
2189
      $line =~ /postfwd .+ (?:starting|terminated)/
2190
   );
2191
 
2192
   my ($type,$rule,$id,$action,$host,$hostip,$recipient);
2193
 
2194
   if ($line =~ /^\[(RULES|CACHE)\] rule=(\d+), id=([^,]+), client=([^[]+)\[([^]]+)\], sender=.*?, recipient=<(.*?)>,.*? action=(.*)$/) {
2195
      #TDpfw [RULES] rule=0, id=OK_DNSWL, client=example.com[10.0.0.1], sender=<f@example.com>, recipient=<to@sample.net>, helo=<example.com>, proto=ESMTP, state=RCPT, delay=0s, hits=OK_DNSWL, action=DUNNO
2196
      #TDpfw [CACHE] rule=14, id=GREY_NODNS, client=unknown[192.168.0.1], sender=<f@example.net>, recipient=<to@sample.com>, helo=<example.com>, proto=ESMTP, state=RCPT, delay=0s, hits=SET_NODNS;EVAL_DNSBLS;EVAL_RHSBLS;GREY_NODNS, action=greylist
2197
      ($type,$rule,$id,$host,$hostip,$recipient,$action) = ($1,$2,$3,$4,$5,$6,$7);
2198
      $recipient  = '*unknown' if (not defined $recipient);
2199
      $Counts{'postfwd'}{"Rule $rule"}{$id}{$action}{$type}{$recipient}{formathost($hostip,$host)}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2200
   }
2201
   elsif (($line =~ /Can't connect to TCP port/) or
2202
          ($line =~ /Pid_file already exists for running process/)
2203
         )
2204
    {
2205
      $line =~ s/^[-\d\/:]+ //; # strip leading date/time stamps 2009/07/18-20:09:49
2206
      $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
2207
      $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
2208
      return;
2209
   }
2210
 
2211
   # ignoring [DNSBL] lines
2212
   #elsif ($line =~ /^\[DNSBL\] object (\S+) listed on (\S+) \(answer: ([^,]+), .*\)$/) {
2213
   #   #TDpfw [DNSBL] object 10.0.0.60 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
2214
   #   ($type,$rbl) = split (/:/, $2);
2215
   #   $Counts{'postfwd'}{"DNSBL: $type"}{$rbl}{$1}{$3}{''}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
2216
   #}
2217
   else {
2218
      inc_unmatched('postfwd');
2219
      return;
2220
   }
2221
 
2222
   $Totals{'postfwd'}++;
2223
}
2224
 
2225
1;
2226
 
2227
#MODULE: ../Logreporters/Postgrey.pm
2228
package Logreporters::Postgrey;
2229
 
2230
use 5.008;
2231
use strict;
2232
use re 'taint';
2233
use warnings;
2234
 
2235
my (%pgDelays,%pgDelayso);
2236
 
2237
BEGIN {
2238
   use Exporter ();
2239
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2240
   $VERSION = '1.000';
2241
   @ISA = qw(Exporter);
2242
   @EXPORT = qw(&postfix_postgrey &print_postgrey_reports);
2243
}
2244
 
2245
use subs @EXPORT;
2246
 
2247
BEGIN {
2248
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
2249
   import Logreporters::Utils;
2250
   import Logreporters::Config qw(%Opts);
2251
   import Logreporters::Reports qw(&inc_unmatched &print_percentiles_report2);
2252
}
2253
 
2254
# postgrey: http://postgrey.schweikert.ch/
2255
#
2256
# Triplet: (client IP, envelope sender, envelope recipient address)
2257
#
2258
sub postfix_postgrey($) {
2259
   my $line = shift;
2260
 
2261
   return if (
2262
      #TDpg cleaning up old logs...
2263
      #TDpg cleaning up old entries...
2264
      #TDpg cleaning clients database finished. before: 207, after: 207
2265
      #TDpg cleaning main database finished. before: 3800, after: 2539
2266
      #TDpg delayed 603 seconds: client=10.0.example.com, from=anyone@sample.net, to=joe@example.com
2267
 
2268
      #TDpg Setting uid to "504"
2269
      #TDpg Setting gid to "1002 1002"
2270
      #TDpg Process Backgrounded
2271
      #TDpg 2008/03/08-15:54:49 postgrey (type Net::Server::Multiplex) starting! pid(21961)
2272
      #TDpg Binding to TCP port 10023 on host 127.0.0.1
2273
      #TDpg 2007/01/25-14:58:24 Server closing!
2274
      #TDpg Couldn't unlink "/var/run/postgrey.pid" [Permission denied]
2275
      #TDpg ignoring garbage: <help>
2276
      #TDpg unrecognized request type: ''
2277
      #TDpg rm /var/spool/postfix/postgrey/log.0000000002
2278
      #TDpg 2007/01/25-14:48:00 Pid_file already exists for running process (4775)... aborting    at line 232 in file /usr/lib/perl5/vendor_perl/5.8.7/Net/Server.pm
2279
 
2280
 
2281
      $line =~ /^cleaning / or
2282
      $line =~ /^delayed / or
2283
      $line =~ /^cleaning / or
2284
      $line =~ /^Setting [ug]id/ or
2285
      $line =~ /^Process Backgrounded/ or
2286
      $line =~ /^Binding to / or
2287
      $line =~ /^Couldn't unlink / or
2288
      $line =~ /^ignoring garbage: / or
2289
      $line =~ /^unrecognized request type/ or
2290
      $line =~ /^rm / or
2291
      # unanchored last
2292
      $line =~ /Pid_file already exists/ or
2293
      $line =~ /postgrey .* starting!/ or
2294
      $line =~ /Server closing!/
2295
   );
2296
 
2297
   my ($action,$reason,$delay,$host,$ip,$sender,$recip);
2298
 
2299
   if ($line =~ /^(?:$Logreporters::re_QID: )?action=(.*?), reason=(.*?)(?:, delay=(\d+))?, client_name=(.*?), client_address=(.*?)(?:, sender=(.*?))?(?:, +recipient=(.*))?$/o) {
2300
      #TDpg  action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2301
      #TDpgQ action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com
2302
      #TDpgQ action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2303
      #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
2304
      #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2305
      #TDpg  action=pass,     reason=triplet found, delay=99, client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
2306
      ($action,$reason,$delay,$host,$ip,$sender,$recip) = ($1,$2,$3,$4,$5,$6,$7);
2307
      $reason =~ s/^(early-retry) \(.* missing\)$/$1/;
2308
      $recip  = '*unknown' if (not defined $recip);
2309
      $sender = ''         if (not defined $sender);
2310
 
2311
      $Totals{'postgrey'}++;
2312
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2313
         $Counts{'postgrey'}{"\u$action"}{"\u$reason"}{formathost($ip,$host)}{$recip}{$sender}++;
2314
 
2315
         if (defined $delay and $Logreporters::TreeData::Collecting{'postgrey_delays'}) {
2316
            $pgDelays{'1: Total'}{$delay}++;
2317
 
2318
            push @{$pgDelayso{'Postgrey'}}, $delay
2319
         }
2320
      }
2321
   }
2322
   elsif ($line =~ /^whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2323
      #TDpg: whitelisted: example.com[10.0.0.1]
2324
      $Totals{'postgrey'}++;
2325
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2326
         $Counts{'postgrey'}{'Whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2327
      }
2328
   }
2329
   elsif ($line =~ /^tarpit whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
2330
      #TDpg: tarpit whitelisted: example.com[10.0.0.1]
2331
      $Totals{'postgrey'}++;
2332
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
2333
         $Counts{'postgrey'}{'Tarpit whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
2334
      }
2335
   }
2336
   else {
2337
      inc_unmatched('postgrey');
2338
   }
2339
 
2340
   return;
2341
}
2342
 
2343
sub print_postgrey_reports() {
2344
   #print STDERR "pgDelays     memory usage: ", commify(Devel::Size::total_size(\%pgDelays)), "\n";
2345
 
2346
   if ($Opts{'postgrey_delays'}) {
2347
      my @table;
2348
      for (sort keys %pgDelays) {
2349
         # anon array ref: label, array ref of $Delay{key}
2350
         push @table, [ substr($_,3), $pgDelays{$_} ];
2351
      }
2352
      if (@table) {
2353
         print_percentiles_report2(\@table, "Postgrey Delays Percentiles", $Opts{'postgrey_delays_percentiles'});
2354
      }
2355
   }
2356
}
2357
 
2358
1;
2359
 
2360
#MODULE: ../Logreporters/PolicydWeight.pm
2361
package Logreporters::PolicydWeight;
2362
 
2363
use 5.008;
2364
use strict;
2365
use re 'taint';
2366
use warnings;
2367
 
2368
BEGIN {
2369
   use Exporter ();
2370
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
2371
   $VERSION = '1.000';
2372
   @ISA = qw(Exporter);
2373
   @EXPORT = qw(&postfix_policydweight);
2374
}
2375
 
2376
use subs @EXPORT;
2377
 
2378
BEGIN {
2379
   import Logreporters::Reports qw(&inc_unmatched);
2380
   import Logreporters::TreeData qw(%Totals %Counts);
2381
   import Logreporters::Utils;
2382
}
2383
 
2384
# Handle postfix/policydweight entries
2385
#
2386
sub postfix_policydweight($) {
2387
   my $line = shift;
2388
   my ($r1, $code, $reason, $reason2);
2389
 
2390
   if (
2391
        $line =~ /^weighted check/ or
2392
        $line =~ /^policyd-weight .* started and daemonized/ or
2393
        $line =~ /^(cache|child|master): / or
2394
        $line =~ /^cache (?:spawned|killed)/ or
2395
        $line =~ /^child \d+ exited/ or
2396
        $line =~ /^Daemon terminated/ or
2397
        $line =~ /^Daemon terminated/
2398
      )
2399
   {
2400
      #print "$OrigLine\n";
2401
      return;
2402
   }
2403
 
2404
   if ($line =~ s/^decided action=//) {
2405
      $line =~ s/; delay: \d+s$//;     # ignore, eg.: "delay: 3s"
2406
      #print "....\n\tLINE: $line\n\tORIG: '$Logreporters::Reports::origline'\n";
2407
      if (($code,$r1) = ($line =~ /^(\d+)\s+(.*)$/ )) {
2408
         my @problems = ();
2409
         for (split /; */, $r1) {
2410
 
2411
            if (/^Mail appeared to be SPAM or forged\. Ask your Mail\/DNS-Administrator to correct HELO and DNS MX settings or to get removed from DNSBLs/ ) {
2412
               push @problems, 'spam/forged: bad DNS/hit DNSRBLs';
2413
            }
2414
            elsif (/^Your MTA is listed in too many DNSBLs/) {
2415
               push @problems, 'too many DNSBLs';
2416
            }
2417
            elsif (/^temporarily blocked because of previous errors - retrying too fast\. penalty: \d+ seconds x \d+ retries\./) {
2418
               push @problems, 'temp blocked: retrying too fast';
2419
            }
2420
            elsif (/^Please use DynDNS/) {
2421
               push @problems, 'use DynDNS';
2422
            }
2423
            elsif (/^please relay via your ISP \([^)]+\)/) {
2424
               push @problems, 'use ISP\'s relay';
2425
            }
2426
            elsif (/^in (.*)/) {
2427
               push @problems, $1;
2428
            }
2429
            elsif (m#^check http://rbls\.org/\?q=#) {
2430
               push @problems, 'see http://rbls.org';
2431
            }
2432
            elsif (/^MTA helo: .* \(helo\/hostname mismatch\)/) {
2433
               push @problems, 'helo/hostname mismatch';
2434
            }
2435
            elsif (/^No DNS entries for your MTA, HELO and Domain\. Contact YOUR administrator\s+/) {
2436
               push @problems, 'no DNS entries';
2437
            }
2438
            else {
2439
               push @problems, $_;
2440
            }
2441
         }
2442
 
2443
         $reason = $code; $reason2 = join (', ', @problems);
2444
      }
2445
      elsif ($line =~ s/^DUNNO\s+//) {
2446
         #decided action=DUNNO multirecipient-mail - already accepted by previous query; delay: 0s
2447
         $reason = 'DUNNO'; $reason2 = $line;
2448
      }
2449
      elsif ($line =~ s/^check_greylist//) {
2450
         #decided action=check_greylist; delay: 16s
2451
         $reason = 'Check greylist'; $reason2 = $line;
2452
      }
2453
      elsif ($line =~ s/^PREPEND X-policyd-weight:\s+//) {
2454
         #decided action=PREPEND X-policyd-weight: using cached result; rate: -7.6; delay: 0s
2455
         if ($line =~ /(using cached result); rate:/) {
2456
            $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = "\u$1";
2457
         }
2458
         else {
2459
            #decided action=PREPEND X-policyd-weight:  NOT_IN_SBL_XBL_SPAMHAUS=-1.5 P0F_LINUX=0 <client=10.0.0.1> <helo=example.com> <from=f@example.com> <to=t@sample.net>, rate: -7.6; delay: 2s
2460
            $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = 'Varies';
2461
         }
2462
      }
2463
      else {
2464
         return;
2465
      }
2466
   }
2467
   elsif ($line =~ /^err/) {
2468
      # coerrce policyd-weight err's into general warnings
2469
      $Totals{'startuperror'}++;
2470
      $Counts{'startuperror'}{'Service: policyd-weight'}{$line}++    if ($Logreporters::TreeData::Collecting{'startuperror'});
2471
      return;
2472
   }
2473
   else {
2474
      inc_unmatched('policydweight');
2475
      return;
2476
   }
2477
 
2478
   $Totals{'policydweight'}++;
2479
   $Counts{'policydweight'}{$reason}{$reason2}++   if ($Logreporters::TreeData::Collecting{'policydweight'});
2480
}
2481
 
2482
1;
2483
 
2484
 
2485
package Logreporters;
2486
 
2487
BEGIN {
2488
   import Logreporters::Utils;
2489
   import Logreporters::Config;
2490
   import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree $END_KEY);
2491
   import Logreporters::RegEx;
2492
   import Logreporters::Reports;
2493
   import Logreporters::RFC3463;
2494
   import Logreporters::PolicySPF;
2495
   import Logreporters::Postfwd;
2496
   import Logreporters::Postgrey;
2497
   import Logreporters::PolicydWeight;
2498
}
2499
use 5.008;
2500
use strict;
2501
use warnings;
2502
no warnings "uninitialized";
2503
use re 'taint';
2504
 
2505
use File::Basename;
2506
our $progname =  fileparse($0);
2507
 
2508
my @supplemental_reports = qw(delays postgrey_delays);
2509
 
2510
# Default values for various options.  These are used
2511
# to reset default values after an option has been
2512
# disabled (via undef'ing its value).  This allows
2513
# a report to be disabled via config file or --nodetail,
2514
# but reenabled via subsequent command line option
2515
my %Defaults = (
2516
   detail                      => 10,                        # report level detail
2517
   max_report_width            => 100,                       # maximum line width for report output
2518
   line_style                  => undef,                     # lines > max_report_width, 0=truncate,1=wrap,2=full
2519
   syslog_name                 => 'postfix',                 # service name (postconf(5), syslog_name)
2520
   sect_vars                   => 0,                         # show section vars in detail report hdrs
2521
   unknown                     => 1,                         # show 'unknown' in address/hostname pairs
2522
   ipaddr_width                => 15,                        # width for printing ip addresses
2523
   long_queue_ids              => 0,                         # enable long queue ids (2.9+)
2524
   delays                      => 1,                         # show message delivery delays report
2525
   delays_percentiles          => '0 25 50 75 90 95 98 100', # percentiles shown in delays report
2526
   reject_reply_patterns       => '5.. 4.. warn',            # reject reply grouping patterns
2527
   postgrey_delays             => 1,                         # show postgrey delays report
2528
   postgrey_delays_percentiles => '0 25 50 75 90 95 98 100', # percentiles shown in postgrey delays report
2529
);
2530
 
2531
my $usage_str = <<"END_USAGE";
2532
Usage: $progname [ ARGUMENTS ] [logfile ...]
2533
   ARGUMENTS can be one or more of options listed below.  Later options
2534
   override earlier ones.  Any argument may be abbreviated to an unambiguous
2535
   length.  Input is read from the named logfile(s), or STDIN.
2536
 
2537
   --debug AREAS                          provide debug output for AREAS
2538
   --help                                 print usage information
2539
   --version                              print program version
2540
 
2541
   --config_file FILE, -f FILE            use alternate configuration file FILE
2542
   --ignore_services PATTERN              ignore postfix/PATTERN services
2543
   --syslog_name PATTERN                  only consider log lines that match
2544
                                          syslog service name PATTERN
2545
 
2546
   --detail LEVEL                         print LEVEL levels of detail
2547
                                          (default: 10)
2548
   --nodetail                             set all detail levels to 0
2549
   --[no]summary                          display the summary section
2550
 
2551
   --ipaddr_width WIDTH                   use WIDTH chars for IP addresses in
2552
                                          address/hostname pairs
2553
   --line_style wrap|full|truncate        disposition of lines > max_report_width
2554
                                          (default: truncate)
2555
   --full                                 same as --line_style=full
2556
   --truncate                             same as --line_style=truncate
2557
   --wrap                                 same as --line_style=wrap
2558
   --max_report_width WIDTH               limit report width to WIDTH chars
2559
                                          (default: 100)
2560
   --limit L=V, -l L=V                    set level limiter L with value V
2561
   --[no]long_queue_ids                   use long queue ids
2562
   --[no]unknown                          show the 'unknown' hostname in
2563
                                          formatted address/hostnames pairs
2564
   --[no]sect_vars                        [do not] show config file var/cmd line
2565
                                          option names in section titles
2566
 
2567
   --recipient_delimiter C                split delivery addresses using
2568
                                          recipient delimiter char C
2569
   --reject_reply_patterns "R1 [R2 ...]"  set reject reply patterns used in
2570
                                          to group rejects to R1, [R2 ...],
2571
                                          where patterns are [45][.0-9][.0-9]
2572
                                          or "Warn" (default: 5.. 4.. Warn)
2573
   Supplimental reports
2574
   --[no]delays                           [do not] show msg delays percentiles report
2575
   --delays_percentiles "P1 [P2 ...]"     set delays report percentiles to
2576
                                          P1 [P2 ...] (range: 0...100)
2577
   --[no]postgrey_delays                  [do not] show postgrey delays percentiles
2578
                                          report
2579
   --postgrey_delays_percentiles "P1 [P2 ...]"
2580
                                          set postgrey delays report percentiles to
2581
                                          P1 [P2 ...] (range: 0...100)
2582
END_USAGE
2583
 
2584
my @RejectPats;      # pattern list used to match against reject replys
2585
my @RejectKeys;      # 1-to-1 with RejectPats, but with 'x' replacing '.' (for report output)
2586
my (%DeferredByQid, %SizeByQid, %AcceptedByQid, %Delays);
2587
 
2588
# local prototypes
2589
sub usage;
2590
sub init_getopts_table;
2591
sub init_defaults;
2592
sub build_sect_table;
2593
sub postfix_bounce;
2594
sub postfix_cleanup;
2595
sub postfix_panic;
2596
sub postfix_fatal;
2597
sub postfix_error;
2598
sub postfix_warning;
2599
sub postfix_script;
2600
sub postfix_postsuper;
2601
sub process_delivery_attempt;
2602
sub cleanhostreply;
2603
sub strip_ftph;
2604
sub get_reject_key;
2605
sub expand_bare_reject_limiters;
2606
sub create_ignore_list;
2607
sub in_ignore_list;
2608
sub header_body_checks;
2609
sub milter_common;
2610
 
2611
# lines that match any RE in this list will be ignored.
2612
# see create_ignore_list();
2613
my @ignore_list = ();
2614
 
2615
# The Sections table drives Summary and Detail reports.  For each entry in the
2616
# table, if there is data avaialable, a line will be output in the Summary report.
2617
# Additionally, a sub-section will be output in the Detail report if both the
2618
# global --detail, and the section's limiter variable, are sufficiently high (a
2619
# non-existent section limiter variable is considered to be sufficiently high).
2620
#
2621
my @Sections = ();
2622
 
2623
# List of reject variants.  See also: "Add reject variants" below, and conf file(s).
2624
my @RejectClasses = qw(
2625
   rejectrelay rejecthelo rejectdata rejectunknownuser rejectrecip rejectsender
2626
   rejectclient rejectunknownclient rejectunknownreverseclient rejectunverifiedclient
2627
   rejectrbl rejectheader rejectbody rejectcontent rejectsize rejectmilter rejectproxy
2628
   rejectinsufficientspace rejectconfigerror rejectverify rejectetrn rejectlookupfailure
2629
);
2630
 
2631
# Dispatch table of the list of supported policy services
2632
# XXX have add-ins register into the dispatch table
2633
my @policy_services = (
2634
   [ qr/^postfwd/,         \&Logreporters::Postfwd::postfix_postfwd ],
2635
   [ qr/^postgrey/,        \&Logreporters::Postgrey::postfix_postgrey ],
2636
   [ qr/^policyd?-spf/,    \&Logreporters::PolicySPF::postfix_policy_spf ],
2637
   [ qr/^policyd-?weight/, \&Logreporters::PolicydWeight::postfix_policydweight ],
2638
);
2639
 
2640
# Initialize main running mode and basic opts
2641
init_run_mode($config_file);
2642
 
2643
# Configure the Getopts options table
2644
init_getopts_table();
2645
 
2646
# Place configuration file/environment variables onto command line
2647
init_cmdline();
2648
 
2649
# Initialize default values
2650
init_defaults();
2651
 
2652
# Process command line arguments, 0=no_permute,no_pass_through
2653
get_options(0);
2654
 
2655
# Build the Section table, after reject_reply_patterns is final
2656
build_sect_table();
2657
 
2658
# Expand bare rejects before generic processing
2659
expand_bare_reject_limiters();
2660
 
2661
# Run through the list of Limiters, setting the limiters in %Opts.
2662
process_limiters(@Sections);
2663
 
2664
# Set collection for any enabled supplemental sections
2665
foreach (@supplemental_reports) {
2666
   $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
2667
}
2668
 
2669
if (! defined $Opts{'line_style'}) {
2670
   # default line style to full if detail >= 11, or truncate otherwise
2671
   $Opts{'line_style'} =
2672
      ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
2673
}
2674
 
2675
# Set the QID RE to capture either pre-2.9 short style or 2.9+ long style.
2676
$re_QID = $Opts{'long_queue_ids'} ? $re_QID_l : $re_QID_s;
2677
 
2678
# Create the list of REs used to match against log lines
2679
create_ignore_list();
2680
 
2681
# Notes:
2682
#
2683
#   - IN REs, always use /o flag or qr// at end of RE when RE uses interpolated vars
2684
#   - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<.*?> )
2685
#   - See additional notes below, search for "Note:".
2686
#   - XXX indicates change, fix or thought required
2687
 
2688
 
2689
# Main processing loop
2690
#
2691
LINE: while ( <> ) {
2692
   chomp;
2693
   s/\s+$//;
2694
   next unless length $_;
2695
 
2696
   $Logreporters::Reports::origline = $_;
2697
 
2698
   # Linux:   Jul  1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2699
   # FreeBSD: Jul  1 20:08:06 <mail.info> mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
2700
   #          Aug 17 15:16:12 mailhost postfix/cleanup[14194]: [ID 197553 mail.info] EC2B339E5: message-id=<2616.EC2B339E5@example.com>
2701
   #          Dec 25 05:20:28 mailhost policyd-spf[14194]: [ID 27553 mail.info] ... policyd-spf stuff ...
2702
 
2703
   next unless /^[A-Z][a-z]{2} [ \d]\d \d{2}:\d{2}:\d{2} (?:<[^>]+> )?(\S+) ($Opts{'syslog_name'}(?:\/([^:[]+))?)(?:\[\d+\])?: (?:\[ID \d+ \w+\.\w+\] )?(.*)$/o;
2704
 
2705
   our $service_name = $3;
2706
   my ($mailhost,$server_name,$p1) = ($1,$2,$4);
2707
   #print "mailhost: $mailhost, servername: $server_name, servicename: $service_name, p1: $p1\n";
2708
 
2709
   $service_name = $server_name unless $service_name;
2710
   #print "service_name: $service_name\n";
2711
 
2712
   # ignored postfix services...
2713
   next if $service_name eq 'postlog';
2714
   next if $service_name =~ /^$Opts{'ignore_services'}$/o;
2715
 
2716
   # common log entries up front
2717
   if ($p1 =~ s/^connect from //) {
2718
      #TD25 connect from sample.net[10.0.0.1]
2719
      #TD connect from mail.example.com[2001:dead:beef::1]
2720
      #TD connect from localhost.localdomain[127.0.0.1]
2721
      #TD connect from unknown[unknown]
2722
      $Totals{'connectioninbound'}++;
2723
      next unless ($Collecting{'connectioninbound'});
2724
 
2725
      my $host = $p1;  my $hostip;
2726
      if (($host,$hostip) = ($host =~ /^([^[]+)\[([^]]+)\]/)) {
2727
         $host = formathost($hostip,$host);
2728
      }
2729
      $Counts{'connectioninbound'}{$host}++;
2730
      next;
2731
   }
2732
 
2733
   if ($p1 =~ /^disconnect from /) {
2734
      #TD25 disconnect from sample.net[10.0.0.1]
2735
      #TD disconnect from mail.example.com[2001:dead:beef::1]
2736
      $Totals{'disconnection'}++;
2737
      next;
2738
   }
2739
 
2740
   if ($p1 =~ s/^connect to //) {
2741
      next if ($p1 =~ /^subsystem /);
2742
      $Totals{'connecttofailure'}++;
2743
      next unless ($Collecting{'connecttofailure'});
2744
 
2745
      my ($host,$hostip,$reason,$port) = ($p1 =~ /^([^[]+)\[([^]]+)\](?::\d+)?: (.*?)(?:\s+\(port (\d+)\))?$/);
2746
      # all "connect to" messages indicate a problem with the connection
2747
      #TDs connect to example.org[10.0.0.1]: Connection refused (port 25)
2748
      #TDs connect to mail.sample.com[10.0.0.1]: No route to host (port 25)
2749
      #TDs connect to sample.net[192.168.0.1]: read timeout (port 25)
2750
      #TDs connect to mail.example.com[10.0.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2751
      #TDs connect to mail.example.com[192.168.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
2752
      #TDs connect to ipv6-1.example.com[2001:dead:beef::1]: Connection refused (port 25)
2753
      #TDs connect to ipv6-2.example.com[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]: Connection refused (port 25)
2754
      #TDs connect to ipv6-3.example.com[1080:0:0:0:8:800:200C:4171]: Connection refused (port 25)
2755
      #TDs connect to ipv6-4.example.com[3ffe:2a00:100:7031::1]: Connection refused (port 25)
2756
      #TDs connect to ipv6-5.example.com[1080::8:800:200C:417A]: Connection refused (port 25)
2757
      #TDs connect to ipv6-6.example.com[::192.9.5.5]: Connection refused (port 25)
2758
      #TDs connect to ipv6-7.example.com[::FFFF:129.144.52.38]: Connection refused (port 25)
2759
      #TDs connect to ipv6-8.example.com[2010:836B:4179::836B:4179]: Connection refused (port 25)
2760
      #TDs connect to mail.example.com[10.0.0.1]: server refused to talk to me: 452 try later   (port 25)
2761
 
2762
      $host = join(' :', $host, $port)   if ($port and $port ne '25');
2763
      # Note: See ConnectToFailure below
2764
      if ($reason =~ /^server (refused to talk to me): (.*)$/) {
2765
         $Counts{'connecttofailure'}{ucfirst($1)}{formathost($hostip,$host)}{$2}++;
2766
      } else {
2767
         $Counts{'connecttofailure'}{ucfirst($reason)}{formathost($hostip,$host)}{''}++;
2768
      }
2769
      next;
2770
   }
2771
 
2772
=pod
2773
real    3m43.997s
2774
user    3m39.038s
2775
sys     0m3.005s
2776
=pod
2777
   # Handle before panic, fatal, warning, so that service-specific code gets first crack
2778
   # XXX replace w/dispatch table for add-ins, so user's can add their own...
2779
   if ($service_name eq 'postfwd')          { postfix_postfwd($p1);       next; }
2780
   if ($service_name eq 'postgrey')         { postfix_postgrey($p1);      next; }
2781
   if ($service_name =~ /^policyd?-spf/)    { postfix_policy_spf($p1);    next; } # postfix/policy-spf
2782
   if ($service_name =~ /^policyd-?weight/) { postfix_policydweight($p1); next; } # postfix/policydweight
2783
 
2784
=cut
2785
   # Handle policy service handlers before panic, fatal, warning, etc.
2786
   # messages so that service-specific code gets first crack.
2787
   # 5:25
2788
   foreach (@policy_services) {
2789
      if ($service_name =~ $_->[0]) {
2790
         #print "Calling policy service helper: $service_name:('$p1')\n";
2791
         &{$_->[1]}($p1);
2792
         next LINE;
2793
      }
2794
   };
2795
#=cut
2796
 
2797
   # ^warning: ...
2798
   # ^fatal: ...
2799
   # ^panic: ...
2800
   # ^error: ...
2801
   if ($p1 =~ /^warning: +(.*)$/)           { postfix_warning($1); next; }
2802
   if ($p1 =~ /^fatal: +(.*)$/)             { postfix_fatal($1);   next; }
2803
   if ($p1 =~ /^panic: +(.*)$/)             { postfix_panic($1);   next; }
2804
   if ($p1 =~ /^error: +(.*)$/)             { postfix_error($1);   next; }
2805
 
2806
   # output by all services that use table lookups - process before specific messages
2807
   if ($p1 =~ /(?:lookup )?table (?:[^ ]+ )?has changed -- (?:restarting|exiting)$/) {
2808
      #TD table hash:/var/mailman/data/virtual-mailman(0,lock|fold_fix) has changed -- restarting
2809
      #TD table hash:/etc/postfix/helo_checks has changed -- restarting
2810
      $Totals{'tablechanged'}++;
2811
      next;
2812
   }
2813
 
2814
   # postfix/postscreen and postfix/verify services
2815
   if ($service_name eq 'postscreen'
2816
    or $service_name eq 'verify')          { postfix_postscreen($p1); next; }    # postfix/postscreen, postfix/verify
2817
   if ($service_name eq 'dnsblog')         { postfix_dnsblog($p1);    next; }    # postfix/dnsblog
2818
   if ($service_name =~ /^cleanup/)        { postfix_cleanup($p1);    next; }    # postfix/cleanup*
2819
   if ($service_name =~ /^bounce/)         { postfix_bounce($p1);     next; }    # postfix/bounce*
2820
   if ($service_name eq 'postfix-script')  { postfix_script($p1);     next; }    # postfix/postfix-script
2821
   if ($service_name eq 'postsuper')       { postfix_postsuper($p1);  next; }    # postfix/postsuper
2822
 
2823
   # ignore tlsproxy for now
2824
   if ($service_name eq 'tlsproxy')        { next; }                             # postfix/tlsproxy
2825
 
2826
   my ($helo, $relay, $from, $origto, $to, $domain, $status,
2827
       $type, $reason, $reason2, $filter, $site, $cmd, $qid,
2828
       $rej_type, $reject_name, $host, $hostip, $dsn, $reply, $fmthost, $bytes);
2829
 
2830
   $rej_type = undef;
2831
 
2832
   # ^$re_QID: ...
2833
   if ($p1 =~ s/^($re_QID): //o) {
2834
      $qid = $1;
2835
 
2836
      next if ($p1 =~ /^host \S*\[\S*\] said: 4\d\d/);  # deferrals, picked up in "status=deferred"
2837
 
2838
      if ($p1 =~ /^removed\s*$/ ) {
2839
         # Note: See REMOVED elsewhere
2840
         # 52CBDC2E0F: removed
2841
         delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
2842
         $Totals{'removedfromqueue'}++;
2843
         next;
2844
      }
2845
 
2846
      # coerce into general warning
2847
      if (($p1 =~ /^Cannot start TLS: handshake failure/) or
2848
          ($p1 =~ /^non-E?SMTP response from/)) {
2849
         postfix_warning($p1);
2850
         next;
2851
      }
2852
 
2853
      if ($p1 eq 'status=deferred (bounce failed)') {
2854
         #TDqQ status=deferred (bounce failed)
2855
         $Totals{'bouncefailed'}++;
2856
         next;
2857
      }
2858
 
2859
      # this test must preceed access checks below
2860
      #TDsQ  replace: header From:     "Postmaster" <postmaster@webmail.example.com>: From:     "Postmaster" <postmaster@webmail.example.org>
2861
      if ($service_name eq 'smtp' and header_body_checks($p1)) {
2862
         #print "main: header_body_checks\n";
2863
         next;
2864
      }
2865
 
2866
      # Postfix access actions
2867
      #   REJECT optional text...
2868
      #   DISCARD optional text...
2869
      #   HOLD optional text...
2870
      #   WARN optional text...
2871
      #   FILTER transport:destination
2872
      #   REDIRECT user@domain
2873
      #   BCC user@domain  (2.6 experimental branch)
2874
      # The following actions are indistinguishable in the logs
2875
      #   4NN text
2876
      #   5NN text
2877
      #   DEFER_IF_REJECT optional text...
2878
      #   DEFER_IF_PERMIT optional text...
2879
      #   UCE restriction...
2880
      # The following actions are not logged
2881
      #   PREPEND headername: headervalue
2882
      #   DUNNO
2883
      #
2884
      # Reject actions based on remote client information:
2885
      #     - one of host name, network address, envelope sender
2886
      #   or
2887
      #     - recipient address
2888
 
2889
      # Template of access controls.  Rejects look like the first line, other access actions the second.
2890
      # ftph is envelope from, envelope to, proto and helo.
2891
      # QID: ACTION  STAGE from host[hostip]: DSN       trigger: explanation; ftph
2892
      # QID: ACTION  STAGE from host[hostip]: trigger:           explanation; ftph
2893
 
2894
      # $re_QID: reject: RCPT|MAIL|CONNECT|HELO|DATA from ...
2895
      # $re_QID: reject_warning: RCPT|MAIL|CONNECT|HELO|DATA from ...
2896
      if ($p1 =~ /^(reject(?:_warning)?|discard|filter|hold|redirect|warn|bcc|replace): /) {
2897
         my $action = $1;
2898
         $p1 = substr($p1, length($action) + 2);
2899
 
2900
         #print "action: \"$action\", p1: \"$p1\"\n";
2901
         if ($p1 !~ /^(RCPT|MAIL|CONNECT|HELO|EHLO|DATA|VRFY|ETRN|END-OF-MESSAGE) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
2902
            inc_unmatched('unexpected access');
2903
            next;
2904
         }
2905
         my ($stage,$host,$hostip,$p1) = ($1,$2,$3,$4);    #print "stage: \"$stage\", host: \"$host\", hostip: \"$hostip\", p1: \"$p1\"\n";
2906
         my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);  #print "efrom: \"$efrom\", eto: \"$eto\", proto: \"$proto\", helo: \"$helo\"\n";
2907
                                                           #print "p1 now: \"$p1\"\n";
2908
 
2909
# QID: ACTION         STAGE from host[hostip]:   DSN       trigger:          explanation;                                                       ftph
2910
#TDsdN reject_warning: VRFY from host[10.0.0.1]: 450 4.1.2 <<1F4@bs>>:       Recipient address rejected: Domain not found;                                          to=<<1F4@bs>>        proto=SMTP  helo=<friend>
2911
#TDsdN reject:         VRFY from host[10.0.0.1]: 550 5.1.1 <:>:              Recipient address rejected: User unknown in local recipient table;                     to=<:> proto=SMTP helo=<10.0.0.1>
2912
#TDsdN reject:         VRFY from host[10.0.0.1]: 450 4.1.8 <to@example.com>: Sender address rejected: Domain not found;                         from=<f@sample.com> to=<eto@example.com> proto=SMTP
2913
#TDsdN reject:         VRFY from host[10.0.0.1]: 554 5.7.1 Service unavailable; Client host [10.0.0.1] blocked using zen.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; to=<u> proto=SMTP
2914
#TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.2 <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2915
#TDsdN reject:         RCPT from host[10.0.0.1]: 550       <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2916
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 550       <to@example.com>: Recipient address rejected: User unknown in local recipient table; from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.net>
2917
#TDsdN reject:         RCPT from host[10.0.0.1]: 550 5.1.1 <to@example.com>: Recipient address rejected: User unknown in virtual address table; from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<localhost>
2918
#TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.1 <to@sample.net>:  Recipient address rejected: User unknown in virtual mailbox table; from=<f@sample.net> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2919
#TDsdN reject:         RCPT from host[10.0.0.1]: 550 5.5.0 <to@example.com>: Recipient address rejected: User unknown;                          from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<[10.0.0.1]>
2920
#TDsdN reject:         RCPT from host[10.0.0.1]: 450       <to@example.net>: Recipient address rejected: Greylisted;                            from=<f@sample.net> to=<eto@example.net> proto=ESMTP helo=<example.com>
2921
#TDsdN reject:         RCPT from host[10.0.0.1]: 454 4.7.1 <to@sample.net>:  Recipient address rejected: Access denied;                         from=<f@sample.com> to=<eto@sample.net>  proto=SMTP  helo=<example.com>
2922
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 <to@sample.net>:  Recipient address rejected: Access denied;                         from=<f@sample.net> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2923
#TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.2 <to@example.com>: Recipient address rejected: Domain not found;                      from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<sample.net>
2924
#TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@example.net>: Recipient address rejected: Please see http://www.openspf.org/why.html?sender=from%40example.net&ip=10.0.0.1&receiver=example.net; from=<from@example.net> to=<to@example.net> proto=ESMTP helo=<to@example.com>
2925
#TDsdN reject:         RCPT from host[10.0.0.1]: 550       <to@example.net>: Recipient address rejected: undeliverable address: host example.net[192.168.0.1] said: 550 <unknown@example.net>: User unknown in virtual alias table (in reply to RCPT TO command); from=<from@example.com> to=<unknown@example.net> proto=SMTP helo=<mail.example.com>
2926
#TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@example.com>: Recipient address rejected: Please see http://spf.pobox.com/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=mail; from=<user@example.com> to=<to@sample.net> proto=ESMTP helo=<10.0.0.1>
2927
#TDsdN reject:         RCPT from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                               from=<f@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>
2928
#TDsdN reject_warning: HELO from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                                                                        proto=SMTP  helo=<example.com>
2929
#TDsdN reject:         RCPT from host[10.0.0.1]: 450 4.1.8 <f@sample.net>:   Sender address rejected: Domain not found;                         from=<f@sample.com> to=<to@example.com>  proto=ESMTP helo=<sample.net>
2930
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 450 4.1.8 <f@sample.net>:   Sender address rejected: Domain not found;                         from=<f@sample.com> to=<to@example.com>  proto=ESMTP helo=<sample.net>
2931
#TDsdN reject:         RCPT from host[10.0.0.1]: 550       <f@example.net>:  Sender address rejected: undeliverable address: host example.net[10.0.0.1] said: 550 <f@example.net>: User unknown in virtual alias table (in reply to RCPT TO command); from=<f@example.net> to=<eto@example.net> proto=SMTP helo=<example.com>
2932
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 554       <host[10.0.0.1]>: Client host rejected: Access denied;                               from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<friend>
2933
#TDsdN reject:         RCPT from host[10.0.0.1]: 554       <host[10.0.0.1]>: Client host rejected: Optional text;                               from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<friend>
2934
#TDsdN reject:      CONNECT from host[10.0.0.1]: 503 5.5.0 <host[10.0.1]>:   Client host rejected: Improper use of SMTP command pipelining;                                              proto=SMTP
2935
 
2936
#TDsdN reject_warning: RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2937
#TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2938
#TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];                                                proto=ESMTP
2939
#TDsdN reject:         RCPT from unk[10.0.0.1]: 550 5.7.1                    Client host rejected: cannot find your reverse hostname, [10.0.0.1]
2940
#TDsdN reject:      CONNECT from unk[unknown]:  421 4.7.1                    Client host rejected: cannot find your reverse hostname, [unknown];                                         proto=SMTP
2941
 
2942
#TDsdN reject:         RCPT from host[10.0.0.1]: 554 5.7.1                   Service unavailable; Client host [10.0.0.1] blocked using sbl-xbl.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<friend>
2943
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 554 5.7.1                   Service unavailable; Client host [10.0.0.1] blocked using sbl-xbl.spamhaus.org; http://www.spamhaus.org/query/bl?ip=10.0.0.1; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<friend>
2944
#TDsdN reject:         RCPT from host[10.0.0.1]: 554                         Service denied; Client host [10.0.0.1] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?83.164.27.124; from=<bogus@example.com> to=<user@example.org> proto=ESMTP helo=<example.com>
2945
#TDsdN reject:         RCPT from host[10.0.0.1]: 454 4.7.1 <localhost>:      Helo command rejected: Access denied;                             from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
2946
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 <localhost>:      Helo command rejected: Access denied;                             from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
2947
#TDsdN reject:         EHLO from host[10.0.0.1]: 504 5.5.2 <bogus>:          Helo command rejected: need fully-qualified hostname;                                                      proto=SMTP  helo=<bogus>
2948
#TDsdQ reject:         DATA from host[10.0.0.1]: 550 5.5.3 <DATA>:           Data command rejected: Multi-recipient bounce;                    from=<>                                  proto=ESMTP helo=<localhost>
2949
#TDsdN reject:         ETRN from host[10.0.0.1]: 554 5.7.1 <example.com>:    Etrn command rejected: Access denied;                                                                      proto=ESMTP helo=<example.com>
2950
#TDsdN reject:         RCPT from host[10.0.0.1]: 452                         Insufficient system storage;                                      from=<f@sample.com> to=<eto@sample.net>
2951
#TDsdN reject_warning: RCPT from host[10.0.0.1]: 451 4.3.5                   Server configuration error;                                       from=<f@sample.com> to=<eto@sample.net>  proto=ESMTP helo=<example.com>
2952
#TDsdN reject:         RCPT from host[10.0.0.1]: 450                         Server configuration problem;                                     from=<f@sample.net> to=<eto@sample.com>  proto=ESMTP helo=<sample.net>
2953
#TDsdN reject:         MAIL from host[10.0.0.1]: 552                         Message size exceeds fixed limit;                                                                          proto=ESMTP helo=<localhost>
2954
#TDsdN reject:         RCPT from unk[10.0.0.1]:  554 5.7.1 <unk[10.0.0.1]>:  Unverified Client host rejected: Access denied;                   from=<f@sample.net> to=<eto@sample.com>  proto=SMTP  helo=<sample.net>
2955
#TDsdN reject:         MAIL from host[10.0.0.1]: 451 4.3.0 <f@example.com>:  Temporary lookup failure;                                         from=<f@example.com>                     proto=ESMTP helo=<example.com>
2956
 
2957
         # reject, reject_warning
2958
         if ($action =~ /^reject/) {
2959
            my ($recip);
2960
 
2961
            if ($p1 !~ /^($re_DSN) (.*)$/o) {
2962
               inc_unmatched('reject1');
2963
               next;
2964
            }
2965
            ($dsn,$p1) = ($1,$2);                        #print "dsn: $dsn, p1: \"$p1\"\n";
2966
            $fmthost = formathost($hostip,$host);
2967
 
2968
            # reject_warning override temp or perm reject types
2969
            $rej_type = ($action eq 'reject_warning' ? 'warn' : get_reject_key($dsn));
2970
            #print "REJECT stage: '$rej_type'\n";
2971
 
2972
            if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
2973
               $Counts{'byiprejects'}{$fmthost}++;
2974
            }
2975
 
2976
            if ($stage eq 'VRFY') {
2977
               if ($p1 =~ /^(?:<(\S*)>: )?(.*);$/) {
2978
                  my ($trigger,$reason) = ($1,$2);
2979
                  $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name});
2980
 
2981
                  if ($reason =~ /^Service unavailable; Client host \[[^]]+\] (blocked using [^;]*);/) {
2982
                     $reason = join (' ', 'Client host blocked using', $1);
2983
                     $trigger = '';
2984
                  }
2985
                  $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++;
2986
               } else {
2987
                  inc_unmatched('vrfyfrom');
2988
               }
2989
               next;
2990
            }
2991
 
2992
            # XXX there may be several semicolon-separated messages
2993
            # Recipient address rejected: Unknown users and via check_recipient_access
2994
            if ($p1 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/) {
2995
               ($recip,$reason) = ($1,$2);
2996
 
2997
               my ($localpart,$domainpart);
2998
               # Unknown users; local mailbox, alias, virtual, relay user, unspecified
2999
               if ($recip eq '') { ($localpart, $domainpart) = ('<>', '*unspecified'); }
3000
               else {
3001
                  ($localpart, $domainpart) = split (/@/, lc $recip);
3002
                  ($localpart, $domainpart) = ($recip, '*unspecified')   if ($domainpart eq '');
3003
               }
3004
 
3005
               if ($reason =~ s/^User unknown *//) {
3006
                  $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name});
3007
 
3008
                  my ($table) = ($reason =~ /^in ((?:\w+ )+table)/);
3009
                  $table = 'Address table unavailable'	if ($table eq '');     # when show_user_unknown_table_name=no
3010
                  $Counts{$reject_name}{ucfirst($table)}{$domainpart}{$localpart}{$fmthost}++;
3011
               } else {
3012
                  # check_recipient_access
3013
                  $Totals{$reject_name = "${rej_type}rejectrecip" }++; next unless ($Collecting{$reject_name});
3014
 
3015
                  if ($reason =~ m{^Please see http://[^/]+/why\.html}) {
3016
                     $reason = 'SPF reject';
3017
                  }
3018
                  elsif ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3019
                     $reason = 'undeliverable address: remote host rejected recipient';
3020
                  }
3021
                  $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++;
3022
               }
3023
 
3024
            } elsif ($p1 =~ /^<(.*?)>.* Relay access denied/) {
3025
               $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name});
3026
               $Counts{$reject_name}{$fmthost}{$eto}++;
3027
 
3028
            } elsif ($p1 =~ /^<(.*)>: Sender address rejected: (.*);/) {
3029
               $Totals{$reject_name = "${rej_type}rejectsender" }++;  next unless ($Collecting{$reject_name});
3030
               ($from,$reason) =  ($1,$2);
3031
 
3032
               if ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
3033
                  $reason = 'undeliverable address: remote host rejected sender';
3034
               }
3035
               $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++;
3036
 
3037
            } elsif ($p1 =~ /^(?:<.*>: )?Unverified Client host rejected: /) {
3038
               # check_reverse_client_hostname_access (postfix 2.6+)
3039
               $Totals{$reject_name = "${rej_type}rejectunverifiedclient" }++; next unless ($Collecting{$reject_name});
3040
               $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3041
 
3042
            } elsif ($p1 =~ s/^(?:<.*>: )?Client host rejected: //) {
3043
               # reject_unknown_client
3044
               #   client IP->name mapping fails
3045
               #   name->IP mapping fails
3046
               #   name->IP mapping =! client IP
3047
               if ($p1 =~ /^cannot find your hostname/) {
3048
                  $Totals{$reject_name = "${rej_type}rejectunknownclient" }++; next unless ($Collecting{$reject_name});
3049
                  $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
3050
               }
3051
               # reject_unknown_reverse_client_hostname (no PTR record for client's IP)
3052
               elsif ($p1 =~ /^cannot find your reverse hostname/) {
3053
                  $Totals{$reject_name = "${rej_type}rejectunknownreverseclient" }++; next unless ($Collecting{$reject_name});
3054
                  $Counts{$reject_name}{$hostip}++
3055
               }
3056
               else {
3057
                  $Totals{$reject_name = "${rej_type}rejectclient" }++; next unless ($Collecting{$reject_name});
3058
                  $p1 =~ s/;$//;
3059
                  $Counts{$reject_name}{ucfirst($p1)}{$fmthost}{$eto}{$efrom}++;
3060
               }
3061
            } elsif ($p1 =~ /^Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/) {
3062
               # Note: similar code below: search RejectRBL
3063
 
3064
               # postfix 2.1
3065
               #TDsdN reject: RCPT from example.com[10.0.0.5]: 554 Service unavailable; Client host [10.0.0.5] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.5; from=<from@example.com> to=<to@example.net> proto=ESMTP helo=<example.com>
3066
               # postfix 2.3+
3067
               #TDsdN reject: RCPT from example.com[10.0.0.6]: 554 5.7.1 Service unavailable; Client host [10.0.0.6] blocked using bl.spamcop.net; Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.6; from=<from@example.com> to=<to@example.net> proto=SMTP helo=<example.com>
3068
               #TDsdN reject: RCPT from example.com[10.0.0.1]: 550 5.7.1 Service unavailable; Client host [10.0.0.1] blocked using Trend Micro RBL+. Please see http://www.mail-abuse.com/cgi-bin/lookup?ip_address=10.0.0.1; Mail from 10.0.0.1 blocked using Trend Micro Email Reputation database. Please see <http://www.mail-abuse.com/cgi-bin/lookup?10.0.0.1>; from=<from@example.com> to=<to@example.net> proto=SMTP helo=<10.0.0.1>
3069
 
3070
               $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3071
               ($site,$reason) = ($1 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3072
               $reason =~ s/^reason: // if ($reason);
3073
               $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++;
3074
 
3075
            } elsif ($p1 =~ /^<.*>: Helo command rejected: (.*);$/) {
3076
               $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name});
3077
               $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3078
 
3079
            } elsif ($p1 =~ /^<.*>: Etrn command rejected: (.*);$/) {
3080
               $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name});
3081
               $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;
3082
 
3083
            } elsif ($p1 =~ /^<.*>: Data command rejected: (.*);$/) {
3084
               $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name});
3085
               $Counts{$reject_name}{$1}{$fmthost}{$helo}++;
3086
 
3087
            } elsif ($p1 =~ /^Insufficient system storage;/) {
3088
               $Totals{'warninsufficientspace'}++;    # force display in Warnings section also
3089
               $Totals{$reject_name = "${rej_type}rejectinsufficientspace" }++; next unless ($Collecting{$reject_name});
3090
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3091
 
3092
            } elsif ($p1 =~ /^Server configuration (?:error|problem);/) {
3093
               $Totals{'warnconfigerror'}++;          # force display in Warnings section also
3094
               $Totals{$reject_name = "${rej_type}rejectconfigerror" }++; next unless ($Collecting{$reject_name});
3095
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3096
 
3097
            } elsif ($p1 =~ /^Message size exceeds fixed limit;$/) {
3098
               # Postfix responds with this message after a MAIL FROM:<...> SIZE=nnn  command, where postfix consider's nnn excessive
3099
               # Note: similar code below: search RejectSize
3100
               # Note: reject_warning does not seem to occur
3101
               $Totals{$reject_name = "${rej_type}rejectsize" }++; next unless ($Collecting{$reject_name});
3102
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3103
 
3104
            } elsif ($p1 =~ /^<(.*?)>: Temporary lookup failure;/) {
3105
               $Totals{$reject_name = "${rej_type}rejectlookupfailure" }++; next unless ($Collecting{$reject_name});
3106
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;
3107
 
3108
            # This would capture all other rejects, but I think it might be more useful to add
3109
            # additional capture sections based on user reports of uncapture lines.
3110
            #
3111
            #} elsif ( ($reason) = ($p1 =~ /^([^;]+);/)) {
3112
            #  $Totals{$rej_type . 'rejectother'}++;
3113
            #  $Counts{$rej_type . 'rejectother'}{$reason}++;
3114
            } else {
3115
               inc_unmatched('rejectother');
3116
            }
3117
         }
3118
         # end of $re_QID: reject:
3119
 
3120
# QID: ACTION         STAGE from host[hostip]:   trigger:                    reason;                                                            ftph
3121
#
3122
#TDsdN warn:           RCPT from host[10.0.0.1]:                             TEST access WARN action;                                           from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3123
#TDsdN warn:           RCPT from host[10.0.0.1]:                             ;                                                                  from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.net>
3124
#TDsdN discard:        RCPT from host[10.0.0.1]: <from@example.com>:         Sender address TEST DISCARD action;                                from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3125
#TDsdN discard:        RCPT from host[10.0.0.1]: <host[10.0.0.1]>:           Client host    TEST DISCARD action w/ip(client_checks);            from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3126
#TDsdN discard:        RCPT from host[10.0.0.1]: <host[10.0.0.1]>:           Unverified Client host triggers DISCARD action;                    from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<10.0.0.1>
3127
#TDsdN hold:           RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers HOLD action;                            from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<10.0.0.1>
3128
#TDsdN hold:           RCPT from host[10.0.0.1]: <dummy>:                    Helo command optional text...;                                     from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3129
#TDsdN hold:           RCPT from host[10.0.0.1]: <dummy>:                    Helo command triggers HOLD action;                                 from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3130
#TDsdN hold:           DATA from host[10.0.0.1]: <dummy>:                    Helo command triggers HOLD action;                                 from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<dummy>
3131
#TDsdN filter:         RCPT from host[10.0.0.1]: <>:                         Sender address triggers FILTER filter:somefilter;                  from=<>             to=<eto@example.com> proto=SMTP  helo=<sample.com>
3132
#TDsdN filter:         RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers FILTER smtp-amavis:[127.0.0.1]:10024;   from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<sample.net>
3133
#TDsdN redirect:       RCPT from host[10.0.0.1]: <example.com[10.0.0.1]>:    Client host triggers REDIRECT root@localhost;                      from=<f@sample.net> to=<eto@example.com> proto=SMTP  helo=<localhost>
3134
#TDsdN redirect:       RCPT from host[10.0.0.1]: <eto@example.com>:          Recipient address triggers REDIRECT root@localhost;                from=<f@sample.net> to=<eto@example.com> proto=ESMTP helo=<sample.com>
3135
 
3136
# BCC action (postfix 2.6+)
3137
#TDsdN bcc:            RCPT from host[10.0.0.1]: <user@example.com>:         Sender address triggers BCC root@localhost;                        from=<f@sample.net> to=<eto@sample.com> proto=ESMTP helo=<sample.net>
3138
 
3139
         # $re_QID: discard, filter, hold, redirect, warn, bcc, replace ...
3140
         else {
3141
            my $trigger;
3142
            ($trigger,$reason) = ($p1 =~ /^(?:<(\S*)>: )?(.*);$/ );
3143
            if ($trigger eq '') {   $trigger = '*unavailable';  }
3144
            else {                  $trigger =~ s/^<(.+)>$/$1/; }
3145
            $reason  = '*unavailable' if ($reason eq '');
3146
            $fmthost = formathost ($hostip,$host);
3147
            #print "trigger: \"$trigger\", reason: \"$reason\"\n";
3148
 
3149
            # reason -> subject text
3150
            #           subject -> "Helo command"           : smtpd_helo_restrictions
3151
            #           subject -> "Client host"            : smtpd_client_restrictions
3152
            #           subject -> "Unverified Client host" : smtpd_client_restrictions
3153
            #           subject -> "Client certificate"     : smtpd_client_restrictions
3154
            #           subject -> "Sender address"         : smtpd_sender_restrictions
3155
            #           subject -> "Recipient address"      : smtpd_recipient_restrictions
3156
 
3157
            #           subject -> "Data command"           : smtpd_data_restrictions
3158
            #           subject -> "End-of-data"            : smtpd_end_of_data_restrictions
3159
            #           subject -> "Etrn command"           : smtpd_etrn_restrictions
3160
 
3161
            #           text    -> triggers <ACTION> action|triggers <ACTION> <destination>|optional text...
3162
 
3163
            my ($subject, $text) =
3164
               ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o);
3165
            #printf "ACTION: '$action', SUBJECT: %-30s TEXT: \"$text\"\n", '"' . $subject . '"';
3166
 
3167
            if ($action eq 'filter') {
3168
               $Totals{'filtered'}++; next unless ($Collecting{'filtered'});
3169
               # See "Note: Counts" before changing $Counts below re: Filtered
3170
               $text =~ s/triggers FILTER //;
3171
               if    ($subject eq 'Recipient address') { $Counts{'filtered'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3172
               elsif ($subject =~ /Client host$/)      { $Counts{'filtered'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3173
               else                                    { $Counts{'filtered'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3174
            }
3175
            elsif ($action eq 'redirect') {
3176
               $Totals{'redirected'}++; next unless ($Collecting{'redirected'});
3177
               $text =~ s/triggers REDIRECT //;
3178
               # See "Note: Counts" before changing $Counts below re: Redirected
3179
               if    ($subject eq 'Recipient address') { $Counts{'redirected'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3180
               elsif ($subject =~ /Client host$/)      { $Counts{'redirected'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3181
               else                                    { $Counts{'redirected'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3182
            }
3183
            # hold, discard, and warn allow "optional text"
3184
            elsif ($action eq 'hold') {
3185
               $Totals{'hold'}++; next unless ($Collecting{'hold'});
3186
               # See "Note: Counts" before changing $Counts below re: Hold
3187
               $subject = $reason unless $text eq 'triggers HOLD action';
3188
               if    ($subject eq 'Recipient address') { $Counts{'hold'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3189
               elsif ($subject =~ /Client host$/)      { $Counts{'hold'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3190
               else                                    { $Counts{'hold'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3191
            }
3192
            elsif ($action eq 'discard') {
3193
               $Totals{'discarded'}++; next unless ($Collecting{'discarded'});
3194
               # See "Note: Counts" before changing $Counts below re: Discarded
3195
               $subject = $reason unless $text eq 'triggers DISCARD action';
3196
               if    ($subject eq 'Recipient address') { $Counts{'discarded'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3197
               elsif ($subject =~ /Client host$/)      { $Counts{'discarded'}{$subject}{$fmthost}{$eto}{$efrom}++; }
3198
               else                                    { $Counts{'discarded'}{$subject}{$trigger}{$eto}{$fmthost}++; }
3199
            }
3200
            elsif ($action eq 'warn') {
3201
               $Totals{'warned'}++; next unless ($Collecting{'warned'});
3202
               $Counts{'warned'}{$reason}{$fmthost}{$eto}{''}++;
3203
               # See "Note: Counts" before changing $Counts above...
3204
            }
3205
            elsif ($action eq 'bcc') {
3206
               $Totals{'bcced'}++; next unless ($Collecting{'bcced'});
3207
               # See "Note: Counts" before changing $Counts below re: Filtered
3208
               $text =~ s/triggers BCC //o;
3209
               if    ($subject eq 'Recipient address') { $Counts{'bcced'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
3210
               elsif ($subject =~ /Client host$/)      { $Counts{'bcced'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
3211
               else                                    { $Counts{'bcced'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
3212
            }
3213
            else {
3214
               die "Unexpected ACTION: '$action'";
3215
            }
3216
         }
3217
      }
3218
 
3219
      elsif ($p1 =~ s/^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)//) {
3220
         my ($hip,$host,$hostip) = ($1,$2,$3);
3221
 
3222
         # Increment accepted when the client connection is made and smtpd has a QID.
3223
         # Previously, accepted was being incorrectly incremented when the first qmgr
3224
         # "from=xxx, size=nnn ..." line was seen.  This is erroneous when the smtpd
3225
         # client connection occurred outside the date range of the log being analyzed.
3226
         $AcceptedByQid{$qid} = $hip;
3227
         $Totals{'msgsaccepted'}++;
3228
 
3229
         #TDsdQ client=unknown[192.168.0.1]
3230
         #TDsdQ client=unknown[192.168.0.1]:unknown
3231
         #TDsdQ client=unknown[192.168.0.1]:10025
3232
         #TDsd client=example.com[192.168.0.1], helo=example.com
3233
         #TDsdQ client=mail.example.com[2001:dead:beef::1]
3234
 
3235
         #TDsdQ client=localhost[127.0.0.1], sasl_sender=someone@example.com
3236
         #TDsdQ client=example.com[192.168.0.1], sasl_method=PLAIN, sasl_username=anyone@sample.net
3237
         #TDsdQ client=example.com[192.168.0.1], sasl_method=LOGIN, sasl_username=user@example.com, sasl_sender=<id352ib@sample.net>
3238
         #TDsdQ client=unknown[10.0.0.1], sasl_sender=user@examine.com
3239
         next if ($p1 eq '');
3240
         my ($method,$user,$sender) = ($p1 =~ /^(?:, sasl_method=([^,]+))?(?:, sasl_username=([^,]+))?(?:, sasl_sender=<?(.*)>?)?$/);
3241
 
3242
         # sasl_sender occurs when AUTH verb is present in MAIL FROM, typically used for relaying
3243
         # the username (eg. sasl_username) of authenticated users.
3244
         if ($sender or $method or $user) {
3245
            $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'});
3246
            $method ||= '*unknown method';
3247
            $user   ||= '*unknown user';
3248
            $Counts{'saslauth'}{$user . ($sender ? " ($sender)" : '')}{$method}{formathost($hostip,$host)}++;
3249
         }
3250
      }
3251
 
3252
      # ^$re_QID: ...  (not access(5) action)
3253
      elsif ($p1 =~ /^from=<(.*?)>, size=(\d+), nrcpt=(\d+)/) {
3254
         my ($efrom,$bytes,$nrcpt) = ($1,$2,$3);
3255
         #TDsdQ from=<FROM: SOME USER@example.com>, size=4051, nrcpt=1 (queue active)
3256
         #TDsdQ(12) from=<anyone@example.com>, size=25302, nrcpt=2 (queue active)
3257
         #TDsdQ from=<from@example.com>, size=5529, nrcpt=1 (queue active)
3258
         #TDsdQ from=<from@example.net, @example.com>, size=5335, nrcpt=1 (queue active)
3259
 
3260
         # Distinguish bytes accepted vs. bytes delivered due to multiple recips
3261
 
3262
         # Increment bytes accepted on the first qmgr "from=..." line...
3263
         next if (exists $SizeByQid{$qid});
3264
         $SizeByQid{$qid}          = $bytes;
3265
         # ...but only when the smtpd "client=..." line has been seen too.
3266
         # This under-counts when the smtpd "client=..." connection log entry and the
3267
         # qmgr "from=..." log entry span differnt periods (as fed to postfix-logwatch).
3268
         next if (! exists $AcceptedByQid{$qid});
3269
 
3270
         $Totals{'bytesaccepted'} += $bytes;
3271
 
3272
         $Counts{'envelopesenders'}{$efrom ne '' ? $efrom : '<>'}++      if ($Collecting{'envelopesenders'});
3273
         if ($Collecting{'envelopesenderdomains'}) {
3274
            my ($localpart, $domain);
3275
            if ($efrom eq '') { ($localpart, $domain) = ('<>', '*unknown'); }
3276
            else              { ($localpart, $domain) = split (/@/, lc $efrom); }
3277
 
3278
            $Counts{'envelopesenderdomains'}{$domain ne '' ? $domain : '*unknown'}{$localpart}++;
3279
         }
3280
         delete $AcceptedByQid{$qid};           # prevent incrementing BytesAccepted again
3281
      }
3282
 
3283
      ### sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3284
      elsif ($p1 =~ s/^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=(\S+) //o) {
3285
         ($relay,$status) = ($3,$5);
3286
 
3287
         my ($to,$origto,$localpart,$domainpart,$dsn,$p1) = process_delivery_attempt ($1,$2,$4,$p1);
3288
 
3289
         #TD 552B6C20E: to=<to@sample.com>, relay=mail.example.net[10.0.0.1]:25, delay=1021, delays=1020/0.04/0.56/0.78, dsn=2.0.0, status=sent (250 Ok: queued as 6EAC4719EB)
3290
         #TD 552B6C20E: to=<to@sample.com>, relay=mail.example.net[10.0.0.1]:25, conn_use=2 delay=1021, delays=1020/0.04/0.56/0.78, dsn=2.0.0, status=sent (250 Ok: queued as 6EAC4719EB)
3291
         #TD DD925BBE2: to=<to@example.net>, orig_to=<to-ext@example.net>, relay=mail.example.net[2001:dead:beef::1], delay=2, status=sent (250 Ok: queued as 5221227246)
3292
 
3293
         ### sent
3294
         if ($status eq 'sent') {
3295
            if ($p1 =~ /forwarded as /) {
3296
               $Totals{'bytesforwarded'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3297
               $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'});
3298
               $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++;
3299
            }
3300
            else {
3301
               if ($service_name eq 'lmtp') {
3302
                  $Totals{'bytessentlmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3303
                  $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'});
3304
                  $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++;
3305
               }
3306
               elsif ($service_name eq 'smtp') {
3307
                  $Totals{'bytessentsmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3308
                  $Totals{'sent'}++; next unless ($Collecting{'sent'});
3309
                  $Counts{'sent'}{$domainpart}{$localpart}{$origto}++;
3310
               }
3311
               # virtual, command, ...
3312
               else {
3313
                  $Totals{'bytesdelivered'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
3314
                  $Totals{'delivered'}++; next unless ($Collecting{'delivered'});
3315
                  $Counts{'delivered'}{$domainpart}{$localpart}{$origto}++;
3316
               }
3317
            }
3318
         }
3319
 
3320
         elsif ($status eq 'deferred') {
3321
            #TDsQ to=<to@example.com>, relay=none, delay=27077, delays=27077/0/0.57/0, dsn=4.4.3, status=deferred (Host or domain name not found. Name service error for name=example.com type=MX: Host not found, try again)
3322
            #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused)
3323
            #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused)
3324
            #TDsQ to=<to@example.com>, relay=none, delay=306142, delays=306142/0.04/0.18/0, dsn=4.4.1, status=deferred (connect to example.com[10.0.0.1]: Connection refused)
3325
            #TDsQ to=<to@example.org>, relay=example.org[10.0.0.1], delay=48779, status=deferred (lost connection with mail.example.org[10.0.0.1] while sending MAIL FROM)
3326
            #TDsQ to=<to@sample.net>, relay=sample.net, delay=26541, status=deferred (conversation with mail.example.com timed out while sending end of data -- message may be sent more than once)
3327
            #TDsQ to=<to@sample.net>, relay=sample.net[10.0.0.1]:25, delay=322, delays=0.04/0/322/0, dsn=4.4.2, status=deferred (conversation with example.com[10.0.0.01] timed out while receiving the initial server greeting)
3328
            #TDsQ to=<to@localhost>, orig_to=<toalias@localhost>, relay=none, delay=238024, status=deferred (delivery temporarily suspended: transport is unavailable)
3329
 
3330
            # XXX postfix reports dsn=5.0.0, host's reply may contain its own dsn's such as 511 and #5.1.1
3331
            # XXX should these be used instead?
3332
            #TDsQ to=<to@sample.net>, relay=sample.net[10.0.0.1]:25, delay=5.7, delays=0.05/0.02/5.3/0.3, dsn=4.7.1, status=deferred (host sample.net[10.0.0.1] said: 450 4.7.1 <to@sample.net>: Recipient address rejected: Greylisted (in reply to RCPT TO command))
3333
            #TDsQ to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=79799, delays=79797/0.02/0.4/1.3, dsn=4.0.0, status=deferred (host example.com[10.0.0.1] said: 450 <to@example.com>: User unknown in local recipient table (in reply to RCPT TO command))
3334
            #TDsQ to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=97, delays=0.03/0/87/10, dsn=4.0.0, status=deferred (host example.com[10.0.0.1] said: 450 <to@example.com>: Recipient address rejected: undeliverable address: User unknown in virtual alias table (in reply to RCPT TO command))
3335
 
3336
            ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3337
 
3338
            $Totals{'deferred'}++      if ($DeferredByQid{$qid}++ == 0);
3339
            $Totals{'deferrals'}++;    next unless ($Collecting{'deferrals'});
3340
            $Counts{'deferrals'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3341
         }
3342
 
3343
         ### bounced
3344
         elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') {
3345
            # local agent
3346
            #TDlQ to=<envto@example.com>,                  relay=local, delay=2.5, delays=2.1/0.22/0/0.21, dsn=5.1.1, status=bounced (unknown user: "friend")
3347
 
3348
            # smtp agent
3349
            #TDsQ to=<envto@example.com>, orig_to=<envto>, relay=sample.net[10.0.0.1]:25, delay=22, delays=0.02/0.09/22/0.07, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 551 invalid address (in reply to MAIL FROM command))
3350
 
3351
            #TDsQ to=<envto@example.com>,                  relay=sample.net[10.0.0.1]:25, delay=11, delays=0.13/0.07/0.98/0.52, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 550 MAILBOX NOT FOUND (in reply to RCPT TO command))
3352
            #TDsQ to=<envto@example.com>, orig_to=<envto>, relay=sample.net[10.0.0.1]:25, delay=22, delays=0.02/0.09/22/0.07, dsn=5.0.0, status=bounced (host sample.net[10.0.0.1] said: 551 invalid address (in reply to MAIL FROM command))
3353
 
3354
 
3355
            #TDsQ to=<envto@example.com>,                  relay=none,  delay=0.57, delays=0.57/0/0/0,      dsn=5.4.6, status=bounced (mail for sample.net loops back to myself)
3356
            #TDsQ to=<>,                                   relay=none,  delay=1,                                       status=bounced (mail for sample.net loops back to myself)
3357
            #TDsQ to=<envto@example.com>,                  relay=none,  delay=0,                                       status=bounced (Host or domain name not found. Name service error for name=unknown.com type=A: Host not found)
3358
            # XXX verify these...
3359
            #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=none, delay=1, status=bounced (User unknown in virtual alias table)
3360
            #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=sample.net[192.168.0.1], delay=1.1, status=bounced (User unknown in relay recipient table)
3361
            #TD D8962E54: to=<anyone@example.com>, relay=local, conn_use=2 delay=0.21, delays=0.05/0.02/0/0.14, dsn=4.1.1, status=SOFTBOUNCE (unknown user: "to")
3362
            #TD F031C832: to=<to@sample.net>, orig_to=<alias@sample.net>, relay=local, delay=0.17, delays=0.13/0.01/0/0.03, dsn=5.1.1, status=bounced (unknown user: "to")
3363
 
3364
            #TD C76431E2: to=<login@sample.net>, relay=local, delay=2, status=SOFTBOUNCE (host sample.net[192.168.0.1] said: 450 <login@sample.com>: User unknown in local recipient table (in reply to RCPT TO command))
3365
            #TD 04B0702E: to=<anyone@example.com>, relay=example.com[10.0.0.1]:25, delay=12, delays=6.5/0.01/0.03/5.1, dsn=5.1.1, status=bounced (host example.com[10.0.0.1] said: 550 5.1.1 User unknown (in reply to RCPT TO command))
3366
            #TD 9DAC8B2D: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=1.4, delays=0.04/0/0.27/1.1, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 511 sorry, no mailbox here by that name (#5.1.1 - chkuser) (in reply to RCPT TO command))
3367
            #TD 79CB702D: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=0.3, delays=0.04/0/0.61/0.8, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 550 <to@example.com>, Recipient unknown (in reply to RCPT TO command))
3368
            #TD 88B7A079: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=45, delays=0.03/0/5.1/40, dsn=5.0.0, status=bounced (host example.com[10.0.0.1] said: 550-"The recipient cannot be verified.  Please check all recipients of this 550 message to verify they are valid." (in reply to RCPT TO command))
3369
            #TD 47B7B074: to=<to@example.com>, relay=example.com[10.0.0.1]:25, delay=6.6, delays=6.5/0/0/0.11, dsn=5.1.1, status=bounced (host example.com[10.0.0.1] said: 550 5.1.1 <to@example.com> User unknown; rejecting (in reply to RCPT TO command))
3370
            #TDppQ to=<withheld>, relay=dbmail-pipe, delay=0.15, delays=0.09/0.01/0/0.06, dsn=5.3.0, status=bounced (Command died with signal 11: "/usr/sbin/dbmail-smtp")
3371
 
3372
            # print "bounce message from " . $to . " msg : " . $relay . "\n";
3373
 
3374
            # See same code elsewhere "Note: Bounce"
3375
            ### local bounce
3376
            # XXX local v. remote bounce seems iffy, relative
3377
            if ($relay =~ /^(?:none|local|virtual|127\.0\.0\.1|maildrop|avcheck)/) {
3378
               $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'});
3379
               $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($p1)}{$localpart}++;
3380
            }
3381
            else {
3382
               $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'});
3383
               ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
3384
               $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
3385
            }
3386
         }
3387
 
3388
 
3389
         elsif ($status =~ 'undeliverable') {
3390
            #TDsQ to=<u@example.com>, relay=sample.com[10.0.0.1], delay=0, dsn=5.0.0, status=undeliverable (host sample.com[10.0.0.1] refused to talk to me: 554 5.7.1 example.com Connection not authorized)
3391
            #TDsQ to=<to@example.com>, relay=mx.example.com[10.0.0.1]:25, conn_use=2, delay=5.5, delays=0.03/0/0.21/5.3, dsn=5.0.0, status=undeliverable-but-not-cached (host mx.example.com[10.0.0.1] said: 550 RCPT TO:<to@example.com> User unknown (in reply to RCPT TO command))
3392
            #TDvQ to=<u@example.com>, relay=virtual, delay=0.14, delays=0.06/0/0/0.08, dsn=5.1.1, status=undeliverable (unknown user: "u@example.com")
3393
            #TDlQ to=<to@example.com>, relay=local, delay=0.02, delays=0.01/0/0/0, dsn=5.1.1, status=undeliverable-but-not-cached (unknown user: "to")
3394
            $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'});
3395
            if ($p1 =~ /^unknown user: ".+?"$/) {
3396
               $Counts{'undeliverable'}{get_dsn_msg($dsn)}{'Unknown user'}{$domainpart}{$localpart}{$origto ? $origto : ''}++;
3397
            }
3398
            else {
3399
               my ($reply,$fmthost) = cleanhostreply($p1,'',$to ne '' ? $to : '<>',$domainpart);
3400
               $Counts{'undeliverable'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
3401
            }
3402
         }
3403
 
3404
         elsif ($status eq 'deliverable') {
3405
            # address verification, sendmail -bv deliverable reports
3406
            #TDvQ to=<u@example.com>, relay=virtual, delay=0.09, delays=0.03/0/0/0.06, dsn=2.0.0, status=deliverable (delivers to maildir)
3407
            $Totals{'deliverable'}++; next unless ($Collecting{'deliverable'});
3408
            my $dsn = ($p1 =~ s/^($re_DSN) // ? $1 : '*unavailable');
3409
            $Counts{'deliverable'}{$dsn}{$p1}{$origto ? "$to ($origto)" : $to}++;
3410
         }
3411
 
3412
         else {
3413
            # keep this as the last condition in this else clause
3414
            inc_unmatched('unknownstatus');
3415
         }
3416
      } # end of sent, forwarded, bounced, softbounce, deferred, (un)deliverable
3417
 
3418
      # pickup
3419
      elsif ($p1 =~ /^(uid=\S* from=<.*?>)/) {
3420
         #TDpQ2 uid=0 from=<root>
3421
         $AcceptedByQid{$qid} = $1;
3422
         $Totals{'msgsaccepted'}++;
3423
      }
3424
 
3425
      elsif ($p1 =~ /^from=<(.*?)>, status=expired, returned to sender$/) {
3426
         #TDqQ from=<from@example.com>, status=expired, returned to sender
3427
         $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'});
3428
         $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++;
3429
      }
3430
 
3431
      elsif ($p1 =~ s/^host ([^[]+)\[([^]]+)\](?::\d+)? refused to talk to me://) {
3432
         #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 553 Connections are being blocked due to previous incidents of abuse
3433
         #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 501 Connection from 192.168.2.1 (XY) rejected
3434
         # Note: See ConnectToFailure above
3435
         $Totals{'connecttofailure'}++; next unless ($Collecting{'connecttofailure'});
3436
         $Counts{'connecttofailure'}{'Refused to talk to me'}{formathost($2,$1)}{$p1}++;
3437
      }
3438
 
3439
      elsif ($p1 =~ /^lost connection with ([^[]*)\[([^]]+)\](?::\d+)? (while .*)$/) {
3440
         # outbound smtp
3441
         #TDsQ lost connection with sample.net[10.0.0.1] while sending MAIL FROM
3442
         #TDsQ lost connection with sample.net[10.0.0.2] while receiving the initial server greeting
3443
         $Totals{'connectionlostoutbound'}++; next unless ($Collecting{'connectionlostoutbound'});
3444
         $Counts{'connectionlostoutbound'}{ucfirst($3)}{formathost($2,$1)}++;
3445
      }
3446
 
3447
      elsif ($p1 =~ /^conversation with ([^[]*)\[([^]]+)\](?::\d+)? timed out (while .*)$/) {
3448
         #TDsQ conversation with sample.net[10.0.0.1] timed out while receiving the initial SMTP greeting
3449
         # Note: see TimeoutInbound below
3450
         $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3451
         $Counts{'timeoutinbound'}{ucfirst($3)}{formathost($2,$1)}{''}++;
3452
      }
3453
 
3454
      elsif ($p1 =~ /^enabling PIX (<CRLF>\.<CRLF>) workaround for ([^[]+)\[([^]]+)\](?::\d+)?/ or
3455
             $p1 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[([^]]+)\](?::\d+)?/) {
3456
         #TDsQ enabling PIX <CRLF>.<CRLF> workaround for example.com[192.168.0.1]
3457
         #TDsQ enabling PIX <CRLF>.<CRLF> workaround for mail.sample.net[10.0.0.1]:25
3458
         #TDsQ enabling PIX workarounds: disable_esmtp delay_dotcrlf for spam.example.org[10.0.0.1]:25
3459
         $Totals{'pixworkaround'}++; next unless ($Collecting{'pixworkaround'});
3460
         $Counts{'pixworkaround'}{$1}{formathost($3,$2)}++;
3461
      }
3462
 
3463
      # milter-reject, milter-hold, milter-discard
3464
      elsif ($p1 =~ s/^milter-//) {
3465
         milter_common($p1);
3466
      }
3467
 
3468
      elsif ($p1 =~ s/^SASL (\[CACHED\] )?authentication failed; //) {
3469
         #TDsQ SASL authentication failed; cannot authenticate to server smtp.example.com[10.0.0.1]: no mechanism available
3470
         #TDsQ SASL authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3471
         #TDsQ SASL [CACHED] authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
3472
         # see saslauthfail elsewhere
3473
 
3474
         $Totals{'saslauthfail'}++; next unless ($Collecting{'saslauthfail'});
3475
         my $cached = $1;
3476
 
3477
         if ($p1 =~ /^(authentication protocol loop with server): ([^[]+)\[([^]]+)\](?::\d+)?$/) {
3478
            ($reason,$host,$hostip,$reason2) = ($1,$2,$3,'');
3479
         }
3480
         elsif ($p1 =~ /^(cannot authenticate to server) ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
3481
            ($reason,$host,$hostip,$reason2) = ($1,$2,$3,$4);
3482
         }
3483
         elsif ($p1 =~ /^server ([^[]+)\[([^]]+)\](?::\d+)? said: (.+)$/) {
3484
            ($reason,$host,$hostip,$reason2) = ('server ... said',$1,$2,$3);
3485
         }
3486
         else {
3487
            inc_unmatched('saslauthfail');
3488
            next;
3489
         }
3490
 
3491
         $reason .= ': ' . $reason2  if $reason2;
3492
         $Counts{'saslauthfail'}{$cached . $reason}{formathost($hostip,$host)}++;
3493
      }
3494
 
3495
      else {
3496
         # keep this as the last condition in this else clause
3497
         inc_unmatched('unknownqid')  if  ! in_ignore_list ($p1);
3498
      }
3499
   }
3500
   # end of $re_QID section
3501
 
3502
   elsif ($p1 =~ /^(timeout|lost connection) (after [^ ]+)(?: \((?:approximately )?(\d+) bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3503
      my ($lort,$reason,$bytes,$host,$hostip) = ($1,$2,$3,$4,$5);
3504
      if ($lort eq 'timeout') {
3505
         # see also TimeoutInbound in $re_QID section
3506
         #TDsd timeout after RSET from example.com[192.168.0.1]
3507
         #TDsd timeout after DATA (6253 bytes) from example.com[10.0.0.1]
3508
 
3509
         $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
3510
         $Counts{'timeoutinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3511
      } else {
3512
         #TDsd lost connection after CONNECT from mail.example.com[192.168.0.1]
3513
         # postfix 2.5:20071003
3514
         #TDsd lost connection after DATA (494133 bytes) from localhost[127.0.0.1]
3515
         # postfix 2.6:20080621
3516
         #TDsd lost connection after DATA (approximately 0 bytes) from example.com[10.0.0.1]
3517
 
3518
         $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'});
3519
         $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
3520
      }
3521
   }
3522
 
3523
   elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ($re_DSN) Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/o) {
3524
      my ($rej_type,$host,$hostip,$dsn,)  = ($1,$2,$3,$4);
3525
      ($site,$reason) = ($5 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
3526
      $reason =~ s/^reason: // if ($reason);
3527
      $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn));
3528
      #print "REJECT RBL NOQ: '$rej_type'\n";
3529
      # Note: similar code above: search RejectRBL
3530
 
3531
      # This section required: postfix didn't always log QID (eg. postfix 1.1)
3532
      # Also, "reason:" was probably always present in this case, but I'm not certain
3533
      # postfix 1.1
3534
      #TDsd reject_warning: RCPT from example.com[10.0.0.1]: 554 Service unavailable; [10.0.0.1] blocked using orbz.org, reason: Open relay. Please see http://orbz.org/?10.0.0.1; from=<from@example.com> to=<to@sample.net>
3535
      #TDsd reject: RCPT from example.com[10.0.0.2]: 554 Service unavailable; [10.0.0.2] blocked using orbz.org, reason: Open relay. Please see http://orbz.org/?10.0.0.2; from=<from@example.com> to=<to@example.net>
3536
      #TDsd reject: RCPT from unknown[10.0.0.3]: 554 Service unavailable; [10.0.0.3] blocked using bl.spamcop.net, reason: Blocked - see http://www.spamcop.net/bl.shtml?10.0.0.3; from=<from@example.net> to=<to@example.com>
3537
      #TDsd reject: RCPT from example.com[10.0.0.4]: 554 Service unavailable; [10.0.0.4] blocked using sbl.spamhaus.org, reason: http://www.spamhaus.org/SBL/sbl.lasso?query=B12057; from=<from@example.net> to=<to@example.com>
3538
 
3539
      if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
3540
         $fmthost = formathost($hostip,$host);
3541
         $Counts{'byiprejects'}{$fmthost}++;
3542
      }
3543
 
3544
      $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
3545
      $Counts{$reject_name}{$site}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reason ? $reason : ''}++;
3546
   }
3547
 
3548
   # proxy-reject, proxy-accept
3549
   elsif ($p1 =~ s/^proxy-(reject|accept): ([^:]+): //) {
3550
      # 2.7
3551
      #TDsdN proxy-accept: END-OF-MESSAGE: 250 2.0.0 Ok: queued as 9BE3547AFE; from=<senderexample.com> to=<recipientexample.com> proto=ESMTP helo=<client.example.com>
3552
      #TDsdN proxy-reject: END-OF-MESSAGE: 554 5.7.0 Reject, id=11912-03 - INFECTED: Eicar-Test-Signature; from=<root@example.com> to=<root@example.net> proto=ESMTP helo=<example.com>
3553
      #TDsdN proxy-reject: END-OF-MESSAGE: ; from=<user@example.com> to=<user@example.org> proto=SMTP helo=<mail.example.net>
3554
 
3555
      next if $1 eq 'accept';    #ignore accepts
3556
 
3557
      my ($stage) = ($2);
3558
      my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
3559
      #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
3560
      #print "stage: '$stage', reply: '$p1'\n";
3561
 
3562
      my ($dsn,$reject_name);
3563
      ($dsn,$reply) = ($1,$2)    if $p1 =~ /^($re_DSN) (.*)$/o;
3564
      #print "   dsn: '$dsn', reply: '$reply', key: ", get_reject_key($dsn), "\n";
3565
      # DSN may not be present. Can occur, for example, when queue file size limit is reached,
3566
      # which is logged as a Warning.  Ignore these, since they can't be add to any
3567
      # reject section (no SMTP reply code).
3568
      if (! defined $dsn) {
3569
         next;
3570
      }
3571
 
3572
      $Totals{$reject_name = get_reject_key($dsn) . 'rejectproxy' }++; next unless ($Collecting{$reject_name});
3573
      $Counts{$reject_name}{$stage}{$reply}{$eto}++;
3574
   }
3575
 
3576
   ### smtpd_tls_loglevel >= 1
3577
   # Server TLS messages
3578
   elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/)) {
3579
      #TDsd TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3580
      # Postfix 2.5+: status: Untrusted or Trusted
3581
      #TDsd Untrusted TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3582
      #TDsd Anonymous TLS connection established from localhost[127.0.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
3583
 
3584
      $Totals{'tlsserverconnect'}++; next unless ($Collecting{'tlsserverconnect'});
3585
      $Counts{'tlsserverconnect'}{$status ? "$status: $type" : $type}{formathost($hostip,$host)}++;
3586
   }
3587
 
3588
   # Client TLS messages
3589
   elsif ( ($status,$host,$type) = ($p1 =~ /^(?:(Verified|Trusted|Untrusted) )?TLS connection established to ([^ ]*): (.*)$/o)) {
3590
      #TD TLS connection established to example.com: TLSv1 with cipher AES256-SHA (256/256 bits)
3591
      # Postfix 2.5+: peer verification status: Untrusted, Trusted or Verified when
3592
      # server's trust chain is valid and peername is matched
3593
      #TD Verified TLS connection established to 127.0.0.1[127.0.0.1]:26: TLSv1 with cipher DHE-DSS-AES256-SHA (256/256 bits)
3594
 
3595
      $Totals{'tlsclientconnect'}++; next unless ($Collecting{'tlsclientconnect'});
3596
      $Counts{'tlsclientconnect'}{$status ? "$status: $type" : $type}{$host}++;
3597
   }
3598
 
3599
   # smtp_tls_note_starttls_offer=yes
3600
   elsif ($p1 =~ /^Host offered STARTTLS: \[(.*)\]$/o) {
3601
      #TD Host offered STARTTLS: [mail.example.com]
3602
      $Totals{'tlsoffered'}++; next unless ($Collecting{'tlsoffered'});
3603
      $Counts{'tlsoffered'}{$1}++;
3604
   }
3605
 
3606
   ### smtpd_tls_loglevel >= 1
3607
   elsif ($p1 =~ /^Unverified: (.*)/o) {
3608
      #TD Unverified: subject_CN=(www|smtp|mailhost).(example.com|sample.net), issuer=someuser
3609
      $Totals{'tlsunverified'}++; next unless ($Collecting{'tlsunverified'});
3610
      $Counts{'tlsunverified'}{$1}++;
3611
   }
3612
 
3613
   # Note: no QID
3614
   elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<(.*?)> to=<(.*?)>/)) {
3615
      #TD reject: RCPT from size.example.com[192.168.0.1]: 452 Message size exceeds fixed limit; from=<from@example.com> to=<to@sample.net>
3616
      #TD reject: RCPT from size.example.com[192.168.0.1]: 552 Message size exceeds fixed limit; from=<from@example.com> to=<to@sample.net> proto=ESMTP helo=<example.com>
3617
      # Note: similar code above: search RejectSize
3618
      # Note: reject_warning does not seem to occur
3619
      if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
3620
         $fmthost = formathost($hostip,$host);
3621
         $Counts{'byiprejects'}{$fmthost}++;
3622
      }
3623
      $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name});
3624
      $Counts{$reject_name}{$fmthost ? $fmthost : formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++;
3625
   }
3626
 
3627
   elsif ($p1 =~ /looking for plugins in (.*)$/) {
3628
    #TD looking for plugins in '/usr/lib/sasl2', failed to open directory, error: No such file or directory
3629
      $Totals{'warnconfigerror'}++; next unless ($Collecting{'warnconfigerror'});
3630
      $Counts{'warnconfigerror'}{$1}++;
3631
   }
3632
 
3633
   # SMTP/ESMTP protocol violations
3634
   elsif ($p1 =~ /^(improper command pipelining) (after \S+) from ([^[]*)\[([^]]+)\](?::\d+)?/) {
3635
      # ProtocolViolation
3636
      #TDsd postfix/smtpd[24928]: improper command pipelining after RCPT from unknown[192.168.0.1]
3637
      my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3638
      $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3639
      $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3640
   }
3641
 
3642
   elsif ($p1 =~ /^(too many errors) (after [^ ]*)(?: \((?:approximately )?\d+ bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
3643
      my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
3644
      #TDsd too many errors after AUTH from sample.net[10.0.0.1]
3645
      #TDsd too many errors after DATA (0 bytes) from 1-0-0-10.example.com[10.0.0.1]
3646
      $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
3647
      $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
3648
   }
3649
 
3650
   # coerce these into general warnings
3651
   elsif ( $p1 =~ /^cannot load Certificate Authority data/ or
3652
           $p1 =~ /^SSL_connect error to /)
3653
   {
3654
      #TDsQ Cannot start TLS: handshake failure
3655
      #TDsd cannot load Certificate Authority data
3656
      #TDs SSL_connect error to mail.example.com: 0
3657
 
3658
      postfix_warning($p1);
3659
   }
3660
 
3661
   else {
3662
      # add to the unmatched list if not on the ignore_list
3663
      inc_unmatched('final')   if ! in_ignore_list ($p1);
3664
   }
3665
}
3666
 
3667
########################################
3668
# Final tabulations, and report printing
3669
 
3670
for my $code (@RejectKeys) {
3671
   for my $type (@RejectClasses) {
3672
      $Totals{'totalrejects' . $code} += $Totals{$code . $type};
3673
   }
3674
 
3675
   if ($code =~ /^5/o) {
3676
      $Totals{'totalrejects'} += $Totals{'totalrejects' . $code};
3677
   }
3678
}
3679
 
3680
# XXX this was naive - the goal was to avoid recounting messages
3681
# released from quarantine, but externally introduced messages may
3682
# contain resent-message-id; trying to track only internally resent
3683
# messages does not seem useful.
3684
# make some corrections now, due to double counting
3685
#$Totals{'msgsaccepted'} -= $Totals{'resent'}   if ($Totals{'msgsaccepted'} >= $Totals{'resent'});
3686
 
3687
$Totals{'totalacceptplusreject'} = $Totals{'msgsaccepted'} + $Totals{'totalrejects'};
3688
 
3689
# Print the Summary report if any key has non-zero data.
3690
# Note: must explicitely check for any non-zero data,
3691
# as Totals always has some keys extant.
3692
#
3693
if ($Opts{'summary'}) {
3694
   for (keys %Totals) {
3695
      if ($Totals{$_}) {
3696
         print_summary_report (@Sections);
3697
         last;
3698
      }
3699
   }
3700
}
3701
 
3702
# Print the Detail report, if detail is sufficiently high
3703
#
3704
if ($Opts{'detail'} >= 5) {
3705
   #print STDERR "Counts     memory usage: ", commify(Devel::Size::total_size(\%Counts)), "\n";
3706
   #print STDERR "Delays     memory usage: ", commify(Devel::Size::total_size(\%Delays)), "\n";
3707
   print_detail_report(@Sections);
3708
 
3709
   if ($Opts{'delays'}) {
3710
      my @table;
3711
      for (sort keys %Delays) {
3712
         # anon array ref: label, array ref of $Delay{key}
3713
         push @table, [ substr($_,3), $Delays{$_} ];
3714
      }
3715
      if (@table) {
3716
         print_percentiles_report2(\@table, "Delivery Delays Percentiles", $Opts{'delays_percentiles'});
3717
      }
3718
   }
3719
 
3720
   print_postgrey_reports();
3721
 
3722
}
3723
 
3724
# debug: show which ignore_list items are hit most
3725
#my %IGNORED;
3726
#for (sort { $IGNORED{$b} <=> $IGNORED{$a} } keys %IGNORED) {
3727
#   printf "%10d: KEY: %s\n", $IGNORED{$_}, $_;
3728
#}
3729
 
3730
# Finally, print any unmatched lines
3731
#
3732
print_unmatched_report();
3733
 
3734
#
3735
# End of main
3736
#
3737
##################################################
3738
 
3739
# Create the list of REs against which log lines are matched.
3740
# Lines that match any of the patterns in this list are ignored.
3741
#
3742
# Note: This table is created at runtime, due to a Perl bug which
3743
# I reported as perl bug #56202:
3744
#
3745
#    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
3746
#
3747
sub create_ignore_list() {
3748
   # top 3 hitters up front
3749
   push @ignore_list, qr/^statistics:/;
3750
   push @ignore_list, qr/^setting up TLS connection (?:from|to)/;
3751
   push @ignore_list, qr/^Verified: /;
3752
   push @ignore_list, qr/^skipped, still being delivered/;
3753
 
3754
   # SSL info at/above mail.info level
3755
   push @ignore_list, qr/^read from [a-fA-F\d]{8}/;
3756
   push @ignore_list, qr/^write to [a-fA-F\d]{8}/;
3757
   push @ignore_list, qr/^[a-f\d]{4} [a-f\d]{2}/;
3758
   push @ignore_list, qr/^[a-f\d]{4} - <SPACES/;
3759
   push @ignore_list, qr/^[<>]+ /;
3760
 
3761
   push @ignore_list, qr/^premature end-of-input (?:on|from) .* socket while reading input attribute name$/;
3762
   push @ignore_list, qr/^certificate peer name verification failed/;
3763
   push @ignore_list, qr/^Peer certi?ficate could not be verified$/;   # missing i was a postfix typo
3764
   push @ignore_list, qr/^Peer cert verify depth=/;
3765
   push @ignore_list, qr/^Peer verification:/;
3766
   push @ignore_list, qr/^Server certificate could not be verified/;
3767
   push @ignore_list, qr/^cannot load .SA certificate and key data/;
3768
   push @ignore_list, qr/^tlsmgr_cache_run_event/;
3769
   push @ignore_list, qr/^SSL_accept/;
3770
   push @ignore_list, qr/^SSL_connect:/;
3771
   push @ignore_list, qr/^connection (?:closed|established)/;
3772
   push @ignore_list, qr/^delete smtpd session/;
3773
   push @ignore_list, qr/^put smtpd session/;
3774
   push @ignore_list, qr/^save session/;
3775
   push @ignore_list, qr/^Reusing old/;
3776
   push @ignore_list, qr/^looking up session/;
3777
   push @ignore_list, qr/^lookup smtpd session/;
3778
   push @ignore_list, qr/^lookup \S+ type/;
3779
   push @ignore_list, qr/^xsasl_(?:cyrus|dovecot)_/;
3780
   push @ignore_list, qr/^watchdog_/;
3781
   push @ignore_list, qr/^read smtpd TLS/;
3782
   push @ignore_list, qr/^open smtpd TLS/;
3783
   push @ignore_list, qr/^write smtpd TLS/;
3784
   push @ignore_list, qr/^read smtp TLS cache entry/;
3785
   push @ignore_list, qr/^starting TLS engine$/;
3786
   push @ignore_list, qr/^initializing the server-side TLS/;
3787
   push @ignore_list, qr/^global TLS level: /;
3788
   push @ignore_list, qr/^auto_clnt_/;
3789
   push @ignore_list, qr/^generic_checks:/;
3790
   push @ignore_list, qr/^inet_addr_/;
3791
   push @ignore_list, qr/^mac_parse:/;
3792
   push @ignore_list, qr/^cert has expired/;
3793
   push @ignore_list, qr/^daemon started/;
3794
   push @ignore_list, qr/^master_notify:/;
3795
   push @ignore_list, qr/^rewrite_clnt:/;
3796
   push @ignore_list, qr/^rewrite stream/;
3797
   push @ignore_list, qr/^dict_/;
3798
   push @ignore_list, qr/^send attr /;
3799
   push @ignore_list, qr/^match_/;
3800
   push @ignore_list, qr/^input attribute /;
3801
   push @ignore_list, qr/^Run-time/;
3802
   push @ignore_list, qr/^Compiled against/;
3803
   push @ignore_list, qr/^private\//;
3804
   push @ignore_list, qr/^reject_unknown_/;    # don't combine or shorten these reject_ patterns
3805
   push @ignore_list, qr/^reject_unauth_/;
3806
   push @ignore_list, qr/^reject_non_/;
3807
   push @ignore_list, qr/^permit_/;
3808
   push @ignore_list, qr/^idle timeout/;
3809
   push @ignore_list, qr/^get_dns_/;
3810
   push @ignore_list, qr/^dns_/;
3811
   push @ignore_list, qr/^chroot /;
3812
   push @ignore_list, qr/^process generation/;
3813
   push @ignore_list, qr/^fsspace:/;
3814
   push @ignore_list, qr/^master disconnect/;
3815
   push @ignore_list, qr/^resolve_clnt/;
3816
   push @ignore_list, qr/^ctable_/;
3817
   push @ignore_list, qr/^extract_addr/;
3818
   push @ignore_list, qr/^mynetworks:/;
3819
   push @ignore_list, qr/^name_mask:/;
3820
      #TDm reload -- version 2.6-20080814, configuration /etc/postfix
3821
      #TDm reload configuration /etc/postfix
3822
   push @ignore_list, qr/^reload (?:-- version \S+, )?configuration/;
3823
   push @ignore_list, qr/^terminating on signal 15$/;
3824
   push @ignore_list, qr/^verify error:num=/;
3825
   push @ignore_list, qr/^verify return:/;
3826
   push @ignore_list, qr/^nss_ldap: /;
3827
   push @ignore_list, qr/^discarding EHLO keywords: /;
3828
   push @ignore_list, qr/^sql auxprop plugin/;
3829
   push @ignore_list, qr/^sql plugin/;
3830
   push @ignore_list, qr/^sql_select/;
3831
   push @ignore_list, qr/^auxpropfunc error/;
3832
   push @ignore_list, qr/^commit transaction/;
3833
   push @ignore_list, qr/^begin transaction/;
3834
   push @ignore_list, qr/^maps_find: /;
3835
   push @ignore_list, qr/^check_access: /;
3836
   push @ignore_list, qr/^check_domain_access: /;
3837
   push @ignore_list, qr/^check_mail_access: /;
3838
   push @ignore_list, qr/^check_table_result: /;
3839
   push @ignore_list, qr/^mail_addr_find: /;
3840
   push @ignore_list, qr/^mail_addr_map: /;
3841
   push @ignore_list, qr/^mail_flow_put: /;
3842
   push @ignore_list, qr/^smtp_addr_one: /;
3843
   push @ignore_list, qr/^smtp_connect_addr: /;
3844
   push @ignore_list, qr/^smtp_connect_unix: trying: /;
3845
   push @ignore_list, qr/^smtp_find_self: /;
3846
   push @ignore_list, qr/^smtp_get: /;
3847
   push @ignore_list, qr/^smtp_fputs: /;
3848
   push @ignore_list, qr/^smtp_parse_destination: /;
3849
   push @ignore_list, qr/^smtp_sasl_passwd_lookup: /;
3850
   push @ignore_list, qr/^smtpd_check_/;
3851
   push @ignore_list, qr/^smtpd_chat_notify: /;
3852
   push @ignore_list, qr/^been_here: /;
3853
   push @ignore_list, qr/^set_eugid: /;
3854
   push @ignore_list, qr/^deliver_/;
3855
   push @ignore_list, qr/^flush_send_file: queue_id/;
3856
   push @ignore_list, qr/^milter_macro_lookup/;
3857
   push @ignore_list, qr/^milter8/;
3858
   push @ignore_list, qr/^skipping non-protocol event/;
3859
   push @ignore_list, qr/^reply: /;
3860
   push @ignore_list, qr/^event: /;
3861
   push @ignore_list, qr/^trying... /;
3862
   push @ignore_list, qr/ all milters$/;
3863
   push @ignore_list, qr/^vstream_/;
3864
   push @ignore_list, qr/^server features/;
3865
   push @ignore_list, qr/^skipping event/;
3866
   push @ignore_list, qr/^Using /;
3867
   push @ignore_list, qr/^rec_(?:put|get): /;
3868
   push @ignore_list, qr/^subject=/;
3869
   push @ignore_list, qr/^issuer=/;
3870
   push @ignore_list, qr/^pref  /;  # yes, multiple spaces
3871
   push @ignore_list, qr/^request: \d/;
3872
   push @ignore_list, qr/^done incoming queue scan$/;
3873
   push @ignore_list, qr/^qmgr_/;
3874
   push @ignore_list, qr/^trigger_server_accept_fifo: /;
3875
   push @ignore_list, qr/^proxymap stream/;
3876
   push @ignore_list, qr/^(?:start|end) sorted recipient list$/;
3877
   push @ignore_list, qr/^connecting to \S+ port /;
3878
   push @ignore_list, qr/^Write \d+ chars/;
3879
   push @ignore_list, qr/^Read \d+ chars/;
3880
   push @ignore_list, qr/^(?:lookup|delete) smtp session/;
3881
   push @ignore_list, qr/^delete smtp session/;
3882
   push @ignore_list, qr/^(?:reloaded|remove|looking for) session .* cache$/;
3883
   push @ignore_list, qr/^(?:begin|end) \S+ address list$/;
3884
   push @ignore_list, qr/^mapping DSN status/;
3885
   push @ignore_list, qr/^record [A-Z]/;
3886
   push @ignore_list, qr/^dir_/;
3887
   push @ignore_list, qr/^transport_event/;
3888
   push @ignore_list, qr/^read [A-Z](?: |$)/;
3889
   push @ignore_list, qr/^relay: /;
3890
   push @ignore_list, qr/^why: /;
3891
   push @ignore_list, qr/^fp: /;
3892
   push @ignore_list, qr/^path: /;
3893
   push @ignore_list, qr/^level: /;
3894
   push @ignore_list, qr/^recipient: /;
3895
   push @ignore_list, qr/^delivered: /;
3896
   push @ignore_list, qr/^queue_id: /;
3897
   push @ignore_list, qr/^queue_name: /;
3898
   push @ignore_list, qr/^user: /;
3899
   push @ignore_list, qr/^sender: /;
3900
   push @ignore_list, qr/^offset: /;
3901
   push @ignore_list, qr/^offset: /;
3902
   push @ignore_list, qr/^verify stream disconnect/;
3903
   push @ignore_list, qr/^event_request_timer: /;
3904
   push @ignore_list, qr/^smtp_sasl_authenticate: /;
3905
   push @ignore_list, qr/^flush_add: /;
3906
   push @ignore_list, qr/^disposing SASL state information/;
3907
   push @ignore_list, qr/^starting new SASL client/;
3908
   push @ignore_list, qr/^error: dict_ldap_connect: /;
3909
   push @ignore_list, qr/^error: to submit mail, use the Postfix sendmail command/;
3910
   push @ignore_list, qr/^local_deliver[:[]/;
3911
   push @ignore_list, qr/^_sasl_plugin_load /;
3912
   push @ignore_list, qr/^exp_type: /;
3913
   push @ignore_list, qr/^wakeup [\dA-Z]/;
3914
   push @ignore_list, qr/^defer (?:site|transport) /;
3915
   push @ignore_list, qr/^local: /;
3916
   push @ignore_list, qr/^exp_from: /;
3917
   push @ignore_list, qr/^extension: /;
3918
   push @ignore_list, qr/^owner: /;
3919
   push @ignore_list, qr/^unmatched: /;
3920
   push @ignore_list, qr/^domain: /;
3921
   push @ignore_list, qr/^initializing the client-side TLS engine/;
3922
   push @ignore_list, qr/^header_token: /;
3923
   push @ignore_list, qr/^(?:PUSH|POP) boundary/;
3924
   push @ignore_list, qr/^recipient limit \d+$/;
3925
   push @ignore_list, qr/^scan_dir_next: found/;
3926
   push @ignore_list, qr/^open (?:btree|incoming)/;
3927
   push @ignore_list, qr/^Renamed to match inode number/;
3928
   push @ignore_list, qr/^cleanup_[^:]+:/;
3929
   push @ignore_list, qr/^(?:before|after) input_transp_cleanup: /;
3930
   push @ignore_list, qr/^event_enable_read: /;
3931
   push @ignore_list, qr/^report recipient to all milters /;
3932
   push @ignore_list, qr/_action = defer_if_permit$/;
3933
   push @ignore_list, qr/^reject_invalid_hostname: /;
3934
 
3935
   # non-anchored
3936
   #push @ignore_list, qr/: Greylisted for /;
3937
   push @ignore_list, qr/certificate verification (?:depth|failed for)/;
3938
   push @ignore_list, qr/re-using session with untrusted certificate, look for details earlier in the log$/;
3939
   push @ignore_list, qr/socket: wanted attribute: /;
3940
   push @ignore_list, qr/ smtpd cache$/;
3941
   push @ignore_list, qr/ old session$/;
3942
   push @ignore_list, qr/fingerprint=/;
3943
   push @ignore_list, qr/TLS cipher list "/;
3944
}
3945
 
3946
# Evaluates a given line against the list of ignore patterns.
3947
#
3948
sub in_ignore_list($) {
3949
   my $line = shift;
3950
 
3951
   foreach (@ignore_list) {
3952
      #return 1 if $line =~ /$_/;
3953
      if ($line =~ /$_/) {
3954
         #$IGNORED{$_}++;
3955
         return 1;
3956
      }
3957
   }
3958
 
3959
   return 0;
3960
}
3961
 
3962
# Accepts common fields from a standard delivery attempt, processing then
3963
# and returning modified values
3964
#
3965
sub process_delivery_attempt ($ $ $ $) {
3966
   my ($to,$origto,$DDD,$reason) = @_;
3967
 
3968
   $reason =~ s/\((.*)\)/$1/;   # Makes capturing nested parens easier
3969
   # leave $to/$origto undefined, or strip < > chars if not null address (<>).
3970
   defined $to     and $to =     ($to eq '')     ? '<>' : lc $to;
3971
   defined $origto and $origto = ($origto eq '') ? '<>' : lc $origto;
3972
   my ($localpart, $domainpart) = split ('@', $to);
3973
   ($localpart, $domainpart) = ($to, '*unspecified')   if ($domainpart eq '');
3974
   my ($dsn);
3975
 
3976
   # If recipient_delimiter is set, break localpart into user + extension
3977
   # and save localpart in origto if origto is empty
3978
   #
3979
   if ($Opts{'recipient_delimiter'} and $localpart =~ /\Q$Opts{'recipient_delimiter'}\E/o) {
3980
 
3981
      # special cases: never split mailer-daemon or double-bounce
3982
      # or owner- or -request if delim is "-" (dash).
3983
      unless ($localpart =~ /^(?:mailer-daemon|double-bounce)$/i or
3984
          ($Opts{'recipient_delimiter'} eq '-' and $localpart =~ /^owner-.|.-request$/i)) {
3985
         my ($user,$extension) = split (/\Q$Opts{'recipient_delimiter'}\E/, $localpart, 2);
3986
         $origto = $localpart    if ($origto eq '');
3987
         $localpart = $user;
3988
      }
3989
   }
3990
 
3991
   unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) {
3992
      $dsn = '';
3993
   }
3994
 
3995
   if ($Collecting{'delays'} and $DDD =~ m{delay=([\d.]+)(?:, delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+))?}) {
3996
      # Message delivery time stamps
3997
      # delays=a/b/c/d, where
3998
      #   a = time before queue manager, including message transmission
3999
      #   b = time in queue manager
4000
      #   c = connection setup including DNS, HELO and TLS;
4001
      #   d = message transmission time.
4002
      if (defined $2) {
4003
         $Delays{'1: Before qmgr'}{$2}++;
4004
         $Delays{'2: In qmgr'}{$3}++;
4005
         $Delays{'3: Conn setup'}{$4}++;
4006
         $Delays{'4: Transmission'}{$5}++;
4007
      }
4008
      $Delays{'5: Total'}{$1}++;
4009
   }
4010
 
4011
   return ($to,$origto,$localpart,$domainpart,$dsn,$reason);
4012
}
4013
 
4014
# Processes postfix/bounce messages
4015
#
4016
sub postfix_bounce($) {
4017
   my $line = shift;
4018
   my $type;
4019
 
4020
   $line =~ s/^(?:$re_QID): //o;
4021
   if ($line =~ /^(sender|postmaster) non-delivery notification/o) {
4022
      #TDbQ postmaster non-delivery notification: 7446BCD68
4023
      #TDbQ sender non-delivery notification: 7446BCD68
4024
      $type = 'Non-delivery';
4025
   }
4026
   elsif ($line =~ /^(sender|postmaster) delivery status notification/o ) {
4027
      #TDbQ sender delivery status notification: 7446BCD68
4028
      $type = 'Delivery';
4029
   }
4030
   elsif ($line =~ /^(sender|postmaster) delay notification: /o) {
4031
      #TDbQ sender delay notification: AA61EC2F9A
4032
      $type = 'Delayed';
4033
   }
4034
   else {
4035
      inc_unmatched('bounce')   if ! in_ignore_list($line);
4036
      return;
4037
   }
4038
 
4039
   $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'});
4040
   $Counts{'notificationsent'}{$type}{$1}++;
4041
}
4042
 
4043
# Processes postfix/cleanup messages
4044
#   cleanup always has a QID
4045
#
4046
sub postfix_cleanup($) {
4047
   my $line = shift;
4048
   my ($qid,$reply,$fmthost,$reject_name);
4049
 
4050
   ($qid, $line) = ($1, $2)  if ($line =~ /^($re_QID): (.*)$/o );
4051
 
4052
   #TDcQ message-id=<C1BEA2A0.188572%from@example.com>
4053
   return if ($line =~ /^message-id=/);
4054
 
4055
   # milter-reject, milter-hold, milter-discard
4056
   if ($line =~ s/^milter-//) {
4057
      milter_common($line);
4058
      return;
4059
   }
4060
 
4061
   ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps)
4062
   # Note: Bounce
4063
   #   See same code elsewhere "Note: Bounce"
4064
   #TDcQ to=<envto@example.com>,                  relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text...
4065
   #TDcQ to=<envto@example.com>, orig_to=<envto>, relay=none, delay=0.13, delays=0.13/0/0/0, dsn=5.7.1, status=bounced optional text...
4066
   if ($line =~ /^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o) {
4067
      # ($to,$origto,$relay,$DDD,$status,$reason) = ($1,$2,$3,$4,$5,$6);
4068
      if ($5 ne 'bounced' and $5 ne 'SOFTBOUNCE') {
4069
         inc_unmatched('cleanupbounce');
4070
         return;
4071
      }
4072
 
4073
      my ($to,$origto,$relay,$DDD,$reason) = ($1,$2,$3,$4,$6);
4074
      my ($localpart,$domainpart,$dsn);
4075
      ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$DDD,$reason);
4076
 
4077
      ### local bounce
4078
      # XXX local v. remote bounce seems iffy, relative
4079
      if ($relay =~ /^(?:none|local|virtual|maildrop|127\.0\.0\.1|avcheck)/) {
4080
         $Totals{'bouncelocal'}++; return unless ($Collecting{'bouncelocal'});
4081
         $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++;
4082
      }
4083
      ### remote bounce
4084
      else {
4085
         ($reply,$fmthost) = cleanhostreply($reason,$relay,$to ne '' ? $to : '<>',$domainpart);
4086
         $Totals{'bounceremote'}++; return unless ($Collecting{'bounceremote'});
4087
         $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
4088
      }
4089
   }
4090
 
4091
   # *header_checks and body_checks
4092
   elsif (header_body_checks($line)) {
4093
      #print "cleanup: header_body_checks\n";
4094
      return;
4095
   }
4096
 
4097
   #TDcQ resent-message-id=4739073.1
4098
   #TDcQ resent-message-id=<ARF+DXZwLECdxm@mail.example.com>
4099
   #TDcQ resent-message-id=<B19-DVD42188E0example.com>?    <120B11@samplepc>
4100
   elsif ( ($line =~ /^resent-message-id=<?.+>?$/o  )) {
4101
      $Totals{'resent'}++;
4102
   }
4103
 
4104
   #TDcN unable to dlopen .../sasl2/libplain.so.2: .../sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted
4105
   elsif ($line =~ /^unable to dlopen /) {
4106
      # strip extraneous doubling of library path
4107
      $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/);
4108
      postfix_warning($line);
4109
   }
4110
 
4111
   else {
4112
      inc_unmatched('cleanup(last)')   if ! in_ignore_list($line);
4113
   }
4114
}
4115
 
4116
=pod
4117
 header_body_checks
4118
 
4119
  Handle cleanup's header_checks and body_checks, and smtp's smtp_body_checks/smtp_*header_checks
4120
 
4121
  Possible actions that log are:
4122
 
4123
     REJECT optional text...
4124
     DISCARD optional text...
4125
     FILTER transport:destination
4126
     HOLD optional text...
4127
     REDIRECT user@domain
4128
     PREPEND text...
4129
     REPLACE text...
4130
     WARN optional text...
4131
 
4132
     DUNNO and IGNORE are not logged
4133
 
4134
Returns:
4135
   1: if line matched or handled
4136
   0: otherwise
4137
=cut
4138
 
4139
sub header_body_checks($)
4140
{
4141
   my $line = shift;
4142
 
4143
   # bcc, discard, filter, hold, prepend, redirect, reject, replace, warning
4144
   return 0 if ($line !~ /^[bdfhprw]/) or   # short circuit alternation when no match possible
4145
               ($line !~ /^(re(?:ject|direct|place)|filter|hold|discard|prepend|warning|bcc): (header|body|content) (.*)$/);
4146
 
4147
   my ($action,$part,$p3) = ($1,$2,$3);
4148
 
4149
   #print "header_body_checks: action: \"$action\", part: \"$part\", p3: \"$p3\"\n";
4150
 
4151
   my ($trigger,$host,$eto,$p4,$fmthost,$reject_name);
4152
   # $re_QID: reject: body ...
4153
   # $re_QID: reject: header ...
4154
   # $re_QID: reject: content ...
4155
 
4156
 
4157
   if ($p3 =~ /^(.*) from ([^;]+); from=<.*?>(?: to=<(.*?)>)?(?: proto=\S*)?(?: helo=<.*?>)?(?:: (.*)|$)/) {
4158
      ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4);
4159
 
4160
      #    $action   $part  $trigger                                 $host                                              $eto                                                $p4
4161
      #TDcQ reject:   body   Subject: Cheap cialis               from local;                    from=<root@localhost>:                                                       optional text...
4162
      #TDcQ reject:   body   Quality replica watches!!!          from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>: optional text...
4163
      #TDcQ reject:   header To: <user@example.com>              from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4164
      # message_reject_characters (postfix >= 2.3)
4165
      #TDcQ reject:   content Received: by example.com Postfix   from example.com[10.0.0.1];    from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=.example.com>: 5.7.1 disallowed character
4166
 
4167
      #TDcQ filter:   header To: to@example.com                  from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: transport:destination
4168
      #TDcQ hold:     header Message-ID: <user@example.com>      from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4169
      #TDcQ hold:     header Subject: Hold Test                  from local;                    from=<efrom@example.com> to=<eto@sample.net>:                                optional text...
4170
      #TDcQ hold:     header Received: by example.com...from x   from local;                    from=<efrom@example.com>
4171
      #TDcQ hold:     header Received: from x.com (x.com[10.0.0.1])??by example.com (Postfix) with ESMTP id 630BF??for <X>; Thu, 20 Oct 2006 13:27: from example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>
4172
      #      hold:     header Received: from [10.0.0.1] by example.com Thu, 9 Jan 2008 18:06:06 -0500 from sample.net[10.0.0.2]; from=<> to=<to@example.com> proto=SMTP helo=<sample.net>: faked header
4173
      #TDcQ redirect: header From: "Attn Men" <attn@example.com> from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4174
      #TDcQ redirect: header From: "Superman" <attn@example.com> from hb.example.com[10.0.0.2]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4175
      #TDcQ redirect: body   Original drugs                      from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=SMTP  helo=<example.com>: user@domain
4176
      #TDcQ discard:  header Subject: **SPAM** Blah...           from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>
4177
      #TDcQ prepend:  header Rubble: Mr.                         from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: text...
4178
      #TDcQ replace:  header Rubble: flintstone                  from localhost[127.0.0.1];     from=<efrom@apple.com>   to=<eto@sample.net> proto=ESMTP helo=<example.com>: text...
4179
      #TDcQ warning:  header Date: Tues, 99:34:67                from localhost[127.0.0.1];     from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: optional text...
4180
      # BCC action (2.6 experimental branch)
4181
      #TDcQ bcc:      header To: to@example.com                  from hb.example.com[10.0.0.1]; from=<efrom@example.com> to=<eto@sample.net> proto=ESMTP helo=<example.com>: user@domain
4182
 
4183
      # Note: reject_warning does not seem to occur
4184
   }
4185
 
4186
   else {
4187
      # smtp_body_checks, smtp_header_checks, smtp_mime_header_checks, smtp_nested_header_checks (postfix >= 2.5)
4188
      #TDsQ replace:  header Sender:   <from@example.com>                                                                                                                  : Sender:   <fm2@sample.net>
4189
 
4190
      $trigger = $p3; $host = ''; $eto = ''; $p4 = $part eq 'body' ? 'smtp_body_checks' : 'smtp_*header_checks';
4191
 
4192
      #inc_unmatched('header_body_checks');
4193
      #return 1;
4194
   }
4195
 
4196
   #print "   trigger: \"$trigger\", host: \"$host\", eto: \"$eto\", p4: \"$p4\"\n";
4197
   $trigger =~ s/\s+/ /g;
4198
   $trigger = '*unknown reason'    if ($trigger eq '');
4199
   $eto     = '*unknown'           if ($eto     eq '');
4200
 
4201
   my ($trig,$trig_opt,$text);
4202
   if    ($part eq 'header')               { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; }
4203
   elsif ($part eq 'body')                 { $trig = "Body check"; }
4204
   else                                    { $trig = "Content check"; }  # message_reject_characters (postfix >= 2.3)
4205
 
4206
   if ($p4 eq '')                          { $text = '*generic'; $trig_opt = $trig; }
4207
   else                                    { $text = $p4;        $trig_opt = "$trig ($p4)"; }
4208
 
4209
   if    ($host eq 'local')                { $fmthost = formathost('127.0.0.1', 'local'); }
4210
   elsif ($host =~ /([^[]+)\[([^]]+)\]/)   { $fmthost = formathost($2,$1); }
4211
   else                                    { $fmthost = '*unknown'; }
4212
 
4213
   # Note: Counts
4214
   #   Ensure each $Counts{key} accumulator is consistently
4215
   #   used with the same number of hash key levels throughout the code.
4216
   #   For example, $Counts{'hold'} below has 4 keys; ensure that every
4217
   #   other usage of $Counts{'hold'} also has 4 keys.  Currently, it is
4218
   #   OK to set the last key as '', but only the last.
4219
 
4220
   if ($action eq 'reject') {
4221
      $Counts{'byiprejects'}{$fmthost}++                                if $Collecting{'byiprejects'};
4222
 
4223
      # Note: no temporary or reject_warning
4224
      # Note: no reply code - force into a 5xx reject
4225
      # XXX this won't be seen if the user has no 5.. entry in reject_reply_patterns
4226
      $Totals{$reject_name = "5xxreject$part" }++;
4227
      $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++          if $Collecting{$reject_name};
4228
   }
4229
   elsif ( $action eq 'filter' ) {
4230
      $Totals{'filtered'}++;
4231
      $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++     if $Collecting{'filtered'};
4232
   }
4233
   elsif ( $action eq 'hold' ) {
4234
      $Totals{'hold'}++;
4235
      $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++            if $Collecting{'hold'};
4236
   }
4237
   elsif ( $action eq 'redirect' ) {
4238
      $Totals{'redirected'}++;
4239
      $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++   if $Collecting{'redirected'};
4240
   }
4241
   elsif ( $action eq 'discard' ) {
4242
      $Totals{'discarded'}++;
4243
      $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++           if $Collecting{'discarded'};
4244
   }
4245
   elsif ( $action eq 'prepend' ) {
4246
      $Totals{'prepended'}++;
4247
      $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++ if $Collecting{'prepended'};
4248
   }
4249
   elsif ( $action eq 'replace' ) {
4250
      $Totals{'replaced'}++;
4251
      $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++  if $Collecting{'replaced'};
4252
   }
4253
   elsif ( $action eq 'warning' ) {
4254
      $Totals{'warned'}++;
4255
      $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++              if $Collecting{'warned'};
4256
   }
4257
   elsif ( $action eq 'bcc' ) {
4258
      $Totals{'bcced'}++;
4259
      $Counts{'bcced'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++        if $Collecting{'bcced'};
4260
   }
4261
   else {
4262
      inc_unmatched('header_body_checks unexpected action');
4263
   }
4264
 
4265
   return 1;
4266
}
4267
 
4268
 
4269
# Handle common milter actions:
4270
#    milter-reject, milter-hold, milter-discard
4271
# which are created by both smtpd and cleanup
4272
#
4273
sub milter_common($) {
4274
   my $line = shift;
4275
 
4276
   #TDsdN milter-reject: MAIL           from milterS.example.com[10.0.0.1]: 553 5.1.7 address incomplete;                                                                          proto=ESMTP helo=<example.com>
4277
   #TDsdN milter-reject: CONNECT        from milterS.example.com[10.0.0.2]: 451 4.7.1 Service unavailable - try again later; proto=SMTP
4278
   #TDsdQ milter-reject: END-OF-MESSAGE from milterS.example.com[10.0.0.3]: 5.7.1 black listed URL host sample.com by ...uribl.com;  from=<from@sample.com> to=<to@example.net>    proto=ESMTP helo=<example.com>
4279
   #TDsdQ milter-hold:   END-OF-MESSAGE from milterS.example.com[10.0.0.4]: milter triggers HOLD action;                             from=<from@sample.com> to=<to@example.net>    proto=ESMTP helo=<sample.com>
4280
 
4281
   #TDcQ milter-reject:  END-OF-MESSAGE from milterC.example.com[10.0.0.1]: 5.7.1 Some problem;                                      from=<efrom@example.com> to=<eto@sample.net>  proto=SMTP  helo=<example.com>
4282
   #TDcQ milter-reject:  CONNECT        from milterC.example.com[10.0.0.2]: 5.7.1 Some problem;                                                                                    proto=SMTP
4283
   #TDcQ milter-hold:    END-OF-MESSAGE from milterC.example.com[10.0.0.3]: milter triggers HOLD action;                             from=<efrom@example.com> to=<eto@example.net> proto=ESMTP helo=<example.com>
4284
   #TDcQ milter-discard: END-OF-MESSAGE from milterC.example.com[10.0.0.4]: milter triggers DISCARD action;                          from=<efrom@example.com> to=<eto@example.net> proto=ESMTP helo=<example.com>
4285
#   84B82AC8B3: milter-reject: END-OF-MESSAGE from localhost[127.0.0.1]: 5.7.1 Blocked
4286
 
4287
   my ($efrom,$eto,$proto,$helo) = strip_ftph($line);
4288
   #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
4289
   $line =~ s/;$//;
4290
 
4291
   if ($line =~ /^(reject|hold|discard): (\S+) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
4292
 
4293
      my ($action,$stage,$host,$hostip,$reply) = ($1,$2,$3,$4,$5);
4294
      #print "action: '$action', stage: '$stage', host: '$host', hostip: '$hostip', reply: '$reply'\n";
4295
 
4296
      if ($action eq 'reject') {
4297
         my ($dsn,$fmthost,$reject_name);
4298
         ($dsn,$reply) = ($1,$2)    if $reply =~ /^($re_DSN) (.*)$/o;
4299
         #print "   dsn: '$dsn', reply: '$reply'\n";
4300
 
4301
         if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
4302
            $fmthost = formathost($hostip,$host);
4303
            $Counts{'byiprejects'}{$fmthost}++;
4304
         }
4305
         # Note: reject_warning does not seem to occur
4306
         # Note: See rejectmilter elsewhere
4307
         $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; return unless ($Collecting{$reject_name});
4308
         $Counts{$reject_name}{$stage}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reply}++;
4309
      }
4310
      # milter-hold
4311
      elsif ($action eq 'hold') {
4312
         $Totals{'hold'}++; return unless ($Collecting{'hold'});
4313
         $Counts{'hold'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4314
      }
4315
      # milter-discard
4316
      else { # $action eq 'discard'
4317
         $Totals{'discarded'}++; return unless ($Collecting{'discarded'});
4318
         $Counts{'discarded'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
4319
      }
4320
 
4321
   }
4322
   else {
4323
      inc_unmatched('milter_common)');
4324
   }
4325
}
4326
 
4327
sub postfix_dnsblog {
4328
   my $line = shift;
4329
 
4330
   #postfix/dnsblog[16943]: addr 192.168.0.1 listed by domain bl.spamcop.net as 127.0.0.2
4331
   #postfix/dnsblog[78598]: addr 192.168.0.1 blocked by domain zen.spamhaus.org as 127.0.0.11
4332
   if ($line =~ /^addr (\S+) (?:listed|blocked) by domain (\S+) as (\S+)$/) {
4333
      $Counts{'dnsblog'}{$2}{$1}{$3}++  if $Collecting{'dnsblog'};
4334
   }
4335
   else {
4336
      inc_unmatched('dnsblog')   if ! in_ignore_list($line);
4337
      return;
4338
   }
4339
}
4340
 
4341
sub postfix_postscreen {
4342
   my $line = shift;
4343
 
4344
   return if (
4345
      $line =~ /^cache / or
4346
      $line =~ /discarding EHLO keywords: / or
4347
      $line =~ /: discard_mask / or
4348
      $line =~ /: sq=\d+ cq=\d+ event/ or
4349
      $line =~ /: replacing command "/
4350
   );
4351
 
4352
 
4353
   if (($line =~ /^(PREGREET) \d+ (?:after \S+)? from \[([^]]+)\](?::\d+)?/) or
4354
      # PREGREET 20 after 0.31 from [192.168.0.1]:12345: HELO 10.0.0.1??
4355
      # HANGUP after 0.7 from [192.168.0.4]:12345
4356
       ($line =~ /^(HANGUP) (?:after \S+)? from \[([^]]+)\](?::\d+)?/)) {
4357
      $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4358
   }
4359
   elsif ($line =~ /^(WHITELISTED|BLACKLISTED|PASS \S+) \[([^]]+)\](?::\d+)?$/) {
4360
      # PASS NEW [192.168.0.2]:12345
4361
      # PASS OLD [192.168.0.3]:12345
4362
      $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
4363
   }
4364
   elsif ($line =~ /^DNSBL rank (\S+) for \[([^]]+)\](?::\d+)?$/) {
4365
      $Counts{'postscreen'}{'dnsbl'}{$2}{$1}++      if $Collecting{'postscreen'};
4366
   }
4367
 
4368
   elsif ($line =~ /^(CONNECT|COMMAND (?:(?:TIME|COUNT|LENGTH) LIMIT|PIPELINING)|NON-SMTP COMMAND|BARE NEWLINE) from \[([^\]]+)\]:\d+/) {
4369
      # CONNECT from [192.168.1.1]:12345
4370
      $Counts{'postscreen'}{lc($1)}{$2}{$END_KEY}++		if $Collecting{'postscreen'};
4371
   }
4372
   elsif ($line =~ /^DISCONNECT \[([^\]]+)\]:\d+$/) {
4373
      # DISCONNECT [192.168.1.1]:12345
4374
      $Counts{'postscreen'}{'disconnect'}{$1}{$END_KEY}++	if $Collecting{'postscreen'};
4375
   }
4376
 
4377
   elsif ($line =~ /^NOQUEUE: reject: RCPT from \[([^]]+)\](?::\d+)?: ($re_DSN) ([^;]+)/o) {
4378
      #NOQUEUE: reject: RCPT from [192.168.0.1]:12345: 550 5.7.1 Service unavailable; client [192.168.0.1] blocked using b.barracudacentral.org; from=<from@example.com>, to=<to@example.net>, proto=SMTP, helo=<example.com>
4379
      my ($ip,$dsn,$msg) = ($1,$2,$3);
4380
 
4381
      if ($dsn =~ /^([54])/) {
4382
         $Counts{'postscreen'}{$1 . 'xx reject'}{"$dsn $msg"}{$ip}++      if $Collecting{'postscreen'};
4383
      }
4384
      else {
4385
         $Counts{'postscreen'}{'reject'}{"$dsn $msg"}{$ip}{$END_KEY}++      if $Collecting{'postscreen'};
4386
      }
4387
   }
4388
 
4389
   elsif ($line =~ /^NOQUEUE: reject: CONNECT from \[([^]]+)\](?::\d+)?: too many connections/) {
4390
      # NOQUEUE: reject: CONNECT from [192.168.0.1]:7197: too many connections
4391
      $Counts{'postscreen'}{'reject'}{'Too many connections'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4392
   }
4393
 
4394
   elsif ($line =~ /^reject: connect from \[([^]]+)\](?::\d+)?: (.+)$/) {
4395
      # reject: connect from [192.168.0.1]:21225: all screening ports busy
4396
      $Counts{'postscreen'}{'reject'}{"\u$2"}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4397
   }
4398
 
4399
   elsif ($line =~ /^(?:WHITELIST VETO) \[([^]]+)\](?::\d+)?$/) {
4400
      # WHITELIST VETO [192.168.0.8]:43579
4401
      $Counts{'postscreen'}{'whitelist veto'}{$1}{$END_KEY}++	if $Collecting{'postscreen'};
4402
   }
4403
 
4404
   elsif ($line =~ /^(entering|leaving) STRESS mode with (\d+) connections$/) {
4405
      # entering STRESS mode with 90 connections
4406
      $Counts{'postscreen'}{'stress mode: ' . $1}{$2}{$END_KEY}++      if $Collecting{'postscreen'};
4407
   }
4408
 
4409
   elsif ($line =~ /^close database (\S+): No such file or directory/) {
4410
      # close database /var/lib/postfix/postscreen_cache.db: No such file or directory (possible Berkeley DB bug)
4411
      $Counts{'postscreen'}{'close database'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
4412
   }
4413
 
4414
   else {
4415
      inc_unmatched('postscreen')   if ! in_ignore_list($line);
4416
      return;
4417
   }
4418
 
4419
   $Totals{'postscreen'}++;
4420
}
4421
 
4422
 
4423
# Handles postfix/postsuper lines
4424
#
4425
sub postfix_postsuper($) {
4426
   my $line = shift;
4427
 
4428
   return if $line =~ /^Deleted: \d+ messages?$/;
4429
 
4430
   if ($line =~ /^Placed on hold: (\d+) messages?$/o) {
4431
      #TDps Placed on hold: 2 messages
4432
      # Note: See Hold elsewhere
4433
      $Totals{'hold'} += $1; return unless ($Collecting{'hold'});
4434
      $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1;
4435
   }
4436
   elsif ($line =~ /^Released from hold: (\d+) messages?$/o) {
4437
      #TDps Released from hold: 1 message
4438
      $Totals{'releasedfromhold'} += $1;
4439
   }
4440
   elsif ($line =~ /^Requeued: (\d+) messages?$/o) {
4441
      #TDps Requeued: 1 message
4442
      $Totals{'requeued'} += $1;
4443
   }
4444
   elsif (my($qid,$p2) = ($line =~ /($re_QID): (.*)$/)) {
4445
      # postsuper double reports the following 3 lines
4446
      return if ($p2 eq 'released from hold');
4447
      return if ($p2 eq 'placed on hold');
4448
      return if ($p2 eq 'requeued');
4449
 
4450
      if ($p2 =~ /^removed\s*$/o) {
4451
         # Note: See REMOVED elsewhere
4452
         # 52CBDC2E0F: removed
4453
         delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
4454
         $Totals{'removedfromqueue'}++;
4455
      }
4456
      elsif (! in_ignore_list ($p2)) {
4457
         inc_unmatched('postsuper2');
4458
      }
4459
   }
4460
   elsif (! in_ignore_list ($line)) {
4461
      inc_unmatched('postsuper1');
4462
   }
4463
}
4464
 
4465
# Handles postfix panic: lines
4466
#
4467
sub postfix_panic($) {
4468
   #TD panic: myfree: corrupt or unallocated memory block
4469
   $Totals{'panicerror'}++; return unless ($Collecting{'panicerror'});
4470
   $Counts{'panicerror'}{ucfirst($1)}++;
4471
}
4472
 
4473
# Handles postfix fatal: lines
4474
#
4475
sub postfix_fatal($) {
4476
   my ($reason) = shift;
4477
 
4478
   if ($reason =~ /^\S*\(\d+\): Message file too big$/o) {
4479
      #TD fatal: root(0): Message file too big
4480
      $Totals{'fatalfiletoobig'}++;
4481
 
4482
 
4483
   # XXX its not clear this is at all useful - consider falling through to last case
4484
   } elsif ( $reason =~ /^config variable (\S*): (.*)$/o ) {
4485
      #TD fatal: config variable inet_interfaces: host not found: 10.0.0.1:2525
4486
      #TD fatal: config variable inet_interfaces: host not found: all:2525
4487
      $Totals{'fatalconfigerror'}++; return unless ($Collecting{'fatalconfigerror'});
4488
      $Counts{'fatalconfigerror'}{ucfirst($reason)}++;
4489
   }
4490
   else {
4491
      #TD fatal: watchdog timeout
4492
      #TD fatal: bad boolean configuration: smtpd_use_tls =
4493
 
4494
      #TDvN fatal: update queue file active/4B709F060E: File too large
4495
      $reason =~ s/(^update queue file \w+\/)\w+:/$1*:/;
4496
 
4497
      $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'});
4498
      $Counts{'fatalerror'}{ucfirst($reason)}++;
4499
   }
4500
}
4501
# Handles postfix fatal: lines
4502
#
4503
sub postfix_error($) {
4504
   my ($reason) = shift;
4505
   # postfix/postfix-script[4271]: error: unknown command: 'rel'
4506
 
4507
   $Totals{'error'}++; return unless ($Collecting{'fatalerror'});
4508
   $Counts{'error'}{ucfirst($reason)}++;
4509
}
4510
 
4511
# Handles postfix warning: lines
4512
# and additional lines coerced into warnings
4513
#
4514
sub postfix_warning($) {
4515
   my ($warning) = shift;
4516
 
4517
   # Skip these
4518
   return if ($warning =~ /$re_QID: skipping further client input$/o);
4519
   return if ($warning =~ /^Mail system is down -- accessing queue directly$/o);
4520
   return if ($warning =~ /^SASL authentication failure: (?:Password verification failed|no secret in database)$/o);
4521
   return if ($warning =~ /^no MX host for .* has a valid A record$/o);
4522
   return if ($warning =~ /^uid=\d+: Broken pipe$/o);
4523
 
4524
   #TD warning: connect to 127.0.0.1:12525: Connection refused
4525
   #TD warning: problem talking to server 127.0.0.1:12525: Connection refused
4526
   #TD warning: valid_ipv4_hostaddr: invalid octet count:
4527
 
4528
   my ($domain,$to,$type,$site,$helo,$cmd);
4529
   my ($addr,$size,$hostip,$host,$port,$reason,$qid,$queue,$reason2,$process,$status,$service);
4530
 
4531
   if (($hostip,$host,$reason) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): hostname ([^ ]+) verification failed: (.*)$/) or
4532
       ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): (address not listed for hostname) (.*)$/) or
4533
       ($host,$reason,$hostip,$reason2) = ($warning =~ /^(?:smtpd_peer_init: )?hostname (\S+) (does not resolve to address) ([\d.]+)(: host not found, try again)?$/)) {
4534
      #TD warning: 10.0.0.1: hostname sample.com verification failed: Host not found
4535
      #TD warning: smtpd_peer_init: 192.168.0.1: hostname example.com verification failed: Name or service not known
4536
      #TD warning: 192.168.0.1: address not listed for hostname sample.net
4537
      # post 2.8
4538
      #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1: host not found, try again
4539
      #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1
4540
 
4541
      $reason .= $reason2 if $reason2;
4542
      $Totals{'hostnameverification'}++; return unless ($Collecting{'hostnameverification'});
4543
      $Counts{'hostnameverification'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4544
 
4545
   } elsif (($warning =~ /^$re_QID: queue file size limit exceeded$/o) or
4546
            ($warning =~ /^uid=\d+: File too large$/o)) {
4547
      $Totals{'warnfiletoobig'}++;
4548
 
4549
   } elsif ($warning =~ /^database (?:[^ ]*) is older than source file ([\w\/]+)$/o) {
4550
      #TD warning: database /etc/postfix/client_checks.db is older than source file /etc/postfix/client_checks
4551
      $Totals{'databasegeneration'}++; return unless ($Collecting{'databasegeneration'});
4552
      $Counts{'databasegeneration'}{$1}++;
4553
 
4554
   } elsif (($reason,$qid,$reason2) = ($warning =~ /^(open active) ($re_QID): (.*)$/o) or
4555
            ($reason,$qid,$reason2) = ($warning =~ /^qmgr_active_corrupt: (save corrupt file queue active) id ($re_QID): (.*)$/o) or
4556
            ($qid,$reason,$reason2) = ($warning =~ /^($re_QID): (write queue file): (.*)$/o)) {
4557
 
4558
      #TD warning: open active BDB9B1309F7: No such file or directory
4559
      #TD warning: qmgr_active_corrupt: save corrupt file queue active id 4F4272F342: No such file or directory
4560
      #TD warning: E669DE52: write queue file: No such file or directory
4561
 
4562
      $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4563
      $Counts{'queuewriteerror'}{"$reason: $reason2"}{$qid}++;
4564
 
4565
   } elsif (($qid,$reason) = ($warning =~ /^qmgr_active_done_3_generic: remove ($re_QID) from active: (.*)$/o)) {
4566
      #TD warning: qmgr_active_done_3_generic: remove AF0F223FC05 from active: No such file or directory
4567
      $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
4568
      $Counts{'queuewriteerror'}{"remove from active: $reason"}{$qid}++;
4569
 
4570
   } elsif (($queue,$qid) = ($warning =~ /^([^\/]*)\/($re_QID): Error writing message file$/o )) {
4571
      #TD warning: maildrop/C9E66ADF: Error writing message file
4572
      $Totals{'messagewriteerror'}++; return unless ($Collecting{'messagewriteerror'});
4573
      $Counts{'messagewriteerror'}{$queue}{$qid}++;
4574
 
4575
   } elsif (($process,$status) = ($warning =~ /^process ([^ ]*) pid \d+ exit status (\d+)$/o)) {
4576
      #TD warning: process /usr/lib/postfix/smtp pid 9724 exit status 1
4577
      $Totals{'processexit'}++; return unless ($Collecting{'processexit'});
4578
      $Counts{'processexit'}{"Exit status $status"}{$process}++;
4579
 
4580
   } elsif ($warning =~ /^mailer loop: (.*)$/o) {
4581
      #TD warning: mailer loop: best MX host for example.com is local
4582
      $Totals{'mailerloop'}++; return unless ($Collecting{'mailerloop'});
4583
      $Counts{'mailerloop'}{$1}++;
4584
 
4585
   } elsif ($warning =~ /^no (\S+) host for (\S+) has a valid address record$/) {
4586
      #TDs warning: no MX host for example.com has a valid address record
4587
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4588
      $Counts{'dnserror'}{"No $1 host has a valid address record"}{$2}{$END_KEY}++;
4589
 
4590
   } elsif ($warning =~ /^(Unable to look up \S+ host) (.+)$/) {
4591
      #TDsd warning: Unable to look up MX host for example.com: Host not found
4592
      #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known
4593
      #TDsd warning: Unable to look up NS host ns1.example.logal for Sender address bounce@example.local: No address associated with hostname
4594
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4595
 
4596
      my ($problem,$target,$reason) = ($1, split(/: /,$2));
4597
      $reason =~ s/, try again//;
4598
 
4599
      if ($target =~ /^for (\S+)$/) {
4600
         $Counts{'dnserror'}{$problem}{ucfirst($reason)}{$1}{$END_KEY}++;
4601
      }
4602
      elsif ($target =~ /^(\S+)( for \S+ address) (\S+)$/) {
4603
         $Counts{'dnserror'}{$problem . lc($2)}{ucfirst($reason)}{$1}{$3}++;
4604
      }
4605
 
4606
   } elsif ($warning =~ /^((?:malformed|numeric) domain name in .+? of \S+ record) for (.*):(.*)?$/) {
4607
      my ($problem,$domain,$reason) = ($1,$2,$3);
4608
      #TDsd warning: malformed domain name in resource data of MX record for example.com:
4609
      #TDsd warning: malformed domain name in resource data of MX record for example.com: mail.example.com\\032
4610
      #TDsd warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1
4611
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
4612
      $Counts{'dnserror'}{ucfirst($problem)}{$domain}{$reason eq '' ? '*unknown' : $reason}{$END_KEY}++;
4613
 
4614
   } elsif ($warning =~ /^numeric hostname: ([\S]+)$/) {
4615
      #TD warning: numeric hostname: 192.168.0.1
4616
      $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'});
4617
      $Counts{'numerichostname'}{$1}++;
4618
 
4619
   } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/)  or
4620
             ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[([^]]+)\](?::(\d+))?: (.*)$/) or
4621
             ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[([^]]+)\](?::(\d+))?:(?: (.*))?$/o)) {
4622
      # ancient
4623
      #TDsd warning: example.com[192.168.0.1] sent message header instead of SMTP command: From: "Someone" <40245426501example.com>
4624
      # current
4625
      #TDsd warning: non-SMTP command from sample.net[10.0.0.1]: Received: from 192.168.0.1 (HELO bogus.sample.com)
4626
      #TDs warning: 6B01A8DEF: non-ESMTP response from mail.example.com[192.168.0.1]:25:
4627
 
4628
      $Totals{'smtpconversationerror'}++; return unless ($Collecting{'smtpconversationerror'});
4629
      $host .= ' :' . $port   if ($port and $port ne '25');
4630
      $Counts{'smtpconversationerror'}{ucfirst($type)}{formathost($hostip,$host)}{$reason}++;
4631
 
4632
   } elsif ($warning =~ /^valid_hostname: (.*)$/o) {
4633
      #TD warning: valid_hostname: empty hostname
4634
      $Totals{'hostnamevalidationerror'}++; return unless ($Collecting{'hostnamevalidationerror'});
4635
      $Counts{'hostnamevalidationerror'}{$1}++;
4636
 
4637
   } elsif (($host,$hostip,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::\d+)?: SASL (.*) authentication failed(.*)$/)) {
4638
      #TDsd warning: unknown[10.0.0.1]: SASL LOGIN authentication failed: bad protocol / cancel
4639
      #TDsd warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed
4640
      # see saslauthfail elsewhere
4641
      $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'});
4642
      if ($reason) { $reason = $type . $reason; }
4643
      else         { $reason = $type; }
4644
      $Counts{'saslauthfail'}{$reason}{formathost($hostip,$host)}++;
4645
 
4646
   } elsif (($host,$reason) = ($warning =~ /^(\S+): RBL lookup error:.* Name service error for (?:name=)?\1(?: type=[^:]+)?: (.*)$/o)) {
4647
      #TD warning: 192.168.0.1.sbl.spamhaus.org: RBL lookup error: Host or domain name not found. Name service error for name=192.168.0.1.sbl.spamhaus.org type=A: Host not found, try again
4648
 
4649
      #TD warning: 10.0.0.1.relays.osirusoft.com: RBL lookup error: Name service error for 10.0.0.1.relays.osirusoft.com: Host not found, try again
4650
      $Totals{'rblerror'}++; return unless ($Collecting{'rblerror'});
4651
      $Counts{'rblerror'}{$reason}{$host}++;
4652
 
4653
   } elsif (
4654
         ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/ ) or
4655
         ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/ )) {
4656
      #TDs warning: host example.com[192.168.0.1] greeted me with my own hostname example.com
4657
      #TDs warning: host example.com[192.168.0.1] replied to HELO/EHLO with my own hostname example.com
4658
      $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4659
      $Counts{'heloerror'}{ucfirst($reason)}{formathost($hostip,$host)}++;
4660
 
4661
   } elsif (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[([^]]+)\](?::\d+)?$/ )) {
4662
      #TD warning: bad size limit "-679215104" in EHLO reply from example.com[192.168.0.1]
4663
      $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
4664
      $Counts{'heloerror'}{"Bad size limit in EHLO reply"}{formathost($hostip,$host)}{"$size"}++;
4665
 
4666
   } elsif ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[([^]]+)\](?::\d+)? in ([^ ]*) command: (.*)/ )) {
4667
      #TD warning: Illegal address syntax from example.com[192.168.0.1] in MAIL command: user@sample.net
4668
      $addr =~ s/[<>]//g   unless ($addr eq '<>');
4669
      $Totals{'illegaladdrsyntax'}++; return unless ($Collecting{'illegaladdrsyntax'});
4670
      $Counts{'illegaladdrsyntax'}{$cmd}{$addr}{formathost($hostip,$host)}++;
4671
 
4672
   } elsif ($warning =~ /^(timeout|premature end-of-input) on (.+) while reading (.*)$/o
4673
         or $warning =~ /^(malformed (?:base64|numerical)|unexpected end-of-input) from (.+) while reading (.*)$/o) {
4674
 
4675
      #TDs warning: premature end-of-input on private/anvil while reading input attribute name
4676
      #TDs warning: timeout on private/anvil while reading input attribute data
4677
      #TDs warning: unexpected end-of-input from 127.0.0.1:10025 socket while reading input attribute name
4678
      #TDs warning: malformed base64 data from %s while reading input attribute data: ...
4679
      #TDs warning: malformed numerical data from %s while reading input attribute data: ...
4680
 
4681
      $Totals{'attrerror'}++; return unless ($Collecting{'attrerror'});
4682
      $Counts{'attrerror'}{$2}{$1}{$3}++;
4683
 
4684
   } elsif ($warning =~ /^(.*): (bad command startup -- throttling)/o) {
4685
      #TD warning: /usr/libexec/postfix/trivial-rewrite: bad command startup -- throttling
4686
      $Totals{'startuperror'}++; return unless ($Collecting{'startuperror'});
4687
      $Counts{'startuperror'}{ucfirst($2)}{$1}++;
4688
 
4689
   } elsif ($warning =~ /(problem talking to service [^:]*): (.*)$/o) {
4690
      #TD warning: problem talking to service rewrite: Connection reset by peer
4691
      #TD warning: problem talking to service rewrite: Success
4692
      $Totals{'communicationerror'}++; return unless ($Collecting{'communicationerror'});
4693
      $Counts{'communicationerror'}{ucfirst($1)}{$2}++;
4694
 
4695
   } elsif (my ($map,$key) = ($warning =~ /^$re_QID: ([^ ]*) map lookup problem for (.*)$/o)) {
4696
      #TD warning: 6F74F74431: virtual_alias_maps map lookup problem for root@example.com
4697
      $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4698
      $Counts{'mapproblem'}{$map}{$key}++;
4699
 
4700
   } elsif (($map,$reason) = ($warning =~ /^pcre map ([^,]+), (.*)$/o)) {
4701
      #TD warning: pcre map /etc/postfix/body_checks, line 92: unknown regexp option "F": skipping this rule
4702
      $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
4703
      $Counts{'mapproblem'}{$map}{$reason}++;
4704
 
4705
   } elsif (($reason) = ($warning =~ /dict_ldap_lookup: (.*)$/o)) {
4706
      #TD warning: dict_ldap_lookup: Search error 80: Internal (implementation specific) error
4707
      $Totals{'ldaperror'}++; return unless ($Collecting{'ldaperror'});
4708
      $Counts{'ldaperror'}{$reason}++;
4709
 
4710
   } elsif (($type,$size,$host,$hostip,$service) = ($warning =~ /^(.+) limit exceeded: (\d+) from ([^[]+)\[([^]]+)\](?::\d+)? for service (.*)/ )) {
4711
      #TDsd warning: Connection concurrency limit exceeded: 51 from example.com[192.168.0.1] for service smtp
4712
      #TDsd warning: Connection rate limit exceeded: 20 from mail.example.com[192.168.0.1] for service smtp
4713
      #TDsd warning: Connection rate limit exceeded: 30 from unknown[unknown] for service smtp
4714
      #TDsd warning: Recipient address rate limit exceeded: 21 from example.com[10.0.0.1] for service smtp
4715
      #TDsd warning: Message delivery request rate limit exceeded: 11 from example.com[10.0.0.1] for service smtp
4716
      #TDsd warning: New TLS session rate limit exceeded: 49 from example.com[10.0.0.1] for service smtp
4717
      $Totals{'anvil'}++; return unless ($Collecting{'anvil'});
4718
      $Counts{'anvil'}{$service}{$type}{formathost($hostip,$host)}{$size}++;
4719
 
4720
   } elsif (my ($extname,$intname,$limit) = ($warning =~ /service "([^"]+)" \(([^)]+)\) has reached its process limit "([^"]+)":/o)) {
4721
      #TD warning: service "smtp" (25) has reached its process limit "50": new clients may experience noticeable delays
4722
      $Totals{'processlimit'}++; return unless ($Collecting{'processlimit'});
4723
      $Counts{'processlimit'}{'See http://www.postfix.org/STRESS_README.html'}{"$extname ($intname)"}{$limit}++;
4724
 
4725
   } else {
4726
      #TDsd warning: No server certs available. TLS won't be enabled
4727
      #TDs warning: smtp_connect_addr: bind <localip>: Address already in use
4728
 
4729
      # These two messages follow ProcessLimit message above
4730
      #TDm warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client
4731
      #TDm warning: see http://www.postfix.org/STRESS_README.html for examples of stress-dependent configuration settings
4732
      return if ($warning =~ /^to avoid this condition,/o);
4733
      return if ($warning =~ /^see http:\/\/www\.postfix\.org\/STRESS_README.html/o);
4734
 
4735
      #TDsd warning: 009314BD9E: read timeout on cleanup socket
4736
      $warning =~ s/^$re_QID: (read timeout on \S+ socket)/$1/;
4737
 
4738
      #TDsd warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4739
      #TDs warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11
4740
      $warning =~ s/^(Read failed in network_biopair_interop) with .*$/$1/;
4741
 
4742
      $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'});
4743
      $Counts{'warningsother'}{$warning}++;
4744
   }
4745
}
4746
 
4747
# Handles postfix/postfix-script lines
4748
#
4749
sub postfix_script($) {
4750
   my $line = shift;
4751
 
4752
   return if ($line =~ /^the Postfix mail system is running: PID: /o);
4753
 
4754
   if ($line =~ /^starting the Postfix mail system/o) {
4755
      $Totals{'postfixstart'}++;
4756
   }
4757
   elsif ($line =~ /^stopping the Postfix mail system/o) {
4758
      $Totals{'postfixstop'}++;
4759
   }
4760
   elsif ($line =~ /^refreshing the Postfix mail system/o) {
4761
      $Totals{'postfixrefresh'}++;
4762
   }
4763
   elsif ($line =~ /^waiting for the Postfix mail system to terminate/o) {
4764
      $Totals{'postfixwaiting'}++;
4765
   }
4766
   elsif (! in_ignore_list ($line)) {
4767
      inc_unmatched('postfix_script');
4768
   }
4769
}
4770
 
4771
# Clean up a server's reply, to give some uniformity to reports
4772
#
4773
sub cleanhostreply($ $ $ $) {
4774
   my ($hostreply,$relay,$recip,$domain) = @_;
4775
 
4776
   my $fmtdhost = '';
4777
   my ($r1, $r2, $dsn, $msg, $host, $event);
4778
 
4779
   #print "RELAY: $relay, RECIP: $recip, DOMAIN: $domain\n";
4780
   #print "HOSTREPLY: \"$hostreply\"\n";
4781
   return ('Accepted', '*unknown')  if $hostreply =~ /^25\d/o;
4782
 
4783
   # Host or domain name not found. Name service error for name=example.com type=MX: Host not found...
4784
   if ($hostreply =~ /^Host or domain name not found. Name service error for name=([^:]+): Host not found/o) {
4785
      return ('Host not found', $1);
4786
   }
4787
 
4788
   if (($host,$dsn,$r1) = ($hostreply =~ /host (\S+) said: ($re_DSN)[\- :]*"?(.*)"?$/o)) {
4789
      # Strip recipient address from host's reply - we already have it in $recip.
4790
      $r1 =~ s/[<(]?\Q$recip\E[>)]?\W*//ig;
4791
 
4792
      # Strip and capture "in reply to XYZ command" from host's reply
4793
      if ($r1 =~ s/\s*[(]?(?:in reply to (.*) command)[)]?//o) {
4794
         $r2 = ": $1";
4795
      }
4796
      $r1 =~ s/^Recipient address rejected: //o;
4797
      # Canonicalize numerous forms of "recipient unknown"
4798
      if (   $r1 =~ /^user unknown/i
4799
          or $r1 =~ /^unknown user/i
4800
          or $r1 =~ /^unknown recipient address/i
4801
          or $r1 =~ /^invalid recipient/i
4802
          or $r1 =~ /^recipient unknown/i
4803
          or $r1 =~ /^sorry, no mailbox here by that name/i
4804
          or $r1 =~ /^User is unknown/
4805
          or $r1 =~ /^User not known/
4806
          or $r1 =~ /^MAILBOX NOT FOUND/
4807
          or $r1 =~ /^Recipient Rejected: No account by that name here/
4808
          or $r1 =~ /^Recipient does not exist here/
4809
          or $r1 =~ /The email account that you tried to reach does not exist./ # Google's long mess
4810
          or $r1 =~ /(?:no such user|user unknown)/i
4811
         )
4812
      {
4813
         #print "UNKNOWN RECIP: $r1\n";
4814
         $r1 = 'Unknown recipient';
4815
      }
4816
      elsif ($r1 =~ /greylisted/oi) {
4817
         #print "GREYLISTED RECIP: $r1\n";
4818
         $r1 = 'Recipient greylisted';
4819
      }
4820
      elsif ($r1 =~ /^Message temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/o) {
4821
         # Yahoo: 421 Message temporarily deferred - 4.16.51. Please refer to http://... (in reply to end of DATA command))
4822
         $dsn = "$dsn $1"; $r1 = "see $2";
4823
      }
4824
      elsif ($r1 =~ /^Resources temporarily not available - Please try again later \[#(\d\.\d+\.\d+)\]\.$/o) {
4825
         #Yahoo 451 Resources temporarily not available - Please try again later [#4.16.5].
4826
         $dsn = "$dsn $1"; $r1 = "resources not available";
4827
      }
4828
      elsif ($r1 =~ /^Message temporarily deferred - (\[\d+\])/o) {
4829
         # Yahoo: 451 Message temporarily deferred - [160]
4830
         $dsn = "$dsn $1"; $r1 = '';
4831
      }
4832
   }
4833
 
4834
   elsif ($hostreply =~ /^connect to (\S+): (.*)$/o) {
4835
      #print "CONNECT: $hostreply\n";
4836
      $host = $1; $r1 = $2; $r1 =~ s/server refused to talk to me/refused/;
4837
   }
4838
 
4839
   elsif ($hostreply =~ /^host (\S+) refused to talk to me: (.*)$/o) {
4840
      $host = $1; $msg = $2;
4841
      #print "HOSTREFUSED: $hostreply\n";
4842
      #Yahoo: '421 Message from (10.0.0.1) temporarily deferred - 4.16.50. Please refer to http://...
4843
      if ($msg =~ /^(\d+) Message from \([^)]+\) temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/) {
4844
         $dsn = "$1 $2"; $msg = "see $3";
4845
      }
4846
      #$r1 = join(': ', 'refused', $msg);
4847
      $r1 = $msg;
4848
   }
4849
   elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) {
4850
      #print "DELIVERY SUSP: $hostreply\n";
4851
      $host = $2; $r1 = join(': ', $1, $3);
4852
   }
4853
   elsif ($hostreply =~ /^(delivery temporarily suspended: conversation) with (\S+) (.*)$/o) {
4854
      # delivery temporarily suspended: conversation with example.com[10.0.0.1] timed out while receiving the initial server greeting)
4855
      #print "DELIVERY SUSP2: $hostreply\n";
4856
      $host = $2; $r1 = join(' ', $1, $3);
4857
   }
4858
   elsif (($event,$host,$r1) = ($hostreply =~ /^(lost connection|conversation) with (\S+) (.*)$/o)) {
4859
      #print "LOST conv/conn: $hostreply\n";
4860
      $r1 = join(' ',$event,$r1);
4861
   }
4862
   elsif ($hostreply =~ /^(.*: \S+maildrop: Unable to create a dot-lock) at .*$/o) {
4863
      #print "MAILDROP: $hostreply\n";
4864
      $r1 = $1;
4865
   }
4866
   elsif ($hostreply =~ /^mail for (\S+) loops back to myself/o) {
4867
      #print "LOOP: $hostreply\n";
4868
      $host = $1; $r1 = 'mailer loop';
4869
   }
4870
   elsif ($hostreply =~ /^unable to find primary relay for (\S+)$/o) {
4871
      #print "NORELAY: $hostreply\n";
4872
      $host = $1; $r1 = 'no relay found';
4873
   }
4874
   elsif ($hostreply =~ /^message size \d+ exceeds size limit \d+ of server (\S+)\s*$/o) {
4875
      #print "TOOBIG: $hostreply\n";
4876
      $host = $1; $r1 = 'message too big';
4877
   }
4878
   else {
4879
      #print "UNMATCH: $hostreply\n";
4880
      $r1 = $hostreply;
4881
   }
4882
 
4883
   #print "R1: $r1, R2: $r2\n";
4884
   $r1 =~ s/for name=\Q$domain\E //ig;
4885
 
4886
   if ($host eq '') {
4887
      if ($relay =~ /([^[]+)\[([^]]+)\]/) {
4888
         $fmtdhost = formathost($2,$1);
4889
      }
4890
      else {
4891
         $fmtdhost = '*unknown';
4892
      }
4893
   }
4894
   elsif ($host =~ /^([^[]+)\[([^]]+)\]/) {
4895
      $fmtdhost = formathost($2,$1);
4896
   }
4897
   else {
4898
      $fmtdhost = $host;
4899
   }
4900
 
4901
   return (($dsn ? "$dsn " : '' ) . "\u$r1$r2", $fmtdhost);
4902
}
4903
 
4904
# Strip and return from, to, proto, and helo information from a log line
4905
# From is set to the empty envelope sender <> as necessary, and To is
4906
# always lowercased.
4907
#
4908
# Note: modifies its input for efficiency
4909
#
4910
sub strip_ftph($) {
4911
   my ($helo, $proto, $to, $from);
4912
   #print "strip_ftph: '$_[0]\n";
4913
   $helo  =    ($_[0] =~ s/\s+helo=<(.*?)>\s*$//) == 1 ? $1               : '*unavailable';
4914
   $proto =    ($_[0] =~ s/\s+proto=(\S+)\s*$//)  == 1 ? $1               : '*unavailable';
4915
   $to    =    ($_[0] =~ s/\s+to=<(.*?)>\s*$//)   == 1 ? (lc($1) || '<>') : '*unavailable';
4916
   $from  =    ($_[0] =~ s/\s+from=<(.*?)>\s*$//) == 1 ? (   $1  || '<>') : '*unavailable';
4917
 
4918
   #print "helo: $helo, proto: $proto, to: $to, from: $from\n";
4919
   #print "strip_ftph: final: '$_[0]'\n";
4920
   return ($from,$to,$proto,$helo);
4921
}
4922
 
4923
# Initialize the Getopts option list.  Requires the Section table to
4924
# be built already.
4925
#
4926
sub init_getopts_table() {
4927
   print "init_getopts_table: enter\n"  if $Opts{'debug'} & Logreporters::D_ARGS;
4928
 
4929
   init_getopts_table_common(@supplemental_reports);
4930
 
4931
   add_option ('recipient_delimiter=s');
4932
   add_option ('delays!');
4933
   add_option ('show_delays=i',             sub { $Opts{'delays'} = $_[1]; 1; });
4934
   add_option ('delays_percentiles=s');
4935
   add_option ('reject_reply_patterns=s');
4936
   add_option ('ignore_services=s');
4937
   add_option ('postgrey_delays!');
4938
   add_option ('postgrey_show_delays=i',    sub { $Opts{'postgrey_delays'} = $_[1]; 1; });
4939
   add_option ('postgrey_delays_percentiles=s');
4940
   add_option ('unknown!',                  sub { $Opts{'unknown'} = $_[1]; 1; });
4941
   add_option ('show_unknown=i',            sub { $Opts{'unknown'} = $_[1]; 1; });
4942
   add_option ('enable_long_queue_ids=i',   sub { $Opts{'long_queue_ids'} = $_[1]; 1; });
4943
   add_option ('long_queue_ids!');
4944
 
4945
=pod
4946
   # aliases and backwards compatibility
4947
   add_option ('msgsdeferred=s',            \$Opts{'deferred'});
4948
   add_option ('msgsdelivered=s',           \$Opts{'delivered'});
4949
   add_option ('msgssent=s',                \$Opts{'sent'});
4950
   add_option ('msgssentlmtp=s',            \$Opts{'sentlmtp'});
4951
   add_option ('msgsforwarded=s',           \$Opts{'forwarded'});
4952
   add_option ('msgsresent=s',              \$Opts{'resent'});
4953
   add_option ('warn=s',                    \$Opts{'warned'});
4954
   add_option ('held=s',                    \$Opts{'hold'});
4955
=cut
4956
}
4957
 
4958
# Builds the entire @Section table used for data collection
4959
#
4960
# Each Section entry has as many as six fields:
4961
#
4962
#   1. Section array reference
4963
#   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
4964
#   3. Output in Detail report? (must also a %Counts accumulator)
4965
#   4. Numeric output format specifier for Summary report
4966
#   5. Section title for Summary and Detail reports
4967
#   6. A hash to a divisor used to calculate the percentage of a total for that key
4968
#
4969
# Use begin_section_group/end_section_group to create groupings around sections.
4970
#
4971
# Sections can be freely reordered if desired, but maintain proper group nesting.
4972
#
4973
#
4974
# The reject* entries of this table are dynamic, in that they are built based
4975
# upon the value of $Opts{'reject_reply_patterns'}, which can be specified by
4976
# either command line or configuration file.  This allows various flavors, of
4977
# reject sections based on SMTP reply code (eg. 421 45x, 5xx, etc.).  Instead
4978
# of creating special sections for each reject variant, the primary key of each
4979
# reject section could have been the SMTP reply code.  However, this would
4980
# require special-case processing to distinguish 4xx temporary rejects from 5xx
4981
# permanent rejects in various Totals{'totalrejects*'} counts, and in the
4982
# Totals{'totalrejects'} tally.
4983
#
4984
# Sections can be freely reordered if desired.
4985
sub build_sect_table() {
4986
   if ($Opts{'debug'} & Logreporters::D_SECT) {
4987
      print "build_sect_table: enter\n";
4988
      print "\treject patterns: $Opts{'reject_reply_patterns'}\n";
4989
   }
4990
   my $S = \@Sections;
4991
 
4992
   # References to these are used in the Sections table below; we'll predeclare them.
4993
   $Totals{'totalrejects'} = 0;
4994
   $Totals{'totalrejectswarn'} = 0;
4995
   $Totals{'totalacceptplusreject'} = 0;
4996
 
4997
   # Configuration and critical errors appear first
4998
 
4999
   #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
5000
   begin_section_group ($S, 'warnings');
5001
   add_section ($S, 'panicerror',                  1, 'd', '*Panic:   General panic');
5002
   add_section ($S, 'fatalfiletoobig',             0, 'd', '*Fatal:   Message file too big');
5003
   add_section ($S, 'fatalconfigerror',            1, 'd', '*Fatal:   Configuration error');
5004
   add_section ($S, 'fatalerror',                  1, 'd', '*Fatal:   General fatal');
5005
   add_section ($S, 'error',                       1, 'd', '*Error:   General error');
5006
   add_section ($S, 'processlimit',                1, 'd', '*Warning: Process limit reached, clients may delay');
5007
   add_section ($S, 'warnfiletoobig',              0, 'd', '*Warning: Queue file size limit exceeded');
5008
   add_section ($S, 'warninsufficientspace',       0, 'd', '*Warning: Insufficient system storage error');
5009
   add_section ($S, 'warnconfigerror',             1, 'd', '*Warning: Server configuration error');
5010
   add_section ($S, 'queuewriteerror',             1, 'd', '*Warning: Error writing queue file');
5011
   add_section ($S, 'messagewriteerror',           1, 'd', '*Warning: Error writing message file');
5012
   add_section ($S, 'databasegeneration',          1, 'd', '*Warning: Database is older than source file');
5013
   add_section ($S, 'mailerloop',                  1, 'd', '*Warning: Mailer loop');
5014
   add_section ($S, 'startuperror',                1, 'd', '*Warning: Startup error');
5015
   add_section ($S, 'mapproblem',                  1, 'd', '*Warning: Map lookup problem');
5016
   add_section ($S, 'attrerror',                   1, 'd', '*Warning: Error reading attribute data');
5017
   add_section ($S, 'anvil',                       1, 'd', '*Warning: Anvil limit reached');
5018
   add_section ($S, 'processexit',                 1, 'd', 'Process exited');
5019
   add_section ($S, 'hold',                        1, 'd', 'Placed on hold');
5020
   add_section ($S, 'communicationerror',          1, 'd', 'Postfix communications error');
5021
   add_section ($S, 'saslauthfail',                1, 'd', 'SASL authentication failed');
5022
   add_section ($S, 'ldaperror',                   1, 'd', 'LDAP error');
5023
   add_section ($S, 'warningsother',               1, 'd', 'Miscellaneous warnings');
5024
   add_section ($S, 'totalrejectswarn',            0, 'd', 'Reject warnings (warn_if_reject)');
5025
   end_section_group ($S, 'warnings');
5026
 
5027
   begin_section_group ($S, 'bytes', "\n");
5028
   add_section ($S, 'bytesaccepted',               0, 'Z', 'Bytes accepted ');           # Z means print scaled as in 1k, 1m, etc.
5029
   add_section ($S, 'bytessentsmtp',               0, 'Z', 'Bytes sent via SMTP');
5030
   add_section ($S, 'bytessentlmtp',               0, 'Z', 'Bytes sent via LMTP');
5031
   add_section ($S, 'bytesdelivered',              0, 'Z', 'Bytes delivered');
5032
   add_section ($S, 'bytesforwarded',              0, 'Z', 'Bytes forwarded');
5033
   end_section_group ($S, 'bytes', $sep1);
5034
 
5035
   begin_section_group ($S, 'acceptreject', "\n");
5036
   begin_section_group ($S, 'acceptreject2', "\n");
5037
   add_section ($S, 'msgsaccepted',                0, 'd', 'Accepted',                          \$Totals{'totalacceptplusreject'});
5038
   add_section ($S, 'totalrejects',                0, 'd', 'Rejected',                          \$Totals{'totalacceptplusreject'});
5039
   end_section_group ($S, 'acceptreject2', $sep2);
5040
   add_section ($S, 'totalacceptplusreject',       0, 'd', 'Total',                             \$Totals{'totalacceptplusreject'});
5041
   end_section_group ($S, 'acceptreject', $sep1);
5042
 
5043
   # The various Reject sections are built dynamically based upon a list of reject reply keys,
5044
   # which are user-configured via $Opts{'reject_reply_patterns'}
5045
   @RejectPats = ();
5046
   foreach my $rejpat (split /[ ,]/, $Opts{'reject_reply_patterns'}) {
5047
      if ($rejpat !~ /^(warn|[45][\d.]{2})$/io) {
5048
         print STDERR usage "Invalid pattern \"$rejpat\" in reject_reply_patterns";
5049
         exit (2);
5050
      }
5051
      if (grep (/\Q$rejpat\E/, @RejectPats) == 0) {
5052
         push @RejectPats, $rejpat
5053
      }
5054
      else {
5055
         print STDERR "Ignoring duplicate pattern \"$rejpat\" in reject_reply_patterns\n";
5056
      }
5057
   }
5058
   @RejectKeys = @RejectPats;
5059
   for (@RejectKeys) {
5060
      s/\./x/g;
5061
   }
5062
 
5063
   print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n"  if $Opts{'debug'} & Logreporters::D_SECT;
5064
 
5065
   # Add reject variants
5066
   foreach my $key (@RejectKeys) {
5067
      $key   = lc($key);
5068
      my $keyuc = ucfirst($key);
5069
      my $totalsref = \$Totals{'totalrejects' . $key};
5070
      print "\t   reject key: $key\n" if $Opts{'debug'} & Logreporters::D_SECT;
5071
 
5072
      begin_section_group ($S, 'rejects', "\n");
5073
      begin_section_group ($S, 'rejects2', "\n");
5074
      add_section ($S, $key . 'rejectrelay',                 1, 'd', $keyuc . ' Reject relay denied',                $totalsref);
5075
      add_section ($S, $key . 'rejecthelo',                  1, 'd', $keyuc . ' Reject HELO/EHLO',                   $totalsref);
5076
      add_section ($S, $key . 'rejectdata',                  1, 'd', $keyuc . ' Reject DATA',                        $totalsref);
5077
      add_section ($S, $key . 'rejectunknownuser',           1, 'd', $keyuc . ' Reject unknown user',                $totalsref);
5078
      add_section ($S, $key . 'rejectrecip',                 1, 'd', $keyuc . ' Reject recipient address',           $totalsref);
5079
      add_section ($S, $key . 'rejectsender',                1, 'd', $keyuc . ' Reject sender address',              $totalsref);
5080
      add_section ($S, $key . 'rejectclient',                1, 'd', $keyuc . ' Reject client host',                 $totalsref);
5081
      add_section ($S, $key . 'rejectunknownclient',         1, 'd', $keyuc . ' Reject unknown client host',         $totalsref);
5082
      add_section ($S, $key . 'rejectunknownreverseclient',  1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref);
5083
      add_section ($S, $key . 'rejectunverifiedclient',      1, 'd', $keyuc . ' Reject unverified client host',      $totalsref);
5084
      add_section ($S, $key . 'rejectrbl',                   1, 'd', $keyuc . ' Reject RBL',                         $totalsref);
5085
      add_section ($S, $key . 'rejectheader',                1, 'd', $keyuc . ' Reject header',                      $totalsref);
5086
      add_section ($S, $key . 'rejectbody',                  1, 'd', $keyuc . ' Reject body',                        $totalsref);
5087
      add_section ($S, $key . 'rejectcontent',               1, 'd', $keyuc . ' Reject content',                     $totalsref);
5088
      add_section ($S, $key . 'rejectsize',                  1, 'd', $keyuc . ' Reject message size',                $totalsref);
5089
      add_section ($S, $key . 'rejectmilter',                1, 'd', $keyuc . ' Reject milter',                      $totalsref);
5090
      add_section ($S, $key . 'rejectproxy',                 1, 'd', $keyuc . ' Reject proxy',                       $totalsref);
5091
      add_section ($S, $key . 'rejectinsufficientspace',     1, 'd', $keyuc . ' Reject insufficient space',          $totalsref);
5092
      add_section ($S, $key . 'rejectconfigerror',           1, 'd', $keyuc . ' Reject server config error',         $totalsref);
5093
      add_section ($S, $key . 'rejectverify',                1, 'd', $keyuc . ' Reject VRFY',                        $totalsref);
5094
      add_section ($S, $key . 'rejectetrn',                  1, 'd', $keyuc . ' Reject ETRN',                        $totalsref);
5095
      add_section ($S, $key . 'rejectlookupfailure',         1, 'd', $keyuc . ' Reject temporary lookup failure',    $totalsref);
5096
      end_section_group ($S, 'rejects2', $sep2);
5097
      add_section ($S, 'totalrejects' . $key,                0, 'd', "Total $keyuc Rejects",                         $totalsref);
5098
      end_section_group ($S, 'rejects', $sep1);
5099
 
5100
      $Totals{'totalrejects' . $key} = 0;
5101
   }
5102
 
5103
   begin_section_group ($S, 'byiprejects', "\n");
5104
   add_section ($S,  'byiprejects',                 1, 'd', 'Reject by IP');
5105
   end_section_group ($S, 'byiprejects');
5106
 
5107
   begin_section_group ($S, 'general1', "\n");
5108
   add_section ($S, 'connectioninbound',           1, 'd', 'Connections');
5109
   add_section ($S, 'connectionlostinbound',       1, 'd', 'Connections lost (inbound)');
5110
   add_section ($S, 'connectionlostoutbound',      1, 'd', 'Connections lost (outbound)');
5111
   add_section ($S, 'disconnection',               0, 'd', 'Disconnections');
5112
   add_section ($S, 'removedfromqueue',            0, 'd', 'Removed from queue');
5113
   add_section ($S, 'delivered',                   1, 'd', 'Delivered');
5114
   add_section ($S, 'sent',                        1, 'd', 'Sent via SMTP');
5115
   add_section ($S, 'sentlmtp',                    1, 'd', 'Sent via LMTP');
5116
   add_section ($S, 'forwarded',                   1, 'd', 'Forwarded');
5117
   add_section ($S, 'resent',                      0, 'd', 'Resent');
5118
   add_section ($S, 'deferred',                    1, 'd', 'Deferred');
5119
   add_section ($S, 'deferrals',                   1, 'd', 'Deferrals');
5120
   add_section ($S, 'bouncelocal',                 1, 'd', 'Bounced (local)');
5121
   add_section ($S, 'bounceremote',                1, 'd', 'Bounced (remote)');
5122
   add_section ($S, 'bouncefailed',                1, 'd', 'Bounce failure');
5123
   add_section ($S, 'postscreen',                  1, 'd', 'Postscreen');
5124
   add_section ($S, 'dnsblog',                     1, 'd', 'DNSBL log');
5125
 
5126
   add_section ($S, 'envelopesenders',             1, 'd', 'Envelope senders');
5127
   add_section ($S, 'envelopesenderdomains',       1, 'd', 'Envelope sender domains');
5128
 
5129
   add_section ($S, 'bcced',                       1, 'd', 'BCCed');
5130
   add_section ($S, 'filtered',                    1, 'd', 'Filtered');
5131
   add_section ($S, 'redirected',                  1, 'd', 'Redirected');
5132
   add_section ($S, 'discarded',                   1, 'd', 'Discarded');
5133
   add_section ($S, 'prepended',                   1, 'd', 'Prepended');
5134
   add_section ($S, 'replaced',                    1, 'd', 'Replaced');
5135
   add_section ($S, 'warned',                      1, 'd', 'Warned');
5136
 
5137
   add_section ($S, 'requeued',                    0, 'd', 'Requeued messages');
5138
   add_section ($S, 'returnedtosender',            1, 'd', 'Expired and returned to sender');
5139
   add_section ($S, 'notificationsent',            1, 'd', 'Notifications sent');
5140
 
5141
   add_section ($S, 'policyspf',                   1, 'd', 'Policy SPF');
5142
   add_section ($S, 'policydweight',               1, 'd', 'Policyd-weight');
5143
   add_section ($S, 'postfwd',                     1, 'd', 'Postfwd');
5144
   add_section ($S, 'postgrey',                    1, 'd', 'Postgrey');
5145
   end_section_group ($S, 'general1');
5146
 
5147
   begin_section_group ($S, 'general2', "\n");
5148
   add_section ($S, 'connecttofailure',            1, 'd', 'Connection failures (outbound)');
5149
   add_section ($S, 'timeoutinbound',              1, 'd', 'Timeouts (inbound)');
5150
   add_section ($S, 'heloerror',                   1, 'd', 'HELO/EHLO conversations errors');
5151
   add_section ($S, 'illegaladdrsyntax',           1, 'd', 'Illegal address syntax in SMTP command');
5152
   add_section ($S, 'released',                    0, 'd', 'Released from hold');
5153
   add_section ($S, 'rblerror',                    1, 'd', 'RBL lookup errors');
5154
   add_section ($S, 'dnserror',                    1, 'd', 'DNS lookup errors');
5155
   add_section ($S, 'numerichostname',             1, 'd', 'Numeric hostname');
5156
   add_section ($S, 'smtpconversationerror',       1, 'd', 'SMTP dialog errors');
5157
   add_section ($S, 'hostnameverification',        1, 'd', 'Hostname verification errors (FCRDNS)');
5158
   add_section ($S, 'hostnamevalidationerror',     1, 'd', 'Hostname validation errors');
5159
   add_section ($S, 'smtpprotocolviolation',       1, 'd', 'SMTP protocol violations');
5160
   add_section ($S, 'deliverable',                 1, 'd', 'Deliverable (address verification)');
5161
   add_section ($S, 'undeliverable',               1, 'd', 'Undeliverable (address verification)');
5162
   add_section ($S, 'tablechanged',                0, 'd', 'Restarts due to lookup table change');
5163
   add_section ($S, 'pixworkaround',               1, 'd', 'PIX workaround enabled');
5164
   add_section ($S, 'tlsserverconnect',            1, 'd', 'TLS connections (server)');
5165
   add_section ($S, 'tlsclientconnect',            1, 'd', 'TLS connections (client)');
5166
   add_section ($S, 'saslauth',                    1, 'd', 'SASL authenticated messages');
5167
   add_section ($S, 'tlsunverified',               1, 'd', 'TLS certificate unverified');
5168
   add_section ($S, 'tlsoffered',                  1, 'd', 'Host offered TLS');
5169
   end_section_group ($S, 'general2');
5170
 
5171
   begin_section_group ($S, 'postfixstate', "\n");
5172
   add_section ($S, 'postfixstart',                0, 'd', 'Postfix start');
5173
   add_section ($S, 'postfixstop',                 0, 'd', 'Postfix stop');
5174
   add_section ($S, 'postfixrefresh',              0, 'd', 'Postfix refresh');
5175
   add_section ($S, 'postfixwaiting',              0, 'd', 'Postfix waiting to terminate');
5176
   end_section_group ($S, 'postfixstate');
5177
 
5178
 
5179
   if ($Opts{'debug'} & Logreporters::D_SECT) {
5180
      print "\tSection table\n";
5181
      printf "\t\t%s\n", (ref($_) eq 'HASH' ? $_->{NAME} : $_) foreach @Sections;
5182
      print "build_sect_table: exit\n"
5183
   }
5184
}
5185
 
5186
# XXX create array of defaults for detail <5, 5-9, >10
5187
sub init_defaults() {
5188
   map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
5189
   if (! $Opts{'standalone'}) {
5190
      # LOGWATCH
5191
      # these take affect if no env present (eg. nothing in conf file)
5192
      # 0 to 4 nodelays
5193
 
5194
      if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
5195
         $Opts{'delays'}            = 0;
5196
         $Opts{'postgrey_delays'}   = 0;
5197
      }
5198
   }
5199
}
5200
 
5201
 
5202
# XXX ensure something is matched?
5203
# XXX cache values so we don't have to substitute X for . each time
5204
#match $dsn against list for best fit
5205
sub get_reject_key($) {
5206
   my $reply = shift;
5207
   my $replyorig = $reply;
5208
   ($reply) = split / /, $reply;
5209
   for (my $i = 0; $i <= $#RejectPats; $i++) {
5210
      #print "TRYING: $RejectPats[$i]\n";
5211
      # we'll allow extended DSNs to match (eg. 5.7.1 will match 5..)
5212
      if ($reply =~ /^$RejectPats[$i]/) {    # no /o here, pattern varies
5213
         #print "MATCHED: orig: $replyorig, reply $reply matched pattern $RejectPats[$i], returning $RejectKeys[$i]\n";
5214
         return $RejectKeys[$i];
5215
      }
5216
   }
5217
   #print "NOT MATCHED: REPLY CODE: '$replyorig', '$reply'\n";
5218
   return;
5219
}
5220
 
5221
# Replace bare reject limiters with specific reject limiters
5222
# based on reject_reply_patterns
5223
#
5224
sub expand_bare_reject_limiters()
5225
{
5226
  # don't reorder the list of limiters.  This breaks --nodetail followed by a
5227
  # bare reject such as --limit rejectrbl=10.  Reordering is no longer necessary
5228
  # since process_limiters was instituted and using the special __none__ pseudo-
5229
  # limiter to indicate the position at which --nodefailt was found on the command
5230
  # line.
5231
  # my ($limiter, @reject_limiters, @non_reject_limiters);
5232
   my ($limiter, @new_list);
5233
 
5234
   # XXX check if limiter matches just one in rejectclasses
5235
   while ($limiter = shift @Limiters) {
5236
      if ($limiter =~ /^reject[^_]/) {
5237
         foreach my $reply_code (@RejectKeys) {
5238
            printf "bare_reject: \L$reply_code$limiter\n"  if $Opts{'debug'} & Logreporters::D_VARS;
5239
            #push @reject_limiters, lc($reply_code) . $limiter;
5240
            push @new_list, lc($reply_code) . $limiter;
5241
         }
5242
      }
5243
      elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) {
5244
         $limiter =~ s/^([45])\.\./$1xx/;
5245
         #push @reject_limiters, lc $limiter;
5246
         push @new_list, lc $limiter;
5247
      }
5248
      else {
5249
         #push @non_reject_limiters, $limiter;
5250
         push @new_list, $limiter;
5251
      }
5252
   }
5253
   #@Limiters = (@reject_limiters, @non_reject_limiters);
5254
   @Limiters = @new_list;
5255
}
5256
 
5257
 
5258
# Return a usage string,  built from:
5259
#    arg1 +
5260
#    $usage_str +
5261
#    a string built from each usable entry in the @Sections table.
5262
# reject patterns are special cased to minimize the number of
5263
# command line options presented.
5264
#
5265
sub usage($) {
5266
   my $ret = "";
5267
   $ret = "@_\n"  if ($_[0]);
5268
 
5269
   $ret .= $usage_str;
5270
   my ($name, $desc, %reject_types);
5271
   foreach my $sect (get_usable_sectvars(@Sections, 0)) {
5272
 
5273
      if (my ($code,$rej) = ($sect->{NAME} =~ /^(...|warn)(reject.*)$/oi)) {
5274
         $rej = lc $rej;
5275
         next if (exists $reject_types{$rej});
5276
         $reject_types{$rej}++;
5277
         $name = '[###]' . $rej;
5278
         $desc = '###' . substr($sect->{TITLE}, length($code));
5279
      }
5280
      else {
5281
         $name = lc $sect->{NAME};
5282
         $desc = $sect->{TITLE};
5283
      }
5284
      $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
5285
   }
5286
   $ret .= "\n";
5287
   return $ret;
5288
}
5289
 
5290
1;
5291
 
5292
# vi: shiftwidth=3 tabstop=3 syntax=perl et