logwatch 7.4.1-2 / usr / share / logwatch / scripts / services / postfix

#!/usr/bin/perl

##########################################################################
# Postfix-logwatch: written and maintained by:
#
#    Mike "MrC" Cappella <mike (at) cappella (dot) us>
#      http://logreporters.sourceforge.net/
#
# Please send all comments, suggestions, bug reports regarding this
# program/module to the email address above.  I will respond as quickly
# as possible. [MrC]
#
# Questions regarding the logwatch program itself should be directed to
# the logwatch project at:
#   http://sourceforge.net/projects/logwatch/support
#
#######################################################
### All work since Dec 12, 2006 (logwatch CVS revision 1.28)
### Copyright (c) 2006-2012  Mike Cappella
### 
### Covered under the included MIT/X-Consortium License:
###    http://www.opensource.org/licenses/mit-license.php
### All modifications and contributions by other persons to
### this script are assumed to have been donated to the
### Logwatch project and thus assume the above copyright
### and licensing terms.  If you want to make contributions
### under your own copyright or a different license this
### must be explicitly stated in the contribution an the
### Logwatch project reserves the right to not accept such
### contributions.  If you have made significant
### contributions to this script and want to claim
### copyright please contact logwatch-devel@lists.sourceforge.net.
##########################################################

##########################################################################
# The original postfix logwatch filter was written by
# Kenneth Porter, and has had many contributors over the years.
#
# CVS log removed: see Changes file for postfix-logwatch at
#    http://logreporters.sourceforge.net/
# or included with the standalone postfix-logwatch distribution
##########################################################################

##########################################################################
#
# Test data included via inline comments starting with "#TD"
#

#use Devel::Size qw(size total_size);
 
package Logreporters;
use 5.008;
use strict;
use warnings;
no warnings "uninitialized";
use re 'taint';

our $Version          = '1.40.03';
our $progname_prefix  = 'postfix';

# Specifies the default configuration file for use in standalone mode.
my $config_file = "/usr/local/etc/${progname_prefix}-logwatch.conf";

# support postfix long (2.9+) or short queue ids
my $re_QID_s   = qr/[A-Z\d]+/;
my $re_QID_l   = qr/(?:NOQUEUE|[bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ\d]+)/;
our $re_QID;

our $re_DSN     = qr/(?:(?:\d{3})?(?: ?\d\.\d\.\d)?)/;
our $re_DDD     = qr/(?:(?:conn_use=\d+ )?delay=-?[\d.]+(?:, delays=[\d\/.]+)?(?:, dsn=[\d.]+)?)/;

#MODULE: ../Logreporters/Utils.pm
package Logreporters::Utils;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.003';
   @ISA = qw(Exporter);
   @EXPORT = qw(&formathost &get_percentiles &get_percentiles2 &get_frequencies &commify &unitize
                &get_usable_sectvars &add_section &begin_section_group &end_section_group
                &get_version &unique_list);
   @EXPORT_OK = qw(&gen_test_log);
}

use subs qw (@EXPORT @EXPORT_OK);


# Formats IP and hostname for even column spacing
#
sub formathost($ $) {
   # $_[0] : hostip
   # $_[1] : hostname;

   if (! $Logreporters::Config::Opts{'unknown'} and $_[1] eq 'unknown') {
      return $_[0];
   }

   return sprintf "%-$Logreporters::Config::Opts{'ipaddr_width'}s  %s",
      $_[0] eq '' ? '*unknown' :    $_[0],
      $_[1] eq '' ? '*unknown' : lc $_[1];
}

# Add a new section to the end of a section table
#
sub add_section($$$$$;$) {
   my $sref = shift;
   die "Improperly specified Section entry: $_[0]" if !defined $_[3];

   my $entry  = {
      CLASS     => 'DATA',
      NAME      => $_[0],
      DETAIL    => $_[1],
      FMT       => $_[2],
      TITLE     => $_[3],
   };
   $entry->{'DIVISOR'}   = $_[4] if defined $_[4];
   push @$sref, $entry;
}

{
my $group_level = 0;

# Begin a new section group.  Groups can nest.
#
sub begin_section_group($;@) {
   my $sref = shift;
   my $group_name = shift;
   my $entry  = {
      CLASS     => 'GROUP_BEGIN',
      NAME      => $group_name,
      LEVEL     => ++$group_level,
      HEADERS   => [ @_ ],
   };
   push @$sref, $entry;
}

# Ends a section group.
#
sub end_section_group($;@) {
   my $sref = shift;
   my $group_name = shift;
   my $entry  = {
      CLASS     => 'GROUP_END',
      NAME      => $group_name,
      LEVEL     => --$group_level,
      FOOTERS   => [ @_ ],
   };
   push @$sref, $entry;
}
}

# Generate and return a list of section table entries or
# limiter key names, skipping any formatting entries.
# If 'namesonly' is set, limiter key names are returned,
# otherwise an array of section array records is returned.
sub get_usable_sectvars(\@ $) {
   my ($sectref,$namesonly) = @_;
   my (@sect_list, %unique_names);

   foreach my $sref (@$sectref) {
      #print "get_usable_sectvars: $sref->{NAME}\n";
      next unless $sref->{CLASS} eq 'DATA';
      if ($namesonly) {
         $unique_names{$sref->{NAME}} = 1;
      }
      else {
         push @sect_list, $sref;
      }
   }
   # return list of unique names
   if ($namesonly) {
      return keys %unique_names;
   }
   return @sect_list;
}

# Print program and version info, preceeded by an optional string, and exit.
# 
sub get_version() {

   print STDOUT "@_\n"  if ($_[0]);
   print STDOUT "$Logreporters::progname: $Logreporters::Version\n";
   exit 0;
}


# Returns a list of percentile values given a
# sorted array of numeric values.  Uses the formula:
#
# r = 1 + (p(n-1)/100) = i + d  (Excel method)
#
# r = rank
# p = desired percentile
# n = number of items
# i = integer part
# d = decimal part
#
# Arg1 is an array ref to the sorted series
# Arg2 is a list of percentiles to use

sub get_percentiles(\@ @) {
   my ($aref,@plist) = @_;
   my ($n, $last, $r, $d, $i, @vals, $Yp);

   $last = $#$aref;
   $n = $last + 1;
   #printf "%6d" x $n . "\n", @{$aref};

   #printf "n: %4d, last: %d\n", $n, $last;
   foreach my $p (@plist) {
      $r = 1 + ($p * ($n - 1) / 100.0);
      $i = int ($r);		# integer part
      # domain: $i = 1 .. n
      if ($i == $n) {
        $Yp = $aref->[$last];
      }
      elsif ($i == 0) {
        $Yp = $aref->[0];
        print "CAN'T HAPPEN: $Yp\n";
      }
      else {
         $d = $r - $i;		# decimal part
	 #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
         $Yp = $aref->[$i-1] + ($d * ($aref->[$i] - $aref->[$i-1]));
      }
      #printf "\np(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d", $p, $r, $i, $d, $Yp;
      push @vals, $Yp;
   }

   return @vals;
}

sub get_num_scores($) {
   my $scoretab_r = shift;

   my $totalscores = 0;

   for (my $i = 0; $i < @$scoretab_r; $i += 2) {
      $totalscores += $scoretab_r->[$i+1]
   }

   return $totalscores;
}

# scoretab
#
#  (score1, n1), (score2, n2), ... (scoreN, nN) 
#     $i   $i+1
#
# scores are 0 based (0 = 1st score)
sub get_nth_score($ $) {
   my ($scoretab_r, $n) = @_;

   my $i = 0;
   my $n_cur_scores = 0;
   #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";

   while ($i < $#$scoretab_r) {
      #print "Samples_seen: $n_cur_scores\n";
      $n_cur_scores += $scoretab_r->[$i+1];
      if ($n_cur_scores >= $n) {
         #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];
         #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];
         return $scoretab_r->[$i];
      }

      $i += 2;
   }
   print "returning last score $scoretab_r->[$i]\n";
   return $scoretab_r->[$i];
}

sub get_percentiles2(\@ @) {
   my ($scoretab_r, @plist) = @_;
   my ($n, $last, $r, $d, $i, @vals, $Yp);

   #$last = $#$scoretab_r - 1;
   $n = get_num_scores($scoretab_r);
   #printf "\n%6d" x $n . "\n", @{$scoretab_r};

   #printf "\n\tn: %4d, @$scoretab_r\n", $n;
   foreach my $p (@plist) {
  ###print "\nPERCENTILE: $p\n";
      $r = 1 + ($p * ($n - 1) / 100.0);
      $i = int ($r);		# integer part
      if ($i == $n) {
        #print "last:\n";
        #$Yp = $scoretab_r->[$last];
        $Yp = get_nth_score($scoretab_r, $n);
      }
      elsif ($i == 0) {
        #$Yp = $scoretab_r->[0];
        print "1st: CAN'T HAPPEN\n";
        $Yp = get_nth_score($scoretab_r, 1);
      }
      else {
         $d = $r - $i;		# decimal part
	 #p = Y[i] + d(Y[i+1] - Y[i]), but since we're 0 based, use i=i-1
         my $ithvalprev = get_nth_score($scoretab_r, $i);
         my $ithval     = get_nth_score($scoretab_r, $i+1);
         $Yp = $ithvalprev + ($d * ($ithval - $ithvalprev));
      }
      #printf "p(%6.2f), r: %6.2f, i: %6d, d: %6.2f, Yp: %6d\n", $p, $r, $i, $d, $Yp;
      push @vals, $Yp;
   }

   return @vals;
}



# Returns a list of frequency distributions given an incrementally sorted
# set of sorted scores, and an incrementally sorted list of buckets
#
# Arg1 is an array ref to the sorted series
# Arg2 is a list of frequency buckets to use
sub get_frequencies(\@ @) { 
   my ($aref,@blist) = @_;

   my @vals = ( 0 ) x (@blist);
   my @sorted_blist = sort { $a <=> $b } @blist;
   my $bucket_index = 0;

OUTER: foreach my $score (@$aref) {
      #print "Score: $score\n";
      for my $i ($bucket_index .. @sorted_blist - 1) {
         #print "\tTrying Bucket[$i]: $sorted_blist[$i]\n";
         if ($score > $sorted_blist[$i]) {
            $bucket_index++;
         }
         else {
            #printf "\t\tinto Bucket[%d]\n", $bucket_index;
            $vals[$bucket_index]++;
            next OUTER;
         }
      }
      #printf "\t\tinto Bucket[%d]\n", $bucket_index - 1;
      $vals[$bucket_index - 1]++;
   }

   return @vals;
}

# Inserts commas in numbers for easier readability
#
sub commify ($) {
    return undef if ! defined ($_[0]);

    my $text = reverse $_[0];
    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
    return scalar reverse $text;
}

# Unitize a number, and return appropriate printf formatting string
#
sub unitize($ $) {
   my ($num, $fmt) = @_;
   my $kilobyte = 2**10;
   my $megabyte = 2**20;
   my $gigabyte = 2**30;
   my $terabyte = 2**40;

   if ($num >= $terabyte) {
      $num /= $terabyte;
      $fmt .= '.3fT';
   } elsif ($num >= $gigabyte) {
      $num /= $gigabyte;
      $fmt .= '.3fG';
   } elsif ($num >= $megabyte) {
      $num /= $megabyte;
      $fmt .= '.3fM';
   } elsif ($num >= $kilobyte) {
      $num /= $kilobyte;
      $fmt .= '.3fK';
   } else {
      $fmt .= 'd ';
   }

   return ($num, $fmt);
}

# Returns a sublist of the supplied list of elements in an unchanged order,
# where only the first occurrence of each defined element is retained
# and duplicates removed
#
# Borrowed from amavis 2.6.2
#
sub unique_list(@) {
   my ($r) = @_ == 1 && ref($_[0]) ? $_[0] : \@_;  # accept list, or a list ref
   my (%seen);
   my (@unique) = grep { defined($_) && !$seen{$_}++ } @$r;

   return @unique;
}

# Generate a test maillog file from the '#TD' test data lines
# The test data file is placed in /var/tmp/maillog.autogen
#
# arg1: "postfix" or "amavis"
# arg2: path to postfix-logwatch or amavis-logwatch from which to read '#TD' data
#
# Postfix TD syntax:
#    TD<service><QID>(<count>) log entry
#
sub gen_test_log($) {
   my $scriptpath = shift;

   my $toolname = $Logreporters::progname_prefix;
   my $datafile = "/var/tmp/maillog-${toolname}.autogen";

   die "gen_test_log: invalid toolname $toolname"  if ($toolname !~ /^(postfix|amavis)$/);

   eval {
      require Sys::Hostname;
      require Fcntl;
   } or die "Unable to create test data file: required module(s) not found\n$@";

   my $syslogtime = localtime;
   $syslogtime =~ s/^....(.*) \d{4}$/$1/;

   my ($hostname) = split /\./, Sys::Hostname::hostname();

  # # avoid -T issues
  # delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

   my $flags = &Fcntl::O_CREAT|&Fcntl::O_WRONLY|&Fcntl::O_TRUNC;
   sysopen(FH, $datafile, $flags) or die "Can't create test data file: $!";
   print "Generating test log data file from $scriptpath: $datafile\n";

   my $id;
   @ARGV = ($scriptpath);
   if ($toolname eq 'postfix') {
      my %services = (
          DEF   => 'smtpd',
          bQ    => 'bounce',
          cN    => 'cleanup',
          cQ    => 'cleanup',
          lQ    => 'local',
          m     => 'master',
          p     => 'pickup',
          pQ    => 'pickup',
          ppQ   => 'pipe',
          pfw   => 'postfwd',
          pg    => 'postgrey',
          pgQ   => 'postgrey',
          ps    => 'postsuper',
          qQ    => 'qmgr',
          s     => 'smtp',
          sQ    => 'smtp',
          sd    => 'smtpd',
          sdN   => 'smtpd',
          sdQ   => 'smtpd',
          spf   => 'policy-spf',
          vN    => 'virtual',
          vQ    => 'virtual',
      );
      $id = 'postfix/smtp[12345]';

      while (<>) {
         if (/^\s*#TD([a-zA-Z]*[NQ]?)(\d+)?(?:\(([^)]+)\))? (.*)$/) {
            my ($service,$count,$qid,$line) = ($1, $2, $3, $4);

            #print "SERVICE: %s, QID: %s, COUNT: %s, line: %s\n", $service, $qid, $count, $line;

            if ($service eq '') {
               $service = 'DEF';
            }
            die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});

            $id = $services{$service} . '[123]';
            $id = 'postfix/' . $id    unless $services{$service} eq 'postgrey';
            #print "searching for service: \"$service\"\n\tFound $id\n";
            if    ($service =~ /N$/) { $id .= ': NOQUEUE'; }
            elsif ($service =~ /Q$/) { $id .= $qid ? $qid : ': DEADBEEF'; }

            $line =~ s/ +/ /g;
            $line =~ s/^ //g;
            #print "$syslogtime $hostname $id: \"$line\"\n" x ($count ? $count : 1);
            print FH "$syslogtime $hostname $id: $line\n" x ($count ? $count : 1);
         }
      }
   }
   else { #amavis
      my %services = (
          DEF   => 'amavis',
          dcc   => 'dccproc',
      );
      while (<>) {
         if (/^\s*#TD([a-z]*)(\d+)? (.*)$/) {
            my ($service,$count,$line) = ($1, $2, $3);
            if ($service eq '') {
               $service = 'DEF';
            }
            die ("No such service: \"$service\": line \"$_\"")  if (!exists $services{$service});
            $id = $services{$service} . '[123]:';
            if ($services{$service} eq 'amavis') {
               $id .= ' (9999-99)';
            }
            print FH "$syslogtime $hostname $id $line\n" x ($count ? $count : 1)
         }
      }
   }

   close FH or die "Can't close $datafile: $!";
}

1;

#MODULE: ../Logreporters/Config.pm
package Logreporters::Config;

use 5.008;
use strict;
use re 'taint';
use warnings;


BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.002';
   @ISA = qw(Exporter);
   @EXPORT = qw(&init_run_mode &add_option &get_options &init_cmdline &get_vars_from_file
                &process_limiters &process_debug_opts &init_getopts_table_common &zero_opts
                @Optspec %Opts %Configvars @Limiters %line_styles $fw1 $fw2 $sep1 $sep2
                &D_CONFIG &D_ARGS &D_VARS &D_TREE &D_SECT &D_UNMATCHED &D_TEST &D_ALL
             );
}

use subs @EXPORT;

our  @Optspec = ();      # options table used by Getopts

our %Opts = ();         # program-wide options
our %Configvars = ();   # configuration file variables
our @Limiters;

# Report separator characters and widths
our ($fw1,$fw2)   = (22, 10);
our ($sep1,$sep2) = ('=', '-');

use Getopt::Long;


BEGIN {
   import Logreporters::Utils qw(&get_usable_sectvars);
}

our %line_styles = (
   truncate => 0,
   wrap     => 1,
   full     => 2,
);

sub init_run_mode($);
sub confighash_to_cmdline(\%);
sub get_vars_from_file(\% $);
sub process_limiters(\@);
sub add_option(@);
sub get_options($);
sub init_getopts_table_common(@);
sub set_supplemental_reports($$);
# debug constants
sub D_CONFIG ()    { 1<<0 }
sub D_ARGS ()      { 1<<1 }
sub D_VARS ()      { 1<<2 }
sub D_TREE ()      { 1<<3 }
sub D_SECT ()      { 1<<4 }
sub D_UNMATCHED () { 1<<5 }

sub D_TEST ()      { 1<<30 }
sub D_ALL ()       { 1<<31 }

my %debug_words = (
   config     => D_CONFIG,
   args       => D_ARGS,
   vars       => D_VARS,
   tree       => D_TREE,
   sect       => D_SECT,
   unmatched  => D_UNMATCHED,

   test       => D_TEST,
   all        => 0xffffffff,
);

# Clears %Opts hash and initializes basic running mode options in
# %Opts hash by setting keys: 'standalone', 'detail', and 'debug'.
# Call early.
#
sub init_run_mode($) {
   my $config_file = shift;
   $Opts{'debug'} = 0;

   # Logwatch passes a filter's options via environment variables.
   # When running standalone (w/out logwatch), use command line options
   $Opts{'standalone'} = exists ($ENV{LOGWATCH_DETAIL_LEVEL}) ? 0 : 1;

   # Show summary section by default
   $Opts{'summary'} = 1;

   if ($Opts{'standalone'}) {
      process_debug_opts($ENV{'LOGREPORTERS_DEBUG'}) if exists ($ENV{'LOGREPORTERS_DEBUG'});
   }
   else {
      $Opts{'detail'} = $ENV{'LOGWATCH_DETAIL_LEVEL'};
      # XXX
      #process_debug_opts($ENV{'LOGWATCH_DEBUG'}) if exists ($ENV{'LOGWATCH_DEBUG'});
   }

   # first process --debug, --help, and --version options
   add_option ('debug=s',                   sub { process_debug_opts($_[1]); 1});
   add_option ('version',                   sub { &Logreporters::Utils::get_version(); 1;});
   get_options(1);

   # now process --config_file, so that all config file vars are read first
   add_option ('config_file|f=s',           sub { get_vars_from_file(%Configvars, $_[1]); 1;});
   get_options(1);

   # if no config file vars were read
   if ($Opts{'standalone'} and ! keys(%Configvars) and -f $config_file) {
      print "Using default config file: $config_file\n" if $Opts{'debug'} & D_CONFIG;
      get_vars_from_file(%Configvars, $config_file);
   }
}

sub get_options($) {
   my $pass_through = shift;
   #$SIG{__WARN__} = sub { print "*** $_[0]*** options error\n" };
   # ensure we're called after %Opts is initialized
   die "get_options: program error: %Opts is emtpy" unless exists $Opts{'debug'};

   my $p = new Getopt::Long::Parser;

   if ($pass_through) {
      $p->configure(qw(pass_through permute));
   }
   else {
      $p->configure(qw(no_pass_through no_permute));
   }
   #$p->configure(qw(debug));

   if ($Opts{'debug'} & D_ARGS) {
      print "\nget_options($pass_through): enter\n";
      printf "\tARGV(%d): ", scalar @ARGV;
      print @ARGV, "\n";
      print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
   }

   if ($p->getoptions(\%Opts, @Optspec) == 0) {
      print STDERR "Use ${Logreporters::progname} --help for options\n";
      exit 1;
   }
   if ($Opts{'debug'} & D_ARGS) {
      print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n"  foreach sort keys %Opts;
      printf "\tARGV(%d): ", scalar @ARGV;
      print @ARGV, "\n";
      print "get_options: exit\n";
   }
}

sub add_option(@) {
   push @Optspec, @_;
}

# untaint string, borrowed from amavisd-new
sub untaint($) {
   no re 'taint';

   my ($str);
   if (defined($_[0])) {
      local($1);            # avoid Perl taint bug: tainted global $1 propagates taintedness
      $str = $1  if $_[0] =~ /^(.*)$/;
   }

   return $str;
}

sub init_getopts_table_common(@) {
   my @supplemental_reports = @_;

   print "init_getopts_table_common: enter\n"   if $Opts{'debug'} & D_ARGS;

   add_option ('help',                       sub { print STDOUT Logreporters::usage(undef); exit 0 });
   add_option ('gen_test_log=s',             sub { Logreporters::Utils::gen_test_log($_[1]); exit 0; });
   add_option ('detail=i');
   add_option ('nodetail',                   sub { 
      # __none__ will set all limiters to 0 in process_limiters
      # since they are not known (Sections table is not yet built).
      push @Limiters, '__none__';
      # 0 = disable supplemental_reports
      set_supplemental_reports(0, \@supplemental_reports);
   });
   add_option ('max_report_width=i');
   add_option ('summary!');
   add_option ('show_summary=i',             sub { $Opts{'summary'} = $_[1]; 1; });
   # untaint ipaddr_width for use w/sprintf() in Perl v5.10
   add_option ('ipaddr_width=i',             sub { $Opts{'ipaddr_width'} = untaint ($_[1]); 1; });

   add_option ('sect_vars!');
   add_option ('show_sect_vars=i',           sub { $Opts{'sect_vars'} = $_[1]; 1; });

   add_option ('syslog_name=s');
   add_option ('wrap',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
   add_option ('full',                       sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
   add_option ('truncate',                   sub { $Opts{'line_style'} = $line_styles{$_[0]}; 1; });
   add_option ('line_style=s',               sub {
      my $style = lc($_[1]);
      my @list = grep (/^$style/, keys %line_styles);
      if (! @list) {
         print STDERR "Invalid line_style argument \"$_[1]\"\n";
         print STDERR "Option line_style argument must be one of \"wrap\", \"full\", or \"truncate\".\n";
         print STDERR "Use $Logreporters::progname --help for options\n";
         exit 1;
      }
      $Opts{'line_style'} = $line_styles{lc($list[0])};
      1;
   });

   add_option ('limit|l=s',                 sub {
      my ($limiter,$lspec) = split(/=/, $_[1]);
      if (!defined $lspec) {
         printf STDERR "Limiter \"%s\" requires value (ex. --limit %s=10)\n", $_[1],$_[1];
         exit 2;
      }
      foreach my $val (split(/(?:\s+|\s*,\s*)/, $lspec)) {
         if ($val !~ /^\d+$/ and 
             $val !~ /^(\d*)\.(\d+)$/ and
             $val !~ /^::(\d+)$/ and
             $val !~ /^:(\d+):(\d+)?$/ and
             $val !~ /^(\d+):(\d+)?:(\d+)?$/)
         {
            printf STDERR "Limiter value \"$val\" invalid in \"$limiter=$lspec\"\n";
            exit 2;
         }
      }
      push @Limiters, lc $_[1];
   });

   print "init_getopts_table_common: exit\n"   if $Opts{'debug'} & D_ARGS;
}

sub get_option_names() {
   my (@ret, @tmp);
   foreach (@Optspec) {
      if (ref($_) eq '') {       # process only the option names
         my $spec = $_;
         $spec =~ s/=.*$//;
         $spec =~ s/([^|]+)\!$/$1|no$1/g;
         @tmp = split /[|]/, $spec;
         #print "PUSHING: @tmp\n";
         push @ret, @tmp;
      }
   }
   return @ret;
}

# Set values for the configuration variables passed via hashref.
# Variables are of the form ${progname_prefix}_KEYNAME.
#
# Because logwatch lowercases all config file entries, KEYNAME is
# case-insensitive.
#
sub init_cmdline() {
   my ($href, $configvar, $value, $var);

   # logwatch passes all config vars via environment variables
   $href = $Opts{'standalone'} ? \%Configvars : \%ENV;

   # XXX: this is cheeze: need a list of valid limiters, but since
   # the Sections table is not built yet, we don't know what is
   # a limiter and what is an option, as there is no distinction in
   # variable names in the config file (perhaps this should be changed).
   my @valid_option_names = get_option_names();
   die "Options table not yet set" if ! scalar @valid_option_names;

   print "confighash_to_cmdline: @valid_option_names\n"  if $Opts{'debug'} & D_ARGS;
   my @cmdline = ();
   while (($configvar, $value) = each %$href) {
      if ($configvar =~ s/^${Logreporters::progname_prefix}_//o) {
         # distinguish level limiters from general options
         # would be easier if limiters had a unique prefix
         $configvar = lc $configvar;
         my $ret = grep (/^$configvar$/i, @valid_option_names);
         if ($ret == 0) {
            print "\tLIMITER($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
            push @cmdline, '-l', "$configvar" . "=$value";
         }
         else {
            print "\tOPTION($ret): $configvar = $value\n"  if $Opts{'debug'} & D_ARGS;
            unshift @cmdline, $value  if defined ($value);
            unshift @cmdline, "--$configvar";
         }
      }
   }
   unshift @ARGV, @cmdline;
}

# Obtains the variables from a logwatch-style .conf file, for use
# in standalone mode.  Returns an ENV-style hash of key/value pairs.
#
sub get_vars_from_file(\% $) {
   my ($href, $file) = @_;
   my ($var, $val);

   print "get_vars_from_file: enter: processing file: $file\n" if $Opts{'debug'} & D_CONFIG;

   my  $message = undef;
   my $ret = stat ($file);
   if ($ret == 0) { $message = $!; }
   elsif (! -r _) { $message = "Permission denied"; }
   elsif (  -d _) { $message = "Is a directory"; }
   elsif (! -f _) { $message = "Not a regular file"; }

   if ($message) {
      print STDERR "Configuration file \"$file\": $message\n";
      exit 2;
   }

   my $prog = $Logreporters::progname_prefix;
   open FILE, '<', "$file" or die "unable to open configuration file $file: $!";
   while (<FILE>) {
      chomp;
      next if (/^\s*$/);   # ignore all whitespace lines
      next if (/^\*/);     # ignore logwatch's *Service lines
      next if (/^\s*#/);   # ignore comment lines
      if (/^\s*\$(${prog}_[^=\s]+)\s*=\s*"?([^"]+)"?$/o) {
         ($var,$val) = ($1,$2);
         if    ($val =~ /^(?:no|false)$/i) { $val = 0; }
         elsif ($val =~ /^(?:yes|true)$/i) { $val = 1; }
         elsif ($val eq '')                { $var =~ s/${prog}_/${prog}_no/; $val = undef; }

         print "\t\"$var\" => \"$val\"\n"  if $Opts{'debug'} & D_CONFIG;

         $href->{$var} = $val;
      }
   }
   close FILE         or die "failed to close configuration handle for $file: $!";
   print "get_vars_from_file: exit\n" if $Opts{'debug'} & D_CONFIG;
}

sub process_limiters(\@) {
   my ($sectref) = @_;

   my ($limiter, $var, $val, @errors);
   my @l = get_usable_sectvars(@$sectref, 1);

   if ($Opts{'debug'} & D_VARS) {
      print "process_limiters: enter\n";
      print "\tLIMITERS: @Limiters\n";
   }
   while ($limiter = shift @Limiters) {
      my @matched = ();

      printf "\t%-30s  ",$limiter   if $Opts{'debug'} & D_VARS;
      # disable all limiters when limiter is __none__: see 'nodetail' cmdline option
      if ($limiter eq '__none__') {
         $Opts{$_} = 0 foreach @l;
         next;
      }

      ($var,$val) = split /=/, $limiter;

      if ($val eq '') {
         push @errors, "Limiter \"$var\" requires value (ex. --limit limiter=10)";
         next;
      }

      # try exact match first, then abbreviated match next
      if (scalar (@matched = grep(/^$var$/, @l)) == 1 or scalar (@matched = grep(/^$var/, @l)) == 1) {
         $limiter = $matched[0];    # unabbreviate limiter
         print "MATCH: $var: $limiter => $val\n" if $Opts{'debug'} & D_VARS;
         # XXX move limiters into section hash entry...
         $Opts{$limiter} = $val;
         next;
      }
      print "matched=", scalar @matched, ": @matched\n" if $Opts{'debug'} & D_VARS;

      push @errors, "Limiter \"$var\" is " . (scalar @matched == 0 ? "invalid" : "ambiguous: @matched");
   }
   print "\n" if $Opts{'debug'} & D_VARS;

   if (@errors) {
      print STDERR "$_\n" foreach @errors;
      exit 2;
   }

   # Set the default value of 10 for each section if no limiter exists.
   # This allows output for each section should there be no configuration
   # file or missing limiter within the configuration file. 
   foreach (@l) {
      $Opts{$_} = 10 unless exists $Opts{$_};
   }

   # Enable collection for each section if a limiter is non-zero.
   foreach (@l) {
      #print "L is: $_\n";
      #print "DETAIL: $Opts{'detail'}, OPTS: $Opts{$_}\n";
      $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
   }
   #print "OPTS: \n"; map { print "$_ => $Opts{$_}\n"} keys %Opts;
   #print "COLLECTING: \n"; map { print "$_ => $Logreporters::TreeData::Collecting{$_}\n"} keys %Logreporters::TreeData::Collecting;
}

# Enable/disable supplemental reports
# arg1:     0=off, 1=on
# arg2,...: list of supplemental report keywords
sub set_supplemental_reports($$) {
   my ($onoff,$aref) = @_;

   $Opts{$_} = $onoff foreach (@$aref);
}

sub process_debug_opts($) {
   my $optstring = shift;

   my @errors = ();
   foreach (split(/\s*,\s*/, $optstring)) {
      my $word = lc $_;
      my @matched = grep (/^$word/, keys %debug_words);

      if (scalar @matched == 1) {
         $Opts{'debug'} |= $debug_words{$matched[0]};
         next;
      }

      if (scalar @matched == 0) {
         push @errors, "Unknown debug keyword \"$word\"";
      }
      else {  # > 1
         push @errors, "Ambiguous debug keyword abbreviation \"$word\": (matches: @matched)";
      }
   }
   if (@errors) {
      print STDERR "$_\n" foreach @errors;
      print STDERR "Debug keywords: ", join (' ', sort keys %debug_words), "\n";
      exit 2;
   }
}

# Zero the options controlling level specs and those
# any others passed via Opts key.
#
# Zero the options controlling level specs in the
# Detailed section, and set all other report options
# to disabled. This makes it easy via command line to
# disable the entire summary section, and then re-enable
# one or more sections for specific reports.
#
#   eg. progname --nodetail --limit forwarded=2
#
sub zero_opts ($ @) {
   my $sectref = shift;
   # remaining args: list of Opts keys to zero

   map { $Opts{$_} = 0; print "zero_opts: $_ => 0\n" if $Opts{'debug'} & D_VARS;} @_;
   map { $Opts{$_} = 0 } get_usable_sectvars(@$sectref, 1);
}

1;

#MODULE: ../Logreporters/TreeData.pm
package Logreporters::TreeData;

use 5.008;
use strict;
use re 'taint';
use warnings;
no warnings "uninitialized";

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.001';
   @ISA = qw(Exporter);
   @EXPORT = qw(%Totals %Counts %Collecting $END_KEY);
   @EXPORT_OK = qw(&printTree &buildTree);

}

