pflogsumm - Produce Postfix MTA logfile summary
-Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.11
+Copyright (C) 1998-2025 by James S. Seymour, Release 1.1.12
=head1 SYNOPSIS
- pflogsumm -[eq] [-d <today|yesterday>] [--detail <cnt>]
- [--bounce-detail <cnt>] [--colwidth <n>] [--deferral-detail <cnt>]
- [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
- [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
- [--pscrn-detail [cnt] [--pscrn-stats] [--rej-add-from] [--rej-add-to]
- [--reject-detail <cnt>] [--smtp-detail <cnt>] [--smtpd-stats]
- [--smtpd-warning-detail <cnt>] [--srs-mung] [--syslog-name=string]
- [-u <cnt>] [--unprocd <filename> ] [--use-orig-to]
- [--verbose-msg-detail] [--verp-mung[=<n>] [-x] [--zero-fill]
- [file1 [filen]]
+ pflogsumm [--config <file>] [--bounce-detail <cnt>]
+ [--colwidth <n>] [--deferral-detail <cnt>] [--detail <cnt>]
+ [-d <date [range]>] [--dow0mon] [-e] [-h <cnt>] [-i]
+ [--iso-date-time] [--mailq] [-m] [--no-no-msg-size]
+ [--problems-first] [--pscrn-detail <cnt>] [--pscrn-stats]
+ [-q] [--rej-add-from] [--rej-add-to] [--reject-detail <cnt>]
+ [--smtp-detail <cnt>] [--smtpd-stats] [--smtpd-warning-detail <cnt>]
+ [--srs-mung] [--syslog-name=string] [-u <cnt>]
+ [--unprocd-file <filename> ] [--use-orig-to] [--verbose-msg-detail]
+ [--verp-mung[=<n>]] [-x] [--zero-fill] [file1 [filen]]
- pflogsumm -[help|version]
+ pflogsumm --[dump-config|help|version]
+
+ Note: Where both long- and short-form options exist only the
+ latter are shown above. See man page for long-form equivalents.
If no file(s) specified, reads from stdin. Output is to stdout. Errors
and debug to stderr.
Limit detailed bounce reports to the top <cnt>. 0
to suppress entirely.
- --colwidth <n>
+ --config <config file>
+
+ Path to a configuration file containing pflogsumm
+ options.
+
+ Supports all standard command-line options (without the
+ leading "-" or "--"). Options like "config", "dump-config",
+ "help", and "version" technically work here, too, though
+ they're not particularly useful in this context.
+ Command-line arguments override config file values except
+ for boolean options.
+
+ --colwidth <n>
Maximum report output width. Default is 80 columns.
0 = unlimited.
N.B.: --verbose-msg-detail overrides
- -d today generate report for just today
- -d yesterday generate report for just "yesterday"
+ -d <arg>
+ --date-range <arg>
+
+ Limits the report to the specified date or range.
+
+ Accepted values:
+
+ today
+ yesterday
+ "this week" / "last week"
+ "this month" / "last month"
+ YYYY-MM[-DD]
+ "YYYY-MM[-DD] YYYY-MM[-DD]"
+
+ These options do what they suggest, with one
+ important caveat:
+
+ ISO 8601 / RFC 3339-style dates and ranges may
+ not yield accurate results when used with
+ traditional log formats lacking year information
+ ("month day-of-month").
+
+ In such cases, pflogsumm assumes log entries
+ are from the current year. For example, if the
+ current month is April and a log contains "Apr
+ NN" entries from the previous year, they will
+ be interpreted as from the *current* April.
+
+ As such, date-based filtering is only reliable
+ for entries less than ~365 days old for
+ old-/traditional-style logfiles.
+
+ Arguments containing spaces must be quoted!
+
+ This/last week/month arguments can take underscores,
+ rather than spaces, to avoid quoting: E.g.:
+
+ --date-range last_week
+
+ ISO 8601/RFC 3339 date ranges may optionally use a
+ hyphen or the word "to" for readability. E.g.:
+
+ "2025-08-01 to 2025-08-08"
+
+ If an optional day (DD) is omitted, the range becomes
+ the full month. E.g.:
+
+ 2025-08 == 2025-08-01 through 2025-08-31
+
+ "2025-07 - 2025-08" == 2025-07-01 - 2025-08-31
+
+ --dow0mon
+ First day of the week is Monday, rather than Sunday.
+
+ (Used only for this/last week calculations.)
--deferral-detail <cnt>
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
+ --dump-config
+ Dump the config to STDOUT and exit.
+
+ This can be used as both a debugging aid and as a way
+ to develop your first config file. For the latter:
+ Simply run your usual pflogsumm command line, adding
+ --dump-config to it, and redirect STDOUT to a file.
+
+ To make it cleaner: Remove unset configs:
+ pflogsumm --dump-config <add'l args> |grep -v ' = $'
+
+ -e
+ --extended-detail
+
+ Extended (extreme? excessive?) detail
Emit detailed reports. At present, this includes
only a per-message report, sorted by sender domain,
then user-in-domain, then by queue i.d.
quickly consume very large amounts of memory if a
lot of log entries are processed!
- -h <cnt> top <cnt> to display in host/domain reports.
-
+ -h <cnt>
+ --host-cnt <cnt>
+
+ top <cnt> to display in host/domain reports.
0 = none.
See also: "-u" and "--*-detail" options for further
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
rather than "Mon DD CCYY" and "HHMM".
-m modify (mung?) UUCP-style bang-paths
- --uucp-mung
This is for use when you have a mix of Internet-style
domain addresses and UUCP-style bang-paths in the log.
extended detail report (-e), to help ensure that by-
domain-by-name sorting is more accurate.
+ See also: --uucp-mung
+
--mailq Run "mailq" command at end of report.
Merely a convenience feature. (Assumes that "mailq"
Emit "problems" reports (bounces, defers, warnings,
etc.) before "normal" stats.
- --pscrn-detail [cnt]
- Emit postscreen detail.
+ --pscrn-detail <cnt>
- If the optional cnt is included: Limits postscreen detail
- reports to the top cnt.
+ Limit postscreen detail reporting to top <cnt> lines of
+ each event. 0 to suppress entirely.
+
+ Note: Postscreen rejects are collected and reported
+ in any event.
--pscrn-stats
Collect and emit postscreen summary stats.
each listing. (Does not apply to "Improper use of
SMTP command pipelining" report.)
- -q quiet - don't print headings for empty reports
+ -q
+ --quiet
+ quiet - don't print headings for empty reports
note: headings for warning, fatal, and "master"
messages will always be printed.
--rej-add-to
-
For sender reject reports: Add the intended recipient
address.
0 to suppress entirely.
--smtpd-stats
-
Generate smtpd connection statistics.
The "per-day" report is not generated for single-day
0 to suppress entirely.
--srs-mung
-
Undo SRS address munging.
If your postfix install has an SRS plugin running, many
See the discussion about the use of this option under
"NOTES," below.
- -u <cnt> top <cnt> to display in user reports. 0 == none.
+ -u <cnt>
+ --user-cnt <cnt>
- See also: "-h" and "--*-detail" options for further
- report-limiting options.
+ top <cnt> to display in user reports. 0 == none.
- --unprocd <filename>
+ See also: "-h" and "--*-detail" options for further
+ report-limiting options.
+
+ --unprocd-file <filename>
Emit unprocessed logfile lines to file <filename>
Where "orig_to" fields are found, report that in place
of the "to" address.
+ --uucp-mung
+ modify (mung?) UUCP-style bang-paths
+
+ See also: -m
+
--verbose-msg-detail
For the message deferral, bounce and reject summaries:
pflogsumm -d yesterday /var/log/maillog
- A report of prior week's activities (after logs rotated):
+ A report of prior week's activities:
- pflogsumm /var/log/maillog.0
+ pflogsumm -d last_week /var/log/maillog.0
What's happened so far today:
pflogsumm -d today /var/log/maillog
Crontab entry to generate a report of the previous day's activity
- at 10 minutes after midnight.
+ at 10 minutes after midnight:
10 0 * * * /usr/local/sbin/pflogsumm -d yesterday /var/log/maillog
- 2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
+ 2>&1 |/usr/bin/mailx -s "`uname -n` daily mail stats" postmaster
Crontab entry to generate a report for the prior week's activity.
- (This example assumes one rotates ones mail logs weekly, some time
- before 4:10 a.m. on Sunday.)
- 10 4 * * 0 /usr/local/sbin/pflogsumm /var/log/maillog.0
- 2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
+ 10 4 * * 0 /usr/local/sbin/pflogsumm -d "last week" /var/log/maillog.0
+ 2>&1 |/usr/bin/mailx -s "`uname -n` weekly mail stats" postmaster
+
+ (The two crontab examples, above, must actually be a single line
+ each. They're broken-up into two-or-more lines due to page
+ formatting issues.)
+
+ Using a config file:
+
+ pflogsumm --config /usr/local/etc/pflogusmm/daily.conf
- The two crontab examples, above, must actually be a single line
- each. They're broken-up into two-or-more lines due to page
- formatting issues.
+ Using a config file, overriding a config file options on the command
+ line:
+
+ pflogsumm --config /usr/local/etc/pflogsumm/daily.conf
+ --detail 30
+
+ This would override *all* detail settings in the config
+ file, setting them all to 30.
+
+ pflogsumm --config /usr/local/etc/pflogsumm/daily.conf
+ --detail 30 --host-cnt 10
+
+ This would override all detail settings in the config
+ file, setting them all to 30, with the global detail
+ setting in turn being overridden to 10 for host count.
=head1 SEE ALSO
=head1 NOTES
+ Some options, such as date range, have both short-form and
+ long-form names. In the interest of brevity, only the
+ short-form options are shown in the SYNOPSIS and in
+ pflogsumm's "help" output.
+
Pflogsumm makes no attempt to catch/parse non-Postfix log
entries. Unless it has "postfix/" in the log entry, it will be
ignored.
=head1 REQUIREMENTS
- Requires Perl 5.10, minimum
+ Requires Perl 5.10, minimum, and Date::Calc
+
+ For --config, Pflogsumm requires the Config::Simple module.
- For certain options (e.g.: --smtpd-stats), Pflogsumm requires the
- Date::Calc module, which can be obtained from CPAN at
- http://www.perl.com.
+ Both of the above can be obtained from CPAN at http://www.perl.com
+ or from your distro's repository.
Pflogsumm is currently written and tested under Perl 5.38.
As of version 19990413-02, pflogsumm worked with Perl 5.003, but
use locale;
use Getopt::Long;
use List::Util qw(reduce);
-eval { require Date::Calc };
-my $haveDateCalc = $@ ? 0 : 1;
+use Time::Local;
+use Date::Calc qw(Add_Delta_Days Week_of_Year Delta_DHMS Day_of_Week
+ Monday_of_Week Days_in_Month);
+use POSIX qw(strftime);
+eval { require Config::Simple };
+my $haveConfigSimple = $@ ? 0 : 1;
my $mailqCmd = "mailq";
-my $release = "1.1.11";
+my $release = "1.1.12";
# Variables and constants used throughout pflogsumm
-use vars qw(
- $progName
- $usageMsg
- %opts
- @monthNames %monthNums $thisYr $thisMon @dowNames
- $isoDateTime
+our (
+ $progName,
+ $usageMsg,
+ @monthNames, %monthNums, $thisYr, $thisMon, @dowNames,
+ %fromDate, %thruDate, %qidTracker
);
# Some constants used by display routines. I arbitrarily chose to
my (
$cmd, $qid, $addr, $orig_to, $size, $relay, $status, $delay,
- $dateStr, $dateStrRFC3339, $dow,
+ $strtDate, $endDate,
%panics, %fatals, %warnings, %masterMsgs,
%deferred, %bounced,
%noMsgSize, %msgDetail,
$msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs,
%connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime,
%pscrnConnTime, %pscrnPerDay, %pscrnPerIP, $pscrnConnCnt, $pscrnTotTime,
- %smtpMsgs
+ %smtpMsgs, $sizeDataExists, @deprecated
);
$dayCnt = $smtpdConnCnt = $smtpdTotTime = 0;
($progName = $0) =~ s/^.*\///;
$usageMsg =
- "usage: $progName -[eq] [-d <today|yesterday>] [--detail <cnt>]
- [--bounce-detail <cnt>] [--colwidth <n>] [--deferral-detail <cnt>]
- [-h <cnt>] [-i|--ignore-case] [--iso-date-time] [--mailq]
- [-m|--uucp-mung] [--no-no-msg-size] [--problems-first]
- [--pscrn-detail [cnt] [--pscrn-stats] [--rej-add-from] [--rej-add-to]
- [--reject-detail <cnt>] [--smtp-detail <cnt>] [--smtpd-stats]
- [--smtpd-warning-detail <cnt>] [--srs-mung] [--syslog-name=string]
- [-u <cnt>] [--unprocd <filename> ] [--use-orig-to]
- [--verbose-msg-detail] [--verp-mung[=<n>]] [-x] [--zero-fill]
- [file1 [filen]]
-
- $progName --[version|help]";
-
-# Some pre-inits for convenience
-$isoDateTime = 0; # Don't use ISO date/time formats
-GetOptions(
- "bounce-detail=i" => \$opts{'bounceDetail'},
- "colwidth=i" => \$opts{'colWidth'},
- "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-no-msg-size" => \$opts{'noNoMsgSize'},
- "problems-first" => \$opts{'pf'},
- "pscrn-detail:i" => \$opts{'pscrnDetail'},
- "pscrn-stats" => \$opts{'pscrnStats'},
- "q" => \$opts{'q'},
- "rej-add-from" => \$opts{'rejAddFrom'},
- "rej-add-to" => \$opts{'rejAddTo'},
- "reject-detail=i" => \$opts{'rejectDetail'},
- "smtp-detail=i" => \$opts{'smtpDetail'},
- "smtpd-stats" => \$opts{'smtpdStats'},
- "smtpd-warning-detail=i" => \$opts{'smtpdWarnDetail'},
- "srs-mung" => \$opts{'srsMung'},
- "syslog-name=s" => \$opts{'syslogName'},
- "u=i" => \$opts{'u'},
- "unprocd=s" => \$opts{'unProcdFN'},
- "use-orig-to" => \$opts{'useOrigTo'},
- "uucp-mung" => \$opts{'m'},
- "verbose-msg-detail" => \$opts{'verbMsgDetail'},
- "verp-mung:i" => \$opts{'verpMung'},
- "version" => \$opts{'version'},
- "x" => \$opts{'debug'},
- "zero-fill" => \$opts{'zeroFill'}
-) || die "$usageMsg\n";
+ "usage: $progName [--config <file>] [--bounce-detail <cnt>]
+ [--colwidth <n>] [--deferral-detail <cnt>] [--detail <cnt>]
+ [-d <date [range]>] [--dow0mon] [-e] [-h <cnt>] [-i]
+ [--iso-date-time] [--mailq] [-m] [--no-no-msg-size]
+ [--problems-first] [--pscrn-detail <cnt>] [--pscrn-stats]
+ [-q] [--rej-add-from] [--rej-add-to] [--reject-detail <cnt>]
+ [--smtp-detail <cnt>] [--smtpd-stats] [--smtpd-warning-detail <cnt>]
+ [--srs-mung] [--syslog-name=string] [-u <cnt>]
+ [--unprocd-file <filename> ] [--use-orig-to] [--verbose-msg-detail]
+ [--verp-mung[=<n>]] [-x] [--zero-fill] [file1 [filen]]
+
+ $progName --[dump-config|help|version]
+
+ Note: Where both long- and short-form options exist only the
+ latter are shown above. See man page for long-form equivalents.";
+
+#
+# Central options specifications. This allows us to create a unified set
+# of arguments to GetOpts, for processing Config::Simple, and for dumping
+# the configuration.
+#
+# type: s = string, i = integer, b = boolean, f = float (validated manually)
+# Notes: "i" and "s" are used in the GetOpts hash. "f" is translated to "s".
+# Short options are ignored by Config::Simple processing.
+my %optionSpec = (
+ 'bounce-detail' => { type => 'i' },
+ 'colwidth' => { type => 'i' },
+ 'config' => { type => 's' }, # not exposed as CLI short option
+ 'date-range' => { type => 's', short => 'd' },
+ 'debug' => { type => 'b', short => 'x' },
+ 'deferral-detail' => { type => 'i' },
+ 'detail' => { type => 'i' },
+ 'dow0mon' => { type => 'b' },
+ 'dump-config' => { type => 'b' },
+ 'extended-detail' => { type => 'b', short => 'e' },
+ 'help' => { type => 'b' },
+ 'host-cnt' => { type => 'i', short => 'h' },
+ 'ignore-case' => { type => 'b', short => 'i' },
+ 'iso-date-time' => { type => 'b' },
+ 'mailq' => { type => 'b' },
+ 'no-no-msg-size' => { type => 'b' },
+ 'problems-first' => { type => 'b' },
+ 'pscrn-detail' => { type => 'i' }, # optional arg
+ 'pscrn-stats' => { type => 'b' },
+ 'quiet' => { type => 'b', short => 'q' },
+ 'rej-add-from' => { type => 'b' },
+ 'rej-add-to' => { type => 'b' },
+ 'reject-detail' => { type => 'i' },
+ 'smtp-detail' => { type => 'i' },
+ 'smtpd-stats' => { type => 'b' },
+ 'smtpd-warning-detail' => { type => 'i' },
+ 'srs-mung' => { type => 'b' },
+ 'syslog-name' => { type => 's' },
+ 'unprocd-file' => { type => 's' },
+ 'use-orig-to' => { type => 'b' },
+ 'user-cnt' => { type => 'i', short => 'u' },
+ 'uucp-mung' => { type => 'b', short => 'm' },
+ 'verbose-msg-detail' => { type => 'b' },
+ 'verp-mung' => { type => 'i' }, # optional arg
+ 'version' => { type => 'b' },
+);
+
+# Storage for actual values
+our %opts;
+
+# Dynamically build GetOptions argument list
+my @getopt_args;
+for my $long (sort keys %optionSpec) {
+ my $type = $optionSpec{$long}->{type};
+ my $short = $optionSpec{$long}->{short};
+
+ my $opt_string = $long;
+ if ($type eq 'f') {
+ $opt_string .= "=s";
+ } elsif ($type ne 'b') {
+ $opt_string .= "=$type";
+ }
+ push @getopt_args, $opt_string => \$opts{$long};
+
+ if (defined $short) {
+ my $short_string = $short;
+ if ($type eq 'f') {
+ $short_string .= "=s";
+ } elsif ($type ne 'b') {
+ $short_string .= "=$type";
+ }
+ push @getopt_args, $short_string => \$opts{$long};
+ }
+}
+
+# Ok, this is kind of ugly, but it solves a problem: We don't want to
+# *require* Config::Simple, but we also don't want to warn about it if it's
+# not needed, so...
+my $configFile;
+for (my $i = 0; $i < @ARGV; $i++) {
+ if($ARGV[$i] eq '--config' && defined $ARGV[$i + 1]) {
+ $configFile = $ARGV[$i + 1];
+ splice @ARGV, $i, 2; # Remove from ARGV
+ last;
+ }
+}
+
+if($haveConfigSimple) {
+ # manually import the Config::Simple routines we want
+ no warnings 'once';
+ *ConfigSimpleNew = sub { Config::Simple->new(@_) };
+ *ConfigSimpleVars = *Config::Simple::vars;
+ *ConfigSimpleError = *Config::Simple::error;
+
+} elsif(defined($configFile)) {
+ # If user specified --config but doesn't have Config::Simple
+ # installed, die with friendly help message.
+ die <<End_Of_HELP_CONFIG_SIMPLE;
+
+The option "--config", to read a config file, requires the
+Config::Simple 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 Config::Simple'
+
+End_Of_HELP_CONFIG_SIMPLE
+}
+
+# More ugly
+#
+# Can't just remove support for --underscore_options. Need
+# deprecation period with warnings, so...
+#
+my %seenName; # Avoid duplicate warnings
+for (@ARGV) {
+
+ last if $_ eq '--';
+
+ # Strip leading "--", skip if not present
+ next unless (my $rest = $_) =~ s/^--//;
+
+ my $orig = $_;
+
+ # Split name and possible "=value"
+ my ($name, $eq, $val) = $rest =~ /^([^=]+)(=?)(.*)$/;
+
+ # If no underscores in the name, nothing to do
+ next if index($name, '_') == -1;
+
+ # Translate underscores → hyphens in the *name* only
+ (my $dashed = $name) =~ tr/_/-/;
+
+ # Only warn/translate if the dashed form is actually a known option
+ next unless exists $optionSpec{$dashed};
+
+ # Rewrite this argv element
+ $_ = '--' . $dashed . ($eq ? "=$val" : '');
+
+ # Record deprecation message
+ next if $seenName{$name}++;
+ push @deprecated, sprintf 'Option "%s" deprecated, use "--%s" instead', $orig, $dashed . ($eq? $eq : '');
+}
+
+#
+###### Defaults ######
+#
+$opts{'colwidth'} = 80;
+#
+### End: Defaults ###
+#
+
+#
+# Read the configuration from a config file?
+#
+# GetOptions won't allow the user to specify blatantly wrong
+# things, such as a string to an integer option or a boolean
+# true/false to a switch, but Config::Simple will.
+#
+# So guardrails
+#
+if (defined $configFile) {
+ -f $configFile || die "Config file \"$configFile\" not found: $!\n";
+
+ my $cfg = ConfigSimpleNew($configFile) or die ConfigSimpleError();
+ my %cfgOpts = ConfigSimpleVars($cfg);
+
+ for my $cfgKey (keys %cfgOpts) {
+ my $key;
+ unless (($key) = ($cfgKey =~ /^default\.(.+)$/)) {
+ warn "Ignoring unsupported config section key: $cfgKey\n";
+ next;
+ }
+
+ unless (exists $optionSpec{$key}) {
+ warn "Ignoring unknown option in config file: $key\n";
+ next;
+ }
+
+ my $val = $cfgOpts{$cfgKey};
+ my $type = $optionSpec{$key}{type};
+ if ($type eq 's') {
+ $opts{$key} = $val;
+ }
+ elsif ($type eq 'i') {
+ if ($val =~ /^[1-9]\d*$/) {
+ $opts{$key} = $val;
+ } elsif ($val eq 'none') {
+ $opts{$key} = 0;
+ } elsif ($val eq 'all') {
+ $opts{$key} = undef;
+ } else {
+ warn "Ignoring invalid integer for $key: $val\n";
+ }
+ }
+ elsif ($type eq 'f') {
+ if ($val =~ /^-?\d+(?:\.\d+)?$/) {
+ $opts{$key} = $val;
+ } else {
+ warn "Ignoring invalid float for $key: $val\n";
+ }
+ }
+ elsif ($type eq 'b') {
+ if ($val =~ /^(yes|true|1)$/i) {
+ $opts{$key} = 1;
+ } elsif ($val =~ /^(no|false|0)$/i) {
+ $opts{$key} = 0;
+ } else {
+ warn "Ignoring invalid boolean for $key: $val\n";
+ }
+ }
+ }
+}
+
+
+GetOptions(@getopt_args) or die "Invalid command-line arguments\n\n$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'}));
-$opts{'colWidth'} = 0 if($opts{'verbMsgDetail'});
-$opts{'colWidth'} = -1 unless(defined($opts{'colWidth'}));
-# This one's a bit tricky because it works differently
-$opts{'pscrnDetail'} = defined($opts{'pscrnDetail'})? ($opts{'pscrnDetail'} == 0? -1 : $opts{'pscrnDetail'}) : 0;
+#
+$opts{'colwidth'} = 0 if($opts{'verbose-msg-detail'}); # This one's a bit different
+foreach my $optName (qw(bounce-detail colwidth deferral-detail host-cnt pscrn-detail reject-detail smtp-detail smtpd-warning-detail user-cnt)) {
+ $opts{$optName} = -1 unless(defined($opts{$optName}));
+}
# 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 pscrnDetail)) {
+ foreach my $optName (qw (bounce-detail deferral-detail host-cnt pscrn-detail reject-detail smtp-detail smtpd-warning-detail user-cnt)) {
$opts{$optName} = $opts{'detail'} unless($opts{"$optName"} != -1);
}
}
-if(defined $opts{'debug'}) {
- if(defined $opts{'pscrnDetail'}) {
- print STDERR "\$opts{'pscrnDetail'}: $opts{'pscrnDetail'}\n";
- } else {
- print STDERR "\$opts{'pscrnDetail'}: undef\n";
- }
-}
-my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix";
+my $syslogName = $opts{'syslog-name'}? $opts{'syslog-name'} : "postfix";
if(defined($opts{'help'})) {
print "$usageMsg\n";
exit 0;
}
-if($haveDateCalc) {
- # manually import the Date::Calc routine we want
- #
- # This looks stupid, but it's the only way to shut Perl up about
- # "Date::Calc::<blurfl>" 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;
- *Day_of_Week = *Date::Calc::Day_of_Week;
- *Day_of_Week = *Date::Calc::Day_of_Week;
-
-} elsif(defined($opts{'smtpdStats'}) || defined($opts{'pscrnStats'})) {
- # If user specified --smtpd-stats or --pscrn-stats but doesn't
- # have Date::Calc installed, die with friendly help message.
- die <<End_Of_HELP_DATE_CALC;
-
-The options "--smtpd-stats" and "--pscrn-stats" do 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
+($strtDate, $endDate) = get_dates($opts{'date-range'}, $opts{'dow0mon'}) if defined($opts{'date-range'});
+
+# Dump the configs & exit?
+if(defined($opts{'dump-config'})) {
+ use List::Util qw(reduce);
+ use Scalar::Util qw(looks_like_number);
+
+ # Create a string fomatter for nicely-formatted output
+ my $longestKey = reduce { length($a) > length($b) ? $a : $b } keys %opts;
+ # indent a little...
+ my $fmtStr = sprintf "%%%ds =", length($longestKey) + 2;
+
+ foreach my $key (sort keys(%opts)) {
+ next if $key eq 'dump-config';
+ if($optionSpec{$key}{'type'} eq 'b') {
+ printf "${fmtStr} %s\n", $key, defined($opts{$key})? "true" : "";
+ } elsif(looks_like_number($opts{$key})) {
+ # internally: 0 == none, undefined == -1 == all
+ my $val = $opts{$key} == 0? "none" : ($opts{$key} == -1? "all" : $opts{$key});
+ printf "${fmtStr} $val\n", $key;
+ } else {
+ printf "${fmtStr} %s\n", $key, defined($opts{$key})? $opts{$key} : "";
+ }
+ }
+ exit 0;
}
-($dateStr, $dateStrRFC3339, $dow) = get_datestrs($opts{'d'}, $haveDateCalc) if(defined($opts{'d'}));
-
# debugging
my $unProcd;
-if($opts{'unProcdFN'}) {
- open($unProcd, "> $opts{'unProcdFN'}") ||
- die "couldn't open \"$opts{'unProcdFN'}\": $!\n";
+if($opts{'unprocd-file'}) {
+ open($unProcd, "> $opts{'unprocd-file'}") ||
+ die "couldn't open \"$opts{'unprocd-file'}\": $!\n";
}
while(<>) {
- next if(defined($dateStr) && ! (/^${dateStr} / || /^${dateStrRFC3339}T/));
s/: \[ID \d+ [^\]]+\] /: /; # lose "[ID nnnnnn some.thing]" stuff
my $logRmdr;
- # "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;
- }
+ next unless((($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) = line_matches_dates($_, $strtDate, $endDate)) == 7);
+
+ # Snag first date seen
+ ($fromDate{'yr'}, $fromDate{'mon'}, $fromDate{'day'}) = ($msgYr, $msgMon, $msgDay) unless($fromDate{'mon'});
+ # Snag last date seen
+ ($thruDate{'yr'}, $thruDate{'mon'}, $thruDate{'day'}) = ($msgYr, $msgMon, $msgDay);
unless((($cmd, $qid) = $logRmdr =~ m#^(?:postfix|$syslogName)(?:/(?:smtps|submission))?/([^\[:]*).*?: ([^:\s]+)#o) == 2 ||
(($cmd, $qid) = $logRmdr =~ m#^((?:postfix)(?:-script)?)(?:\[\d+\])?: ([^:\s]+)#o) == 2)
}
chomp;
- # 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
# month--or at least that successive messages don't arrive on the
# same month-day in successive months :-)
$lastMsgDay = $msgDay;
$revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay;
++$dayCnt;
- if(defined($opts{'zeroFill'})) {
+ if(defined($opts{'zero-fill'})) {
${$msgsPerDay{$revMsgDateStr}}[4] = 0;
}
}
if($cmd eq "cleanup" && (my($rejSubTyp, $rejReas, $rejRmdr) = $logRmdr =~
/\/cleanup\[\d+\]: .*?\b((?:milter-)?reject|warning|hold|discard): (header|body|END-OF-MESSAGE) (.*)$/) == 3)
{
- $rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbMsgDetail'});
+ $rejRmdr =~ s/( from \S+?)?; from=<.*$// unless($opts{'verbose-msg-detail'});
# FIXME: In retrospect: I've no idea where I came up with the magic numbers I pass to this function.
$rejRmdr = string_trimmer($rejRmdr, 64);
- if($rejSubTyp eq "reject" or $rejSubTyp eq "milter-reject") {
- ++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
+ if($rejSubTyp eq "reject" or $rejSubTyp eq "milter-reject") {
+ ++$rejects{$cmd}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
++$msgsRjctd;
- --$msgsRcvd; # It will have already been counted as "Received," even though it ultimately is not
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd");
+ ++$qidTracker{$qid}{'lateRejects'};
+ }
+ --$msgsRcvd; # Late Reject: It will have already been counted as "Received," even though it ultimately is not
} elsif($rejSubTyp eq "warning") {
- ++$warns{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
+ ++$warns{$cmd}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
++$msgsWrnd;
} elsif($rejSubTyp eq "hold") {
- ++$holds{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
+ ++$holds{$cmd}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
++$msgsHld;
} elsif($rejSubTyp eq "discard") {
- ++$discards{$cmd}{$rejReas}{$rejRmdr} unless($opts{'rejectDetail'} == 0);
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp") if $opts{'debug'};
+ ++$discards{$cmd}{$rejReas}{$rejRmdr} unless($opts{'reject-detail'} == 0);
++$msgsDscrdd;
}
delete($rcvdMsg{$qid}); # We're done with this
++${$msgsPerDay{$revMsgDateStr}}[4];
} elsif($qid eq 'warning') {
(my $warnReas = $logRmdr) =~ s/^.*warning: //;
- unless($opts{'verbMsgDetail'}) {
+ unless($opts{'verbose-msg-detail'}) {
# Condense smtpd and other warnings
$warnReas =~ s/^(Unable to look up (?:MX|NS) host) for .+(: Host not found(?:,try again)?)/$1$2/ ||
$warnReas =~ s/^(hostname ).+ (does not resolve to address) [0-9A-F:\.]+$/$1$2/ ||
$warnReas =~ s/(process .+) pid \d+ (exit status \d+)/$1 $2/;
}
$warnReas = string_trimmer($warnReas, 66);
- unless($cmd eq "smtpd" && $opts{'smtpdWarnDetail'} == 0) {
+ unless($cmd eq "smtpd" && $opts{'smtpd-warning-detail'} == 0) {
++$warnings{$cmd}{$warnReas};
}
} elsif($qid eq 'fatal') {
} elsif($cmd eq 'master') {
++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]};
} elsif($cmd eq 'smtpd' || $cmd eq 'postscreen') {
- if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/) {
+ if((my $clientInfo = $logRmdr) =~ /\[\d+\]: \w+: client=(.+?)(?:,|$)/) {
#
# Warning: this code in two places!
#
++$rcvPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[0];
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, ++\$msgsRcvd");
+ ++$qidTracker{$qid}{'rcvdCnt'};
+ }
++$msgsRcvd;
- $rcvdMsg{$qid}{'whence'} = gimme_domain($1); # Whence it came
+ $rcvdMsg{$qid}{'whence'} = gimme_domain($clientInfo); # Whence it came
} 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]);
- delete($rcvdMsg{$qid}) if($rcvdMsg{$qid}); # If it's rejected later in the game
+ # Experimental
+ unless($qid eq 'NOQUEUE') {
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp, --\$msgsRcvd");
+ ++$qidTracker{$qid}{'lateRejects'};
+ }
+ --$msgsRcvd # Late reject: It's been counted as received already
+ }
+ delete($rcvdMsg{$qid}) if($rcvdMsg{$qid}); # Late Reject: If it's rejected later in the game
} elsif($rejSubTyp eq 'reject_warning') {
proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd,
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
} elsif($rejSubTyp eq 'hold') {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp") if $opts{'debug'};
proc_smtpd_reject($logRmdr, \%holds, \$msgsHld,
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
} elsif($rejSubTyp eq 'discard') {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$rejSubTyp: $rejSubTyp") if $opts{'debug'};
proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd,
\$rejPerHr[$msgHr],
\${$msgsPerDay{$revMsgDateStr}}[4]);
}
else {
if($cmd eq 'smtpd') {
- next unless(defined($opts{'smtpdStats'}));
+ next unless(defined($opts{'smtpd-stats'}));
if($logRmdr =~ /: connect from /) {
$logRmdr =~ /\/smtpd\[(\d+)\]: /;
@{$connTime{$1}} =
$smtpdTotTime += $tSecs;
}
}
- } elsif($cmd eq 'postscreen' && (defined $opts{'pscrnStats'} || $opts{'pscrnDetail'})) {
+ } elsif($cmd eq 'postscreen' && (defined $opts{'pscrn-stats'} || $opts{'pscrn-detail'})) {
my ($pscrnAct, $clientIP, $clientPort, $pscrnAddl, $capCnt);
print STDERR "\n" if($opts{'debug'});
- print STDERR "\$opts{'pscrnStats'}: " . ($opts{'pscrnStats'} // 0) .", \$opts{'pscrnDetail'}: $opts{'pscrnDetail'}\n" if($opts{'debug'});
+ print STDERR "\$opts{'pscrn-stats'}: " . ($opts{'pscrn-stats'} // 0) .", \$opts{'pscrn-detail'}: $opts{'pscrn-detail'}\n" if($opts{'debug'});
foreach my $regEx (@pscrnRegexs) {
print STDERR "\$regEx->{'expr'}: \"$regEx->{'expr'}\"\n" if($opts{'debug'});
if(($capCnt = (($pscrnAct, $clientIP, $clientPort, $pscrnAddl) = $logRmdr =~ /$regEx->{'expr'}/)) >= 3) {
my $bump_capt_cnt = sub {
if($capCnt == 4) {
print STDERR "Bumping \$pscrnHits{\"$pscrnAct $pscrnAddl\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
- ++$pscrnHits{"$pscrnAct $pscrnAddl"}{$clientIP} if($opts{'pscrnDetail'});
+ ++$pscrnHits{"$pscrnAct $pscrnAddl"}{$clientIP} if($opts{'pscrn-detail'});
print STDERR "\$cmd: \"$cmd\", \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
} else {
print STDERR "Bumping \$pscrnHits{\"$pscrnAct\"}{\"$clientIP\"} on \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
- ++$pscrnHits{$pscrnAct}{$clientIP} if($opts{'pscrnDetail'});
+ ++$pscrnHits{$pscrnAct}{$clientIP} if($opts{'pscrn-detail'});
print STDERR "\$cmd: \"$cmd\", \$logRmdr: \"$logRmdr\"\n" if($opts{'debug'});
}
};
$pscrnTotTime += $tSecs;
# Want the per-postscreen-action stats?
- $bump_capt_cnt->() if($opts{'pscrnDetail'} != 0 && $pscrnAct =~ /^PASS (NEW|OLD)$/);
+ $bump_capt_cnt->() if($opts{'pscrn-detail'} && $pscrnAct =~ /^PASS (NEW|OLD)$/);
}
} else {
- $bump_capt_cnt->() if($opts{'pscrnDetail'}); # Want the per-postscreen-action stats?
+ $bump_capt_cnt->() if($opts{'pscrn-detail'}); # Want the per-postscreen-action stats?
}
} elsif($capCnt == 4) {
- $bump_capt_cnt->() if($opts{'pscrnDetail'}); # Want the per-postscreen-action stats?
+ $bump_capt_cnt->() if($opts{'pscrn-detail'}); # Want the per-postscreen-action stats?
} else {
- print $unProcd "[02]: $_\n" if($unProcd && (defined $opts{'pscrnStats'} || $opts{'pscrnDetail'} != 0));
+ print $unProcd "[02]: $_\n" if($unProcd && (defined $opts{'pscrn-stats'} || $opts{'pscrn-detail'}));
}
}
}
my $toRmdr;
if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/) == 2)
{
+ ++$sizeDataExists; # Flag for orphan rcvdMsg cleanup: Older logs won't have size data
next if($rcvdMsg{$qid}{'size'}); # avoid double-counting!
if($addr) {
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
+ if($opts{'uucp-mung'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
- $addr = lc($addr) if($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'ignore-case'});
+ $addr = lc($addr) if($opts{'ignore-case'});
$addr = verp_mung($addr);
$addr = srs_mung($addr);
} else {
$addr = "from=<>"
}
$rcvdMsg{$qid}{'size'} = $size;
- push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
+ push(@{$msgDetail{$qid}}, $addr) if($opts{'extended-detail'});
# Avoid counting forwards
if($rcvdMsg{$qid}{'whence'}) {
# Get the domain out of the sender's address. If there is
elsif((($addr, $orig_to, $relay, $delay, $status, $toRmdr) = $logRmdr =~
/to=<([^>]*)>, (?:orig_to=<([^>]*)>, )?relay=([^,]+), (?:conn_use=[^,]+, )?delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=[^,]+, )?status=(\S+)(.*)$/) >= 4)
{
- $addr = $orig_to if($opts{'useOrigTo'} && $orig_to);
+ $addr = $orig_to if($opts{'use-orig-to'} && $orig_to);
- if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
+ if($opts{'uucp-mung'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/) {
$addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2";
}
- $addr =~ s/(@.+)/\L$1/ unless($opts{'i'});
- $addr = lc($addr) if($opts{'i'});
- $relay = lc($relay) if($opts{'i'});
+ $addr =~ s/(@.+)/\L$1/ unless($opts{'ignore-case'});
+ $addr = lc($addr) if($opts{'ignore-case'});
+ $relay = lc($relay) if($opts{'ignore-case'});
(my $domAddr = $addr) =~ s/^[^@]+\@//; # get domain only
if($status eq 'sent') {
# was it actually forwarded, rather than delivered?
if((my $newQid) = ($toRmdr =~ /\(forwarded as ([^\)]+)\)/)) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$status: $status, forwarded as new qid $1, ++\$msgsFwdd") if $opts{'debug'};
++$msgsFwdd;
delete($rcvdMsg{$qid}); # We're done with this
next;
++${$recipUser{$addr}}[MSG_CNT_I];
++$dlvPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[1];
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$status: $status, ++\$msgsDlvrd");
+ ++$qidTracker{$qid}{'dlvrdCnt'};
+ }
++$msgsDlvrd;
if($rcvdMsg{$qid}{'size'}) {
${$recipDom{$domAddr}}[MSG_SIZE_I] += $rcvdMsg{$qid}{'size'};
} else {
${$recipDom{$domAddr}}[MSG_SIZE_I] += 0;
${$recipUser{$addr}}[MSG_SIZE_I] += 0;
- $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'});
- push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'});
+ $noMsgSize{$qid} = $addr unless($opts{'no-no-msg-size'});
+ push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'extended-detail'});
# put this back later? mebbe with -v?
# msg_warn("no message size for qid: $qid");
}
- push(@{$msgDetail{$qid}}, $addr) if($opts{'e'});
+ push(@{$msgDetail{$qid}}, $addr) if($opts{'extended-detail'});
} elsif($status eq 'deferred') {
- unless($opts{'deferralDetail'} == 0) {
+ unless($opts{'deferral-detail'} == 0) {
my ($deferredReas) = $logRmdr =~ /, status=deferred \(([^\)]+)/;
- if(!defined($opts{'verbMsgDetail'})) {
+ if(!defined($opts{'verbose-msg-detail'})) {
my ($host, $reason, $moreReason); # More ugliness :/
unless((($host, $reason) = ($deferredReas =~ /^host (\S+) (?:said|refused to talk to me): ([^(]+)/)) ||
(($host, $reason) = ($deferredReas =~ /^(?:delivery temporarily suspended: )?connect to (.+?(?::\d+)?): ([^)]+)$/)) ||
}
++$dfrPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[2];
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$status: $status, ++\$msgsDfrd") if $opts{'debug'};
++$msgsDfrdCnt;
++$msgsDfrd unless($msgDfrdFlgs{$qid}++);
++${$recipDom{$domAddr}}[MSG_DFRS_I];
${$recipDom{$domAddr}}[MSG_DLY_MAX_I] = $delay
}
} elsif($status eq 'bounced') {
- unless($opts{'bounceDetail'} == 0) {
+ unless($opts{'bounce-detail'} == 0) {
my ($bounceReas) = $logRmdr =~ /, status=bounced \((.+)\)/;
- unless(defined($opts{'verbMsgDetail'})) {
+ unless(defined($opts{'verbose-msg-detail'})) {
$bounceReas = said_string_trimmer($bounceReas, 66);
}
++$bounced{$relay}{$bounceReas};
}
++$bncPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[3];
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, \$status: $status, ++\$msgsBncd") if $opts{'debug'};
++$msgsBncd;
} else {
print $unProcd "[03]: $_\n" if $unProcd;
#
++$rcvPerHr[$msgHr];
++${$msgsPerDay{$revMsgDateStr}}[0];
+ if($opts{'debug'}) {
+ push(@{$qidTracker{$qid}{'status'}}, "\$cmd: $cmd, ++\$msgsRcvd");
+ ++$qidTracker{$qid}{'rcvdCnt'};
+ }
++$msgsRcvd;
$rcvdMsg{$qid}{'whence'} = "pickup"; # Whence it came
}
- elsif($cmd eq 'smtp' && $opts{'smtpDetail'} != 0) {
+ elsif($cmd eq 'smtp' && $opts{'smtp-detail'} != 0) {
# Was an IPv6 problem here
if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/) {
++$smtpMsgs{lc($2)}{$1};
}
}
-# Experimental:
+# Experimental heuristic:
#
# If messages were "received" but undelivered, unforwarded, and not
# rejected in cleanup, odds are nothing was ever really received—not
# even a 0-length message.
#
+# N.B.: This may result in wonky outcomes for older Postfix logs
+# where some of the data in newer logs isn't availble.
+#
if(my $noSizeCnt = scalar grep { !exists $rcvdMsg{$_}{'size'} } keys %rcvdMsg) {
- $msgsRcvd -= $noSizeCnt;
+ foreach my $qid (keys %rcvdMsg) {
+ push(@{$qidTracker{$qid}{'status'}}, "No \$rcvdMsg{$qid}{'size'} at end of processing: --\$msgsRcvd") if $opts{'debug'};
+ }
+ $msgsRcvd -= $noSizeCnt if $sizeDataExists;
+}
+
+# Extensive queue I.D. lifetime tracking
+if($opts{'debug'} && scalar keys %qidTracker) {
+ my ($qidCnt, $rcvdDlvrd, $dlvrdCnt, $addlDlvr, $multiDlvrCnt, $noSizeCnt,
+ $addlRcvd, $multiRcvdCnt, $noRcvdCnt, $lateRejects) = ((0) x 10);
+
+ foreach my $qid (sort keys %qidTracker) {
+ ++$qidCnt;
+ print STDERR "qid: $qid\n";
+ if(exists $qidTracker{$qid}{'dlvrdCnt'}) {
+ ++$rcvdDlvrd;
+ $dlvrdCnt += $qidTracker{$qid}{'dlvrdCnt'};
+ if($qidTracker{$qid}{'dlvrdCnt'} > 1) {
+ $addlDlvr += $qidTracker{$qid}{'dlvrdCnt'} - 1;
+ ++$multiDlvrCnt;
+ }
+ print STDERR " delivered cnt: $qidTracker{$qid}{'dlvrdCnt'}\n"
+ } else {
+ print STDERR " delivered cnt: 0\n";
+ }
+ if(! $qidTracker{$qid}{'rcvdCnt'}) {
+ print STDERR " received cnt: 0\n";
+ ++$noRcvdCnt;
+ } elsif($qidTracker{$qid}{'rcvdCnt'} > 1) {
+ $addlRcvd += $qidTracker{$qid}{'rcvdCnt'} - 1;
+ ++$multiRcvdCnt;
+ print STDERR " received cnt: $qidTracker{$qid}{'rcvdCnt'}\n";
+ }
+ $lateRejects += $qidTracker{$qid}{'lateRejects'} if $qidTracker{$qid}{'lateRejects'};
+ foreach my $event (@{$qidTracker{$qid}{'status'}}) {
+ print STDERR " $event\n";
+ }
+ if(exists $rcvdMsg{$qid} && ! exists $rcvdMsg{$qid}{'size'}) {
+ print STDERR " no size data\n";
+ ++$noSizeCnt;
+ }
+ }
+ printf STDERR "\n %6d%s qids\n", adj_int_units($qidCnt);
+ printf STDERR " %6d%s qids delivered\n", adj_int_units($rcvdDlvrd);
+ printf STDERR " %6d%s qids w/multi-deliveries\n", adj_int_units($multiDlvrCnt);
+ printf STDERR " %6d%s total add'l deliveries\n", adj_int_units($addlDlvr);
+ printf STDERR " %6d%s qids w/multi-received\n", adj_int_units($multiRcvdCnt);
+ printf STDERR " %6d%s total add'l received\n", adj_int_units($addlRcvd);
+ printf STDERR " %6d%s qids w/no received count\n", adj_int_units($noRcvdCnt);
+ printf STDERR " %6d%s forwarded\n", adj_int_units($msgsFwdd);
+ printf STDERR " %6d%s delivered by cnt\n", adj_int_units($dlvrdCnt);
+ printf STDERR " %6d%s discarded\n", adj_int_units($msgsDscrdd);
+ printf STDERR " %6d%s qids w/no size data\n", adj_int_units($noSizeCnt);
+ printf STDERR " %6d%s late rejects (rec'd but not dlvrd)\n", adj_int_units($lateRejects);
}
# debugging
if($unProcd) {
close($unProcd) ||
- warn "problem closing \"$opts{'unProcdFN'}\": $!\n";
+ warn "problem closing \"$opts{'unprocd-file'}\": $!\n";
}
# Calculate percentage of messages rejected and discarded
}
print "Postfix Log Summaries";
-if(defined($dateStr)) {
- (my $dispDate = $dateStr) =~ s/\[ 0\]// if($dateStr);
- $dow .= ", " if(length($dow));
- print " for ${dow}${dispDate}";
+if (defined($thruDate{'mon'}) && defined($thruDate{'day'})) {
+ # We can safely assume that if we've a thruDate we've a fromDate
+ my $monName = $monthNames[ $fromDate{'mon'}];
+ my $day = $fromDate{'day'};
+ my $yr = $fromDate{'yr'} // $thisYr;
+
+ # st00pid Day_of_Week requires months indexed from 1, not 0 <smh>
+ my $dowIdx = Day_of_Week($yr, $fromDate{'mon'} + 1, $day);
+ my $dowStr = $dowNames[$dowIdx];
+ $day =~ s/^0//;
+
+ print " for $dowStr, $monName $day $yr";
+
+ # One or both of these could be undefined, so...
+ my $fromYr = $fromDate{'yr'} // $thisYr;
+ my $thruYr = $thruDate{'yr'} // $thisYr;
+
+ unless($fromDate{'mon'} == $thruDate{'mon'} &&
+ $fromDate{'day'} == $thruDate{'day'} &&
+ $fromYr == $thruYr)
+ {
+ my $monName = $monthNames[ $thruDate{'mon'}];
+ my $day = $thruDate{'day'};
+ my $yr = $thruDate{'yr'} // $thisYr;
+
+ my $dowIdx = Day_of_Week($yr, $thruDate{'mon'} + 1, $day);
+ my $dowStr = $dowNames[$dowIdx];
+ $day =~ s/^0//;
+
+ print " through $dowStr, $monName $day $yr";
+ }
}
print "\n";
+# Did they use any deprecated "_" options?
+if(scalar @deprecated) {
+ print "\n";
+ print "$_\n" foreach (@deprecated);
+}
+
print_subsect_title("Grand Totals");
print "messages\n\n";
printf " %6d%s received\n", adj_int_units($msgsRcvd);
printf " %6d%s recipients\n", adj_int_units($recipUserCnt);
printf " %6d%s recipient hosts/domains\n", adj_int_units($recipDomCnt);
-if(defined($opts{'smtpdStats'})) {
+if(defined($opts{'smtpd-stats'})) {
print "\nsmtpd\n\n";
printf " %6d%s connections\n", adj_int_units($smtpdConnCnt);
printf " %6d%s hosts/domains\n", adj_int_units(int(keys %smtpdPerDom));
}
}
-if(defined($opts{'pscrnStats'})) {
+if(defined($opts{'pscrn-stats'})) {
print "\npostscreen\n\n";
printf " %6d%s connections\n", adj_int_units($pscrnConnCnt);
printf " %6d%s IP addresses\n", adj_int_units(int(keys %pscrnPerIP));
print "\n";
-print_problems_reports() if(defined($opts{'pf'}));
+print_problems_reports() if(defined($opts{'problems-first'}));
print_per_day_summary(\%msgsPerDay) if($dayCnt > 1);
print_per_hour_summary(\@rcvPerHr, \@dlvPerHr, \@dfrPerHr, \@bncPerHr,
\@rejPerHr, $dayCnt);
-print_recip_domain_summary(\%recipDom, $opts{'h'});
-print_sending_domain_summary(\%sendgDom, $opts{'h'});
+print_recip_domain_summary(\%recipDom, $opts{'host-cnt'});
+print_sending_domain_summary(\%sendgDom, $opts{'host-cnt'});
-if(defined($opts{'smtpdStats'})) {
+if(defined($opts{'smtpd-stats'})) {
print_per_day_smtpd(\%smtpdPerDay, $dayCnt) if($dayCnt > 1);
print_per_hour_smtpd(\@smtpdPerHr, $dayCnt);
- print_domain_smtpd_summary(\%smtpdPerDom, $opts{'h'});
+ print_domain_smtpd_summary(\%smtpdPerDom, $opts{'host-cnt'});
}
-print_user_data(\%sendgUser, "Senders by message count", MSG_CNT_I, $opts{'u'}, $opts{'q'});
-print_user_data(\%recipUser, "Recipients by message count", MSG_CNT_I, $opts{'u'}, $opts{'q'});
-print_user_data(\%sendgUser, "Senders by message size", MSG_SIZE_I, $opts{'u'}, $opts{'q'});
-print_user_data(\%recipUser, "Recipients by message size", MSG_SIZE_I, $opts{'u'}, $opts{'q'});
+print_user_data(\%sendgUser, "Senders by message count", MSG_CNT_I, $opts{'user-cnt'}, $opts{'quiet'});
+print_user_data(\%recipUser, "Recipients by message count", MSG_CNT_I, $opts{'user-cnt'}, $opts{'quiet'});
+print_user_data(\%sendgUser, "Senders by message size", MSG_SIZE_I, $opts{'user-cnt'}, $opts{'quiet'});
+print_user_data(\%recipUser, "Recipients by message size", MSG_SIZE_I, $opts{'user-cnt'}, $opts{'quiet'});
print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1);
-print_problems_reports() unless(defined($opts{'pf'}));
+print_problems_reports() unless(defined($opts{'problems-first'}));
-print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'});
+print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'quiet'}) if($opts{'extended-detail'});
# Print "problems" reports
sub print_problems_reports {
- unless($opts{'deferralDetail'} == 0) {
- print_nested_hash(\%deferred, "message deferral detail", $opts{'deferralDetail'}, $opts{'q'});
+ unless($opts{'deferral-detail'} == 0) {
+ print_nested_hash(\%deferred, "message deferral detail", $opts{'deferral-detail'}, $opts{'quiet'});
}
- unless($opts{'bounceDetail'} == 0) {
- print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'bounceDetail'}, $opts{'q'});
+ unless($opts{'bounce-detail'} == 0) {
+ print_nested_hash(\%bounced, "message bounce detail (by relay)", $opts{'bounce-detail'}, $opts{'quiet'});
}
- 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{'reject-detail'} == 0) {
+ print_nested_hash(\%rejects, "message reject detail", $opts{'reject-detail'}, $opts{'quiet'});
+ print_nested_hash(\%warns, "message reject warning detail", $opts{'reject-detail'}, $opts{'quiet'});
+ print_nested_hash(\%holds, "message hold detail", $opts{'reject-detail'}, $opts{'quiet'});
+ print_nested_hash(\%discards, "message discard detail", $opts{'reject-detail'}, $opts{'quiet'});
}
- unless($opts{'smtpDetail'} == 0) {
- print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtpDetail'}, $opts{'q'});
+ unless($opts{'smtp-detail'} == 0) {
+ print_nested_hash(\%smtpMsgs, "smtp delivery failures", $opts{'smtp-detail'}, $opts{'quiet'});
}
- unless($opts{'smtpdWarnDetail'} == 0) {
- print_nested_hash(\%warnings, "Warnings", $opts{'smtpdWarnDetail'}, $opts{'q'});
+ unless($opts{'smtpd-warning-detail'} == 0) {
+ print_nested_hash(\%warnings, "Warnings", $opts{'smtpd-warning-detail'}, $opts{'quiet'});
}
- print_nested_hash(\%pscrnHits, "postscreen actions", $opts{'pscrnDetail'}, $opts{'q'}) if($opts{'pscrnDetail'});
+ print_nested_hash(\%pscrnHits, "postscreen actions", $opts{'pscrn-detail'}, $opts{'quiet'}) if($opts{'pscrn-detail'});
- 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'});
+ print_nested_hash(\%fatals, "Fatal Errors", 0, $opts{'quiet'});
+ print_nested_hash(\%panics, "Panics", 0, $opts{'quiet'});
+ print_hash_by_cnt_vals(\%masterMsgs,"Master daemon messages", 0, $opts{'quiet'});
}
if($opts{'mailq'}) {
foreach (sort { $a <=> $b } keys(%$msgsPerDay)) {
my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
- if($isoDateTime) {
+ if($opts{'iso-date-time'}) {
printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
} else {
my $msgMonStr = $monthNames[$msgMon];
End_Of_Per_Hour_Heading
for($hour = 0; $hour < 24; ++$hour) {
- if($isoDateTime) {
+ if($opts{'iso-date-time'}) {
printf " %02d:00-%02d:00", $hour, $hour + 1;
} else {
printf " %02d00-%02d00 ", $hour, $hour + 1;
}
my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]);
- if($isoDateTime) {
+ if($opts{'iso-date-time'}) {
printf " %02d:00-%02d:00", $hour, $hour + 1;
} else {
printf " %02d00-%02d00 ", $hour, $hour + 1;
foreach (sort { $a <=> $b } keys(%$smtpdPerDay)) {
my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_);
- if($isoDateTime) {
+ if($opts{'iso-date-time'}) {
printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay
} else {
my $msgMonStr = $monthNames[$msgMon];
}
}
-# return traditional and RFC3339 date strings to match in log
-sub get_datestrs {
- my ($dateOpt, $haveDateCalc) = @_;
+# Get range of dates to parse
+sub get_dates {
+ my ($range, $day0mon, $currTime) = @_;
+ my ($startYr, $startMon, $startDay, $endYr, $endMon, $endDay);
+
+ $currTime //= time();
+ my ($sec, $min, $hour, $day, $mon, $yr) = localtime($currTime);
+ $yr += 1900;
+ $mon += 1;
+
+ # Normalize
+ $range =~ s/_/ /g;
+
+ if ($range eq 'today') {
+ ($startYr, $startMon, $startDay) = ($yr, $mon, $day);
+ ($endYr, $endMon, $endDay) = ($yr, $mon, $day);
+ }
+ elsif ($range eq 'yesterday') {
+ ($startYr, $startMon, $startDay) = Add_Delta_Days($yr, $mon, $day, -1);
+ ($endYr, $endMon, $endDay) = ($startYr, $startMon, $startDay);
+ }
+ elsif ($range eq 'this week' or $range eq 'last week') {
+ # 1) Get local calendar date for "now"
+ my ($sec,$min,$hour,$d,$mo,$y) = localtime($currTime);
+ my $midnight_now = timelocal(0,0,0, $d, $mo, $y); # local midnight of "now"
+
+ # 2) Day-of-week at local midnight (0=Sun..6=Sat)
+ my $dow = (localtime($midnight_now))[6];
+
+ # 3) Days since start-of-week (Sun-start vs Mon-start)
+ my $since_start = $day0mon ? ($dow == 0 ? 6 : $dow - 1) : $dow;
+
+ # 4) Convert to Y-M-D, then use calendar math only
+ my ($ny,$nmon,$nday) = ($y + 1900, $mo + 1, $d);
+
+ my $offset = -$since_start + ($range eq 'last week' ? -7 : 0);
+ my ($sy,$sm,$sd) = Add_Delta_Days($ny, $nmon, $nday, $offset); # start (Y-M-D)
+ my ($ey,$em,$ed) = Add_Delta_Days($sy, $sm, $sd, 6); # end (Y-M-D)
+
+ # 5) Back to epochs at local midnight (isdst auto-handled)
+ my $start_epoch = timelocal(0,0,0, $sd, $sm-1, $sy-1900);
+ my $end_epoch = timelocal(0,0,0, $ed, $em-1, $ey-1900);
+
+ ($startYr,$startMon,$startDay) = ($sy,$sm,$sd);
+ ($endYr, $endMon, $endDay) = ($ey,$em,$ed);
+ }
+ elsif ($range eq 'this month') {
+ ($startYr, $startMon, $startDay) = ($yr, $mon, 1);
+ ($endYr, $endMon, $endDay) = Add_Delta_Days($yr, $mon, 1, Days_in_Month($yr, $mon) - 1);
+ }
+ elsif ($range eq 'last month') {
+ my ($lastYr, $lastMon) = ($mon == 1) ? ($yr - 1, 12) : ($yr, $mon - 1);
+ ($startYr, $startMon, $startDay) = ($lastYr, $lastMon, 1);
+ ($endYr, $endMon, $endDay) = Add_Delta_Days($lastYr, $lastMon, 1, Days_in_Month($lastYr, $lastMon) - 1);
+ }
+ elsif ($range =~ /^(\d{4})-(\d{2})(?:-(\d{2}))?$/) {
+ ($startYr, $startMon, $startDay) = ($1, $2, $3);
+ unless(defined($startDay)) {
+ $startDay = 1;
+ ($endYr, $endMon, $endDay) = ($1, $2, Days_in_Month($startYr, $startMon));
+ } else {
+ ($endYr, $endMon, $endDay) = ($1, $2, $3);
+ }
+ }
+ elsif ($range =~ /^(\d{4}-\d{2}(?:-\d{2})?)\s+(?:(?:to|-)\s+)?(\d{4}-\d{2}(?:-\d{2})?)$/) {
+ my ($s, $e) = ($1, $2);
+ ($startYr, $startMon, $startDay) = split(/-/, $s);
+ $startDay = 1 unless($startDay);
+ ($endYr, $endMon, $endDay) = split(/-/, $e);
+ $endDay = Days_in_Month($endYr, $endMon) unless($endDay);
+ } else {
+ die "Invalid date range format: '$range'\n";
+ }
+
+ my $start_time = timelocal(0, 0, 0, $startDay, $startMon - 1, $startYr - 1900);
+ my $end_time = timelocal(0, 0, 0, $endDay, $endMon - 1, $endYr - 1900);
+
+ die "End date precedes start date: '$range'" if $end_time < $start_time;
+
+ return ($start_time, $end_time);
+}
+
+#
+# If a line matches the desired date (range): Return the year, month, day, hour, minutes, seconds, and log remainder
+#
+# N.B.: Year is returned adj. to +1900
+# Month is returned as 0-11
+#
+sub line_matches_dates {
+ my ($line, $startEpoch, $endEpoch) = @_;
+ my $now = time();
+
+ my ($epoch, $msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr);
+
+ # Try RFC 3339 / ISO 8601 first
+ if (scalar (($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
+ ($line =~ /^(?:<\d{1,3}>(?:[1-9]\d*\s+|\s*))?(\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;
+
+ return ($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) unless(defined($startEpoch) && defined($endEpoch));
- my $time = time();
+ $epoch = eval { timelocal(0, 0, 0, $msgDay, $msgMon, $msgYr - 1900) };
+ return ($epoch >= $startEpoch && $epoch <= $endEpoch)
+ ? ($msgYr, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr)
+ : (undef);
+ }
- if($dateOpt eq "yesterday") {
- # Back up to yesterday
- $time -= ((localtime($time))[2] + 2) * 3600;
- } elsif($dateOpt ne "today") {
- die "$usageMsg\n";
+ # Try traditional syslog format
+ my $monStr;
+ if(scalar (($monStr, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) =
+ ($line =~ /^(?:<\d{1,3}>(?:[1-9]\d*\s+|\s*))?(\w{3}) {1,2}(\d{1,2}) (\d{2}):(\d{2}):(\d{2}) \S+ (.+)$/)) == 6)
+ {
+ return (undef) unless defined($msgMon = $monthNums{$monStr});
+ #$msgMon = $monthNums{$monStr};
+ #unless(defined($msgMon)) {
+ # print "dbg: \$msgMon undefined from \$monStr: \"$monStr\"\n";
+ # return (undef);
+ #}
+ my ($currMon, $currYr) = (localtime($now))[4,5];
+ # If month in logfile line is > current month the logfile line must be from last year
+ --$currYr if($msgMon > $currMon);
+
+ return ($currYr + 1900, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr) unless (defined($startEpoch) && defined($endEpoch));
+
+ $epoch = eval { timelocal(0, 0, 0, $msgDay, $msgMon, $currYr) };
+ return (defined $epoch && $epoch >= $startEpoch && $epoch <= $endEpoch)
+ ? ($currYr + 1900, $msgMon, $msgDay, $msgHr, $msgMin, $msgSec, $logRmdr)
+ : (undef);
}
- my ($t_mday, $t_mon, $t_year) = (localtime($time))[3,4,5];
- my $dow = ($dateOpt && $haveDateCalc)? $dowNames[Day_of_Week($t_year + 1900, $t_mon + 1, $t_mday)] : "";
- return @{[map {s/ (\d)$/[ 0]$1/; $_} sprintf("%s %2d", $monthNames[$t_mon], $t_mday)]},
- sprintf("%04d-%02d-%02d", $t_year+1900, $t_mon+1, $t_mday), $dow;
+ return (undef); # Not a parsable line
}
-# if there's a real domain: uses that. Otherwise uses the IP addr.
+
+# if there's a real hostname/domain: uses that. Otherwise uses
+# the IP addr.
#
# N.B.: in-addr.arpa and ip6.arpa FQDNs return IP addrs
#
$fqdn = "unknown" unless($fqdn);
$ipaddr = "unknown" unless($ipaddr);
- my $domain;
- if($fqdn eq "unknown" || $fqdn =~ /\.(in-addr|ip6)\.arpa$/) {
- $domain = $ipaddr;
- } else {
- ($domain = $fqdn) =~ s/^(.*)\.([^\.]+)\.([^\.]{3,15}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/;
+ return $ipaddr if($fqdn eq "unknown" || $fqdn =~ /\.(in-addr|ip6)\.arpa$/);
+
+ my $domain = lc $fqdn;
+
+ # Skip if no dot (single-label or malformed)
+ return $domain unless $domain =~ /\./;
+
+ my @parts = split /\./, $domain;
+ my $tld = $parts[-1];
+ my $sld = $parts[-2];
+ my %original_tlds = map { $_ => 1 } qw(com net org gov mil edu);
+
+ if ($original_tlds{$tld}) {
+ # Collapse to second-level domain: example.com
+ return "$sld.$tld";
}
- return $domain;
+ # Otherwise elide leftmost: host.example.co.uk → example.co.uk
+ # if more than 3 elements
+ if (@parts > 3) {
+ shift @parts;
+ return join('.', @parts);
+ } else {
+ return $domain;
+ }
}
# Return (value, units) for integer
sub string_trimmer {
my($trimmedString, $maxLen) = @_;
- unless($opts{'colWidth'} == 0) {
- $maxLen += $opts{'colWidth'} - 80 if($opts{'colWidth'} > 0);
+ unless($opts{'colwidth'} == 0) {
+ $maxLen += $opts{'colwidth'} - 80 if($opts{'colwidth'} > 0);
if(length($trimmedString) > $maxLen) {
$trimmedString = substr($trimmedString, 0, $maxLen - 3) . "...";
}
# 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);
+ return if($opts{'reject-detail'} == 0);
# This could get real ugly!
# Next: get the reject "reason"
$rejReas = $rejRmdr;
- unless(defined($opts{'verbMsgDetail'})) {
+ unless(defined($opts{'verbose-msg-detail'})) {
if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT" || $rejTyp eq "BDAT") { # special treatment :-(
# If there are "<>"s immediately following the reject code, that's
# an email address or HELO string. There can be *anything* in
(($to) = $rejRmdr =~ /\d{3} <([^>]+)>: User unknown /) ||
(($to) = $rejRmdr =~ /to=<(.*?)(?:[, ]|$)/) ||
($to = "<>");
- $to = lc($to) if($opts{'i'});
+ $to = lc($to) if($opts{'ignore-case'});
# Snag sender address
(($from) = $rejRmdr =~ /from=<([^>]+)>/) || ($from = "<>");
if(defined($from)) {
$from = verp_mung($from);
$from = srs_mung($from);
- $from = lc($from) if($opts{'i'});
+ $from = lc($from) if($opts{'ignore-case'});
}
# stash in "triple-subscripted-array"
# Sender address rejected: Domain not found
# Sender address rejected: need fully-qualified address
my $rejData = $from;
- $rejData .= " ($to)" if($opts{'rejAddTo'} && $to);
+ $rejData .= " ($to)" if($opts{'rej-add-to'} && $to);
++$rejects->{$rejTyp}{$rejReas}{$rejData};
} elsif($rejReas =~ m/^(Recipient address rejected:|User unknown( |$))/) {
# Recipient address rejected: Domain not found
# User unknown (in local/relay recipient table)
#++$rejects->{$rejTyp}{$rejReas}{$to};
my $rejData = $to;
- if($opts{'rejAddFrom'}) {
+ if($opts{'rej-add-from'}) {
$rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")";
}
++$rejects->{$rejTyp}{$rejReas}{$rejData};
++$rejects->{$rejTyp}{$rejReas}{$src};
} elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/) {
my $rejData = gimme_domain($rejFrom);
- $rejData .= " ($from)" if($opts{'rejAddFrom'});
+ $rejData .= " ($from)" if($opts{'rej-add-from'});
++$rejects->{$rejTyp}{$rejReas}{$rejData};
} elsif($rejReas =~ s/^.*?\d{3} (Server configuration (?:error|problem));.*$/(Local) $1/) {
my $rejData = gimme_domain($rejFrom);
- $rejData .= " ($from)" if($opts{'rejAddFrom'});
+ $rejData .= " ($from)" if($opts{'rej-add-from'});
+ ++$rejects->{$rejTyp}{$rejReas}{$rejData};
+ } elsif($rejReas =~ m/^Helo command rejected: Invalid name$/) {
+ my $rejData = gimme_domain($rejFrom);
+ $rejData .= " ($from)" if($opts{'rej-add-from'});
++$rejects->{$rejTyp}{$rejReas}{$rejData};
} else {
print STDERR "dbg: unknown/un-enumerated reject reason: \$rejReas: \"$rejReas\", \$rejTyp: \"$rejTyp\", \$rejFrom: \"$rejFrom\"!\n" if($opts{'debug'});
my $rejData = gimme_domain($rejFrom);
- if($opts{'rejAddFrom'} && $opts{'rejAddTo'} && $to) {
+ if($opts{'rej-add-from'} && $opts{'rej-add-to'} && $to) {
$rejData .= " ($from -> $to)";
- } elsif($opts{'rejAddFrom'}) {
+ } elsif($opts{'rej-add-from'}) {
$rejData .= " (< $from)";
- } elsif($opts{'rejAddTo'} && $to) {
+ } elsif($opts{'rej-add-to'} && $to) {
$rejData .= " (> $to)";
}
++$rejects->{$rejTyp}{$rejReas}{$rejData};
sub verp_mung {
my $addr = $_[0];
- if(defined($opts{'verpMung'})) {
+ if(defined($opts{'verp-mung'})) {
$addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/i;
- if($opts{'verpMung'} > 1) {
+ if($opts{'verp-mung'} > 1) {
$addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/;
}
}
sub srs_mung {
my $addr = $_[0];
- if(defined($opts{'srsMung'})) {
+ if(defined($opts{'srs-mung'})) {
$addr =~ s/^SRS(?:[01])(?:[=+-])(?:[^=]+=[\w\.]+==)*(?:[^=]+=[^=]+=)([\w\.]+)=(.+)@[\w\.]+$/$2\@$1/i;
}
projects / sven / pflogsumm.git / commitdiff