From f96c237b659dfe729ed1c43bba8cf29aea1101e2 Mon Sep 17 00:00:00 2001 From: Sven Hoexter Date: Sat, 3 Oct 2009 08:23:55 +0000 Subject: [PATCH] Remove the modified pflogsumm.pl from 1.1.0-3. --- pflogsumm.pl | 1604 -------------------------------------------------- 1 file changed, 1604 deletions(-) delete mode 100755 pflogsumm.pl diff --git a/pflogsumm.pl b/pflogsumm.pl deleted file mode 100755 index d584327..0000000 --- a/pflogsumm.pl +++ /dev/null @@ -1,1604 +0,0 @@ -#!/usr/bin/perl -eval 'exec perl -S $0 "$@"' - if 0; - -=head1 NAME - -pflogsumm.pl - Produce Postfix MTA logfile summary - -Copyright (C) 1998-2003 by James S. Seymour, Release 1.1.0. - -=head1 SYNOPSIS - - pflogsumm.pl -[eq] [-d ] [-h ] [-u ] - [--verp_mung[=]] [--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 -[help|version] - - If no file(s) specified, reads from stdin. Output is to stdout. - -=head1 DESCRIPTION - - Pflogsumm is a log analyzer/summarizer for the Postfix MTA. It is - designed to provide an over-view of Postfix activity, with just enough - detail to give the administrator a "heads up" for potential trouble - spots. - - Pflogsumm generates summaries and, in some cases, detailed reports of - mail server traffic volumes, rejected and bounced email, and server - warnings, errors and panics. - -=head1 OPTIONS - - -d today generate report for just today - -d yesterday generate report for just "yesterday" - - -e 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. - - WARNING: the data built to generate this report can - quickly consume very large amounts of memory if a - lot of log entries are processed! - - -h top to display in host/domain reports. - - 0 = none. - - See also: "-u" and "--no_*_detail" for further - report-limiting options. - - --help Emit short usage message and bail out. - - (By happy coincidence, "-h" alone does much the same, - being as it requires a numeric argument :-). Yeah, I - know: lame.) - - -i - --ignore_case Handle complete email address in a case-insensitive - manner. - - Normally pflogsumm lower-cases only the host and - domain parts, leaving the user part alone. This - option causes the entire email address to be lower- - cased. - - --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 - - This is for use when you have a mix of Internet-style - domain addresses and UUCP-style bang-paths in the log. - Upstream UUCP feeds sometimes mung Internet domain - style address into bang-paths. This option can - sometimes undo the "damage". For example: - "somehost.dom!username@foo" (where "foo" is the next - host upstream and "somehost.dom" was whence the email - originated) will get converted to - "foo!username@somehost.dom". This also affects the - extended detail report (-e), to help ensure that by- - domain-by-name sorting is more accurate. - - --mailq Run "mailq" command at end of report. - - Merely a convenience feature. (Assumes that "mailq" - is in $PATH. See "$mailqCmd" variable to path thisi - if desired.) - - --no_bounce_detail - --no_deferral_detail - --no_reject_detail - - Suppresses the printing of the following detailed - reports, respectively: - - message bounce detail (by relay) - message deferral detail - message reject detail - - See also: "-u" and "-h" for further report-limiting - options. - - --no_no_msg_size - - Do not emit report on "Messages with no size data". - - Message size is reported only by the queue manager. - The message may be delivered long-enough after the - (last) qmgr log entry that the information is not in - the log(s) processed by a particular run of - pflogsumm.pl. This throws off "Recipients by message - size" and the total for "bytes delivered." These are - normally reported by pflogsumm as "Messages with no - size data." - - --no_smtpd_warnings - - 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 - - Emit "problems" reports (bounces, defers, warnings, - etc.) before "normal" stats. - - --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 - SMTP command pipelining" report.) - - -q quiet - don't print headings for empty reports - - note: headings for warning, fatal, and "master" - messages will always be printed. - - --smtpd_stats - - Generate smtpd connection statistics. - - The "per-day" report is not generated for single-day - reports. For multiple-day reports: "per-hour" numbers - are daily averages (reflected in the report heading). - - --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. - If you've set a non-default "syslog_name" parameter - in your Postfix configuration, use this option to - tell pflogsumm what that is. - - See the discussion about the use of this option under - "NOTES," below. - - -u top to display in user reports. 0 == none. - - See also: "-h" and "--no_*_detail" for further - report-limiting options. - - --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 - "list-return-NN-someuser=some.dom@host.sender.dom" - to - "list-return-ID-someuser=some.dom@host.sender.dom" - - In other words: replace the numeric value with "ID". - - By specifying the optional "=2" (second form), the - munging is more "aggressive", converting the address - to something like: - - "list-return@host.sender.dom" - - Actually: specifying anything less than 2 does the - "simple" munging and anything greater than 1 results - in the more "aggressive" hack being applied. - - See "NOTES" regarding this option. - - --version Print program name and version and bail out. - - --zero_fill "Zero-fill" certain arrays so reports come out with - data in columns that that might otherwise be blank. - -=head1 RETURN VALUE - - Pflogsumm doesn't return anything of interest to the shell. - -=head1 ERRORS - - Error messages are emitted to stderr. - -=head1 EXAMPLES - - Produce a report of previous day's activities: - - pflogsumm.pl -d yesterday /var/log/maillog - - A report of prior week's activities (after logs rotated): - - pflogsumm.pl /var/log/maillog.0 - - What's happened so far today: - - pflogsumm.pl -d today /var/log/maillog - - Crontab entry to generate a report of the previous day's activity - 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 - - 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 - - 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. - -=head1 SEE ALSO - - The pflogsumm FAQ: pflogsumm-faq.txt. - -=head1 NOTES - - Pflogsumm makes no attempt to catch/parse non-Postfix log - entries. Unless it has "postfix/" in the log entry, it will be - ignored. - - It's important that the logs are presented to pflogsumm in - chronological order so that message sizes are available when - needed. - - For display purposes: integer values are munged into "kilo" and - "mega" notation as they exceed certain values. I chose the - admittedly arbitrary boundaries of 512k and 512m as the points at - which to do this--my thinking being 512x was the largest number - (of digits) that most folks can comfortably grok at-a-glance. - These are "computer" "k" and "m", not 1000 and 1,000,000. You - can easily change all of this with some constants near the - beginning of the program. - - "Items-per-day" reports are not generated for single-day - reports. For multiple-day reports: "Items-per-hour" numbers are - daily averages (reflected in the report headings). - - Message rejects, reject warnings, holds and discards are all - reported under the "rejects" column for the Per-Hour and Per-Day - traffic summaries. - - Verp munging may not always result in correct address and - address-count reduction. - - Verp munging is always in a state of experimentation. The use - of this option may result in inaccurate statistics with regards - to the "senders" count. - - UUCP-style bang-path handling needs more work. Particularly if - Postfix is not being run with "swap_bangpath = yes" and/or *is* being - run with "append_dot_mydomain = yes", the detailed by-message report - may not be sorted correctly by-domain-by-user. (Also depends on - upstream MTA, I suspect.) - - The "percent rejected" and "percent discarded" figures are only - approximations. They are calculated as follows (example is for - "percent rejected"): - - percent rejected = - - (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 - /etc/postfix/sample-misc.cf: - - # Beware: a non-default syslog_name setting takes effect only - # after process initialization. Some initialization errors will be - # logged with the default name, especially errors while parsing - # the command line and errors while accessing the Postfix main.cf - # configuration file. - - As a consequence, pflogsumm must always look for "postfix," in logs, - as well as whatever is supplied for syslog_name. - - Where this becomes an issue is where people are running two or more - instances of Postfix, logging to the same file. In such a case: - - . Neither instance may use the default "postfix" syslog name - and... - - . Log entries that fall victim to what's described in - sample-misc.cf will be reported under "postfix", so that if - you're running pflogsumm twice, once for each syslog_name, such - log entries will show up in each report. - - The Pflogsumm Home Page is at: - - http://jimsun.LinxNet.com/postfix_contrib.html - -=head1 REQUIREMENTS - - 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. - As of version 19990413-02, pflogsumm worked with Perl 5.003, but - future compatibility is not guaranteed. - -=head1 LICENSE - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You may have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, - USA. - - An on-line copy of the GNU General Public License can be found - http://www.fsf.org/copyleft/gpl.html. - -=cut - -use strict; -use locale; -use Getopt::Long; -# ---Begin: SMTPD_STATS_SUPPORT--- -use Date::Calc qw(Delta_DHMS); -# ---End: SMTPD_STATS_SUPPORT--- - -my $mailqCmd = "mailq"; -my $release = "1.1.0"; - -# Variables and constants used throughout pflogsumm -use vars qw( - $progName - $usageMsg - %opts - $divByOneKAt $divByOneMegAt $oneK $oneMeg - @monthNames %monthNums $thisYr $thisMon - $msgCntI $msgSizeI $msgDfrsI $msgDlyAvgI $msgDlyMaxI - $isoDateTime -); - -# Some constants used by display routines. I arbitrarily chose to -# display in kilobytes and megabytes at the 512k and 512m boundaries, -# respectively. Season to taste. -$divByOneKAt = 524288; # 512k -$divByOneMegAt = 536870912; # 512m -$oneK = 1024; # 1k -$oneMeg = 1048576; # 1m - -# Constants used throughout pflogsumm -@monthNames = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); -%monthNums = qw( - Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5 - Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11); -($thisMon, $thisYr) = (localtime(time()))[4,5]; -$thisYr += 1900; - -# -# Variables used only in main loop -# -# Per-user data -my (%recipUser, $recipUserCnt); -my (%sendgUser, $sendgUserCnt); -# Per-domain data -my (%recipDom, $recipDomCnt); # recipient domain data -my (%sendgDom, $sendgDomCnt); # sending domain data -# Indexes for arrays in above -$msgCntI = 0; # message count -$msgSizeI = 1; # total messages size -$msgDfrsI = 2; # number of defers -$msgDlyAvgI = 3; # total of delays (used for averaging) -$msgDlyMaxI = 4; # max delay - -my ( - $cmd, $qid, $addr, $size, $relay, $status, $delay, - $dateStr, - %panics, %fatals, %warnings, %masterMsgs, - %msgSizes, - %deferred, %bounced, - %noMsgSize, %msgDetail, - $msgsRcvd, $msgsDlvrd, $sizeRcvd, $sizeDlvrd, - $msgMonStr, $msgMon, $msgDay, $msgTimeStr, $msgHr, $msgMin, $msgSec, - $msgYr, - $revMsgDateStr, $dayCnt, %msgsPerDay, - %rejects, $msgsRjctd, - %warns, $msgsWrnd, - %discards, $msgsDscrdd, - %holds, $msgsHld, - %rcvdMsg, $msgsFwdd, $msgsBncd, - $msgsDfrdCnt, $msgsDfrd, %msgDfrdFlgs, - %connTime, %smtpdPerDay, %smtpdPerDom, $smtpdConnCnt, $smtpdTotTime, - %smtpMsgs -); -$dayCnt = $smtpdConnCnt = $smtpdTotTime = 0; - -# Init total messages delivered, rejected, and discarded -$msgsDlvrd = $msgsRjctd = $msgsDscrdd = 0; - -# Init messages received and delivered per hour -my @rcvPerHr = (0) x 24; -my @dlvPerHr = @rcvPerHr; -my @dfrPerHr = @rcvPerHr; # defers per hour -my @bncPerHr = @rcvPerHr; # bounces per hour -my @rejPerHr = @rcvPerHr; # rejects per hour -my $lastMsgDay = 0; - -# Init "doubly-sub-scripted array": cnt, total and max time per-hour -my @smtpdPerHr; -for (0 .. 23) { - $smtpdPerHr[$_] = [0,0,0]; -} - -$progName = "pflogsumm.pl"; -$usageMsg = - "usage: $progName -[eq] [-d ] [-h ] [-u ] - [--verp_mung[=]] [--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]] - - $progName --[version|help]"; - -# 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'} -) || die "$usageMsg\n"; - -# internally: 0 == none, undefined == -1 == all -$opts{'h'} = -1 unless(defined($opts{'h'})); -$opts{'u'} = -1 unless(defined($opts{'u'})); -my $syslogName = $opts{'syslogName'}? $opts{'syslogName'} : "postfix"; - -if(defined($opts{'help'})) { - print "$usageMsg\n"; - exit 0; -} - -if(defined($opts{'version'})) { - print "$progName $release\n"; - exit 0; -} - -$dateStr = get_datestr($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 - 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) - { - #print UNPROCD "$_"; - next; - } - chomp; - - # snatch out log entry date & time - $msgMon = $monthNums{$msgMonStr}; - $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 :-) - unless($msgDay == $lastMsgDay) { - $lastMsgDay = $msgDay; - $revMsgDateStr = sprintf "%d%02d%02d", $msgYr, $msgMon, $msgDay; - ++$dayCnt; - if(defined($opts{'zeroFill'})) { - ${$msgsPerDay{$revMsgDateStr}}[4] = 0; - } - } - - # 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) - { - $rejRmdr =~ s/( from \S+?)?; from=<.*$//o unless($opts{'verbMsgDetail'}); - $rejRmdr = string_trimmer($rejRmdr, 64, $opts{'verbMsgDetail'}); - if($rejSubTyp eq "reject") { - ++$rejects{$cmd}{$rejReas}{$rejRmdr}; - ++$msgsRjctd; - } elsif($rejSubTyp eq "warning") { - ++$warns{$cmd}{$rejReas}{$rejRmdr}; - ++$msgsWrnd; - } elsif($rejSubTyp eq "hold") { - ++$holds{$cmd}{$rejReas}{$rejRmdr}; - ++$msgsHld; - } elsif($rejSubTyp eq "discard") { - ++$discards{$cmd}{$rejReas}{$rejRmdr}; - ++$msgsDscrdd; - } - ++$rejPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[4]; - } elsif($qid eq 'warning') { - (my $warnReas = $logRmdr) =~ s/^.*warning: //o; - $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; - $fatalReas = string_trimmer($fatalReas, 66, $opts{'verbMsgDetail'}); - ++$fatals{$cmd}{$fatalReas}; - } elsif($qid eq 'panic') { - (my $panicReas = $logRmdr) =~ s/^.*panic: //o; - $panicReas = string_trimmer($panicReas, 66, $opts{'verbMsgDetail'}); - ++$panics{$cmd}{$panicReas}; - } elsif($qid eq 'reject') { - proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($qid eq 'reject_warning') { - proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($qid eq 'hold') { - proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($qid eq 'discard') { - proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($cmd eq 'master') { - ++$masterMsgs{(split(/^.*master.*: /, $logRmdr))[1]}; - } elsif($cmd eq 'smtpd') { - if($logRmdr =~ /\[\d+\]: \w+: client=(.+?)(,|$)/o) { - # - # Warning: this code in two places! - # - ++$rcvPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[0]; - ++$msgsRcvd; - $rcvdMsg{$qid} = gimme_domain($1); # Whence it came - } elsif(my($rejSubTyp) = $logRmdr =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /o) { - if($rejSubTyp eq 'reject') { - proc_smtpd_reject($logRmdr, \%rejects, \$msgsRjctd, - \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($rejSubTyp eq 'reject_warning') { - proc_smtpd_reject($logRmdr, \%warns, \$msgsWrnd, - \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($rejSubTyp eq 'hold') { - proc_smtpd_reject($logRmdr, \%holds, \$msgsHld, - \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } elsif($rejSubTyp eq 'discard') { - proc_smtpd_reject($logRmdr, \%discards, \$msgsDscrdd, - \$rejPerHr[$msgHr], - \${$msgsPerDay{$revMsgDateStr}}[4]); - } - } -# ---Begin: SMTPD_STATS_SUPPORT--- - else { - next unless(defined($opts{'smtpdStats'})); - if($logRmdr =~ /: connect from /o) { - $logRmdr =~ /\/smtpd\[(\d+)\]: /o; - @{$connTime{$1}} = - ($msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec); - } elsif($logRmdr =~ /: disconnect from /o) { - my ($pid, $hostID) = $logRmdr =~ /\/smtpd\[(\d+)\]: disconnect from (.+)$/o; - if(exists($connTime{$pid})) { - $hostID = gimme_domain($hostID); - my($d, $h, $m, $s) = Delta_DHMS(@{$connTime{$pid}}, - $msgYr, $msgMon + 1, $msgDay, $msgHr, $msgMin, $msgSec); - delete($connTime{$pid}); # dispose of no-longer-needed item - my $tSecs = (86400 * $d) + (3600 * $h) + (60 * $m) + $s; - - ++$smtpdPerHr[$msgHr][0]; - $smtpdPerHr[$msgHr][1] += $tSecs; - $smtpdPerHr[$msgHr][2] = $tSecs if($tSecs > $smtpdPerHr[$msgHr][2]); - - unless(${$smtpdPerDay{$revMsgDateStr}}[0]++) { - ${$smtpdPerDay{$revMsgDateStr}}[1] = 0; - ${$smtpdPerDay{$revMsgDateStr}}[2] = 0; - } - ${$smtpdPerDay{$revMsgDateStr}}[1] += $tSecs; - ${$smtpdPerDay{$revMsgDateStr}}[2] = $tSecs - if($tSecs > ${$smtpdPerDay{$revMsgDateStr}}[2]); - - unless(${$smtpdPerDom{$hostID}}[0]++) { - ${$smtpdPerDom{$hostID}}[1] = 0; - ${$smtpdPerDom{$hostID}}[2] = 0; - } - ${$smtpdPerDom{$hostID}}[1] += $tSecs; - ${$smtpdPerDom{$hostID}}[2] = $tSecs - if($tSecs > ${$smtpdPerDom{$hostID}}[2]); - - ++$smtpdConnCnt; - $smtpdTotTime += $tSecs; - } - } - } -# ---End: SMTPD_STATS_SUPPORT--- - } else { - my $toRmdr; - if((($addr, $size) = $logRmdr =~ /from=<([^>]*)>, size=(\d+)/o) == 2) - { - next if($msgSizes{$qid}); # avoid double-counting! - if($addr) { - if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) { - $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2"; - } - $addr =~ s/(@.+)/\L$1/o unless($opts{'i'}); - $addr = lc($addr) if($opts{'i'}); - $addr = verp_mung($addr); - } else { - $addr = "from=<>" - } - $msgSizes{$qid} = $size; - push(@{$msgDetail{$qid}}, $addr) if($opts{'e'}); - # Avoid counting forwards - if($rcvdMsg{$qid}) { - # 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) { - $domAddr = $rcvdMsg{$qid} eq "pickup"? $addr : $rcvdMsg{$qid}; - } - ++$sendgDomCnt - unless(${$sendgDom{$domAddr}}[$msgCntI]); - ++${$sendgDom{$domAddr}}[$msgCntI]; - ${$sendgDom{$domAddr}}[$msgSizeI] += $size; - ++$sendgUserCnt unless(${$sendgUser{$addr}}[$msgCntI]); - ++${$sendgUser{$addr}}[$msgCntI]; - ${$sendgUser{$addr}}[$msgSizeI] += $size; - $sizeRcvd += $size; - delete($rcvdMsg{$qid}); # limit hash size - } - } - elsif((($addr, $relay, $delay, $status, $toRmdr) = $logRmdr =~ - /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=\d+\.\d+\.\d+, )?status=(\S+)(.*)$/o) >= 4) - { - - if($opts{'m'} && $addr =~ /^(.*!)*([^!]+)!([^!@]+)@([^\.]+)$/o) { - $addr = "$4!" . ($1? "$1" : "") . $3 . "\@$2"; - } - $addr =~ s/(@.+)/\L$1/o unless($opts{'i'}); - $addr = lc($addr) if($opts{'i'}); - (my $domAddr = $addr) =~ s/^[^@]+\@//o; # get domain only - if($status eq 'sent') { - - # was it actually forwarded, rather than delivered? - if($toRmdr =~ /forwarded as /o) { - ++$msgsFwdd; - next; - } - ++$recipDomCnt unless(${$recipDom{$domAddr}}[$msgCntI]); - ++${$recipDom{$domAddr}}[$msgCntI]; - ${$recipDom{$domAddr}}[$msgDlyAvgI] += $delay; - if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] || - $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI]) - { - ${$recipDom{$domAddr}}[$msgDlyMaxI] = $delay - } - ++$recipUserCnt unless(${$recipUser{$addr}}[$msgCntI]); - ++${$recipUser{$addr}}[$msgCntI]; - ++$dlvPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[1]; - ++$msgsDlvrd; - if($msgSizes{$qid}) { - ${$recipDom{$domAddr}}[$msgSizeI] += $msgSizes{$qid}; - ${$recipUser{$addr}}[$msgSizeI] += $msgSizes{$qid}; - $sizeDlvrd += $msgSizes{$qid}; - } else { - ${$recipDom{$domAddr}}[$msgSizeI] += 0; - ${$recipUser{$addr}}[$msgSizeI] += 0; - $noMsgSize{$qid} = $addr unless($opts{'noNoMsgSize'}); - push(@{$msgDetail{$qid}}, "(sender not in log)") if($opts{'e'}); - # put this back later? mebbe with -v? - # msg_warn("no message size for qid: $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; - } - ++$deferred{$cmd}{$deferredReas}; - ++$dfrPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[2]; - ++$msgsDfrdCnt; - ++$msgsDfrd unless($msgDfrdFlgs{$qid}++); - ++${$recipDom{$domAddr}}[$msgDfrsI]; - if(! ${$recipDom{$domAddr}}[$msgDlyMaxI] || - $delay > ${$recipDom{$domAddr}}[$msgDlyMaxI]) - { - ${$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; - } - ++$bounced{$relay}{$bounceReas}; - ++$bncPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[3]; - ++$msgsBncd; - } else { -# print UNPROCD "$_\n"; - } - } - elsif($cmd eq 'pickup' && $logRmdr =~ /: (sender|uid)=/o) { - # - # Warning: this code in two places! - # - ++$rcvPerHr[$msgHr]; - ++${$msgsPerDay{$revMsgDateStr}}[0]; - ++$msgsRcvd; - $rcvdMsg{$qid} = "pickup"; # Whence it came - } - elsif($cmd eq 'smtp') { - # Was an IPv6 problem here - if($logRmdr =~ /.* connect to (\S+?): ([^;]+); address \S+ port.*$/o) { - ++$smtpMsgs{lc($2)}{$1}; - } elsif($logRmdr =~ /.* connect to ([^[]+)\[\S+?\]: (.+?) \(port \d+\)$/o) { - ++$smtpMsgs{lc($2)}{$1}; - } else { -# print UNPROCD "$_\n"; - } - } - else - { -# print UNPROCD "$_\n"; - } - } -} - -# debugging -#close(UNPROCD) || -# die "problem closing \"unprocessed\": $!\n"; - -# Calculate percentage of messages rejected and discarded -my $msgsRjctdPct = 0; -my $msgsDscrddPct = 0; -if(my $msgsTotal = $msgsDlvrd + $msgsRjctd + $msgsDscrdd) { - $msgsRjctdPct = int(($msgsRjctd/$msgsTotal) * 100); - $msgsDscrddPct = int(($msgsDscrdd/$msgsTotal) * 100); -} - -if(defined($dateStr)) { - print "Postfix log summaries for $dateStr\n"; -} - -print "\nGrand Totals\n------------\n"; -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 forwarded\n", adj_int_units($msgsFwdd); -printf " %6d%s deferred", adj_int_units($msgsDfrd); -printf " (%d%s deferrals)", adj_int_units($msgsDfrdCnt) if($msgsDfrdCnt); -print "\n"; -printf " %6d%s bounced\n", adj_int_units($msgsBncd); -printf " %6d%s rejected (%d%%)\n", adj_int_units($msgsRjctd), $msgsRjctdPct; -printf " %6d%s reject warnings\n", adj_int_units($msgsWrnd); -printf " %6d%s held\n", adj_int_units($msgsHld); -printf " %6d%s discarded (%d%%)\n", adj_int_units($msgsDscrdd), $msgsDscrddPct; -print "\n"; -printf " %6d%s bytes received\n", adj_int_units($sizeRcvd); -printf " %6d%s bytes delivered\n", adj_int_units($sizeDlvrd); -printf " %6d%s senders\n", adj_int_units($sendgUserCnt); -printf " %6d%s sending hosts/domains\n", adj_int_units($sendgDomCnt); -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); - printf " %6d%s hosts/domains\n", adj_int_units(int(keys %smtpdPerDom)); - printf " %6d avg. connect time (seconds)\n", - $smtpdConnCnt > 0? ($smtpdTotTime / $smtpdConnCnt) + .5 : 0; - { - my ($sec, $min, $hr) = get_smh($smtpdTotTime); - printf " %2d:%02d:%02d total connect time\n", - $hr, $min, $sec; - } -} -# ---End: SMTPD_STATS_SUPPORT--- - -print "\n"; - -print_problems_reports() if(defined($opts{'pf'})); - -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'}); - -# ---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_user_data(\%sendgUser, "Senders by message size", $msgSizeI, $opts{'u'}, $opts{'q'}); -print_user_data(\%recipUser, "Recipients by message size", $msgSizeI, $opts{'u'}, $opts{'q'}); - -print_hash_by_key(\%noMsgSize, "Messages with no size data", 0, 1); - -print_problems_reports() unless(defined($opts{'pf'})); - -print_detailed_msg_data(\%msgDetail, "Message detail", $opts{'q'}) if($opts{'e'}); - -# Print "problems" reports -sub print_problems_reports { - unless($opts{'noDeferralDetail'}) { - print_nested_hash(\%deferred, "message deferral detail", $opts{'q'}); - } - unless($opts{'noBounceDetail'}) { - print_nested_hash(\%bounced, "message bounce detail (by relay)", $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'}); - } - 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"; - system($mailqCmd); -} - -# print "per-day" traffic summary -# (done in a subroutine only to keep main-line code clean) -sub print_per_day_summary { - my($msgsPerDay) = @_; - my $value; - print < $b } keys(%$msgsPerDay)) { - my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_); - if($isoDateTime) { - printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay - } else { - my $msgMonStr = $monthNames[$msgMon]; - printf " $msgMonStr %2d $msgYr", $msgDay; - } - foreach $value (@{$msgsPerDay->{$_}}) { - my $value2 = $value? $value : 0; - printf " %6d%s", adj_int_units($value2); - } - print "\n"; - } -} - -# print "per-hour" traffic summary -# (done in a subroutine only to keep main-line code clean) -sub print_per_hour_summary { - my ($rcvPerHr, $dlvPerHr, $dfrPerHr, $bncPerHr, $rejPerHr, $dayCnt) = @_; - my $reportType = $dayCnt > 1? 'Daily Average' : 'Summary'; - my ($hour, $value); - print < 0? "(top $cnt)" : ""; - my $avgDly; - print <{$_}}[$msgCntI]) { - $avgDly = (${$hashRef->{$_}}[$msgDlyAvgI] / - ${$hashRef->{$_}}[$msgCntI]); - } else { - $avgDly = 0; - } - printf " %6d%s %6d%s %6d%s %5.1f %s %5.1f %s %s\n", - adj_int_units(${$hashRef->{$_}}[$msgCntI]), - adj_int_units(${$hashRef->{$_}}[$msgSizeI]), - adj_int_units(${$hashRef->{$_}}[$msgDfrsI]), - adj_time_units($avgDly), - adj_time_units(${$hashRef->{$_}}[$msgDlyMaxI]), - $_; - last if --$cnt == 0; - } -} - -# print "per-sender-domain" traffic summary -# (done in a subroutine only to keep main-line code clean) -sub print_sending_domain_summary { - use vars '$hashRef'; - local($hashRef) = $_[0]; - my($cnt) = $_[1]; - return if($cnt == 0); - my $topCnt = $cnt > 0? "(top $cnt)" : ""; - print <{$_}}[$msgCntI]), - adj_int_units(${$hashRef->{$_}}[$msgSizeI]), - $_; - last if --$cnt == 0; - } -} - -# print "per-user" data sorted in descending order -# order (i.e.: highest first) -sub print_user_data { - my($hashRef, $title, $index, $cnt, $quiet) = @_; - my $dottedLine; - return if($cnt == 0); - $title = sprintf "%s%s", $cnt > 0? "top $cnt " : "", $title; - unless(%$hashRef) { - return if($quiet); - $dottedLine = ": none"; - } else { - $dottedLine = "\n" . "-" x length($title); - } - printf "\n$title$dottedLine\n"; - foreach (map { $_->[0] } - sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } - map { [ $_, $hashRef->{$_}[$index], normalize_host($_) ] } - (keys(%$hashRef))) - { - printf " %6d%s %s\n", adj_int_units(${$hashRef->{$_}}[$index]), $_; - last if --$cnt == 0; - } -} - -# ---Begin: SMTPD_STATS_SUPPORT--- - -# print "per-hour" smtpd connection summary -# (done in a subroutine only to keep main-line code clean) -sub print_per_hour_smtpd { - my ($smtpdPerHr, $dayCnt) = @_; - my ($hour, $value); - if($dayCnt > 1) { - print <[0] || next; - my $avg = int($smtpdPerHr[$hour]->[0]? - ($smtpdPerHr[$hour]->[1]/$smtpdPerHr[$hour]->[0]) + .5 : 0); - if($dayCnt > 1) { - $smtpdPerHr[$hour]->[0] /= $dayCnt; - $smtpdPerHr[$hour]->[1] /= $dayCnt; - $smtpdPerHr[$hour]->[0] += .5; - $smtpdPerHr[$hour]->[1] += .5; - } - my($sec, $min, $hr) = get_smh($smtpdPerHr[$hour]->[1]); - - if($isoDateTime) { - printf " %02d:00-%02d:00", $hour, $hour + 1; - } else { - printf " %02d00-%02d00 ", $hour, $hour + 1; - } - printf " %6d%s %2d:%02d:%02d", - adj_int_units($smtpdPerHr[$hour]->[0]), - $hr, $min, $sec; - if($dayCnt < 2) { - printf " %6ds %6ds", - $avg, - $smtpdPerHr[$hour]->[2]; - } - print "\n"; - } -} - - -# 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 < $b } keys(%$smtpdPerDay)) { - my ($msgYr, $msgMon, $msgDay) = unpack("A4 A2 A2", $_); - if($isoDateTime) { - printf " %04d-%02d-%02d ", $msgYr, $msgMon + 1, $msgDay - } else { - my $msgMonStr = $monthNames[$msgMon]; - printf " $msgMonStr %2d $msgYr", $msgDay; - } - - my $avg = (${$smtpdPerDay{$_}}[1]/${$smtpdPerDay{$_}}[0]) + .5; - my($sec, $min, $hr) = get_smh(${$smtpdPerDay{$_}}[1]); - - printf " %6d%s %2d:%02d:%02d %6ds %6ds\n", - adj_int_units(${$smtpdPerDay{$_}}[0]), - $hr, $min, $sec, - $avg, - ${$smtpdPerDay{$_}}[2]; - } -} - -# print "per-domain-smtpd" connection summary -# (done in a subroutine only to keep main-line code clean) -sub print_domain_smtpd_summary { - use vars '$hashRef'; - local($hashRef) = $_[0]; - my($cnt) = $_[1]; - return if($cnt == 0); - my $topCnt = $cnt > 0? "(top $cnt)" : ""; - my $avgDly; - print <{$_}}[1]/${$hashRef->{$_}}[0]) + .5; - my ($sec, $min, $hr) = get_smh(${$hashRef->{$_}}[1]); - - printf " %6d%s %2d:%02d:%02d %6ds %6ds %s\n", - adj_int_units(${$hashRef->{$_}}[0]), - $hr, $min, $sec, - $avg, - ${$hashRef->{$_}}[2], - $_; - last if --$cnt == 0; - } -} - -# ---End: SMTPD_STATS_SUPPORT--- - -# print hash contents sorted by numeric values in descending -# order (i.e.: highest first) -sub print_hash_by_cnt_vals { - my($hashRef, $title, $cnt, $quiet) = @_; - my $dottedLine; - $title = sprintf "%s%s", $cnt? "top $cnt " : "", $title; - unless(%$hashRef) { - return if($quiet); - $dottedLine = ": none"; - } else { - $dottedLine = "\n" . "-" x length($title); - } - printf "\n$title$dottedLine\n"; - really_print_hash_by_cnt_vals($hashRef, $cnt, ' '); -} - -# print hash contents sorted by key in ascending order -sub print_hash_by_key { - my($hashRef, $title, $cnt, $quiet) = @_; - my $dottedLine; - $title = sprintf "%s%s", $cnt? "first $cnt " : "", $title; - unless(%$hashRef) { - return if($quiet); - $dottedLine = ": none"; - } else { - $dottedLine = "\n" . "-" x length($title); - } - printf "\n$title$dottedLine\n"; - foreach (sort keys(%$hashRef)) - { - printf " %s %s\n", $_, $hashRef->{$_}; - last if --$cnt == 0; - } -} - -# print "nested" hashes -sub print_nested_hash { - my($hashRef, $title, $quiet) = @_; - my $dottedLine; - unless(%$hashRef) { - return if($quiet); - $dottedLine = ": none"; - } else { - $dottedLine = "\n" . "-" x length($title); - } - printf "\n$title$dottedLine\n"; - walk_nested_hash($hashRef, 0); -} - -# "walk" a "nested" hash -sub walk_nested_hash { - my ($hashRef, $level) = @_; - $level += 2; - my $indents = ' ' x $level; - my ($keyName, $hashVal) = each(%$hashRef); - - if(ref($hashVal) eq 'HASH') { - foreach (sort keys %$hashRef) { - print "$indents$_"; - # If the next hash is finally the data, total the - # counts for the report and print - 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 "\n"; - walk_nested_hash($hashRef->{$_}, $level); - } - } else { - really_print_hash_by_cnt_vals($hashRef, 0, $indents); - } -} - - -# print per-message info in excruciating detail :-) -sub print_detailed_msg_data { - use vars '$hashRef'; - local($hashRef) = $_[0]; - my($title, $quiet) = @_[1,2]; - my $dottedLine; - unless(%$hashRef) { - return if($quiet); - $dottedLine = ": none"; - } else { - $dottedLine = "\n" . "-" x length($title); - } - printf "\n$title$dottedLine\n"; - foreach (sort by_domain_then_user keys(%$hashRef)) - { - printf " %s %s\n", $_, shift(@{$hashRef->{$_}}); - foreach (@{$hashRef->{$_}}) { - print " $_\n"; - } - print "\n"; - } -} - -# *really* print hash contents sorted by numeric values in descending -# order (i.e.: highest first), then by IP/addr, in ascending order. -sub really_print_hash_by_cnt_vals { - my($hashRef, $cnt, $indents) = @_; - - foreach (map { $_->[0] } - sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] } - map { [ $_, $hashRef->{$_}, normalize_host($_) ] } - (keys(%$hashRef))) - { - printf "$indents%6d%s %s\n", adj_int_units($hashRef->{$_}), $_; - last if --$cnt == 0; - } -} - -# Normalize IP addr or hostname -# (Note: Makes no effort to normalize IPv6 addrs. Just returns them -# as they're passed-in.) -sub normalize_host { - # 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) { - # Dotted-quad IP address - return(pack('C4', @octets)); - } else { - # Possibly hostname or user@dom.ain - return(join( '', map { lc $_ } reverse split /[.@]/, $norm1 )); - } -} - -# subroutine to sort by domain, then user in domain, then by queue i.d. -# Note: mixing Internet-style domain names and UUCP-style bang-paths -# may confuse this thing. An attempt is made to use the first host -# preceding the username in the bang-path as the "domain" if none is -# found otherwise. -sub by_domain_then_user { - # first see if we can get "user@somedomain" - my($userNameA, $domainA) = split(/\@/, ${$hashRef->{$a}}[0]); - my($userNameB, $domainB) = split(/\@/, ${$hashRef->{$b}}[0]); - - # try "somedomain!user"? - ($userNameA, $domainA) = (split(/!/, ${$hashRef->{$a}}[0]))[-1,-2] - unless($domainA); - ($userNameB, $domainB) = (split(/!/, ${$hashRef->{$b}}[0]))[-1,-2] - unless($domainB); - - # 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 - if($domainA); - $domainB =~ s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/$2.$3.$1/o - if($domainB); - - # oddly enough, doing this here is marginally faster than doing - # an "if-else", above. go figure. - $domainA = "" unless($domainA); - $domainB = "" unless($domainB); - - if($domainA lt $domainB) { - return -1; - } elsif($domainA gt $domainB) { - return 1; - } else { - # disregard leading bang-path - $userNameA =~ s/^.*!//o; - $userNameB =~ s/^.*!//o; - if($userNameA lt $userNameB) { - return -1; - } elsif($userNameA gt $userNameB) { - return 1; - } else { - if($a lt $b) { - return -1; - } elsif($a gt $b) { - return 1; - } - } - } - return 0; -} - -# Subroutine used by host/domain reports to sort by count, then size. -# We "fix" un-initialized values here as well. Very ugly and un- -# structured to do this here - but it's either that or the callers -# must run through the hashes twice :-(. -sub by_count_then_size { - ${$hashRef->{$a}}[$msgCntI] = 0 unless(${$hashRef->{$a}}[$msgCntI]); - ${$hashRef->{$b}}[$msgCntI] = 0 unless(${$hashRef->{$b}}[$msgCntI]); - if(${$hashRef->{$a}}[$msgCntI] == ${$hashRef->{$b}}[$msgCntI]) { - ${$hashRef->{$a}}[$msgSizeI] = 0 unless(${$hashRef->{$a}}[$msgSizeI]); - ${$hashRef->{$b}}[$msgSizeI] = 0 unless(${$hashRef->{$b}}[$msgSizeI]); - return(${$hashRef->{$a}}[$msgSizeI] <=> - ${$hashRef->{$b}}[$msgSizeI]); - } else { - return(${$hashRef->{$a}}[$msgCntI] <=> - ${$hashRef->{$b}}[$msgCntI]); - } -} - -# return a date string to match in log -sub get_datestr { - my $dateOpt = $_[0]; - - my $aDay = 60 * 60 * 24; - - my $time = time(); - if($dateOpt eq "yesterday") { - $time -= $aDay; - } elsif($dateOpt ne "today") { - die "$usageMsg\n"; - } - my ($t_mday, $t_mon) = (localtime($time))[3,4]; - - return sprintf("%s %2d", $monthNames[$t_mon], $t_mday); -} - -# if there's a real domain: uses that. Otherwise uses the IP addr. -# Lower-cases returned domain name. -# -# Optional bit of code elides the last octet of an IPv4 address. -# (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. -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) { - # more exhaustive method - ($domain, $ipAddr) = /^([^\[\(\/]+)[\[\(\/]([^\]\)]+)[\]\)]?:?\s*$/o; - } - - # "mach.host.dom"/"mach.host.do.co" to "host.dom"/"host.do.co" - if($domain eq 'unknown') { - $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; - } else { - $domain =~ - s/^(.*)\.([^\.]+)\.([^\.]{3}|[^\.]{2,3}\.[^\.]{2})$/\L$2.$3/o; - } - - return $domain; -} - -# Return (value, units) for integer -sub adj_int_units { - my $value = $_[0]; - my $units = ' '; - $value = 0 unless($value); - if($value > $divByOneMegAt) { - $value /= $oneMeg; - $units = 'm' - } elsif($value > $divByOneKAt) { - $value /= $oneK; - $units = 'k' - } - return($value, $units); -} - -# Return (value, units) for time -sub adj_time_units { - my $value = $_[0]; - my $units = 's'; - $value = 0 unless($value); - if($value > 3600) { - $value /= 3600; - $units = 'h' - } elsif($value > 60) { - $value /= 60; - $units = 'm' - } - return($value, $units); -} - -# Trim a "said:" string, if necessary. Add elipses to show it. -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; - } else { - $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..."; - last; - } - } - - return $trimmedString; -} - -# Trim a string, if necessary. Add elipses to show it. -sub string_trimmer { - my($trimmedString, $maxLen, $doNotTrim) = @_; - - $trimmedString = substr($trimmedString, 0, $maxLen - 3) . "..." - if(! $doNotTrim && (length($trimmedString) > $maxLen)); - return $trimmedString; -} - -# Get seconds, minutes and hours from seconds -sub get_smh { - my $sec = shift @_; - my $hr = int($sec / 3600); - $sec -= $hr * 3600; - my $min = int($sec / 60); - $sec -= $min * 60; - return($sec, $min, $hr); -} - -# Process smtpd rejects -sub proc_smtpd_reject { - my ($logLine, $rejects, $msgsRjctd, $rejPerHr, $msgsPerDay) = @_; - my ($rejTyp, $rejFrom, $rejRmdr, $rejReas); - my ($from, $to); - my $rejAddFrom = 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); - - # Next: get the reject "reason" - $rejReas = $rejRmdr; - unless(defined($opts{'verbMsgDetail'})) { - if($rejTyp eq "RCPT" || $rejTyp eq "DATA" || $rejTyp eq "CONNECT") { # special treatment :-( - # If there are "<>"s immediately following the reject code, that's - # 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; - } elsif($rejTyp eq "MAIL") { # *more* special treatment :-( grrrr... - $rejReas =~ s/^\d{3} (?:<.+>: )?([^;:]+)[;:]?.*$/$1/o; - } else { - $rejReas =~ s/^(?:.*[:;] )?([^,]+).*$/$1/o; - } - } - - # Snag recipient address - # Second expression is for unknown recipient--where there is no - # "to=" 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 = "<>"); - - # Snag sender address - (($from) = $rejRmdr =~ /from=<([^>]+)>/o) || ($from = "<>"); - - if(defined($from)) { - $rejAddFrom = $opts{'rejAddFrom'}; - $from = verp_mung($from); - } - - # stash in "triple-subscripted-array" - if($rejReas =~ m/^Sender address rejected:/o) { - # 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) { - # Recipient address rejected: Domain not found - # Recipient address rejected: need fully-qualified address - # User unknown (in local/relay recipient table) - #++$rejects->{$rejTyp}{$rejReas}{$to}; - my $rejData = $to; - if($rejAddFrom) { - $rejData .= " (" . ($from? $from : gimme_domain($rejFrom)) . ")"; - } - ++$rejects->{$rejTyp}{$rejReas}{$rejData}; - } elsif($rejReas =~ s/^.*?\d{3} (Improper use of SMTP command pipelining);.*$/$1/o) { - # Was an IPv6 problem here - my ($src) = $logLine =~ /^.+? from (\S+?):.*$/o; - ++$rejects->{$rejTyp}{$rejReas}{$src}; - } elsif($rejReas =~ s/^.*?\d{3} (Message size exceeds fixed limit);.*$/$1/o) { - 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) { - my $rejData = gimme_domain($rejFrom); - $rejData .= " ($from)" if($rejAddFrom); - ++$rejects->{$rejTyp}{$rejReas}{$rejData}; - } else { -# print STDERR "dbg: unknown reject reason $rejReas !\n\n"; - my $rejData = gimme_domain($rejFrom); - $rejData .= " ($from)" if($rejAddFrom); - ++$rejects->{$rejTyp}{$rejReas}{$rejData}; - } - ++$$msgsRjctd; - ++$$rejPerHr; - ++$$msgsPerDay; -} - -# Hack for VERP (?) - convert address from somthing like -# "list-return-36-someuser=someplace.com@lists.domain.com" -# to "list-return-ID-someuser=someplace.com@lists.domain.com" -# to prevent per-user listing "pollution." More aggressive -# munging converts to something like -# "list-return@lists.domain.com" (Instead of "return," there -# may be numeric list name/id, "warn", "error", etc.?) -sub verp_mung { - my $addr = $_[0]; - - if(defined($opts{'verpMung'})) { - $addr =~ s/((?:bounce[ds]?|no(?:list|reply|response)|return|sentto|\d+).*?)(?:[\+_\.\*-]\d+\b)+/$1-ID/oi; - if($opts{'verpMung'} > 1) { - $addr =~ s/[\*-](\d+[\*-])?[^=\*-]+[=\*][^\@]+\@/\@/o; - } - } - - return $addr; -} - -### -### Warning and Error Routines -### - -# Emit warning message to stderr -sub msg_warn { - warn "warning: $progName: $_[0]\n"; -} - -- 2.39.5