use subs @EXPORT_OK;

BEGIN {
   import Logreporters::Config qw(%line_styles);
}

# Totals and Counts are the log line accumulator hashes.
# Totals: maintains per-section grand total tallies for use in Summary section
# Counts: is a multi-level hash, which maintains per-level key totals.
our (%Totals, %Counts);

# The Collecting hash determines which sections will be captured in
# the Counts hash.  Counts are collected only if a section is enabled,
# and this hash obviates the need to test both existence and
# non-zero-ness of the Opts{'keyname'} (either of which cause capture).
# XXX The Opts hash could be used ....
our %Collecting = ();

sub buildTree(\% $ $ $ $ $);
sub printTree($ $ $ $ $);
=pod
[ a:b:c, ... ]

which would be interpreted as follows:

a = show level a detail
b = show at most b items at this level
c = minimun count that will be shown
=cut

sub printTree($ $ $ $ $) {
   my ($treeref, $lspecsref, $line_style, $max_report_width, $debug) = @_;
   my ($entry, $line);
   my $cutlength = $max_report_width - 3;

   my $topn = 0;
   foreach $entry (sort bycount @$treeref) {
      ref($entry) ne "HASH" and die "Unexpected entry in tree: $entry\n";

      #print "LEVEL: $entry->{LEVEL}, TOTAL: $entry->{TOTAL}, HASH: $entry, DATA: $entry->{DATA}\n";

      # Once the top N lines have been printed, we're done
      if ($lspecsref->[$entry->{LEVEL}]{topn}) {
         if ($topn++ >= $lspecsref->[$entry->{LEVEL}]{topn} ) {
            print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
               unless ($debug) and do {
                     $line = '     ' . '   ' x ($entry->{LEVEL} + 3) . '...';
                     printf "%-130s L%d: topn reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{topn};
               };
            last;
         }
      }

      # Once the item's count falls below the given threshold, we're done at this level
      # unless a top N is specified, as threshold has lower priority than top N
      elsif ($lspecsref->[$entry->{LEVEL}]{threshold}) {
         if ($entry->{TOTAL} <= $lspecsref->[$entry->{LEVEL}]{threshold}) {
            print '     ', '   ' x ($entry->{LEVEL} + 3), "...\n"
               unless ($debug) and do {
                  $line = '     ' . ('   ' x ($entry->{LEVEL} + 3)) . '...';
                  printf "%-130s L%d: threshold reached(%d)\n", $line, $entry->{LEVEL} + 1, $lspecsref->[$entry->{LEVEL}]{threshold};
               };
            last;
         }
      }

      $line = sprintf "%8d%s%s", $entry->{TOTAL}, '   ' x ($entry->{LEVEL} + 2),  $entry->{DATA};

      if ($debug) {
         printf "%-130s %-60s\n", $line, $entry->{DEBUG};
      }

      # line_style full, or lines < max_report_width

      #printf "MAX: $max_report_width, LEN: %d, CUTLEN $cutlength\n", length($line);
      if ($line_style == $line_styles{'full'} or length($line) <= $max_report_width) {
         print $line, "\n";
      }
      elsif ($line_style == $line_styles{'truncate'}) {
         print substr ($line,0,$cutlength), '...', "\n";
      }
      elsif ($line_style == $line_styles{'wrap'}) {
         my $leader = ' ' x 8 . '   ' x ($entry->{LEVEL} + 2);
         print substr ($line, 0, $max_report_width, ''), "\n";
         while (length($line)) {
            print $leader, substr ($line, 0, $max_report_width - length($leader), ''), "\n";
         }
      }
      else {
         die ('unexpected line style');
      }

      printTree ($entry->{CHILDREF}, $lspecsref, $line_style, $max_report_width, $debug)   if (exists $entry->{CHILDREF});
   }
}

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/;
# XXX optimize this using packed default sorting.  Analysis shows speed isn't an issue though
sub bycount {
   # Sort by totals, then IP address if one exists, and finally by data as a string

   local $SIG{__WARN__} = sub { print "*** PLEASE REPORT:\n*** $_[0]*** Unexpected: \"$a->{DATA}\", \"$b->{DATA}\"\n" };

   $b->{TOTAL} <=> $a->{TOTAL}

      ||

   pack('C4' => $a->{DATA} =~ /^$re_IP_strict/o) cmp pack('C4' => $b->{DATA} =~ /^$re_IP_strict/o)

      ||

   $a->{DATA} cmp $b->{DATA}
}

#
# Builds a tree of REC structures from the multi-key %Counts hashes
#
# Parameters:
#    Hash:  A multi-key hash, with keys being used as category headings, and leaf data
#           being tallies for that set of keys
#    Level: This current recursion level.  Call with 0.
#
# Returns:
#    Listref: A listref, where each item in the list is a rec record, described as:
#           DATA:      a string: a heading, or log data
#           TOTAL:     an integer: which is the subtotal of this item's children
#           LEVEL:     an integer > 0: representing this entry's level in the tree
#           CHILDREF:  a listref: references a list consisting of this node's children
#    Total: The cummulative total of items found for a given invocation
#
# Use the special key variable $END_KEY, which is "\a\a" (two ASCII bell's) to end a,
# nested hash early, or the empty string '' may be used as the last key.

our $END_KEY = "\a\a";

sub buildTree(\% $ $ $ $ $) {
   my ($href, $max_level_section, $levspecref, $max_level_global, $recurs_level, $show_unique, $debug) = @_;
   my ($subtotal, $childList, $rec);

   my @treeList = ();
   my $total = 0;

   foreach my $item (sort keys %$href) {
      if (ref($href->{$item}) eq "HASH") {
         #print " " x ($recurs_level * 4), "HASH: LEVEL $recurs_level: Item: $item, type: \"", ref($href->{$item}), "\"\n";

         ($subtotal, $childList) = buildTree (%{$href->{$item}}, $max_level_section, $levspecref, $max_level_global, $recurs_level + 1, $debug);

         if ($recurs_level < $max_level_global and $recurs_level < $max_level_section) {
            # me + children
            $rec = {
               DATA     => $item,
               TOTAL    => $subtotal,
               LEVEL    => $recurs_level,
               CHILDREF => $childList,
            };

            if ($debug) {
               $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
                     $recurs_level + 1, $max_level_global, $max_level_section,
                     $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $subtotal;
            }
            push (@treeList, $rec);
         }
      }
      else {
         if ($item ne '' and $item ne $END_KEY and $recurs_level < $max_level_global and $recurs_level < $max_level_section) {
            $rec = {
               DATA  => $item,
               TOTAL => $href->{$item},
               LEVEL => $recurs_level,
               #CHILDREF => undef,
            };
            if ($debug) {
               $rec->{DEBUG} = sprintf "L%d: levelspecs: %2d/%2d/%2d/%2d, Count: %10d",
                     $recurs_level, $max_level_global, $max_level_section,
                     $levspecref->[$recurs_level]{topn}, $levspecref->[$recurs_level]{threshold}, $href->{$item};
            }
            push (@treeList,  $rec);
         }
         $subtotal = $href->{$item};
      }

      $total += $subtotal;
   }

   #print " " x ($recurs_level * 4), "LEVEL $recurs_level: Returning from recurs_level $recurs_level\n";

   return ($total, \@treeList);
}

1;

#MODULE: ../Logreporters/RegEx.pm
package Logreporters::RegEx;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
#   @EXPORT = qw($re_IP);
   @EXPORT_OK = qw();
}

# IPv4 and IPv6
# See syntax in RFC 2821 IPv6-address-literal,
# eg. IPv6:2001:630:d0:f102:230:48ff:fe77:96e
#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})';

# Modified from "dartware" case at http://forums.dartware.com/viewtopic.php?t=452#
#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;

# IPv4 only
#our $re_IP      = qr/(?:\d{1,3}\.){3}(?:\d{1,3})/;

1;

#MODULE: ../Logreporters/Reports.pm
package Logreporters::Reports;

use 5.008;
use strict;
use re 'taint';
use warnings;
no warnings "uninitialized";

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.002';
   @ISA = qw(Exporter);
   @EXPORT = qw(&inc_unmatched &print_unmatched_report &print_percentiles_report2
                &print_summary_report &print_detail_report);
   @EXPORT_OK = qw();
}

use subs @EXPORT_OK;

BEGIN {
   import Logreporters::Config qw(%Opts $fw1 $fw2 $sep1 $sep2 &D_UNMATCHED &D_TREE);
   import Logreporters::Utils qw(&commify &unitize &get_percentiles &get_percentiles2);
   import Logreporters::TreeData qw(%Totals %Counts &buildTree &printTree);
}

my (%unmatched_list);

our $origline;       # unmodified log line, for error reporting and debug

sub inc_unmatched($) {
   my ($id) = @_;
   $unmatched_list{$origline}++;
   print "UNMATCHED($id): \"$origline\"\n"  if $Opts{'debug'} & D_UNMATCHED;
}

# Print unmatched lines
#
sub print_unmatched_report() {
   return unless (keys %unmatched_list);

   print "\n\n**Unmatched Entries**\n";
   foreach my $line (sort {$unmatched_list{$b}<=>$unmatched_list{$a} } keys %unmatched_list) {
      printf "%8d   %s\n", $unmatched_list{$line}, $line;
   }
}

=pod
   ****** Summary ********************************************************
          2   Miscellaneous warnings 

      20621   Total messages scanned ----------------  100.00%
    662.993M  Total bytes scanned                  695,198,092
   ========   ================================================

      19664   Ham -----------------------------------   95.36%
      19630     Clean passed                            95.19%
         34     Bad header passed                        0.16%

        942   Spam ----------------------------------    4.57%
        514     Spam blocked                             2.49%
        428     Spam discarded (no quarantine)           2.08%

         15   Malware -------------------------------    0.07%
         15     Malware blocked                          0.07%


       1978   SpamAssassin bypassed 
         18   Released from quarantine 
       1982   Whitelisted           
          3   Blacklisted           
         12   MIME error            
         51   Bad header (debug supplemental) 
         28   Extra code modules loaded at runtime 
=cut
# Prints the Summary report section
#
sub print_summary_report (\@) {
   my ($sections) = @_;
   my ($keyname,$cur_level);
   my @lines;

   my $expand_header_footer = sub {
      my $line = undef;

      foreach my $horf (@_) {
         # print blank line if keyname is newline
         if ($horf eq "\n") {
            $line .= "\n";
         }
         elsif (my ($sepchar) = ($horf =~ /^(.)$/o)) {
            $line .= sprintf "%s   %s\n", $sepchar x 8, $sepchar x 50;
         }
         else {
            die "print_summary_report: unsupported header or footer type \"$horf\"";
         }
      }
      return $line;
   };

   if ($Opts{'detail'} >= 5) {
      my $header = "****** Summary ";
      print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n\n";
   }

   my @headers;
   foreach my $sref (@$sections) {
      # headers and separators
      die "Unexpected Section $sref"  if (ref($sref) ne 'HASH');

      # Start of a new section group.
      # Expand and save headers to output at end of section group.
      if ($sref->{CLASS} eq 'GROUP_BEGIN') {
         $cur_level = $sref->{LEVEL};
         $headers[$cur_level] = &$expand_header_footer(@{$sref->{HEADERS}});
      }

      elsif ($sref->{CLASS} eq 'GROUP_END') {
         my $prev_level = $sref->{LEVEL};

         # If this section had lines to output, tack on headers and footers,
         # removing extraneous newlines.
         if ($lines[$cur_level]) {
            # squish multiple blank lines
            if ($headers[$cur_level] and substr($headers[$cur_level],0,1) eq "\n") {
               if ( ! defined $lines[$prev_level][-1] or $lines[$prev_level][-1] eq "\n") {
                  $headers[$cur_level] =~ s/^\n+//;
               }
            }

            push @{$lines[$prev_level]}, $headers[$cur_level]  if $headers[$cur_level];
            push @{$lines[$prev_level]}, @{$lines[$cur_level]};
            my $f = &$expand_header_footer(@{$sref->{FOOTERS}});
            push @{$lines[$prev_level]}, $f   if $f;
            $lines[$cur_level] = undef;
         }

         $headers[$cur_level] = undef;
         $cur_level = $prev_level;
      }

      elsif ($sref->{CLASS} eq 'DATA') {
         # Totals data
         $keyname = $sref->{NAME};
         if ($Totals{$keyname} > 0) {
            my ($numfmt, $desc, $divisor) = ($sref->{FMT}, $sref->{TITLE}, $sref->{DIVISOR});

            my $fmt   = '%8';
            my $extra = ' %25s';
            my $total = $Totals{$keyname};

            # Z format provides  unitized or unaltered totals, as appropriate
            if ($numfmt eq 'Z') {
               ($total, $fmt) = unitize ($total, $fmt);
            }
            else {
               $fmt .= "$numfmt ";
               $extra = '';
            }

            if ($divisor and $$divisor) {
               # XXX generalize this
               if (ref ($desc) eq 'ARRAY') {
                  $desc = @$desc[0] . ' ' . @$desc[1] x (42 - 2 - length(@$desc[0]));
               }

               push @{$lines[$cur_level]}, 
                  sprintf "$fmt  %-42s %6.2f%%\n", $total, $desc,
                     $$divisor == $Totals{$keyname} ? 100.00 : $Totals{$keyname} * 100 / $$divisor;
            }
            else {
               push @{$lines[$cur_level]}, 
                  sprintf "$fmt  %-23s $extra\n", $total, $desc, commify ($Totals{$keyname});
            }
         }
      }
      else {
         die "print_summary_report: unexpected control...";
      }
   }
   print @{$lines[0]};
   print "\n";
}

# Prints the Detail report section
# 
# Note: side affect; deletes each key in Totals/Counts 
# after printout.  Only the first instance of a key in
# the Section table will result in Detail output.
sub print_detail_report (\@) {
   my ($sections) = @_;
   my $header_printed = 0;

   return unless (keys %Counts);

#use Devel::Size qw(size total_size);

   foreach my $sref ( @$sections ) {
      next unless $sref->{CLASS} eq 'DATA';
      # only print detail for this section if DETAIL is enabled
      # and there is something in $Counts{$keyname}
      next unless $sref->{DETAIL};
      next unless exists $Counts{$sref->{NAME}};

      my $keyname = $sref->{NAME};
      my $max_level = undef;
      my $print_this_key = 0;

      my @levelspecs = ();
      clear_level_specs($max_level, \@levelspecs);
      if (exists $Opts{$keyname}) {
         $max_level = create_level_specs($Opts{$keyname}, $Opts{'detail'}, \@levelspecs);
         $print_this_key = 1  if ($max_level);
      }
      else {
         $print_this_key = 1;
      }
      #print_level_specs($max_level,\@levelspecs);

      # at detail 5, print level 1, detail 6: level 2, ...

#print STDERR "building: $keyname\n";
      my ($count, $treeref) = 
            buildTree (%{$Counts{$keyname}}, defined ($max_level) ? $max_level : 11,
                       \@levelspecs, $Opts{'detail'} - 4, 0, $Opts{'debug'} & D_TREE);

      if ($count > 0) {
         if ($print_this_key) {
            my $desc = $sref->{TITLE};
            $desc =~ s/^\s+//;

            if (! $header_printed) {
               my $header = "****** Detail ($max_level) ";
               print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n";
               $header_printed = 1;
            }
            printf "\n%8d   %s %s\n", $count, $desc,
                     $Opts{'sect_vars'} ?
                       ('-' x ($Opts{'max_report_width'} - 18 - length($desc) - length($keyname))) . " [ $keyname ] -" :
                        '-' x ($Opts{'max_report_width'} - 12 - length($desc))
         }

         printTree ($treeref, \@levelspecs, $Opts{'line_style'}, $Opts{'max_report_width'},
                    $Opts{'debug'} & D_TREE);
      }
#print STDERR "Total size Counts: ", total_size(\%Counts), "\n";
#print STDERR "Total size Totals: ", total_size(\%Totals), "\n";
      $treeref = undef;
      $Totals{$keyname} = undef;
      delete $Totals{$keyname};
      delete $Counts{$keyname};
   }
   #print "\n";
}

=pod

Print out a standard percentiles report

   === Delivery Delays Percentiles ===============================================================
                          0%       25%       50%       75%       90%       95%       98%      100%
   -----------------------------------------------------------------------------------------------
   Before qmgr          0.01      0.70      1.40  45483.70  72773.08  81869.54  87327.42  90966.00
   In qmgr              0.00      0.00      0.00      0.01      0.01      0.01      0.01      0.01
   Conn setup           0.00      0.00      0.00      0.85      1.36      1.53      1.63      1.70
   Transmission         0.03      0.47      0.92      1.61      2.02      2.16      2.24      2.30
   Total                0.05      1.18      2.30  45486.15  72776.46  81873.23  87331.29  90970.00
   ===============================================================================================

   === Postgrey Delays Percentiles ===========================================================
                      0%       25%       50%       75%       90%       95%       98%      100%
   -------------------------------------------------------------------------------------------
   Postgrey       727.00    727.00    727.00    727.00    727.00    727.00    727.00    727.00
   ===========================================================================================
 
 tableref: 
   data table: ref to array of arrays, first cell is label, subsequent cells are data
 title:
   table's title
 percentiles_str:
   string of space or comma separated integers, which are the percentiles
   calculated and output as table column data
=cut
sub print_percentiles_report2($$$) {
   my ($tableref, $title, $percentiles_str) = @_;

   return unless @$tableref;

   my $myfw2 = $fw2 - 1;
   my @percents = split /[ ,]/, $percentiles_str;

   # Calc y label width from the hash's keys. Each key is padded with the 
   # string "#: ", # where # is a single-digit sort index.
   my $y_label_max_width = 0;
   for (@$tableref) {
      $y_label_max_width = length($_->[0])   if (length($_->[0]) > $y_label_max_width);
   }

   # Titles row
   my $col_titles_str = sprintf "%-${y_label_max_width}s" . "%${myfw2}s%%" x @percents , ' ', @percents;
   my $table_width = length($col_titles_str);

   # Table header row
   my $table_header_str = sprintf "%s %s ", $sep1 x 3, $title;
   $table_header_str .= $sep1 x ($table_width - length($table_header_str));

   print "\n", $table_header_str;
   print "\n", $col_titles_str;
   print "\n", $sep2 x $table_width;

   my (@p, @coldata, @xformed);
   foreach (@$tableref) {
      my ($title, $ref) = ($_->[0], $_->[1]);
      #xxx my @sorted = sort { $a <=> $b } @{$_->[1]};

      my @byscore = ();

      for my $bucket (sort { $a <=> $b } keys %$ref) {
      #print "Key: $title: Bucket: $bucket = $ref->{$bucket}\n";
      # pairs: bucket (i.e. key), tally
         push @byscore, $bucket, $ref->{$bucket};
      }


      my @p = get_percentiles2 (@byscore, @percents);
      printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), $title, @p;
   }

=pod
   foreach (@percents) {
      #printf "\n%-${y_label_max_width}s" . "%${fw2}.2f" x scalar (@p), substr($title,3), @p;
      printf "\n%3d%%", $title;
      foreach my $val (@{shift @xformed}) {
         my $unit;
         if ($val > 1000) {
            $unit = 's';
            $val /= 1000;
         }
         else {
            $unit = '';
         }
         printf "%${fw3}.2f%-2s", $val, $unit;
      }
   }
=cut

   print "\n", $sep1 x $table_width, "\n";
}

sub clear_level_specs($ $) {
   my ($max_level,$lspecsref) = @_;
   #print "Zeroing $max_level rows of levelspecs\n";
   $max_level = 0 if (not defined $max_level);
   for my $x (0..$max_level) {
      $lspecsref->[$x]{topn}      = undef;
      $lspecsref->[$x]{threshold} = undef;
   }
}

# topn      = 0 means don't limit
# threshold = 0 means no min threshold
sub create_level_specs($ $ $) {
   my ($optkey,$gdetail,$lspecref) = @_;

   return 0 if ($optkey eq "0");

   my $max_level = $gdetail;       	# default to global detail level
   my (@specsP1, @specsP2, @specsP3);

   #printf "create_level_specs: key: %s => \"%s\", max_level: %d\n", $optkey, $max_level;

   foreach my $sp (split /[\s,]+/, $optkey) {
      #print "create_level_specs:  SP: \"$sp\"\n";
      # original level specifier
      if ($sp =~ /^\d+$/) {
         $max_level = $sp;
         #print "create_level_specs:  max_level set: $max_level\n";
      }
      # original level specifier + topn at level 1
      elsif ($sp =~ /^(\d*)\.(\d+)$/) {
         if ($1) { $max_level = $1; }
         else    { $max_level = $gdetail; }	      # top n specified, but no max level

         # force top N at level 1 (zero based)
         push @specsP1, { level => 0, topn => $2, threshold => 0 };
      }
      # newer level specs 
      elsif ($sp =~ /^::(\d+)$/) {
         push @specsP3, { level => undef, topn => 0, threshold => $1 };
      }
      elsif ($sp =~ /^:(\d+):(\d+)?$/) {
         push @specsP2, { level => undef, topn => $1, threshold => defined $2 ? $2 : 0 };
      }
      elsif ($sp =~ /^(\d+):(\d+)?:(\d+)?$/) {
         push @specsP1, { level => ($1 > 0 ? $1 - 1 : 0), topn => $2 ? $2 : 0, threshold => $3 ? $3 : 0 };
      }
      else {
         print STDERR "create_level_specs: unexpected levelspec ignored: \"$sp\"\n";
      }
   }

   #foreach my $sp (@specsP3, @specsP2, @specsP1) {
   #   printf "Sorted specs: L%d, topn: %3d, threshold: %3d\n", $sp->{level}, $sp->{topn}, $sp->{threshold};
   #}

   my ($min, $max);
   foreach my $sp ( @specsP3, @specsP2, @specsP1) {
      ($min, $max) = (0, $max_level);
      
      if (defined $sp->{level}) {
         $min = $max = $sp->{level};
      }
      for my $level ($min..$max) {
         #printf "create_level_specs: setting L%d, topn: %s, threshold: %s\n", $level, $sp->{topn}, $sp->{threshold};
         $lspecref->[$level]{topn}      = $sp->{topn}          if ($sp->{topn});
         $lspecref->[$level]{threshold} = $sp->{threshold}     if ($sp->{threshold});
      }
   }

   return $max_level;
}

sub print_level_specs($ $) {
   my ($max_level,$lspecref) = @_;
   for my $level (0..$max_level) {
      printf "LevelSpec Row %d: %3d %3d\n", $level, $lspecref->[$level]{topn}, $lspecref->[$level]{threshold};
   }
}


