-#!/usr/bin/perl
+#!/usr/bin/perl -w
eval 'exec perl -S $0 "$@"'
if 0;
pflogsumm.pl - Produce Postfix MTA logfile summary
-Copyright (C) 1998-2003 by James S. Seymour, Release 1.1.0.
+Copyright (C) 1998-2010 by James S. Seymour, Release 1.1.5
=head1 SYNOPSIS
- pflogsumm.pl -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
- [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
- [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
- [--problems_first] [--rej_add_from] [--no_bounce_detail]
- [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
- [--no_smtpd_warnings] [--zero_fill] [--syslog_name=string]
- [file1 [filen]]
+ pflogsumm.pl -[eq] [-d <today|yesterday>] [--detail <cnt>]
+ [--bounce-detail <cnt>] [--deferral-detail <cnt>]
+ [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
+ [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
+ [--rej-add-from] [--reject-detail <cnt>] [--smtp-detail <cnt>]
+ [--smtpd-stats] [--smtpd-warning-detail <cnt>]
+ [--syslog-name=string] [-u <cnt>] [--verbose-msg-detail]
+ [--verp-mung[=<n>]] [--zero-fill] [file1 [filen]]
pflogsumm.pl -[help|version]
=head1 OPTIONS
+ --bounce-detail <cnt>
+
+ Limit detailed bounce reports to the top <cnt>. 0
+ to suppress entirely.
+
-d today generate report for just today
-d yesterday generate report for just "yesterday"
+ --deferral-detail <cnt>
+
+ Limit detailed deferral reports to the top <cnt>. 0
+ to suppress entirely.
+
+ --detail <cnt>
+
+ Sets all --*-detail, -h and -u to <cnt>. Is
+ over-ridden by individual settings. --detail 0
+ suppresses *all* detail.
+
-e extended (extreme? excessive?) detail
Emit detailed reports. At present, this includes
0 = none.
- See also: "-u" and "--no_*_detail" for further
+ See also: "-u" and "--*-detail" options for further
report-limiting options.
--help Emit short usage message and bail out.
know: lame.)
-i
- --ignore_case Handle complete email address in a case-insensitive
+ --ignore-case Handle complete email address in a case-insensitive
manner.
Normally pflogsumm lower-cases only the host and
option causes the entire email address to be lower-
cased.
- --iso_date_time
+ --iso-date-time
For summaries that contain date or time information,
use ISO 8601 standard formats (CCYY-MM-DD and HH:MM),
rather than "Mon DD CCYY" and "HHMM".
-m modify (mung?) UUCP-style bang-paths
- --uucp_mung
+ --uucp-mung
This is for use when you have a mix of Internet-style
domain addresses and UUCP-style bang-paths in the log.
--no_deferral_detail
--no_reject_detail
+ These switches are deprecated in favour of
+ --bounce-detail, --deferral-detail and
+ --reject-detail, respectively.
+
Suppresses the printing of the following detailed
reports, respectively:
See also: "-u" and "-h" for further report-limiting
options.
- --no_no_msg_size
+ --no-no-msg-size
Do not emit report on "Messages with no size data".
normally reported by pflogsumm as "Messages with no
size data."
- --no_smtpd_warnings
+ --no-smtpd-warnings
+
+ This switch is deprecated in favour of
+ smtpd-warning-detail
On a busy mail server, say at an ISP, SMTPD warnings
can result in a rather sizeable report. This option
turns reporting them off.
- --problems_first
+ --problems-first
Emit "problems" reports (bounces, defers, warnings,
etc.) before "normal" stats.
- --rej_add_from
+ --rej-add-from
For those reject reports that list IP addresses or
host/domain names: append the email from address to
each listing. (Does not apply to "Improper use of
note: headings for warning, fatal, and "master"
messages will always be printed.
- --smtpd_stats
+ --reject-detail <cnt>
+
+ Limit detailed smtpd reject, warn, hold and discard
+ reports to the top <cnt>. 0 to suppress entirely.
+
+ --smtp-detail <cnt>
+
+ Limit detailed smtp delivery reports to the top <cnt>.
+ 0 to suppress entirely.
+
+ --smtpd-stats
Generate smtpd connection statistics.
reports. For multiple-day reports: "per-hour" numbers
are daily averages (reflected in the report heading).
- --syslog_name=name
+ --smtpd-warning-detail <cnt>
+
+ Limit detailed smtpd warnings reports to the top <cnt>.
+ 0 to suppress entirely.
- Set syslog_name to look for for Postfix log entries.
+ --syslog-name=name
+
+ Set syslog-name to look for for Postfix log entries.
By default, pflogsumm looks for entries in logfiles
with a syslog name of "postfix," the default.
-u <cnt> top <cnt> to display in user reports. 0 == none.
- See also: "-h" and "--no_*_detail" for further
+ See also: "-h" and "--*-detail" options for further
report-limiting options.
- --verbose_msg_detail
+ --verbose-msg-detail
For the message deferral, bounce and reject summaries:
display the full "reason", rather than a truncated one.
Note: this can result in quite long lines in the report.
- --verp_mung do "VERP" generated address (?) munging. Convert
- --verp_mung=2 sender addresses of the form
+ --verp-mung do "VERP" generated address (?) munging. Convert
+ --verp-mung=2 sender addresses of the form
"list-return-NN-someuser=some.dom@host.sender.dom"
to
"list-return-ID-someuser=some.dom@host.sender.dom"
--version Print program name and version and bail out.
- --zero_fill "Zero-fill" certain arrays so reports come out with
+ --zero-fill "Zero-fill" certain arrays so reports come out with
data in columns that that might otherwise be blank.
=head1 RETURN VALUE
(rejected / (delivered + rejected + discarded)) * 100
- There are some issues with the use of --syslog_name. The problem is
- that, even with $syslog_name set, Postfix will sometimes still log
- things with "postfix" as the syslog_name. This is noted in
+ There are some issues with the use of --syslog-name. The problem is
+ that, even with Postfix' $syslog_name set, it will sometimes still
+ log things with "postfix" as the syslog_name. This is noted in
/etc/postfix/sample-misc.cf:
# Beware: a non-default syslog_name setting takes effect only
=head1 REQUIREMENTS
- Pflogsumm requires the Date::Calc module, which can be obtained from
- CPAN at http://www.perl.com.
+ For certain options (e.g.: --smtpd-stats), Pflogsumm requires the
+ Date::Calc module, which can be obtained from CPAN at
+ http://www.perl.com.
- Pflogsumm is currently written and tested under Perl 5.005_03.
+ Pflogsumm is currently written and tested under Perl 5.8.3.
As of version 19990413-02, pflogsumm worked with Perl 5.003, but
future compatibility is not guaranteed.
use strict;
use locale;
use Getopt::Long;
-# ---Begin: SMTPD_STATS_SUPPORT---
-use Date::Calc qw(Delta_DHMS);
-# ---End: SMTPD_STATS_SUPPORT---
+eval { require Date::Calc };
+my $hasDateCalc = $@ ? 0 : 1;
my $mailqCmd = "mailq";
-my $release = "1.1.0";
+my $release = "1.1.5";
# Variables and constants used throughout pflogsumm
use vars qw(
my (
$cmd, $qid, $addr, $size, $relay, $status, $delay,
- $dateStr,
+ $dateStr, $dateStrRFC3339,
%panics, %fatals, %warnings, %masterMsgs,
%msgSizes,
%deferred, %bounced,
$smtpdPerHr[$_] = [0,0,0];
}
-$progName = "pflogsumm.pl";
+($progName = $0) =~ s/^.*\///;
+
$usageMsg =
- "usage: $progName -[eq] [-d <today|yesterday>] [-h <cnt>] [-u <cnt>]
- [--verp_mung[=<n>]] [--verbose_msg_detail] [--iso_date_time]
- [-m|--uucp_mung] [-i|--ignore_case] [--smtpd_stats] [--mailq]
- [--problems_first] [--rej_add_from] [--no_bounce_detail]
- [--no_deferral_detail] [--no_reject_detail] [--no_no_msg_size]
- [--no_smtpd_warnings] [--zero_fill] [--syslog_name=name]
- [file1 [filen]]
+ "usage: $progName -[eq] [-d <today|yesterday>] [--detail <cnt>]
+ [--bounce-detail <cnt>] [--deferral-detail <cnt>]
+ [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
+ [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
+ [--rej-add-from] [--reject-detail <cnt>] [--smtp-detail <cnt>]
+ [--smtpd-stats] [--smtpd-warning-detail <cnt>]
+ [--syslog-name=string] [-u <cnt>] [--verbose-msg-detail]
+ [--verp-mung[=<n>]] [--zero-fill] [file1 [filen]]
$progName --[version|help]";
+# Accept either "_"s or "-"s in --switches
+foreach (@ARGV) {
+ last if($_ eq "--");
+ tr/_/-/ if(/^--\w/);
+}
+
# Some pre-inits for convenience
$isoDateTime = 0; # Don't use ISO date/time formats
GetOptions(
- "d=s" => \$opts{'d'},
- "e" => \$opts{'e'},
- "help" => \$opts{'help'},
- "h=i" => \$opts{'h'},
- "i" => \$opts{'i'},
- "ignore_case" => \$opts{'i'},
- "iso_date_time" => \$isoDateTime,
- "m" => \$opts{'m'},
- "uucp_mung" => \$opts{'m'},
- "mailq" => \$opts{'mailq'},
- "no_bounce_detail" => \$opts{'noBounceDetail'},
- "no_deferral_detail" => \$opts{'noDeferralDetail'},
- "no_reject_detail" => \$opts{'noRejectDetail'},
- "no_no_msg_size" => \$opts{'noNoMsgSize'},
- "no_smtpd_warnings" => \$opts{'noSMTPDWarnings'},
- "problems_first" => \$opts{'pf'},
- "q" => \$opts{'q'},
- "rej_add_from" => \$opts{'rejAddFrom'},
- "smtpd_stats" => \$opts{'smtpdStats'},
- "syslog_name=s" => \$opts{'syslogName'},
- "u=i" => \$opts{'u'},
- "verbose_msg_detail" => \$opts{'verbMsgDetail'},
- "verp_mung:i" => \$opts{'verpMung'},
- "version" => \$opts{'version'},
- "zero_fill" => \$opts{'zeroFill'}
+ "bounce-detail=i" => \$opts{'bounceDetail'},
+ "d=s" => \$opts{'d'},
+ "deferral-detail=i" => \$opts{'deferralDetail'},
+ "detail=i" => \$opts{'detail'},
+ "e" => \$opts{'e'},
+ "help" => \$opts{'help'},
+ "h=i" => \$opts{'h'},
+ "ignore-case" => \$opts{'i'},
+ "i" => \$opts{'i'},
+ "iso-date-time" => \$isoDateTime,
+ "mailq" => \$opts{'mailq'},
+ "m" => \$opts{'m'},
+ "no-bounce-detail" => \$opts{'noBounceDetail'},
+ "no-deferral-detail" => \$opts{'noDeferralDetail'},
+ "no-no-msg-size" => \$opts{'noNoMsgSize'},
+ "no-reject-detail" => \$opts{'noRejectDetail'},
+ "no-smtpd-warnings" => \$opts{'noSMTPDWarnings'},
+ "problems-first" => \$opts{'pf'},
+ "q" => \$opts{'q'},
+ "rej-add-from" => \$opts{'rejAddFrom'},
+ "reject-detail=i" => \$opts{'rejectDetail'},
+ "smtp-detail=i" => \$opts{'smtpDetail'},
+ "smtpd-stats" => \$opts{'smtpdStats'},
+ "smtpd-warning-detail=i" => \$opts{'smtpdWarnDetail'},
+ "syslog-name=s" => \$opts{'syslogName'},
+ "u=i" => \$opts{'u'},
+ "uucp-mung" => \$opts{'m'},
+ "verbose-msg-detail" => \$opts{'verbMsgDetail'},
+ "verp-mung:i" => \$opts{'verpMung'},
+ "version" => \$opts{'version'},
+ "zero-fill" => \$opts{'zeroFill'}
) || die "$usageMsg\n";
# internally: 0 == none, undefined == -1 == all
$opts{'h'} = -1 unless(defined($opts{'h'}));
$opts{'u'} = -1 unless(defined($opts{'u'}));
+$opts{'bounceDetail'} = -1 unless(defined($opts{'bounceDetail'}));
+$opts{'deferralDetail'} = -1 unless(defined($opts{'deferralDetail'}));
+$opts{'smtpDetail'} = -1 unless(defined($opts{'smtpDetail'}));
+$opts{'smtpdWarnDetail'} = -1 unless(defined($opts{'smtpdWarnDetail'}));
+$opts{'rejectDetail'} = -1 unless(defined($opts{'rejectDetail'}));
+
+# These go away eventually
+if(defined($opts{'noBounceDetail'})) {
+ $opts{'bounceDetail'} = 0;
+ warn "$progName: \"no_bounce_detail\" is deprecated, use \"bounce-detail=0\" instead\n"
+}
+if(defined($opts{'noDeferralDetail'})) {
+ $opts{'deferralDetail'} = 0;
+ warn "$progName: \"no_deferral_detail\" is deprecated, use \"deferral-detail=0\" instead\n"
+}
+if(defined($opts{'noRejectDetail'})) {
+ $opts{'rejectDetail'} = 0;
+ warn "$progName: \"no_reject_detail\" is deprecated, use \"reject-detail=0\" instead\n"
+}
+if(defined($opts{'noSMTPDWarnings'})) {
+ $opts{'smtpdWarnDetail'} = 0;
+ warn "$progName: \"no_smtpd_warnings\" is deprecated, use \"smtpd-warning-detail=0\" instead\n"
+}
+
+# If --detail was specified, set anything that's not enumerated to it
+if(defined($opts{'detail'})) {
+ foreach my $optName (qw (h u bounceDetail deferralDetail smtpDetail smtpdWarnDetail rejectDetail)) {
+ $opts{$optName} = $opts{'detail'} unless($opts{"$optName"} != -1);
+ }
+}
+
my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
if(defined($opts{'help'})) {
exit 0;
}
-$dateStr = get_datestr($opts{'d'}) if(defined($opts{'d'}));
+if($hasDateCalc) {
+ # manually import the Date::Calc routine we want
+ #
+ # This looks stupid, but it's the only way to shut Perl up about
+ # "Date::Calc::Delta_DHMS" used only once" if -w is on. (No,
+ # $^W = 0 doesn't work in this context.)
+ *Delta_DHMS = *Date::Calc::Delta_DHMS;
+ *Delta_DHMS = *Date::Calc::Delta_DHMS;
+
+} elsif(defined($opts{'smtpdStats'})) {
+ # If user specified --smtpd-stats but doesn't have Date::Calc
+ # installed, die with friendly help message.
+ die <<End_Of_HELP_DATE_CALC;
+
+The option "--smtpd-stats" does calculations that require the
+Date::Calc Perl module, but you don't have this module installed.
+If you want to use this extended functionality of Pflogsumm, you
+will have to install this module. If you have root privileges
+on the machine, this is as simple as performing the following
+command:
+
+ perl -MCPAN -e 'install Date::Calc'
+
+End_Of_HELP_DATE_CALC
+}
+
+($dateStr, $dateStrRFC3339) = get_datestrs($opts{'d'}) if(defined($opts{'d'}));
# debugging
#open(UNPROCD, "> unprocessed") ||
# die "couldn't open \"unprocessed\": $!\n";
while(<>) {
- next if(defined($dateStr) && ! /^$dateStr/o);
- s/: \[ID \d+ [^\]]+\] /: /o; # lose "[ID nnnnnn some.thing]" stuff
+ next if(defined($dateStr) && ! (/^${dateStr} / || /^${dateStrRFC3339}T/));
+ s/: \[ID \d+ [^\]]+\] /: /; # lose "[ID nnnnnn some.thing]" stuff
my $logRmdr;
- next unless((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
- /^(...) +(\d+) (..):(..):(..) \S+ (.+)$/o) == 6);
- unless((($cmd, $qid) = $logRmdr =~ m#^(?:vmailer|postfix|$syslogName)/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
- (($cmd, $qid) = $logRmdr =~ m#^((?:vmailer|postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
+
+ # "Traditional" timestamp format?
+ if((($msgMonStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
+ /^(...) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/) == 6)
+ {
+ # Convert string to numeric value for later "month rollover" check
+ $msgMon = $monthNums{$msgMonStr};
+ } else {
+ # RFC 3339 timestamp format?
+ next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
+ /^(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})(?:\.\d+)?(?:[\+\-](?:\d{2}):(?:\d{2})|Z) \S+ (.+)$/) == 7);
+ # RFC 3339 months start at "1", we index from 0
+ --$msgMon;
+ }
+
+ unless((($cmd, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)(?:/(?:smtps|submission))?/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
+ (($cmd, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
{
#print UNPROCD "$_";
next;
}
chomp;
- # snatch out log entry date & time
- $msgMon = $monthNums{$msgMonStr};
+ # If the log line's month is greater than our current month,
+ # we've probably had a year rollover
+ # FIXME: For processing old logfiles: This is a broken test!
$msgYr = ($msgMon > $thisMon? $thisYr - 1 : $thisYr);
# the following test depends on one getting more than one message a
# regexp rejects happen in "cleanup"
if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
- /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/o) == 3)
+ /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (header|body) (.*)$/) == 3)
{
- $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'});
+ $rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbMsgDetail'});
$rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'});
if($rejSubTyp eq "reject") {
- ++$rejects{$cmd}{$rejReas}{$rejRmdr};
+ ++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
++$msgsRjctd;
} elsif($rejSubTyp eq "warning") {
- ++$warns{$cmd}{$rejReas}{$rejRmdr};
+ ++$warns{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
++$msgsWrnd;
} elsif($rejSubTyp eq "hold") {
- ++$holds{$cmd}{$rejReas}{$rejRmdr};
+ ++$holds{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
++$msgsHld;
} elsif($rejSubTyp eq "discard") {
- ++$discards{$cmd}{$rejReas}{$rejRmdr};
+ ++$discards{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
++$msgsDscrdd;
}
++$rejPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[4];
} elsif($qid eq 'warning') {
- (my $warnReas = $logRmdr) =~ s/^.*warning: //o;
+ (my $warnReas = $logRmdr) =~ s/^.*warning: //;
$warnReas = string_trimmer($warnReas, 66, $opts{'verbMsgDetail'});
unless($cmd eq "smtpd" && $opts{'noSMTPDWarnings'}) {
++$warnings{$cmd}{$warnReas};
}
} elsif($qid eq 'fatal') {
- (my $fatalReas = $logRmdr) =~ s/^.*fatal: //o;
+ (my $fatalReas = $logRmdr) =~ s/^.*fatal: //;
$fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'});
++$fatals{$cmd}{$fatalReas};
} elsif($qid eq 'panic') {
- (my $panicReas = $logRmdr) =~ s/^.*panic: //o;
+ (my $panicReas = $logRmdr) =~ s/^.*panic: //;
$panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'});
++$panics{$cmd}{$panicReas};
} elsif($qid eq 'reject') {
} elsif($cmd eq 'master') {
++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
} elsif($cmd eq 'smtpd') {
- if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) {
+ if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/) {
#
# Warning: this code in two places!
#
++${$msgsPerDay{$revMsgDateStr}}[0];
++$msgsRcvd;
$rcvdMsg{$qid} = gimme_domain($1); # Whence it came
- } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) {
+ # DEBUG DEBUG DEBUG
+ #print STDERR "Received: $qid\n";
+ } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /) {
if($rejSubTyp eq 'reject') {
proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd,
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
}
}
-# ---Begin: SMTPD_STATS_SUPPORT---
else {
next unless(defined($opts{'smtpdStats'}));
- if($logRmdr =~ /: connect from /o) {
- $logRmdr =~ /\/smtpd\[(\d+)\]: /o;
+ if($logRmdr =~ /: connect from /) {
+ $logRmdr =~ /\/smtpd\[(\d+)\]: /;
@{$connTime{$1}} =
($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec);
- } elsif($logRmdr =~ /: disconnect from /o) {
- my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o;
+ } elsif($logRmdr =~ /: disconnect from /) {
+ my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/;
if(exists($connTime{$pid})) {
$hostID = gimme_domain($hostID);
my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}},
}
}
}
-# ---End: SMTPD_STATS_SUPPORT---
} else {
my $toRmdr;
- if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2)
+ if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/) == 2)
{
next if($msgSizes{$qid}); # avoid double-counting!
if($addr) {
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
+ if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
$addr = lc($addr) if($opts{'i'});
$addr = verp_mung($addr);
} else {
# Get the domain out of the sender's address. If there is
# none: Use the client hostname/IP-address
my $domAddr;
- unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/o) == 1) {
+ unless((($domAddr = $addr) =~ s/^[^@]+\@(.+)$/$1/) == 1) {
$domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid};
}
++$sendgDomCnt
}
}
elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~
- /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=\d+\.\d+\.\d+, )?status=(\S+)(.*)$/o) >= 4)
+ /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/) >= 4)
{
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) {
+ if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/o unless($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
$addr = lc($addr) if($opts{'i'});
- (my $domAddr = $addr) =~ s/^[^@]+\@//o; # get domain only
+ $relay = lc($relay) if($opts{'i'});
+ (my $domAddr = $addr) =~ s/^[^@]+\@//; # get domain only
if($status eq 'sent') {
# was it actually forwarded, rather than delivered?
- if($toRmdr =~ /forwarded as /o) {
+ if($toRmdr =~ /forwarded as /) {
++$msgsFwdd;
next;
}
++$dlvPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[1];
++$msgsDlvrd;
+ # DEBUG DEBUG DEBUG
+ #print STDERR "Delivered: $qid\n";
if($msgSizes{$qid}) {
${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid};
${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid};
}
push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
} elsif($status eq 'deferred') {
- my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/o;
- unless(defined($opts{'verbMsgDetail'})) {
- $deferredReas = said_string_trimmer($deferredReas, 65);
- $deferredReas =~ s/^\d{3} //o;
- $deferredReas =~ s/^connect to //o;
+ unless($opts{'deferralDetail'} == 0) {
+ my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
+ unless(defined($opts{'verbMsgDetail'})) {
+ $deferredReas = said_string_trimmer($deferredReas, 65);
+ $deferredReas =~ s/^\d{3} //;
+ $deferredReas =~ s/^connect to //;
+ }
+ ++$deferred{$cmd}{$deferredReas};
}
- ++$deferred{$cmd}{$deferredReas};
++$dfrPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[2];
++$msgsDfrdCnt;
${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay
}
} elsif($status eq 'bounced') {
- my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/o;
- unless(defined($opts{'verbMsgDetail'})) {
- $bounceReas = said_string_trimmer($bounceReas, 66);
- $bounceReas =~ s/^\d{3} //o;
+ unless($opts{'bounceDetail'} == 0) {
+ my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
+ unless(defined($opts{'verbMsgDetail'})) {
+ $bounceReas = said_string_trimmer($bounceReas, 66);
+ $bounceReas =~ s/^\d{3} //;
+ }
+ ++$bounced{$relay}{$bounceReas};
}
- ++$bounced{$relay}{$bounceReas};
++$bncPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[3];
++$msgsBncd;
# print UNPROCD "$_\n";
}
}
- elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) {
+ elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/) {
#
# Warning: this code in two places!
#
++$msgsRcvd;
$rcvdMsg{$qid} = "pickup"; # Whence it came
}
- elsif($cmd eq 'smtp') {
+ elsif($cmd eq 'smtp' && $opts{'smtpDetail'} != 0) {
# Was an IPv6 problem here
- if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) {
+ if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/) {
++$smtpMsgs{lc($2)}{$1};
- } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) {
+ } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/) {
++$smtpMsgs{lc($2)}{$1};
} else {
# print UNPROCD "$_\n";
print "Postfix log summaries for $dateStr\n";
}
-print "\nGrand Totals\n------------\n";
+print_subsect_title("Grand Totals");
print "messages\n\n";
printf " %6d%s received\n", adj_int_units($msgsRcvd);
printf " %6d%s delivered\n", adj_int_units($msgsDlvrd);
printf " %6d%s recipients\n", adj_int_units($recipUserCnt);
printf " %6d%s recipient hosts/domains\n", adj_int_units($recipDomCnt);
-# ---Begin: SMTPD_STATS_SUPPORT---
if(defined($opts{'smtpdStats'})) {
print "\nsmtpd\n\n";
printf " %6d%s connections\n", adj_int_units($smtpdConnCnt);
$hr, $min, $sec;
}
}
-# ---End: SMTPD_STATS_SUPPORT---
print "\n";
print_recip_domain_summary(\%recipDom, $opts{'h'});
print_sending_domain_summary(\%sendgDom, $opts{'h'});
-# ---Begin: SMTPD_STATS_SUPPORT---
if(defined($opts{'smtpdStats'})) {
print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
}
-# ---End: SMTPD_STATS_SUPPORT---
print_user_data(\%sendgUser, "Senders by message count", $msgCntI, $opts{'u'}, $opts{'q'});
print_user_data(\%recipUser, "Recipients by message count", $msgCntI, $opts{'u'}, $opts{'q'});
# Print "problems" reports
sub print_problems_reports {
- unless($opts{'noDeferralDetail'}) {
- print_nested_hash(\%deferred, "message deferral detail", $opts{'q'});
+ unless($opts{'deferralDetail'} == 0) {
+ print_nested_hash(\%deferred, "message deferral detail", $opts{'deferralDetail'}, $opts{'q'});
+ }
+ unless($opts{'bounceDetail'} == 0) {
+ print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'bounceDetail'}, $opts{'q'});
}
- unless($opts{'noBounceDetail'}) {
- print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'q'});
+ unless($opts{'rejectDetail'} == 0) {
+ print_nested_hash(\%rejects, "message reject detail", $opts{'rejectDetail'}, $opts{'q'});
+ print_nested_hash(\%warns, "message reject warning detail", $opts{'rejectDetail'}, $opts{'q'});
+ print_nested_hash(\%holds, "message hold detail", $opts{'rejectDetail'}, $opts{'q'});
+ print_nested_hash(\%discards, "message discard detail", $opts{'rejectDetail'}, $opts{'q'});
}
- unless($opts{'noRejectDetail'}) {
- print_nested_hash(\%rejects, "message reject detail", $opts{'q'});
- print_nested_hash(\%warns, "message reject warning detail", $opts{'q'});
- print_nested_hash(\%holds, "message hold detail", $opts{'q'});
- print_nested_hash(\%discards, "message discard detail", $opts{'q'});
+ unless($opts{'smtpDetail'} == 0) {
+ print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtpDetail'}, $opts{'q'});
+ }
+ unless($opts{'smtpdWarnDetail'} == 0) {
+ print_nested_hash(\%warnings, "Warnings", $opts{'smtpdWarnDetail'}, $opts{'q'});
}
- print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'q'});
- print_nested_hash(\%warnings, "Warnings", $opts{'q'});
print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'q'});
print_nested_hash(\%panics, "Panics", 0, $opts{'q'});
print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'q'});
if($opts{'mailq'}) {
# flush stdout first cuz of asynchronousity
$| = 1;
- print "\nCurrent Mail Queue\n------------------\n";
+ print_subsect_title("Current Mail Queue");
system($mailqCmd);
}
sub print_per_day_summary {
my($msgsPerDay) = @_;
my $value;
- print <<End_Of_Per_Day_Heading;
-Per-Day Traffic Summary
+ print_subsect_title("Per-Day Traffic Summary");
+
+ print <<End_Of_Per_Day_Heading;
date received delivered deferred bounced rejected
--------------------------------------------------------------------
End_Of_Per_Day_Heading
my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_;
my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary';
my ($hour, $value);
- print <<End_Of_Per_Hour_Heading;
-Per-Hour Traffic $reportType
+ print_subsect_title("Per-Hour Traffic $reportType");
+
+ print <<End_Of_Per_Hour_Heading;
time received delivered deferred bounced rejected
--------------------------------------------------------------------
End_Of_Per_Hour_Heading
return if($cnt == 0);
my $topCnt = $cnt > 0? "(top $cnt)" : "";
my $avgDly;
- print <<End_Of_Recip_Domain_Heading;
-Host/Domain Summary: Message Delivery $topCnt
+ print_subsect_title("Host/Domain Summary: Message Delivery $topCnt");
+
+ print <<End_Of_Recip_Domain_Heading;
sent cnt bytes defers avg dly max dly host/domain
-------- ------- ------- ------- ------- -----------
End_Of_Recip_Domain_Heading
my($cnt) = $_[1];
return if($cnt == 0);
my $topCnt = $cnt > 0? "(top $cnt)" : "";
- print <<End_Of_Sender_Domain_Heading;
-Host/Domain Summary: Messages Received $topCnt
+ print_subsect_title("Host/Domain Summary: Messages Received $topCnt");
+
+ print <<End_Of_Sender_Domain_Heading;
msg cnt bytes host/domain
-------- ------- -----------
End_Of_Sender_Domain_Heading
}
}
-# ---Begin: SMTPD_STATS_SUPPORT---
# print "per-hour" smtpd connection summary
# (done in a subroutine only to keep main-line code clean)
my ($smtpdPerHr, $dayCnt) = @_;
my ($hour, $value);
if($dayCnt > 1) {
- print <<End_Of_Per_Hour_Smtp_Average;
+ print_subsect_title("Per-Hour SMTPD Connection Daily Average");
-Per-Hour SMTPD Connection Daily Average
+ print <<End_Of_Per_Hour_Smtp_Average;
hour connections time conn.
-------------------------------------
End_Of_Per_Hour_Smtp_Average
} else {
- print <<End_Of_Per_Hour_Smtp;
+ print_subsect_title("Per-Hour SMTPD Connection Summary");
-Per-Hour SMTPD Connection Summary
+ print <<End_Of_Per_Hour_Smtp;
hour connections time conn. avg./conn. max. time
--------------------------------------------------------------------
End_Of_Per_Hour_Smtp
}
}
-
# print "per-day" smtpd connection summary
# (done in a subroutine only to keep main-line code clean)
sub print_per_day_smtpd {
my ($smtpdPerDay, $dayCnt) = @_;
- print <<End_Of_Per_Day_Smtp;
-Per-Day SMTPD Connection Summary
+ print_subsect_title("Per-Day SMTPD Connection Summary");
+
+ print <<End_Of_Per_Day_Smtp;
date connections time conn. avg./conn. max. time
--------------------------------------------------------------------
End_Of_Per_Day_Smtp
return if($cnt == 0);
my $topCnt = $cnt > 0? "(top $cnt)" : "";
my $avgDly;
- print <<End_Of_Domain_Smtp_Heading;
-Host/Domain Summary: SMTPD Connections $topCnt
+ print_subsect_title("Host/Domain Summary: SMTPD Connections $topCnt");
+
+ print <<End_Of_Domain_Smtp_Heading;
connections time conn. avg./conn. max. time host/domain
----------- ---------- ---------- --------- -----------
End_Of_Domain_Smtp_Heading
}
}
-# ---End: SMTPD_STATS_SUPPORT---
-
# print hash contents sorted by numeric values in descending
# order (i.e.: highest first)
sub print_hash_by_cnt_vals {
# print "nested" hashes
sub print_nested_hash {
- my($hashRef, $title, $quiet) = @_;
+ my($hashRef, $title, $cnt, $quiet) = @_;
my $dottedLine;
unless(%$hashRef) {
return if($quiet);
$dottedLine = "\n" . "-" x length($title);
}
printf "\n$title$dottedLine\n";
- walk_nested_hash($hashRef, 0);
+ walk_nested_hash($hashRef, $cnt, 0);
}
# "walk" a "nested" hash
sub walk_nested_hash {
- my ($hashRef, $level) = @_;
+ my ($hashRef, $cnt, $level) = @_;
$level += 2;
my $indents = ' ' x $level;
my ($keyName, $hashVal) = each(%$hashRef);
my $hashVal2 = (each(%{$hashRef->{$_}}))[1];
keys(%{$hashRef->{$_}}); # "reset" hash iterator
unless(ref($hashVal2) eq 'HASH') {
- my $cnt = 0;
- $cnt += $_ foreach (values %{$hashRef->{$_}});
- print " (total: $cnt)";
+ print " (top $cnt)" if($cnt > 0);
+ my $rptCnt = 0;
+ $rptCnt += $_ foreach (values %{$hashRef->{$_}});
+ print " (total: $rptCnt)";
}
print "\n";
- walk_nested_hash($hashRef->{$_}, $level);
+ walk_nested_hash($hashRef->{$_}, $cnt, $level);
}
} else {
- really_print_hash_by_cnt_vals($hashRef, 0, $indents);
+ really_print_hash_by_cnt_vals($hashRef, $cnt, $indents);
}
}
}
}
+# Print a sub-section title with properly-sized underline
+sub print_subsect_title {
+ my $title = $_[0];
+ print "\n$title\n" . "-" x length($title) . "\n";
+}
+
# Normalize IP addr or hostname
# (Note: Makes no effort to normalize IPv6 addrs. Just returns them
# as they're passed-in.)
# For IP addrs and hostnames: lop off possible " (user@dom.ain)" bit
my $norm1 = (split(/\s/, $_[0]))[0];
- if((my @octets = ($norm1 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/o)) == 4) {
+ if((my @octets = ($norm1 =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)) == 4) {
# Dotted-quad IP address
- return(pack('C4', @octets));
+ return(pack('U4', @octets));
} else {
# Possibly hostname or user@dom.ain
return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 ));
# now re-order "mach.host.dom"/"mach.host.do.co" to
# "host.dom.mach"/"host.do.co.mach"
- $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
+ $domainA =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
if($domainA);
- $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o
+ $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/
if($domainB);
# oddly enough, doing this here is marginally faster than doing
return 1;
} else {
# disregard leading bang-path
- $userNameA =~ s/^.*!//o;
- $userNameB =~ s/^.*!//o;
+ $userNameA =~ s/^.*!//;
+ $userNameB =~ s/^.*!//;
if($userNameA lt $userNameB) {
return -1;
} elsif($userNameA gt $userNameB) {
}
}
-# return a date string to match in log
-sub get_datestr {
- my $dateOpt = $_[0];
-
- my $aDay = 60 * 60 * 24;
+# return traditional and RFC3339 date strings to match in log
+sub get_datestrs {
+ my ($dateOpt) = $_[0];
my $time = time();
+
if($dateOpt eq "yesterday") {
- $time -= $aDay;
+ # Back up to yesterday
+ $time -= ((localtime($time))[2] + 2) * 3600;
} elsif($dateOpt ne "today") {
die "$usageMsg\n";
}
- my ($t_mday, $t_mon) = (localtime($time))[3,4];
+ my ($t_mday, $t_mon, $t_year) = (localtime($time))[3,4,5];
- return sprintf("%s %2d", $monthNames[$t_mon], $t_mday);
+ return sprintf("%s %2d", $monthNames[$t_mon], $t_mday), sprintf("%04d-%02d-%02d", $t_year+1900, $t_mon+1, $t_mday);
}
# if there's a real domain: uses that. Otherwise uses the IP addr.
# (In case one wants to assume an IPv4 addr. is a dialup or other
# dynamic IP address in a /24.)
# Does nothing interesting with IPv6 addresses.
+# FIXME: I think the IPv6 address parsing may be weak
sub gimme_domain {
$_ = $_[0];
my($domain, $ipAddr);
# split domain/ipaddr into separates
# newer versions of Postfix have them "dom.ain[i.p.add.ress]"
# older versions of Postfix have them "dom.ain/i.p.add.ress"
- unless((($domain, $ipAddr) = /^([^\[]+)\[([^\]]+)\]/o) == 2 ||
- (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/oi) == 2) {
+ unless((($domain, $ipAddr) = /^([^\[]+)\[((?:\d{1,3}\.){3}\d{1,3})\]/) == 2 ||
+ (($domain, $ipAddr) = /^([^\/]+)\/([0-9a-f.:]+)/i) == 2) {
# more exhaustive method
- ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o;
+ ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/;
}
# "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co"
$domain = $ipAddr;
# For identifying the host part on a Class C network (commonly
# seen with dial-ups) the following is handy.
- # $domain =~ s/\.\d+$//o;
+ # $domain =~ s/\.\d+$//;
} else {
$domain =~
- s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o;
+ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/;
}
return $domain;
}
# Trim a "said:" string, if necessary. Add elipses to show it.
+# FIXME: This sometimes elides The Wrong Bits, yielding
+# summaries that are less useful than they could be.
sub said_string_trimmer {
my($trimmedString, $maxLen) = @_;
- # If theres a "deferred ()" in the logfile.
- if (not defined $trimmedString) { return "" };
-
while(length($trimmedString) > $maxLen) {
- if($trimmedString =~ /^.* said: /o) {
- $trimmedString =~ s/^.* said: //o;
- } elsif($trimmedString =~ /^.*: */o) {
- $trimmedString =~ s/^.*?: *//o;
+ if($trimmedString =~ /^.* said: /) {
+ $trimmedString =~ s/^.* said: //;
+ } elsif($trimmedString =~ /^.*: */) {
+ $trimmedString =~ s/^.*?: *//;
} else {
$trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
last;
my ($from, $to);
my $rejAddFrom = 0;
+ ++$$msgsRjctd;
+ ++$$rejPerHr;
+ ++$$msgsPerDay;
+
+ # Hate the sub-calling overhead if we're not doing reject details
+ # anyway, but this is the only place we can do this.
+ return if($opts{'rejectDetail'} == 0);
+
# This could get real ugly!
# First: get everything following the "reject: ", etc. token
# Was an IPv6 problem here
($rejTyp, $rejFrom, $rejRmdr) =
- ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/o);
+ ($logLine =~ /^.* \b(?:reject(?:_warning)?|hold|discard): (\S+) from (\S+?): (.*)$/);
# Next: get the reject "reason"
$rejReas = $rejRmdr;
# an email address or HELO string. There can be *anything* in
# those--incl. stuff that'll screw up subsequent parsing. So just
# get rid of it right off.
- $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/o;
- $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/o;
- $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/o;
- $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/o;
+ $rejReas =~ s/^(\d{3} <).*?(>:)/$1$2/;
+ $rejReas =~ s/^(?:.*?[:;] )(?:\[[^\]]+\] )?([^;,]+)[;,].*$/$1/;
+ $rejReas =~ s/^((?:Sender|Recipient) address rejected: [^:]+):.*$/$1/;
+ $rejReas =~ s/(Client host|Sender address) .+? blocked/blocked/;
} elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr...
- $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o;
+ $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/;
} else {
- $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o;
+ $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/;
}
}
# Second expression is for unknown recipient--where there is no
# "to=<mumble>" field, third for pathological case where recipient
# field is unterminated, forth when all else fails.
- (($to) = $rejRmdr =~ /to=<([^>]+)>/o) ||
- (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /o) ||
- (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/o) ||
+ (($to) = $rejRmdr =~ /to=<([^>]+)>/) ||
+ (($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /) ||
+ (($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/) ||
($to = "<>");
+ $to = lc($to) if($opts{'i'});
# Snag sender address
- (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>");
+ (($from) = $rejRmdr =~ /from=<([^>]+)>/) || ($from = "<>");
if(defined($from)) {
$rejAddFrom = $opts{'rejAddFrom'};
$from = verp_mung($from);
+ $from = lc($from) if($opts{'i'});
}
# stash in "triple-subscripted-array"
- if($rejReas =~ m/^Sender address rejected:/o) {
+ if($rejReas =~ m/^Sender address rejected:/) {
# Sender address rejected: Domain not found
# Sender address rejected: need fully-qualified address
++$rejects->{$rejTyp}{$rejReas}{$from};
- } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/o) {
+ } elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/) {
# Recipient address rejected: Domain not found
# Recipient address rejected: need fully-qualified address
# User unknown (in local/relay recipient table)
$rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
}
++$rejects->{$rejTyp}{$rejReas}{$rejData};
- } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/) {
# Was an IPv6 problem here
- my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o;
+ my ($src) = $logLine =~ /^.+? from (\S+?):.*$/;
++$rejects->{$rejTyp}{$rejReas}{$src};
- } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/) {
my $rejData = gimme_domain($rejFrom);
$rejData .= " ($from)" if($rejAddFrom);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
- } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/o) {
+ } elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/) {
my $rejData = gimme_domain($rejFrom);
$rejData .= " ($from)" if($rejAddFrom);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
$rejData .= " ($from)" if($rejAddFrom);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
}
- ++$$msgsRjctd;
- ++$$rejPerHr;
- ++$$msgsPerDay;
}
# Hack for VERP (?) - convert address from somthing like
my $addr = $_[0];
if(defined($opts{'verpMung'})) {
- $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi;
+ $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/i;
if($opts{'verpMung'} > 1) {
- $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o;
+ $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/;
}
}