#!/usr/bin/perl ########################################################################## # $Id: postfix,v 1.36 2007/07/08 18:59:02 mrc Exp $ ########################################################################## ########################################################################## # Postfix-logwatch: written and maintained by: # # Mike "MrC" Cappella # # Please send all comments, suggestions, bug reports to the logwatch # mailing list (logwatch@logwatch.org), or to the email address above. # I will respond as quickly as possible. [MrC] # # All work since Dec 12, 2006 (logwatch CVS revision 1.28) # Copyright (C) 2006,2007 Mike Cappella # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ########################################################################## # 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://www.mikecappella.com/logwatch # or included with the standalone postfix-logwatch distribution ########################################################################## ########################################################################## # # Test data included via inline comments starting with "#TD" # package Logreporters; use 5.008; use strict; use warnings; no warnings "uninitialized"; use re 'taint'; our $Version = '1.37.01'; our $progname_prefix = 'postfix'; # Specifies the default configuration file for use in standalone mode. my $config_file = "/usr/local/etc/${progname_prefix}-logwatch.conf"; # debug constants use constant { D_CONFIG => 1<<0, D_ARGS => 1<<1, D_VARS => 1<<2, D_TREE => 1<<3, D_SECT => 1<<4, D_UNMATCHED => 1<<5, D_TEST => 1<<30, D_ALL => 1<<31, }; #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.001'; @ISA = qw(Exporter); @EXPORT = qw(&formathost &get_percentiles &get_frequencies &commify &unitize &get_usable_sectvars &get_version); @EXPORT_OK = qw(&gen_test_log); } use subs qw (@EXPORT @EXPORT_OK); # Formats IP and hostname for even column spacing # sub formathost($ $) { my ($hostip, $hostname) = @_; return sprintf "%-$Logreporters::Config::Opts{'ipaddr_width'}s %s", $hostip eq '' ? '*unknown' : $hostip, $hostname eq '' ? '*unknown' : lc $hostname; } # 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; foreach my $var (@$sectref) { #print "get_usable_sectvars: $var->{NAME}\n"; next unless ref($var) eq 'HASH'; push @sect_list, $namesonly ? $var->{NAME} : $var; } 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 if ($i == 0) { $Yp = $aref->[0]; } elsif ($i == $n) { $Yp = $aref->[$last]; } 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 "p(%3.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 @blist; my $bucket_index = 0; OUTER: foreach my $score (@$aref) { #print "Score: $score\n"; my $i = 0; for $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 ($) { 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); } # 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 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"; @ARGV = ($scriptpath); if ($toolname eq 'postfix') { my %services = ( DEF => 'smtpd', bQ => 'bounce', cQ => 'cleanup', cN => 'cleanup', lQ => 'local', p => 'pickup', ps => 'postsuper', pQ => 'pipe', qQ => 'qmgr', s => 'smtp', spf => 'policy-spf', sd => 'smtpd', sdN => 'smtpd', sdQ => 'smtpd', sQ => 'smtp', pg => 'postgrey', pgQ => 'postgrey', ); my $id = 'postfix/smtp[12345]'; while (<>) { if (/^\s*#TD([a-zA-Z]*[NQ]?)(\d+)?(?:\(([^)]+)\))? (.*)$/) { my ($service,$qid,$count,$line) = ($1, $2, $3, $4); 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 .= ': 98F8923CA'; } $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 while (<>) { print FH "$syslogtime $hostname amavis\[9999\]: \(9999-99\) $2\n" x ($1 ? $1:1) if /^\s*#TD(\d+)? (.*)$/; } } 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.001'; @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); } use subs @EXPORT; our @Optspec = (); # options table used by Getopts our %Opts = (); # program-wide options our %Configvars = (); # configuration file variables our @Limiters; 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($); # 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; 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'} & Logreporters::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'} & Logreporters::D_ARGS) { print "\nget_options($pass_through): enter\n"; printf "\tARGV(%d): @ARGV\n", scalar @ARGV; 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'} & Logreporters::D_ARGS) { print "\t$_ ", defined $Opts{$_} ? "=> $Opts{$_}\n" : "\n" foreach sort keys %Opts; printf "\tARGV(%d): @ARGV\n", scalar @ARGV; print "get_options: exit\n"; } } sub add_option(@) { push @Optspec, @_; } sub init_getopts_table_common() { print "init_getopts_table_common: enter\n" if $Opts{'debug'} & Logreporters::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 { push @Limiters, '__none__' }); add_option ('max_report_width=i'); add_option ('nosummary'); add_option ('ipaddr_width=i'); 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]); 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, $_[1]; }); print "init_getopts_table_common: exit\n" if $Opts{'debug'} & Logreporters::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'} & Logreporters::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'} & Logreporters::D_ARGS; push @cmdline, '-l', "$configvar" . "=$value"; } else { print "\tOPTION($ret): $configvar = $value\n" if $Opts{'debug'} & Logreporters::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'} & Logreporters::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 () { 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'} & Logreporters::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'} & Logreporters::D_CONFIG; } sub process_limiters(\@ @) { my ($sectref,@othersections) = @_; my ($limiter, $var, $val, @errors); my @l = get_usable_sectvars($sectref, 1); if ($Opts{'debug'} & Logreporters::D_VARS) { print "process_limiters: enter\n"; print "\tLIMITERS: @Limiters\n"; } while ($limiter = shift @Limiters) { my @matched = (); printf "\t%-30s ",$limiter if $Opts{'debug'} & Logreporters::D_VARS; # disable all limiters when limiter is __none__: see 'nodetail' cmdline option if ($limiter eq '__none__') { $Opts{$_} = 0 foreach @l, @othersections; 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'} & Logreporters::D_VARS; # XXX move limiters into section hash entry... $Opts{$limiter} = $val; next; } print "matched=", scalar @matched, ": @matched\n" if $Opts{'debug'} & Logreporters::D_VARS; push @errors, "Limiter \"$var\" is " . (scalar @matched == 0 ? "invalid" : "ambiguous: @matched"); } 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, @othersections) { $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; } my %debug_words = ( config => Logreporters::D_CONFIG, args => Logreporters::D_ARGS, vars => Logreporters::D_VARS, tree => Logreporters::D_TREE, sect => Logreporters::D_SECT, unmatched => Logreporters::D_SECT, test => Logreporters::D_TEST, all => 0xffffffff, ); 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'} & Logreporters::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); @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 top10 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 # sub buildTree(\% $ $ $ $ $) { my ($href, $max_level_section, $levspecref, $max_level_global, $recurs_level, $debug) = @_; my ($subtotal, $childList, $rec); my @treeList; my $item; my $total = 0; @treeList = (); foreach $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, }; $rec->{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); } $total += $subtotal; } else { if ($item ne '' 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); } $total += $href->{$item}; } } #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($re_DSN $re_QID $re_DDD); } # 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})'; # IPv4 only #our $re_IP = qr/(?:\d{1,3}\.){3}(?:\d{1,3})/; our $re_DSN = qr/(?:(?:\d{3})?(?: ?\d\.\d\.\d)?)/; our $re_QID = qr/[A-Z\d]+/; our $re_DDD = qr/(?:(?:conn_use=\d+ )?delay=-?[\d.]+(?:, delays=[\d\/.]+)?(?:, dsn=[\d.]+)?)/; 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.001'; @ISA = qw(Exporter); @EXPORT = qw(&inc_unmatched &print_unmatched_report &print_summary_report &print_detail_report); @EXPORT_OK = qw(); } use subs @EXPORT_OK; BEGIN { import Logreporters::Config qw(%Opts); import Logreporters::Utils qw(&commify &unitize); import Logreporters::TreeData qw(%Totals %Counts &buildTree &printTree); } sub create_level_specs($ $ $); sub print_level_specs($ $); sub clear_level_specs($ $); 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'} & Logreporters::D_UNMATCHED; } # Print unmatched lines # sub print_unmatched_report() { return unless (keys %unmatched_list); my $line; print "\n\n**Unmatched Entries**\n"; foreach $line (sort {$unmatched_list{$b}<=>$unmatched_list{$a} } keys %unmatched_list) { printf "%8d %s\n", $unmatched_list{$line}, $line; } } =pod ****** Summary ******************************************************** 2 Miscellaneous warnings ======== ================================================ 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% 20621 Total messages scanned ---------------- 100.00% 662.993M Total bytes scanned 695,198,092 ======== ================================================ 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 $output_occurred = 0; my $sect_had_output = 0; my $keyname; if ($Opts{'detail'} >= 5) { my $header = "****** Summary "; print $header, '*' x ($Opts{'max_report_width'} - length $header), "\n\n"; } foreach my $sref (@$sections) { # headers and separators if (ref($sref) ne 'HASH') { $keyname = $sref; # start a new section; controls subsequent newline output if ($keyname eq '__SECTION') { $sect_had_output = 0; next; } # print blank line if keyname is null string if ($keyname eq "\n") { print "\n" if ($output_occurred && $sect_had_output); } elsif (my ($sepchar) = ($keyname =~ /^(.)$/o)) { printf "%s %s\n", $sepchar x 8, $sepchar x 48 if ($output_occurred && $sect_had_output); } else { die "print_summary_report: unexpected control..."; } next; } # 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) { # XXX generalize this if (ref ($desc) eq 'ARRAY') { $desc = @$desc[0] . ' ' . @$desc[1] x (40 - 2 - length(@$desc[0])); } printf "$fmt %-40s %6.2f%%\n", $total, $desc, $$divisor == $Totals{$keyname} ? 100.00 : $Totals{$keyname} * 100 / $$divisor; } else { printf "$fmt %-21s $extra\n", $total, $desc, commify ($Totals{$keyname}); } $output_occurred++; $sect_had_output++; } } print "\n"; } # Prints the Detail report section # 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 ) { my $keyname = ref($sref) eq 'HASH' ? $sref->{NAME} : $sref; next unless exists $Counts{$keyname}; 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'} & Logreporters::D_TREE); if ($count > 0) { if ($print_this_key) { my $desc = $sref->{TITLE}; $desc =~ s/^\s+//; if (! $header_printed) { my $header = "****** Detail "; 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'} & Logreporters::D_TREE); } #print STDERR "Total size Counts: ", total_size(\%Counts), "\n"; #print STDERR "Total size Totals: ", total_size(\%Totals), "\n"; $treeref = (); $Totals{$keyname} = (); delete $Totals{$keyname}; delete $Counts{$keyname}; } print "\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::RegEx qw($re_IP $re_QID); import Logreporters::TreeData qw(%Totals %Counts); 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; my ($action, $domain, $ip, $problem) = (undef, '*unknown', '*unknown', ''); if ( #: handler sender_policy_framework: is decisive. $line =~ /^handler [^:]+/ or $line =~ /: testing:/ or $line =~ /^decided action=/ or $line =~ /^$re_QID: /o or $line =~ /REJECT/ ) { #print "$Logreporters::OrigLine\n"; return } # postfix-policyd-spf-perl: http://www.openspf.org/Software if ($line =~ /^: Policy action=(.*)$/) { $line = $1; #print "LINE: \"$line\"\n"; #: : Policy action=DUNNO return if ($line =~ /^DUNNO/); if ($line =~ /^DEFER_IF_PERMIT SPF-Result=\[?(.*?)\]?: (.*) of .*$/o) { ($ip,$problem) = ($1,$2); $action = 'defer_if_permit'; #: : 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' $problem =~ s/'//g; $problem =~ s/^(.*?) on (DNS SPF lookup)$/$2: $1/; } elsif ($line =~ m{^550 (Please see http://www\.openspf\.org/Why\?).*\&id=([^&]+)\&ip=($re_IP)\&}o) { ($problem,$domain,$ip) = ($1,$2,$3); #: : Policy action=550 Please see http://www.openspf.org/Why?s=mfrom&id=from%40example.com&ip=10.0.0.1&r=sample.net $problem .= '...'; $action = '550 reject'; $domain =~ s/.*%40//; } elsif ($line =~ /^[^:]+: (none|pass|fail|softfail|neutral|permerror|temperror) (.*);.* client-ip=(.+)$/) { ($action,$problem,$ip) = ($1,$2,$3,$4); #: : 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 #: : 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 #: : 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 #: : 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 $action = 'SPF ' . $action; if ($problem =~ /^\((.*)\) receiver=[^;]+; identity=([^;]+)(?:; envelope-from="?([^;]+?)"?)?; helo="?(.*?)"?$/) { $problem = $1; my ($identity,$efrom,$helo) = ($2,$3,$4); if ($identity eq 'mfrom') { $domain = (split /@/, $efrom)[1]; } elsif ($identity eq 'helo') { $domain = $helo; } else{ inc_unmatched('postfix_policy_spf(2)'); } } else { inc_unmatched('postfix_policy_spf(3)'); } $problem =~ s/^([^:]*?): //; #Domain does not state whether sender is authorized to use 'returns@example.com' in 'mfrom' identity (mechanism '?all' 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' match) if ($problem =~ /^(Sender|$re_IP|Domain does not state whether sender)( is (?:not )?authorized (?:by default )?to use )'.*?' ([^)]+) (\(.+?\))$/o) { my ($sender,$result,$identity,$mech) = ($1,$2,$3,$4); $sender =~ s/$re_IP/IP/o; $identity =~ s/in 'mfrom' identity/MAIL FROM identity/; $problem = $sender . $result . $identity; $mech =~ s/\(mechanism '(.*?)' matched\)/mech: $1/; $ip = formathost ($ip, $mech); } elsif ($problem =~ s/^(Junk encountered in mechanism) '(.*?)'/$1/) { $ip = formathost ($ip, 'mech: ' . $2); } elsif ($problem =~ s/^(Included domain) '(.*?)' (has no .*)$/$1 $3/) { $ip = formathost ($ip, 'domain: ' . $2); } } else { inc_unmatched('postfix_policy_spf(4)'); return; } $Totals{'policyspf'}++; $Counts{'policyspf'}{$action}{$problem}{$domain}{$ip}++ if ($Logreporters::Collecting{'policyspf'}); return; } # XXX which spf software is this ? #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 if (($action, $line) = ($line =~ /^: (SPF [^:]+): (.*)$/)) { #print "IN....\n\tACTION: $action\n\tLINE: $line\n\tORIG: \"$OrigLine\"\n"; if (($domain) = ($line =~ /smtp_comment=SPF: domain of sender (?:[^@]+@)?(\S+) does not/)) { #print "Action: $action: domain: $domain\n"; } elsif (($domain,$ip) = ($line =~ m#smtp_comment=Please see http://[^/]+/why\.html\?sender=(?:.+%40)?([^&]+)&ip=([^&]+)#)) { #print "Action: $action: domain: $domain, IP: $ip\n"; } elsif (($problem, $domain) = ($line =~ /smtp_comment=SPF record error: ([^,]+), .*: error in processing during lookup of (?:[^@]+\@)?(\S+)/)) { #print "Action: $action: domain: $domain, Problem: $problem\n"; } elsif (($problem, $domain) = ($line =~ /smtp_comment=SPF record error: ([^,]+), .*: encountered unrecognized mechanism during SPF processing of domain (?:[^@]+\@)?(\S+)/)) { #print "Action: \"$action\": domain: $domain, Problem: $problem\n"; $action = "SPF permerror" if ($action =~ /SPF unknown mx-all/); } else { return; } $Totals{'policyspf'}++; $Counts{'policyspf'}{$action}{$domain}{$ip}{$problem}++ if ($Logreporters::Collecting{'policyspf'}); return; } inc_unmatched('postfix_policy_spf'); } 1; #MODULE: ../Logreporters/Postgrey.pm package Logreporters::Postgrey; 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_postgrey); } use subs @EXPORT; BEGIN { import Logreporters::RegEx qw($re_IP $re_QID); import Logreporters::TreeData qw(%Totals %Counts); import Logreporters::Utils; import Logreporters::Reports qw(&inc_unmatched); } # 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 $line =~ /^cleaning / or $line =~ /^delayed / ); my ($action,$reason,$host,$ip,$sender,$recip); if ($line =~ /^(?:$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=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,$host,$ip,$sender,$recip) = ($1,$2,$3,$4,$5,$6); $reason =~ s/^(early-retry) \(.* missing\)$/$1/; } elsif ($line =~ /^(whitelisted): (.*?)\[($re_IP)\]$/o) { #TDpg: whitelisted: example.com[10.0.0.1] $reason='N/A'; ($action,$host,$ip) = ($1,$2,$3); } else { inc_unmatched('postgrey'); return; } $recip = '*unknown' if (not defined $recip); $sender = '' if (not defined $sender); $Totals{'postgrey'}++; $Counts{'postgrey'}{"\u$action"}{"\u$reason"}{formathost($ip,$host)}{$recip}{$sender}++ if ($Logreporters::Collecting{'postgrey'}); } 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::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): / or $line =~ /^cache (?:spawned|killed)/ or $line =~ /^child \d+ exited/ or $line =~ /^Daemon terminated/ ) { #print "$OrigLine\n"; return; } if ($line =~ s/^decided action=//) { $line =~ s/; delay: \d+s$//; # ignore, eg.: "delay: 3s" #print "IN....\n\tLINE: $line\n\tORIG: \"$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 , 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::Collecting{'startuperror'}); return; } else { inc_unmatched('policydweight'); return; } $Totals{'policydweight'}++; $Counts{'policydweight'}{$reason}{$reason2}++ if ($Logreporters::Collecting{'policydweight'}); } 1; package Logreporters; BEGIN { import Logreporters::Utils; import Logreporters::Config; import Logreporters::TreeData qw(%Totals %Counts %Collecting printTree buildTree); import Logreporters::RegEx qw($re_IP $re_DSN $re_QID $re_DDD); import Logreporters::Reports; import Logreporters::RFC3463; import Logreporters::PolicySPF; 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); # 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|postgrey)', # service name (postconf(5), syslog_name) sect_vars => 0, # show section vars in detail report hdrs ipaddr_width => 15, # width for printing ip addresses 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 ); 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 --nosummary do not display 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]sect_vars [do not] show config file var/cmd line option names in section titles --[no]delays [do not] show msg delays percentiles report --delays_percentiles "P1 [P2 ...]" set delays report percentiles to P1 [P2 ...] (range: 0...100) --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) 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 add_section($;$$$$); sub build_sect_table(); sub print_delays_report(); sub postfix_bounce($); sub postfix_cleanup($); sub postfix_fatal($); sub postfix_warning($); sub postfix_script($); sub process_delivery_attempt ($ $ $ $ $ $); sub cleanhostreply($ $ $ $); sub strip_ftph(\$); sub get_reject_key($); sub expand_bare_reject_limiters(); # 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 = (); my @RejectClasses = qw( rejectrelay rejecthelo rejectdata rejectunknownuser rejectrecip rejectsender rejectclient rejectunknownclient rejectunknownreverseclient rejectunverifiedclient rejectrbl rejectheader rejectbody rejectsize rejectmilter rejectinsufficientspace rejectconfigerror rejectverify rejectetrn ); # 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. # Also possibly disable additional report sections when --nodetail # was specified. process_limiters(@Sections, 'delays'); 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'}; } # Notes: # # - IN REs, always use /o flag or qr// at end of RE esp 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 # while ( <> ) { my $p1 = $_; chomp ($p1);; #print "origline: \"$p1\"\n"; $Logreporters::Reports::origline = $p1; my ($svr, $postfix_svc); # Linux #Jul 1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1] # FreeBSD #Jul 1 20:08:06 mailhost postfix/smtpd[4379]: connect from unknown[10.0.0.1] next unless ($p1 =~ /^... .. ..:..:.. (?:<[^>]+> )?[^ ]* ($Opts{'syslog_name'}(?:\/([^[:]+))?)(?:\[\d+\])?: (?:\[ID \d+ \w+\.\w+\] )?(.*)$/o); ($svr, $postfix_svc, $p1) = ($1, $2, $3); # ignored postfix services... next if ($postfix_svc =~ /^$Opts{'ignore_services'}$/o); $p1 =~ s/\s+$//; # should make a dispatch table for add-ins, so user's can add their own... if ($svr eq 'postgrey') { postfix_postgrey($p1); next; } # We don't care about these, but see also less frequent log entries at the end of the while loop next if ($p1 =~ /^Deleted: \d+ messages?$/o); next if ($p1 =~ /: Greylisted for /o); #XXX Perhaps the following are candidates for extended statistics next if ($p1 =~ /certificate verification (?:depth|failed for)/o); next if ($p1 =~ /Server certificate could not be verified/o); next if ($p1 =~ /certificate peer name verification failed/o); # SSL rubbish when logging at/above mail.info level next if ($p1 =~ /^[a-f\d]{4} [a-f\d]{2}/o); next if ($p1 =~ /^[a-f\d]{4} - >: Recipient address rejected: Domain not found; to=<<1F4@bs>> proto=SMTP helo= #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 : Sender address rejected: Domain not found; from= to= 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= proto=SMTP #TDsdN reject: RCPT from host[10.0.0.1]: 450 4.1.2 : Recipient address rejected: User unknown in local recipient table; from=<> to= proto=SMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 550 : Recipient address rejected: User unknown in local recipient table; from=<> to= proto=SMTP helo= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 550 : Recipient address rejected: User unknown in local recipient table; from=<> to= proto=SMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 550 5.1.1 : Recipient address rejected: User unknown in virtual address table; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 450 4.1.1 : Recipient address rejected: User unknown in virtual mailbox table; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 550 5.5.0 : Recipient address rejected: User unknown; from= to= proto=ESMTP helo=<[10.0.0.1]> #TDsdN reject: RCPT from host[10.0.0.1]: 450 : Recipient address rejected: Greylisted; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 454 4.7.1 : Recipient address rejected: Access denied; from= to= proto=SMTP helo= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 : Recipient address rejected: Access denied; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 450 4.1.2 : Recipient address rejected: Domain not found; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 554 : Recipient address rejected: Please see http://www.openspf.org/why.html?sender=from%40example.net&ip=10.0.0.1&receiver=example.net; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 550 : Recipient address rejected: undeliverable address: host example.net[192.168.0.1] said: 550 : User unknown in virtual alias table (in reply to RCPT TO command); from= to= proto=SMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 554 : Recipient address rejected: Please see http://spf.pobox.com/why.html?sender=user%40example.com&ip=10.0.0.1&receiver=mail; from= to= proto=ESMTP helo=<10.0.0.1> #TDsdN reject: RCPT from host[10.0.0.1]: 554 : Relay access denied; from= to= proto=SMTP helo= #TDsdN reject_warning: HELO from host[10.0.0.1]: 554 : Relay access denied; proto=SMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 450 4.1.8 : Sender address rejected: Domain not found; from= to= proto=ESMTP helo= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 450 4.1.8 : Sender address rejected: Domain not found; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 550 : Sender address rejected: undeliverable address: host example.net[10.0.0.1] said: 550 : User unknown in virtual alias table (in reply to RCPT TO command); from= to= proto=SMTP helo= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 554 : Client host rejected: Access denied; from= to= proto=SMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 554 : Client host rejected: Optional text; from= to= proto=SMTP helo= #TDsdN reject: CONNECT from host[10.0.0.1]: 503 5.5.0 : 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= to= proto=ESMTP helo= #TDsdN reject: RCPT from unk[10.0.0.1]: 450 Client host rejected: cannot find your hostname, [10.0.0.1]; from= to= proto=ESMTP helo= #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= to= proto=ESMTP helo= #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= to= proto=ESMTP helo= #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= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 454 4.7.1 : Helo command rejected: Access denied; from= to= proto=SMTP helo= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 454 4.7.1 : Helo command rejected: Access denied; from= to= proto=SMTP helo= #TDsdN reject: EHLO from host[10.0.0.1]: 504 5.5.2 : Helo command rejected: need fully-qualified hostname; proto=SMTP helo= #TDsdQ reject: DATA from host[10.0.0.1]: 550 5.5.3 : Data command rejected: Multi-recipient bounce; from=<> proto=ESMTP helo= #TDsdN reject: ETRN from host[10.0.0.1]: 554 5.7.1 : Etrn command rejected: Access denied; proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 452 Insufficient system storage; from= to= #TDsdN reject_warning: RCPT from host[10.0.0.1]: 451 4.3.5 Server configuration error; from= to= proto=ESMTP helo= #TDsdN reject: RCPT from host[10.0.0.1]: 450 Server configuration problem; from= to= proto=ESMTP helo= #TDsdN reject: MAIL from host[10.0.0.1]: 552 Message size exceeds fixed limit; proto=ESMTP helo= #TDsdN reject: RCPT from unknown[10.0.0.1]: 554 5.7.1 : Unverified Client host rejected: Access denied; from= to= proto=SMTP helo= # reject, reject_warning if ($action =~ /^reject/o) { my ($recip); if ($p2 !~ /^($re_DSN) (.*)$/o) { inc_unmatched('reject1'); next; } ($dsn,$p2) = ($1,$2); #print "dsn: $dsn, p2: \"$p2\"\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 ($stage eq 'VRFY') { my $trigger; if (($trigger,$reason) = ($p2 =~ /^(?:<(\S*)>: )?(.*);$/o )) { $Totals{$reject_name = "${rej_type}rejectverify" }++; next unless ($Collecting{$reject_name}); if ($reason =~ /^Service unavailable; Client host \[$re_IP\] (blocked using [^;]*);/o) { $reason = 'Client host blocked using ' . $1; $trigger = ''; } $Counts{$reject_name}{$reason}{$fmthost}{ucfirst($trigger)}++; } else { inc_unmatched('vrfyfrom'); } next; } #print "p2: $p2\n"; # XXX there may be several semicolon-separated messages # Recipient address rejected: Unknown users and via check_recipient_access if ( ($recip,$reason) = ($p2 =~ /^<(.*)>: Recipient address rejected: ([^;]*);/o )) { # Unknown users; local mailbox, alias, virtual, relay user, unspecified my ($localpart, $domainpart) = split (/@/, lc $recip); ($localpart, $domainpart) = ($recip, '*unspecified') if ($domainpart eq ''); if (($reason) =~ s/^User unknown *//o) { $Totals{$reject_name = "${rej_type}rejectunknownuser" }++; next unless ($Collecting{$reject_name}); my ($table) = ($reason =~ /^in ((?:\w+ )+table)/o); $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}o) { $reason = 'SPF reject'; } elsif ($reason =~ /^undeliverable address: host ([^[]+)\[($re_IP)\](?::\d+)? said:/o) { $reason = 'undeliverable address: remote host rejected recipient'; } $Counts{$reject_name}{ucfirst($reason)}{$domainpart}{$localpart}{$fmthost}++; } } elsif ($p2 =~ /^<([^ ]*)>.* Relay access denied/o ) { $Totals{$reject_name = "${rej_type}rejectrelay" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{$fmthost}{$eto}++; } elsif (($from,$reason) = ($p2 =~ /^<(.*)>: Sender address rejected: (.*);/o)) { $Totals{$reject_name = "${rej_type}rejectsender" }++; next unless ($Collecting{$reject_name}); if ($reason =~ /^undeliverable address: host ([^[]+)\[($re_IP)\](?::\d+)? said:/o) { $reason = 'undeliverable address: remote host rejected sender'; } $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$from ne '' ? $from : '<>'}++; } elsif (($reason) = ($p2 =~ /^(?:<.*>: )?Unverified Client host rejected: (.*)$/o)) { # 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 (($reason) = ($p2 =~ /^(?:<.*>: )?Client host rejected: (.*)$/o)) { # reject_unknown_client # client IP->name mapping fails # name->IP mapping fails # name->IP mapping =! client IP if ($reason =~ /^cannot find your hostname/o) { $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 ($reason =~ /^cannot find your reverse hostname/o) { $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}); $reason =~ s/;$//o; $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$eto}{$efrom}++; } } elsif (($site,$reason) = ($p2 =~ /^Service (?:unavailable|denied); (?:Client host |Sender address )?\[[^ ]*\] blocked using ([^ ]*)(, reason: .*)?;/o)) { # Note: similar code below: search RejectRBL $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{$site}{$fmthost}{$reason ? $reason : ''}++; } elsif (($reason) = ($p2 =~ /^<.*>: Helo command rejected: (.*);$/o)) { $Totals{$reject_name = "${rej_type}rejecthelo" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$helo}++; } elsif (($reason) = ($p2 =~ /^<.*>: Etrn command rejected: (.*);$/o)) { $Totals{$reject_name = "${rej_type}rejectetrn" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{ucfirst($reason)}{$fmthost}{$helo}++; } elsif (($reason) = ($p2 =~ /^<.*>: Data command rejected: (.*);$/o)) { $Totals{$reject_name = "${rej_type}rejectdata" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{$reason}{$fmthost}{$helo}++; } elsif ($p2 =~ /^Insufficient system storage;/o) { $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 ($p2 =~ /^Server configuration (?:error|problem);/o) { $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 ($p2 =~ /^Message size exceeds fixed limit;$/o) { # 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}++; # 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) = ($p2 =~ /^([^;]+);/o)) { # $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= to= proto=ESMTP helo= #TDsdN warn: RCPT from host[10.0.0.1]: ; from= to= proto=ESMTP helo= #TDsdN discard: RCPT from host[10.0.0.1]: : Sender address TEST DISCARD action; from= to= proto=ESMTP helo= #TDsdN discard: RCPT from host[10.0.0.1]: : Client host TEST DISCARD action w/ip(client_checks); from= to= proto=ESMTP helo= #TDsdN discard: RCPT from host[10.0.0.1]: : Unverified Client host triggers DISCARD action; from= to= proto=ESMTP helo=<10.0.0.1> #TDsdN hold: RCPT from host[10.0.0.1]: : Recipient address triggers HOLD action; from= to= proto=SMTP helo=<10.0.0.1> #TDsdN hold: RCPT from host[10.0.0.1]: : Helo command optional text...; from= to= proto=ESMTP helo= #TDsdN hold: RCPT from host[10.0.0.1]: : Helo command triggers HOLD action; from= to= proto=ESMTP helo= #TDsdN hold: DATA from host[10.0.0.1]: : Helo command triggers HOLD action; from= to= proto=ESMTP helo= #TDsdN filter: RCPT from host[10.0.0.1]: <>: Sender address triggers FILTER filter:somefilter; from=<> to= proto=SMTP helo= #TDsdN filter: RCPT from host[10.0.0.1]: : Recipient address triggers FILTER smtp-amavis:[127.0.0.1]:10024; from= to= proto=SMTP helo= #TDsdN redirect: RCPT from host[10.0.0.1]: : Client host triggers REDIRECT root@localhost; from= to= proto=SMTP helo= #TDsdN redirect: RCPT from host[10.0.0.1]: : Recipient address triggers REDIRECT root@localhost; from= to= proto=ESMTP helo= # $re_QID: discard, filter, hold, redirect, warn ... else { my $trigger; ($trigger,$reason) = ($p2 =~ /^(?:<(\S*)>: )?(.*);$/o ); 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|triggers |optional text... my ($subject, $text) = ($reason =~ /^((?:Recipient|Sender) address|(?:Unverified )?Client host|Client certificate|(?:Helo|Etrn|Data) command|End-of-data) (.+)$/o); #printf "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 //o; 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 //o; # 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... } else { die "Unexpected ACTION: '$action'"; } } } elsif ($p2 =~ /^client=(([^ ]*)\[([^ ]*)\](?::(?:\d+|unknown))?)(?:, (.*))?$/o) { my ($hip,$host,$hostip,$p3) = ($1,$2,$3,$4); # 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 #TDsdQ 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= next if ($p3 eq ''); my ($method,$user,$sender) = ($p3 =~ /^(?:sasl_method=([^,]+),?)?(?: sasl_username=([^,]+),?)?(?: sasl_sender=<([^>]*)>)?$/o); # 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) { $Totals{'saslauthrelay'}++; next unless ($Collecting{'saslauthrelay'}); $Counts{'saslauthrelay'}{$user ne '' ? "$sender ($user)" : "$sender (*unknown)"}{$method ne '' ? $method : '*unknown'}{formathost($hostip,$host)}++; } elsif ($method or $user) { $Totals{'saslauth'}++; next unless ($Collecting{'saslauth'}); $Counts{'saslauth'}{$user ne '' ? $user : '*unknown'}{$method ne '' ? $method : '*unknown'}{formathost($hostip,$host)}{$sender}++; } } # ^$re_QID: ... (not access(5) action) elsif ($p2 =~ /^from=<([^,]*)>, size=(\d+), nrcpt=(\d+).*$/o) { my ($efrom,$bytes,$nrcpt) = ($1,$2,$3); #TD 4AEFAF569C11: from=, size=4051, nrcpt=1 (queue active) #TD12 2A535C2E01: from=, size=25302, nrcpt=2 (queue active) #TD F0EC9BBE2: from=, size=5529, 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 (($to,$origto,$relay,$DDD,$status,$reason) = ($p2 =~ /^to=(<[^>]*>),(?: orig_to=(<[^>]*>),)? relay=([^,]*).*, ($re_DDD), status=(\S+) (.*)$/o)) { my ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$relay,$DDD,$status,$reason); #TD 552B6C20E: to=, 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=, 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=, orig_to=, relay=mail.example.net[2001:dead:beef::1], delay=2, status=sent (250 Ok: queued as 5221227246) ### sent if ($status eq 'sent') { # Increment bytes accepted on the first qmgr "from=..." line if ($reason =~ /forwarded as /o) { $Totals{'bytesforwarded'} += $SizeByQid{$qid} if (exists $SizeByQid{$qid}); $Totals{'forwarded'}++; next unless ($Collecting{'forwarded'}); $Counts{'forwarded'}{$domainpart}{$localpart}{$origto}++; } else { if ($postfix_svc eq 'lmtp') { $Totals{'bytessentlmtp'} += $SizeByQid{$qid} if (exists $SizeByQid{$qid}); $Totals{'sentlmtp'}++; next unless ($Collecting{'sentlmtp'}); $Counts{'sentlmtp'}{$domainpart}{$localpart}{$origto}++; } elsif ($postfix_svc 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}++; } } } ### bounced elsif ($status eq 'bounced' or $status eq 'SOFTBOUNCE') { # local agent #TDlQ to=, 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=, orig_to=, 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=, 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=, orig_to=, 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=, 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=, 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=, orig_to=, relay=none, delay=1, status=bounced (User unknown in virtual alias table) #TD EB0B8770: to=, orig_to=, relay=sample.net[192.168.0.1], delay=1.1, status=bounced (User unknown in relay recipient table) #TD D8962E54: to=, 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=, orig_to=, 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=, relay=local, delay=2, status=SOFTBOUNCE (host sample.net[192.168.0.1] said: 450 : User unknown in local recipient table (in reply to RCPT TO command)) #TD 04B0702E: to=, 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=, 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=, 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 , Recipient unknown (in reply to RCPT TO command)) #TD 88B7A079: to=, 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=, 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 User unknown; rejecting (in reply to RCPT TO command)) #TDpQ to=, 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|avcheck|maildrop|127\.0\.0\.1)/o) { $Totals{'bouncelocal'}++; next unless ($Collecting{'bouncelocal'}); $Counts{'bouncelocal'}{get_dsn_msg($dsn)}{$domainpart}{ucfirst($reason)}{$localpart}++; } else { $Totals{'bounceremote'}++; next unless ($Collecting{'bounceremote'}); ($reply,$fmthost) = cleanhostreply($reason,$relay,$to,$domainpart); $Counts{'bounceremote'}{get_dsn_msg($dsn)}{$domainpart}{$localpart}{$fmthost}{$reply}++; } } elsif ($status eq 'deferred') { #TD DD4F2AC4D3: to=, 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) #TD E52A1F1B52: to=, relay=none, delay=141602, status=deferred (connect to mx1.example.com[10.0.0.1]: Connection refused) #TD E52A1F1B52: to=, relay=none, delay=141602, status=deferred (delivery temporarily suspended: connect to example.com[192.168.0.1]: Connection refused) #TD DB775D7035: to=, 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) #TD EEDC1F1AA6: to=, 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) #TD 8E7A0575C3: to=, 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) #TD 7CF61B7030: to=, 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) #TD B8BF0AE331: to=, orig_to=, 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? #TD 232EAC2E55: to=, 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 : Recipient address rejected: Greylisted (in reply to RCPT TO command)) #TD 11677B700D: to=, 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 : User unknown in local recipient table (in reply to RCPT TO command)) #TD 0DA72B7035: to=, 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 : Recipient address rejected: undeliverable address: User unknown in virtual alias table (in reply to RCPT TO command)) ($reply,$fmthost) = cleanhostreply($reason,$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}++; } elsif ($status eq 'undeliverable') { #TD B54D220BFC: to=, 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) #TD 8F699C2EA6: to=, relay=virtual, delay=0.14, delays=0.06/0/0/0.08, dsn=5.1.1, status=undeliverable (unknown user: "u@example.com") $Totals{'undeliverable'}++; next unless ($Collecting{'undeliverable'}); $Counts{'undeliverable'}{$reason}{$origto ? "$to ($origto)" : $to}++; } elsif ($status eq 'deliverable') { # address verification, sendmail -bv deliverable reports #TD ED862C2EA6: to=, 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'}); $Counts{'deliverable'}{$reason}{$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 ($p2 =~ /^(uid=\S* from=<\S*>)/o) { #TDp2 1DFE2C2E18: uid=0 from= $AcceptedByQid{$qid} = $1; $Totals{'msgsaccepted'}++; } elsif ($p2 =~ /^from=<(\S*)>, status=expired, returned to sender$/o) { #TDqQ from=, status=expired, returned to sender $Totals{'returnedtosender'}++; next unless ($Collecting{'returnedtosender'}); $Counts{'returnedtosender'}{$1 ne '' ? $1 : '<>'}++; } elsif (($host,$hostip,$reason) = ($p2 =~ /^host ([^[]+)\[($re_IP)\](?::\d+)? refused to talk to me: (.*)$/o)) { #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($hostip,$host)}{$reason}++; } elsif (($host,$hostip,$reason) = ($p2 =~ /^lost connection with ([^[]*)\[($re_IP)\](?::\d+)? (while .*)$/o )) { # 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'}{"\u$reason"}{formathost($hostip,$host)}++; } elsif (($host,$hostip,$reason) = ($p2 =~ /^conversation with ([^[]*)\[($re_IP)\](?::\d+)? timed out (while .*)$/o )) { #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($reason)}{formathost($hostip,$host)}++; } elsif ($p2 =~ /^removed\s*$/o ) { # 52CBDC2E0F: removed delete $SizeByQid{$qid} if (exists $SizeByQid{$qid}); $Totals{'removedfromqueue'}++; } elsif (($type, $host, $hostip) = ($p2 =~ /^enabling PIX (\.) workaround for ([^[]+)\[($re_IP)\](?::\d+)?/o) or ($type, $host, $hostip) = ($p2 =~ /^enabling PIX workarounds: (.*) for ([^[]+)\[($re_IP)\](?::\d+)?/o)) { #TDsQ enabling PIX . workaround for example.com[192.168.0.1] #TDsQ enabling PIX . 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'}{$type}{formathost($hostip,$host)}++; } elsif (($cmd,$host,$hostip,$dsn,$reason,$p3) = ($p2 =~ /^milter-reject: (\S+) from ([^[]+)\[($re_IP)\](?::\d+)?: ($re_DSN) ([^;]+); (.*)$/o)) { #TD NOQUEUE: milter-reject: MAIL from example.com[192.168.0.1]: 553 5.1.7 address incomplete; proto=ESMTP helo= #TD NOQUEUE: milter-reject: CONNECT from sample.net[10.0.0.1]: 451 4.7.1 Service unavailable - try again later; proto=SMTP #TD C569C12: milter-reject: END-OF-MESSAGE from sample.net[10.0.0.1]: 5.7.1 black listed URL host sample.com by .black.uribl.com; from= to= proto=ESMTP helo= # Note: reject_warning does not seem to occur $Totals{$reject_name = get_reject_key($dsn) . 'rejectmilter' }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{$cmd}{formathost($hostip,$host)}{$reason}++; } else { # keep this as the last condition in this else clause inc_unmatched('unknownqid'); } } # end of $re_QID section elsif (($reason,$bytes,$host,$hostip) = ($p1 =~ /lost connection (after [^ ]+)(?: \((\d+) bytes\))? from ([^[]*)\[($re_IP|unknown)\](?::\d+)?$/o)) { # smtpd #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] $Totals{'connectionlostinbound'}++; next unless ($Collecting{'connectionlostinbound'}); $Counts{'connectionlostinbound'}{ucfirst($reason)}{formathost($hostip,$host)}{commify($bytes)}++; } elsif ($postfix_svc eq 'postsuper') { if ($p1 =~ /^Placed on hold: (\d+) messages?$/o) { #TDps Placed on hold: 2 messages # Note: See Hold elsewhere $Totals{'hold'} += $1; next unless ($Collecting{'hold'}); $Counts{'hold'}{'Postsuper'}{'localhost'}{"bulk hold: $1"}{''} += $1; } elsif ($p1 =~ /^Released from hold: (\d+) messages?$/o) { #TDps Released from hold: 1 message $Totals{'releasedfromhold'} += $1; } elsif ($p1 =~ /^Requeued: (\d+) messages?$/o) { #TDps Requeued: 1 message $Totals{'requeued'} += $1; } else { inc_unmatched('postsuper'); } } # see also TimeoutInbound in $re_QID section elsif (($reason,$host,$hostip) = ($p1 =~ /^timeout (after [^ ]*)(?: \(\d+ bytes\))? from ([^[]*)\[($re_IP)\](?::\d+)?$/o)) { #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)}++; } elsif ($p1 =~ /^(reject(?:_warning)?): RCPT from ([^[]+)\[($re_IP)\](?::\d+)?: ($re_DSN) Service unavailable; (?:Client host |Sender address )?\[[^ ]*\] blocked using ([^ ]*)(?:, reason: (.*))?;/o) { my ($rej_type,$host,$hostip,$dsn,$site,$reason) = ($1,$2,$3,$4,$5,$6); $rej_type = ($rej_type =~ /_warning/ ? 'warn' : get_reject_key($dsn)); #print "REJECT RBL NOQ: '$rej_type'\n"; # Note: similar code above: search RejectRBL # postfix doesn't always log QID. Also, "reason:" was probably always present in this case, but I'm not certain #TD reject: 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= to= #TD 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= to= $Totals{$reject_name = "${rej_type}rejectrbl" }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{$site}{formathost($hostip,$host)}{$reason ? $reason : ''}++; } ### smtpd_tls_loglevel >= 1 # Server TLS messages elsif (($status,$host,$hostip,$type) = ($p1 =~ /^(?:(Anonymous|Trusted|Untrusted) )?TLS connection established from ([^[]+)\[($re_IP)\](?::\d+)?: (.*)$/o)) { #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) )?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}++; } elsif (($cmd,$host,$hostip) = ($p1 =~ /^too many errors after ([^ ]*)(?: \(\d+ bytes\))? from ([^[]*)\[($re_IP)\](?::\d+)?$/o)) { #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{'toomanyerrors'}++; next unless ($Collecting{'toomanyerrors'}); $Counts{'toomanyerrors'}{"After $cmd"}{formathost($hostip,$host)}++; } # Note: no QID elsif (($host,$hostip,$dsn,$from,$to) = ($p1 =~ /^reject: RCPT from ([^[]+)\[($re_IP)\](?::\d+)?: ([45]52) Message size exceeds fixed limit; from=<([^>]*)> to=<([^>]+)>/o)) { #TD reject: RCPT from example.com[192.168.0.1]: 452 Message size exceeds fixed limit; from= to= #TD reject: RCPT from example.com[192.168.0.1]: 552 Message size exceeds fixed limit; from= to= proto=ESMTP helo= # Note: similar code above: search RejectSize # Note: reject_warning does not seem to occur $Totals{$reject_name = get_reject_key($dsn) . 'rejectsize' }++; next unless ($Collecting{$reject_name}); $Counts{$reject_name}{formathost($hostip,$host)}{$to}{$from ne '' ? $from : '<>'}++; } elsif ($p1 =~ /looking for plugins in (.*)$/o) { #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}++; } # coerce these into general warnings elsif ( $p1 =~ /^cannot load Certificate Authority data/o or $p1 =~ /^SSL_connect error to /o) { #TDsQ Cannot start TLS: handshake failure #TDsd cannot load Certificate Authority data #TDs SSL_connect error to mail.example.com: 0 postfix_warning($p1); } # Ignore rare messages (mostly debug) hit less frequently - keep far down the if-elsif chain # be sure anything placed here will not match any cases above elsif (( $p1 =~ /^statistics:/o) or ( $p1 =~ /^[<>]+ /o) or ( $p1 =~ /^premature end-of-input (?:on|from) .* socket while reading input attribute name$/o) or ( $p1 =~ /^Peer certi?ficate could not be verified$/o) # missing i was a postfix typo or ( $p1 =~ /^Peer verification:/o) or ( $p1 =~ /^initializing the server-side TLS/o) or ( $p1 =~ /^tlsmgr_cache_run_event/o) or ( $p1 =~ /^SSL_accept/o) or ( $p1 =~ /^SSL_connect:/o) or ( $p1 =~ /^connection (?:closed|established)/o) or ( $p1 =~ /^delete smtpd session/o) or ( $p1 =~ /^put smtpd session/o) or ( $p1 =~ /^save session/o) or ( $p1 =~ /^Reusing old/o) or ( $p1 =~ /^looking up session/o) or ( $p1 =~ /^lookup smtpd session/o) or ( $p1 =~ /^lookup \S+ type/o) or ( $p1 =~ /^xsasl_cyrus_server_/o) or ( $p1 =~ /^watchdog_/o) or ( $p1 =~ /^read smtpd TLS/o) or ( $p1 =~ /^open smtpd TLS/o) or ( $p1 =~ /^write smtpd TLS/o) or ( $p1 =~ /^auto_clnt_/o) or ( $p1 =~ /^Verified: /o) or ( $p1 =~ /^generic_checks:/o) or ( $p1 =~ /^inet_addr_/o) or ( $p1 =~ /^mac_parse:/o) or ( $p1 =~ /^cert has expired/o) or ( $p1 =~ /^daemon started/o) or ( $p1 =~ /^master_notify:/o) or ( $p1 =~ /^rewrite_clnt:/o) or ( $p1 =~ /^dict_/o) or ( $p1 =~ /^send attr /o) or ( $p1 =~ /^match_/o) or ( $p1 =~ /^smtpd_check_/o) or ( $p1 =~ /^input attribute /o) or ( $p1 =~ /^Run-time/o) or ( $p1 =~ /^Compiled against/o) or ( $p1 =~ /^private\//o) or ( $p1 =~ /^reject_unknown_/o) # don't combine or shorten these reject_ patterns or ( $p1 =~ /^reject_unauth_/o) or ( $p1 =~ /^reject_non_/o) or ( $p1 =~ /^permit_/o) or ( $p1 =~ /^idle timeout/o) or ( $p1 =~ /^get_dns_/o) or ( $p1 =~ /^dns_/o) or ( $p1 =~ /^chroot /o) or ( $p1 =~ /^process generation/o) or ( $p1 =~ /^rewrite stream/o) or ( $p1 =~ /^fsspace:/o) or ( $p1 =~ /^master disconnect/o) or ( $p1 =~ /^resolve_clnt/o) or ( $p1 =~ /^ctable_/o) or ( $p1 =~ /^extract_addr/o) or ( $p1 =~ /^mynetworks:/o) or ( $p1 =~ /^name_mask:/o) or ( $p1 =~ /^reload configuration/o) or ( $p1 =~ /^setting up TLS connection (?:from|to)/o) or ( $p1 =~ /^starting TLS engine$/o) or ( $p1 =~ /^terminating on signal 15$/o) or ( $p1 =~ /^verify error:num=/o) or ( $p1 =~ /^nss_ldap: reconnected to LDAP/o) or ( $p1 =~ /^discarding EHLO keywords: /o) or ( $p1 =~ /^sql auxprop plugin/o) or ( $p1 =~ /^sql plugin/o) or ( $p1 =~ /^commit transaction/o) or ( $p1 =~ /^begin transaction/o) or ( $p1 =~ /^maps_find: /o) or ( $p1 =~ /^check_access: /o) or ( $p1 =~ /^check_domain_access: /o) or ( $p1 =~ /^check_mail_access: /o) or ( $p1 =~ /^check_table_result: /o) or ( $p1 =~ /^mail_addr_find: /o) or ( $p1 =~ /^smtp_get: /o) or ( $p1 =~ /^been_here: /o) or ( $p1 =~ /^set_eugid: /o) or ( $p1 =~ /^deliver_/o) or ( $p1 =~ /^flush_send_file: queue_id/o) or ( $p1 =~ /^milter_macro_lookup/o) or ( $p1 =~ /^milter8/o) or ( $p1 =~ /^skipping non-protocol event/o) or ( $p1 =~ /^reply: /o) or ( $p1 =~ /^event: /o) or ( $p1 =~ /^trying... /o) or ( $p1 =~ / all milters$/o) or ( $p1 =~ /^vstream_/o) or ( $p1 =~ /^server features/o) or ( $p1 =~ /^skipping event/o) or ( $p1 =~ /^Using /o) or ( $p1 =~ /^rec_put: /o) or ( $p1 =~ /^smtpd_chat_notify: /o) or ( $p1 =~ /^subject=/o) or ( $p1 =~ /^issuer=/o) or ( $p1 =~ /^proxymap stream/o) or ( $p1 =~ /^Write \d+ chars/o) or ( $p1 =~ /^Read \d+ chars/o) or ( $p1 =~ /^read smtp TLS cache entry/o) or ( $p1 =~ /^(?:lookup|delete) smtp session/o) or ( $p1 =~ /^delete smtp session/o) or ( $p1 =~ /^(?:reloaded|remove|looking for) session .* cache$/o) or ( $p1 =~ /^reloaded session .* from \w+ cache$/o) # non-anchored or ( $p1 =~ /re-using session with untrusted certificate, look for details earlier in the log$/o) or ( $p1 =~ /socket: wanted attribute: /o) or ( $p1 =~ /save session.*to smtpd cache/o) or ( $p1 =~ /fingerprint=/o) or ( $p1 =~ /TLS cipher list "/o) or ( $p1 =~ /(?:before|after) input_transp_cleanup: /o)) { next; } # last case catches all unforeseen messages else { inc_unmatched('final'); } } ######################################## # 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 (!exists $Opts{'nosummary'}) { for (keys %Totals) { if ($Totals{$_}) { print_summary_report (@Sections); last; } } } # Print the Detail report, if detail is sufficiently high # if ($Opts{'detail'} >= 5) { print_detail_report(@Sections); print_delays_report(); } # Finally, print any unmatched lines # print_unmatched_report(); ################################################## # Accepts common fields from a standard delivery attempt, processing then # and returning modified values # sub process_delivery_attempt ($ $ $ $ $ $) { my ($to,$origto,$relay,$DDD,$status,$reason) = @_; $reason =~ s/\((.*)\)/$1/; # Makes capturing nested parens easier $to =~ s/^<(.*)>$/$1/g unless ($to eq '<>'); $origto =~ s/^<(.*)>$/$1/g unless ($origto eq '<>'); $to = lc $to; $origto = 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$/oi)) { my ($user,$extension) = split (/$Opts{'recipient_delimiter'}/o, $localpart, 2); $origto = $localpart if ($origto eq ''); $localpart = $user; } } unless (($dsn) = ($DDD =~ /dsn=(\d\.\d+\.\d+)/o)) { $dsn = ''; } if ($Collecting{'delays'} and $DDD =~ m{delays=([\d.]+)/([\d.]+)/([\d.]+)/([\d.]+)}o) { # 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. push @{$Delays{'1: Pre qmgr'}}, $1; push @{$Delays{'2: In qmgr'}}, $2; push @{$Delays{'3: Connection setup'}}, $3; push @{$Delays{'4: Xmit time'}}, $4; } 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 delay notification: /o) { #TDbQ sender delay notification: AA61EC2F9A $type = 'Delayed'; } else { inc_unmatched('bounce'); return; } $Totals{'notificationsent'}++; return unless ($Collecting{'notificationsent'}); $Counts{'notificationsent'}{$type}++; } # 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 ); return if ($line =~ /^message-id=/o); #TDcQ message-id= # cleanup's reject-milter if ( $line =~ /^milter-reject: (\S+) from ([^[]+)\[($re_IP)\](?::\d+)?: ($re_DSN) ([^;]+); /o ) { my ($cmd,$host,$hostip,$dsn,$reason) = ($1,$2,$3,$4,$5); #TDcQ milter-reject: END-OF-MESSAGE from example.com[10.0.0.1]: 5.7.1 Some problem; from= to= proto=SMTP helo= #TDcQ milter-reject: CONNECT from example.com[10.0.0.1]: 5.7.1 Some problem; proto=SMTP # 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}{$cmd}{formathost($hostip,$host)}{$reason}++; } elsif ( ($line =~ /^resent-message-id=?$/o )) { #TDcQ resent-message-id=4739073.1 #TDcQ resent-message-id= #TDcQ resent-message-id=? <120B11@samplepc> $Totals{'resent'}++; } # header_checks & body_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 elsif ( $line =~ /^(reject|filter|hold|redirect|discard|prepend|replace|warning): (header|body) (.*)$/o ) { my ($action,$class,$p3) = ($1,$2,$3); #print "Cleanup: action: \"$action\", class: \"$class\", p3: \"$p3\"\n"; # $re_QID: reject: body ... # $re_QID: reject: header ... if ( $p3 =~ /^(.*) from ([^;]+); from=<\S*>(?: to=<(\S*)>)?(?: proto=\S*)?(?: helo=<\S*>)?(?:: (.*)|$)/o ) { my ($trigger,$host,$eto,$p4) = ($1,$2,$3,$4); # $action $class $trigger $host $eto $p4 #TDcQ reject: body Subject: Cheap cialis from local; from=: optional text... #TDcQ reject: body Quality replica watches!!! from example.com[10.0.0.1]; from= to= proto=SMTP helo=: optional text... #TDcQ reject: header To: from example.com[10.0.0.1]; from= to= proto=ESMTP helo=: optional text... #TDcQ filter: header To: to@example.com from example.com[10.0.0.1]; from= to= proto=ESMTP helo=: transport:destination #TDcQ hold: header Message-ID: from localhost[127.0.0.1]; from= to= proto=ESMTP helo=: optional text... #TDcQ hold: header Subject: Hold Test from local; from= to=: optional text... #TDcQ hold: header Received: by example.com...from x from local; from= #TDcQ hold: header Received: from x.com (x.com[10.0.0.1])??by example.com (Postfix) with ESMTP id 630BF??for ; Thu, 20 Oct 2006 13:27: from example.com[10.0.0.1]; from= to= proto=ESMTP helo= # 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= proto=SMTP helo=: faked header #TDcQ redirect: header From: "Attn Men" from example.com[10.0.0.1]; from= to= proto=ESMTP helo=: user@domain #TDcQ redirect: header From: "Superman" from example.com[10.0.0.2]; from= to= proto=ESMTP helo=: user@domain #TDcQ redirect: body Original drugs from example.com[10.0.0.1]; from= to= proto=SMTP helo=: user@domain #TDcQ discard: header Subject: **SPAM** Blah... from example.com[10.0.0.1]; from= to= proto=ESMTP helo= #TDcQ prepend: header Rubble: Mr. from localhost[127.0.0.1]; from= to= proto=ESMTP helo=: text... #TDcQ replace: header Rubble: flintstone from localhost[127.0.0.1]; from= to= proto=ESMTP helo=: text... #TDcQ warning: header Date: Tues, 99:34:67 from localhost[127.0.0.1]; from= to= proto=ESMTP helo=: optional text... # Note: reject_warning does not seem to occur #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 ($class eq 'header') { ($trig = $trigger) =~ s/^([^:]+:).*$/Header check "$1"/; } else { $trig = "Body check"; } 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 =~ /([^[]+)\[($re_IP)\]/o) { $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' ) { # 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$class" }++; return unless ($Collecting{$reject_name}); $Counts{$reject_name}{$text}{$eto}{$fmthost}{$trigger}++; } elsif ( $action eq 'filter' ) { $Totals{'filtered'}++; return unless ($Collecting{'filtered'}); $Counts{'filtered'}{$text}{$trig}{$trigger}{$eto}{$fmthost}++; } elsif ( $action eq 'hold' ) { $Totals{'hold'}++; return unless ($Collecting{'hold'}); $Counts{'hold'}{$trig_opt}{$fmthost}{$eto}{$trigger}++; } elsif ( $action eq 'redirect' ) { $Totals{'redirected'}++; return unless ($Collecting{'redirected'}); $Counts{'redirected'}{$trig}{$text}{$eto}{$fmthost}{$trigger}++; } elsif ( $action eq 'discard' ) { $Totals{'discarded'}++; return unless ($Collecting{'discarded'}); $Counts{'discarded'}{$trig}{$fmthost}{$eto}{$trigger}++; } elsif ( $action eq 'prepend' ) { $Totals{'prepended'}++; return unless ($Collecting{'prepended'}); $Counts{'prepended'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++; } elsif ( $action eq 'replace' ) { $Totals{'replaced'}++; return unless ($Collecting{'replaced'}); $Counts{'replaced'}{"$trig ($text)"}{$fmthost}{$eto}{$trigger}++; } elsif ( $action eq 'warning' ) { $Totals{'warned'}++; return unless ($Collecting{'warned'}); $Counts{'warned'}{$trig}{$fmthost}{$eto}{$trigger}++; } else { die ("Unexpected cleanup command \"$action\": end of cleanup checks\n"); } } else { inc_unmatched('cleanup1'); } } ### cleanup bounced messages (always_bcc, recipient_bcc_maps, sender_bcc_maps) elsif (my ($to,$origto,$relay,$DDD,$status,$reason) = ($line =~ /^to=<(\S*)>,(?: orig_to=<(\S*)>,)? relay=([^,]*).*, ($re_DDD), status=([^ ]+) (.*)$/o)) { # Note: Bounce # See same code elsewhere "Note: Bounce" #TDcQ to=, relay=none, delay=0.11, delays=0.11/0/0/0, dsn=5.7.1, status=bounced optional text... #TDcQ to=, orig_to=, relay=none, delay=0.13, delays=0.13/0/0/0, dsn=5.7.1, status=bounced optional text... if ($status ne 'bounced' and $status ne 'SOFTBOUNCE') { inc_unmatched('cleanupbounce'); return; } my ($to,$origto,$localpart,$domainpart,$dsn,$reason) = process_delivery_attempt ($to,$origto,$relay,$DDD,$status,$reason); ### local bounce # XXX local v. remote bounce seems iffy, relative if ($relay =~ /^(?:none|local|virtual|avcheck|maildrop|127\.0\.0\.1)/o) { $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}++; } } elsif ($line =~ /^unable to dlopen /) { #TDcN unable to dlopen /usr/lib/sasl2/libplain.so.2: /usr/lib/sasl2/libplain.so.2: failed to map segment from shared object: Operation not permitted # strip extraneous doubling of library path $line = "$1$2 $3" if ($line =~ /(unable to dlopen )([^:]+: )\2(.+)$/); postfix_warning($line); } else { inc_unmatched('cleanup2'); } } 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 = $Totals{'fatalerror'}++; return unless ($Collecting{'fatalerror'}); $Counts{'fatalerror'}{ucfirst($reason)}++; } } 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: )?($re_IP): hostname ([^ ]+) verification failed: (.*)$/o) or ($hostip,$reason,$host) = ($warning =~ /^(?:smtpd_peer_init: )?($re_IP): (address not listed for hostname) (.*)$/o)) { #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 $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 (($domain,$reason) = ($warning =~ /^malformed domain name in resource data of MX record for (.*):(.*)?$/o)) { #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 $Totals{'mxerror'}++; return unless ($Collecting{'mxerror'}); $Counts{'mxerror'}{'Malformed domain name in resource data of MX record'}{$domain}{$reason eq '' ? '*unknown' : $reason}++; } elsif (($host,$reason) = ($warning =~ /^Unable to look up MX host for ([^:]*): (.*)$/o)) { #TDsd warning: Unable to look up MX host for example.com: Host not found $Totals{'mxerror'}++; return unless ($Collecting{'mxerror'}); $reason = 'Host not found' if ($reason =~ /^Host not found, try again/o); $Counts{'mxerror'}{'Unable to look up MX host'}{ucfirst($reason)}{$host}++; } elsif (($host,$to,$reason2) = ($warning =~ /^Unable to look up MX host (.*) for Sender address ([^:]*): (.*)$/o)) { #TDsd warning: Unable to look up MX host mail.example.com for Sender address from@example.com: hostname nor servname provided, or not known $Totals{'mxerror'}++; return unless ($Collecting{'mxerror'}); $reason2 = 'Host not found' if ($reason2 =~ /^Host not found, try again/o); #my ($name, $domain) = split ('@', lc($to)); $Counts{'mxerror'}{'Unable to look up MX host for sender address'}{ucfirst($reason2)}{"$host: $to"}++; } elsif (($domain) = ($warning =~ /^no MX host for (.*) has a valid address record$/o)) { #TDs warning: no MX host for example.com has a valid address record $Totals{'mxerror'}++; return unless ($Collecting{'mxerror'}); $Counts{'mxerror'}{'No MX host has a valid address record'}{$domain}{''}++; } elsif ( ($host,$hostip,$port,$type,$reason) = ($warning =~ /^([^[]+)\[($re_IP)\](?::(\d+))? (sent \w+ header instead of SMTP command): (.*)$/o) or ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(non-E?SMTP command) from ([^[]+)\[($re_IP)\](?::(\d+))?: (.*)$/o) or ($type,$host,$hostip,$port,$reason) = ($warning =~ /^(?:$re_QID: )?(non-E?SMTP response) from ([^[]+)\[($re_IP)\](?::(\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) = ($warning =~ /^([^[]+)\[($re_IP)\](?::\d+)?: SASL (.*) authentication failed/o)) { #TD warning: example.com[192.168.0.1]: SASL DIGEST-MD5 authentication failed $Totals{'saslauthfail'}++; return unless ($Collecting{'saslauthfail'}); $Counts{'saslauthfail'}{formathost($hostip,$host)}{$type}++; } elsif (($host,$site,$reason) = ($warning =~ /^([^:]*): RBL lookup error:.* Name service error for (?:name=)?$re_IP\.([^:]*): (.*)$/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'}{$site}{$reason}{$host}++; } elsif ( ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[($re_IP)\](?::\d+)? (greeted me with my own hostname) ([^ ]*)$/o ) or ($host,$hostip,$reason,$helo) = ($warning =~ /^host ([^[]+)\[($re_IP)\](?::\d+)? (replied to HELO\/EHLO with my own hostname) ([^ ]*)$/o )) { #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 ( ($host,$hostip,$cmd,$addr) = ($warning =~ /^Illegal address syntax from ([^[]+)\[($re_IP)\](?::\d+)? in ([^ ]*) command: (.*)/o )) { #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 (($reason, $host) = ($warning =~ /^numeric (hostname): ($re_IP)$/o) or ($reason, $host) = ($warning =~ /^numeric domain name in (resource data of MX record) for (.*)$/o)) { #TD warning: numeric hostname: 192.168.0.1 #TD warning: numeric domain name in resource data of MX record for sample.com: 192.168.0.1 if (($host,$hostip) = ($host =~ /([^:]+): ($re_IP)/o)) { $host = formathost($hostip,$host); } $Totals{'numerichostname'}++; return unless ($Collecting{'numerichostname'}); $Counts{'numerichostname'}{ucfirst($reason)}{$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 (($size,$host,$hostip) = ($warning =~ /^bad size limit "([^"]+)" in EHLO reply from ([^[]+)\[($re_IP)\](?::\d+)?$/o)) { #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 (($type,$size,$host,$hostip,$service) = ($warning =~ /^Connection (concurrency|rate) limit exceeded: (\d+) from ([^[]+)\[($re_IP|unknown)\](?::\d+)? for service (.*)/o)) { #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 if ($type eq 'rate') { $Totals{'ratelimit'}++; return unless ($Collecting{'ratelimit'}); $Counts{'ratelimit'}{$service}{formathost($hostip,$host)}{$size}++; } else { $Totals{'concurrencylimit'}++; return unless ($Collecting{'concurrencylimit'}); $Counts{'concurrencylimit'}{$service}{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 { # These two messages follow ProcessLimit message above #TD warning: to avoid this condition, increase the process count in master.cf or reduce the service time per client #TD 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); #TD warning: No server certs available. TLS won't be enabled #TD warning: smtp_connect_addr: bind : Address already in use $Totals{'warningsother'}++; return unless ($Collecting{'warningsother'}); $Counts{'warningsother'}{$warning}++; } } # Process postfix/postfix-script entries # 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'}++; } else { inc_unmatched('postfix_script'); } } # Delivery delays percentiles report # sub print_delays_report() { if ($Opts{'delays'} and keys %Delays) { my @percents = split /[ ,]/, $Opts{'delays_percentiles'}; print "\n======================", "============" x @percents, "\n"; printf "%-22s" . " %10s%%" x @percents , "Delays Percentiles", @percents; print "\n----------------------", "------------" x @percents, "\n"; foreach (sort keys %Delays) { my @sorted = sort { $a <=> $b } @{$Delays{$_}}; my @p = get_percentiles (@sorted, @percents); printf "%-22s" . " %11.3f" x scalar (@p) . "\n", "$_", @p; } print "======================", "============" x @percents, "\n"; } } # Clean up a server's reply, to give some uniformity to reports # sub cleanhostreply($ $ $ $) { my ($hostreply,$relay,$recip,$domain) = @_; my $fmtdhost = ''; my ($r1, $r2, $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,$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/oi or $r1 =~ /^unknown user/oi or $r1 =~ /^unknown recipient address/oi or $r1 =~ /^invalid recipient/oi or $r1 =~ /^recipient unknown/oi or $r1 =~ /^sorry, no mailbox here by that name/oi or $r1 =~ /(?:no such user|user unknown)/oi) { #print "UNKNOWN RECIP: $r1\n"; $r1 = 'Unknown recipient'; } elsif ($r1 =~ /greylisted/oi) { #print "GREYLISTED RECIP: $r1\n"; $r1 = 'Recipient greylisted'; } } 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) { #print "HOSTREFUSED: $hostreply\n"; $host = $1; $r1 = join(': ', 'refused', $2); } elsif ($hostreply =~ /^(delivery temporarily suspended): connect to (\S+): (.*)$/o) { #print "DELIVERY SUSP: $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 =~ /([^[]+)\[($re_IP)\]/o) { $fmtdhost = formathost($2,$1); } else { $fmtdhost = '*unknown'; } } elsif ($host =~ /^([^[]+)\[($re_IP)\]/o) { $fmtdhost = formathost($2,$1); } else { $fmtdhost = $host; } return ("\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. # sub strip_ftph(\$) { #print "strip_ftph: \"${$_[0]}\"\n"; my ($helo, $proto, $to, $from) = ('*unavailable', '*unavailable', '*unavailable', '*unavailable'); $helo = $1 if (${$_[0]} =~ s/\s+helo=<([^>]+)>\s*$//o); $proto = $1 if (${$_[0]} =~ s/\s+proto=(\S+)\s*$//o); $to = lc($1) || '<>' if (${$_[0]} =~ s/\s+to=<(\S*)>\s*$//o); $from = $1 || '<>' if (${$_[0]} =~ s/\s+from=<(\S*)>\s*$//o); #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(); 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'); =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 } # Add a new section to the end of the Section table # sub add_section($;$$$$) { if (defined $_[3]) { my $entry = { NAME => $_[0], HASCOUNTS => $_[1], FMT => $_[2], TITLE => $_[3], }; $entry->{'DIVISOR'} = $_[4] if defined $_[4]; push @Sections, $entry; } else { push @Sections, $_[0]; } } # Builds the entire @Section table used for data collection # # Each Section entry has as many as five fields: # # 1: Key to %Counts, %Totals accumulator hashes, and %Collecting hash # 2: Does this key use a %Counts accumulator? # 3: Numeric output format specifier for Summary report # 4: Summary and Detail section title # 5: A hash to a divisor used to calculate the percentage of a total for that key # # Alternatively, when the NAME field contains a single character, this character # will cause a line filled with that character to be output, but only if there was # output for that section. # The special name '__SECTION' is used to indicate the beginning of a new section. # This ensures the printReports routine does not print needless horizontal lines. # # 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"; } # 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 # NAME, HASCOUNTS, FMT, TITLE, DIVISOR add_section ('__SECTION'); add_section ('panicerror', 1, 'd', '*Panic: General panic'); add_section ('fatalfiletoobig', 0, 'd', '*Fatal: Message file too big'); add_section ('fatalconfigerror', 1, 'd', '*Fatal: Configuration error'); add_section ('fatalerror', 1, 'd', '*Fatal: General fatal'); add_section ('processlimit', 1, 'd', '*Warning: Process limit reached, clients may delay'); add_section ('warnfiletoobig', 0, 'd', '*Warning: Queue file size limit exceeded'); add_section ('warninsufficientspace', 0, 'd', '*Warning: Insufficient system storage error'); add_section ('warnconfigerror', 1, 'd', '*Warning: Server configuration error'); add_section ('queuewriteerror', 1, 'd', '*Warning: Error writing queue file'); add_section ('messagewriteerror', 1, 'd', '*Warning: Error writing message file'); add_section ('databasegeneration', 1, 'd', '*Warning: Database file needs update'); add_section ('mailerloop', 1, 'd', '*Warning: Mailer loop'); add_section ('startuperror', 1, 'd', '*Warning: Startup error'); add_section ('mapproblem', 1, 'd', '*Warning: Map lookup problem'); add_section ('attrerror', 1, 'd', '*Warning: Error reading attribute data'); add_section ('concurrencylimit', 1, 'd', '*Warning: Connection concurrency limit reached'); add_section ('ratelimit', 1, 'd', '*Warning: Connection rate limit reached (anvil)'); add_section ('processexit', 1, 'd', 'Process exited'); add_section ('hold', 1, 'd', 'Placed on hold'); add_section ('communicationerror', 1, 'd', 'Postfix communications error'); add_section ('saslauthfail', 1, 'd', 'SASL authentication failed'); add_section ('ldaperror', 1, 'd', 'LDAP error'); add_section ('warningsother', 1, 'd', 'Miscellaneous warnings'); add_section ('totalrejectswarn', 0, 'd', 'Reject warnings (warn_if_reject)'); add_section ("\n"); add_section ('__SECTION'); add_section ('bytesaccepted', 0, 'Z', 'Bytes accepted '); # Z means print scaled as in 1k, 1m, etc. add_section ('bytessentsmtp', 0, 'Z', 'Bytes sent via SMTP'); add_section ('bytessentlmtp', 0, 'Z', 'Bytes sent via LMTP'); add_section ('bytesdelivered', 0, 'Z', 'Bytes delivered'); add_section ('bytesforwarded', 0, 'Z', 'Bytes forwarded'); add_section ('=' ); add_section ("\n"); add_section ('__SECTION'); add_section ('msgsaccepted', 0, 'd', 'Accepted', \$Totals{'totalacceptplusreject'}); add_section ('totalrejects', 0, 'd', 'Rejected', \$Totals{'totalacceptplusreject'}); add_section ('-'); add_section ('totalacceptplusreject', 0, 'd', 'Total', \$Totals{'totalacceptplusreject'}); add_section ('=',); add_section ("\n"); # 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; map { $_ =~ s/\./x/g } @RejectKeys; print "\tRejectPat: \"@RejectPats\", RejectKeys: \"@RejectKeys\"\n" if $Opts{'debug'} & Logreporters::D_SECT; 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; add_section ('__SECTION'); add_section ($key . 'rejectrelay', 1, 'd', $keyuc . ' Reject relay denied', $totalsref); add_section ($key . 'rejecthelo', 1, 'd', $keyuc . ' Reject HELO/EHLO', $totalsref); add_section ($key . 'rejectdata', 1, 'd', $keyuc . ' Reject DATA', $totalsref); add_section ($key . 'rejectunknownuser', 1, 'd', $keyuc . ' Reject unknown user', $totalsref); add_section ($key . 'rejectrecip', 1, 'd', $keyuc . ' Reject recipient address', $totalsref); add_section ($key . 'rejectsender', 1, 'd', $keyuc . ' Reject sender address', $totalsref); add_section ($key . 'rejectclient', 1, 'd', $keyuc . ' Reject client host', $totalsref); add_section ($key . 'rejectunknownclient', 1, 'd', $keyuc . ' Reject unknown client host', $totalsref); add_section ($key . 'rejectunknownreverseclient', 1, 'd', $keyuc . ' Reject unknown reverse client host', $totalsref); add_section ($key . 'rejectunverifiedclient', 1, 'd', $keyuc . ' Reject unverified client host', $totalsref); add_section ($key . 'rejectrbl', 1, 'd', $keyuc . ' Reject RBL', $totalsref); add_section ($key . 'rejectheader', 1, 'd', $keyuc . ' Reject header', $totalsref); add_section ($key . 'rejectbody', 1, 'd', $keyuc . ' Reject body', $totalsref); add_section ($key . 'rejectsize', 1, 'd', $keyuc . ' Reject message size', $totalsref); add_section ($key . 'rejectmilter', 1, 'd', $keyuc . ' Reject milter', $totalsref); add_section ($key . 'rejectinsufficientspace', 1, 'd', $keyuc . ' Reject insufficient space', $totalsref); add_section ($key . 'rejectconfigerror', 1, 'd', $keyuc . ' Reject server config error', $totalsref); add_section ($key . 'rejectverify', 1, 'd', $keyuc . ' Reject VRFY', $totalsref); add_section ($key . 'rejectetrn', 1, 'd', $keyuc . ' Reject ETRN', $totalsref); add_section ('-'); add_section ('totalrejects' . $key, 0, 'd', "Total $keyuc Rejects", $totalsref); add_section ('='); add_section ("\n"); $Totals{'totalrejects' . $key} = 0; } add_section ('__SECTION'); add_section ('connectioninbound', 0, 'd', 'Connections made'); add_section ('connectionlostinbound', 1, 'd', 'Connections lost (inbound)'); add_section ('connectionlostoutbound', 1, 'd', 'Connections lost (outbound)'); add_section ('disconnection', 0, 'd', 'Disconnections'); add_section ('removedfromqueue', 0, 'd', 'Removed from queue'); add_section ('delivered', 1, 'd', 'Delivered'); add_section ('sent', 1, 'd', 'Sent via SMTP'); add_section ('sentlmtp', 1, 'd', 'Sent via LMTP'); add_section ('forwarded', 1, 'd', 'Forwarded'); add_section ('resent', 0, 'd', 'Resent'); add_section ('deferred', 1, 'd', 'Deferred'); add_section ('deferrals', 1, 'd', 'Deferrals'); add_section ('bouncelocal', 1, 'd', 'Bounced (local)'); add_section ('bounceremote', 1, 'd', 'Bounced (remote)'); add_section ('bouncefailed', 1, 'd', 'Bounce failure'); add_section ('envelopesenders', 1, 'd', 'Envelope senders'); add_section ('envelopesenderdomains', 1, 'd', 'Envelope sender domains'); add_section ('filtered', 1, 'd', 'Filtered'); add_section ('redirected', 1, 'd', 'Redirected'); add_section ('discarded', 1, 'd', 'Discarded'); add_section ('prepended', 1, 'd', 'Prepended'); add_section ('replaced', 1, 'd', 'Replaced'); add_section ('warned', 1, 'd', 'Warned'); add_section ('requeued', 0, 'd', 'Requeued messages'); add_section ('returnedtosender', 1, 'd', 'Expired and returned to sender'); add_section ('notificationsent', 1, 'd', 'Notifications sent'); add_section ('policyspf', 1, 'd', 'Policy SPF'); add_section ('policydweight', 1, 'd', 'Policyd-weight'); add_section ('postgrey', 1, 'd', 'Postgrey'); add_section ("\n"); add_section ('__SECTION'); add_section ('connecttofailure', 1, 'd', 'Connection failure (outbound)'); add_section ('timeoutinbound', 1, 'd', 'Timeout (inbound)'); add_section ('heloerror', 1, 'd', 'HELO/EHLO conversations errors'); add_section ('illegaladdrsyntax', 1, 'd', 'Illegal address syntax in SMTP command'); add_section ('released', 0, 'd', 'Released from hold'); add_section ('rblerror', 1, 'd', 'RBL lookup errors'); add_section ('mxerror', 1, 'd', 'MX errors'); add_section ('numerichostname', 1, 'd', 'Numeric hostname'); add_section ('smtpconversationerror', 1, 'd', 'SMTP dialog error'); add_section ('toomanyerrors', 1, 'd', 'Excessive errors in SMTP dialog'); add_section ('hostnameverification', 1, 'd', 'Hostname verification errors'); add_section ('hostnamevalidationerror', 1, 'd', 'Hostname validation errors'); add_section ('deliverable', 1, 'd', 'Deliverable (address verification)'); add_section ('undeliverable', 1, 'd', 'Undeliverable (address verification)'); add_section ('tablechanged', 0, 'd', 'Restarts due to lookup table change'); add_section ('pixworkaround', 1, 'd', 'PIX workaround enabled'); add_section ('tlsserverconnect', 1, 'd', 'TLS connections (server)'); add_section ('tlsclientconnect', 1, 'd', 'TLS connections (client)'); add_section ('saslauth', 1, 'd', 'SASL authenticated messages'); add_section ('saslauthrelay', 1, 'd', 'SASL authenticated relayed messages'); add_section ('tlsunverified', 1, 'd', 'TLS certificate unverified'); add_section ('tlsoffered', 1, 'd', 'Host offered TLS'); add_section ("\n"); add_section ('__SECTION'); add_section ('postfixstart', 0, 'd', 'Postfix start'); add_section ('postfixstop', 0, 'd', 'Postfix stop'); add_section ('postfixrefresh', 0, 'd', 'Postfix refresh'); add_section ('postfixwaiting', 0, 'd', 'Postfix waiting to terminate'); add_section ("\n"); 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; } } } # 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 undef; } # Replace bare reject limiters with specific reject limiters # based on reject_reply_patterns # sub expand_bare_reject_limiters() { my ($limiter, @reject_limiters, @non_reject_limiters); # 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; } } elsif ($limiter =~ /^(?:[45]\.\.|Warn)reject[^_]/) { $limiter =~ s/^([45])\.\./$1xx/; push @reject_limiters, lc $limiter; } else { push @non_reject_limiters, $limiter; } } @Limiters = (@reject_limiters, @non_reject_limiters); } # 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