1;

#MODULE: ../Logreporters/RFC3463.pm
package Logreporters::RFC3463;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
   @EXPORT = qw(&get_dsn_msg);
}

use subs @EXPORT;

#-------------------------------------------------
# Enhanced Mail System Status Codes (aka: extended status codes)
#
#   RFC 3463   http://www.ietf.org/rfc/rfc3463.txt
#   RFC 4954   http://www.ietf.org/rfc/rfc4954.txt
#
# Class.Subject.Detail
#
my %dsn_codes = (
    class => {
      '2' => 'Success',
      '4' => 'Transient failure',
      '5' => 'Permanent failure',
    },

    subject => {
      '0' => 'Other/Undefined status',
      '1' => 'Addressing status',
      '2' => 'Mailbox status',
      '3' => 'Mail system status',
      '4' => 'Network & routing status',
      '5' => 'Mail delivery protocol status',
      '6' => 'Message content/media status',
      '7' => 'Security/policy status',
    },

    detail => {
      '0.0' => 'Other undefined status',
      '1.0' => 'Other address status',
      '1.1' => 'Bad destination mailbox address',
      '1.2' => 'Bad destination system address',
      '1.3' => 'Bad destination mailbox address syntax',
      '1.4' => 'Destination mailbox address ambiguous',
      '1.5' => 'Destination mailbox address valid',
      '1.6' => 'Mailbox has moved',
      '1.7' => 'Bad sender\'s mailbox address syntax',
      '1.8' => 'Bad sender\'s system address',

      '2.0' => 'Other/Undefined mailbox status',
      '2.1' => 'Mailbox disabled, not accepting messages',
      '2.2' => 'Mailbox full',
      '2.3' => 'Message length exceeds administrative limit.',
      '2.4' => 'Mailing list expansion problem',

      '3.0' => 'Other/Undefined mail system status',
      '3.1' => 'Mail system full',
      '3.2' => 'System not accepting network messages',
      '3.3' => 'System not capable of selected features',
      '3.4' => 'Message too big for system',

      '4.0' => 'Other/Undefined network or routing status',
      '4.1' => 'No answer from host',
      '4.2' => 'Bad connection',
      '4.3' => 'Routing server failure',
      '4.4' => 'Unable to route',
      '4.5' => 'Network congestion',
      '4.6' => 'Routing loop detected',
      '4.7' => 'Delivery time expired',

      '5.0' => 'Other/Undefined protocol status',
      '5.1' => 'Invalid command',
      '5.2' => 'Syntax error',
      '5.3' => 'Too many recipients',
      '5.4' => 'Invalid command arguments',
      '5.5' => 'Wrong protocol version',
      '5.6' => 'Authentication Exchange line too long',

      '6.0' => 'Other/Undefined media error',
      '6.1' => 'Media not supported',
      '6.2' => 'Conversion required & prohibited',
      '6.3' => 'Conversion required but not supported',
      '6.4' => 'Conversion with loss performed',
      '6.5' => 'Conversion failed',

      '7.0' => 'Other/Undefined security status',
      '7.1' => 'Delivery not authorized, message refused',
      '7.2' => 'Mailing list expansion prohibited',
      '7.3' => 'Security conversion required but not possible',
      '7.4' => 'Security features not supported',
      '7.5' => 'Cryptographic failure',
      '7.6' => 'Cryptographic algorithm not supported',
      '7.7' => 'Message integrity failure',
    },

    # RFC 4954
    complete => {
      '2.7.0'  => 'Authentication succeeded',
      '4.7.0'  => 'Temporary authentication failure',
      '4.7.12' => 'Password transition needed',
      '5.7.0'  => 'Authentication required',
      '5.7.8'  => 'Authentication credentials invalid',
      '5.7.9'  => 'Authentication mechanism too weak',
      '5.7.11' => 'Encryption required for requested authentication mechanism',
    },
);

# Returns an RFC 3463 DSN messages given a DSN code
#
sub get_dsn_msg ($) {
   my $dsn = shift;
   my ($msg, $class, $subject, $detail);

   return "*DSN unavailable"  if ($dsn =~ /^$/);

   unless ($dsn =~ /^(\d)\.((\d{1,3})\.\d{1,3})$/) {
      print "Error: not a DSN code $dsn\n";
      return "Invalid DSN";
   }

   $class = $1; $subject = $3; $detail = $2;

   #print "DSN: $dsn, Class: $class, Subject: $subject, Detail: $detail\n";

   if (exists $dsn_codes{'class'}{$class}) {
      $msg = $dsn_codes{'class'}{$class};
   }
   if (exists $dsn_codes{'subject'}{$subject}) {
      $msg .= ': ' . $dsn_codes{'subject'}{$subject};
   }
   if (exists $dsn_codes{'complete'}{$dsn}) {
      $msg .= ': ' . $dsn_codes{'complete'}{$dsn};
   }
   elsif (exists $dsn_codes{'detail'}{$detail}) {
      $msg .= ': ' . $dsn_codes{'detail'}{$detail};
   }

   #print "get_dsn_msg: $msg\n" if ($msg);
   return $dsn . ': ' . $msg;
}

1;

#MODULE: ../Logreporters/PolicySPF.pm
package Logreporters::PolicySPF;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
   @EXPORT = qw(&postfix_policy_spf);
}

use subs @EXPORT;

BEGIN {
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
   import Logreporters::Utils;
   import Logreporters::Reports qw(&inc_unmatched);
}

# Handle postfix/policy_spf entries
#
# Mail::SPF::Result
#   Pass      the SPF record designates the host to be allowed to send accept
#   Fail      the SPF record has designated the host as NOT being allowed to send  reject
#   SoftFail  the SPF record has designated the host as NOT being allowed to send but is in transition  accept but mark
#   Neutral   the SPF record specifies explicitly that nothing can be said about validity   accept
#   None      the domain does not have an SPF record or the SPF record does not evaluate to a result accept
#   PermError a permanent error has occured (eg. badly formatted SPF record) unspecified
#   TempError a transient error has occured accept or reject

sub postfix_policy_spf($) {
   my $line = shift;

   if (
        $line =~ /^Attribute: / or
        # handler sender_policy_framework: is decisive. 
        $line =~ /^handler [^:]+/ or
        # decided action=REJECT Please see http://www.openspf.org/why.html?sender=jrzjcez%40telecomitalia.it&ip=81.178.62.236&receiver=protegate1.zmi.at 
        $line =~ /^decided action=/ or

        # pypolicyd-spf-0.7.1
        #
        # Read line: "request=smtpd_access_policy"
        # Found the end of entry
        # 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'}
        # spfcheck: pyspf result: "['Pass', 'sender SPF authorized', 'helo']"
        # ERROR: Could not match line "#helo pass and mfrom none"
        # Traceback (most recent call last):
        #   File "/usr/local/bin/policyd-spf", line 405, in <module>
        #     line = sys.stdin.readline()
        # KeyboardInterrupt 
        $line =~ /^Read line: "/ or
        $line =~ /^Found the end of entry$/ or
        $line =~ /^Config: {/ or
        $line =~ /^spfcheck: pyspf result/ or
        $line =~ /^Starting$/ or
        $line =~ /^Normal exit$/ or
        $line =~ /^ERROR: Could not match line/ or
        $line =~ /^Traceback / or
        $line =~ /^KeyboardInterrupt/ or
        $line =~ /^\s\s+/
      )
   {
      #print "IGNORING...\n\tORIG: $::OrigLine\n";
      return
   }

   # Keep policy-spf warnings in its section
   if (my ($warn,$msg) = $line =~ /^warning: ([^:]+): (.*)$/) {
      #TDspf warning: ignoring garbage: # No SPF 

      $msg =~ s/^# ?//;
      $Totals{'policyspf'}++;
      $Counts{'policyspf'}{'*Warning'}{ucfirst $warn}{$msg}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
      return;
   }

   # pypolicyd-spf-0.7.1

   # Fail;      identity=helo;     client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # Fail;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
   # Neutral;   identity=helo;     client-ip=192.168.0.3; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # None;      identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # None;      identity=helo;     client-ip=192.168.0.5; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # None;      identity=mailfrom; client-ip=192.168.0.1; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # None;      identity=mailfrom; client-ip=192.168.0.2; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # Pass;      identity=helo;     client-ip=192.168.0.2; helo=example.com; envelope-from=<>;            receiver=bogus@example.net
   # Permerror; identity=helo;     client-ip=192.168.0.4; helo=example.com; envelope-from=f@example.com; receiver=bogus2@example.net
   # Softfail;  identity=mailfrom; client-ip=192.168.0.6; helo=example.com; envelope-from=f@example.com; receiver=yahl@example.org 
   if ($line =~ /^(Pass|Fail|None|Neutral|Permerror|Softfail|Temperror); (.*)$/) {
         my $result = $1;
         my %params = $2 =~ /([-\w]+)=([^;]+)/g;
         #$params{'s'} = '*unknown' unless $params{'s'};
         $Totals{'policyspf'}++;
         if ($Logreporters::TreeData::Collecting{'policyspf'}) {
            my ($id) = $params{'identity'};
            $id =~ s/mailfrom/envelope-from/;
            
            $Counts{'policyspf'}{'Policy Action'}{"SPF: $result"}{join(': ',$params{'identity'},$params{$id})}{$params{'client-ip'}}{$params{'receiver'}}++;
         }
         return;
   }
   elsif ($line =~ /^ERROR /) {
      $line =~ s/^ERROR //;
      $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
      $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
      return;
   }

   # Strip QID if it exists, and trailing ": ", leaving just the message.
   $line =~ s/^(?:$Logreporters::re_QID|): //;

   # other ignored
   if (
        $line =~ /^SPF \S+ \(.+?\): .*$/ or
        $line =~ /^Mail From/ or
        $line =~ /^:HELO check failed/ or     # log entry has no space after :
        $line =~ /^testing:/
      )
   {
        #TDspf testing: stripped sender=jrzjcez@telecomitalia.it, stripped rcpt=hengstberger@adv.at 
        # postfix-policyd-spf-perl-2.007
        #TDspf SPF pass (Mechanism 'ip4:10.0.0.2/22' matched): Envelope-from: foo@example.com
        #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): Envelope-from: anyone@sample.net 
        #TDspf SPF pass (Mechanism 'ip4:10.10.10.10' matched): HELO/EHLO (Null Sender): mailout2.example.com 
        #TDspf SPF fail (Mechanism '-all' matched): HELO/EHLO: mailout1.example.com 
        #TDspf SPF none (No applicable sender policy available): Envelope-from: efrom@example.com 
        #TDspf SPF permerror (Included domain 'example.com' has no applicable sender policy): Envelope-from: efrom@example.com 
        #TDspf SPF permerror (Maximum DNS-interactive terms limit (10) exceeded): Envelope-from: efrom@example.com 
        #TDspf Mail From (sender) check failed - Mail::SPF->new(10.0.0.1, , test.DNSreport.com) failed: 'identity' option must not be empty
        #TDspf HELO check failed - Mail::SPF->new(, , ) failed: Missing required 'identity' option 

        #TDspf SPF not applicable to localhost connection - skipped check 

        #print "IGNORING...\n\tLINE: $line\n\tORIG: \"$Logreporters::Reports::origline\"\n";
        return;
   }

   my ($action, $domain, $ip, $message, $mechanism);
   ($domain, $ip, $message, $mechanism) = ('*unknown', '*unknown', '', '*unavailable');
   #print "LINE: '$line'\n";

   # postfix-policyd-spf-perl: http://www.openspf.org/Software
   if ($line =~ /^Policy action=(.*)$/) {
      $line = $1;

      #: Policy action=DUNNO 
      return if $line =~ /^DUNNO/;
      # Policy action=PREPEND X-Comment: SPF not applicable to localhost connection - skipped check 
      return if $line =~ /^PREPEND X-Comment: SPF not applicable to localhost connection - skipped check$/;

      #print "LINE: '$line'\n";
      if ($line =~ /^DEFER_IF_PERMIT SPF-Result=\[?(.*?)\]?: (.*) of .*$/) {
         my ($lookup,$message) = ($1,$2);
         # Policy action=DEFER_IF_PERMIT SPF-Result=[10.0.0.1]: Time-out on DNS 'SPF' lookup of '[10.0.0.1]' 
         # Policy action=DEFER_IF_PERMIT SPF-Result=example.com: 'SERVFAIL' error on DNS 'SPF' lookup of 'example.com' 
         $message =~ s/^(.*?) on (DNS SPF lookup)$/$2: $1/;
         $message =~ s/'//g;
         $Totals{'policyspf'}++;
         $Counts{'policyspf'}{'Policy Action'}{'defer_if_permit'}{$message}{$lookup}{$END_KEY}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
         return;
      }

      if ($line =~ /^550 Please see http:\/\/www\.openspf\.org\/Why\?(.*)$/) {
         # Policy action=550 Please see http://www.openspf.org/Why?s=mfrom&id=from%40example.com&ip=10.0.0.1&r=example.net
         # 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 
         # Policy action=550 Please see http://www.openspf.org/Why?id=someone%40example.com&ip=10.0.0.1&receiver=vps.example.net

         my %params;
         for (split /[&;]/, $1) {
            my ($id,$val) = split /=/, $_;
            $params{$id} = $val;
         }
         $params{'id'} =~ s/^.*%40//;
         $params{'s'} = '*unknown' unless $params{'s'};
         #print "Please see...:\n\tMessage: $message\n\tIP: $ip\n\tDomain: $domain\n";
         $Totals{'policyspf'}++;
         $Counts{'policyspf'}{'Policy Action'}{'550 reject'}{'See http://www.openspf.org/Why?...'}{$params{'s'}}{$params{'ip'}}{$params{'id'}}++   if ($Logreporters::TreeData::Collecting{'policyspf'});
         return;
      }

      if ($line =~ /^[^:]+: (none|pass|fail|softfail|neutral|permerror|temperror) \((.+?)\) receiver=[^;]+(?:; (.*))?$/) {
         # iehc is identity, envelope-from, helo, client-ip
         my ($result,$message,$iehc,$subject) = ($1,$2,$3,undef);
         my %params = ();
         #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

         # Note: "identity=mailfrom" new in Mail::SPF version 2.006 Aug. 17
         #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

         #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

         #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

         #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
         #TDspf Policy action=PREPEND Received-SPF: none (example.com: No applicable sender policy available) receiver=mx1.example

         #print "LINE: $iehc\n";
         if ($iehc) {
            %params = $iehc =~ /([-\w]+)=([^;]+)/g;

            if (exists $params{'identity'}) {
               $params{'identity'} =~ s/identity=//;
               if ($params{'identity'} eq 'mfrom' or $params{'identity'} eq 'mailfrom') {
                  $params{'identity'} = 'mail from';
               }
               $params{'identity'} = uc $params{'identity'};
            }
            $params{'envelope-from'} =~ s/"//g        if exists $params{'envelope-from'};
            #($helo    = $params{'helo'}) =~ s/"//g   if exists $params{'helo'};
            $ip       = $params{'client-ip'}          if exists $params{'client-ip'};
         }

         $message =~ s/^([^:]+): // and $subject = $1;

         if ($message =~ /^No applicable sender policy available$/) { 
            $message = 'No sender policy';
         }
         elsif ($message =~ s/^(Junk encountered in mechanism) '(.*?)'/$1/) {
            #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
            $ip = formathost ($ip, 'mech: ' . $2);
         }
         elsif ($message =~ s/^(Included domain) '(.*?)' (has no .*)$/$1 $3/) {
            #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
            $subject .= "  (included: $2)";
         }
         elsif ($message =~ /^Domain does not state whether sender is authorized to use '.*?' in '\S+' identity \(mechanism '(.+?)' matched\)$/) { 
            # Domain does not state whether sender is authorized to use 'returns@example.com' in 'mfrom' identity                                            (mechanism '?all' matched))
            ($mechanism,$message) = ($1,'Domain does not state if sender authorized to use');
         }
         elsif ($message =~ /^(\S+) is (not )?authorized( by default)? to use '.*?' in '\S+' identity(?:, however domain is not currently prepared for false failures)? \(mechanism '(.+?)' matched\)$/) {
            # 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))
            # 192.168.1.10 is     authorized by default to use 'from@example.com' in 'mfrom' identity                                                              (mechanism 'all' matched))
            $message = join (' ', 
                             $1 eq 'Sender' ? 'Sender' : 'IP',   # canonicalize IP address
                             $2 ? 'not authorized' : 'authorized',
                             $3 ? 'by default to use' : 'to use',
                            );
            $mechanism = $4;
         }
         elsif ($message =~ /^Maximum DNS-interactive terms limit \S+ exceeded$/) {
            $message = 'Maximum DNS-interactive terms limit exceeded';
         }
         elsif ($message =~ /^Invalid IPv4 prefix length encountered in (.*)$/) {
            $subject .= " (invalid: $1)";
            $message = 'Invalid IPv4 prefix length encountered';
         }

         #print "Result: $result, Identity: $params{'identity'}, Mech: $mechanism, Subject: $subject, IP: $ip\n";
         $Totals{'policyspf'}++;
         if ($Logreporters::TreeData::Collecting{'policyspf'}) {
            $message = join (' ', $message, $params{'identity'})  if exists $params{'identity'};
            $Counts{'policyspf'}{'Policy Action'}{"SPF $result"}{$message}{'mech: ' .$mechanism}{$subject}{$ip}++
         }
         return;
      }

      inc_unmatched('postfix_policy_spf(2)');
      return;
   }

=pod
   Mail::SPF::Query
   libmail-spf-query-perl 1:1.999

    XXX incomplete

    Some possible smtp_comment results:
     pass         "localhost is always allowed."
     none         "SPF", "domain of sender $query->{sender} does not designate mailers
     unknown      $explanation, "domain of sender $query->{sender} does not exist"
                  $query->{spf_error_explanation}, $query->is_looping
                  $query->{spf_error_explanation}, $directive_set->{hard_syntax_error}
                  $query->{spf_error_explanation}, "Missing SPF record at $query->{domain}"
     error        $query->{spf_error_explanation}, $query->{error}

     $result      $explanation, $comment, $query->{directive_set}->{orig_txt}

    Possible header_comment results:
     pass         "$query->{spf_source} designates $ip as permitted sender"
     fail         "$query->{spf_source} does not designate $ip as permitted sender"
     softfail     "transitioning $query->{spf_source} does not designate $ip as permitted sender"
     /^unknown /  "encountered unrecognized mechanism during SPF processing of $query->{spf_source}"
     unknown      "error in processing during lookup of $query->{sender}"
     neutral      "$ip is neither permitted nor denied by domain of $query->{sender}"
     error        "encountered temporary error during SPF processing of $query->{spf_source}"
     none         "$query->{spf_source} does not designate permitted sender hosts" 
                  "could not perform SPF query for $query->{spf_source}" );
=cut

   #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
   #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
   #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
   #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
   #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

   if (my ($result, $reply) = ($line =~ /^(SPF [^:]+): (.*)$/)) {

      #print "result: $result\n\treply: $reply\n\tORIG: \"$Logreporters::Reports::origline\"\n";

      if ($reply =~ /^(?:smtp_comment=)(.*)$/) {
         $reply = $1;
         
         # SPF none
         if ($reply =~ /^SPF: domain of sender (?:(?:[^@]+@)?(\S+) )?does not designate mailers/) {
            $domain = $1 ? $1 : '*unknown';
            #print "result: $result: domain: $domain\n";
         }
         elsif ($reply =~ /^Please see http:\/\/[^\/]+\/why\.html\?sender=(?:.+%40)?([^&]+)&ip=([^&]+)/) {
            ($domain,$ip) = ($1,$2);
            #print "result: $result: domain: $domain, IP: $ip\n";
         }

         # SPF unknown
         elsif ($reply =~ /^SPF record error: ([^,]+), .*: error in processing during lookup of (?:[^@]+\@)?(\S+)/) {
            ($message, $domain) = ($1, $2);
            #print "result: $result: domain: $domain, Problem: $message\n";
         }
         elsif ($reply =~ /^SPF record error: ([^,]+), .*: encountered unrecognized mechanism during SPF processing of domain (?:[^@]+\@)?(\S+)/) {
            ($message, $domain) = ($1,$2);
            #print "result: \"$result\": domain: $domain, Problem: $message\n";
            $result = "SPF permerror"   if ($result =~ /SPF unknown mx-all/);
         }
         else {
            inc_unmatched('postfix_policy_spf(3)');
            return;
         }
      }
      else {
         inc_unmatched('postfix_policy_spf(4)');
         return;
      }

      $Totals{'policyspf'}++;
      if ($message) {
         $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$message}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
      }
      else {
         $Counts{'policyspf'}{'Policy Action'}{$result}{$domain}{$ip}{$END_KEY}++  if ($Logreporters::TreeData::Collecting{'policyspf'});
      }
      return;
   }


   inc_unmatched('postfix_policy_spf(5)');
}

1;

#MODULE: ../Logreporters/Postfwd.pm
package Logreporters::Postfwd;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
   @EXPORT = qw(&postfix_postfwd);
}

use subs @EXPORT;

BEGIN {
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
   import Logreporters::Utils;
   import Logreporters::Reports qw(&inc_unmatched);
}

# postfwd: http://postfwd.org/
#
#
sub postfix_postfwd($) {
   my $line = shift;

   return if (
      #TDpfw [STATS] Counters: 213000 seconds uptime, 39 rules
      #TDpfw [LOGS info]: compare rbl: "example.com[10.1.0.7]"  ->  "localrbl.local"
      #TDpfw [DNSBL] object 10.0.0.1 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
      $line =~ /^\[STATS\] / or
      $line =~ /^\[DNSBL\] / or
      $line =~ /^\[LOGS info\]/ or
      $line =~ /^Process Backgrounded/ or
      $line =~ /^Setting [ug]id to/ or
      $line =~ /^Binding to TCP port/ or
      $line =~ /^terminating\.\.\./ or
      $line =~ /^Setting status interval to \S+ seconds/ or
      $line =~ /^postfwd .+ ready for input$/ or
      $line =~ /postfwd .+ (?:starting|terminated)/
   );

   my ($type,$rule,$id,$action,$host,$hostip,$recipient);

   if ($line =~ /^\[(RULES|CACHE)\] rule=(\d+), id=([^,]+), client=([^[]+)\[([^]]+)\], sender=.*?, recipient=<(.*?)>,.*? action=(.*)$/) {
      #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
      #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
      ($type,$rule,$id,$host,$hostip,$recipient,$action) = ($1,$2,$3,$4,$5,$6,$7);
      $recipient  = '*unknown' if (not defined $recipient);
      $Counts{'postfwd'}{"Rule $rule"}{$id}{$action}{$type}{$recipient}{formathost($hostip,$host)}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
   }
   elsif (($line =~ /Can't connect to TCP port/) or
          ($line =~ /Pid_file already exists for running process/)
         )
    {
      $line =~ s/^[-\d\/:]+ //; # strip leading date/time stamps 2009/07/18-20:09:49
      $Totals{'warningsother'}++; return unless ($Logreporters::TreeData::Collecting{'warningsother'});
      $Counts{'warningsother'}{"$Logreporters::service_name: $line"}++;
      return;
   }

   # ignoring [DNSBL] lines
   #elsif ($line =~ /^\[DNSBL\] object (\S+) listed on (\S+) \(answer: ([^,]+), .*\)$/) {
   #   #TDpfw [DNSBL] object 10.0.0.60 listed on rbl:list.dnswl.org (answer: 127.0.15.0, time: 0s)
   #   ($type,$rbl) = split (/:/, $2);
   #   $Counts{'postfwd'}{"DNSBL: $type"}{$rbl}{$1}{$3}{''}++  if ($Logreporters::TreeData::Collecting{'postfwd'});
   #}
   else {
      inc_unmatched('postfwd');
      return;
   }

   $Totals{'postfwd'}++;
}

1;

#MODULE: ../Logreporters/Postgrey.pm
package Logreporters::Postgrey;

use 5.008;
use strict;
use re 'taint';
use warnings;

my (%pgDelays,%pgDelayso);

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
   @EXPORT = qw(&postfix_postgrey &print_postgrey_reports);
}

use subs @EXPORT;

BEGIN {
   import Logreporters::TreeData qw(%Totals %Counts $END_KEY);
   import Logreporters::Utils;
   import Logreporters::Config qw(%Opts);
   import Logreporters::Reports qw(&inc_unmatched &print_percentiles_report2);
}

# postgrey: http://postgrey.schweikert.ch/
#
# Triplet: (client IP, envelope sender, envelope recipient address)
#
sub postfix_postgrey($) {
   my $line = shift;

   return if (
      #TDpg cleaning up old logs...
      #TDpg cleaning up old entries...
      #TDpg cleaning clients database finished. before: 207, after: 207
      #TDpg cleaning main database finished. before: 3800, after: 2539
      #TDpg delayed 603 seconds: client=10.0.example.com, from=anyone@sample.net, to=joe@example.com 

      #TDpg Setting uid to "504"
      #TDpg Setting gid to "1002 1002"
      #TDpg Process Backgrounded
      #TDpg 2008/03/08-15:54:49 postgrey (type Net::Server::Multiplex) starting! pid(21961)
      #TDpg Binding to TCP port 10023 on host 127.0.0.1
      #TDpg 2007/01/25-14:58:24 Server closing!
      #TDpg Couldn't unlink "/var/run/postgrey.pid" [Permission denied]
      #TDpg ignoring garbage: <help>
      #TDpg unrecognized request type: ''
      #TDpg rm /var/spool/postfix/postgrey/log.0000000002
      #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


      $line =~ /^cleaning / or
      $line =~ /^delayed / or
      $line =~ /^cleaning / or
      $line =~ /^Setting [ug]id/ or
      $line =~ /^Process Backgrounded/ or
      $line =~ /^Binding to / or
      $line =~ /^Couldn't unlink / or
      $line =~ /^ignoring garbage: / or
      $line =~ /^unrecognized request type/ or
      $line =~ /^rm / or
      # unanchored last
      $line =~ /Pid_file already exists/ or
      $line =~ /postgrey .* starting!/ or
      $line =~ /Server closing!/
   );

   my ($action,$reason,$delay,$host,$ip,$sender,$recip);

   if ($line =~ /^(?:$Logreporters::re_QID: )?action=(.*?), reason=(.*?)(?:, delay=(\d+))?, client_name=(.*?), client_address=(.*?)(?:, sender=(.*?))?(?:, +recipient=(.*))?$/o) {
      #TDpg  action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
      #TDpgQ action=greylist, reason=new,                     client_name=example.com, client_address=10.0.0.1, sender=from@example.com
      #TDpgQ action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
      #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1, sender=from@example.com, recipient=to@sample.net
      #TDpg  action=pass,     reason=triplet found,           client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
      #TDpg  action=pass,     reason=triplet found, delay=99, client_name=example.com, client_address=10.0.0.1,                          recipient=to@sample.net
      ($action,$reason,$delay,$host,$ip,$sender,$recip) = ($1,$2,$3,$4,$5,$6,$7);
      $reason =~ s/^(early-retry) \(.* missing\)$/$1/;
      $recip  = '*unknown' if (not defined $recip);
      $sender = ''         if (not defined $sender);

      $Totals{'postgrey'}++;
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
         $Counts{'postgrey'}{"\u$action"}{"\u$reason"}{formathost($ip,$host)}{$recip}{$sender}++;

         if (defined $delay and $Logreporters::TreeData::Collecting{'postgrey_delays'}) {
            $pgDelays{'1: Total'}{$delay}++;

            push @{$pgDelayso{'Postgrey'}}, $delay
         }
      }
   }
   elsif ($line =~ /^whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
      #TDpg: whitelisted: example.com[10.0.0.1]
      $Totals{'postgrey'}++;
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
         $Counts{'postgrey'}{'Whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
      }
   }
   elsif ($line =~ /^tarpit whitelisted: (.*?)(?:\[([^]]+)\])?$/) {
      #TDpg: tarpit whitelisted: example.com[10.0.0.1]
      $Totals{'postgrey'}++;
      if ($Logreporters::TreeData::Collecting{'postgrey'}) {
         $Counts{'postgrey'}{'Tarpit whitelisted'}{defined $2 ? formathost($2,$1) : $1}{$END_KEY}++;
      }
   }
   else {
      inc_unmatched('postgrey');
   }

   return;
}

