2 # $Cambridge: exim/src/src/eximstats.src,v 1.3 2004/12/20 13:12:32 steve Exp $
4 # Copyright (c) 2001 University of Cambridge.
5 # See the file NOTICE for conditions of use and distribution.
7 # Perl script to generate statistics from one or more Exim log files.
9 # Usage: eximstats [<options>] <log file> <log file> ...
11 # 1996-05-21: Ignore lines not starting with valid date/time, just in case
12 # these get into a log file.
13 # 1996-11-19: Add the -h option to control the size of the histogram,
14 # and optionally turn it off.
15 # Use some Perl 5 things; it should be everywhere by now.
16 # Add the Perl -w option and rewrite so no warnings are given.
17 # Add the -t option to control the length of the "top" listing.
18 # Add the -ne, -nt options to turn off errors and transport
20 # Add information about length of time on queue, and -q<list> to
21 # control the intervals and turn it off.
22 # Add count and percentage of delayed messages to the Received
24 # Show total number of errors.
25 # Add count and percentage of messages with errors to Received
27 # Add information about relaying and -nr to suppress it.
28 # 1997-02-03 Merged in some of the things Nigel Metheringham had done:
30 # Added received histogram as well as delivered
31 # Added local senders' league table
32 # Added local recipients' league table
33 # 1997-03-10 Fixed typo "destinationss"
34 # Allow for intermediate address between final and original
35 # when testing for relaying
36 # Give better message when no input
37 # 1997-04-24 Fixed bug in layout of error listing that was depending on
38 # text length (output line got repeated).
39 # 1997-05-06 Bug in option decoding when only one option.
40 # Overflow bug when handling very large volumes.
41 # 1997-10-28 Updated to handle revised log format that might show
42 # HELO name as well as host name before IP number
43 # 1998-01-26 Bugs in the function for calculating the number of seconds
44 # since 1970 from a log date
45 # 1998-02-02 Delivery to :blackhole: doesn't have a T= entry in the log
46 # line; cope with this, thereby avoiding undefined problems
47 # Very short log line gave substring error
48 # 1998-02-03 A routed delivery to a local transport may not have <> in the
49 # log line; terminate the address at white space, not <
50 # 1998-09-07 If first line of input was a => line, $thissize was undefined;
52 # 1998-12-21 Adding of $thissize from => line should have been adding $size.
53 # Oops. Should have looked more closely when fixing the previous
55 # 1999-11-12 Increased the field widths for printed integers; numbers are
56 # bigger than originally envisaged.
57 # 2001-03-21 Converted seconds() routine to use Time::Local, fixing a bug
58 # whereby seconds($timestamp) - id_seconds($id) gave an
60 # Added POD documentation.
61 # Moved usage instructions into help() subroutine.
62 # Added 'use strict' and declared all global variables.
63 # Added '-html' flag and resultant code.
64 # Added '-cache' flag and resultant code.
65 # Added add_volume() routine and converted all volume variables
66 # to use it, fixing the overflow problems for individual hosts
68 # Converted all volume output to GB/MB/KB as appropriate.
69 # Don't store local user stats if -nfl is specified.
70 # Modifications done by: Steve Campbell (<steve@computurn.com>)
71 # 2001-04-02 Added the -t_remote_users flag. Steve Campbell.
72 # 2001-10-15 Added the -domain flag. Steve Campbell.
73 # 2001-10-16 Accept files on STDIN or on the command line. Steve Campbell.
74 # 2001-10-21 Removed -domain flag and added -bydomain, -byhost, and -byemail.
75 # We now generate our main parsing subroutine as an eval statement
76 # which improves performance dramatically when not all the results
77 # are required. We also cache the last timestamp to time convertion.
79 # NOTE: 'Top 50 destinations by (message count|volume)' lines are
80 # now 'Top N (host|email|domain) destinations by (message count|volume)'
81 # where N is the topcount. Steve Campbell.
83 # 2001-10-30 V1.16 Joachim Wieland.
84 # Fixed minor bugs in add_volume() when taking over this version
85 # for use in Exim 4: -w gave uninitialized value warnings in
86 # two situations: for the first addition to a counter, and if
87 # there were never any gigabytes, thereby leaving the $gigs
89 # Initialized $last_timestamp to stop a -w uninitialized warning.
90 # Minor layout tweak for grand totals (nitpicking).
91 # Put the IP addresses for relaying stats in [] and separated by
92 # a space from the domain name.
93 # Removed the IPv4-specific address test when picking out addresses
94 # for relaying. Anything inside [] is OK.
96 # 2002-07-02 Philip Hazel
97 # Fixed "uninitialized variable" message that occurred for relay
98 # messages that arrived from H=[1.2.3.4] hosts (no name shown).
99 # This bug didn't affect the output.
101 # 2002-04-15 V1.17 Joachim Wieland.
102 # Added -charts, -chartdir. -chartrel options which use
103 # GD::Graph modules to create graphical charts of the statistics.
105 # 2002-04-15 V1.18 Steve Campbell.
106 # Added a check for $domain to to stop a -w uninitialized warning.
107 # Added -byemaildomain option.
108 # Only print HTML header links to included tables!
110 # 2002-08-02 V1.19 Steve Campbell.
111 # Changed the debug mode to dump the parser onto STDERR rather
112 # than STDOUT. Documented the -d flag into the help().
113 # Rejoined the divergent 2002-04-15 and 2002-07-02 releases.
115 # 2002-08-21 V1.20 Steve Campbell.
116 # Added the '-merge' option to allow merging of previous reports.
117 # Fixed a missing semicolon when doing -bydomain.
118 # Make volume charts plot the data gigs and bytes rather than just bytes.
119 # Only process log lines with $flag =~ /<=|=>|->|==|\*\*|Co/
120 # Converted Emaildomain to Edomain - the column header was too wide!
121 # This changes the text output slightly. You can revert to the old
122 # column widths by changing $COLUMN_WIDTHS to 7;
124 # 2002-09-04 V1.21 Andreas J Mueller
125 # Local deliveries domain now defaults to 'localdomain'.
126 # Don't match F=<From> when looking for the user.
128 # 2002-09-05 V1.22 Steve Campbell
129 # Fixed a perl 5.005 incompatibility problem ('our' variables).
131 # 2002-09-11 V1.23 Steve Campbell
132 # Stopped -charts option from throwing errors on null data.
133 # Don't print out 'Errors encountered' unless there are any.
135 # 2002-10-21 V1.23a Philip Hazel - patch from Tony Finch put in until
136 # Steve's eximstats catches up.
137 # Handle log files that include the timezone after the timestamp.
138 # Switch to assuming that log timestamps are in local time, with
139 # an option for UTC timestamps, as in Exim itself.
141 # 2003-02-05 V1.24 Steve Campbell
142 # Added in Sergey Sholokh's code to convert '<' and '>' characters
143 # in HTML output. Also added code to convert them back with -merge.
144 # Fixed timestamp offsets to convert to seconds rather than minutes.
145 # Updated -merge to work with output files using timezones.
146 # Added cacheing to speed up the calculation of timezone offsets.
148 # 2003-02-07 V1.25 Steve Campbell
149 # Optimised the usage of mktime() in the seconds subroutine.
150 # Removed the now redundant '-cache' option.
151 # html2txt() now explicitly matches HTML tags.
152 # Implemented a new sorting algorithm - the top_n_sort() routine.
153 # Added Danny Carroll's '-nvr' flag and code.
155 # 2003-03-13 V1.26 Steve Campbell
156 # Implemented HTML compliance changes recommended by Bernard Massot.
157 # Bug fix to allow top_n_sort() to handle null keys.
158 # Convert all domains and edomains to lowercase.
159 # Remove preceding dots from domains.
161 # 2003-03-13 V1.27 Steve Campbell
162 # Replaced border attributes with 'border=1', as recommended by
165 # 2003-06-03 V1.28 John Newman
166 # Added in the ability to skip over the parsing and evaulation of
167 # specific transports as passed to eximstats via the new "-nt/.../"
168 # command line argument. This new switch allows the viewing of
169 # not more accurate statistics but more applicable statistics when
170 # special transports are in use (ie; SpamAssassin). We need to be
171 # able to ignore transports such as this otherwise the resulting
172 # local deliveries are significantly skewed (doubled)...
174 # 2003-11-06 V1.29 Steve Campbell
175 # Added the '-pattern "Description" "/pattern/"' option.
177 # 2004-02-17 V1.30 Steve Campbell
178 # Added warnings if required GD::Graph modules are not available or
179 # insufficient -chart* options are specified.
181 # 2004-02-20 V1.31 Andrea Balzi
182 # Only show the Local Sender/Destination links if the tables exist.
184 # 2004-07-05 V1.32 Steve Campbell
185 # Fix '-merge -h0' divide by zero error.
187 # 2004-07-15 V1.33 Steve Campbell
188 # Documentation update - I've converted the subroutine
189 # documentation from POD to comments.
191 # 2004-12-10 V1.34 Steve Campbell
192 # Eximstats can now parse syslog lines as well as mainlog lines.
194 # 2004-12-20 V1.35 Andreas Metzler
195 # Pie charts by volume were actually generated by count. Fixed.
200 eximstats - generates statistics from Exim mainlog or syslog files.
204 eximstats [Options] mainlog1 mainlog2 ... > report.txt
205 eximstats -html [Options] mainlog1 mainlog2 ... > report.html
206 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
214 histogram divisions per hour. The default is 1, and
215 0 suppresses histograms. Valid values are:
217 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
221 Don't display error information.
225 Don't display relaying information.
227 =item B<-nr>I</pattern/>
229 Don't display relaying information that matches.
233 Don't display transport information.
235 =item B<-nt>I</pattern/>
237 Don't display transport information that matches
241 List of times for queuing information single 0 item suppresses.
245 Display top <number> sources/destinations
246 default is 50, 0 suppresses top listing.
250 Omit local sources/destinations in top listing.
252 =item B<-t_remote_users>
254 Include remote users in the top source/destination listings.
258 Show results by sending host. This may be combined with
259 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
260 are specified, then B<-byhost> is assumed as a default.
264 Show results by sending domain.
265 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
269 Show results by sender's email address.
270 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
272 =item B<-byemaildomain> or B<-byedomain>
274 Show results by sender's email domain.
275 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
277 =item B<-pattern> I<Description> I</Pattern/>
279 Look for the specified pattern and count the number of lines in which it appears.
280 This option can be specified multiple times. Eg:
282 -pattern 'Refused connections' '/refused connection/'
287 This option allows eximstats to merge old eximstat reports together. Eg:
289 eximstats mainlog.sun > report.sun.txt
290 eximstats mainlog.mon > report.mon.txt
291 eximstats mainlog.tue > report.tue.txt
292 eximstats mainlog.wed > report.web.txt
293 eximstats mainlog.thu > report.thu.txt
294 eximstats mainlog.fri > report.fri.txt
295 eximstats mainlog.sat > report.sat.txt
296 eximstats -merge report.*.txt > weekly_report.txt
297 eximstats -merge -html report.*.txt > weekly_report.html
303 You can merge text or html reports and output the results as text or html.
307 You can use all the normal eximstat output options, but only data
308 included in the original reports can be shown!
312 When merging reports, some loss of accuracy may occur in the top I<n> lists.
313 This will be towards the ends of the lists.
317 The order of items in the top I<n> lists may vary when the data volumes
318 round to the same value.
324 Output the results in HTML.
328 Create graphical charts to be displayed in HTML output.
330 This requires the following modules which can be obtained
331 from http://www.cpan.org/modules/01modules.index.html
343 To install these, download and unpack them, then use the normal perl installation procedure:
350 =item B<-chartdir>I <dir>
352 Create the charts in the directory <dir>
354 =item B<-chartrel>I <dir>
356 Specify the relative directory for the "img src=" tags from where to include
361 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
362 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
369 Eximstats parses exim mainlog and syslog files to output a statistical
370 analysis of the messages processed. By default, a text
371 analysis is generated, but you can request an html analysis
372 by using the B<-html> flag. See the help (B<-help>) to learn
373 about how to create charts from the tables.
377 There is a web site at http://www.exim.org - this contains details of the
378 mailing list exim-users@exim.org.
382 This program does not perfectly handle messages whose received
383 and delivered log lines are in different files, which can happen
384 when you have multiple mail servers and a message cannot be
385 immeadiately delivered. Fixing this could be tricky...
392 # use Time::Local; # PH/FANF
395 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints);
396 eval { require GD::Graph::pie; };
397 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
398 eval { require GD::Graph::linespoints; };
399 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
402 ##################################################
404 ##################################################
405 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
406 use vars qw(@tab62 @days_per_month $gig);
407 use vars qw($VERSION);
408 use vars qw($COLUMN_WIDTHS);
412 (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, # 0-9
413 0,10,11,12,13,14,15,16,17,18,19,20, # A-K
414 21,22,23,24,25,26,27,28,29,30,31,32, # L-W
415 33,34,35, 0, 0, 0, 0, 0, # X-Z
416 0,36,37,38,39,40,41,42,43,44,45,46, # a-k
417 47,48,49,50,51,52,53,54,55,56,57,58, # l-w
420 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
421 $gig = 1024 * 1024 * 1024;
424 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
427 # Declare global variables.
428 use vars qw($total_received_data $total_received_data_gigs $total_received_count);
429 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_count);
430 use vars qw(%arrival_time %size %from_host %from_address);
431 use vars qw(%timestamp2time); #Hash of timestamp => time.
432 use vars qw($last_timestamp $last_time); #The last time convertion done.
433 use vars qw($last_date $date_seconds); #The last date convertion done.
434 use vars qw($last_offset $offset_seconds); #The last time offset convertion done.
435 use vars qw($localtime_offset);
436 use vars qw($i); #General loop counter.
437 use vars qw($debug); #Debug mode?
438 use vars qw($ntopchart); #How many entries should make it into the chart?
439 use vars qw($gddirectory); #Where to put files from GD::Graph
443 # The following are parameters whose values are
444 # set by command line switches:
445 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
446 use vars qw($topcount $local_league_table $include_remote_users);
447 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding);
448 use vars qw($relay_pattern @queue_times $html @user_patterns @user_descriptions);
450 use vars qw(%do_sender); #Do sender by Host, Domain, Email, and/or Edomain tables.
451 use vars qw($charts $chartrel $chartdir $charts_option_specified);
452 use vars qw($merge_reports); #Merge old reports ?
454 # The following are modified in the parse() routine, and
455 # referred to in the print_*() routines.
456 use vars qw($queue_more_than $delayed_count $relayed_unshown $begin $end);
457 use vars qw(%received_count %received_data %received_data_gigs);
458 use vars qw(%delivered_count %delivered_data %delivered_data_gigs);
459 use vars qw(%received_count_user %received_data_user %received_data_gigs_user);
460 use vars qw(%delivered_count_user %delivered_data_user %delivered_data_gigs_user);
461 use vars qw(%transported_count %transported_data %transported_data_gigs);
462 use vars qw(%remote_delivered %relayed %delayed %had_error %errors_count);
463 use vars qw(@queue_bin @remote_queue_bin @received_interval_count @delivered_interval_count);
464 use vars qw(@user_pattern_totals);
466 use vars qw(%report_totals);
471 ##################################################
473 ##################################################
476 #######################################################################
479 # $rounded_volume = volume_rounded($bytes,$gigabytes);
481 # Given a data size in bytes, round it to KB, MB, or GB
484 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
486 # Note: I've experimented with Math::BigInt and it results in a 33%
487 # performance degredation as opposed to storing numbers split into
488 # bytes and gigabytes.
489 #######################################################################
501 if ($volume_rounding) {
505 $rounded = sprintf("%6d", $x);
507 elsif ($x < 10000000) {
508 $rounded = sprintf("%4dKB", ($x + 512)/1024);
511 $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
514 # Values between 1GB and 10GB are printed in MB
516 $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
519 # Handle values over 10GB
520 $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
524 # We don't want any rounding to be done.
525 $rounded = sprintf("%4d", ($g * $gig) + $x);
532 #######################################################################
535 # un_round($rounded_volume,\$bytes,\$gigabytes);
537 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
538 # do the reverse transformation and convert it back into Bytes and Gigabytes.
539 # These are added to the $bytes and $gigabytes parameters.
541 # Given a data size in bytes, round it to KB, MB, or GB
544 # EG: 500 => (500,0), 14GB => (0,14), etc.
545 #######################################################################
547 my($rounded,$bytes_sref,$gigabytes_sref) = @_;
549 if ($rounded =~ /(\d+)GB/) {
550 $$gigabytes_sref += $1;
552 elsif ($rounded =~ /(\d+)MB/) {
553 $$gigabytes_sref += $1 / 1024;
554 $$bytes_sref += (($1 % 1024 ) * 1024 * 1024);
556 elsif ($rounded =~ /(\d+)KB/) {
557 $$gigabytes_sref += $1 / (1024 * 1024);
558 $$bytes_sref += ($1 % (1024 * 1024) * 1024);
560 elsif ($rounded =~ /(\d+)/) {
561 $$gigabytes_sref += $1 / $gig;
562 $$bytes_sref += $1 % $gig;
565 #Now reduce the bytes down to less than 1GB.
566 add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
570 #######################################################################
573 # add_volume(\$bytes,\$gigs,$size);
575 # Add $size to $bytes/$gigs where this is a number split into
576 # bytes ($bytes) and gigabytes ($gigs). This is significantly
577 # faster than using Math::BigInt.
578 #######################################################################
580 my($bytes_ref,$gigs_ref,$size) = @_;
581 $$bytes_ref = 0 if ! defined $$bytes_ref;
582 $$gigs_ref = 0 if ! defined $$gigs_ref;
583 $$bytes_ref += $size;
584 while ($$bytes_ref > $gig) {
591 #######################################################################
594 # $formatted_time = format_time($seconds);
596 # Given a time in seconds, break it down into
597 # weeks, days, hours, minutes, and seconds.
599 # Eg 12005 => 3h20m5s
600 #######################################################################
612 $p .= "$w"."w" if $w > 0;
613 $p .= "$d"."d" if $d > 0;
614 $p .= "$h"."h" if $h > 0;
615 $p .= "$m"."m" if $m > 0;
616 $p .= "$s"."s" if $s > 0 || $p eq "";
621 #######################################################################
624 # $seconds = unformat_time($formatted_time);
626 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
628 # Eg 3h20m5s => 12005
629 #######################################################################
631 my($formated_time) = pop @_;
634 while ($formated_time =~ s/^(\d+)([wdhms]?)//) {
635 $time += $1 if ($2 eq '' || $2 eq 's');
636 $time += $1 * 60 if ($2 eq 'm');
637 $time += $1 * 60 * 60 if ($2 eq 'h');
638 $time += $1 * 60 * 60 * 24 if ($2 eq 'd');
639 $time += $1 * 60 * 60 * 24 * 7 if ($2 eq 'w');
645 #######################################################################
648 # $time = seconds($timestamp);
650 # Given a time-of-day timestamp, convert it into a time() value using
651 # POSIX::mktime. We expect the timestamp to be of the form
652 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
653 # and the year to be absolute (we do the necessary conversions). The
654 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
655 # offset is not present, and we have not been told that the log is in UTC
656 # (with the -utc option), then we adjust the time by the current local
657 # time offset so that it can be compared with the time recorded in message
660 # To improve performance, we only use mktime on the date ($year-$mon-$day),
661 # and only calculate it if the date is different to the previous time we
662 # came here. We then add on seconds for the '$hour:$min:$sec'.
664 # We also store the results of the last conversion done, and only
665 # recalculate if the date is different.
667 # We used to have the '-cache' flag which would store the results of the
668 # mktime() call. However, the current way of just using mktime() on the
669 # date obsoletes this.
670 #######################################################################
674 # Is the timestamp the same as the last one?
675 return $last_time if ($last_timestamp eq $timestamp);
677 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
679 unless ($last_date eq $1) {
681 my(@timestamp) = (0,0,0,$4,$3,$2);
682 $timestamp[5] -= 1900;
684 $date_seconds = mktime(@timestamp);
686 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
688 # SC. Use cacheing. Also note we want seconds not minutes.
689 #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
690 if (defined $8 && ($8 ne $last_offset)) {
692 $offset_seconds = ($10 * 60 + $11) * 60;
693 $offset_seconds = -$offset_seconds if ($9 eq '-');
698 #$time -= $this_offset;
699 $time -= $offset_seconds;
700 } elsif (defined $localtime_offset) {
701 $time -= $localtime_offset;
704 # Store the last timestamp received.
705 $last_timestamp = $timestamp;
712 #######################################################################
715 # $time = id_seconds($message_id);
717 # Given a message ID, convert it into a time() value.
718 #######################################################################
720 my($sub_id) = substr((pop @_), 0, 6);
722 my(@c) = split(//, $sub_id);
723 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
729 #######################################################################
730 # calculate_localtime_offset();
732 # $localtime_offset = calculate_localtime_offset();
734 # Calculate the the localtime offset from gmtime in seconds.
736 # $localtime = time() + $localtime_offset.
738 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
739 # (West is negative, East is positive.)
740 #######################################################################
742 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
743 # This subroutine commented out as it's not currently in use.
745 #sub calculate_localtime_offset {
746 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
747 # my (@sample_date) = (0,0,0,5,5,100);
748 # my $localtime = timelocal(@sample_date);
749 # my $gmtime = timegm(@sample_date);
750 # my $offset = $localtime - $gmtime;
754 sub calculate_localtime_offset {
755 # Assume that the offset at the moment is valid across the whole
756 # period covered by the logs that we're analysing. This may not
757 # be true around the time the clocks change in spring or autumn.
759 # mktime works on local time and gmtime works in UTC
760 my $local = mktime(gmtime($utc));
761 return $local - $utc;
765 #######################################################################
766 # print_queue_times();
768 # $time = print_queue_times($message_type,\@queue_times,$queue_more_than);
770 # Given the type of messages being output, the array of message queue times,
771 # and the number of messages which exceeded the queue times, print out
773 #######################################################################
774 sub print_queue_times {
776 my($string,$array,$queue_more_than) = @_;
781 my $cumulative_percent = 0;
782 #$queue_unknown += keys %arrival_time;
784 my $queue_total = $queue_more_than;
785 for ($i = 0; $i <= $#queue_times; $i++) { $queue_total += $$array[$i] }
787 my $temp = "Time spent on the queue: $string";
791 print "<hr><a name=\"$string time\"></a><h2>$temp</h2>\n";
792 print "<table border=0 width=\"100%\">\n";
794 print "<table border=1>\n";
795 print "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
796 $format = "<tr><td align=\"right\">%s %s</td><td align=\"right\">%d</td><td align=\"right\">%5.1f%%</td><td align=\"right\">%5.1f%%</td>\n";
800 printf("%s\n%s\n\n", $temp, "-" x length($temp));
801 $format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
804 for ($i = 0; $i <= $#queue_times; $i++) {
807 my $percent = ($$array[$i] * 100)/$queue_total;
808 $cumulative_percent += $percent;
810 $printed_one? " " : "Under",
811 format_time($queue_times[$i]),
812 $$array[$i], $percent, $cumulative_percent);
813 if (!defined($queue_times[$i])) {
816 push(@chartdatanames,
817 ($printed_one? "" : "Under") . format_time($queue_times[$i]));
818 push(@chartdatavals, $$array[$i]);
823 if ($queue_more_than > 0) {
824 my $percent = ($queue_more_than * 100)/$queue_total;
825 $cumulative_percent += $percent;
828 format_time($queue_times[$#queue_times]),
829 $queue_more_than, $percent, $cumulative_percent);
831 push(@chartdatanames, "Over " . format_time($queue_times[$#queue_times]));
832 push(@chartdatavals, $queue_more_than);
834 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
839 if ($HAVE_GD_Graph_pie && $charts) {
844 my $graph = GD::Graph::pie->new(200, 200);
847 if ($string =~ /all/) { $pngname = "queue_all.png"; $title = "Queue (all)"; }
848 if ($string =~ /remote/) { $pngname = "queue_rem.png"; $title = "Queue (remote)"; }
852 my $gd = $graph->plot(\@data) or warn($graph->error);
854 open(IMG, ">$chartdir/$pngname") or die $!;
858 print "<img src=\"$chartrel/$pngname\">";
861 print "</td></tr></table>\n";
868 #######################################################################
871 # print_histogram('Deliverieds|Messages received',@interval_count);
873 # Print a histogram of the messages delivered/received per time slot
875 #######################################################################
876 sub print_histogram {
878 my(@interval_count) = @_;
882 for ($i = 0; $i < $hist_number; $i++)
883 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
885 my $scale = int(($maxd + 25)/50);
886 $scale = 1 if $scale == 0;
889 if ($text eq "Deliveries")
891 $type = ($scale == 1)? "delivery" : "deliveries";
895 $type = ($scale == 1)? "message" : "messages";
898 my($title) = sprintf("$text per %s (each dot is $scale $type)",
899 ($hist_interval == 60)? "hour" :
900 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
903 print "<hr><a name=\"$text\"></a><h2>$title</h2>\n";
904 print "<table border=0 width=\"100%\">\n";
905 print "<tr><td><pre>\n";
908 printf("%s\n%s\n\n", $title, "-" x length($title));
913 for ($i = 0; $i < $hist_number; $i++)
915 my $c = $interval_count[$i];
917 # If the interval is an hour (the maximum) print the starting and
918 # ending hours as a label. Otherwise print the starting hour and
919 # minutes, which take up the same space.
924 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
926 push(@chartdatanames, $temp);
932 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
934 { $temp = sprintf(" :%02d", $minutes) }
936 push(@chartdatanames, $temp);
937 $minutes += $hist_interval;
944 push(@chartdatavals, $c);
945 printf(" %6d %s\n", $c, "." x ($c/$scale));
952 if ($HAVE_GD_Graph_linespoints && $charts) {
953 # calculate the graph
958 my $graph = GD::Graph::linespoints->new(300, 300);
963 x_labels_vertical => 1
966 if ($text =~ /Deliveries/) { $pngname = "histogram_del.png"; }
967 if ($text =~ /Messages/) { $pngname = "histogram_mes.png"; }
968 my $gd = $graph->plot(\@data) or warn($graph->error);
970 open(IMG, ">$chartdir/$pngname") or die $!;
974 print "<img src=\"$chartrel/$pngname\">";
977 print "</td></tr></table>\n";
983 #######################################################################
984 # print_league_table();
986 # print_league_table($league_table_type,\%message_count,\%message_data,\%message_data_gigs);
988 # Given hashes of message count and message data, which are keyed by
989 # the table type (eg by the sending host), print a league table
990 # showing the top $topcount (defaults to 50).
991 #######################################################################
992 sub print_league_table {
993 my($text,$m_count,$m_data,$m_data_gigs) = @_;
994 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
995 my($temp) = "Top $name by message count";
996 my(@chartdatanames) = ();
997 my(@chartdatavals) = ();
998 my $chartotherval = 0;
1002 print "<hr><a name=\"$text count\"></a><h2>$temp</h2>\n";
1003 print "<table border=0 width=\"100%\">\n";
1005 print "<table border=1>\n";
1006 print "<tr><th>Messages</th><th>Bytes</th><th>\u$text</th>\n";
1008 # Align non-local addresses to the right (so all the .com's line up).
1009 # Local addresses are aligned on the left as they are userids.
1010 my $align = ($text !~ /local/i) ? 'right' : 'left';
1011 $format = "<tr><td align=\"right\">%d</td><td align=\"right\">%s</td><td align=\"$align\" nowrap>%s</td>\n";
1014 printf("%s\n%s\n\n", $temp, "-" x length($temp));
1015 $format = "%7d %10s %s\n";
1019 foreach $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1022 $htmlkey =~ s/>/\>\;/g;
1023 $htmlkey =~ s/</\<\;/g;
1024 printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $htmlkey);
1027 printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $key);
1029 if (scalar @chartdatanames < $ntopchart)
1031 push(@chartdatanames, $key);
1032 push(@chartdatavals, $$m_count{$key});
1036 $chartotherval += $$m_count{$key};
1039 push(@chartdatanames, "Other");
1040 push(@chartdatavals, $chartotherval);
1045 print "</td><td>\n";
1046 if ($HAVE_GD_Graph_pie && $charts)
1048 # calculate the graph
1053 my $graph = GD::Graph::pie->new(300, 300);
1056 y_label => 'Amount',
1057 title => 'By count',
1059 my $gd = $graph->plot(\@data) or warn($graph->error);
1063 open(IMG, ">$chartdir/${temp}_count.png") or die $!;
1067 print "<img src=\"$chartrel/${temp}_count.png\">";
1070 print "</td><td>\n";
1071 print "</td></tr></table>\n";
1075 $temp = "Top $name by volume";
1077 print "<hr><a name=\"$text volume\"></a><h2>$temp</h2>\n";
1078 print "<table border=0 width=\"100%\">\n";
1080 print "<table border=1>\n";
1081 print "<tr><th>Messages</th><th>Bytes</th><th>\u$text</th>\n";
1084 printf("%s\n%s\n\n", $temp, "-" x length($temp));
1087 @chartdatanames = ();
1088 @chartdatavals = ();
1091 foreach $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1092 if ($$m_data_gigs{$key}) {
1097 $htmlkey =~ s/>/\>\;/g;
1098 $htmlkey =~ s/</\<\;/g;
1099 printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $htmlkey);
1102 printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $key);
1105 if (scalar @chartdatanames < $ntopchart) {
1107 if ($$m_data_gigs{$key}) {
1108 push(@chartdatanames, $key);
1109 push(@chartdatavals, $$m_data_gigs{$key});
1113 push(@chartdatanames, $key);
1114 push(@chartdatavals, $$m_data{$key});
1118 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1121 push(@chartdatanames, "Other");
1122 push(@chartdatavals, $chartotherval);
1126 print "</td><td>\n";
1127 if ($HAVE_GD_Graph_pie && $charts) {
1128 # calculate the graph
1133 my $graph = GD::Graph::pie->new(300, 300);
1136 y_label => 'Volume' ,
1137 title => 'By Volume',
1139 my $gd = $graph->plot(\@data) or warn($graph->error);
1143 open(IMG, ">$chartdir/${temp}_volume.png") or die $!;
1147 print "<img src=\"$chartrel/${temp}_volume.png\">";
1150 print "</td><td>\n";
1151 print "</td></tr></table>\n";
1158 #######################################################################
1161 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1163 # Given a hash which has numerical values, return the sorted $n keys which
1164 # point to the top values. The second and third hashes are used as
1165 # tiebreakers. They all must have the same keys.
1167 # The idea behind this routine is that when you only want to see the
1168 # top n members of a set, rather than sorting the entire set and then
1169 # plucking off the top n, sort through the stack as you go, discarding
1170 # any member which is lower than your current n'th highest member.
1172 # This proves to be an order of magnitude faster for large hashes.
1173 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1174 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1176 # We assume the values are > 0.
1177 #######################################################################
1179 my($n,$href1,$href2,$href3) = @_;
1181 # PH's original sort was:
1183 # foreach $key (sort
1185 # $$m_count{$b} <=> $$m_count{$a} ||
1186 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1187 # $$m_data{$b} <=> $$m_data{$a} ||
1193 #We use a key of '_' to represent non-existant values, as null keys are valid.
1194 #'_' is not a valid domain, edomain, host, or email.
1195 my(@top_n_keys) = ('_') x $n;
1196 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1198 my $n_minus_1 = $n - 1;
1199 my $n_minus_2 = $n - 2;
1201 # Pick out the top $n keys.
1202 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1203 while (($key,$value1) = each %$href1) {
1205 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1207 # Check to see that the new value is bigger than the lowest of the
1208 # top n keys that we're keeping.
1209 $comparison = $value1 <=> $minimum_value1 ||
1210 $href2->{$key} <=> $minimum_value2 ||
1211 $href3->{$key} <=> $minimum_value3 ||
1212 $top_n_key cmp $key;
1213 next unless ($comparison == 1);
1215 # As we will be using these values a few times, extract them into scalars.
1216 $value2 = $href2->{$key};
1217 $value3 = $href3->{$key};
1219 # This key is bigger than the bottom n key, so the lowest position we
1220 # will insert it into is $n minus 1 (the bottom of the list).
1221 $insert_position = $n_minus_1;
1223 # Now go through the list, stopping when we find a key that we're
1224 # bigger than, or we come to the penultimate position - we've
1225 # already tested bigger than the last.
1227 # Note: we go top down as the list starts off empty.
1228 # Note: stepping through the list in this way benchmarks nearly
1229 # three times faster than doing a sort() on the reduced list.
1230 # I assume this is because the list is already in order, and
1231 # we get a performance boost from not having to do hash lookups
1233 for ($i = 0; $i < $n_minus_1; $i++) {
1234 $top_n_key = $top_n_keys[$i];
1235 if ( ($top_n_key eq '_') ||
1236 ( ($value1 <=> $href1->{$top_n_key} ||
1237 $value2 <=> $href2->{$top_n_key} ||
1238 $value3 <=> $href3->{$top_n_key} ||
1239 $top_n_key cmp $key) == 1
1242 $insert_position = $i;
1247 # Remove the last element, then insert the new one.
1248 $#top_n_keys = $n_minus_2;
1249 splice(@top_n_keys,$insert_position,0,$key);
1251 # Extract our new minimum values.
1252 $top_n_key = $top_n_keys[$n_minus_1];
1253 if ($top_n_key ne '_') {
1254 $minimum_value1 = $href1->{$top_n_key};
1255 $minimum_value2 = $href2->{$top_n_key};
1256 $minimum_value3 = $href3->{$top_n_key};
1260 # Return the top n list, grepping out non-existant values, just in case
1261 # we didn't have that many values.
1262 return(grep(!/^_$/,@top_n_keys));
1266 #######################################################################
1269 # $header = html_header($title);
1271 # Print our HTML header and start the <body> block.
1272 #######################################################################
1275 my $text = << "EoText";
1276 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1279 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1280 <title>$title</title>
1282 <body bgcolor="white">
1290 #######################################################################
1295 # Display usage instructions and exit.
1296 #######################################################################
1300 eximstats Version $VERSION
1302 Usage: eximstats [Options] mainlog1 mainlog2 ... > report.txt
1303 eximstats -html [Options] mainlog1 mainlog2 ... > report.html
1304 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_rep.txt
1305 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1307 Parses exim mainlog or syslog files and generates a statistical analysis
1308 of the messages processed. Valid options are:
1310 -h<number> histogram divisions per hour. The default is 1, and
1311 0 suppresses histograms. Other valid values are:
1312 2, 3, 5, 10, 15, 20, 30 or 60.
1313 -ne don't display error information
1314 -nr don't display relaying information
1315 -nr/pattern/ don't display relaying information that matches
1316 -nt don't display transport information
1317 -nt/pattern/ don't display transport information that matches
1318 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1319 -q<list> list of times for queuing information
1320 single 0 item suppresses
1321 -t<number> display top <number> sources/destinations
1322 default is 50, 0 suppresses top listing
1323 -tnl omit local sources/destinations in top listing
1324 -t_remote_users show top user sources/destinations from non-local domains
1326 -byhost show results by sending host (default unless bydomain or
1327 byemail is specified)
1328 -bydomain show results by sending domain.
1329 -byemail show results by sender's email address
1330 -byedomain show results by sender's email domain
1332 -pattern "Description" /pattern/
1333 Count lines matching specified patterns and show them in
1334 the results. It can be specified multiple times. Eg:
1335 -pattern 'Refused connections' '/refused connection/'
1337 -merge merge previously generated reports into a new report
1339 -html output the results in HTML
1340 -charts Create charts (this requires the GD::Graph modules)
1341 -chartdir <dir> Create the charts' png files in the directory <dir>
1342 -chartrel <dir> Specify the relative directory for the "img src=" tags
1343 from where to include the charts in the html file
1344 -chartdir and -chartrel default to '.'
1346 -d Debug mode - dump the eval'ed parser onto STDERR.
1355 #######################################################################
1356 # generate_parser();
1358 # $parser = generate_parser();
1360 # This subroutine generates the parsing routine which will be
1361 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1362 # This improves performance depending on what bits you take out or add.
1364 # I've tested using study(), but this does not improve performance.
1366 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1367 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1368 # the expression evaluates to true, then it is included/excluded accordingly.
1369 #######################################################################
1370 sub generate_parser {
1372 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1373 my($tod,$m_hour,$m_min,$id,$flag);
1376 # Convert syslog lines to mainlog format.
1378 next unless s/^.*? exim\\b.*?: //;
1381 next if length($_) < 38;
1382 next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)/o;
1384 ($tod,$m_hour,$m_min) = ($1,$2,$3);
1387 my($extra) = defined($4)? 6 : 0;
1388 $id = substr($_, 20 + $extra, 16);
1389 $flag = substr($_, 37 + $extra, 2);
1392 # Watch for user specified patterns.
1393 my $user_pattern_index = 0;
1394 foreach (@user_patterns) {
1395 $user_pattern_totals[$user_pattern_index] = 0;
1396 $parser .= " \$user_pattern_totals[$user_pattern_index]++ if $_;\n";
1397 $user_pattern_index++;
1401 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co/);
1403 #Strip away the timestamp, ID and flag (which could be "Com" for completed)
1404 #This speeds up the later pattern matches.
1405 # $_ = substr($_, 40);
1407 $_ = substr($_, 40 + $extra); # PH
1409 # JN - Skip over certain transports as specified via the "-nt/.../" command
1410 # line switch (where ... is a perl style regular expression). This is
1411 # required so that transports that skew stats such as SpamAssassin can be
1413 #IFDEF ($transport_pattern)
1414 if (/\\sT=(\\S+)/) {
1415 next if ($1 =~ /$transport_pattern/o) ;
1417 #ENDIF ($transport_pattern)
1420 $host = "local"; #Host is local unless otherwise specified.
1421 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1424 # Do some pattern matches to get the host and IP address.
1425 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1426 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1427 # We do 2 separate matches to keep the matches simple and fast.
1428 if (/\\sH=(\\S+)/) {
1431 ($ip) = /\\sH=.*?(\\s\\[[^]]+\\])/;
1432 # If there is only an IP address, it will be in $host and $ip will be
1433 # unset. That is OK, because we only use $ip in conjunction with $host
1434 # below. But make it empty to avoid warning messages.
1435 $ip = "" if !defined $ip;
1437 #IFDEF ($do_sender{Domain})
1438 if ($host !~ /^\\[/ && $host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1439 # Remove the host portion from the DNS name. We ensure that we end up with
1440 # at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1441 $domain = lc("$1.$2");
1442 $domain =~ s/^\\.//; #Remove preceding dot.
1444 #ENDIF ($do_sender{Domain})
1448 #IFDEF ($do_sender{Email})
1449 $email = (/^(\S+)/) ? $1 : "";
1450 #ENDIF ($do_sender{Email})
1452 #IFDEF ($do_sender{Edomain})
1453 $edomain = (/^\S*?\\@(\S+)/) ? lc($1) : "";
1454 #ENDIF ($do_sender{Edomain})
1456 if ($tod lt $begin) {
1459 elsif ($tod gt $end) {
1464 if ($flag eq "<=") {
1465 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
1466 $size{$id} = $thissize;
1468 #IFDEF ($show_relay)
1469 if ($host ne "local") {
1470 # Save incoming information in case it becomes interesting
1471 # later, when delivery lines are read.
1472 my($from) = /^(\\S+)/;
1473 $from_host{$id} = "$host$ip";
1474 $from_address{$id} = $from;
1476 #ENDIF ($show_relay)
1478 #IFDEF ($local_league_table || $include_remote_users)
1482 #IFDEF ($local_league_table && $include_remote_users)
1483 { #Store both local and remote users.
1484 #ENDIF ($local_league_table && $include_remote_users)
1486 #IFDEF ($local_league_table && ! $include_remote_users)
1487 if ($host eq "local") { #Store local users only.
1488 #ENDIF ($local_league_table && ! $include_remote_users)
1490 #IFDEF ($include_remote_users && ! $local_league_table)
1491 if ($host ne "local") { #Store remote users only.
1492 #ENDIF ($include_remote_users && ! $local_league_table)
1494 $received_count_user{$user}++;
1495 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
1498 #ENDIF ($local_league_table || $include_remote_users)
1500 #IFDEF ($do_sender{Host})
1501 $received_count{Host}{$host}++;
1502 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
1503 #ENDIF ($do_sender{Host})
1505 #IFDEF ($do_sender{Domain})
1507 $received_count{Domain}{$domain}++;
1508 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
1510 #ENDIF ($do_sender{Domain})
1512 #IFDEF ($do_sender{Email})
1513 $received_count{Email}{$email}++;
1514 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
1515 #ENDIF ($do_sender{Email})
1517 #IFDEF ($do_sender{Edomain})
1518 $received_count{Edomain}{$edomain}++;
1519 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
1520 #ENDIF ($do_sender{Edomain})
1522 $total_received_count++;
1523 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
1525 #IFDEF ($#queue_times >= 0)
1526 $arrival_time{$id} = $tod;
1527 #ENDIF ($#queue_times >= 0)
1529 #IFDEF ($hist_opt > 0)
1530 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
1531 #ENDIF ($hist_opt > 0)
1534 elsif ($flag eq "=>") {
1535 $size = $size{$id} || 0;
1536 if ($host ne "local") {
1537 $remote_delivered{$id} = 1;
1540 #IFDEF ($show_relay)
1541 # Determine relaying address if either only one address listed,
1542 # or two the same. If they are different, it implies a forwarding
1543 # or aliasing, which is not relaying. Note that for multi-aliased
1544 # addresses, there may be a further address between the first
1547 if (defined $from_host{$id}) {
1548 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
1549 ($old,$new) = ($1,$2);
1555 if ("\\L$new" eq "\\L$old") {
1556 ($old) = /^(\\S+)/ if $old eq "";
1557 my $key = "H=\\L$from_host{$id}\\E A=\\L$from_address{$id}\\E => " .
1558 "H=\\L$host\\E$ip A=\\L$old\\E";
1559 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
1560 $relayed{$key} = 0 if !defined $relayed{$key};
1568 #ENDIF ($show_relay)
1572 #IFDEF ($local_league_table || $include_remote_users)
1573 #IFDEF ($local_league_table && $include_remote_users)
1574 { #Store both local and remote users.
1575 #ENDIF ($local_league_table && $include_remote_users)
1577 #IFDEF ($local_league_table && ! $include_remote_users)
1578 if ($host eq "local") { #Store local users only.
1579 #ENDIF ($local_league_table && ! $include_remote_users)
1581 #IFDEF ($include_remote_users && ! $local_league_table)
1582 if ($host ne "local") { #Store remote users only.
1583 #ENDIF ($include_remote_users && ! $local_league_table)
1585 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
1586 if ($user =~ /^[\\/|]/) {
1587 my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
1588 $user = "$user $parent" if defined $parent;
1590 $delivered_count_user{$user}++;
1591 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
1594 #ENDIF ($local_league_table || $include_remote_users)
1596 #IFDEF ($do_sender{Host})
1597 $delivered_count{Host}{$host}++;
1598 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
1599 #ENDIF ($do_sender{Host})
1600 #IFDEF ($do_sender{Domain})
1602 $delivered_count{Domain}{$domain}++;
1603 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
1605 #ENDIF ($do_sender{Domain})
1606 #IFDEF ($do_sender{Email})
1607 $delivered_count{Email}{$email}++;
1608 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
1609 #ENDIF ($do_sender{Email})
1610 #IFDEF ($do_sender{Edomain})
1611 $delivered_count{Edomain}{$edomain}++;
1612 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
1613 #ENDIF ($do_sender{Edomain})
1615 $total_delivered_count++;
1616 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
1618 #IFDEF ($show_transport)
1619 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
1620 $transported_count{$transport}++;
1621 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
1622 #ENDIF ($show_transport)
1624 #IFDEF ($hist_opt > 0)
1625 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
1626 #ENDIF ($hist_opt > 0)
1630 elsif ($flag eq "==" && defined($size{$id}) && !defined($delayed{$id})) {
1635 elsif ($flag eq "**") {
1636 $had_error{$id} = 1 if defined ($size{$id});
1638 #IFDEF ($show_errors)
1639 $errors_count{$_}++;
1640 #ENDIF ($show_errors)
1644 elsif ($flag eq "Co") {
1646 #IFDEF ($#queue_times >= 0)
1647 #Note: id_seconds() benchmarks as 42% slower than seconds() and computing
1648 #the time accounts for a significant portion of the run time.
1650 if (defined $arrival_time{$id}) {
1651 $queued = seconds($tod) - seconds($arrival_time{$id});
1652 delete($arrival_time{$id});
1655 $queued = seconds($tod) - id_seconds($id);
1658 for ($i = 0; $i <= $#queue_times; $i++) {
1659 if ($queued < $queue_times[$i]) {
1661 $remote_queue_bin[$i]++ if $remote_delivered{$id};
1665 $queue_more_than++ if $i > $#queue_times;
1666 #ENDIF ($#queue_times >= 0)
1668 #IFDEF ($show_relay)
1669 delete($from_host{$id});
1670 delete($from_address{$id});
1671 #ENDIF ($show_relay)
1676 # We now do a 'C preprocessor style operation on our parser
1677 # to remove bits not in use.
1678 my(%defines_in_operation,$removing_lines,$processed_parser);
1679 foreach (split (/\n/,$parser)) {
1680 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
1681 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
1682 $defines_in_operation{$1} = 1;
1683 $removing_lines = 1;
1686 $processed_parser .= $_."\n" unless $removing_lines;
1688 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
1689 delete $defines_in_operation{$1};
1690 unless (keys %defines_in_operation) {
1691 $removing_lines = 0;
1695 print STDERR "# START OF PARSER:\n$processed_parser\n# END OF PARSER\n\n" if $debug;
1697 return $processed_parser;
1702 #######################################################################
1705 # parse($parser,\*FILEHANDLE);
1707 # This subroutine accepts a parser and a filehandle from main and parses each
1708 # line. We store the results into global variables.
1709 #######################################################################
1711 my($parser,$fh) = @_;
1713 if ($merge_reports) {
1714 parse_old_eximstat_reports($fh);
1725 #######################################################################
1730 # Print our headers and contents.
1731 #######################################################################
1734 my $title = "Exim statistics from $begin to $end";
1737 print html_header($title);
1739 print "<li><a href=\"#grandtotal\">Grand total summary</a>\n";
1740 print "<li><a href=\"#patterns\">User Specified Patterns</a>\n" if @user_patterns;
1741 print "<li><a href=\"#transport\">Deliveries by Transport</a>\n" if $show_transport;
1743 print "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
1744 print "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
1746 if ($#queue_times >= 0) {
1747 print "<li><a href=\"#all messages time\">Time spent on the queue: all messages</a>\n";
1748 print "<li><a href=\"#messages with at least one remote delivery time\">Time spent on the queue: messages with at least one remote delivery</a>\n";
1750 print "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
1752 foreach ('Host','Domain','Email','Edomain') {
1753 next unless $do_sender{$_};
1754 print "<li><a href=\"#sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
1755 print "<li><a href=\"#sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
1757 if ($local_league_table || $include_remote_users) {
1758 print "<li><a href=\"#local sender count\">Top $topcount local senders by message count</a>\n";
1759 print "<li><a href=\"#local sender volume\">Top $topcount local senders by volume</a>\n";
1761 foreach ('Host','Domain','Email','Edomain') {
1762 next unless $do_sender{$_};
1763 print "<li><a href=\"#\l$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
1764 print "<li><a href=\"#\l$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
1766 if ($local_league_table || $include_remote_users) {
1767 print "<li><a href=\"#local destination count\">Top $topcount local destinations by message count</a>\n";
1768 print "<li><a href=\"#local destination volume\">Top $topcount local destinations by volume</a>\n";
1771 print "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
1772 print "</ul>\n<hr>\n";
1781 #######################################################################
1782 # print_grandtotals();
1784 # print_grandtotals();
1786 # Print the grand totals.
1787 #######################################################################
1788 sub print_grandtotals {
1790 # Get the sender by headings and results. This is complicated as we can have
1791 # different numbers of columns.
1792 my($sender_txt_header,$sender_html_header,$sender_txt_format,$sender_html_format);
1793 my(@received_totals,@delivered_totals);
1794 foreach ('Host','Domain','Email','Edomain') {
1795 next unless $do_sender{$_};
1796 if ($merge_reports) {
1797 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
1798 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
1801 push(@received_totals,scalar(keys %{$received_data{$_}}));
1802 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
1804 $sender_html_header .= "<th>${_}s</th>";
1805 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
1806 $sender_html_format .= "<td align=\"right\">%d</td>";
1807 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6d";
1810 my($format1,$format2);
1813 <a name="grandtotal"></a>
1814 <h2>Grand total summary</h2>
1816 <tr><th>TOTAL</th><th>Volume</th><th>Messages</th>$sender_html_header<th colspan=2>At least one addr<br>Delayed</th><th colspan=2>At least one addr<br>Failed</th>
1819 $format1 = "<tr><td>%s</td><td align=\"right\">%s</td>$sender_html_format<td align=\"right\">%d</td>";
1820 $format2 = "<td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td><td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td>";
1823 my $sender_spaces = " " x length($sender_txt_header);
1828 $sender_spaces At least one address
1829 TOTAL Volume Messages $sender_txt_header Delayed Failed
1831 $format1 = " %-16s %9s %6d $sender_txt_format";
1832 $format2 = " %6d %4.1f%% %6d %4.1f%%",
1835 my($volume,$failed_count);
1836 if ($merge_reports) {
1837 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
1838 $total_received_count = get_report_total($report_totals{Received},'Messages');
1839 $failed_count = get_report_total($report_totals{Received},'Failed');
1840 $delayed_count = get_report_total($report_totals{Received},'Delayed');
1843 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
1844 $failed_count = keys %had_error;
1849 printf("$format1$format2\n",'Received',$volume,$total_received_count,
1850 @received_totals,$delayed_count,
1851 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
1853 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0);
1856 if ($merge_reports) {
1857 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
1858 $total_delivered_count = get_report_total($report_totals{Delivered},'Messages');
1861 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
1863 printf("$format1\n\n",'Delivered',$volume,$total_delivered_count,@delivered_totals);
1864 print "</table>\n" if $html;
1868 #######################################################################
1869 # print_user_patterns()
1871 # print_user_patterns();
1873 # Print the counts of user specified patterns.
1874 #######################################################################
1875 sub print_user_patterns {
1879 print "<hr><a name=\"patterns\"></a><h2>User Specified Patterns</h2>\n";
1880 print "<table border=0 width=\"100%\">\n";
1882 print "<table border=1>\n";
1883 print "<tr><th> </th><th>Total</th>\n";
1884 $format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
1887 print "User Specified Patterns\n";
1888 print "-----------------------";
1890 $format1 = " %-18s %6d";
1894 if ($merge_reports) {
1895 # We are getting our data from previous reports.
1896 foreach $key (@user_descriptions) {
1897 my $count = get_report_total($report_totals{patterns}{$key},'Total');
1898 printf("$format1\n",$key,$count);
1902 # We are getting our data from mainlog files.
1903 my $user_pattern_index = 0;
1904 foreach $key (@user_descriptions) {
1905 printf("$format1\n",$key,$user_pattern_totals[$user_pattern_index]);
1906 $user_pattern_index++;
1916 #######################################################################
1917 # print_transport();
1919 # print_transport();
1921 # Print totals by transport.
1922 #######################################################################
1923 sub print_transport {
1925 my(@chartdatanames);
1926 my(@chartdatavals_count);
1927 my(@chartdatavals_vol);
1928 no integer; #Lose this for charting the data.
1931 print "<hr><a name=\"transport\"></a><h2>Deliveries by Transport</h2>\n";
1932 print "<table border=0 width=\"100%\">\n";
1934 print "<table border=1>\n";
1935 print "<tr><th> </th><th>Volume</th><th>Messages</th>\n";
1936 $format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
1939 print "Deliveries by transport\n";
1940 print "-----------------------";
1941 print "\n Volume Messages\n";
1942 $format1 = " %-18s %6s %6d";
1946 if ($merge_reports) {
1947 # We are getting our data from previous reports.
1948 foreach $key (sort keys %{$report_totals{transport}}) {
1949 my $count = get_report_total($report_totals{transport}{$key},'Messages');
1950 printf("$format1\n",$key,
1951 volume_rounded($report_totals{transport}{$key}{Volume},$report_totals{transport}{$key}{'Volume-gigs'}),
1953 push(@chartdatanames, $key);
1954 push(@chartdatavals_count, $count);
1955 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
1959 # We are getting our data from mainlog files.
1960 foreach $key (sort keys %transported_data) {
1961 printf("$format1\n",$key,
1962 volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
1963 $transported_count{$key});
1964 push(@chartdatanames, $key);
1965 push(@chartdatavals_count, $transported_count{$key});
1966 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
1971 print "</td><td>\n";
1972 if ($HAVE_GD_Graph_pie && $charts)
1974 # calculate the graph
1977 \@chartdatavals_count
1979 my $graph = GD::Graph::pie->new(200, 200);
1981 x_label => 'Transport',
1982 y_label => 'Messages',
1983 title => 'By count',
1985 my $gd = $graph->plot(\@data) or warn($graph->error);
1987 open(IMG, ">$chartdir/transports_count.png") or die $!;
1991 print "<img src=\"$chartrel/transports_count.png\">";
1994 print "</td><td>\n";
1996 if ($HAVE_GD_Graph_pie && $charts) {
2001 my $graph = GD::Graph::pie->new(200, 200);
2003 title => 'By volume',
2005 my $gd = $graph->plot(\@data) or warn($graph->error);
2007 open(IMG, ">$chartdir/transports_vol.png") or die $!;
2011 print "<img src=\"$chartrel/transports_vol.png\">";
2014 print "</td></tr></table>\n";
2021 #######################################################################
2026 # Print our totals by relay.
2027 #######################################################################
2029 my $temp = "Relayed messages";
2030 print "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $html;
2031 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
2037 print "<table border=1>\n";
2038 print "<tr><th>Count</th><th>From</th><th>To</th>\n";
2039 $format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
2042 printf("%s\n%s\n\n", $temp, "-" x length($temp));
2043 $format = "%7d %s\n => %s\n";
2047 foreach $key (sort keys %relayed) {
2048 my $count = $relayed{$key};
2051 my($one,$two) = split(/=> /, $key);
2052 printf($format, $count, $one, $two);
2055 print "</table>\n<p>\n" if $html;
2056 print "${spacing}Total: $shown (plus $relayed_unshown unshown)\n";
2059 print "No relayed messages\n";
2060 print "-------------------\n" unless $html;
2067 #######################################################################
2072 # Print our errors. In HTML, we display them as a list rather than a table -
2073 # Netscape doesn't like large tables!
2074 #######################################################################
2076 my $total_errors = 0;
2078 if (scalar(keys %errors_count) != 0) {
2079 my $temp = "List of errors";
2082 print "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
2083 print "<ul><li><b>Count - Error</b>\n";
2084 $format = "<li>%d - %s\n";
2087 printf("%s\n%s\n\n", $temp, "-" x length($temp));
2091 foreach $key (sort keys %errors_count) {
2094 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
2095 $total_errors += $errors_count{$key};
2098 #Translate HTML tag characters. Sergey Sholokh.
2099 $text =~ s/\</\<\;/g;
2100 $text =~ s/\>/\>\;/g;
2102 printf($format,$errors_count{$key},$text);
2105 printf("%5d ", $errors_count{$key});
2106 while (length($text) > 65) {
2107 my($first,$rest) = $text =~ /(.{50}\S*)\s+(.+)/;
2109 printf("%s\n ", $first);
2112 printf("%s\n\n", $text);
2115 print "</ul>\n<p>\n" if $html;
2117 $temp = "Errors encountered: $total_errors";
2119 print "-" x length($temp),"\n" unless $html;
2125 #######################################################################
2126 # parse_old_eximstat_reports();
2128 # parse_old_eximstat_reports($fh);
2130 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
2132 # To test that the merging still works after changes, do something like the following.
2133 # All the diffs should produce no output.
2135 # options='-bydomain -byemail -byhost -byedomain'
2136 # options="$options -pattern 'Completed Messages' /Completed/"
2137 # options="$options -pattern 'Received Messages' /<=/"
2139 # ./eximstats $options mainlog > mainlog.txt
2140 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
2141 # diff mainlog.txt mainlog.2.txt
2143 # ./eximstats $options -html mainlog > mainlog.html
2144 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
2145 # diff mainlog.html mainlog.2.html
2147 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
2148 # diff mainlog.txt mainlog.3.txt
2150 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
2151 # diff mainlog.html mainlog.3.html
2153 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
2154 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
2155 # diff mainlog.txt mainlog.4.txt
2157 # # double_mainlog.txt should have twice the values that mainlog.txt has.
2158 # ./eximstats $options mainlog mainlog > double_mainlog.txt
2159 #######################################################################
2160 sub parse_old_eximstat_reports {
2163 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
2166 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
2167 $begin = $1 if ($1 lt $begin);
2168 $end = $3 if ($3 gt $end);
2170 elsif (/Grand total summary/) {
2171 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
2174 $_ = html2txt($_); #Convert general HTML markup to text.
2175 s/At least one addr//g; #Another part of the HTML output we don't want.
2177 # TOTAL Volume Messages Hosts Domains Delayed Failed
2178 # Received 26MB 237 177 23 8 3.4% 28 11.8%
2179 # Delivered 13MB 233 99 88
2180 if (/TOTAL\s+(.*?)\s*$/) {
2181 @fields = split(/\s+/,$1);
2182 #Delayed and Failed have two columns each, so add the extra field names in.
2183 splice(@fields,-1,1,'DelayedPercent','Failed','FailedPercent');
2185 elsif (/(Received|Delivered)\s+(.*?)\s*$/) {
2186 print STDERR "Parsing $_" if $debug;
2187 add_to_totals($report_totals{$1},\@fields,$2);
2189 last if (/Delivered/); #Last line of this section.
2193 elsif (/User Specified Patterns/i) {
2194 #User Specified Patterns
2195 #-----------------------
2199 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
2201 print STDERR "Parsing $_" if $debug;
2202 $_ = html2txt($_); #Convert general HTML markup to text.
2203 if (/^\s*(.*?)\s+(\d+)\s*$/) {
2204 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
2205 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
2207 last if (/^\s*$/); #Finished if we have a blank line.
2211 elsif (/Deliveries by transport/i) {
2212 #Deliveries by transport
2213 #-----------------------
2215 # :blackhole: 70KB 51
2216 # address_pipe 655KB 1
2219 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
2221 print STDERR "Parsing $_" if $debug;
2222 $_ = html2txt($_); #Convert general HTML markup to text.
2223 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
2224 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
2225 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
2227 last if (/^\s*$/); #Finished if we have a blank line.
2230 elsif (/(Messages received|Deliveries) per/) {
2231 # Messages received per hour (each dot is 2 messages)
2232 #---------------------------------------------------
2234 #00-01 106 .....................................................
2235 #01-02 103 ...................................................
2237 # Set a pointer to the interval array so we can use the same code
2238 # block for both messages received and delivered.
2239 my $interval_aref = ($1 eq 'Deliveries') ? \@delivered_interval_count : \@received_interval_count;
2240 my $reached_table = 0;
2242 $reached_table = 1 if (/^00/);
2243 next unless $reached_table;
2244 print STDERR "Parsing $_" if $debug;
2245 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
2246 $$interval_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
2248 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
2249 $$interval_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
2251 else { #Finished the table ?
2257 elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
2258 #Time spent on the queue: all messages
2259 #-------------------------------------
2261 #Under 1m 217 91.9% 91.9%
2267 # Set a pointer to the queue bin so we can use the same code
2268 # block for both all messages and remote deliveries.
2269 my $bin_aref = ($1 eq 'all messages') ? \@queue_bin : \@remote_queue_bin;
2270 my $reached_table = 0;
2272 $_ = html2txt($_); #Convert general HTML markup to text.
2273 $reached_table = 1 if (/^\s*Under/);
2274 next unless $reached_table;
2275 my $previous_seconds_on_queue = 0;
2276 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
2277 print STDERR "Parsing $_" if $debug;
2278 my($modifier,$formated_time,$count) = ($1,$2,$3);
2279 my $seconds = unformat_time($formated_time);
2280 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
2281 $previous_seconds_on_queue = $seconds;
2282 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
2284 for ($i = 0; $i <= $#queue_times; $i++) {
2285 if ($time_on_queue < $queue_times[$i]) {
2286 $$bin_aref[$i] += $count;
2290 # There's only one counter for messages going over the queue
2291 # times so make sure we only count it once.
2292 $queue_more_than += $count if (($bin_aref == \@queue_bin) && ($i > $#queue_times));
2295 last; #Finished the table ?
2300 elsif (/Relayed messages/) {
2304 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
2305 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
2307 #<tr><td align="right">1</td><td>addr.domain.com [1.2.3.4] a.user@domain.com </td><td>addr2.domain2.com [5.6.7.8] a2.user2@domain2.com</td>
2309 my $reached_table = 0;
2312 unless ($reached_table) {
2313 last if (/No relayed messages/);
2314 $reached_table = 1 if (/^\s*\d/ || />\d+</);
2315 next unless $reached_table;
2317 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
2318 update_relayed($1,$2,$3);
2320 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
2321 ($count,$sender) = ($1,$2);
2323 elsif (/=>\s+(.*?)\s*$/) {
2324 update_relayed($count,$sender,$1);
2327 last; #Finished the table ?
2332 elsif (/Top (.*?) by (message count|volume)/) {
2333 #Top 50 sending hosts by message count
2334 #-------------------------------------
2337 my($category,$by_count_or_volume) = ($1,$2);
2339 #As we show 2 views of each table (by count and by volume),
2340 #most (but not all) entries will appear in both tables.
2341 #Set up a hash to record which entries we have already seen
2342 #and one to record which ones we are seeing for the first time.
2343 if ($by_count_or_volume =~ /count/) {
2344 undef %league_table_value_entered;
2345 undef %league_table_value_was_zero;
2349 #As this section processes multiple different table categories,
2350 #set up pointers to the hashes to be updated.
2351 my($count_href,$data_href,$data_gigs_href);
2352 if ($category =~ /local sender/) {
2353 $count_href = \%received_count_user;
2354 $data_href = \%received_data_user;
2355 $data_gigs_href = \%received_data_gigs_user;
2357 elsif ($category =~ /sending (\S+?)s?\b/) {
2358 #Top 50 sending (host|domain|email|edomain)s
2359 #Top sending (host|domain|email|edomain)
2360 $count_href = \%{$received_count{"\u$1"}};
2361 $data_href = \%{$received_data{"\u$1"}};
2362 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
2364 elsif ($category =~ /local destination/) {
2365 $count_href = \%delivered_count_user;
2366 $data_href = \%delivered_data_user;
2367 $data_gigs_href = \%delivered_data_gigs_user;
2369 elsif ($category =~ /(\S+) destination/) {
2370 #Top 50 (host|domain|email|edomain) destinations
2371 #Top (host|domain|email|edomain) destination
2372 $count_href = \%{$delivered_count{"\u$1"}};
2373 $data_href = \%{$delivered_data{"\u$1"}};
2374 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
2377 my $reached_table = 0;
2379 $_ = html2txt($_); #Convert general HTML markup to text.
2380 $reached_table = 1 if (/^\s*\d/);
2381 next unless $reached_table;
2382 if (/^\s*(\d+)\s+(\S+)\s*(.*?)\s*$/) {
2383 my($count,$rounded_volume,$entry) = ($1,$2,$3);
2384 #Note: $entry fields can be both null and can contain spaces.
2386 #Add the entry into the %table_order hash if it has a rounded volume (KB/MB/GB).
2387 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
2389 unless ($league_table_value_entered{$entry}) {
2390 $league_table_value_entered{$entry} = 1;
2391 unless ($$count_href{$entry}) {
2392 $$count_href{$entry} = 0;
2393 $$data_href{$entry} = 0;
2394 $$data_gigs_href{$entry} = 0;
2395 $league_table_value_was_zero{$entry} = 1;
2398 $$count_href{$entry} += $count;
2399 #Add the rounded value to the data and data_gigs hashes.
2400 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry});
2401 print STDERR "$category by $by_count_or_volume: added $count,$rounded_volume to $entry\n" if $debug;
2404 else { #Finished the table ?
2405 if ($by_count_or_volume =~ /volume/) {
2406 #Add a few bytes to appropriate entries to preserve the order.
2408 my($rounded_volume);
2409 foreach $rounded_volume (keys %table_order) {
2410 #For each rounded volume, we want to create a list which has things
2411 #ordered from the volume table at the front, and additional things
2412 #from the count table ordered at the back.
2413 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
2414 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
2416 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
2417 @order = @{$table_order{$rounded_volume}{volume}};
2418 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
2420 my $bonus_bytes = $#order;
2421 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
2422 while (@order and ($bonus_bytes > 0)) {
2423 my $entry = shift(@order);
2424 if ($league_table_value_was_zero{$entry}) {
2425 $$data_href{$entry} += $bonus_bytes;
2426 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
2437 elsif (/List of errors/) {
2441 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
2442 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
2443 # host mail.one2one.net [193.133.192.24]: 550 User unknown
2445 #<li>1 - ally.dufc@dunbar.org.uk R=external T=smtp: SMTP error from remote mailer after RCPT TO:<ally.dufc@dunbar.org.uk>: host mail.dunbar.org.uk [216.167.89.88]: 550 Unknown local part ally.dufc in <ally.dufc@dunbar.org.uk>
2448 my $reached_table = 0;
2449 my($count,$error,$blanks);
2451 $reached_table = 1 if (/^( *|<li>)(\d+)/);
2452 next unless $reached_table;
2454 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
2455 $_ = html2txt($_); #Convert general HTML markup to text.
2458 $error .= ' ' . $1; #Join a multiline error.
2460 elsif (/^\s*(\d+)\s+(.*)/) {
2462 #Finished with a previous multiline error so save it.
2463 $errors_count{$error} = 0 unless $errors_count{$error};
2464 $errors_count{$error} += $count;
2466 ($count,$error) = ($1,$2);
2468 elsif (/Errors encountered/) {
2470 #Finished the section, so save our stored last error.
2471 $errors_count{$error} = 0 unless $errors_count{$error};
2472 $errors_count{$error} += $count;
2484 #######################################################################
2487 # update_relayed($count,$sender,$recipient);
2489 # Adds an entry into the %relayed hash. Currently only used when
2491 #######################################################################
2492 sub update_relayed {
2493 my($count,$sender,$recipient) = @_;
2495 #When generating the key, put in the 'H=' and 'A=' which can be used
2497 my $key = "H=$sender => H=$recipient";
2498 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
2499 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2500 $relayed{$key} = 0 if !defined $relayed{$key};
2501 $relayed{$key} += $count;
2504 $relayed_unshown += $count;
2509 #######################################################################
2512 # add_to_totals(\%totals,\@keys,$values);
2514 # Given a line of space seperated values, add them into the provided hash using @keys
2517 # If the value contains a '%', then the value is set rather than added. Otherwise, we
2518 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
2519 #######################################################################
2521 my($totals_href,$keys_aref,$values) = @_;
2522 my(@values) = split(/\s+/,$values);
2523 my(@keys) = @$keys_aref; #Make a copy as we destroy the one we use.
2525 foreach $value (@values) {
2526 my $key = shift(@keys) or next;
2527 if ($value =~ /%/) {
2528 $$totals_href{$key} = $value;
2531 $$totals_href{$key} = 0 unless ($$totals_href{$key});
2532 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
2533 un_round($value, \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
2534 print STDERR "Added $value to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
2539 #######################################################################
2540 # get_report_total();
2542 # $total = get_report_total(\%hash,$key);
2544 # If %hash contains values split into Units and Gigs, we calculate and return
2546 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
2547 #######################################################################
2548 sub get_report_total {
2550 my($hash_ref,$key) = @_;
2551 if ($$hash_ref{"${key}-gigs"}) {
2552 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
2554 return $$hash_ref{$key} || 0;
2557 #######################################################################
2560 # $text_line = html2txt($html_line);
2562 # Convert a line from html to text. Currently we just convert HTML tags to spaces
2563 # and convert >, <, and tags back.
2564 #######################################################################
2568 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
2569 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
2570 # (the ones used by this program). If someone is careless enough to have their
2571 # Userid the same as an HTML tag, there's not much we can do about it.
2572 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /og;
2574 s/\<\;/\</og; #Convert '<' to '<'.
2575 s/\>\;/\>/og; #Convert '>' to '>'.
2576 s/\ \;/ /og; #Convert ' ' to ' '.
2580 #######################################################################
2583 # $arg = get_next_arg();
2585 # Because eximstats arguments are often passed as variables,
2586 # we can't rely on shell parsing to deal with quotes. This
2587 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
2588 # starts with a quote (' or "), and doesn't end in one, then
2589 # we append the next argument to it and shift again. We repeat
2590 # until we've got all of the argument.
2592 # This isn't perfect as all white space gets reduced to one space,
2593 # but it's as good as we can get! If it's esential that spacing
2594 # be preserved precisely, then you get that by not using shell
2596 #######################################################################
2599 my $matched_pattern = 0;
2601 $arg .= ' ' if $arg;
2602 $arg .= $ARGV[1]; shift(@ARGV);
2603 if ($arg !~ /^['"]/) {
2604 $matched_pattern = 1;
2607 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
2608 $matched_pattern = 1;
2612 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
2618 ##################################################
2620 ##################################################
2623 $last_timestamp = '';
2627 $show_transport = 1;
2629 $local_league_table = 1;
2630 $include_remote_users = 0;
2632 $volume_rounding = 1;
2633 $localtime_offset = calculate_localtime_offset(); # PH/FANF
2636 $charts_option_specified = 0;
2640 @queue_times = (60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60,
2641 12*60*60, 24*60*60);
2644 $offset_seconds = 0;
2648 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-')
2650 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
2651 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
2652 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/)
2654 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
2656 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/)
2658 @queue_times = split(/,/, $1);
2660 foreach $q (@queue_times) { $q = eval($q) + 0 }
2661 @queue_times = sort { $a <=> $b } @queue_times;
2662 @queue_times = () if ($#queue_times == 0 && $queue_times[0] == 0);
2664 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
2665 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
2667 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
2669 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
2670 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
2671 elsif ($ARGV[0] =~ /^-html$/) { $html = 1 }
2672 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
2673 elsif ($ARGV[0] =~ /^-charts$/) {
2675 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
2676 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
2678 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
2679 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
2680 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
2681 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
2682 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
2683 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
2684 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
2685 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
2686 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
2687 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
2688 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
2689 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
2690 elsif ($ARGV[0] =~ /^-pattern$/)
2692 push(@user_descriptions,get_next_arg());
2693 push(@user_patterns,get_next_arg());
2695 elsif ($ARGV[0] =~ /^-utc$/)
2697 # We don't need this value if the log is in UTC.
2698 $localtime_offset = undef;
2702 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
2708 # Check that all the charts options are specified.
2709 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
2711 # Default to display tables by sending Host.
2712 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
2715 for (my $i = 0; $i <= $#queue_times; $i++) {
2717 $remote_queue_bin[$i] = 0;
2720 # Compute the number of slots for the histogram
2724 if ($hist_opt > 60 || 60 % $hist_opt != 0)
2726 print "Eximstats: -h must specify a factor of 60\n";
2729 $hist_interval = 60/$hist_opt; #Interval in minutes.
2730 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
2731 @received_interval_count = (0) x $hist_number;
2732 @delivered_interval_count = (0) x $hist_number;
2735 #$queue_unknown = 0;
2737 $total_received_data = 0;
2738 $total_received_data_gigs = 0;
2739 $total_received_count = 0;
2741 $total_delivered_data = 0;
2742 $total_delivered_data_gigs = 0;
2743 $total_delivered_count = 0;
2745 $queue_more_than = 0;
2747 $relayed_unshown = 0;
2748 $begin = "9999-99-99 99:99:99";
2749 $end = "0000-00-00 00:00:00";
2751 foreach $section ('Received','Delivered') {
2752 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
2753 $report_totals{$section}{$type} = 0;
2757 # Generate our parser.
2758 my $parser = generate_parser();
2763 # Scan the input files and collect the data
2764 foreach my $file (@ARGV) {
2765 if ($file =~ /\.gz/) {
2766 unless (open(FILE,"gunzip -c $file |")) {
2767 print STDERR "Failed to gunzip -c $file: $!";
2771 elsif ($file =~ /\.Z/) {
2772 unless (open(FILE,"uncompress -c $file |")) {
2773 print STDERR "Failed to uncompress -c $file: $!";
2778 unless (open(FILE,$file)) {
2779 print STDERR "Failed to read $file: $!";
2783 #Now parse the filehandle, updating the global variables.
2784 parse($parser,\*FILE);
2789 #No files provided. Parse STDIN, updating the global variables.
2790 parse($parser,\*STDIN);
2794 if ($begin eq "9999-99-99 99:99:99") {
2795 print "**** No valid log lines read\n";
2799 # Output our results.
2801 print_grandtotals();
2803 # Print counts of user specified patterns if required.
2804 print_user_patterns() if @user_patterns;
2806 # Print totals by transport if required.
2807 print_transport() if $show_transport;
2809 # Print the deliveries per interval as a histogram, unless configured not to.
2810 # First find the maximum in one interval and scale accordingly.
2811 if ($hist_opt > 0) {
2812 print_histogram("Messages received", @received_interval_count);
2813 print_histogram("Deliveries", @delivered_interval_count);
2816 # Print times on queue if required.
2817 if ($#queue_times >= 0) {
2818 print_queue_times("all messages", \@queue_bin,$queue_more_than);
2819 print_queue_times("messages with at least one remote delivery",\@remote_queue_bin,$queue_more_than);
2822 # Print relay information if required.
2823 print_relay() if $show_relay;
2825 # Print the league tables, if topcount isn't zero.
2826 if ($topcount > 0) {
2827 foreach ('Host','Domain','Email','Edomain') {
2828 next unless $do_sender{$_};
2829 print_league_table("sending \l$_", $received_count{$_}, $received_data{$_},$received_data_gigs{$_});
2832 print_league_table("local sender", \%received_count_user,
2833 \%received_data_user,\%received_data_gigs_user) if ($local_league_table || $include_remote_users);
2834 foreach ('Host','Domain','Email','Edomain') {
2835 next unless $do_sender{$_};
2836 print_league_table("\l$_ destination", $delivered_count{$_}, $delivered_data{$_},$delivered_data_gigs{$_});
2838 print_league_table("local destination", \%delivered_count_user,
2839 \%delivered_data_user,\%delivered_data_gigs_user) if ($local_league_table || $include_remote_users);
2842 # Print the error statistics if required.
2843 print_errors() if $show_errors;
2846 print "</body>\n</html>\n"