sub print_postgrey_reports() {
   #print STDERR "pgDelays     memory usage: ", commify(Devel::Size::total_size(\%pgDelays)), "\n";

   if ($Opts{'postgrey_delays'}) {
      my @table;
      for (sort keys %pgDelays) {
         # anon array ref: label, array ref of $Delay{key}
         push @table, [ substr($_,3), $pgDelays{$_} ];
      }
      if (@table) {
         print_percentiles_report2(\@table, "Postgrey Delays Percentiles", $Opts{'postgrey_delays_percentiles'});
      }
   }
}

1;

#MODULE: ../Logreporters/PolicydWeight.pm
package Logreporters::PolicydWeight;

use 5.008;
use strict;
use re 'taint';
use warnings;

BEGIN {
   use Exporter ();
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
   $VERSION = '1.000';
   @ISA = qw(Exporter);
   @EXPORT = qw(&postfix_policydweight);
}

use subs @EXPORT;

BEGIN {
   import Logreporters::Reports qw(&inc_unmatched);
   import Logreporters::TreeData qw(%Totals %Counts);
   import Logreporters::Utils;
}

# Handle postfix/policydweight entries
#
sub postfix_policydweight($) {
   my $line = shift;
   my ($r1, $code, $reason, $reason2);

   if (
        $line =~ /^weighted check/ or
        $line =~ /^policyd-weight .* started and daemonized/ or
        $line =~ /^(cache|child|master): / or
        $line =~ /^cache (?:spawned|killed)/ or
        $line =~ /^child \d+ exited/ or
        $line =~ /^Daemon terminated/ or
        $line =~ /^Daemon terminated/
      )
   {
      #print "$OrigLine\n";
      return;
   }

   if ($line =~ s/^decided action=//) {
      $line =~ s/; delay: \d+s$//;     # ignore, eg.: "delay: 3s"
      #print "....\n\tLINE: $line\n\tORIG: '$Logreporters::Reports::origline'\n";
      if (($code,$r1) = ($line =~ /^(\d+)\s+(.*)$/ )) {
         my @problems = ();
         for (split /; */, $r1) {

            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/ ) {
               push @problems, 'spam/forged: bad DNS/hit DNSRBLs';
            }
            elsif (/^Your MTA is listed in too many DNSBLs/) {
               push @problems, 'too many DNSBLs';
            }
            elsif (/^temporarily blocked because of previous errors - retrying too fast\. penalty: \d+ seconds x \d+ retries\./) {
               push @problems, 'temp blocked: retrying too fast';
            }
            elsif (/^Please use DynDNS/) {
               push @problems, 'use DynDNS';
            }
            elsif (/^please relay via your ISP \([^)]+\)/) {
               push @problems, 'use ISP\'s relay';
            }
            elsif (/^in (.*)/) {
               push @problems, $1;
            }
            elsif (m#^check http://rbls\.org/\?q=#) {
               push @problems, 'see http://rbls.org';
            }
            elsif (/^MTA helo: .* \(helo\/hostname mismatch\)/) {
               push @problems, 'helo/hostname mismatch';
            }
            elsif (/^No DNS entries for your MTA, HELO and Domain\. Contact YOUR administrator\s+/) {
               push @problems, 'no DNS entries';
            }
            else {
               push @problems, $_;
            }
         }

         $reason = $code; $reason2 = join (', ', @problems);
      }
      elsif ($line =~ s/^DUNNO\s+//) {
         #decided action=DUNNO multirecipient-mail - already accepted by previous query; delay: 0s
         $reason = 'DUNNO'; $reason2 = $line;
      }
      elsif ($line =~ s/^check_greylist//) {
         #decided action=check_greylist; delay: 16s
         $reason = 'Check greylist'; $reason2 = $line;
      }
      elsif ($line =~ s/^PREPEND X-policyd-weight:\s+//) {
         #decided action=PREPEND X-policyd-weight: using cached result; rate: -7.6; delay: 0s
         if ($line =~ /(using cached result); rate:/) {
            $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = "\u$1";
         }
         else {
            #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
            $reason = 'PREPEND X-policyd-weight: mail accepted'; $reason2 = 'Varies';
         }
      }
      else {
         return;
      }
   }
   elsif ($line =~ /^err/) {
      # coerrce policyd-weight err's into general warnings
      $Totals{'startuperror'}++;
      $Counts{'startuperror'}{'Service: policyd-weight'}{$line}++    if ($Logreporters::TreeData::Collecting{'startuperror'});
      return;
   }
   else {
      inc_unmatched('policydweight');
      return;
   }

   $Totals{'policydweight'}++;
   $Counts{'policydweight'}{$reason}{$reason2}++   if ($Logreporters::TreeData::Collecting{'policydweight'});
}

1;


package Logreporters;

BEGIN {
   import Logreporters::Utils;
   import Logreporters::Config;
   import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree $END_KEY);
   import Logreporters::RegEx;
   import Logreporters::Reports;
   import Logreporters::RFC3463;
   import Logreporters::PolicySPF;
   import Logreporters::Postfwd;
   import Logreporters::Postgrey;
   import Logreporters::PolicydWeight;
}
use 5.008;
use strict;
use warnings;
no warnings "uninitialized";
use re 'taint';

use File::Basename;
our $progname =  fileparse($0);

my @supplemental_reports = qw(delays postgrey_delays);

# Default values for various options.  These are used
# to reset default values after an option has been
# disabled (via undef'ing its value).  This allows
# a report to be disabled via config file or --nodetail,
# but reenabled via subsequent command line option
my %Defaults = (
   detail                      => 10,                        # report level detail
   max_report_width            => 100,                       # maximum line width for report output
   line_style                  => undef,                     # lines > max_report_width, 0=truncate,1=wrap,2=full
   syslog_name                 => 'postfix',                 # service name (postconf(5), syslog_name)
   sect_vars                   => 0,                         # show section vars in detail report hdrs
   unknown                     => 1,                         # show 'unknown' in address/hostname pairs
   ipaddr_width                => 15,                        # width for printing ip addresses
   long_queue_ids              => 0,                         # enable long queue ids (2.9+)
   delays                      => 1,                         # show message delivery delays report
   delays_percentiles          => '0 25 50 75 90 95 98 100', # percentiles shown in delays report
   reject_reply_patterns       => '5.. 4.. warn',            # reject reply grouping patterns
   postgrey_delays             => 1,                         # show postgrey delays report
   postgrey_delays_percentiles => '0 25 50 75 90 95 98 100', # percentiles shown in postgrey delays report
);

my $usage_str = <<"END_USAGE";
Usage: $progname [ ARGUMENTS ] [logfile ...]
   ARGUMENTS can be one or more of options listed below.  Later options
   override earlier ones.  Any argument may be abbreviated to an unambiguous
   length.  Input is read from the named logfile(s), or STDIN.

   --debug AREAS                          provide debug output for AREAS
   --help                                 print usage information
   --version                              print program version

   --config_file FILE, -f FILE            use alternate configuration file FILE
   --ignore_services PATTERN              ignore postfix/PATTERN services
   --syslog_name PATTERN                  only consider log lines that match
                                          syslog service name PATTERN

   --detail LEVEL                         print LEVEL levels of detail
                                          (default: 10)
   --nodetail                             set all detail levels to 0
   --[no]summary                          display the summary section

   --ipaddr_width WIDTH                   use WIDTH chars for IP addresses in
                                          address/hostname pairs
   --line_style wrap|full|truncate        disposition of lines > max_report_width
                                          (default: truncate)
   --full                                 same as --line_style=full
   --truncate                             same as --line_style=truncate
   --wrap                                 same as --line_style=wrap
   --max_report_width WIDTH               limit report width to WIDTH chars
                                          (default: 100)
   --limit L=V, -l L=V                    set level limiter L with value V
   --[no]long_queue_ids                   use long queue ids
   --[no]unknown                          show the 'unknown' hostname in
                                          formatted address/hostnames pairs
   --[no]sect_vars                        [do not] show config file var/cmd line
                                          option names in section titles

   --recipient_delimiter C                split delivery addresses using
                                          recipient delimiter char C
   --reject_reply_patterns "R1 [R2 ...]"  set reject reply patterns used in
                                          to group rejects to R1, [R2 ...],
                                          where patterns are [45][.0-9][.0-9]
                                          or "Warn" (default: 5.. 4.. Warn)
   Supplimental reports
   --[no]delays                           [do not] show msg delays percentiles report
   --delays_percentiles "P1 [P2 ...]"     set delays report percentiles to
                                          P1 [P2 ...] (range: 0...100)
   --[no]postgrey_delays                  [do not] show postgrey delays percentiles
                                          report
   --postgrey_delays_percentiles "P1 [P2 ...]"
                                          set postgrey delays report percentiles to
                                          P1 [P2 ...] (range: 0...100)
END_USAGE

my @RejectPats;      # pattern list used to match against reject replys
my @RejectKeys;      # 1-to-1 with RejectPats, but with 'x' replacing '.' (for report output)
my (%DeferredByQid, %SizeByQid, %AcceptedByQid, %Delays);

# local prototypes
sub usage;
sub init_getopts_table;
sub init_defaults;
sub build_sect_table;
sub postfix_bounce;
sub postfix_cleanup;
sub postfix_panic;
sub postfix_fatal;
sub postfix_error;
sub postfix_warning;
sub postfix_script;
sub postfix_postsuper;
sub process_delivery_attempt;
sub cleanhostreply;
sub strip_ftph;
sub get_reject_key;
sub expand_bare_reject_limiters;
sub create_ignore_list;
sub in_ignore_list;
sub header_body_checks;
sub milter_common;

# lines that match any RE in this list will be ignored.
# see create_ignore_list();
my @ignore_list = ();

# The Sections table drives Summary and Detail reports.  For each entry in the
# table, if there is data avaialable, a line will be output in the Summary report.
# Additionally, a sub-section will be output in the Detail report if both the
# global --detail, and the section's limiter variable, are sufficiently high (a
# non-existent section limiter variable is considered to be sufficiently high).
#
my @Sections = ();

# List of reject variants.  See also: "Add reject variants" below, and conf file(s).
my @RejectClasses = qw(
   rejectrelay rejecthelo rejectdata rejectunknownuser rejectrecip rejectsender
   rejectclient rejectunknownclient rejectunknownreverseclient rejectunverifiedclient
   rejectrbl rejectheader rejectbody rejectcontent rejectsize rejectmilter rejectproxy
   rejectinsufficientspace rejectconfigerror rejectverify rejectetrn rejectlookupfailure
);

# Dispatch table of the list of supported policy services
# XXX have add-ins register into the dispatch table
my @policy_services = (
   [ qr/^postfwd/,         \&Logreporters::Postfwd::postfix_postfwd ],
   [ qr/^postgrey/,        \&Logreporters::Postgrey::postfix_postgrey ],
   [ qr/^policyd?-spf/,    \&Logreporters::PolicySPF::postfix_policy_spf ],
   [ qr/^policyd-?weight/, \&Logreporters::PolicydWeight::postfix_policydweight ],
);

# Initialize main running mode and basic opts
init_run_mode($config_file);

# Configure the Getopts options table
init_getopts_table();

# Place configuration file/environment variables onto command line
init_cmdline();

# Initialize default values
init_defaults();

# Process command line arguments, 0=no_permute,no_pass_through
get_options(0);

# Build the Section table, after reject_reply_patterns is final
build_sect_table();

# Expand bare rejects before generic processing
expand_bare_reject_limiters();

# Run through the list of Limiters, setting the limiters in %Opts.
process_limiters(@Sections);

# Set collection for any enabled supplemental sections
foreach (@supplemental_reports) {
   $Logreporters::TreeData::Collecting{$_} = (($Opts{'detail'} >= 5) && $Opts{$_}) ? 1 : 0;
}

if (! defined $Opts{'line_style'}) {
   # default line style to full if detail >= 11, or truncate otherwise
   $Opts{'line_style'} =
      ($Opts{'detail'} > 10) ? $line_styles{'full'} : $line_styles{'truncate'};
}

# Set the QID RE to capture either pre-2.9 short style or 2.9+ long style.
$re_QID = $Opts{'long_queue_ids'} ? $re_QID_l : $re_QID_s;

# Create the list of REs used to match against log lines
create_ignore_list();

# Notes:
#
#   - IN REs, always use /o flag or qr// at end of RE when RE uses interpolated vars
#   - In REs, email addresses may be empty "<>" - capture using *, not + ( eg. from=<.*?> )
#   - See additional notes below, search for "Note:".
#   - XXX indicates change, fix or thought required


# Main processing loop
#
LINE: while ( <> ) {
   chomp;
   s/\s+$//;
   next unless length $_;

   $Logreporters::Reports::origline = $_;

   # Linux:   Jul  1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
   # FreeBSD: Jul  1 20:08:06 <mail.info> mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1]
   #          Aug 17 15:16:12 mailhost postfix/cleanup[14194]: [ID 197553 mail.info] EC2B339E5: message-id=<2616.EC2B339E5@example.com>
   #          Dec 25 05:20:28 mailhost policyd-spf[14194]: [ID 27553 mail.info] ... policyd-spf stuff ...

   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;

   our $service_name = $3;
   my ($mailhost,$server_name,$p1) = ($1,$2,$4);
   #print "mailhost: $mailhost, servername: $server_name, servicename: $service_name, p1: $p1\n";

   $service_name = $server_name unless $service_name;
   #print "service_name: $service_name\n";

   # ignored postfix services...
   next if $service_name eq 'postlog';
   next if $service_name =~ /^$Opts{'ignore_services'}$/o;

   # common log entries up front
   if ($p1 =~ s/^connect from //) {
      #TD25 connect from sample.net[10.0.0.1]
      #TD connect from mail.example.com[2001:dead:beef::1]
      #TD connect from localhost.localdomain[127.0.0.1]
      #TD connect from unknown[unknown]
      $Totals{'connectioninbound'}++;
      next unless ($Collecting{'connectioninbound'});

      my $host = $p1;  my $hostip;
      if (($host,$hostip) = ($host =~ /^([^[]+)\[([^]]+)\]/)) {
         $host = formathost($hostip,$host);
      }
      $Counts{'connectioninbound'}{$host}++;
      next;
   }

   if ($p1 =~ /^disconnect from /) {
      #TD25 disconnect from sample.net[10.0.0.1]
      #TD disconnect from mail.example.com[2001:dead:beef::1]
      $Totals{'disconnection'}++;
      next;
   }

   if ($p1 =~ s/^connect to //) {
      next if ($p1 =~ /^subsystem /);
      $Totals{'connecttofailure'}++;
      next unless ($Collecting{'connecttofailure'});

      my ($host,$hostip,$reason,$port) = ($p1 =~ /^([^[]+)\[([^]]+)\](?::\d+)?: (.*?)(?:\s+\(port (\d+)\))?$/);
      # all "connect to" messages indicate a problem with the connection
      #TDs connect to example.org[10.0.0.1]: Connection refused (port 25)
      #TDs connect to mail.sample.com[10.0.0.1]: No route to host (port 25)
      #TDs connect to sample.net[192.168.0.1]: read timeout (port 25)
      #TDs connect to mail.example.com[10.0.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
      #TDs connect to mail.example.com[192.168.0.1]: server dropped connection without sending the initial SMTP greeting (port 25)
      #TDs connect to ipv6-1.example.com[2001:dead:beef::1]: Connection refused (port 25)
      #TDs connect to ipv6-2.example.com[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]: Connection refused (port 25)
      #TDs connect to ipv6-3.example.com[1080:0:0:0:8:800:200C:4171]: Connection refused (port 25)
      #TDs connect to ipv6-4.example.com[3ffe:2a00:100:7031::1]: Connection refused (port 25)
      #TDs connect to ipv6-5.example.com[1080::8:800:200C:417A]: Connection refused (port 25)
      #TDs connect to ipv6-6.example.com[::192.9.5.5]: Connection refused (port 25)
      #TDs connect to ipv6-7.example.com[::FFFF:129.144.52.38]: Connection refused (port 25)
      #TDs connect to ipv6-8.example.com[2010:836B:4179::836B:4179]: Connection refused (port 25)
      #TDs connect to mail.example.com[10.0.0.1]: server refused to talk to me: 452 try later   (port 25)

      $host = join(' :', $host, $port)   if ($port and $port ne '25');
      # Note: See ConnectToFailure below
      if ($reason =~ /^server (refused to talk to me): (.*)$/) {
         $Counts{'connecttofailure'}{ucfirst($1)}{formathost($hostip,$host)}{$2}++;
      } else {
         $Counts{'connecttofailure'}{ucfirst($reason)}{formathost($hostip,$host)}{''}++;
      }
      next;
   }

=pod
real    3m43.997s
user    3m39.038s
sys     0m3.005s
=pod
   # Handle before panic, fatal, warning, so that service-specific code gets first crack
   # XXX replace w/dispatch table for add-ins, so user's can add their own...
   if ($service_name eq 'postfwd')          { postfix_postfwd($p1);       next; }
   if ($service_name eq 'postgrey')         { postfix_postgrey($p1);      next; }
   if ($service_name =~ /^policyd?-spf/)    { postfix_policy_spf($p1);    next; } # postfix/policy-spf
   if ($service_name =~ /^policyd-?weight/) { postfix_policydweight($p1); next; } # postfix/policydweight

=cut
   # Handle policy service handlers before panic, fatal, warning, etc.
   # messages so that service-specific code gets first crack.
   # 5:25
   foreach (@policy_services) {
      if ($service_name =~ $_->[0]) {
         #print "Calling policy service helper: $service_name:('$p1')\n";
         &{$_->[1]}($p1);
         next LINE;
      }
   };
#=cut

   # ^warning: ...
   # ^fatal: ...
   # ^panic: ...
   # ^error: ...
   if ($p1 =~ /^warning: +(.*)$/)           { postfix_warning($1); next; }
   if ($p1 =~ /^fatal: +(.*)$/)             { postfix_fatal($1);   next; }
   if ($p1 =~ /^panic: +(.*)$/)             { postfix_panic($1);   next; }
   if ($p1 =~ /^error: +(.*)$/)             { postfix_error($1);   next; }

   # output by all services that use table lookups - process before specific messages
   if ($p1 =~ /(?:lookup )?table (?:[^ ]+ )?has changed -- (?:restarting|exiting)$/) {
      #TD table hash:/var/mailman/data/virtual-mailman(0,lock|fold_fix) has changed -- restarting
      #TD table hash:/etc/postfix/helo_checks has changed -- restarting
      $Totals{'tablechanged'}++;
      next;
   }

   # postfix/postscreen and postfix/verify services
   if ($service_name eq 'postscreen'
    or $service_name eq 'verify')          { postfix_postscreen($p1); next; }    # postfix/postscreen, postfix/verify
   if ($service_name eq 'dnsblog')         { postfix_dnsblog($p1);    next; }    # postfix/dnsblog
   if ($service_name =~ /^cleanup/)        { postfix_cleanup($p1);    next; }    # postfix/cleanup*
   if ($service_name =~ /^bounce/)         { postfix_bounce($p1);     next; }    # postfix/bounce*
   if ($service_name eq 'postfix-script')  { postfix_script($p1);     next; }    # postfix/postfix-script
   if ($service_name eq 'postsuper')       { postfix_postsuper($p1);  next; }    # postfix/postsuper

   # ignore tlsproxy for now
   if ($service_name eq 'tlsproxy')        { next; }                             # postfix/tlsproxy

   my ($helo, $relay, $from, $origto, $to, $domain, $status,
       $type, $reason, $reason2, $filter, $site, $cmd, $qid,
       $rej_type, $reject_name, $host, $hostip, $dsn, $reply, $fmthost, $bytes);

   $rej_type = undef;

   # ^$re_QID: ...
   if ($p1 =~ s/^($re_QID): //o) {
      $qid = $1;

      next if ($p1 =~ /^host \S*\[\S*\] said: 4\d\d/);  # deferrals, picked up in "status=deferred"

      if ($p1 =~ /^removed\s*$/ ) {
         # Note: See REMOVED elsewhere
         # 52CBDC2E0F: removed
         delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
         $Totals{'removedfromqueue'}++;
         next;
      }

      # coerce into general warning
      if (($p1 =~ /^Cannot start TLS: handshake failure/) or
          ($p1 =~ /^non-E?SMTP response from/)) {
         postfix_warning($p1);
         next;
      }

      if ($p1 eq 'status=deferred (bounce failed)') {
         #TDqQ status=deferred (bounce failed)
         $Totals{'bouncefailed'}++;
         next;
      }

      # this test must preceed access checks below
      #TDsQ  replace: header From:     "Postmaster" <postmaster@webmail.example.com>: From:     "Postmaster" <postmaster@webmail.example.org>
      if ($service_name eq 'smtp' and header_body_checks($p1)) {
         #print "main: header_body_checks\n";
         next;
      }

      # Postfix access actions
      #   REJECT optional text...
      #   DISCARD optional text...
      #   HOLD optional text...
      #   WARN optional text...
      #   FILTER transport:destination
      #   REDIRECT user@domain
      #   BCC user@domain  (2.6 experimental branch)
      # The following actions are indistinguishable in the logs
      #   4NN text
      #   5NN text
      #   DEFER_IF_REJECT optional text...
      #   DEFER_IF_PERMIT optional text...
      #   UCE restriction...
      # The following actions are not logged
      #   PREPEND headername: headervalue
      #   DUNNO
      #
      # Reject actions based on remote client information:
      #     - one of host name, network address, envelope sender
      #   or
      #     - recipient address

      # Template of access controls.  Rejects look like the first line, other access actions the second.
      # ftph is envelope from, envelope to, proto and helo.
      # QID: ACTION  STAGE from host[hostip]: DSN       trigger: explanation; ftph
      # QID: ACTION  STAGE from host[hostip]: trigger:           explanation; ftph

      # $re_QID: reject: RCPT|MAIL|CONNECT|HELO|DATA from ...
      # $re_QID: reject_warning: RCPT|MAIL|CONNECT|HELO|DATA from ...
      if ($p1 =~ /^(reject(?:_warning)?|discard|filter|hold|redirect|warn|bcc|replace): /) {
         my $action = $1;
         $p1 = substr($p1, length($action) + 2);

         #print "action: \"$action\", p1: \"$p1\"\n";
         if ($p1 !~ /^(RCPT|MAIL|CONNECT|HELO|EHLO|DATA|VRFY|ETRN|END-OF-MESSAGE) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
            inc_unmatched('unexpected access');
            next;
         }
         my ($stage,$host,$hostip,$p1) = ($1,$2,$3,$4);    #print "stage: \"$stage\", host: \"$host\", hostip: \"$hostip\", p1: \"$p1\"\n";
         my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);  #print "efrom: \"$efrom\", eto: \"$eto\", proto: \"$proto\", helo: \"$helo\"\n";
                                                           #print "p1 now: \"$p1\"\n";

# QID: ACTION         STAGE from host[hostip]:   DSN       trigger:          explanation;                                                       ftph
#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>
#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>
#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
#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
#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>
#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>
#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>
#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>
#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>
#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]>
#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>
#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>
#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>
#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>
#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>
#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>
#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>
#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>
#TDsdN reject_warning: HELO from host[10.0.0.1]: 554       <to@sample.net>:  Relay access denied;                                                                                        proto=SMTP  helo=<example.com>
#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>
#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>
#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>
#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>
#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>
#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

#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>
#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>
#TDsdN reject:         RCPT from unk[10.0.0.1]: 450                          Client host rejected: cannot find your hostname, [10.0.0.1];                                                proto=ESMTP
#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]
#TDsdN reject:      CONNECT from unk[unknown]:  421 4.7.1                    Client host rejected: cannot find your reverse hostname, [unknown];                                         proto=SMTP

#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>
#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>
#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>
#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>
#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>
#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>
#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>
#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>
#TDsdN reject:         RCPT from host[10.0.0.1]: 452                         Insufficient system storage;                                      from=<f@sample.com> to=<eto@sample.net>
#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>
#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>
#TDsdN reject:         MAIL from host[10.0.0.1]: 552                         Message size exceeds fixed limit;                                                                          proto=ESMTP helo=<localhost>
#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>
#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>

         # reject, reject_warning
         if ($action =~ /^reject/) {
            my ($recip);

            if ($p1 !~ /^($re_DSN) (.*)$/o) {
               inc_unmatched('reject1');
               next;
            }
            ($dsn,$p1) = ($1,$2);                        #print "dsn: $dsn, p1: \"$p1\"\n";
            $fmthost = formathost($hostip,$host);

            # reject_warning override temp or perm reject types
            $rej_type = ($action eq 'reject_warning' ? 'warn' : get_reject_key($dsn));
            #print "REJECT stage: '$rej_type'\n";

            if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
               $Counts{'byiprejects'}{$fmthost}++;
            }

            if ($stage eq 'VRFY') {
               if ($p1 =~ /^(?:<(\S*)>: )?(.*);$/) {
                  my ($trigger,$reason) = ($1,$2);
                  $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name});

                  if ($reason =~ /^Service unavailable; Client host \[[^]]+\] (blocked using [^;]*);/) {
                     $reason = join (' ', 'Client host blocked using', $1);
                     $trigger = '';
                  }
                  $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++;
               } else {
                  inc_unmatched('vrfyfrom');
               }
               next;
            }

            # XXX there may be several semicolon-separated messages
            # Recipient address rejected: Unknown users and via check_recipient_access
            if ($p1 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/) {
               ($recip,$reason) = ($1,$2);

               my ($localpart,$domainpart);
               # Unknown users; local mailbox, alias, virtual, relay user, unspecified
               if ($recip eq '') { ($localpart, $domainpart) = ('<>', '*unspecified'); }
               else {
                  ($localpart, $domainpart) = split (/@/, lc $recip);
                  ($localpart, $domainpart) = ($recip, '*unspecified')   if ($domainpart eq '');
               }

               if ($reason =~ s/^User unknown *//) {
                  $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name});

                  my ($table) = ($reason =~ /^in ((?:\w+ )+table)/);
                  $table = 'Address table unavailable'	if ($table eq '');     # when show_user_unknown_table_name=no
                  $Counts{$reject_name}{ucfirst($table)}{$domainpart}{$localpart}{$fmthost}++;
               } else {
                  # check_recipient_access
                  $Totals{$reject_name = "${rej_type}rejectrecip" }++; next unless ($Collecting{$reject_name});

                  if ($reason =~ m{^Please see http://[^/]+/why\.html}) {
                     $reason = 'SPF reject';
                  }
                  elsif ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
                     $reason = 'undeliverable address: remote host rejected recipient';
                  }
                  $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++;
               }

            } elsif ($p1 =~ /^<(.*?)>.* Relay access denied/) {
               $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$eto}++;

            } elsif ($p1 =~ /^<(.*)>: Sender address rejected: (.*);/) {
               $Totals{$reject_name = "${rej_type}rejectsender" }++;  next unless ($Collecting{$reject_name});
               ($from,$reason) =  ($1,$2);

               if ($reason =~ /^undeliverable address: host ([^[]+)\[([^]]+)\](?::\d+)? said:/) {
                  $reason = 'undeliverable address: remote host rejected sender';
               }
               $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++;

            } elsif ($p1 =~ /^(?:<.*>: )?Unverified Client host rejected: /) {
               # check_reverse_client_hostname_access (postfix 2.6+)
               $Totals{$reject_name = "${rej_type}rejectunverifiedclient" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;

            } elsif ($p1 =~ s/^(?:<.*>: )?Client host rejected: //) {
               # reject_unknown_client
               #   client IP->name mapping fails
               #   name->IP mapping fails
               #   name->IP mapping =! client IP
               if ($p1 =~ /^cannot find your hostname/) {
                  $Totals{$reject_name = "${rej_type}rejectunknownclient" }++; next unless ($Collecting{$reject_name});
                  $Counts{$reject_name}{$fmthost}{$helo}{$eto}{$efrom}++;
               }
               # reject_unknown_reverse_client_hostname (no PTR record for client's IP)
               elsif ($p1 =~ /^cannot find your reverse hostname/) {
                  $Totals{$reject_name = "${rej_type}rejectunknownreverseclient" }++; next unless ($Collecting{$reject_name});
                  $Counts{$reject_name}{$hostip}++
               }
               else {
                  $Totals{$reject_name = "${rej_type}rejectclient" }++; next unless ($Collecting{$reject_name});
                  $p1 =~ s/;$//;
                  $Counts{$reject_name}{ucfirst($p1)}{$fmthost}{$eto}{$efrom}++;
               }
            } elsif ($p1 =~ /^Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/) {
               # Note: similar code below: search RejectRBL

               # postfix 2.1
               #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>
               # postfix 2.3+
               #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>
               #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>

               $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
               ($site,$reason) = ($1 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
               $reason =~ s/^reason: // if ($reason);
               $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++;

            } elsif ($p1 =~ /^<.*>: Helo command rejected: (.*);$/) {
               $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;

            } elsif ($p1 =~ /^<.*>: Etrn command rejected: (.*);$/) {
               $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{ucfirst($1)}{$fmthost}{$helo}++;

            } elsif ($p1 =~ /^<.*>: Data command rejected: (.*);$/) {
               $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$1}{$fmthost}{$helo}++;

            } elsif ($p1 =~ /^Insufficient system storage;/) {
               $Totals{'warninsufficientspace'}++;    # force display in Warnings section also
               $Totals{$reject_name = "${rej_type}rejectinsufficientspace" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;

            } elsif ($p1 =~ /^Server configuration (?:error|problem);/) {
               $Totals{'warnconfigerror'}++;          # force display in Warnings section also
               $Totals{$reject_name = "${rej_type}rejectconfigerror" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;

            } elsif ($p1 =~ /^Message size exceeds fixed limit;$/) {
               # Postfix responds with this message after a MAIL FROM:<...> SIZE=nnn  command, where postfix consider's nnn excessive
               # Note: similar code below: search RejectSize
               # Note: reject_warning does not seem to occur
               $Totals{$reject_name = "${rej_type}rejectsize" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;

            } elsif ($p1 =~ /^<(.*?)>: Temporary lookup failure;/) {
               $Totals{$reject_name = "${rej_type}rejectlookupfailure" }++; next unless ($Collecting{$reject_name});
               $Counts{$reject_name}{$fmthost}{$eto}{$efrom}++;

            # This would capture all other rejects, but I think it might be more useful to add
            # additional capture sections based on user reports of uncapture lines.
            #
            #} elsif ( ($reason) = ($p1 =~ /^([^;]+);/)) {
            #  $Totals{$rej_type . 'rejectother'}++;
            #  $Counts{$rej_type . 'rejectother'}{$reason}++;
            } else {
               inc_unmatched('rejectother');
            }
         }
         # end of $re_QID: reject:

# QID: ACTION         STAGE from host[hostip]:   trigger:                    reason;                                                            ftph
#
#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>
#TDsdN warn:           RCPT from host[10.0.0.1]:                             ;                                                                  from=<f@sample.com> to=<eto@example.com> proto=ESMTP helo=<sample.net>
#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>
#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>
#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>
#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> 
#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>
#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>
#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>
#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>
#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>
#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>
#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>

# BCC action (postfix 2.6+)
#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> 

         # $re_QID: discard, filter, hold, redirect, warn, bcc, replace ...
         else {
            my $trigger;
            ($trigger,$reason) = ($p1 =~ /^(?:<(\S*)>: )?(.*);$/ );
            if ($trigger eq '') {   $trigger = '*unavailable';  }
            else {                  $trigger =~ s/^<(.+)>$/$1/; }
            $reason  = '*unavailable' if ($reason eq '');
            $fmthost = formathost ($hostip,$host);
            #print "trigger: \"$trigger\", reason: \"$reason\"\n";

            # reason -> subject text
            #           subject -> "Helo command"           : smtpd_helo_restrictions
            #           subject -> "Client host"            : smtpd_client_restrictions
            #           subject -> "Unverified Client host" : smtpd_client_restrictions
            #           subject -> "Client certificate"     : smtpd_client_restrictions
            #           subject -> "Sender address"         : smtpd_sender_restrictions
            #           subject -> "Recipient address"      : smtpd_recipient_restrictions

            #           subject -> "Data command"           : smtpd_data_restrictions
            #           subject -> "End-of-data"            : smtpd_end_of_data_restrictions
            #           subject -> "Etrn command"           : smtpd_etrn_restrictions

            #           text    -> triggers <ACTION> action|triggers <ACTION> <destination>|optional text...

            my ($subject, $text) =
               ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o);
            #printf "ACTION: '$action', SUBJECT: %-30s TEXT: \"$text\"\n", '"' . $subject . '"';

            if ($action eq 'filter') {
               $Totals{'filtered'}++; next unless ($Collecting{'filtered'});
               # See "Note: Counts" before changing $Counts below re: Filtered
               $text =~ s/triggers FILTER //;
               if    ($subject eq 'Recipient address') { $Counts{'filtered'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
               elsif ($subject =~ /Client host$/)      { $Counts{'filtered'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
               else                                    { $Counts{'filtered'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
            }
            elsif ($action eq 'redirect') {
               $Totals{'redirected'}++; next unless ($Collecting{'redirected'});
               $text =~ s/triggers REDIRECT //;
               # See "Note: Counts" before changing $Counts below re: Redirected
               if    ($subject eq 'Recipient address') { $Counts{'redirected'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
               elsif ($subject =~ /Client host$/)      { $Counts{'redirected'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
               else                                    { $Counts{'redirected'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
            }
            # hold, discard, and warn allow "optional text"
            elsif ($action eq 'hold') {
               $Totals{'hold'}++; next unless ($Collecting{'hold'});
               # See "Note: Counts" before changing $Counts below re: Hold
               $subject = $reason unless $text eq 'triggers HOLD action';
               if    ($subject eq 'Recipient address') { $Counts{'hold'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
               elsif ($subject =~ /Client host$/)      { $Counts{'hold'}{$subject}{$fmthost}{$eto}{$efrom}++; }
               else                                    { $Counts{'hold'}{$subject}{$trigger}{$eto}{$fmthost}++; }
            }
            elsif ($action eq 'discard') {
               $Totals{'discarded'}++; next unless ($Collecting{'discarded'});
               # See "Note: Counts" before changing $Counts below re: Discarded
               $subject = $reason unless $text eq 'triggers DISCARD action';
               if    ($subject eq 'Recipient address') { $Counts{'discarded'}{$subject}{$trigger}{$efrom}{$fmthost}++; }
               elsif ($subject =~ /Client host$/)      { $Counts{'discarded'}{$subject}{$fmthost}{$eto}{$efrom}++; }
               else                                    { $Counts{'discarded'}{$subject}{$trigger}{$eto}{$fmthost}++; }
            }
            elsif ($action eq 'warn') {
               $Totals{'warned'}++; next unless ($Collecting{'warned'});
               $Counts{'warned'}{$reason}{$fmthost}{$eto}{''}++;
               # See "Note: Counts" before changing $Counts above...
            }
            elsif ($action eq 'bcc') {
               $Totals{'bcced'}++; next unless ($Collecting{'bcced'});
               # See "Note: Counts" before changing $Counts below re: Filtered
               $text =~ s/triggers BCC //o;
               if    ($subject eq 'Recipient address') { $Counts{'bcced'}{$text}{$subject}{$trigger}{$efrom}{$fmthost}++; }
               elsif ($subject =~ /Client host$/)      { $Counts{'bcced'}{$text}{$subject}{$fmthost}{$eto}{$efrom}++; }
               else                                    { $Counts{'bcced'}{$text}{$subject}{$trigger}{$eto}{$fmthost}++; }
            }
            else {
               die "Unexpected ACTION: '$action'";
            }
         }
      }

      elsif ($p1 =~ s/^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)//) {
         my ($hip,$host,$hostip) = ($1,$2,$3);

         # Increment accepted when the client connection is made and smtpd has a QID.
         # Previously, accepted was being incorrectly incremented when the first qmgr
         # "from=xxx, size=nnn ..." line was seen.  This is erroneous when the smtpd
         # client connection occurred outside the date range of the log being analyzed.
         $AcceptedByQid{$qid} = $hip;
         $Totals{'msgsaccepted'}++;

         #TDsdQ client=unknown[192.168.0.1]
         #TDsdQ client=unknown[192.168.0.1]:unknown
         #TDsdQ client=unknown[192.168.0.1]:10025
         #TDsd client=example.com[192.168.0.1], helo=example.com
         #TDsdQ client=mail.example.com[2001:dead:beef::1]

         #TDsdQ client=localhost[127.0.0.1], sasl_sender=someone@example.com
         #TDsdQ client=example.com[192.168.0.1], sasl_method=PLAIN, sasl_username=anyone@sample.net
         #TDsdQ client=example.com[192.168.0.1], sasl_method=LOGIN, sasl_username=user@example.com, sasl_sender=<id352ib@sample.net>
         #TDsdQ client=unknown[10.0.0.1], sasl_sender=user@examine.com
         next if ($p1 eq '');
         my ($method,$user,$sender) = ($p1 =~ /^(?:, sasl_method=([^,]+))?(?:, sasl_username=([^,]+))?(?:, sasl_sender=<?(.*)>?)?$/);

         # sasl_sender occurs when AUTH verb is present in MAIL FROM, typically used for relaying
         # the username (eg. sasl_username) of authenticated users.
         if ($sender or $method or $user) {
            $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'});
            $method ||= '*unknown method';
            $user   ||= '*unknown user';
            $Counts{'saslauth'}{$user . ($sender ? " ($sender)" : '')}{$method}{formathost($hostip,$host)}++;
         }
      }

      # ^$re_QID: ...  (not access(5) action)
      elsif ($p1 =~ /^from=<(.*?)>, size=(\d+), nrcpt=(\d+)/) {
         my ($efrom,$bytes,$nrcpt) = ($1,$2,$3);
         #TDsdQ from=<FROM: SOME USER@example.com>, size=4051, nrcpt=1 (queue active)
         #TDsdQ(12) from=<anyone@example.com>, size=25302, nrcpt=2 (queue active)
         #TDsdQ from=<from@example.com>, size=5529, nrcpt=1 (queue active)
         #TDsdQ from=<from@example.net, @example.com>, size=5335, nrcpt=1 (queue active)

         # Distinguish bytes accepted vs. bytes delivered due to multiple recips

         # Increment bytes accepted on the first qmgr "from=..." line...
         next if (exists $SizeByQid{$qid});
         $SizeByQid{$qid}          = $bytes;
         # ...but only when the smtpd "client=..." line has been seen too.
         # This under-counts when the smtpd "client=..." connection log entry and the
         # qmgr "from=..." log entry span differnt periods (as fed to postfix-logwatch).
         next if (! exists $AcceptedByQid{$qid});

         $Totals{'bytesaccepted'} += $bytes;

         $Counts{'envelopesenders'}{$efrom ne '' ? $efrom : '<>'}++      if ($Collecting{'envelopesenders'});
         if ($Collecting{'envelopesenderdomains'}) {
            my ($localpart, $domain);
            if ($efrom eq '') { ($localpart, $domain) = ('<>', '*unknown'); }
            else              { ($localpart, $domain) = split (/@/, lc $efrom); }

            $Counts{'envelopesenderdomains'}{$domain ne '' ? $domain : '*unknown'}{$localpart}++;
         }
         delete $AcceptedByQid{$qid};           # prevent incrementing BytesAccepted again
      }

      ### sent, forwarded, bounced, softbounce, deferred, (un)deliverable
      elsif ($p1 =~ s/^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=(\S+) //o) {
         ($relay,$status) = ($3,$5);

         my ($to,$origto,$localpart,$domainpart,$dsn,$p1) = process_delivery_attempt ($1,$2,$4,$p1);

         #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)
         #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)
         #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)

         ### sent
         if ($status eq 'sent') {
            if ($p1 =~ /forwarded as /) {
               $Totals{'bytesforwarded'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
               $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'});
               $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++;
            }
            else {
               if ($service_name eq 'lmtp') {
                  $Totals{'bytessentlmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
                  $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'});
                  $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++;
               }
               elsif ($service_name eq 'smtp') {
                  $Totals{'bytessentsmtp'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
                  $Totals{'sent'}++; next unless ($Collecting{'sent'});
                  $Counts{'sent'}{$domainpart}{$localpart}{$origto}++;
               }
               # virtual, command, ...
               else {
                  $Totals{'bytesdelivered'} += $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
                  $Totals{'delivered'}++; next unless ($Collecting{'delivered'});
                  $Counts{'delivered'}{$domainpart}{$localpart}{$origto}++;
               }
            }
         }

         elsif ($status eq 'deferred') {
            #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)
            #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused)
            #TDsQ to=<to@example.com>, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused)
            #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)
            #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)
            #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)
            #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)
            #TDsQ to=<to@localhost>, orig_to=<toalias@localhost>, relay=none, delay=238024, status=deferred (delivery temporarily suspended: transport is unavailable)

            # XXX postfix reports dsn=5.0.0, host's reply may contain its own dsn's such as 511 and #5.1.1
            # XXX should these be used instead?
            #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))
            #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))
            #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))

            ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);

            $Totals{'deferred'}++      if ($DeferredByQid{$qid}++ == 0);
            $Totals{'deferrals'}++;    next unless ($Collecting{'deferrals'});
            $Counts{'deferrals'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
         }

         ### bounced
         elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') {
            # local agent
            #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")

            # smtp agent
            #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))

            #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))
            #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))


            #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)
            #TDsQ to=<>,                                   relay=none,  delay=1,                                       status=bounced (mail for sample.net loops back to myself) 
            #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)
            # XXX verify these...
            #TD EB0B8770: to=<to@example.com>, orig_to=<postmaster>, relay=none, delay=1, status=bounced (User unknown in virtual alias table)
            #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)
            #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")
            #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")

            #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))
            #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))
            #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))
            #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))
            #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))
            #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))
            #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")

            # print "bounce message from " . $to . " msg : " . $relay . "\n";

            # See same code elsewhere "Note: Bounce" 
            ### local bounce
            # XXX local v. remote bounce seems iffy, relative
            if ($relay =~ /^(?:none|local|virtual|127\.0\.0\.1|maildrop|avcheck)/) {
               $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'});
               $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($p1)}{$localpart}++;
            }
            else {
               $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'});
               ($reply,$fmthost) = cleanhostreply($p1,$relay,$to,$domainpart);
               $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
            }
         }


         elsif ($status =~ 'undeliverable') {
            #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)
            #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))
            #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")
            #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")
            $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'});
            if ($p1 =~ /^unknown user: ".+?"$/) {
               $Counts{'undeliverable'}{get_dsn_msg($dsn)}{'Unknown user'}{$domainpart}{$localpart}{$origto ? $origto : ''}++;
            }
            else {
               my ($reply,$fmthost) = cleanhostreply($p1,'',$to ne '' ? $to : '<>',$domainpart);
               $Counts{'undeliverable'}{get_dsn_msg($dsn)}{$reply}{$domainpart}{$localpart}{$fmthost}++;
            }
         }

         elsif ($status eq 'deliverable') {
            # address verification, sendmail -bv deliverable reports
            #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)
            $Totals{'deliverable'}++; next unless ($Collecting{'deliverable'});
            my $dsn = ($p1 =~ s/^($re_DSN) // ? $1 : '*unavailable');
            $Counts{'deliverable'}{$dsn}{$p1}{$origto ? "$to ($origto)" : $to}++;
         }

         else {
            # keep this as the last condition in this else clause
            inc_unmatched('unknownstatus');
         }
      } # end of sent, forwarded, bounced, softbounce, deferred, (un)deliverable

      # pickup
      elsif ($p1 =~ /^(uid=\S* from=<.*?>)/) {
         #TDpQ2 uid=0 from=<root>
         $AcceptedByQid{$qid} = $1;
         $Totals{'msgsaccepted'}++;
      }

      elsif ($p1 =~ /^from=<(.*?)>, status=expired, returned to sender$/) {
         #TDqQ from=<from@example.com>, status=expired, returned to sender
         $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'});
         $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++;
      }

      elsif ($p1 =~ s/^host ([^[]+)\[([^]]+)\](?::\d+)? refused to talk to me://) {
         #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
         #TDsQ host mail.example.com[10.0.0.1] refused to talk to me: 501 Connection from 192.168.2.1 (XY) rejected
         # Note: See ConnectToFailure above
         $Totals{'connecttofailure'}++; next unless ($Collecting{'connecttofailure'});
         $Counts{'connecttofailure'}{'Refused to talk to me'}{formathost($2,$1)}{$p1}++;
      }

      elsif ($p1 =~ /^lost connection with ([^[]*)\[([^]]+)\](?::\d+)? (while .*)$/) {
         # outbound smtp
         #TDsQ lost connection with sample.net[10.0.0.1] while sending MAIL FROM
         #TDsQ lost connection with sample.net[10.0.0.2] while receiving the initial server greeting
         $Totals{'connectionlostoutbound'}++; next unless ($Collecting{'connectionlostoutbound'});
         $Counts{'connectionlostoutbound'}{ucfirst($3)}{formathost($2,$1)}++;
      }

      elsif ($p1 =~ /^conversation with ([^[]*)\[([^]]+)\](?::\d+)? timed out (while .*)$/) {
         #TDsQ conversation with sample.net[10.0.0.1] timed out while receiving the initial SMTP greeting
         # Note: see TimeoutInbound below
         $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
         $Counts{'timeoutinbound'}{ucfirst($3)}{formathost($2,$1)}{''}++;
      }

      elsif ($p1 =~ /^enabling PIX (<CRLF>\.<CRLF>) workaround for ([^[]+)\[([^]]+)\](?::\d+)?/ or
             $p1 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[([^]]+)\](?::\d+)?/) {
         #TDsQ enabling PIX <CRLF>.<CRLF> workaround for example.com[192.168.0.1]
         #TDsQ enabling PIX <CRLF>.<CRLF> workaround for mail.sample.net[10.0.0.1]:25
         #TDsQ enabling PIX workarounds: disable_esmtp delay_dotcrlf for spam.example.org[10.0.0.1]:25
         $Totals{'pixworkaround'}++; next unless ($Collecting{'pixworkaround'});
         $Counts{'pixworkaround'}{$1}{formathost($3,$2)}++;
      }

      # milter-reject, milter-hold, milter-discard
      elsif ($p1 =~ s/^milter-//) {
         milter_common($p1);
      }

      elsif ($p1 =~ s/^SASL (\[CACHED\] )?authentication failed; //) {
         #TDsQ SASL authentication failed; cannot authenticate to server smtp.example.com[10.0.0.1]: no mechanism available
         #TDsQ SASL authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
         #TDsQ SASL [CACHED] authentication failed; server example.com[10.0.0.1] said: 535 Error: authentication failed
         # see saslauthfail elsewhere

         $Totals{'saslauthfail'}++; next unless ($Collecting{'saslauthfail'});
         my $cached = $1;

         if ($p1 =~ /^(authentication protocol loop with server): ([^[]+)\[([^]]+)\](?::\d+)?$/) {
            ($reason,$host,$hostip,$reason2) = ($1,$2,$3,'');
         }
         elsif ($p1 =~ /^(cannot authenticate to server) ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {
            ($reason,$host,$hostip,$reason2) = ($1,$2,$3,$4);
         }
         elsif ($p1 =~ /^server ([^[]+)\[([^]]+)\](?::\d+)? said: (.+)$/) {
            ($reason,$host,$hostip,$reason2) = ('server ... said',$1,$2,$3);
         }
         else {
            inc_unmatched('saslauthfail');
            next;
         }

         $reason .= ': ' . $reason2  if $reason2;
         $Counts{'saslauthfail'}{$cached . $reason}{formathost($hostip,$host)}++;
      }

      else {
         # keep this as the last condition in this else clause
         inc_unmatched('unknownqid')  if  ! in_ignore_list ($p1);
      }
   }
   # end of $re_QID section

   elsif ($p1 =~ /^(timeout|lost connection) (after [^ ]+)(?: \((?:approximately )?(\d+) bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
      my ($lort,$reason,$bytes,$host,$hostip) = ($1,$2,$3,$4,$5);
      if ($lort eq 'timeout') {
         # see also TimeoutInbound in $re_QID section
         #TDsd timeout after RSET from example.com[192.168.0.1]
         #TDsd timeout after DATA (6253 bytes) from example.com[10.0.0.1]

         $Totals{'timeoutinbound'}++; next unless ($Collecting{'timeoutinbound'});
         $Counts{'timeoutinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
      } else {
         #TDsd lost connection after CONNECT from mail.example.com[192.168.0.1]
         # postfix 2.5:20071003
         #TDsd lost connection after DATA (494133 bytes) from localhost[127.0.0.1]
         # postfix 2.6:20080621
         #TDsd lost connection after DATA (approximately 0 bytes) from example.com[10.0.0.1]

         $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'});
         $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++;
      }
   }

   elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ($re_DSN) Service (?:temporarily )?(?:unavailable|denied)[^;]*; (?:(?:Unverified )?Client host |Sender address |Helo command )?\[[^ ]*\] blocked using ([^;]+);/o) {
      my ($rej_type,$host,$hostip,$dsn,)  = ($1,$2,$3,$4);
      ($site,$reason) = ($5 =~ /^(.+?)(?:$|(?:[.,] )(.*))/);
      $reason =~ s/^reason: // if ($reason);
      $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn));
      #print "REJECT RBL NOQ: '$rej_type'\n";
      # Note: similar code above: search RejectRBL

      # This section required: postfix didn't always log QID (eg. postfix 1.1)
      # Also, "reason:" was probably always present in this case, but I'm not certain
      # postfix 1.1
      #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>
      #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>
      #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>
      #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>

      if ($Collecting{'byiprejects'} and substr($rej_type,0,1) eq '5') {
         $fmthost = formathost($hostip,$host);
         $Counts{'byiprejects'}{$fmthost}++;
      }

      $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name});
      $Counts{$reject_name}{$site}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reason ? $reason : ''}++;
   }

   # proxy-reject, proxy-accept
   elsif ($p1 =~ s/^proxy-(reject|accept): ([^:]+): //) {
      # 2.7
      #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> 
      #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>
      #TDsdN proxy-reject: END-OF-MESSAGE: ; from=<user@example.com> to=<user@example.org> proto=SMTP helo=<mail.example.net>

      next if $1 eq 'accept';    #ignore accepts

      my ($stage) = ($2);
      my ($efrom,$eto,$proto,$helo) = strip_ftph($p1);
      #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
      #print "stage: '$stage', reply: '$p1'\n";

      my ($dsn,$reject_name);
      ($dsn,$reply) = ($1,$2)    if $p1 =~ /^($re_DSN) (.*)$/o;
      #print "   dsn: '$dsn', reply: '$reply', key: ", get_reject_key($dsn), "\n";
      # DSN may not be present. Can occur, for example, when queue file size limit is reached,
      # which is logged as a Warning.  Ignore these, since they can't be add to any
      # reject section (no SMTP reply code).
      if (! defined $dsn) {
         next;
      }

      $Totals{$reject_name = get_reject_key($dsn) . 'rejectproxy' }++; next unless ($Collecting{$reject_name});
      $Counts{$reject_name}{$stage}{$reply}{$eto}++;
   }

   ### smtpd_tls_loglevel >= 1
   # Server TLS messages
   elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/)) {
      #TDsd TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
      # Postfix 2.5+: status: Untrusted or Trusted
      #TDsd Untrusted TLS connection established from example.com[192.168.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)
      #TDsd Anonymous TLS connection established from localhost[127.0.0.1]: TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits) 

      $Totals{'tlsserverconnect'}++; next unless ($Collecting{'tlsserverconnect'});
      $Counts{'tlsserverconnect'}{$status ? "$status: $type" : $type}{formathost($hostip,$host)}++;
   }

   # Client TLS messages
   elsif ( ($status,$host,$type) = ($p1 =~ /^(?:(Verified|Trusted|Untrusted|Anonymous) )?TLS connection established to ([^ ]*): (.*)$/o)) {
      #TD TLS connection established to example.com: TLSv1 with cipher AES256-SHA (256/256 bits)
      # Postfix 2.5+: peer verification status: Untrusted, Trusted or Verified when
      # server's trust chain is valid and peername is matched
      #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)

      $Totals{'tlsclientconnect'}++; next unless ($Collecting{'tlsclientconnect'});
      $Counts{'tlsclientconnect'}{$status ? "$status: $type" : $type}{$host}++;
   }

   # smtp_tls_note_starttls_offer=yes
   elsif ($p1 =~ /^Host offered STARTTLS: \[(.*)\]$/o) {
      #TD Host offered STARTTLS: [mail.example.com]
      $Totals{'tlsoffered'}++; next unless ($Collecting{'tlsoffered'});
      $Counts{'tlsoffered'}{$1}++;
   }

   ### smtpd_tls_loglevel >= 1
   elsif ($p1 =~ /^Unverified: (.*)/o) {
      #TD Unverified: subject_CN=(www|smtp|mailhost).(example.com|sample.net), issuer=someuser
      $Totals{'tlsunverified'}++; next unless ($Collecting{'tlsunverified'});
      $Counts{'tlsunverified'}{$1}++;
   }

   # Note: no QID
   elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[([^]]+)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<(.*?)> to=<(.*?)>/)) {
      #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>
      #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>
      # Note: similar code above: search RejectSize
      # Note: reject_warning does not seem to occur
      if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
         $fmthost = formathost($hostip,$host);
         $Counts{'byiprejects'}{$fmthost}++;
      }
      $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name});
      $Counts{$reject_name}{$fmthost ? $fmthost : formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++;
   }

   elsif ($p1 =~ /looking for plugins in (.*)$/) {
    #TD looking for plugins in '/usr/lib/sasl2', failed to open directory, error: No such file or directory
      $Totals{'warnconfigerror'}++; next unless ($Collecting{'warnconfigerror'});
      $Counts{'warnconfigerror'}{$1}++;
   }

   # SMTP/ESMTP protocol violations
   elsif ($p1 =~ /^(improper command pipelining) (after \S+) from ([^[]*)\[([^]]+)\](?::\d+)?/) {
      # ProtocolViolation
      #TDsd postfix/smtpd[24928]: improper command pipelining after RCPT from unknown[192.168.0.1]
      my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
      $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
      $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
   }

   elsif ($p1 =~ /^(too many errors) (after [^ ]*)(?: \((?:approximately )?\d+ bytes\))? from ([^[]*)\[([^]]+)\](?::\d+)?$/) {
      my ($error,$stage,$host,$hostip) = ($1,$2,$3,$4);
      #TDsd too many errors after AUTH from sample.net[10.0.0.1]
      #TDsd too many errors after DATA (0 bytes) from 1-0-0-10.example.com[10.0.0.1]
      $Totals{'smtpprotocolviolation'}++; next unless ($Collecting{'smtpprotocolviolation'});
      $Counts{'smtpprotocolviolation'}{ucfirst($error)}{ucfirst($stage)}{formathost($hostip,$host)}++;
   }

   # coerce these into general warnings
   elsif ( $p1 =~ /^cannot load Certificate Authority data/ or
           $p1 =~ /^SSL_connect error to /)
   {
      #TDsQ Cannot start TLS: handshake failure
      #TDsd cannot load Certificate Authority data
      #TDs SSL_connect error to mail.example.com: 0

      postfix_warning($p1);
   }

   else {
      # add to the unmatched list if not on the ignore_list
      inc_unmatched('final')   if ! in_ignore_list ($p1);
   }
}

########################################
# Final tabulations, and report printing

for my $code (@RejectKeys) {
   for my $type (@RejectClasses) {
      $Totals{'totalrejects' . $code} += $Totals{$code . $type};
   }

   if ($code =~ /^5/o) {
      $Totals{'totalrejects'} += $Totals{'totalrejects' . $code};
   }
}

# XXX this was naive - the goal was to avoid recounting messages
# released from quarantine, but externally introduced messages may
# contain resent-message-id; trying to track only internally resent
# messages does not seem useful.
# make some corrections now, due to double counting
#$Totals{'msgsaccepted'} -= $Totals{'resent'}   if ($Totals{'msgsaccepted'} >= $Totals{'resent'});

$Totals{'totalacceptplusreject'} = $Totals{'msgsaccepted'} + $Totals{'totalrejects'};

# Print the Summary report if any key has non-zero data.
# Note: must explicitely check for any non-zero data,
# as Totals always has some keys extant.
#
if ($Opts{'summary'}) {
   for (keys %Totals) {
      if ($Totals{$_}) {
         print_summary_report (@Sections);
         last;
      }
   }
}

# Print the Detail report, if detail is sufficiently high
#
if ($Opts{'detail'} >= 5) {
   #print STDERR "Counts     memory usage: ", commify(Devel::Size::total_size(\%Counts)), "\n";
   #print STDERR "Delays     memory usage: ", commify(Devel::Size::total_size(\%Delays)), "\n";
   print_detail_report(@Sections);

   if ($Opts{'delays'}) {
      my @table;
      for (sort keys %Delays) {
         # anon array ref: label, array ref of $Delay{key}
         push @table, [ substr($_,3), $Delays{$_} ];
      }
      if (@table) {
         print_percentiles_report2(\@table, "Delivery Delays Percentiles", $Opts{'delays_percentiles'});
      }
   }

   print_postgrey_reports();

}

# debug: show which ignore_list items are hit most
#my %IGNORED;
#for (sort { $IGNORED{$b} <=> $IGNORED{$a} } keys %IGNORED) {
#   printf "%10d: KEY: %s\n", $IGNORED{$_}, $_;
#}

# Finally, print any unmatched lines
#
print_unmatched_report();

#
# End of main
#
##################################################

# Create the list of REs against which log lines are matched.
# Lines that match any of the patterns in this list are ignored.
#
# Note: This table is created at runtime, due to a Perl bug which
# I reported as perl bug #56202:
#
#    http://rt.perl.org/rt3/Public/Bug/Display.html?id=56202
#
sub create_ignore_list() {
   # top 3 hitters up front
   push @ignore_list, qr/^statistics:/;
   push @ignore_list, qr/^setting up TLS connection (?:from|to)/;
   push @ignore_list, qr/^Verified: /;
   push @ignore_list, qr/^skipped, still being delivered/;

   # SSL info at/above mail.info level
   push @ignore_list, qr/^read from [a-fA-F\d]{8}/;
   push @ignore_list, qr/^write to [a-fA-F\d]{8}/;
   push @ignore_list, qr/^[a-f\d]{4} [a-f\d]{2}/;
   push @ignore_list, qr/^[a-f\d]{4} - <SPACES/;
   push @ignore_list, qr/^[<>]+ /;

   push @ignore_list, qr/^premature end-of-input (?:on|from) .* socket while reading input attribute name$/;
   push @ignore_list, qr/^certificate peer name verification failed/;
   push @ignore_list, qr/^Peer certi?ficate could not be verified$/;   # missing i was a postfix typo
   push @ignore_list, qr/^Peer cert verify depth=/;
   push @ignore_list, qr/^Peer verification:/;
   push @ignore_list, qr/^Server certificate could not be verified/;
   push @ignore_list, qr/^cannot load .SA certificate and key data/;
   push @ignore_list, qr/^tlsmgr_cache_run_event/;
   push @ignore_list, qr/^SSL_accept/;
   push @ignore_list, qr/^SSL_connect:/;
   push @ignore_list, qr/^connection (?:closed|established)/;
   push @ignore_list, qr/^delete smtpd session/;
   push @ignore_list, qr/^put smtpd session/;
   push @ignore_list, qr/^save session/;
   push @ignore_list, qr/^Reusing old/;
   push @ignore_list, qr/^looking up session/;
   push @ignore_list, qr/^lookup smtpd session/;
   push @ignore_list, qr/^lookup \S+ type/;
   push @ignore_list, qr/^xsasl_(?:cyrus|dovecot)_/;
   push @ignore_list, qr/^watchdog_/;
   push @ignore_list, qr/^read smtpd TLS/;
   push @ignore_list, qr/^open smtpd TLS/;
   push @ignore_list, qr/^write smtpd TLS/;
   push @ignore_list, qr/^read smtp TLS cache entry/;
   push @ignore_list, qr/^starting TLS engine$/;
   push @ignore_list, qr/^initializing the server-side TLS/;
   push @ignore_list, qr/^global TLS level: /;
   push @ignore_list, qr/^auto_clnt_/;
   push @ignore_list, qr/^generic_checks:/;
   push @ignore_list, qr/^inet_addr_/;
   push @ignore_list, qr/^mac_parse:/;
   push @ignore_list, qr/^cert has expired/;
   push @ignore_list, qr/^daemon started/;
   push @ignore_list, qr/^master_notify:/;
   push @ignore_list, qr/^rewrite_clnt:/;
   push @ignore_list, qr/^rewrite stream/;
   push @ignore_list, qr/^dict_/;
   push @ignore_list, qr/^send attr /;
   push @ignore_list, qr/^match_/;
   push @ignore_list, qr/^input attribute /;
   push @ignore_list, qr/^Run-time/;
   push @ignore_list, qr/^Compiled against/;
   push @ignore_list, qr/^private\//;
   push @ignore_list, qr/^reject_unknown_/;    # don't combine or shorten these reject_ patterns
   push @ignore_list, qr/^reject_unauth_/;
   push @ignore_list, qr/^reject_non_/;
   push @ignore_list, qr/^permit_/;
   push @ignore_list, qr/^idle timeout/;
   push @ignore_list, qr/^get_dns_/;
   push @ignore_list, qr/^dns_/;
   push @ignore_list, qr/^chroot /;
   push @ignore_list, qr/^process generation/;
   push @ignore_list, qr/^fsspace:/;
   push @ignore_list, qr/^master disconnect/;
   push @ignore_list, qr/^resolve_clnt/;
   push @ignore_list, qr/^ctable_/;
   push @ignore_list, qr/^extract_addr/;
   push @ignore_list, qr/^mynetworks:/;
   push @ignore_list, qr/^name_mask:/;
      #TDm reload -- version 2.6-20080814, configuration /etc/postfix
      #TDm reload configuration /etc/postfix
   push @ignore_list, qr/^reload (?:-- version \S+, )?configuration/;
   push @ignore_list, qr/^terminating on signal 15$/;
   push @ignore_list, qr/^verify error:num=/;
   push @ignore_list, qr/^verify return:/;
   push @ignore_list, qr/^nss_ldap: /;
   push @ignore_list, qr/^discarding EHLO keywords: /;
   push @ignore_list, qr/^sql auxprop plugin/;
   push @ignore_list, qr/^sql plugin/;
   push @ignore_list, qr/^sql_select/;
   push @ignore_list, qr/^auxpropfunc error/;
   push @ignore_list, qr/^commit transaction/;
   push @ignore_list, qr/^begin transaction/;
   push @ignore_list, qr/^maps_find: /;
   push @ignore_list, qr/^check_access: /;
   push @ignore_list, qr/^check_domain_access: /;
   push @ignore_list, qr/^check_mail_access: /;
   push @ignore_list, qr/^check_table_result: /;
   push @ignore_list, qr/^mail_addr_find: /;
   push @ignore_list, qr/^mail_addr_map: /;
   push @ignore_list, qr/^mail_flow_put: /;
   push @ignore_list, qr/^smtp_addr_one: /;
   push @ignore_list, qr/^smtp_connect_addr: /;
   push @ignore_list, qr/^smtp_connect_unix: trying: /;
   push @ignore_list, qr/^smtp_find_self: /;
   push @ignore_list, qr/^smtp_get: /;
   push @ignore_list, qr/^smtp_fputs: /;
   push @ignore_list, qr/^smtp_parse_destination: /;
   push @ignore_list, qr/^smtp_sasl_passwd_lookup: /;
   push @ignore_list, qr/^smtpd_check_/;
   push @ignore_list, qr/^smtpd_chat_notify: /;
   push @ignore_list, qr/^been_here: /;
   push @ignore_list, qr/^set_eugid: /;
   push @ignore_list, qr/^deliver_/;
   push @ignore_list, qr/^flush_send_file: queue_id/;
   push @ignore_list, qr/^milter_macro_lookup/;
   push @ignore_list, qr/^milter8/;
   push @ignore_list, qr/^skipping non-protocol event/;
   push @ignore_list, qr/^reply: /;
   push @ignore_list, qr/^event: /;
   push @ignore_list, qr/^trying... /;
   push @ignore_list, qr/ all milters$/;
   push @ignore_list, qr/^vstream_/;
   push @ignore_list, qr/^server features/;
   push @ignore_list, qr/^skipping event/;
   push @ignore_list, qr/^Using /;
   push @ignore_list, qr/^rec_(?:put|get): /;
   push @ignore_list, qr/^subject=/;
   push @ignore_list, qr/^issuer=/;
   push @ignore_list, qr/^pref  /;  # yes, multiple spaces
   push @ignore_list, qr/^request: \d/;
   push @ignore_list, qr/^done incoming queue scan$/;
   push @ignore_list, qr/^qmgr_/;
   push @ignore_list, qr/^trigger_server_accept_fifo: /;
   push @ignore_list, qr/^proxymap stream/;
   push @ignore_list, qr/^(?:start|end) sorted recipient list$/;
   push @ignore_list, qr/^connecting to \S+ port /;
   push @ignore_list, qr/^Write \d+ chars/;
   push @ignore_list, qr/^Read \d+ chars/;
   push @ignore_list, qr/^(?:lookup|delete) smtp session/;
   push @ignore_list, qr/^delete smtp session/;
   push @ignore_list, qr/^(?:reloaded|remove|looking for) session .* cache$/;
   push @ignore_list, qr/^(?:begin|end) \S+ address list$/;
   push @ignore_list, qr/^mapping DSN status/;
   push @ignore_list, qr/^record [A-Z]/;
   push @ignore_list, qr/^dir_/;
   push @ignore_list, qr/^transport_event/;
   push @ignore_list, qr/^read [A-Z](?: |$)/;
   push @ignore_list, qr/^relay: /;
   push @ignore_list, qr/^why: /;
   push @ignore_list, qr/^fp: /;
   push @ignore_list, qr/^path: /;
   push @ignore_list, qr/^level: /;
   push @ignore_list, qr/^recipient: /;
   push @ignore_list, qr/^delivered: /;
   push @ignore_list, qr/^queue_id: /;
   push @ignore_list, qr/^queue_name: /;
   push @ignore_list, qr/^user: /;
   push @ignore_list, qr/^sender: /;
   push @ignore_list, qr/^offset: /;
   push @ignore_list, qr/^offset: /;
   push @ignore_list, qr/^verify stream disconnect/;
   push @ignore_list, qr/^event_request_timer: /;
   push @ignore_list, qr/^smtp_sasl_authenticate: /;
   push @ignore_list, qr/^flush_add: /;
   push @ignore_list, qr/^disposing SASL state information/;
   push @ignore_list, qr/^starting new SASL client/;
   push @ignore_list, qr/^error: dict_ldap_connect: /;
   push @ignore_list, qr/^error: to submit mail, use the Postfix sendmail command/;
   push @ignore_list, qr/^local_deliver[:[]/;
   push @ignore_list, qr/^_sasl_plugin_load /;
   push @ignore_list, qr/^exp_type: /;
   push @ignore_list, qr/^wakeup [\dA-Z]/;
   push @ignore_list, qr/^defer (?:site|transport) /;
   push @ignore_list, qr/^local: /;
   push @ignore_list, qr/^exp_from: /;
   push @ignore_list, qr/^extension: /;
   push @ignore_list, qr/^owner: /;
   push @ignore_list, qr/^unmatched: /;
   push @ignore_list, qr/^domain: /;
   push @ignore_list, qr/^initializing the client-side TLS engine/;
   push @ignore_list, qr/^header_token: /;
   push @ignore_list, qr/^(?:PUSH|POP) boundary/;
   push @ignore_list, qr/^recipient limit \d+$/;
   push @ignore_list, qr/^scan_dir_next: found/;
   push @ignore_list, qr/^open (?:btree|incoming)/;
   push @ignore_list, qr/^Renamed to match inode number/;
   push @ignore_list, qr/^cleanup_[^:]+:/;
   push @ignore_list, qr/^(?:before|after) input_transp_cleanup: /;
   push @ignore_list, qr/^event_enable_read: /;
   push @ignore_list, qr/^report recipient to all milters /;
   push @ignore_list, qr/_action = defer_if_permit$/;
   push @ignore_list, qr/^reject_invalid_hostname: /;
   push @ignore_list, qr/^cfg_get_/;
   push @ignore_list, qr/^sacl_check: /;

   # non-anchored
   #push @ignore_list, qr/: Greylisted for /;
   push @ignore_list, qr/certificate verification (?:depth|failed for)/;
   push @ignore_list, qr/re-using session with untrusted certificate, look for details earlier in the log$/;
   push @ignore_list, qr/socket: wanted attribute: /;
   push @ignore_list, qr/ smtpd cache$/;
   push @ignore_list, qr/ old session$/;
   push @ignore_list, qr/fingerprint=/;
   push @ignore_list, qr/TLS cipher list "/;
}

# Evaluates a given line against the list of ignore patterns.
#
sub in_ignore_list($) {
   my $line = shift;

   foreach (@ignore_list) {
      #return 1 if $line =~ /$_/;
      if ($line =~ /$_/) {
         #$IGNORED{$_}++;
         return 1;
      }
   }

   return 0;
}

# Accepts common fields from a standard delivery attempt, processing then
# and returning modified values
#
sub process_delivery_attempt ($ $ $ $) {
   my ($to,$origto,$DDD,$reason) = @_;

   $reason =~ s/\((.*)\)/$1/;   # Makes capturing nested parens easier
   # leave $to/$origto undefined, or strip < > chars if not null address (<>).
   defined $to     and $to =     ($to eq '')     ? '<>' : lc $to;
   defined $origto and $origto = ($origto eq '') ? '<>' : lc $origto;
   my ($localpart, $domainpart) = split ('@', $to);
   ($localpart, $domainpart) = ($to, '*unspecified')   if ($domainpart eq '');
   my ($dsn);

   # If recipient_delimiter is set, break localpart into user + extension
   # and save localpart in origto if origto is empty
   #
   if ($Opts{'recipient_delimiter'} and $localpart =~ /\Q$Opts{'recipient_delimiter'}\E/o) {

      # special cases: never split mailer-daemon or double-bounce
      # or owner- or -request if delim is "-" (dash).
      unless ($localpart =~ /^(?:mailer-daemon|double-bounce)$/i or
          ($Opts{'recipient_delimiter'} eq '-' and $localpart =~ /^owner-.|.-request$/i)) {
         my ($user,$extension) = split (/\Q$Opts{'recipient_delimiter'}\E/, $localpart, 2);
         $origto = $localpart    if ($origto eq '');
         $localpart = $user;
      }
   }

   unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) {
      $dsn = '';
   }

   if ($Collecting{'delays'} and $DDD =~ m{delay=([\d.]+)(?:, delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+))?}) {
      # Message delivery time stamps
      # delays=a/b/c/d, where
      #   a = time before queue manager, including message transmission
      #   b = time in queue manager
      #   c = connection setup including DNS, HELO and TLS;
      #   d = message transmission time.
      if (defined $2) {
         $Delays{'1: Before qmgr'}{$2}++;
         $Delays{'2: In qmgr'}{$3}++;
         $Delays{'3: Conn setup'}{$4}++;
         $Delays{'4: Transmission'}{$5}++;
      }
      $Delays{'5: Total'}{$1}++;
   }

   return ($to,$origto,$localpart,$domainpart,$dsn,$reason);
}

# Processes postfix/bounce messages
# 
sub postfix_bounce($) {
   my $line = shift;
   my $type;

   $line =~ s/^(?:$re_QID): //o;
   if ($line =~ /^(sender|postmaster) non-delivery notification/o) {
      #TDbQ postmaster non-delivery notification: 7446BCD68
      #TDbQ sender non-delivery notification: 7446BCD68
      $type = 'Non-delivery';
   }
   elsif ($line =~ /^(sender|postmaster) delivery status notification/o ) {
      #TDbQ sender delivery status notification: 7446BCD68
      $type = 'Delivery';
   }
   elsif ($line =~ /^(sender|postmaster) delay notification: /o) {
      #TDbQ sender delay notification: AA61EC2F9A
      $type = 'Delayed';
   }
   else {
      inc_unmatched('bounce')   if ! in_ignore_list($line);
      return;
   }

   $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'});
   $Counts{'notificationsent'}{$type}{$1}++;
}

# Processes postfix/cleanup messages
#   cleanup always has a QID
# 
sub postfix_cleanup($) {
   my $line = shift;
   my ($qid,$reply,$fmthost,$reject_name);

   ($qid, $line) = ($1, $2)  if ($line =~ /^($re_QID): (.*)$/o );

   #TDcQ message-id=<C1BEA2A0.188572%from@example.com>
   return if ($line =~ /^message-id=/);

   # milter-reject, milter-hold, milter-discard
   if ($line =~ s/^milter-//) {
      milter_common($line);
      return;
   }

   ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps)
   # Note: Bounce
   #   See same code elsewhere "Note: Bounce" 
   #TDcQ to=<envto@example.com>,                  relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text...
   #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...
   if ($line =~ /^to=<(.*?)>,(?: orig_to=<(.*?)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o) {
      # ($to,$origto,$relay,$DDD,$status,$reason) = ($1,$2,$3,$4,$5,$6);
      if ($5 ne 'bounced' and $5 ne 'SOFTBOUNCE') {
         inc_unmatched('cleanupbounce');
         return;
      }

      my ($to,$origto,$relay,$DDD,$reason) = ($1,$2,$3,$4,$6);
      my ($localpart,$domainpart,$dsn);
      ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$DDD,$reason);

      ### local bounce
      # XXX local v. remote bounce seems iffy, relative
      if ($relay =~ /^(?:none|local|virtual|maildrop|127\.0\.0\.1|avcheck)/) {
         $Totals{'bouncelocal'}++; return unless ($Collecting{'bouncelocal'});
         $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++;
      }
      ### remote bounce
      else {
         ($reply,$fmthost) = cleanhostreply($reason,$relay,$to ne '' ? $to : '<>',$domainpart);
         $Totals{'bounceremote'}++; return unless ($Collecting{'bounceremote'});
         $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++;
      }
   }

   # *header_checks and body_checks
   elsif (header_body_checks($line)) {
      #print "cleanup: header_body_checks\n";
      return;
   }

   #TDcQ resent-message-id=4739073.1
   #TDcQ resent-message-id=<ARF+DXZwLECdxm@mail.example.com>
   #TDcQ resent-message-id=<B19-DVD42188E0example.com>?    <120B11@samplepc>
   elsif ( ($line =~ /^resent-message-id=<?.+>?$/o  )) {
      $Totals{'resent'}++;
   }

   #TDcN unable to dlopen .../sasl2/libplain.so.2: .../sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted
   elsif ($line =~ /^unable to dlopen /) {
      # strip extraneous doubling of library path
      $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/);
      postfix_warning($line);
   }

   else {
      inc_unmatched('cleanup(last)')   if ! in_ignore_list($line);
   }
}

=pod
 header_body_checks

  Handle cleanup's header_checks and body_checks, and smtp's smtp_body_checks/smtp_*header_checks

  Possible actions that log are:

     REJECT optional text...
     DISCARD optional text...
     FILTER transport:destination
     HOLD optional text...
     REDIRECT user@domain
     PREPEND text...
     REPLACE text...
     WARN optional text...

     DUNNO and IGNORE are not logged

Returns:
   1: if line matched or handled
   0: otherwise
=cut

sub header_body_checks($)
{
   my $line = shift;

   # bcc, discard, filter, hold, prepend, redirect, reject, replace, warning
   return 0 if ($line !~ /^[bdfhprw]/) or   # short circuit alternation when no match possible
               ($line !~ /^(re(?:ject|direct|place)|filter|hold|discard|prepend|warning|bcc): (header|body|content) (.*)$/);

   my ($action,$part,$p3) = ($1,$2,$3);

   #print "header_body_checks: action: \"$action\", part: \"$part\", p3: \"$p3\"\n";

   my ($trigger,$host,$eto,$p4,$fmthost,$reject_name);
   # $re_QID: reject: body ...
   # $re_QID: reject: header ...
   # $re_QID: reject: content ...


   if ($p3 =~ /^(.*) from ([^;]+); from=<.*?>(?: to=<(.*?)>)?(?: proto=\S*)?(?: helo=<.*?>)?(?:: (.*)|$)/) {
      ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4);

      #    $action   $part  $trigger                                 $host                                              $eto                                                $p4
      #TDcQ reject:   body   Subject: Cheap cialis               from local;                    from=<root@localhost>:                                                       optional text...
      #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...
      #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...
      # message_reject_characters (postfix >= 2.3)
      #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 

      #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
      #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...
      #TDcQ hold:     header Subject: Hold Test                  from local;                    from=<efrom@example.com> to=<eto@sample.net>:                                optional text...
      #TDcQ hold:     header Received: by example.com...from x   from local;                    from=<efrom@example.com>
      #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>
      #      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
      #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
      #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
      #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
      #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>
      #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...
      #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...
      #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...
      # BCC action (2.6 experimental branch)
      #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

      # Note: reject_warning does not seem to occur
   }

   else {
      # smtp_body_checks, smtp_header_checks, smtp_mime_header_checks, smtp_nested_header_checks (postfix >= 2.5)
      #TDsQ replace:  header Sender:   <from@example.com>                                                                                                                  : Sender:   <fm2@sample.net> 

      $trigger = $p3; $host = ''; $eto = ''; $p4 = $part eq 'body' ? 'smtp_body_checks' : 'smtp_*header_checks';

      #inc_unmatched('header_body_checks');
      #return 1;
   }

   #print "   trigger: \"$trigger\", host: \"$host\", eto: \"$eto\", p4: \"$p4\"\n";
   $trigger =~ s/\s+/ /g;
   $trigger = '*unknown reason'    if ($trigger eq '');
   $eto     = '*unknown'           if ($eto     eq '');

   my ($trig,$trig_opt,$text);
   if    ($part eq 'header')               { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; }
   elsif ($part eq 'body')                 { $trig = "Body check"; }
   else                                    { $trig = "Content check"; }  # message_reject_characters (postfix >= 2.3)

   if ($p4 eq '')                          { $text = '*generic'; $trig_opt = $trig; }
   else                                    { $text = $p4;        $trig_opt = "$trig ($p4)"; }

   if    ($host eq 'local')                { $fmthost = formathost('127.0.0.1', 'local'); }
   elsif ($host =~ /([^[]+)\[([^]]+)\]/)   { $fmthost = formathost($2,$1); }
   else                                    { $fmthost = '*unknown'; }

   # Note: Counts
   #   Ensure each $Counts{key} accumulator is consistently
   #   used with the same number of hash key levels throughout the code.
   #   For example, $Counts{'hold'} below has 4 keys; ensure that every
   #   other usage of $Counts{'hold'} also has 4 keys.  Currently, it is
   #   OK to set the last key as '', but only the last.

   if ($action eq 'reject') {
      $Counts{'byiprejects'}{$fmthost}++                                if $Collecting{'byiprejects'};

      # Note: no temporary or reject_warning
      # Note: no reply code - force into a 5xx reject
      # XXX this won't be seen if the user has no 5.. entry in reject_reply_patterns
      $Totals{$reject_name = "5xxreject$part" }++;
      $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++          if $Collecting{$reject_name};
   }
   elsif ( $action eq 'filter' ) {
      $Totals{'filtered'}++;
      $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++     if $Collecting{'filtered'};
   }
   elsif ( $action eq 'hold' ) {
      $Totals{'hold'}++;
      $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++            if $Collecting{'hold'};
   }
   elsif ( $action eq 'redirect' ) {
      $Totals{'redirected'}++;
      $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++   if $Collecting{'redirected'};
   }
   elsif ( $action eq 'discard' ) {
      $Totals{'discarded'}++;
      $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++           if $Collecting{'discarded'};
   }
   elsif ( $action eq 'prepend' ) {
      $Totals{'prepended'}++;
      $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++ if $Collecting{'prepended'};
   }
   elsif ( $action eq 'replace' ) {
      $Totals{'replaced'}++;
      $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++  if $Collecting{'replaced'};
   }
   elsif ( $action eq 'warning' ) {
      $Totals{'warned'}++;
      $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++              if $Collecting{'warned'};
   }
   elsif ( $action eq 'bcc' ) {
      $Totals{'bcced'}++;
      $Counts{'bcced'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++        if $Collecting{'bcced'};
   }
   else {
      inc_unmatched('header_body_checks unexpected action');
   }

   return 1;
}


# Handle common milter actions:
#    milter-reject, milter-hold, milter-discard
# which are created by both smtpd and cleanup
#
sub milter_common($) {
   my $line = shift;

   #TDsdN milter-reject: MAIL           from milterS.example.com[10.0.0.1]: 553 5.1.7 address incomplete;                                                                          proto=ESMTP helo=<example.com>
   #TDsdN milter-reject: CONNECT        from milterS.example.com[10.0.0.2]: 451 4.7.1 Service unavailable - try again later; proto=SMTP
   #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>
   #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>

   #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>
   #TDcQ milter-reject:  CONNECT        from milterC.example.com[10.0.0.2]: 5.7.1 Some problem;                                                                                    proto=SMTP
   #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>
   #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> 
#   84B82AC8B3: milter-reject: END-OF-MESSAGE from localhost[127.0.0.1]: 5.7.1 Blocked

   my ($efrom,$eto,$proto,$helo) = strip_ftph($line);
   #print "efrom: '$efrom', eto: '$eto', proto: '$proto', helo: '$helo'\n";
   $line =~ s/;$//;

   if ($line =~ /^(reject|hold|discard): (\S+) from ([^[]+)\[([^]]+)\](?::\d+)?: (.*)$/) {

      my ($action,$stage,$host,$hostip,$reply) = ($1,$2,$3,$4,$5);
      #print "action: '$action', stage: '$stage', host: '$host', hostip: '$hostip', reply: '$reply'\n";

      if ($action eq 'reject') {
         my ($dsn,$fmthost,$reject_name);
         ($dsn,$reply) = ($1,$2)    if $reply =~ /^($re_DSN) (.*)$/o;
         #print "   dsn: '$dsn', reply: '$reply'\n";

         if ($Collecting{'byiprejects'} and substr($dsn,0,1) eq '5') {
            $fmthost = formathost($hostip,$host);
            $Counts{'byiprejects'}{$fmthost}++;
         }
         # Note: reject_warning does not seem to occur
         # Note: See rejectmilter elsewhere
         $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; return unless ($Collecting{$reject_name});
         $Counts{$reject_name}{$stage}{$fmthost ? $fmthost : formathost($hostip,$host)}{$reply}++;
      }
      # milter-hold
      elsif ($action eq 'hold') {
         $Totals{'hold'}++; return unless ($Collecting{'hold'});
         $Counts{'hold'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
      }
      # milter-discard
      else { # $action eq 'discard'
         $Totals{'discarded'}++; return unless ($Collecting{'discarded'});
         $Counts{'discarded'}{'milter'}{$stage}{formathost($hostip,$host)}{$eto}++;
      }

   }
   else {
      inc_unmatched('milter_common)');
   }
}

sub postfix_dnsblog {
   my $line = shift;

   #postfix/dnsblog[16943]: addr 192.168.0.1 listed by domain bl.spamcop.net as 127.0.0.2
   #postfix/dnsblog[78598]: addr 192.168.0.1 blocked by domain zen.spamhaus.org as 127.0.0.11
   if ($line =~ /^addr (\S+) (?:listed|blocked) by domain (\S+) as (\S+)$/) {
      $Counts{'dnsblog'}{$2}{$1}{$3}++  if $Collecting{'dnsblog'};
   }
   else {
      inc_unmatched('dnsblog')   if ! in_ignore_list($line);
      return;
   }
}

sub postfix_postscreen {
   my $line = shift;

   return if (
      $line =~ /^cache / or
      $line =~ /discarding EHLO keywords: / or
      $line =~ /: discard_mask / or
      $line =~ /: sq=\d+ cq=\d+ event/ or
      $line =~ /: replacing command "/
   );


   if (($line =~ /^(PREGREET) \d+ (?:after \S+)? from \[([^]]+)\](?::\d+)?/) or
      # PREGREET 20 after 0.31 from [192.168.0.1]:12345: HELO 10.0.0.1??
      # HANGUP after 0.7 from [192.168.0.4]:12345
       ($line =~ /^(HANGUP) (?:after \S+)? from \[([^]]+)\](?::\d+)?/)) {
      $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
   }
   elsif ($line =~ /^(WHITELISTED|BLACKLISTED|PASS \S+) \[([^]]+)\](?::\d+)?$/) {
      # PASS NEW [192.168.0.2]:12345
      # PASS OLD [192.168.0.3]:12345
      $Counts{'postscreen'}{lc $1}{$2}{$END_KEY}++  if $Collecting{'postscreen'};
   }
   elsif ($line =~ /^DNSBL rank (\S+) for \[([^]]+)\](?::\d+)?$/) {
      $Counts{'postscreen'}{'dnsbl'}{$2}{$1}++      if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^(CONNECT|COMMAND (?:(?:TIME|COUNT|LENGTH) LIMIT|PIPELINING)|NON-SMTP COMMAND|BARE NEWLINE) from \[([^\]]+)\]:\d+/) {
      # CONNECT from [192.168.1.1]:12345
      $Counts{'postscreen'}{lc($1)}{$2}{$END_KEY}++		if $Collecting{'postscreen'};
   }
   elsif ($line =~ /^DISCONNECT \[([^\]]+)\]:\d+$/) {
      # DISCONNECT [192.168.1.1]:12345
      $Counts{'postscreen'}{'disconnect'}{$1}{$END_KEY}++	if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^NOQUEUE: reject: RCPT from \[([^]]+)\](?::\d+)?: ($re_DSN) ([^;]+)/o) {
      #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>
      my ($ip,$dsn,$msg) = ($1,$2,$3);

      if ($dsn =~ /^([54])/) {
         $Counts{'postscreen'}{$1 . 'xx reject'}{"$dsn $msg"}{$ip}++      if $Collecting{'postscreen'};
      }
      else {
         $Counts{'postscreen'}{'reject'}{"$dsn $msg"}{$ip}{$END_KEY}++      if $Collecting{'postscreen'};
      }
   }

   elsif ($line =~ /^NOQUEUE: reject: CONNECT from \[([^]]+)\](?::\d+)?: too many connections/) {
      # NOQUEUE: reject: CONNECT from [192.168.0.1]:7197: too many connections
      $Counts{'postscreen'}{'reject'}{'Too many connections'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^reject: connect from \[([^]]+)\](?::\d+)?: (.+)$/) {
      # reject: connect from [192.168.0.1]:21225: all screening ports busy
      $Counts{'postscreen'}{'reject'}{"\u$2"}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^(?:WHITELIST VETO) \[([^]]+)\](?::\d+)?$/) {
      # WHITELIST VETO [192.168.0.8]:43579
      $Counts{'postscreen'}{'whitelist veto'}{$1}{$END_KEY}++	if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^(entering|leaving) STRESS mode with (\d+) connections$/) {
      # entering STRESS mode with 90 connections
      $Counts{'postscreen'}{'stress mode: ' . $1}{$2}{$END_KEY}++      if $Collecting{'postscreen'};
   }

   elsif ($line =~ /^close database (\S+): No such file or directory/) {
      # close database /var/lib/postfix/postscreen_cache.db: No such file or directory (possible Berkeley DB bug)
      $Counts{'postscreen'}{'close database'}{$1}{$END_KEY}++      if $Collecting{'postscreen'};
   }

   else {
      inc_unmatched('postscreen')   if ! in_ignore_list($line);
      return;
   }

   $Totals{'postscreen'}++;
}


# Handles postfix/postsuper lines
#
sub postfix_postsuper($) {
   my $line = shift;

   return if $line =~ /^Deleted: \d+ messages?$/;

   if ($line =~ /^Placed on hold: (\d+) messages?$/o) {
      #TDps Placed on hold: 2 messages
      # Note: See Hold elsewhere
      $Totals{'hold'} += $1; return unless ($Collecting{'hold'});
      $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1;
   }
   elsif ($line =~ /^Released from hold: (\d+) messages?$/o) {
      #TDps Released from hold: 1 message
      $Totals{'releasedfromhold'} += $1;
   }
   elsif ($line =~ /^Requeued: (\d+) messages?$/o) {
      #TDps Requeued: 1 message
      $Totals{'requeued'} += $1;
   }
   elsif (my($qid,$p2) = ($line =~ /($re_QID): (.*)$/)) {
      # postsuper double reports the following 3 lines
      return if ($p2 eq 'released from hold');
      return if ($p2 eq 'placed on hold');
      return if ($p2 eq 'requeued');

      if ($p2 =~ /^removed\s*$/o) {
         # Note: See REMOVED elsewhere
         # 52CBDC2E0F: removed
         delete $SizeByQid{$qid}   if (exists $SizeByQid{$qid});
         $Totals{'removedfromqueue'}++;
      }
      elsif (! in_ignore_list ($p2)) {
         inc_unmatched('postsuper2');
      }
   }
   elsif (! in_ignore_list ($line)) {
      inc_unmatched('postsuper1');
   }
}

# Handles postfix panic: lines
#
sub postfix_panic($) {
   #TD panic: myfree: corrupt or unallocated memory block
   $Totals{'panicerror'}++; return unless ($Collecting{'panicerror'});
   $Counts{'panicerror'}{ucfirst($1)}++;
}

# Handles postfix fatal: lines
#
sub postfix_fatal($) {
   my ($reason) = shift;

   if ($reason =~ /^\S*\(\d+\): Message file too big$/o) {
      #TD fatal: root(0): Message file too big
      $Totals{'fatalfiletoobig'}++;


   # XXX its not clear this is at all useful - consider falling through to last case
   } elsif ( $reason =~ /^config variable (\S*): (.*)$/o ) {
      #TD fatal: config variable inet_interfaces: host not found: 10.0.0.1:2525
      #TD fatal: config variable inet_interfaces: host not found: all:2525
      $Totals{'fatalconfigerror'}++; return unless ($Collecting{'fatalconfigerror'});
      $Counts{'fatalconfigerror'}{ucfirst($reason)}++;
   }
   else {
      #TD fatal: watchdog timeout
      #TD fatal: bad boolean configuration: smtpd_use_tls =

      #TDvN fatal: update queue file active/4B709F060E: File too large
      $reason =~ s/(^update queue file \w+\/)\w+:/$1*:/;

      $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'});
      $Counts{'fatalerror'}{ucfirst($reason)}++;
   }
}
# Handles postfix fatal: lines
#
sub postfix_error($) {
   my ($reason) = shift;
   # postfix/postfix-script[4271]: error: unknown command: 'rel'

   $Totals{'error'}++; return unless ($Collecting{'fatalerror'});
   $Counts{'error'}{ucfirst($reason)}++;
}

# Handles postfix warning: lines
# and additional lines coerced into warnings
#
sub postfix_warning($) {
   my ($warning) = shift;

   # Skip these
   return if ($warning =~ /$re_QID: skipping further client input$/o);
   return if ($warning =~ /^Mail system is down -- accessing queue directly$/o);
   return if ($warning =~ /^SASL authentication failure: (?:Password verification failed|no secret in database)$/o);
   return if ($warning =~ /^no MX host for .* has a valid A record$/o);
   return if ($warning =~ /^uid=\d+: Broken pipe$/o);

   #TD warning: connect to 127.0.0.1:12525: Connection refused
   #TD warning: problem talking to server 127.0.0.1:12525: Connection refused
   #TD warning: valid_ipv4_hostaddr: invalid octet count:

   my ($domain,$to,$type,$site,$helo,$cmd);
   my ($addr,$size,$hostip,$host,$port,$reason,$qid,$queue,$reason2,$process,$status,$service);

   if (($hostip,$host,$reason) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): hostname ([^ ]+) verification failed: (.*)$/) or
       ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?([^:]+): (address not listed for hostname) (.*)$/) or
       ($host,$reason,$hostip,$reason2) = ($warning =~ /^(?:smtpd_peer_init: )?hostname (\S+) (does not resolve to address) ([\d.]+)(: host not found, try again)?$/)) {
      #TD warning: 10.0.0.1: hostname sample.com verification failed: Host not found
      #TD warning: smtpd_peer_init: 192.168.0.1: hostname example.com verification failed: Name or service not known
      #TD warning: 192.168.0.1: address not listed for hostname sample.net
      # post 2.8
      #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1: host not found, try again
      #TD warning: hostname 281.example.net does not resolve to address 192.168.0.1

      $reason .= $reason2 if $reason2;
      $Totals{'hostnameverification'}++; return unless ($Collecting{'hostnameverification'});
      $Counts{'hostnameverification'}{ucfirst($reason)}{formathost($hostip,$host)}++;

   } elsif (($warning =~ /^$re_QID: queue file size limit exceeded$/o) or
            ($warning =~ /^uid=\d+: File too large$/o)) {
      $Totals{'warnfiletoobig'}++;

   } elsif ($warning =~ /^database (?:[^ ]*) is older than source file ([\w\/]+)$/o) {
      #TD warning: database /etc/postfix/client_checks.db is older than source file /etc/postfix/client_checks
      $Totals{'databasegeneration'}++; return unless ($Collecting{'databasegeneration'});
      $Counts{'databasegeneration'}{$1}++;

   } elsif (($reason,$qid,$reason2) = ($warning =~ /^(open active) ($re_QID): (.*)$/o) or
            ($reason,$qid,$reason2) = ($warning =~ /^qmgr_active_corrupt: (save corrupt file queue active) id ($re_QID): (.*)$/o) or
            ($qid,$reason,$reason2) = ($warning =~ /^($re_QID): (write queue file): (.*)$/o)) {

      #TD warning: open active BDB9B1309F7: No such file or directory
      #TD warning: qmgr_active_corrupt: save corrupt file queue active id 4F4272F342: No such file or directory
      #TD warning: E669DE52: write queue file: No such file or directory

      $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
      $Counts{'queuewriteerror'}{"$reason: $reason2"}{$qid}++;

   } elsif (($qid,$reason) = ($warning =~ /^qmgr_active_done_3_generic: remove ($re_QID) from active: (.*)$/o)) {
      #TD warning: qmgr_active_done_3_generic: remove AF0F223FC05 from active: No such file or directory
      $Totals{'queuewriteerror'}++; return unless ($Collecting{'queuewriteerror'});
      $Counts{'queuewriteerror'}{"remove from active: $reason"}{$qid}++;

   } elsif (($queue,$qid) = ($warning =~ /^([^\/]*)\/($re_QID): Error writing message file$/o )) {
      #TD warning: maildrop/C9E66ADF: Error writing message file
      $Totals{'messagewriteerror'}++; return unless ($Collecting{'messagewriteerror'});
      $Counts{'messagewriteerror'}{$queue}{$qid}++;

   } elsif (($process,$status) = ($warning =~ /^process ([^ ]*) pid \d+ exit status (\d+)$/o)) {
      #TD warning: process /usr/lib/postfix/smtp pid 9724 exit status 1
      $Totals{'processexit'}++; return unless ($Collecting{'processexit'});
      $Counts{'processexit'}{"Exit status $status"}{$process}++;

   } elsif ($warning =~ /^mailer loop: (.*)$/o) {
      #TD warning: mailer loop: best MX host for example.com is local
      $Totals{'mailerloop'}++; return unless ($Collecting{'mailerloop'});
      $Counts{'mailerloop'}{$1}++;

   } elsif ($warning =~ /^no (\S+) host for (\S+) has a valid address record$/) {
      #TDs warning: no MX host for example.com has a valid address record
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
      $Counts{'dnserror'}{"No $1 host has a valid address record"}{$2}{$END_KEY}++;

   } elsif ($warning =~ /^(Unable to look up \S+ host) (.+)$/) {
      #TDsd warning: Unable to look up MX host for example.com: Host not found
      #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known
      #TDsd warning: Unable to look up NS host ns1.example.logal for Sender address bounce@example.local: No address associated with hostname
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});

      my ($problem,$target,$reason) = ($1, split(/: /,$2));
      $reason =~ s/, try again//;

      if ($target =~ /^for (\S+)$/) {
         $Counts{'dnserror'}{$problem}{ucfirst($reason)}{$1}{$END_KEY}++;
      }
      elsif ($target =~ /^(\S+)( for \S+ address) (\S+)$/) {
         $Counts{'dnserror'}{$problem . lc($2)}{ucfirst($reason)}{$1}{$3}++;
      }

   } elsif ($warning =~ /^((?:malformed|numeric) domain name in .+? of \S+ record) for (.*):(.*)?$/) {
      my ($problem,$domain,$reason) = ($1,$2,$3);
      #TDsd warning: malformed domain name in resource data of MX record for example.com:
      #TDsd warning: malformed domain name in resource data of MX record for example.com: mail.example.com\\032
      #TDsd warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1
      $Totals{'dnserror'}++; return unless ($Collecting{'dnserror'});
      $Counts{'dnserror'}{ucfirst($problem)}{$domain}{$reason eq '' ? '*unknown' : $reason}{$END_KEY}++;

   } elsif ($warning =~ /^numeric hostname: ([\S]+)$/) {
      #TD warning: numeric hostname: 192.168.0.1
      $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'});
      $Counts{'numerichostname'}{$1}++;

   } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/)  or
             ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[([^]]+)\](?::(\d+))?: (.*)$/) or
             ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[([^]]+)\](?::(\d+))?:(?: (.*))?$/o)) {
      # ancient
      #TDsd warning: example.com[192.168.0.1] sent message header instead of SMTP command: From: "Someone" <40245426501example.com>
      # current
      #TDsd warning: non-SMTP command from sample.net[10.0.0.1]: Received: from 192.168.0.1 (HELO bogus.sample.com)
      #TDs warning: 6B01A8DEF: non-ESMTP response from mail.example.com[192.168.0.1]:25: 

      $Totals{'smtpconversationerror'}++; return unless ($Collecting{'smtpconversationerror'});
      $host .= ' :' . $port   if ($port and $port ne '25');
      $Counts{'smtpconversationerror'}{ucfirst($type)}{formathost($hostip,$host)}{$reason}++;

   } elsif ($warning =~ /^valid_hostname: (.*)$/o) {
      #TD warning: valid_hostname: empty hostname
      $Totals{'hostnamevalidationerror'}++; return unless ($Collecting{'hostnamevalidationerror'});
      $Counts{'hostnamevalidationerror'}{$1}++;

   } elsif (($host,$hostip,$type,$reason) = ($warning =~ /^([^[]+)\[([^]]+)\](?::\d+)?: SASL (.*) authentication failed(.*)$/)) {
      #TDsd warning: unknown[10.0.0.1]: SASL LOGIN authentication failed: bad protocol / cancel
      #TDsd warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed
      # see saslauthfail elsewhere
      $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'});
      if ($reason) { $reason = $type . $reason; }
      else         { $reason = $type; }
      $Counts{'saslauthfail'}{$reason}{formathost($hostip,$host)}++;

   } elsif (($host,$reason) = ($warning =~ /^(\S+): RBL lookup error:.* Name service error for (?:name=)?\1(?: type=[^:]+)?: (.*)$/o)) {
      #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

      #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
      $Totals{'rblerror'}++; return unless ($Collecting{'rblerror'});
      $Counts{'rblerror'}{$reason}{$host}++;

   } elsif (
         ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/ ) or
         ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[([^]]+)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/ )) {
      #TDs warning: host example.com[192.168.0.1] greeted me with my own hostname example.com
      #TDs warning: host example.com[192.168.0.1] replied to HELO/EHLO with my own hostname example.com
      $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
      $Counts{'heloerror'}{ucfirst($reason)}{formathost($hostip,$host)}++;

   } elsif (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[([^]]+)\](?::\d+)?$/ )) {
      #TD warning: bad size limit "-679215104" in EHLO reply from example.com[192.168.0.1]
      $Totals{'heloerror'}++; return unless ($Collecting{'heloerror'});
      $Counts{'heloerror'}{"Bad size limit in EHLO reply"}{formathost($hostip,$host)}{"$size"}++;

   } elsif ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[([^]]+)\](?::\d+)? in ([^ ]*) command: (.*)/ )) {
      #TD warning: Illegal address syntax from example.com[192.168.0.1] in MAIL command: user@sample.net
      $addr =~ s/[<>]//g   unless ($addr eq '<>');
      $Totals{'illegaladdrsyntax'}++; return unless ($Collecting{'illegaladdrsyntax'});
      $Counts{'illegaladdrsyntax'}{$cmd}{$addr}{formathost($hostip,$host)}++;

   } elsif ($warning =~ /^(timeout|premature end-of-input) on (.+) while reading (.*)$/o
         or $warning =~ /^(malformed (?:base64|numerical)|unexpected end-of-input) from (.+) while reading (.*)$/o) {

      #TDs warning: premature end-of-input on private/anvil while reading input attribute name
      #TDs warning: timeout on private/anvil while reading input attribute data
      #TDs warning: unexpected end-of-input from 127.0.0.1:10025 socket while reading input attribute name
      #TDs warning: malformed base64 data from %s while reading input attribute data: ...
      #TDs warning: malformed numerical data from %s while reading input attribute data: ...

      $Totals{'attrerror'}++; return unless ($Collecting{'attrerror'});
      $Counts{'attrerror'}{$2}{$1}{$3}++;

   } elsif ($warning =~ /^(.*): (bad command startup -- throttling)/o) {
      #TD warning: /usr/libexec/postfix/trivial-rewrite: bad command startup -- throttling
      $Totals{'startuperror'}++; return unless ($Collecting{'startuperror'});
      $Counts{'startuperror'}{ucfirst($2)}{$1}++;

   } elsif ($warning =~ /(problem talking to service [^:]*): (.*)$/o) {
      #TD warning: problem talking to service rewrite: Connection reset by peer
      #TD warning: problem talking to service rewrite: Success
      $Totals{'communicationerror'}++; return unless ($Collecting{'communicationerror'});
      $Counts{'communicationerror'}{ucfirst($1)}{$2}++;

   } elsif (my ($map,$key) = ($warning =~ /^$re_QID: ([^ ]*) map lookup problem for (.*)$/o)) {
      #TD warning: 6F74F74431: virtual_alias_maps map lookup problem for root@example.com
      $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
      $Counts{'mapproblem'}{$map}{$key}++;

   } elsif (($map,$reason) = ($warning =~ /^pcre map ([^,]+), (.*)$/o)) {
      #TD warning: pcre map /etc/postfix/body_checks, line 92: unknown regexp option "F": skipping this rule
      $Totals{'mapproblem'}++; return unless ($Collecting{'mapproblem'});
      $Counts{'mapproblem'}{$map}{$reason}++;

   } elsif (($reason) = ($warning =~ /dict_ldap_lookup: (.*)$/o)) {
      #TD warning: dict_ldap_lookup: Search error 80: Internal (implementation specific) error
      $Totals{'ldaperror'}++; return unless ($Collecting{'ldaperror'});
      $Counts{'ldaperror'}{$reason}++;

   } elsif (($type,$size,$host,$hostip,$service) = ($warning =~ /^(.+) limit exceeded: (\d+) from ([^[]+)\[([^]]+)\](?::\d+)? for service (.*)/ )) {
      #TDsd warning: Connection concurrency limit exceeded: 51 from example.com[192.168.0.1] for service smtp
      #TDsd warning: Connection rate limit exceeded: 20 from mail.example.com[192.168.0.1] for service smtp
      #TDsd warning: Connection rate limit exceeded: 30 from unknown[unknown] for service smtp
      #TDsd warning: Recipient address rate limit exceeded: 21 from example.com[10.0.0.1] for service smtp
      #TDsd warning: Message delivery request rate limit exceeded: 11 from example.com[10.0.0.1] for service smtp
      #TDsd warning: New TLS session rate limit exceeded: 49 from example.com[10.0.0.1] for service smtp
      $Totals{'anvil'}++; return unless ($Collecting{'anvil'});
      $Counts{'anvil'}{$service}{$type}{formathost($hostip,$host)}{$size}++;

   } elsif (my ($extname,$intname,$limit) = ($warning =~ /service "([^"]+)" \(([^)]+)\) has reached its process limit "([^"]+)":/o)) {
      #TD warning: service "smtp" (25) has reached its process limit "50": new clients may experience noticeable delays
      $Totals{'processlimit'}++; return unless ($Collecting{'processlimit'});
      $Counts{'processlimit'}{'See http://www.postfix.org/STRESS_README.html'}{"$extname ($intname)"}{$limit}++;

   } else {
      #TDsd warning: No server certs available. TLS won't be enabled
      #TDs warning: smtp_connect_addr: bind <localip>: Address already in use

      # These two messages follow ProcessLimit message above
      #TDm warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client
      #TDm warning: see http://www.postfix.org/STRESS_README.html for examples of stress-dependent configuration settings
      return if ($warning =~ /^to avoid this condition,/o);
      return if ($warning =~ /^see http:\/\/www\.postfix\.org\/STRESS_README.html/o);

      #TDsd warning: 009314BD9E: read timeout on cleanup socket
      $warning =~ s/^$re_QID: (read timeout on \S+ socket)/$1/;

      #TDsd warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11 
      #TDs warning: Read failed in network_biopair_interop with errno=0: num_read=0, want_read=11 
      $warning =~ s/^(Read failed in network_biopair_interop) with .*$/$1/;

=cut
      $warning =~ s/^(TLS library problem: )\d+:(error:.*)$/$1$2/;
      $warning =~ s/^(network_biopair_interop: error reading) \d+ bytes(.*)$/$1$2/;

1      TLS library problem: 10212:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
1      TLS library problem: 10217:error:1408A0C1:SSL routines:SSL3_GET_CLIENT_HELLO:no shared cipher...
1      network_biopair_interop: error reading 1102 bytes from the network: Connection reset by peer
1      network_biopair_interop: error reading 1120 bytes from the network: Connection reset by peer
=cut


      $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'});
      $Counts{'warningsother'}{$warning}++;
   }
}

# Handles postfix/postfix-script lines
#
sub postfix_script($) {
   my $line = shift;

   return if ($line =~ /^the Postfix mail system is running: PID: /o);

   if ($line =~ /^starting the Postfix mail system/o) {
      $Totals{'postfixstart'}++;
   }
   elsif ($line =~ /^stopping the Postfix mail system/o) {
      $Totals{'postfixstop'}++;
   }
   elsif ($line =~ /^refreshing the Postfix mail system/o) {
      $Totals{'postfixrefresh'}++;
   }
   elsif ($line =~ /^waiting for the Postfix mail system to terminate/o) {
      $Totals{'postfixwaiting'}++;
   }
   elsif (! in_ignore_list ($line)) {
      inc_unmatched('postfix_script');
   }
}

# Clean up a server's reply, to give some uniformity to reports
#
sub cleanhostreply($ $ $ $) {
   my ($hostreply,$relay,$recip,$domain) = @_;

   my $fmtdhost = '';
   my ($r1, $r2, $dsn, $msg, $host, $event);

   #print "RELAY: $relay, RECIP: $recip, DOMAIN: $domain\n";
   #print "HOSTREPLY: \"$hostreply\"\n";
   return ('Accepted', '*unknown')  if $hostreply =~ /^25\d/o;

   # Host or domain name not found. Name service error for name=example.com type=MX: Host not found...
   if ($hostreply =~ /^Host or domain name not found. Name service error for name=([^:]+): Host not found/o) {
      return ('Host not found', $1);
   }

   if (($host,$dsn,$r1) = ($hostreply =~ /host (\S+) said: ($re_DSN)[\- :]*"?(.*)"?$/o)) {
      # Strip recipient address from host's reply - we already have it in $recip.
      $r1 =~ s/[<(]?\Q$recip\E[>)]?\W*//ig;

      # Strip and capture "in reply to XYZ command" from host's reply
      if ($r1 =~ s/\s*[(]?(?:in reply to (.*) command)[)]?//o) {
         $r2 = ": $1";
      }
      $r1 =~ s/^Recipient address rejected: //o;
      # Canonicalize numerous forms of "recipient unknown"
      if (   $r1 =~ /^user unknown/i
          or $r1 =~ /^unknown user/i
          or $r1 =~ /^unknown recipient address/i
          or $r1 =~ /^invalid recipient/i
          or $r1 =~ /^recipient unknown/i
          or $r1 =~ /^sorry, no mailbox here by that name/i
          or $r1 =~ /^User is unknown/
          or $r1 =~ /^User not known/
          or $r1 =~ /^MAILBOX NOT FOUND/
          or $r1 =~ /^Recipient Rejected: No account by that name here/
          or $r1 =~ /^Recipient does not exist here/
          or $r1 =~ /The email account that you tried to reach does not exist./ # Google's long mess
          or $r1 =~ /(?:no such user|user unknown)/i
         )
      {
         #print "UNKNOWN RECIP: $r1\n";
         $r1 = 'Unknown recipient';
      }
      elsif ($r1 =~ /greylisted/oi) {
         #print "GREYLISTED RECIP: $r1\n";
         $r1 = 'Recipient greylisted';
      }
      elsif ($r1 =~ /^Message temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/o) {
         # Yahoo: 421 Message temporarily deferred - 4.16.51. Please refer to http://... (in reply to end of DATA command))
         $dsn = "$dsn $1"; $r1 = "see $2";
      }
      elsif ($r1 =~ /^Resources temporarily not available - Please try again later \[#(\d\.\d+\.\d+)\]\.$/o) {
         #Yahoo 451 Resources temporarily not available - Please try again later [#4.16.5]. 
         $dsn = "$dsn $1"; $r1 = "resources not available";
      }
      elsif ($r1 =~ /^Message temporarily deferred - (\[\d+\])/o) {
         # Yahoo: 451 Message temporarily deferred - [160] 
         $dsn = "$dsn $1"; $r1 = '';
      }
   }

   elsif ($hostreply =~ /^connect to (\S+): (.*)$/o) {
      #print "CONNECT: $hostreply\n";
      $host = $1; $r1 = $2; $r1 =~ s/server refused to talk to me/refused/;
   }

   elsif ($hostreply =~ /^host (\S+) refused to talk to me: (.*)$/o) {
      $host = $1; $msg = $2;
      #print "HOSTREFUSED: $hostreply\n";
      #Yahoo: '421 Message from (10.0.0.1) temporarily deferred - 4.16.50. Please refer to http://...
      if ($msg =~ /^(\d+) Message from \([^)]+\) temporarily deferred - (\d\.\d+\.\d+)\. Please refer to (.+)$/) {
         $dsn = "$1 $2"; $msg = "see $3";
      }
      #$r1 = join(': ', 'refused', $msg);
      $r1 = $msg;
   }
   elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) {
      #print "DELIVERY SUSP: $hostreply\n";
      $host = $2; $r1 = join(': ', $1, $3);
   }
   elsif ($hostreply =~ /^(delivery temporarily suspended: conversation) with (\S+) (.*)$/o) {
      # delivery temporarily suspended: conversation with example.com[10.0.0.1] timed out while receiving the initial server greeting)
      #print "DELIVERY SUSP2: $hostreply\n";
      $host = $2; $r1 = join(' ', $1, $3);
   }
   elsif (($event,$host,$r1) = ($hostreply =~ /^(lost connection|conversation) with (\S+) (.*)$/o)) {
      #print "LOST conv/conn: $hostreply\n";
      $r1 = join(' ',$event,$r1);
   }
   elsif ($hostreply =~ /^(.*: \S+maildrop: Unable to create a dot-lock) at .*$/o) {
      #print "MAILDROP: $hostreply\n";
      $r1 = $1;
   }
   elsif ($hostreply =~ /^mail for (\S+) loops back to myself/o) {
      #print "LOOP: $hostreply\n";
      $host = $1; $r1 = 'mailer loop';
   }
   elsif ($hostreply =~ /^unable to find primary relay for (\S+)$/o) {
      #print "NORELAY: $hostreply\n";
      $host = $1; $r1 = 'no relay found';
   }
   elsif ($hostreply =~ /^message size \d+ exceeds size limit \d+ of server (\S+)\s*$/o) {
      #print "TOOBIG: $hostreply\n";
      $host = $1; $r1 = 'message too big';
   }
   else {
      #print "UNMATCH: $hostreply\n";
      $r1 = $hostreply;
   }

   #print "R1: $r1, R2: $r2\n";
   $r1 =~ s/for name=\Q$domain\E //ig;

   if ($host eq '') {
      if ($relay =~ /([^[]+)\[([^]]+)\]/) {
         $fmtdhost = formathost($2,$1);
      }
      else {
         $fmtdhost = '*unknown';
      }
   }
   elsif ($host =~ /^([^[]+)\[([^]]+)\]/) {
      $fmtdhost = formathost($2,$1);
   }
   else {
      $fmtdhost = $host;
   }

   return (($dsn ? "$dsn " : '' ) . "\u$r1$r2", $fmtdhost);
}

# Strip and return from, to, proto, and helo information from a log line
# From is set to the empty envelope sender <> as necessary, and To is
# always lowercased.
#
# Note: modifies its input for efficiency
#
sub strip_ftph($) {
   my ($helo, $proto, $to, $from);
   #print "strip_ftph: '$_[0]\n";
   $helo  =    ($_[0] =~ s/\s+helo=<(.*?)>\s*$//) == 1 ? $1               : '*unavailable';
   $proto =    ($_[0] =~ s/\s+proto=(\S+)\s*$//)  == 1 ? $1               : '*unavailable';
   $to    =    ($_[0] =~ s/\s+to=<(.*?)>\s*$//)   == 1 ? (lc($1) || '<>') : '*unavailable';
   $from  =    ($_[0] =~ s/\s+from=<(.*?)>\s*$//) == 1 ? (   $1  || '<>') : '*unavailable';

   #print "helo: $helo, proto: $proto, to: $to, from: $from\n";
   #print "strip_ftph: final: '$_[0]'\n";
   return ($from,$to,$proto,$helo);
}

# Initialize the Getopts option list.  Requires the Section table to
# be built already.
#
sub init_getopts_table() {
   print "init_getopts_table: enter\n"  if $Opts{'debug'} & Logreporters::D_ARGS;

   init_getopts_table_common(@supplemental_reports);

   add_option ('recipient_delimiter=s');
   add_option ('delays!');
   add_option ('show_delays=i',             sub { $Opts{'delays'} = $_[1]; 1; });
   add_option ('delays_percentiles=s');
   add_option ('reject_reply_patterns=s');
   add_option ('ignore_services=s');
   add_option ('postgrey_delays!');
   add_option ('postgrey_show_delays=i',    sub { $Opts{'postgrey_delays'} = $_[1]; 1; });
   add_option ('postgrey_delays_percentiles=s');
   add_option ('unknown!',                  sub { $Opts{'unknown'} = $_[1]; 1; });
   add_option ('show_unknown=i',            sub { $Opts{'unknown'} = $_[1]; 1; });
   add_option ('enable_long_queue_ids=i',   sub { $Opts{'long_queue_ids'} = $_[1]; 1; });
   add_option ('long_queue_ids!');

=pod
   # aliases and backwards compatibility
   add_option ('msgsdeferred=s',            \$Opts{'deferred'});
   add_option ('msgsdelivered=s',           \$Opts{'delivered'});
   add_option ('msgssent=s',                \$Opts{'sent'});
   add_option ('msgssentlmtp=s',            \$Opts{'sentlmtp'});
   add_option ('msgsforwarded=s',           \$Opts{'forwarded'});
   add_option ('msgsresent=s',              \$Opts{'resent'});
   add_option ('warn=s',                    \$Opts{'warned'});
   add_option ('held=s',                    \$Opts{'hold'});
=cut
}

# Builds the entire @Section table used for data collection
#
# Each Section entry has as many as six fields:
#
#   1. Section array reference
#   2. Key to %Counts, %Totals accumulator hashes, and %Collecting hash
#   3. Output in Detail report? (must also a %Counts accumulator)
#   4. Numeric output format specifier for Summary report
#   5. Section title for Summary and Detail reports
#   6. A hash to a divisor used to calculate the percentage of a total for that key
#
# Use begin_section_group/end_section_group to create groupings around sections.
# 
# Sections can be freely reordered if desired, but maintain proper group nesting.
#
#
# The reject* entries of this table are dynamic, in that they are built based
# upon the value of $Opts{'reject_reply_patterns'}, which can be specified by
# either command line or configuration file.  This allows various flavors, of
# reject sections based on SMTP reply code (eg. 421 45x, 5xx, etc.).  Instead
# of creating special sections for each reject variant, the primary key of each
# reject section could have been the SMTP reply code.  However, this would
# require special-case processing to distinguish 4xx temporary rejects from 5xx
# permanent rejects in various Totals{'totalrejects*'} counts, and in the
# Totals{'totalrejects'} tally.
# 
# Sections can be freely reordered if desired.
sub build_sect_table() {
   if ($Opts{'debug'} & Logreporters::D_SECT) {
      print "build_sect_table: enter\n";
      print "\treject patterns: $Opts{'reject_reply_patterns'}\n";
   }
   my $S = \@Sections;

   # References to these are used in the Sections table below; we'll predeclare them.
   $Totals{'totalrejects'} = 0;
   $Totals{'totalrejectswarn'} = 0;
   $Totals{'totalacceptplusreject'} = 0;

   # Configuration and critical errors appear first

   #    SECTIONREF, NAME,                 DETAIL, FMT, TITLE,                             DIVISOR
   begin_section_group ($S, 'warnings');
   add_section ($S, 'panicerror',                  1, 'd', '*Panic:   General panic');
   add_section ($S, 'fatalfiletoobig',             0, 'd', '*Fatal:   Message file too big');
   add_section ($S, 'fatalconfigerror',            1, 'd', '*Fatal:   Configuration error');
   add_section ($S, 'fatalerror',                  1, 'd', '*Fatal:   General fatal');
   add_section ($S, 'error',                       1, 'd', '*Error:   General error');
   add_section ($S, 'processlimit',                1, 'd', '*Warning: Process limit reached, clients may delay');
   add_section ($S, 'warnfiletoobig',              0, 'd', '*Warning: Queue file size limit exceeded');
   add_section ($S, 'warninsufficientspace',       0, 'd', '*Warning: Insufficient system storage error');
   add_section ($S, 'warnconfigerror',             1, 'd', '*Warning: Server configuration error');
   add_section ($S, 'queuewriteerror',             1, 'd', '*Warning: Error writing queue file');
   add_section ($S, 'messagewriteerror',           1, 'd', '*Warning: Error writing message file');
   add_section ($S, 'databasegeneration',          1, 'd', '*Warning: Database is older than source file');
   add_section ($S, 'mailerloop',                  1, 'd', '*Warning: Mailer loop');
   add_section ($S, 'startuperror',                1, 'd', '*Warning: Startup error');
   add_section ($S, 'mapproblem',                  1, 'd', '*Warning: Map lookup problem');
   add_section ($S, 'attrerror',                   1, 'd', '*Warning: Error reading attribute data');
   add_section ($S, 'anvil',                       1, 'd', '*Warning: Anvil limit reached');
   add_section ($S, 'processexit',                 1, 'd', 'Process exited');
   add_section ($S, 'hold',                        1, 'd', 'Placed on hold');
   add_section ($S, 'communicationerror',          1, 'd', 'Postfix communications error');
   add_section ($S, 'saslauthfail',                1, 'd', 'SASL authentication failed');
   add_section ($S, 'ldaperror',                   1, 'd', 'LDAP error');
   add_section ($S, 'warningsother',               1, 'd', 'Miscellaneous warnings');
   add_section ($S, 'totalrejectswarn',            0, 'd', 'Reject warnings (warn_if_reject)');
   end_section_group ($S, 'warnings');

   begin_section_group ($S, 'bytes', "\n");
   add_section ($S, 'bytesaccepted',               0, 'Z', 'Bytes accepted ');           # Z means print scaled as in 1k, 1m, etc.
   add_section ($S, 'bytessentsmtp',               0, 'Z', 'Bytes sent via SMTP');
   add_section ($S, 'bytessentlmtp',               0, 'Z', 'Bytes sent via LMTP');
   add_section ($S, 'bytesdelivered',              0, 'Z', 'Bytes delivered');
   add_section ($S, 'bytesforwarded',              0, 'Z', 'Bytes forwarded');
   end_section_group ($S, 'bytes', $sep1);

   begin_section_group ($S, 'acceptreject', "\n");
   begin_section_group ($S, 'acceptreject2', "\n");
   add_section ($S, 'msgsaccepted',                0, 'd', 'Accepted',                          \$Totals{'totalacceptplusreject'});
   add_section ($S, 'totalrejects',                0, 'd', 'Rejected',                          \$Totals{'totalacceptplusreject'});
   end_section_group ($S, 'acceptreject2', $sep2);
   add_section ($S, 'totalacceptplusreject',       0, 'd', 'Total',                             \$Totals{'totalacceptplusreject'});
   end_section_group ($S, 'acceptreject', $sep1);

   # The various Reject sections are built dynamically based upon a list of reject reply keys,
   # which are user-configured via $Opts{'reject_reply_patterns'}
   @RejectPats = ();
   foreach my $rejpat (split /[ ,]/, $Opts{'reject_reply_patterns'}) {
      if ($rejpat !~ /^(warn|[45][\d.]{2})$/io) {
         print STDERR usage "Invalid pattern \"$rejpat\" in reject_reply_patterns";
         exit (2);
      }
      if (grep (/\Q$rejpat\E/, @RejectPats) == 0) {
         push @RejectPats, $rejpat
      }
      else {
         print STDERR "Ignoring duplicate pattern \"$rejpat\" in reject_reply_patterns\n";
      }
   }
   @RejectKeys = @RejectPats;
   for (@RejectKeys) {
      s/\./x/g;
   }

   print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n"  if $Opts{'debug'} & Logreporters::D_SECT;

   # Add reject variants
   foreach my $key (@RejectKeys) {
      $key   = lc($key);
      my $keyuc = ucfirst($key);
      my $totalsref = \$Totals{'totalrejects' . $key};
      print "\t   reject key: $key\n" if $Opts{'debug'} & Logreporters::D_SECT;

      begin_section_group ($S, 'rejects', "\n");
      begin_section_group ($S, 'rejects2', "\n");
      add_section ($S, $key . 'rejectrelay',                 1, 'd', $keyuc . ' Reject relay denied',                $totalsref);
      add_section ($S, $key . 'rejecthelo',                  1, 'd', $keyuc . ' Reject HELO/EHLO',                   $totalsref);
      add_section ($S, $key . 'rejectdata',                  1, 'd', $keyuc . ' Reject DATA',                        $totalsref);
      add_section ($S, $key . 'rejectunknownuser',           1, 'd', $keyuc . ' Reject unknown user',                $totalsref);
      add_section ($S, $key . 'rejectrecip',                 1, 'd', $keyuc . ' Reject recipient address',           $totalsref);
      add_section ($S, $key . 'rejectsender',                1, 'd', $keyuc . ' Reject sender address',              $totalsref);
      add_section ($S, $key . 'rejectclient',                1, 'd', $keyuc . ' Reject client host',                 $totalsref);
      add_section ($S, $key . 'rejectunknownclient',         1, 'd', $keyuc . ' Reject unknown client host',         $totalsref);
      add_section ($S, $key . 'rejectunknownreverseclient',  1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref);
      add_section ($S, $key . 'rejectunverifiedclient',      1, 'd', $keyuc . ' Reject unverified client host',      $totalsref);
      add_section ($S, $key . 'rejectrbl',                   1, 'd', $keyuc . ' Reject RBL',                         $totalsref);
      add_section ($S, $key . 'rejectheader',                1, 'd', $keyuc . ' Reject header',                      $totalsref);
      add_section ($S, $key . 'rejectbody',                  1, 'd', $keyuc . ' Reject body',                        $totalsref);
      add_section ($S, $key . 'rejectcontent',               1, 'd', $keyuc . ' Reject content',                     $totalsref);
      add_section ($S, $key . 'rejectsize',                  1, 'd', $keyuc . ' Reject message size',                $totalsref);
      add_section ($S, $key . 'rejectmilter',                1, 'd', $keyuc . ' Reject milter',                      $totalsref);
      add_section ($S, $key . 'rejectproxy',                 1, 'd', $keyuc . ' Reject proxy',                       $totalsref);
      add_section ($S, $key . 'rejectinsufficientspace',     1, 'd', $keyuc . ' Reject insufficient space',          $totalsref);
      add_section ($S, $key . 'rejectconfigerror',           1, 'd', $keyuc . ' Reject server config error',         $totalsref);
      add_section ($S, $key . 'rejectverify',                1, 'd', $keyuc . ' Reject VRFY',                        $totalsref);
      add_section ($S, $key . 'rejectetrn',                  1, 'd', $keyuc . ' Reject ETRN',                        $totalsref);
      add_section ($S, $key . 'rejectlookupfailure',         1, 'd', $keyuc . ' Reject temporary lookup failure',    $totalsref);
      end_section_group ($S, 'rejects2', $sep2);
      add_section ($S, 'totalrejects' . $key,                0, 'd', "Total $keyuc Rejects",                         $totalsref);
      end_section_group ($S, 'rejects', $sep1);

      $Totals{'totalrejects' . $key} = 0;
   }

   begin_section_group ($S, 'byiprejects', "\n");
   add_section ($S,  'byiprejects',                 1, 'd', 'Reject by IP');
   end_section_group ($S, 'byiprejects');

   begin_section_group ($S, 'general1', "\n");
   add_section ($S, 'connectioninbound',           1, 'd', 'Connections');
   add_section ($S, 'connectionlostinbound',       1, 'd', 'Connections lost (inbound)');
   add_section ($S, 'connectionlostoutbound',      1, 'd', 'Connections lost (outbound)');
   add_section ($S, 'disconnection',               0, 'd', 'Disconnections');
   add_section ($S, 'removedfromqueue',            0, 'd', 'Removed from queue');
   add_section ($S, 'delivered',                   1, 'd', 'Delivered');
   add_section ($S, 'sent',                        1, 'd', 'Sent via SMTP');
   add_section ($S, 'sentlmtp',                    1, 'd', 'Sent via LMTP');
   add_section ($S, 'forwarded',                   1, 'd', 'Forwarded');
   add_section ($S, 'resent',                      0, 'd', 'Resent');
   add_section ($S, 'deferred',                    1, 'd', 'Deferred');
   add_section ($S, 'deferrals',                   1, 'd', 'Deferrals');
   add_section ($S, 'bouncelocal',                 1, 'd', 'Bounced (local)');
   add_section ($S, 'bounceremote',                1, 'd', 'Bounced (remote)');
   add_section ($S, 'bouncefailed',                1, 'd', 'Bounce failure');
   add_section ($S, 'postscreen',                  1, 'd', 'Postscreen');
   add_section ($S, 'dnsblog',                     1, 'd', 'DNSBL log');

   add_section ($S, 'envelopesenders',             1, 'd', 'Envelope senders');
   add_section ($S, 'envelopesenderdomains',       1, 'd', 'Envelope sender domains');

   add_section ($S, 'bcced',                       1, 'd', 'BCCed');
   add_section ($S, 'filtered',                    1, 'd', 'Filtered');
   add_section ($S, 'redirected',                  1, 'd', 'Redirected');
   add_section ($S, 'discarded',                   1, 'd', 'Discarded');
   add_section ($S, 'prepended',                   1, 'd', 'Prepended');
   add_section ($S, 'replaced',                    1, 'd', 'Replaced');
   add_section ($S, 'warned',                      1, 'd', 'Warned');

   add_section ($S, 'requeued',                    0, 'd', 'Requeued messages');
   add_section ($S, 'returnedtosender',            1, 'd', 'Expired and returned to sender');
   add_section ($S, 'notificationsent',            1, 'd', 'Notifications sent');

   add_section ($S, 'policyspf',                   1, 'd', 'Policy SPF');
   add_section ($S, 'policydweight',               1, 'd', 'Policyd-weight');
   add_section ($S, 'postfwd',                     1, 'd', 'Postfwd');
   add_section ($S, 'postgrey',                    1, 'd', 'Postgrey');
   end_section_group ($S, 'general1');

   begin_section_group ($S, 'general2', "\n");
   add_section ($S, 'connecttofailure',            1, 'd', 'Connection failures (outbound)');
   add_section ($S, 'timeoutinbound',              1, 'd', 'Timeouts (inbound)');
   add_section ($S, 'heloerror',                   1, 'd', 'HELO/EHLO conversations errors');
   add_section ($S, 'illegaladdrsyntax',           1, 'd', 'Illegal address syntax in SMTP command');
   add_section ($S, 'released',                    0, 'd', 'Released from hold');
   add_section ($S, 'rblerror',                    1, 'd', 'RBL lookup errors');
   add_section ($S, 'dnserror',                    1, 'd', 'DNS lookup errors');
   add_section ($S, 'numerichostname',             1, 'd', 'Numeric hostname');
   add_section ($S, 'smtpconversationerror',       1, 'd', 'SMTP dialog errors');
   add_section ($S, 'hostnameverification',        1, 'd', 'Hostname verification errors (FCRDNS)');
   add_section ($S, 'hostnamevalidationerror',     1, 'd', 'Hostname validation errors');
   add_section ($S, 'smtpprotocolviolation',       1, 'd', 'SMTP protocol violations');
   add_section ($S, 'deliverable',                 1, 'd', 'Deliverable (address verification)');
   add_section ($S, 'undeliverable',               1, 'd', 'Undeliverable (address verification)');
   add_section ($S, 'tablechanged',                0, 'd', 'Restarts due to lookup table change');
   add_section ($S, 'pixworkaround',               1, 'd', 'PIX workaround enabled');
   add_section ($S, 'tlsserverconnect',            1, 'd', 'TLS connections (server)');
   add_section ($S, 'tlsclientconnect',            1, 'd', 'TLS connections (client)');
   add_section ($S, 'saslauth',                    1, 'd', 'SASL authenticated messages');
   add_section ($S, 'tlsunverified',               1, 'd', 'TLS certificate unverified');
   add_section ($S, 'tlsoffered',                  1, 'd', 'Host offered TLS');
   end_section_group ($S, 'general2');

   begin_section_group ($S, 'postfixstate', "\n");
   add_section ($S, 'postfixstart',                0, 'd', 'Postfix start');
   add_section ($S, 'postfixstop',                 0, 'd', 'Postfix stop');
   add_section ($S, 'postfixrefresh',              0, 'd', 'Postfix refresh');
   add_section ($S, 'postfixwaiting',              0, 'd', 'Postfix waiting to terminate');
   end_section_group ($S, 'postfixstate');


   if ($Opts{'debug'} & Logreporters::D_SECT) {
      print "\tSection table\n";
      printf "\t\t%s\n", (ref($_) eq 'HASH' ? $_->{NAME} : $_) foreach @Sections;
      print "build_sect_table: exit\n"
   }
}

# XXX create array of defaults for detail <5, 5-9, >10
sub init_defaults() {
   map { $Opts{$_} = $Defaults{$_} unless exists $Opts{$_} } keys %Defaults;
   if (! $Opts{'standalone'}) {
      # LOGWATCH
      # these take affect if no env present (eg. nothing in conf file)
      # 0 to 4 nodelays

      if ($Opts{'detail'} < 5) {          # detail 0 to 4, disable all supplimental reports
         $Opts{'delays'}            = 0;
         $Opts{'postgrey_delays'}   = 0;
      }
   }
}


# XXX ensure something is matched?
# XXX cache values so we don't have to substitute X for . each time
#match $dsn against list for best fit
sub get_reject_key($) {
   my $reply = shift;
   my $replyorig = $reply;
   ($reply) = split / /, $reply;
   for (my $i = 0; $i <= $#RejectPats; $i++) {
      #print "TRYING: $RejectPats[$i]\n";
      # we'll allow extended DSNs to match (eg. 5.7.1 will match 5..)
      if ($reply =~ /^$RejectPats[$i]/) {    # no /o here, pattern varies
         #print "MATCHED: orig: $replyorig, reply $reply matched pattern $RejectPats[$i], returning $RejectKeys[$i]\n";
         return $RejectKeys[$i];
      }
   }
   #print "NOT MATCHED: REPLY CODE: '$replyorig', '$reply'\n";
   return;
}

# Replace bare reject limiters with specific reject limiters 
# based on reject_reply_patterns
#
sub expand_bare_reject_limiters()
{
  # don't reorder the list of limiters.  This breaks --nodetail followed by a
  # bare reject such as --limit rejectrbl=10.  Reordering is no longer necessary
  # since process_limiters was instituted and using the special __none__ pseudo-
  # limiter to indicate the position at which --nodefailt was found on the command
  # line.
  # my ($limiter, @reject_limiters, @non_reject_limiters);
   my ($limiter, @new_list);

   # XXX check if limiter matches just one in rejectclasses
   while ($limiter = shift @Limiters) {
      if ($limiter =~ /^reject[^_]/) {
         foreach my $reply_code (@RejectKeys) {
            printf "bare_reject: \L$reply_code$limiter\n"  if $Opts{'debug'} & Logreporters::D_VARS;
            #push @reject_limiters, lc($reply_code) . $limiter;
            push @new_list, lc($reply_code) . $limiter;
         }
      }
      elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) {
         $limiter =~ s/^([45])\.\./$1xx/;
         #push @reject_limiters, lc $limiter;
         push @new_list, lc $limiter;
      }
      else {
         #push @non_reject_limiters, $limiter;
         push @new_list, $limiter;
      }
   }
   #@Limiters = (@reject_limiters, @non_reject_limiters);
   @Limiters = @new_list;
}


# Return a usage string,  built from:
#    arg1 +
#    $usage_str +
#    a string built from each usable entry in the @Sections table.
# reject patterns are special cased to minimize the number of
# command line options presented.
#
sub usage($) {
   my $ret = "";
   $ret = "@_\n"  if ($_[0]);

   $ret .= $usage_str;
   my ($name, $desc, %reject_types);
   foreach my $sect (get_usable_sectvars(@Sections, 0)) {

      if (my ($code,$rej) = ($sect->{NAME} =~ /^(...|warn)(reject.*)$/oi)) {
         $rej = lc $rej;
         next if (exists $reject_types{$rej});
         $reject_types{$rej}++;
         $name = '[###]' . $rej;
         $desc = '###' . substr($sect->{TITLE}, length($code));
      }
      else {
         $name = lc $sect->{NAME};
         $desc = $sect->{TITLE};
      }
      $ret .= sprintf "   --%-38s%s\n", "$name" . ' LEVEL', "$desc";
   }
   $ret .= "\n";
   return $ret;
}

1;

# vi: shiftwidth=3 tabstop=3 syntax=perl et