2 # $Cambridge: exim/src/src/eximstats.src,v 1.13 2007/01/31 16:52:12 ph10 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 Wouter Verhelst
195 # Pie charts by volume were actually generated by count. Fixed.
197 # 2005-02-07 V1.36 Gregor Herrmann / Steve Campbell
198 # Added average sizes to HTML Top tables.
200 # 2005-04-26 V1.37 Frank Heydlauf
201 # Added -xls and the ability to specify output files.
203 # 2005-04-29 V1.38 Steve Campbell
204 # Use FileHandles for outputing results.
205 # Allow any combination of xls, txt, and html output.
206 # Fixed display of large numbers with -nvr option
207 # Fixed merging of reports with empty tables.
209 # 2005-05-27 V1.39 Steve Campbell
210 # Added the -include_original_destination flag
211 # Removed tabs and trailing whitespace.
213 # 2005-06-03 V1.40 Steve Campbell
214 # Whilst parsing the mainlog(s), store information about
215 # the messages in a hash of arrays rather than using
216 # individual hashes. This is a bit cleaner and results in
217 # dramatic memory savings, albeit at a slight CPU cost.
219 # 2005-06-15 V1.41 Steve Campbell
220 # Added the -show_rt<list> flag.
221 # Added the -show_dt<list> flag.
223 # 2005-06-24 V1.42 Steve Campbell
224 # Added Histograms for user specified patterns.
226 # 2005-06-30 V1.43 Steve Campbell
227 # Bug fix for V1.42 with -h0 specified. Spotted by Chris Lear.
229 # 2005-07-26 V1.44 Steve Campbell
230 # Use a glob alias rather than an array ref in the generated
231 # parser. This improves both readability and performance.
233 # 2005-09-30 V1.45 Marco Gaiarin / Steve Campbell
234 # Collect SpamAssassin and rejection statistics.
235 # Don't display local sender or destination tables unless
236 # there is data to show.
237 # Added average volumes into the top table text output.
239 # 2006-02-07 V1.46 Steve Campbell
240 # Collect data on the number of addresses (recipients)
241 # as well as the number of messages.
243 # 2006-05-05 V1.47 Steve Campbell
244 # Added 'Message too big' to the list of mail rejection
245 # reasons (thanks to Marco Gaiarin).
247 # 2006-06-05 V1.48 Steve Campbell
248 # Mainlog lines which have GMT offsets and are too short to
249 # have a flag are now skipped.
251 # 2006-11-10 V1.49 Alain Williams
252 # Added the -emptyok flag.
254 # 2006-11-16 V1.50 Steve Campbell
255 # Fixes for obtaining the IP address from reject messages.
257 # 2006-11-27 V1.51 Steve Campbell
258 # Another update for obtaining the IP address from reject messages.
260 # 2006-11-27 V1.52 Steve Campbell
261 # Tally any reject message containing SpamAssassin.
263 # 2007-01-31 V1.53 Philip Hazel
264 # Allow for [pid] after date in log lines
268 # For documentation on the logfile format, see
269 # http://www.exim.org/exim-html-4.50/doc/html/spec_48.html#IX2793
273 eximstats - generates statistics from Exim mainlog or syslog files.
277 eximstats [Output] [Options] mainlog1 mainlog2 ...
278 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
286 Output the results in plain text to STDOUT.
288 =item B<-txt>=I<filename>
290 Output the results in plain text. Filename '-' for STDOUT is accepted.
294 Output the results in HTML to STDOUT.
296 =item B<-html>=I<filename>
298 Output the results in HTML. Filename '-' for STDOUT is accepted.
302 Output the results in Excel compatible Format to STDOUT.
303 Requires the Spreadsheet::WriteExcel CPAN module.
305 =item B<-xls>=I<filename>
307 Output the results in Excel compatible format. Filename '-' for STDOUT is accepted.
318 histogram divisions per hour. The default is 1, and
319 0 suppresses histograms. Valid values are:
321 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
325 Don't display error information.
329 Don't display relaying information.
331 =item B<-nr>I</pattern/>
333 Don't display relaying information that matches.
337 Don't display transport information.
339 =item B<-nt>I</pattern/>
341 Don't display transport information that matches
345 List of times for queuing information single 0 item suppresses.
349 Display top <number> sources/destinations
350 default is 50, 0 suppresses top listing.
354 Omit local sources/destinations in top listing.
356 =item B<-t_remote_users>
358 Include remote users in the top source/destination listings.
360 =item B<-include_original_destination>
362 Include the original destination email addresses rather than just
363 using the final ones.
364 Useful for finding out which of your mailing lists are receiving mail.
366 =item B<-show_dt>I<list>
368 Show the delivery times (B<DT>)for all the messages.
370 Exim must have been configured to use the +delivery_time logging option
371 for this option to work.
373 I<list> is an optional list of times. Eg -show_dt1,2,4,8 will show
374 the number of messages with delivery times under 1 second, 2 seconds, 4 seconds,
375 8 seconds, and over 8 seconds.
377 =item B<-show_rt>I<list>
379 Show the receipt times for all the messages. The receipt time is
380 defined as the Completed hh:mm:ss - queue_time_overall - the Receipt hh:mm:ss.
381 These figures will be skewed by pipelined messages so might not be that useful.
383 Exim must have been configured to use the +queue_time_overall logging option
384 for this option to work.
386 I<list> is an optional list of times. Eg -show_rt1,2,4,8 will show
387 the number of messages with receipt times under 1 second, 2 seconds, 4 seconds,
388 8 seconds, and over 8 seconds.
392 Show results by sending host. This may be combined with
393 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
394 are specified, then B<-byhost> is assumed as a default.
398 Show results by sending domain.
399 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
403 Show results by sender's email address.
404 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
406 =item B<-byemaildomain> or B<-byedomain>
408 Show results by sender's email domain.
409 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
411 =item B<-pattern> I<Description> I</Pattern/>
413 Look for the specified pattern and count the number of lines in which it appears.
414 This option can be specified multiple times. Eg:
416 -pattern 'Refused connections' '/refused connection/'
421 This option allows eximstats to merge old eximstat reports together. Eg:
423 eximstats mainlog.sun > report.sun.txt
424 eximstats mainlog.mon > report.mon.txt
425 eximstats mainlog.tue > report.tue.txt
426 eximstats mainlog.wed > report.web.txt
427 eximstats mainlog.thu > report.thu.txt
428 eximstats mainlog.fri > report.fri.txt
429 eximstats mainlog.sat > report.sat.txt
430 eximstats -merge report.*.txt > weekly_report.txt
431 eximstats -merge -html report.*.txt > weekly_report.html
437 You can merge text or html reports and output the results as text or html.
441 You can use all the normal eximstat output options, but only data
442 included in the original reports can be shown!
446 When merging reports, some loss of accuracy may occur in the top I<n> lists.
447 This will be towards the ends of the lists.
451 The order of items in the top I<n> lists may vary when the data volumes
452 round to the same value.
458 Create graphical charts to be displayed in HTML output.
459 Only valid in combination with I<-html>.
461 This requires the following modules which can be obtained
462 from http://www.cpan.org/modules/01modules.index.html
474 To install these, download and unpack them, then use the normal perl installation procedure:
481 =item B<-chartdir>I <dir>
483 Create the charts in the directory <dir>
485 =item B<-chartrel>I <dir>
487 Specify the relative directory for the "img src=" tags from where to include
492 Specify that it's OK to not find any valid log lines. Without this
493 we will output an error message if we don't find any.
497 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
498 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
505 Eximstats parses exim mainlog and syslog files to output a statistical
506 analysis of the messages processed. By default, a text
507 analysis is generated, but you can request other output formats
508 using flags. See the help (B<-help>) to learn
509 about how to create charts from the tables.
513 There is a web site at http://www.exim.org - this contains details of the
514 mailing list exim-users@exim.org.
518 This program does not perfectly handle messages whose received
519 and delivered log lines are in different files, which can happen
520 when you have multiple mail servers and a message cannot be
521 immeadiately delivered. Fixing this could be tricky...
523 Merging of xls files is not (yet) possible. Be free to implement :)
531 # use Time::Local; # PH/FANF
534 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints $HAVE_Spreadsheet_WriteExcel);
535 eval { require GD::Graph::pie; };
536 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
537 eval { require GD::Graph::linespoints; };
538 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
539 eval { require Spreadsheet::WriteExcel; };
540 $HAVE_Spreadsheet_WriteExcel = $@ ? 0 : 1;
543 ##################################################
545 ##################################################
546 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
547 use vars qw(@tab62 @days_per_month $gig);
548 use vars qw($VERSION);
549 use vars qw($COLUMN_WIDTHS);
550 use vars qw($WEEK $DAY $HOUR $MINUTE);
554 (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, # 0-9
555 0,10,11,12,13,14,15,16,17,18,19,20, # A-K
556 21,22,23,24,25,26,27,28,29,30,31,32, # L-W
557 33,34,35, 0, 0, 0, 0, 0, # X-Z
558 0,36,37,38,39,40,41,42,43,44,45,46, # a-k
559 47,48,49,50,51,52,53,54,55,56,57,58, # l-w
562 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
563 $gig = 1024 * 1024 * 1024;
566 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
570 $HOUR = 60 * $MINUTE;
574 # Declare global variables.
575 use vars qw($total_received_data $total_received_data_gigs $total_received_count);
576 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_messages $total_delivered_addresses);
577 use vars qw(%timestamp2time); #Hash of timestamp => time.
578 use vars qw($last_timestamp $last_time); #The last time convertion done.
579 use vars qw($last_date $date_seconds); #The last date convertion done.
580 use vars qw($last_offset $offset_seconds); #The last time offset convertion done.
581 use vars qw($localtime_offset);
582 use vars qw($i); #General loop counter.
583 use vars qw($debug); #Debug mode?
584 use vars qw($ntopchart); #How many entries should make it into the chart?
585 use vars qw($gddirectory); #Where to put files from GD::Graph
587 # SpamAssassin variables
588 use vars qw($spam_score $spam_score_gigs);
589 use vars qw($ham_score $ham_score_gigs);
590 use vars qw(%ham_count_by_ip %spam_count_by_ip);
591 use vars qw(%rejected_count_by_ip %rejected_count_by_reason);
593 #For use in Speadsheed::WriteExcel
594 use vars qw($workbook $ws_global $ws_relayed $ws_errors);
595 use vars qw($row $col $row_hist $col_hist);
596 use vars qw($run_hist);
597 use vars qw($f_default $f_header1 $f_header2 $f_header2_m $f_headertab $f_percent); #Format Header
600 use vars qw($txt_fh $htm_fh $xls_fh);
604 # The following are parameters whose values are
605 # set by command line switches:
606 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
607 use vars qw($topcount $local_league_table $include_remote_users);
608 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding $emptyOK);
609 use vars qw($relay_pattern @queue_times @user_patterns @user_descriptions);
610 use vars qw(@rcpt_times @delivery_times);
611 use vars qw($include_original_destination);
612 use vars qw($txt_fh $htm_fh $xls_fh);
614 use vars qw(%do_sender); #Do sender by Host, Domain, Email, and/or Edomain tables.
615 use vars qw($charts $chartrel $chartdir $charts_option_specified);
616 use vars qw($merge_reports); #Merge old reports ?
618 # The following are modified in the parse() routine, and
619 # referred to in the print_*() routines.
620 use vars qw($delayed_count $relayed_unshown $begin $end);
621 use vars qw(%messages @message);
622 use vars qw(%received_count %received_data %received_data_gigs);
623 use vars qw(%delivered_messages %delivered_data %delivered_data_gigs %delivered_addresses);
624 use vars qw(%received_count_user %received_data_user %received_data_gigs_user);
625 use vars qw(%delivered_messages_user %delivered_addresses_user %delivered_data_user %delivered_data_gigs_user);
626 use vars qw(%transported_count %transported_data %transported_data_gigs);
627 use vars qw(%relayed %errors_count $message_errors);
628 use vars qw(@qt_all_bin @qt_remote_bin);
629 use vars qw($qt_all_overflow $qt_remote_overflow);
630 use vars qw(@dt_all_bin @dt_remote_bin %rcpt_times_bin);
631 use vars qw($dt_all_overflow $dt_remote_overflow %rcpt_times_overflow);
632 use vars qw(@received_interval_count @delivered_interval_count);
633 use vars qw(@user_pattern_totals @user_pattern_interval_count);
635 use vars qw(%report_totals);
638 use vars qw($SIZE $FROM_HOST $FROM_ADDRESS $ARRIVAL_TIME $REMOTE_DELIVERED $PROTOCOL);
639 use vars qw($DELAYED $HAD_ERROR);
644 $REMOTE_DELIVERED = 4;
651 ##################################################
653 ##################################################
655 #######################################################################
656 # get_filehandle($file,\%output_files);
657 # Return a filehandle writing to $file.
659 # If %output_files is defined, check that $output_files{$file}
660 # doesn't exist and die if it does, or set it if it doesn't.
661 #######################################################################
663 my($file,$output_files_href) = @_;
665 $file = '-' if ($file eq '');
667 if (defined $output_files_href) {
668 die "You can only output to '$file' once! Use -h for help.\n" if exists $output_files_href->{$file};
669 $output_files_href->{$file} = 1;
677 unlink $file or die "Failed to rm $file: $!";
680 my $fh = new IO::File $file, O_WRONLY|O_CREAT|O_EXCL;
681 die "new IO::File $file failed: $!" unless (defined $fh);
686 #######################################################################
689 # $rounded_volume = volume_rounded($bytes,$gigabytes);
691 # Given a data size in bytes, round it to KB, MB, or GB
694 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
696 # Note: I've experimented with Math::BigInt and it results in a 33%
697 # performance degredation as opposed to storing numbers split into
698 # bytes and gigabytes.
699 #######################################################################
711 if ($volume_rounding) {
715 $rounded = sprintf("%6d", $x);
717 elsif ($x < 10000000) {
718 $rounded = sprintf("%4dKB", ($x + 512)/1024);
721 $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
724 # Values between 1GB and 10GB are printed in MB
726 $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
729 # Handle values over 10GB
730 $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
734 # We don't want any rounding to be done.
735 # and we don't need broken formated output which on one hand avoids numbers from
736 # being interpreted as string by Spreadsheed Calculators, on the other hand
737 # breaks if more than 4 digits! -> flexible length instead of fixed length
738 # Format the return value at the output routine! -fh
739 #$rounded = sprintf("%d", ($g * $gig) + $x);
741 $rounded = sprintf("%.0f", ($g * $gig) + $x);
748 #######################################################################
751 # un_round($rounded_volume,\$bytes,\$gigabytes);
753 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
754 # do the reverse transformation and convert it back into Bytes and Gigabytes.
755 # These are added to the $bytes and $gigabytes parameters.
757 # Given a data size in bytes, round it to KB, MB, or GB
760 # EG: 500 => (500,0), 14GB => (0,14), etc.
761 #######################################################################
763 my($rounded,$bytes_sref,$gigabytes_sref) = @_;
765 if ($rounded =~ /(\d+)GB/) {
766 $$gigabytes_sref += $1;
768 elsif ($rounded =~ /(\d+)MB/) {
769 $$gigabytes_sref += $1 / 1024;
770 $$bytes_sref += (($1 % 1024 ) * 1024 * 1024);
772 elsif ($rounded =~ /(\d+)KB/) {
773 $$gigabytes_sref += $1 / (1024 * 1024);
774 $$bytes_sref += ($1 % (1024 * 1024) * 1024);
776 elsif ($rounded =~ /(\d+)/) {
777 # We need to turn off integer in case we are merging an -nvr report.
779 $$gigabytes_sref += int($1 / $gig);
780 $$bytes_sref += $1 % $gig;
783 #Now reduce the bytes down to less than 1GB.
784 add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
788 #######################################################################
791 # add_volume(\$bytes,\$gigs,$size);
793 # Add $size to $bytes/$gigs where this is a number split into
794 # bytes ($bytes) and gigabytes ($gigs). This is significantly
795 # faster than using Math::BigInt.
796 #######################################################################
798 my($bytes_ref,$gigs_ref,$size) = @_;
799 $$bytes_ref = 0 if ! defined $$bytes_ref;
800 $$gigs_ref = 0 if ! defined $$gigs_ref;
801 $$bytes_ref += $size;
802 while ($$bytes_ref > $gig) {
809 #######################################################################
812 # $formatted_time = format_time($seconds);
814 # Given a time in seconds, break it down into
815 # weeks, days, hours, minutes, and seconds.
817 # Eg 12005 => 3h20m5s
818 #######################################################################
830 $p .= "$w"."w" if $w > 0;
831 $p .= "$d"."d" if $d > 0;
832 $p .= "$h"."h" if $h > 0;
833 $p .= "$m"."m" if $m > 0;
834 $p .= "$s"."s" if $s > 0 || $p eq "";
839 #######################################################################
842 # $seconds = unformat_time($formatted_time);
844 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
846 # Eg 3h20m5s => 12005
847 #######################################################################
849 my($formated_time) = pop @_;
852 while ($formated_time =~ s/^(\d+)([wdhms]?)//) {
853 $time += $1 if ($2 eq '' || $2 eq 's');
854 $time += $1 * 60 if ($2 eq 'm');
855 $time += $1 * 60 * 60 if ($2 eq 'h');
856 $time += $1 * 60 * 60 * 24 if ($2 eq 'd');
857 $time += $1 * 60 * 60 * 24 * 7 if ($2 eq 'w');
863 #######################################################################
866 # $time = seconds($timestamp);
868 # Given a time-of-day timestamp, convert it into a time() value using
869 # POSIX::mktime. We expect the timestamp to be of the form
870 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
871 # and the year to be absolute (we do the necessary conversions). The
872 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
873 # offset is not present, and we have not been told that the log is in UTC
874 # (with the -utc option), then we adjust the time by the current local
875 # time offset so that it can be compared with the time recorded in message
878 # To improve performance, we only use mktime on the date ($year-$mon-$day),
879 # and only calculate it if the date is different to the previous time we
880 # came here. We then add on seconds for the '$hour:$min:$sec'.
882 # We also store the results of the last conversion done, and only
883 # recalculate if the date is different.
885 # We used to have the '-cache' flag which would store the results of the
886 # mktime() call. However, the current way of just using mktime() on the
887 # date obsoletes this.
888 #######################################################################
892 # Is the timestamp the same as the last one?
893 return $last_time if ($last_timestamp eq $timestamp);
895 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
897 unless ($last_date eq $1) {
899 my(@timestamp) = (0,0,0,$4,$3,$2);
900 $timestamp[5] -= 1900;
902 $date_seconds = mktime(@timestamp);
904 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
906 # SC. Use cacheing. Also note we want seconds not minutes.
907 #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
908 if (defined $8 && ($8 ne $last_offset)) {
910 $offset_seconds = ($10 * 60 + $11) * 60;
911 $offset_seconds = -$offset_seconds if ($9 eq '-');
916 #$time -= $this_offset;
917 $time -= $offset_seconds;
918 } elsif (defined $localtime_offset) {
919 $time -= $localtime_offset;
922 # Store the last timestamp received.
923 $last_timestamp = $timestamp;
930 #######################################################################
933 # $time = id_seconds($message_id);
935 # Given a message ID, convert it into a time() value.
936 #######################################################################
938 my($sub_id) = substr((pop @_), 0, 6);
940 my(@c) = split(//, $sub_id);
941 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
945 #######################################################################
948 # $seconds = wdhms_seconds($string);
950 # Convert a string in a week/day/hour/minute/second format (eg 4h10s)
952 #######################################################################
954 if ($_[0] =~ /^(?:(\d+)w)?(?:(\d+)d)?(?:(\d+)h)?(?:(\d+)m)?(?:(\d+)s)?/) {
955 return((($1||0) * $WEEK) + (($2||0) * $DAY) + (($3||0) * $HOUR) + (($4||0) * $MINUTE) + ($5||0));
960 #######################################################################
963 # $queued = queue_time($completed_tod, $arrival_time, $id);
965 # Given the completed time of day and either the arrival time
966 # (preferred), or the message ID, calculate how long the message has
969 #######################################################################
971 my($completed_tod, $arrival_time, $id) = @_;
973 # Note: id_seconds() benchmarks as 42% slower than seconds()
974 # and computing the time accounts for a significant portion of
976 if (defined $arrival_time) {
977 return(seconds($completed_tod) - seconds($arrival_time));
980 return(seconds($completed_tod) - id_seconds($id));
985 #######################################################################
986 # calculate_localtime_offset();
988 # $localtime_offset = calculate_localtime_offset();
990 # Calculate the the localtime offset from gmtime in seconds.
992 # $localtime = time() + $localtime_offset.
994 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
995 # (West is negative, East is positive.)
996 #######################################################################
998 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
999 # This subroutine commented out as it's not currently in use.
1001 #sub calculate_localtime_offset {
1002 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
1003 # my (@sample_date) = (0,0,0,5,5,100);
1004 # my $localtime = timelocal(@sample_date);
1005 # my $gmtime = timegm(@sample_date);
1006 # my $offset = $localtime - $gmtime;
1010 sub calculate_localtime_offset {
1011 # Assume that the offset at the moment is valid across the whole
1012 # period covered by the logs that we're analysing. This may not
1013 # be true around the time the clocks change in spring or autumn.
1015 # mktime works on local time and gmtime works in UTC
1016 my $local = mktime(gmtime($utc));
1017 return $local - $utc;
1022 #######################################################################
1023 # print_duration_table();
1025 # print_duration_table($title, $message_type, \@times, \@values, $overflow);
1027 # Print a table showing how long a particular step took for
1028 # the messages. The parameters are:
1029 # $title Eg "Time spent on the queue"
1030 # $message_type Eg "Remote"
1031 # \@times The maximum time a message took for it to increment
1032 # the corresponding @values counter.
1033 # \@values An array of message counters.
1034 # $overflow The number of messages which exceeded the maximum
1036 #######################################################################
1037 sub print_duration_table {
1039 my($title, $message_type, $times_aref, $values_aref, $overflow) = @_;
1040 my(@chartdatanames);
1043 my $printed_one = 0;
1044 my $cumulative_percent = 0;
1046 my $queue_total = $overflow;
1047 map {$queue_total += $_} @$values_aref;
1049 my $temp = "$title: $message_type";
1052 my $txt_format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
1053 my $htm_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";
1056 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
1058 print $htm_fh "<hr><a name=\"$title $message_type\"></a><h2>$temp</h2>\n";
1059 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
1060 print $htm_fh "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
1063 $ws_global->write($row++, $col, "$title: ".$message_type, $f_header2);
1064 my @content=("Time", "Messages", "Percentage", "Cumulative Percentage");
1065 &set_worksheet_line($ws_global, $row++, 1, \@content, $f_headertab);
1069 for ($i = 0; $i <= $#$times_aref; ++$i) {
1070 if ($$values_aref[$i] > 0)
1072 my $percent = ($values_aref->[$i] * 100)/$queue_total;
1073 $cumulative_percent += $percent;
1075 my @content=($printed_one? " " : "Under",
1076 format_time($times_aref->[$i]),
1077 $values_aref->[$i], $percent, $cumulative_percent);
1080 printf $htm_fh ($htm_format, @content);
1081 if (!defined($values_aref->[$i])) {
1082 print $htm_fh "Not defined";
1086 printf $txt_fh ($txt_format, @content);
1087 if (!defined($times_aref->[$i])) {
1088 print $txt_fh "Not defined";
1094 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1095 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1097 if (!defined($times_aref->[$i])) {
1099 $ws_global->write($row++, $col, "Not defined" );
1103 push(@chartdatanames,
1104 ($printed_one? "" : "Under") . format_time($times_aref->[$i]));
1105 push(@chartdatavals, $$values_aref[$i]);
1110 if ($overflow && $overflow > 0) {
1111 my $percent = ($overflow * 100)/$queue_total;
1112 $cumulative_percent += $percent;
1114 my @content = ("Over ", format_time($times_aref->[-1]),
1115 $overflow, $percent, $cumulative_percent);
1117 printf $txt_fh ($txt_format, @content) if $txt_fh;
1118 printf $htm_fh ($htm_format, @content) if $htm_fh;
1121 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1122 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1127 push(@chartdatanames, "Over " . format_time($times_aref->[-1]));
1128 push(@chartdatavals, $overflow);
1130 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
1132 print $htm_fh "</table></td><td>";
1134 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1139 my $graph = GD::Graph::pie->new(200, 200);
1140 my $pngname = "$title-$message_type.png";
1141 $pngname =~ s/[^\w\-\.]/_/;
1143 my $graph_title = "$title ($message_type)";
1144 $graph->set(title => $graph_title) if (length($graph_title) < 21);
1146 my $gd = $graph->plot(\@data) or warn($graph->error);
1148 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1152 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1155 print $htm_fh "</td></tr></table>\n";
1162 print $txt_fh "\n" if $txt_fh;
1163 print $htm_fh "\n" if $htm_fh;
1168 #######################################################################
1169 # print_histogram();
1171 # print_histogram('Deliveries|Messages received|$pattern', $unit, @interval_count);
1173 # Print a histogram of the messages delivered/received per time slot
1174 # (hour by default).
1175 #######################################################################
1176 sub print_histogram {
1177 my($text, $unit, @interval_count) = @_;
1178 my(@chartdatanames);
1182 # save first row of print_histogram for xls output
1190 for ($i = 0; $i < $hist_number; $i++)
1191 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
1193 my $scale = int(($maxd + 25)/50);
1194 $scale = 1 if $scale == 0;
1197 if ($unit !~ s/y$/ies/) {
1202 # make and output title
1203 my $title = sprintf("$text per %s",
1204 ($hist_interval == 60)? "hour" :
1205 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
1207 my $txt_htm_title = $title . " (each dot is $scale $unit)";
1209 printf $txt_fh ("%s\n%s\n\n", $txt_htm_title, "-" x length($txt_htm_title)) if $txt_fh;
1212 print $htm_fh "<hr><a name=\"$text\"></a><h2>$txt_htm_title</h2>\n";
1213 print $htm_fh "<table border=0 width=\"100%\">\n";
1214 print $htm_fh "<tr><td><pre>\n";
1218 $title =~ s/Messages/Msg/ ;
1220 $ws_global->write($row++, $col_hist+1, $title, $f_headertab);
1226 for ($i = 0; $i < $hist_number; $i++) {
1227 my $c = $interval_count[$i];
1229 # If the interval is an hour (the maximum) print the starting and
1230 # ending hours as a label. Otherwise print the starting hour and
1231 # minutes, which take up the same space.
1234 if ($hist_opt == 1) {
1235 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
1237 print $txt_fh $temp if $txt_fh;
1238 print $htm_fh $temp if $htm_fh;
1243 $ws_global->write($row, 0, [$temp], $f_default);
1247 push(@chartdatanames, $temp);
1252 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
1254 { $temp = sprintf(" :%02d", $minutes) }
1256 print $txt_fh $temp if $txt_fh;
1257 print $htm_fh $temp if $htm_fh;
1258 if (($xls_fh) and ($run_hist==0)) {
1260 $temp = sprintf("%02d:%02d", $hour, $minutes);
1261 $ws_global->write($row, 0, [$temp], $f_default);
1264 push(@chartdatanames, $temp);
1265 $minutes += $hist_interval;
1266 if ($minutes >= 60) {
1271 push(@chartdatavals, $c);
1273 printf $txt_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $txt_fh;
1274 printf $htm_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $htm_fh;
1275 $ws_global->write($row++, $col_hist+1, [$c], $f_default) if $xls_fh;
1279 printf $txt_fh "\n" if $txt_fh;
1280 printf $htm_fh "\n" if $htm_fh;
1284 print $htm_fh "</pre>\n";
1285 print $htm_fh "</td><td>\n";
1286 if ($HAVE_GD_Graph_linespoints && $charts && ($#chartdatavals > 0)) {
1287 # calculate the graph
1292 my $graph = GD::Graph::linespoints->new(300, 300);
1295 y_label => 'Amount',
1297 x_labels_vertical => 1
1299 my $pngname = "histogram_$text.png";
1300 $pngname =~ s/[^\w\._]/_/g;
1302 my $gd = $graph->plot(\@data) or warn($graph->error);
1304 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1308 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1311 print $htm_fh "</td></tr></table>\n";
1314 $col_hist++; # where to continue next times
1316 $row+=2; # leave some space after history block
1317 $run_hist=1; # we have done this once or more
1322 #######################################################################
1323 # print_league_table();
1325 # print_league_table($league_table_type,\%message_count,\%address_count,\%message_data,\%message_data_gigs, $spreadsheet, $row_sref);
1327 # Given hashes of message count, address count, and message data,
1328 # which are keyed by the table type (eg by the sending host), print a
1329 # league table showing the top $topcount (defaults to 50).
1330 #######################################################################
1331 sub print_league_table {
1332 my($text,$m_count,$a_count,$m_data,$m_data_gigs,$spreadsheet, $row_sref) = @_;
1333 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
1334 my($title) = "Top $name by message count";
1335 my(@chartdatanames) = ();
1336 my(@chartdatavals) = ();
1337 my $chartotherval = 0;
1338 $text = ucfirst($text);
1340 # Align non-local addresses to the right (so all the .com's line up).
1341 # Local addresses are aligned on the left as they are userids.
1342 my $align = ($text !~ /local/i) ? 'right' : 'left';
1345 ################################################
1346 # Generate the printf formats and table headers.
1347 ################################################
1348 my(@headers) = ('Messages');
1349 push(@headers,'Addresses') if defined $a_count;
1350 push(@headers,'Bytes','Average') if defined $m_data;
1352 my $txt_format = "%10s " x @headers . " %s\n";
1353 my $txt_col_headers = sprintf $txt_format, @headers, $text;
1354 my $htm_format = "<tr>" . '<td align="right">%s</td>'x@headers . "<td align=\"$align\" nowrap>%s</td></tr>\n";
1355 my $htm_col_headers = sprintf $htm_format, @headers, $text;
1356 $htm_col_headers =~ s/(<\/?)td/$1th/g; #Convert <td>'s to <th>'s for the header.
1359 ################################################
1360 # Write the table headers
1361 ################################################
1362 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1365 print $htm_fh <<EoText;
1366 <hr><a name="$text count"></a><h2>$title</h2>
1367 <table border=0 width="100%">
1371 print $htm_col_headers;
1375 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1376 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1381 foreach my $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1383 # When displaying the average figures, we calculate the average of
1384 # the rounded data, as the user would calculate it. This reduces
1385 # the accuracy slightly, but we have to do it this way otherwise
1386 # when using -merge to convert results from text to HTML and
1387 # vice-versa discrepencies would occur.
1388 my $messages = $$m_count{$key};
1389 my @content = ($messages);
1390 push(@content, $$a_count{$key}) if defined $a_count;
1391 if (defined $m_data) {
1392 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1393 my($data,$gigs) = (0,0);
1394 un_round($rounded_volume,\$data,\$gigs);
1395 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1396 push(@content, $rounded_volume, $rounded_average);
1400 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1404 $htmlkey =~ s/>/\>\;/g;
1405 $htmlkey =~ s/</\<\;/g;
1406 printf $htm_fh ($htm_format, @content, $htmlkey);
1408 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1410 if (scalar @chartdatanames < $ntopchart) {
1411 push(@chartdatanames, $key);
1412 push(@chartdatavals, $$m_count{$key});
1415 $chartotherval += $$m_count{$key};
1419 push(@chartdatanames, "Other");
1420 push(@chartdatavals, $chartotherval);
1422 print $txt_fh "\n" if $txt_fh;
1424 print $htm_fh "</table>\n";
1425 print $htm_fh "</td><td>\n";
1426 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0))
1428 # calculate the graph
1433 my $graph = GD::Graph::pie->new(300, 300);
1436 y_label => 'Amount',
1437 title => 'By count',
1439 my $gd = $graph->plot(\@data) or warn($graph->error);
1443 open(IMG, ">$chartdir/${temp}_count.png") or die "Could not write $chartdir/${temp}_count.png: $!\n";
1447 print $htm_fh "<img src=\"$chartrel/${temp}_count.png\">";
1450 print $htm_fh "</td><td>\n";
1451 print $htm_fh "</td></tr></table>\n\n";
1453 ++${$row_sref} if $xls_fh;
1456 if (defined $m_data) {
1459 $title = "Top $name by volume";
1461 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1464 print $htm_fh <<EoText;
1465 <hr><a name="$text volume"></a><h2>$title</h2>
1466 <table border=0 width="100%">
1470 print $htm_col_headers;
1473 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1474 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1477 @chartdatanames = ();
1478 @chartdatavals = ();
1481 foreach my $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1482 # The largest volume will be the first (top of the list).
1483 # If it has at least 1 gig, then just use gigabytes to avoid
1484 # risking an integer overflow when generating the pie charts.
1485 if ($$m_data_gigs{$key}) {
1489 my $messages = $$m_count{$key};
1490 my @content = ($messages);
1491 push(@content, $$a_count{$key}) if defined $a_count;
1492 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1493 my($data ,$gigs) = (0,0);
1494 un_round($rounded_volume,\$data,\$gigs);
1495 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1496 push(@content, $rounded_volume, $rounded_average );
1499 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1502 $htmlkey =~ s/>/\>\;/g;
1503 $htmlkey =~ s/</\<\;/g;
1504 printf $htm_fh ($htm_format, @content, $htmlkey);
1506 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1509 if (scalar @chartdatanames < $ntopchart) {
1511 if ($$m_data_gigs{$key}) {
1512 push(@chartdatanames, $key);
1513 push(@chartdatavals, $$m_data_gigs{$key});
1517 push(@chartdatanames, $key);
1518 push(@chartdatavals, $$m_data{$key});
1522 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1525 push(@chartdatanames, "Other");
1526 push(@chartdatavals, $chartotherval);
1528 print $txt_fh "\n" if $txt_fh;
1530 print $htm_fh "</table>\n";
1531 print $htm_fh "</td><td>\n";
1532 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1533 # calculate the graph
1538 my $graph = GD::Graph::pie->new(300, 300);
1541 y_label => 'Volume' ,
1542 title => 'By Volume',
1544 my $gd = $graph->plot(\@data) or warn($graph->error);
1548 open(IMG, ">$chartdir/${temp}_volume.png") or die "Could not write $chartdir/${temp}_volume.png: $!\n";
1552 print $htm_fh "<img src=\"$chartrel/${temp}_volume.png\">";
1555 print $htm_fh "</td><td>\n";
1556 print $htm_fh "</td></tr></table>\n\n";
1559 ++${$row_sref} if $xls_fh;
1564 #######################################################################
1567 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1569 # Given a hash which has numerical values, return the sorted $n keys which
1570 # point to the top values. The second and third hashes are used as
1571 # tiebreakers. They all must have the same keys.
1573 # The idea behind this routine is that when you only want to see the
1574 # top n members of a set, rather than sorting the entire set and then
1575 # plucking off the top n, sort through the stack as you go, discarding
1576 # any member which is lower than your current n'th highest member.
1578 # This proves to be an order of magnitude faster for large hashes.
1579 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1580 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1582 # We assume the values are > 0.
1583 #######################################################################
1585 my($n,$href1,$href2,$href3) = @_;
1587 # PH's original sort was:
1589 # foreach $key (sort
1591 # $$m_count{$b} <=> $$m_count{$a} ||
1592 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1593 # $$m_data{$b} <=> $$m_data{$a} ||
1599 #We use a key of '_' to represent non-existant values, as null keys are valid.
1600 #'_' is not a valid domain, edomain, host, or email.
1601 my(@top_n_keys) = ('_') x $n;
1602 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1604 my $n_minus_1 = $n - 1;
1605 my $n_minus_2 = $n - 2;
1607 # Create a dummy hash incase the user has not provided us with
1608 # tiebreaker hashes.
1610 $href2 = \%dummy_hash unless defined $href2;
1611 $href3 = \%dummy_hash unless defined $href3;
1613 # Pick out the top $n keys.
1614 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1615 while (($key,$value1) = each %$href1) {
1617 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1619 # Check to see that the new value is bigger than the lowest of the
1620 # top n keys that we're keeping. We test the main key first, because
1621 # for the majority of cases we can skip creating dummy hash values
1622 # should the user have not provided real tie-breaking hashes.
1623 next unless $value1 >= $minimum_value1;
1625 # Create a dummy hash entry for the key if required.
1626 # Note that setting the dummy_hash value sets it for both href2 &
1627 # href3. Also note that currently we are guarenteed to have a real
1628 # value for href3 if a real value for href2 exists so don't need to
1629 # test for it as well.
1630 $dummy_hash{$key} = 0 unless exists $href2->{$key};
1632 $comparison = $value1 <=> $minimum_value1 ||
1633 $href2->{$key} <=> $minimum_value2 ||
1634 $href3->{$key} <=> $minimum_value3 ||
1635 $top_n_key cmp $key;
1636 next unless ($comparison == 1);
1638 # As we will be using these values a few times, extract them into scalars.
1639 $value2 = $href2->{$key};
1640 $value3 = $href3->{$key};
1642 # This key is bigger than the bottom n key, so the lowest position we
1643 # will insert it into is $n minus 1 (the bottom of the list).
1644 $insert_position = $n_minus_1;
1646 # Now go through the list, stopping when we find a key that we're
1647 # bigger than, or we come to the penultimate position - we've
1648 # already tested bigger than the last.
1650 # Note: we go top down as the list starts off empty.
1651 # Note: stepping through the list in this way benchmarks nearly
1652 # three times faster than doing a sort() on the reduced list.
1653 # I assume this is because the list is already in order, and
1654 # we get a performance boost from not having to do hash lookups
1656 for ($i = 0; $i < $n_minus_1; $i++) {
1657 $top_n_key = $top_n_keys[$i];
1658 if ( ($top_n_key eq '_') ||
1659 ( ($value1 <=> $href1->{$top_n_key} ||
1660 $value2 <=> $href2->{$top_n_key} ||
1661 $value3 <=> $href3->{$top_n_key} ||
1662 $top_n_key cmp $key) == 1
1665 $insert_position = $i;
1670 # Remove the last element, then insert the new one.
1671 $#top_n_keys = $n_minus_2;
1672 splice(@top_n_keys,$insert_position,0,$key);
1674 # Extract our new minimum values.
1675 $top_n_key = $top_n_keys[$n_minus_1];
1676 if ($top_n_key ne '_') {
1677 $minimum_value1 = $href1->{$top_n_key};
1678 $minimum_value2 = $href2->{$top_n_key};
1679 $minimum_value3 = $href3->{$top_n_key};
1683 # Return the top n list, grepping out non-existant values, just in case
1684 # we didn't have that many values.
1685 return(grep(!/^_$/,@top_n_keys));
1690 #######################################################################
1693 # $header = html_header($title);
1695 # Print our HTML header and start the <body> block.
1696 #######################################################################
1699 my $text = << "EoText";
1700 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1703 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1704 <title>$title</title>
1706 <body bgcolor="white">
1714 #######################################################################
1719 # Display usage instructions and exit.
1720 #######################################################################
1724 eximstats Version $VERSION
1727 eximstats [Output] [Options] mainlog1 mainlog2 ...
1728 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1731 eximstats -html=eximstats.html mainlog1 mainlog2 ...
1732 eximstats mainlog1 mainlog2 ... > report.txt
1734 Parses exim mainlog or syslog files and generates a statistical analysis
1735 of the messages processed.
1737 Valid output types are:
1738 -txt[=<file>] plain text (default unless no other type is specified)
1741 With no type and file given, defaults to -txt and STDOUT.
1744 -h<number> histogram divisions per hour. The default is 1, and
1745 0 suppresses histograms. Other valid values are:
1746 2, 3, 5, 10, 15, 20, 30 or 60.
1747 -ne don't display error information
1748 -nr don't display relaying information
1749 -nr/pattern/ don't display relaying information that matches
1750 -nt don't display transport information
1751 -nt/pattern/ don't display transport information that matches
1752 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1753 -t<number> display top <number> sources/destinations
1754 default is 50, 0 suppresses top listing
1755 -tnl omit local sources/destinations in top listing
1756 -t_remote_users show top user sources/destinations from non-local domains
1757 -q<list> list of times for queuing information. -q0 suppresses.
1758 -show_rt<list> Show the receipt times for all the messages.
1759 -show_dt<list> Show the delivery times for all the messages.
1760 <list> is an optional list of times in seconds.
1763 -include_original_destination show both the final and original
1764 destinations in the results rather than just the final ones.
1766 -byhost show results by sending host (default unless bydomain or
1767 byemail is specified)
1768 -bydomain show results by sending domain.
1769 -byemail show results by sender's email address
1770 -byedomain show results by sender's email domain
1772 -pattern "Description" /pattern/
1773 Count lines matching specified patterns and show them in
1774 the results. It can be specified multiple times. Eg:
1775 -pattern 'Refused connections' '/refused connection/'
1777 -merge merge previously generated reports into a new report
1779 -charts Create charts (this requires the GD::Graph modules).
1780 Only valid with -html.
1781 -chartdir <dir> Create the charts' png files in the directory <dir>
1782 -chartrel <dir> Specify the relative directory for the "img src=" tags
1783 from where to include the charts in the html file
1784 -chartdir and -chartrel default to '.'
1786 -emptyok It is OK if there is no valid input, don't print an error.
1788 -d Debug mode - dump the eval'ed parser onto STDERR.
1797 #######################################################################
1798 # generate_parser();
1800 # $parser = generate_parser();
1802 # This subroutine generates the parsing routine which will be
1803 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1804 # This improves performance depending on what bits you take out or add.
1806 # I've tested using study(), but this does not improve performance.
1808 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1809 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1810 # the expression evaluates to true, then it is included/excluded accordingly.
1811 #######################################################################
1812 sub generate_parser {
1814 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1815 my($tod,$m_hour,$m_min,$id,$flag,$extra,$length);
1816 my($seconds,$queued,$rcpt_time);
1820 # Convert syslog lines to mainlog format.
1822 next unless s/^.*? exim\\b.*?: //;
1825 $length = length($_);
1826 next if ($length < 38);
1827 next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)( \\[\\d+\\])?/o;
1829 ($tod,$m_hour,$m_min) = ($1,$2,$3);
1831 # PH - watch for GMT offsets in the timestamp.
1834 next if ($length < 44);
1840 # PH - watch for PID added after the timestamp.
1842 $extra += length($5);
1843 next if ($length < 38 + $extra);
1846 $id = substr($_, 20 + $extra, 16);
1847 $flag = substr($_, 37 + $extra, 2);
1849 if ($flag !~ /^([<>=*-]+|SA)$/ && /rejected|refused|dropped/) {
1854 # Rejects can have no MSGID...
1855 if ($flag eq "Re" && $id !~ /^[-0-9a-zA-Z]+$/) {
1856 $id = "reject:" . ++$rej_id;
1861 # Watch for user specified patterns.
1862 my $user_pattern_index = 0;
1863 foreach (@user_patterns) {
1864 $user_pattern_totals[$user_pattern_index] = 0;
1865 $parser .= " if ($_) {\n";
1866 $parser .= " \$user_pattern_totals[$user_pattern_index]++;\n";
1867 $parser .= " \$user_pattern_interval_count[$user_pattern_index][(\$m_hour*60 + \$m_min)/$hist_interval]++;\n" if ($hist_opt > 0);
1869 $user_pattern_index++;
1873 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co|SA|Re/);
1875 #Strip away the timestamp, ID and flag to speed up later pattern matches.
1876 #The flags include Co (Completed), Re (Rejected), and SA (SpamAssassin).
1877 $_ = substr($_, 40 + $extra); # PH
1879 # Alias @message to the array of information about the message.
1880 # This minimises the number of calls to hash functions.
1881 $messages{$id} = [] unless exists $messages{$id};
1882 *message = $messages{$id};
1885 # JN - Skip over certain transports as specified via the "-nt/.../" command
1886 # line switch (where ... is a perl style regular expression). This is
1887 # required so that transports that skew stats such as SpamAssassin can be
1889 #IFDEF ($transport_pattern)
1890 if (/\\sT=(\\S+)/) {
1891 next if ($1 =~ /$transport_pattern/o) ;
1893 #ENDIF ($transport_pattern)
1897 # Do some pattern matches to get the host and IP address.
1898 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1899 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1900 # We do 2 separate matches to keep the matches simple and fast.
1901 # Host is local unless otherwise specified.
1902 $ip = (/\\bH=.*?(\\[[^]]+\\])/) ? $1 : "local";
1903 $host = (/\\bH=(\\S+)/) ? $1 : "local";
1905 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1907 #IFDEF ($do_sender{Domain})
1908 if ($host !~ /^\\[/ && $host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1909 # Remove the host portion from the DNS name. We ensure that we end up
1910 # with at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1911 $domain = lc("$1.$2");
1912 $domain =~ s/^\\.//; #Remove preceding dot.
1914 #ENDIF ($do_sender{Domain})
1916 #IFDEF ($do_sender{Email})
1917 #IFDEF ($include_original_destination)
1918 # Catch both "a@b.com <c@d.com>" and "e@f.com"
1919 #$email = (/^(\S+) (<(\S*?)>)?/) ? $3 || $1 : "";
1920 $email = (/^(\S+ (<[^@>]+@?[^>]*>)?)/) ? $1 : "";
1922 #ENDIF ($include_original_destination)
1924 #IFNDEF ($include_original_destination)
1925 $email = (/^(\S+)/) ? $1 : "";
1926 #ENDIF ($include_original_destination)
1927 #ENDIF ($do_sender{Email})
1929 #IFDEF ($do_sender{Edomain})
1930 #IFDEF ($include_original_destination)
1931 #$edomain = (/^(\S+) (<\S*?\\@(\S+)>)?/) ? $3 || $1 : "";
1932 $edomain = (/^(\S+ (<\S*?\\@(\S+?)>)?)/) ? $1 : "";
1935 #ENDIF ($include_original_destination)
1937 #IFNDEF ($include_original_destination)
1938 $edomain = (/^\S*?\\@(\S+)/) ? lc($1) : "";
1939 #ENDIF ($include_original_destination)
1940 #ENDIF ($do_sender{Edomain})
1942 if ($tod lt $begin) {
1945 elsif ($tod gt $end) {
1950 if ($flag eq "<=") {
1951 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
1952 $message[$SIZE] = $thissize;
1953 $message[$PROTOCOL] = (/ P=(\S+)/) ? $1 : undef;
1955 #IFDEF ($show_relay)
1956 if ($host ne "local") {
1957 # Save incoming information in case it becomes interesting
1958 # later, when delivery lines are read.
1959 my($from) = /^(\\S+)/;
1960 $message[$FROM_HOST] = "$host$ip";
1961 $message[$FROM_ADDRESS] = $from;
1963 #ENDIF ($show_relay)
1965 #IFDEF ($local_league_table || $include_remote_users)
1969 #IFDEF ($local_league_table && $include_remote_users)
1970 { #Store both local and remote users.
1971 #ENDIF ($local_league_table && $include_remote_users)
1973 #IFDEF ($local_league_table && ! $include_remote_users)
1974 if ($host eq "local") { #Store local users only.
1975 #ENDIF ($local_league_table && ! $include_remote_users)
1977 #IFDEF ($include_remote_users && ! $local_league_table)
1978 if ($host ne "local") { #Store remote users only.
1979 #ENDIF ($include_remote_users && ! $local_league_table)
1981 ++$received_count_user{$user};
1982 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
1985 #ENDIF ($local_league_table || $include_remote_users)
1987 #IFDEF ($do_sender{Host})
1988 ++$received_count{Host}{$host};
1989 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
1990 #ENDIF ($do_sender{Host})
1992 #IFDEF ($do_sender{Domain})
1994 ++$received_count{Domain}{$domain};
1995 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
1997 #ENDIF ($do_sender{Domain})
1999 #IFDEF ($do_sender{Email})
2000 ++$received_count{Email}{$email};
2001 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
2002 #ENDIF ($do_sender{Email})
2004 #IFDEF ($do_sender{Edomain})
2005 ++$received_count{Edomain}{$edomain};
2006 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
2007 #ENDIF ($do_sender{Edomain})
2009 ++$total_received_count;
2010 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
2012 #IFDEF ($#queue_times >= 0 || $#rcpt_times >= 0)
2013 $message[$ARRIVAL_TIME] = $tod;
2014 #ENDIF ($#queue_times >= 0 || $#rcpt_times >= 0)
2016 #IFDEF ($hist_opt > 0)
2017 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2018 #ENDIF ($hist_opt > 0)
2021 elsif ($flag eq "=>") {
2022 $size = $message[$SIZE] || 0;
2023 if ($host ne "local") {
2024 $message[$REMOTE_DELIVERED] = 1;
2027 #IFDEF ($show_relay)
2028 # Determine relaying address if either only one address listed,
2029 # or two the same. If they are different, it implies a forwarding
2030 # or aliasing, which is not relaying. Note that for multi-aliased
2031 # addresses, there may be a further address between the first
2034 if (defined $message[$FROM_HOST]) {
2035 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
2036 ($old,$new) = ($1,$2);
2042 if ("\\L$new" eq "\\L$old") {
2043 ($old) = /^(\\S+)/ if $old eq "";
2044 my $key = "H=\\L$message[$FROM_HOST]\\E A=\\L$message[$FROM_ADDRESS]\\E => " .
2045 "H=\\L$host\\E$ip A=\\L$old\\E";
2046 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2047 $relayed{$key} = 0 if !defined $relayed{$key};
2055 #ENDIF ($show_relay)
2059 #IFDEF ($local_league_table || $include_remote_users)
2060 #IFDEF ($local_league_table && $include_remote_users)
2061 { #Store both local and remote users.
2062 #ENDIF ($local_league_table && $include_remote_users)
2064 #IFDEF ($local_league_table && ! $include_remote_users)
2065 if ($host eq "local") { #Store local users only.
2066 #ENDIF ($local_league_table && ! $include_remote_users)
2068 #IFDEF ($include_remote_users && ! $local_league_table)
2069 if ($host ne "local") { #Store remote users only.
2070 #ENDIF ($include_remote_users && ! $local_league_table)
2072 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2073 #IFDEF ($include_original_destination)
2075 #ENDIF ($include_original_destination)
2076 #IFNDEF ($include_original_destination)
2077 if ($user =~ /^[\\/|]/) {
2078 #ENDIF ($include_original_destination)
2079 my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2080 $user = "$user $parent" if defined $parent;
2082 ++$delivered_messages_user{$user};
2083 ++$delivered_addresses_user{$user};
2084 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
2087 #ENDIF ($local_league_table || $include_remote_users)
2089 #IFDEF ($do_sender{Host})
2090 $delivered_messages{Host}{$host}++;
2091 $delivered_addresses{Host}{$host}++;
2092 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
2093 #ENDIF ($do_sender{Host})
2094 #IFDEF ($do_sender{Domain})
2096 ++$delivered_messages{Domain}{$domain};
2097 ++$delivered_addresses{Domain}{$domain};
2098 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
2100 #ENDIF ($do_sender{Domain})
2101 #IFDEF ($do_sender{Email})
2102 ++$delivered_messages{Email}{$email};
2103 ++$delivered_addresses{Email}{$email};
2104 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
2105 #ENDIF ($do_sender{Email})
2106 #IFDEF ($do_sender{Edomain})
2107 ++$delivered_messages{Edomain}{$edomain};
2108 ++$delivered_addresses{Edomain}{$edomain};
2109 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
2110 #ENDIF ($do_sender{Edomain})
2112 ++$total_delivered_messages;
2113 ++$total_delivered_addresses;
2114 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
2116 #IFDEF ($show_transport)
2117 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
2118 ++$transported_count{$transport};
2119 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
2120 #ENDIF ($show_transport)
2122 #IFDEF ($hist_opt > 0)
2123 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2124 #ENDIF ($hist_opt > 0)
2126 #IFDEF ($#delivery_times > 0)
2128 $seconds = wdhms_seconds($1);
2129 for ($i = 0; $i <= $#delivery_times; $i++) {
2130 if ($seconds < $delivery_times[$i]) {
2132 ++$dt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2136 if ($i > $#delivery_times) {
2138 ++$dt_remote_overflow if $message[$REMOTE_DELIVERED];
2141 #ENDIF ($#delivery_times > 0)
2145 elsif ($flag eq "->") {
2147 #IFDEF ($local_league_table || $include_remote_users)
2148 #IFDEF ($local_league_table && $include_remote_users)
2149 { #Store both local and remote users.
2150 #ENDIF ($local_league_table && $include_remote_users)
2152 #IFDEF ($local_league_table && ! $include_remote_users)
2153 if ($host eq "local") { #Store local users only.
2154 #ENDIF ($local_league_table && ! $include_remote_users)
2156 #IFDEF ($include_remote_users && ! $local_league_table)
2157 if ($host ne "local") { #Store remote users only.
2158 #ENDIF ($include_remote_users && ! $local_league_table)
2160 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2161 #IFDEF ($include_original_destination)
2163 #ENDIF ($include_original_destination)
2164 #IFNDEF ($include_original_destination)
2165 if ($user =~ /^[\\/|]/) {
2166 #ENDIF ($include_original_destination)
2167 my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2168 $user = "$user $parent" if defined $parent;
2170 ++$delivered_addresses_user{$user};
2173 #ENDIF ($local_league_table || $include_remote_users)
2175 #IFDEF ($do_sender{Host})
2176 $delivered_addresses{Host}{$host}++;
2177 #ENDIF ($do_sender{Host})
2178 #IFDEF ($do_sender{Domain})
2180 ++$delivered_addresses{Domain}{$domain};
2182 #ENDIF ($do_sender{Domain})
2183 #IFDEF ($do_sender{Email})
2184 ++$delivered_addresses{Email}{$email};
2185 #ENDIF ($do_sender{Email})
2186 #IFDEF ($do_sender{Edomain})
2187 ++$delivered_addresses{Edomain}{$edomain};
2188 #ENDIF ($do_sender{Edomain})
2190 ++$total_delivered_addresses;
2193 elsif ($flag eq "==" && defined($message[$SIZE]) && !defined($message[$DELAYED])) {
2195 $message[$DELAYED] = 1;
2198 elsif ($flag eq "**") {
2199 if (defined ($message[$SIZE])) {
2200 unless (defined $message[$HAD_ERROR]) {
2202 $message[$HAD_ERROR] = 1;
2206 #IFDEF ($show_errors)
2207 ++$errors_count{$_};
2208 #ENDIF ($show_errors)
2212 elsif ($flag eq "Co") {
2214 #IFDEF ($#queue_times >= 0)
2215 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2217 for ($i = 0; $i <= $#queue_times; $i++) {
2218 if ($queued < $queue_times[$i]) {
2220 ++$qt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2224 if ($i > $#queue_times) {
2226 ++$qt_remote_overflow if $message[$REMOTE_DELIVERED];
2228 #ENDIF ($#queue_times >= 0)
2230 #IFDEF ($#rcpt_times >= 0)
2232 $seconds = wdhms_seconds($1);
2233 #Calculate $queued if not previously calculated above.
2234 #IFNDEF ($#queue_times >= 0)
2235 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2236 #ENDIF ($#queue_times >= 0)
2237 $rcpt_time = $seconds - $queued;
2240 if (defined $message[$PROTOCOL]) {
2241 $protocol = $message[$PROTOCOL];
2243 # Create the bin if its not already defined.
2244 unless (exists $rcpt_times_bin{$protocol}) {
2245 initialise_rcpt_times($protocol);
2250 for ($i = 0; $i <= $#rcpt_times; ++$i) {
2251 if ($rcpt_time < $rcpt_times[$i]) {
2252 ++$rcpt_times_bin{all}[$i];
2253 ++$rcpt_times_bin{$protocol}[$i] if defined $protocol;
2258 if ($i > $#rcpt_times) {
2259 ++$rcpt_times_overflow{all};
2260 ++$rcpt_times_overflow{$protocol} if defined $protocol;
2263 #ENDIF ($#rcpt_times >= 0)
2265 delete($messages{$id});
2267 elsif ($flag eq "SA") {
2268 $ip = (/From.*?(\\[[^]]+\\])/ || /\\((local)\\)/) ? $1 : "";
2269 #SpamAssassin message
2270 if (/Action: ((permanently|temporarily) rejected message|flagged as Spam but accepted): score=(\d+\.\d)/) {
2271 #add_volume(\\$spam_score,\\$spam_score_gigs,$3);
2272 ++$spam_count_by_ip{$ip};
2273 } elsif (/Action: scanned but message isn\'t spam: score=(-?\d+\.\d)/) {
2274 #add_volume(\\$ham_score,\\$ham_score_gigs,$1);
2275 ++$ham_count_by_ip{$ip};
2276 } elsif (/(Not running SA because SAEximRunCond expanded to false|check skipped due to message size)/) {
2277 ++$ham_count_by_ip{$ip};
2281 # Look for Reject messages or blackholed messages (deliveries
2282 # without a transport)
2283 if ($flag eq "Re" || ($flag eq "=>" && ! /\\sT=\\S+/)) {
2284 # Correct the IP address for rejects:
2285 # rejected EHLO from my.test.net [10.0.0.5]: syntactically invalid argument(s):
2286 # rejected EHLO from [10.0.0.6]: syntactically invalid argument(s):
2287 $ip = $1 if ($ip eq "local" && /^rejected [HE][HE]LO from .*?(\[.+?\]):/);
2288 ++$rejected_count_by_ip{$ip};
2289 if (/SpamAssassin/) {
2290 ++$rejected_count_by_reason{"Rejected by SpamAssassin"};
2293 /(listed at [^ ]+)/ ||
2294 /(Forged IP detected in HELO)/ ||
2295 /(Invalid domain or IP given in HELO\/EHLO)/ ||
2296 /(unqualified recipient rejected)/ ||
2297 /(closed connection (after|in response) .*?)\s*$/ ||
2298 /(sender rejected)/ ||
2299 # 2005-09-23 15:07:49 1EInHJ-0007Ex-Au H=(a.b.c) [10.0.0.1] F=<> rejected after DATA: This message contains a virus: (Eicar-Test-Signature) please scan your system.
2300 # 2005-10-06 10:50:07 1ENRS3-0000Nr-Kt => blackhole (DATA ACL discarded recipients): This message contains a virus: (Worm.SomeFool.P) please scan your system.
2301 / rejected after DATA: (.*)/ ||
2302 /.DATA ACL discarded recipients.: (.*)/ ||
2303 /rejected after DATA: (unqualified address not permitted)/ ||
2304 /(VRFY rejected)/ ||
2305 # /(sender verify (defer|fail))/i ||
2306 /(too many recipients)/ ||
2307 /(refused relay.*?) to/ ||
2308 /(rejected by non-SMTP ACL: .*)/ ||
2309 /(rejected by local_scan.*)/ ||
2310 # SMTP call from %s dropped: too many syntax or protocol errors (last command was "%s"
2311 # SMTP call from %s dropped: too many nonmail commands
2312 /(dropped: too many ((nonmail|unrecognized) commands|syntax or protocol errors))/ ||
2314 # local_scan() function crashed with signal %d - message temporarily rejected
2315 # local_scan() function timed out - message temporarily rejected
2316 /(local_scan.. function .* - message temporarily rejected)/ ||
2317 /(temporarily refused connection)/ ||
2318 # SMTP protocol synchronization error (input sent without waiting for greeting): rejected connection from %s
2319 /(SMTP protocol .*?(error|violation))/ ||
2322 ++$rejected_count_by_reason{"\u$1"};
2324 elsif (/rejected [HE][HE]LO from [^:]*: syntactically invalid argument/) {
2325 ++$rejected_count_by_reason{"Rejected HELO/EHLO: syntactically invalid argument"};
2327 elsif (/response to "RCPT TO.*? was: (.*)/) {
2328 ++$rejected_count_by_reason{"Response to RCPT TO was: $1"};
2331 /(lookup of host )\S+ (failed)/ ||
2333 # rejected from <%s>%s%s%s%s: message too big:
2334 /(rejected [A-Z]*) .*?(: .*?)(:|\s*$)/ ||
2335 # refused connection from %s (host_reject_connection)
2336 # refused connection from %s (tcp wrappers)
2337 /(refused connection )from.*? (\(.*)/ ||
2339 # error from remote mailer after RCPT TO:<a@b.c>: host a.b.c [10.0.0.1]: 450 <a@b.c>: Recipient address rejected: Greylisted for 60 seconds
2340 # error from remote mailer after MAIL FROM:<> SIZE=3468: host a.b.c [10.0.0.1]: 421 a.b.c has refused your connection because your server did not have a PTR record.
2341 /(error from remote mailer after .*?:).*(: .*?)(:|\s*$)/ ||
2343 # a.b.c F=<a@b.c> rejected after DATA: "@" or "." expected after "Undisclosed-Recipient": failing address in "To" header is: <Undisclosed-Recipient:;>
2344 /rejected after DATA: ("." or "." expected).*?(: failing address in .*? header)/ ||
2346 # connection from %s refused load average = %.2f
2347 /(Connection )from.*? (refused: load average)/ ||
2348 # connection from %s refused (IP options)
2349 # Connection from %s refused: too many connections
2350 # connection from %s refused
2351 /([Cc]onnection )from.*? (refused.*)/ ||
2352 # [10.0.0.1]: connection refused
2353 /: (Connection refused)()/
2355 ++$rejected_count_by_reason{"\u$1$2"};
2358 ++$rejected_count_by_reason{Unknown};
2359 print STDERR "Unknown rejection: $_" if $debug;
2364 # We now do a 'C preprocessor style operation on our parser
2365 # to remove bits not in use.
2366 my(%defines_in_operation,$removing_lines,$processed_parser);
2367 foreach (split (/\n/,$parser)) {
2368 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
2369 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
2370 $defines_in_operation{$1} = 1;
2371 $removing_lines = 1;
2374 # Convert constants.
2375 while (/(\$[A-Z][A-Z_]*)\b/) {
2376 my $constant = eval $1;
2377 s/(\$[A-Z][A-Z_]*)\b/$constant/;
2380 $processed_parser .= $_."\n" unless $removing_lines;
2382 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
2383 delete $defines_in_operation{$1};
2384 unless (keys %defines_in_operation) {
2385 $removing_lines = 0;
2389 print STDERR "# START OF PARSER:$processed_parser\n# END OF PARSER\n\n" if $debug;
2391 return $processed_parser;
2396 #######################################################################
2399 # parse($parser,\*FILEHANDLE);
2401 # This subroutine accepts a parser and a filehandle from main and parses each
2402 # line. We store the results into global variables.
2403 #######################################################################
2405 my($parser,$fh) = @_;
2407 if ($merge_reports) {
2408 parse_old_eximstat_reports($fh);
2419 #######################################################################
2424 # Print our headers and contents.
2425 #######################################################################
2429 my $title = "Exim statistics from $begin to $end";
2431 print $txt_fh "\n$title\n" if $txt_fh;
2433 print $htm_fh html_header($title);
2434 print $htm_fh "<ul>\n";
2435 print $htm_fh "<li><a href=\"#grandtotal\">Grand total summary</a>\n";
2436 print $htm_fh "<li><a href=\"#patterns\">User Specified Patterns</a>\n" if @user_patterns;
2437 print $htm_fh "<li><a href=\"#transport\">Deliveries by Transport</a>\n" if $show_transport;
2439 print $htm_fh "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
2440 print $htm_fh "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
2443 if ($#queue_times >= 0) {
2444 print $htm_fh "<li><a href=\"#Time spent on the queue all messages\">Time spent on the queue: all messages</a>\n";
2445 print $htm_fh "<li><a href=\"#Time spent on the queue messages with at least one remote delivery\">Time spent on the queue: messages with at least one remote delivery</a>\n";
2448 if ($#delivery_times >= 0) {
2449 print $htm_fh "<li><a href=\"#Delivery times all messages\">Delivery times: all messages</a>\n";
2450 print $htm_fh "<li><a href=\"#Delivery times messages with at least one remote delivery\">Delivery times: messages with at least one remote delivery</a>\n";
2453 if ($#rcpt_times >= 0) {
2454 print $htm_fh "<li><a href=\"#Receipt times all messages\">Receipt times</a>\n";
2457 print $htm_fh "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
2459 print $htm_fh "<li><a href=\"#mail rejection reason count\">Top $topcount mail rejection reasons by message count</a>\n" if %rejected_count_by_reason;
2460 foreach ('Host','Domain','Email','Edomain') {
2461 next unless $do_sender{$_};
2462 print $htm_fh "<li><a href=\"#sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
2463 print $htm_fh "<li><a href=\"#sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
2465 if (($local_league_table || $include_remote_users) && %received_count_user) {
2466 print $htm_fh "<li><a href=\"#local sender count\">Top $topcount local senders by message count</a>\n";
2467 print $htm_fh "<li><a href=\"#local sender volume\">Top $topcount local senders by volume</a>\n";
2469 foreach ('Host','Domain','Email','Edomain') {
2470 next unless $do_sender{$_};
2471 print $htm_fh "<li><a href=\"#\l$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
2472 print $htm_fh "<li><a href=\"#\l$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
2474 if (($local_league_table || $include_remote_users) && %delivered_messages_user) {
2475 print $htm_fh "<li><a href=\"#local destination count\">Top $topcount local destinations by message count</a>\n";
2476 print $htm_fh "<li><a href=\"#local destination volume\">Top $topcount local destinations by volume</a>\n";
2479 print $htm_fh "<li><a href=\"#rejected ip count\">Top $topcount rejected ips by message count</a>\n" if %rejected_count_by_ip;
2480 print $htm_fh "<li><a href=\"#non-rejected spamming ip count\">Top $topcount non-rejected spamming ips by message count</a>\n" if %spam_count_by_ip;
2483 print $htm_fh "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
2484 print $htm_fh "</ul>\n<hr>\n";
2488 $ws_global->write($row++, $col+0, "Exim Statistics", $f_header1);
2489 &set_worksheet_line($ws_global, $row, $col, ["from:", $begin, "to:", $end], $f_default);
2495 #######################################################################
2496 # print_grandtotals();
2498 # print_grandtotals();
2500 # Print the grand totals.
2501 #######################################################################
2502 sub print_grandtotals {
2504 # Get the sender by headings and results. This is complicated as we can have
2505 # different numbers of columns.
2506 my($sender_txt_header,$sender_txt_format,$sender_html_format);
2507 my(@received_totals,@delivered_totals);
2508 my($row_tablehead, $row_max);
2509 my(@col_headers) = ('TOTAL', 'Volume', 'Messages', 'Addresses');
2511 foreach ('Host','Domain','Email','Edomain') {
2512 next unless $do_sender{$_};
2513 if ($merge_reports) {
2514 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
2515 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
2518 push(@received_totals,scalar(keys %{$received_data{$_}}));
2519 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
2521 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
2522 $sender_html_format .= "<td align=\"right\">%d</td>";
2523 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6d";
2524 push(@col_headers,"${_}s");
2527 my $txt_format1 = " %-16s %9s %6d %6s $sender_txt_format";
2528 my $txt_format2 = " %6d %4.1f%% %6d %4.1f%%",
2529 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%s</td><td align=\"right\">%s</td>$sender_html_format";
2530 my $htm_format2 = "<td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td><td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td>";
2533 my $sender_spaces = " " x length($sender_txt_header);
2535 print $txt_fh "Grand total summary\n";
2536 print $txt_fh "-------------------\n";
2537 print $txt_fh " $sender_spaces At least one address\n";
2538 print $txt_fh " TOTAL Volume Messages Addresses $sender_txt_header Delayed Failed\n";
2541 print $htm_fh "<a name=\"grandtotal\"></a>\n";
2542 print $htm_fh "<h2>Grand total summary</h2>\n";
2543 print $htm_fh "<table border=1>\n";
2544 print $htm_fh "<tr><th>" . join('</th><th>',@col_headers) . "</th><th colspan=2>At least one addr<br>Delayed</th><th colspan=2>At least one addr<br>Failed</th>\n";
2547 $ws_global->write($row++, 0, "Grand total summary", $f_header2);
2548 $ws_global->write($row, 0, \@col_headers, $f_header2);
2549 $ws_global->merge_range($row, scalar(@col_headers), $row, scalar(@col_headers)+1, "At least one addr Delayed", $f_header2_m);
2550 $ws_global->merge_range($row, scalar(@col_headers)+2, $row, scalar(@col_headers)+3, "At least one addr Failed", $f_header2_m);
2551 #$ws_global->write(++$row, scalar(@col_headers), ['Total','Percent','Total','Percent'], $f_header2);
2555 my($volume,$failed_count);
2556 if ($merge_reports) {
2557 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
2558 $total_received_count = get_report_total($report_totals{Received},'Messages');
2559 $failed_count = get_report_total($report_totals{Received},'Failed');
2560 $delayed_count = get_report_total($report_totals{Received},'Delayed');
2563 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
2564 $failed_count = $message_errors;
2571 $volume,$total_received_count,'',
2574 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
2576 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0
2579 printf $txt_fh ("$txt_format1$txt_format2\n", 'Received', @content) if $txt_fh;
2580 printf $htm_fh ("$htm_format1$htm_format2\n", 'Received', @content) if $htm_fh;
2582 $ws_global->write(++$row, 0, 'Received', $f_default);
2583 for (my $i=0; $i < scalar(@content); $i++) {
2584 if ($i == 4 || $i == 6) {
2585 $ws_global->write($row, $i+1, $content[$i]/100, $f_percent);
2588 $ws_global->write($row, $i+1, $content[$i], $f_default);
2594 if ($merge_reports) {
2595 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
2596 $total_delivered_messages = get_report_total($report_totals{Delivered},'Messages');
2597 $total_delivered_addresses = get_report_total($report_totals{Delivered},'Addresses');
2600 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
2603 my @content=($volume, $total_delivered_messages, $total_delivered_addresses, @delivered_totals);
2604 printf $txt_fh ("$txt_format1\n", 'Delivered', @content) if $txt_fh;
2605 printf $htm_fh ("$htm_format1\n", 'Delivered', @content) if $htm_fh;
2608 $ws_global->write(++$row, 0, 'Delivered', $f_default);
2609 for (my $i=0; $i < scalar(@content); $i++) {
2610 $ws_global->write($row, $i+1, $content[$i], $f_default);
2614 if ($merge_reports) {
2615 foreach ('Rejects', 'Ham', 'Spam') {
2616 my $messages = get_report_total($report_totals{$_},'Messages');
2617 my $addresses = get_report_total($report_totals{$_},'Addresses');
2619 @content = ($_, '', $messages, '');
2620 push(@content,get_report_total($report_totals{$_},'Hosts')) if $do_sender{Host};
2621 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2622 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2623 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2628 foreach my $total_aref (['Rejects',\%rejected_count_by_ip],
2629 ['Ham',\%ham_count_by_ip],
2630 ['Spam',\%spam_count_by_ip]) {
2632 map {$messages += $_} values %{$total_aref->[1]};
2634 if ($messages > 0) {
2635 @content = ($total_aref->[0], '', $messages, '');
2636 push(@content,scalar(keys %{$total_aref->[1]})) if $do_sender{Host};
2638 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2639 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2640 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2645 printf $txt_fh "\n" if $txt_fh;
2646 printf $htm_fh "</table>\n" if $htm_fh;
2651 #######################################################################
2652 # print_user_patterns()
2654 # print_user_patterns();
2656 # Print the counts of user specified patterns.
2657 #######################################################################
2658 sub print_user_patterns {
2659 my $txt_format1 = " %-18s %6d";
2660 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2663 print $txt_fh "User Specified Patterns\n";
2664 print $txt_fh "-----------------------";
2665 print $txt_fh "\n Total\n";
2668 print $htm_fh "<hr><a name=\"patterns\"></a><h2>User Specified Patterns</h2>\n";
2669 print $htm_fh "<table border=0 width=\"100%\">\n";
2670 print $htm_fh "<tr><td>\n";
2671 print $htm_fh "<table border=1>\n";
2672 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2675 $ws_global->write($row++, $col, "User Specified Patterns", $f_header2);
2676 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2681 if ($merge_reports) {
2682 # We are getting our data from previous reports.
2683 foreach $key (@user_descriptions) {
2684 my $count = get_report_total($report_totals{patterns}{$key},'Total');
2685 printf $txt_fh ("$txt_format1\n",$key,$count) if $txt_fh;
2686 printf $htm_fh ("$htm_format1\n",$key,$count) if $htm_fh;
2689 &set_worksheet_line($ws_global, $row++, 0, [$key,$count], $f_default);
2694 # We are getting our data from mainlog files.
2695 my $user_pattern_index = 0;
2696 foreach $key (@user_descriptions) {
2697 printf $txt_fh ("$txt_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $txt_fh;
2698 printf $htm_fh ("$htm_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $htm_fh;
2699 $ws_global->write($row++, 0, [$key,$user_pattern_totals[$user_pattern_index]]) if $xls_fh;
2700 $user_pattern_index++;
2703 print $txt_fh "\n" if $txt_fh;
2704 print $htm_fh "</table>\n\n" if $htm_fh;
2710 if ($hist_opt > 0) {
2711 my $user_pattern_index = 0;
2712 foreach $key (@user_descriptions) {
2713 print_histogram($key, 'occurence', @{$user_pattern_interval_count[$user_pattern_index]});
2714 $user_pattern_index++;
2719 #######################################################################
2724 # Print statistics about rejected mail.
2725 #######################################################################
2727 my($format1,$reason);
2729 my $txt_format1 = " %-40s %6d";
2730 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2733 print $txt_fh "Rejected mail by reason\n";
2734 print $txt_fh "-----------------------";
2735 print $txt_fh "\n Total\n";
2738 print $htm_fh "<hr><a name=\"patterns\"></a><h2>Rejected mail by reason</h2>\n";
2739 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2740 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2743 $ws_global->write($row++, $col, "Rejected mail by reason", $f_header2);
2744 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2748 my $href = ($merge_reports) ? $report_totals{rejected_mail_by_reason} : \%rejected_count_by_reason;
2749 my(@chartdatanames, @chartdatavals_count);
2751 foreach $reason (top_n_sort($topcount, $href, undef, undef)) {
2752 printf $txt_fh ("$txt_format1\n",$reason,$href->{$reason}) if $txt_fh;
2753 printf $htm_fh ("$htm_format1\n",$reason,$href->{$reason}) if $htm_fh;
2754 set_worksheet_line($ws_global, $row++, 0, [$reason,$href->{$reason}], $f_default) if $xls_fh;
2755 push(@chartdatanames, $reason);
2756 push(@chartdatavals_count, $href->{$reason});
2760 print $txt_fh "\n" if $txt_fh;
2763 print $htm_fh "</tr></table></td><td>";
2764 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0)) {
2765 # calculate the graph
2768 \@chartdatavals_count
2770 my $graph = GD::Graph::pie->new(200, 200);
2772 x_label => 'Rejection Reasons',
2773 y_label => 'Messages',
2774 title => 'By count',
2776 my $gd = $graph->plot(\@data) or warn($graph->error);
2778 open(IMG, ">$chartdir/rejections_count.png") or die "Could not write $chartdir/rejections_count.png: $!\n";
2782 print $htm_fh "<img src=\"$chartrel/rejections_count.png\">";
2785 print $htm_fh "</td></tr></table>\n\n";
2793 #######################################################################
2794 # print_transport();
2796 # print_transport();
2798 # Print totals by transport.
2799 #######################################################################
2800 sub print_transport {
2801 my(@chartdatanames);
2802 my(@chartdatavals_count);
2803 my(@chartdatavals_vol);
2804 no integer; #Lose this for charting the data.
2806 my $txt_format1 = " %-18s %6s %6d";
2807 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
2810 print $txt_fh "Deliveries by transport\n";
2811 print $txt_fh "-----------------------";
2812 print $txt_fh "\n Volume Messages\n";
2815 print $htm_fh "<hr><a name=\"transport\"></a><h2>Deliveries by Transport</h2>\n";
2816 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2817 print $htm_fh "<tr><th> </th><th>Volume</th><th>Messages</th>\n";
2820 $ws_global->write(++$row, $col, "Deliveries by transport", $f_header2);
2821 $ws_global->write(++$row, 1, ["Volume", "Messages"], $f_headertab);
2825 if ($merge_reports) {
2826 # We are getting our data from previous reports.
2827 foreach $key (sort keys %{$report_totals{transport}}) {
2828 my $count = get_report_total($report_totals{transport}{$key},'Messages');
2829 my @content=($key, volume_rounded($report_totals{transport}{$key}{Volume},
2830 $report_totals{transport}{$key}{'Volume-gigs'}), $count);
2831 push(@chartdatanames, $key);
2832 push(@chartdatavals_count, $count);
2833 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
2834 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2835 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2836 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2840 # We are getting our data from mainlog files.
2841 foreach $key (sort keys %transported_data) {
2842 my @content=($key, volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
2843 $transported_count{$key});
2844 push(@chartdatanames, $key);
2845 push(@chartdatavals_count, $transported_count{$key});
2846 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
2847 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2848 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2849 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2852 print $txt_fh "\n" if $txt_fh;
2854 print $htm_fh "</tr></table></td><td>";
2856 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0))
2858 # calculate the graph
2861 \@chartdatavals_count
2863 my $graph = GD::Graph::pie->new(200, 200);
2865 x_label => 'Transport',
2866 y_label => 'Messages',
2867 title => 'By count',
2869 my $gd = $graph->plot(\@data) or warn($graph->error);
2871 open(IMG, ">$chartdir/transports_count.png") or die "Could not write $chartdir/transports_count.png: $!\n";
2875 print $htm_fh "<img src=\"$chartrel/transports_count.png\">";
2878 print $htm_fh "</td><td>";
2880 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_vol > 0)) {
2885 my $graph = GD::Graph::pie->new(200, 200);
2887 title => 'By volume',
2889 my $gd = $graph->plot(\@data) or warn($graph->error);
2891 open(IMG, ">$chartdir/transports_vol.png") or die "Could not write $chartdir/transports_vol.png: $!\n";
2895 print $htm_fh "<img src=\"$chartrel/transports_vol.png\">";
2899 print $htm_fh "</td></tr></table>\n\n";
2905 #######################################################################
2910 # Print our totals by relay.
2911 #######################################################################
2913 my $row_print_relay=1;
2914 my $temp = "Relayed messages";
2915 print $htm_fh "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $htm_fh;
2916 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
2919 my $txt_format = "%7d %s\n => %s\n";
2920 my $htm_format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
2922 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2924 print $htm_fh "<table border=1>\n";
2925 print $htm_fh "<tr><th>Count</th><th>From</th><th>To</th>\n";
2928 $ws_relayed->write($row_print_relay++, $col, $temp, $f_header2);
2929 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, ["Count", "From", "To"], $f_headertab);
2934 foreach $key (sort keys %relayed) {
2935 my $count = $relayed{$key};
2938 my($one,$two) = split(/=> /, $key);
2939 my @content=($count, $one, $two);
2940 printf $txt_fh ($txt_format, @content) if $txt_fh;
2941 printf $htm_fh ($htm_format, @content) if $htm_fh;
2944 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, \@content);
2949 print $htm_fh "</table>\n<p>\n" if $htm_fh;
2950 print $txt_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $txt_fh;
2951 print $htm_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $htm_fh;
2954 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$shown, "Sum of shown" ]);
2955 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$relayed_unshown, "unshown"]);
2960 print $txt_fh "No relayed messages\n-------------------\n\n" if $txt_fh;
2961 print $htm_fh "No relayed messages\n\n" if $htm_fh;
2971 #######################################################################
2976 # Print our errors. In HTML, we display them as a list rather than a table -
2977 # Netscape doesn't like large tables!
2978 #######################################################################
2980 my $total_errors = 0;
2983 if (scalar(keys %errors_count) != 0) {
2984 my $temp = "List of errors";
2985 my $htm_format = "<li>%d - %s\n";
2987 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2989 print $htm_fh "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
2990 print $htm_fh "<ul><li><b>Count - Error</b>\n";
2994 $ws_errors->write($row++, 0, $temp, $f_header2);
2995 &set_worksheet_line($ws_errors, $row++, 0, ["Count", "Error"], $f_headertab);
3000 foreach $key (sort keys %errors_count) {
3003 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
3004 $total_errors += $errors_count{$key};
3007 printf $txt_fh ("%5d ", $errors_count{$key});
3008 my $text_remaining = $text;
3009 while (length($text_remaining) > 65) {
3010 my($first,$rest) = $text_remaining =~ /(.{50}\S*)\s+(.+)/;
3012 printf $txt_fh ("%s\n\t ", $first);
3013 $text_remaining = $rest;
3015 printf $txt_fh ("%s\n\n", $text_remaining);
3020 #Translate HTML tag characters. Sergey Sholokh.
3021 $text =~ s/\</\<\;/g;
3022 $text =~ s/\>/\>\;/g;
3024 printf $htm_fh ($htm_format,$errors_count{$key},$text);
3028 &set_worksheet_line($ws_errors, $row++, 0, [$errors_count{$key},$text]);
3032 $temp = "Errors encountered: $total_errors";
3035 print $txt_fh $temp, "\n";
3036 print $txt_fh "-" x length($temp),"\n";
3039 print $htm_fh "</ul>\n<p>\n";
3040 print $htm_fh $temp, "\n";
3044 &set_worksheet_line($ws_errors, $row++, 0, [$total_errors, "Sum of Errors encountered"]);
3051 #######################################################################
3052 # parse_old_eximstat_reports();
3054 # parse_old_eximstat_reports($fh);
3056 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
3058 # To test that the merging still works after changes, do something like the following.
3059 # All the diffs should produce no output.
3061 # options='-bydomain -byemail -byhost -byedomain'
3062 # options="$options -show_rt1,2,4 -show_dt 1,2,4"
3063 # options="$options -pattern 'Completed Messages' /Completed/"
3064 # options="$options -pattern 'Received Messages' /<=/"
3066 # ./eximstats $options mainlog > mainlog.txt
3067 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
3068 # diff mainlog.txt mainlog.2.txt
3070 # ./eximstats $options -html mainlog > mainlog.html
3071 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
3072 # diff mainlog.html mainlog.2.html
3074 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
3075 # diff mainlog.txt mainlog.3.txt
3077 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
3078 # diff mainlog.html mainlog.3.html
3080 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
3081 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
3082 # diff mainlog.txt mainlog.4.txt
3084 # # double_mainlog.txt should have twice the values that mainlog.txt has.
3085 # ./eximstats $options mainlog mainlog > double_mainlog.txt
3086 #######################################################################
3087 sub parse_old_eximstat_reports {
3090 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
3092 my(%user_pattern_index);
3093 my $user_pattern_index = 0;
3094 map {$user_pattern_index{$_} = $user_pattern_index++} @user_descriptions;
3095 my $user_pattern_keys = join('|', @user_descriptions);
3098 PARSE_OLD_REPORT_LINE:
3099 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
3100 $begin = $1 if ($1 lt $begin);
3101 $end = $3 if ($3 gt $end);
3103 elsif (/Grand total summary/) {
3104 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Addresses|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
3105 my(@fields, @delivered_fields);
3106 my $doing_table = 0;
3108 $_ = html2txt($_); #Convert general HTML markup to text.
3109 s/At least one addr//g; #Another part of the HTML output we don't want.
3111 # TOTAL Volume Messages Addresses Hosts Domains Delayed Failed
3112 # Received 26MB 237 177 23 8 3.4% 28 11.8%
3113 # Delivered 13MB 233 250 99 88
3114 if (/TOTAL\s+(.*?)\s*$/) {
3116 @delivered_fields = split(/\s+/,$1);
3118 #Delayed and Failed have two columns each, so add the extra field names in.
3119 splice(@delivered_fields,-1,1,'DelayedPercent','Failed','FailedPercent');
3121 # Addresses only figure in the Delivered row, so remove them from the
3123 @fields = grep !/Addresses/, @delivered_fields;
3125 elsif (/(Received)\s+(.*?)\s*$/) {
3126 print STDERR "Parsing $_" if $debug;
3127 add_to_totals($report_totals{$1},\@fields,$2);
3129 elsif (/(Delivered)\s+(.*?)\s*$/) {
3130 print STDERR "Parsing $_" if $debug;
3131 add_to_totals($report_totals{$1},\@delivered_fields,$2);
3133 # If we're merging an old report which doesn't include addresses,
3134 # then use the Messages field instead.
3135 unless (grep(/Addresses/, @delivered_fields)) {
3137 line_to_hash(\%tmp,\@delivered_fields,$data);
3138 add_to_totals($report_totals{Delivered},['Addresses'],$tmp{Messages});
3141 elsif (/(Rejects|Ham|Spam)\s+(.*?)\s*$/) {
3142 print STDERR "Parsing $_" if $debug;
3143 add_to_totals($report_totals{$1},['Messages','Hosts'],$2);
3146 last if $doing_table;
3151 elsif (/User Specified Patterns/i) {
3152 #User Specified Patterns
3153 #-----------------------
3157 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
3159 print STDERR "Parsing $_" if $debug;
3160 $_ = html2txt($_); #Convert general HTML markup to text.
3161 if (/^\s*(.*?)\s+(\d+)\s*$/) {
3162 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
3163 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
3165 last if (/^\s*$/); #Finished if we have a blank line.
3169 elsif (/(^|<h2>)($user_pattern_keys) per /o) {
3170 # Parse User defined pattern histograms if they exist.
3171 parse_histogram($fh, $user_pattern_interval_count[$user_pattern_index{$2}] );
3175 elsif (/Deliveries by transport/i) {
3176 #Deliveries by transport
3177 #-----------------------
3179 # :blackhole: 70KB 51
3180 # address_pipe 655KB 1
3183 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
3185 print STDERR "Parsing $_" if $debug;
3186 $_ = html2txt($_); #Convert general HTML markup to text.
3187 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
3188 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
3189 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
3191 last if (/^\s*$/); #Finished if we have a blank line.
3194 elsif (/Messages received per/) {
3195 parse_histogram($fh, \@received_interval_count);
3197 elsif (/Deliveries per/) {
3198 parse_histogram($fh, \@delivered_interval_count);
3201 #elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
3202 elsif (/(Time spent on the queue|Delivery times|Receipt times): ((\S+) messages|messages with at least one remote delivery)((<[^>]*>)*\s*)$/) {
3203 #Time spent on the queue: all messages
3204 #-------------------------------------
3206 #Under 1m 217 91.9% 91.9%
3212 # Set a pointer to the queue bin so we can use the same code
3213 # block for both all messages and remote deliveries.
3214 #my $bin_aref = ($1 eq 'all messages') ? \@qt_all_bin : \@qt_remote_bin;
3215 my($bin_aref, $times_aref, $overflow_sref);
3216 if ($1 eq 'Time spent on the queue') {
3217 $times_aref = \@queue_times;
3218 if ($2 eq 'all messages') {
3219 $bin_aref = \@qt_all_bin;
3220 $overflow_sref = \$qt_all_overflow;
3223 $bin_aref = \@qt_remote_bin;
3224 $overflow_sref = \$qt_remote_overflow;
3227 elsif ($1 eq 'Delivery times') {
3228 $times_aref = \@delivery_times;
3229 if ($2 eq 'all messages') {
3230 $bin_aref = \@dt_all_bin;
3231 $overflow_sref = \$dt_all_overflow;
3234 $bin_aref = \@dt_remote_bin;
3235 $overflow_sref = \$dt_remote_overflow;
3239 unless (exists $rcpt_times_bin{$3}) {
3240 initialise_rcpt_times($3);
3242 $bin_aref = $rcpt_times_bin{$3};
3243 $times_aref = \@rcpt_times;
3244 $overflow_sref = \$rcpt_times_overflow{$3};
3248 my ($blank_lines, $reached_table) = (0,0);
3250 $_ = html2txt($_); #Convert general HTML markup to text.
3251 # The table is preceded by one blank line, and has one blank line
3252 # following it. As the table may be empty, the best way to determine
3253 # that we've finished it is to look for the second blank line.
3254 ++$blank_lines if /^\s*$/;
3255 last if ($blank_lines >=2); #Finished the table ?
3256 $reached_table = 1 if (/\d/);
3257 next unless $reached_table;
3258 my $previous_seconds_on_queue = 0;
3259 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
3260 print STDERR "Parsing $_" if $debug;
3261 my($modifier,$formated_time,$count) = ($1,$2,$3);
3262 my $seconds = unformat_time($formated_time);
3263 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
3264 $previous_seconds_on_queue = $seconds;
3265 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
3267 for ($i = 0; $i <= $#$times_aref; $i++) {
3268 if ($time_on_queue < $times_aref->[$i]) {
3269 $$bin_aref[$i] += $count;
3273 $$overflow_sref += $count if ($i > $#$times_aref);
3279 elsif (/Relayed messages/) {
3283 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
3284 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
3286 #<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>
3288 my $reached_table = 0;
3291 unless ($reached_table) {
3292 last if (/No relayed messages/);
3293 $reached_table = 1 if (/^\s*\d/ || />\d+</);
3294 next unless $reached_table;
3296 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
3297 update_relayed($1,$2,$3);
3299 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
3300 ($count,$sender) = ($1,$2);
3302 elsif (/=>\s+(.*?)\s*$/) {
3303 update_relayed($count,$sender,$1);
3306 last; #Finished the table ?
3311 elsif (/Top (.*?) by (message count|volume)/) {
3312 #Top 50 sending hosts by message count
3313 #-------------------------------------
3316 # Could also have average values for HTML output.
3317 # 48 1468KB 30KB local
3319 my($category,$by_count_or_volume) = ($1,$2);
3321 #As we show 2 views of each table (by count and by volume),
3322 #most (but not all) entries will appear in both tables.
3323 #Set up a hash to record which entries we have already seen
3324 #and one to record which ones we are seeing for the first time.
3325 if ($by_count_or_volume =~ /count/) {
3326 undef %league_table_value_entered;
3327 undef %league_table_value_was_zero;
3331 #As this section processes multiple different table categories,
3332 #set up pointers to the hashes to be updated.
3333 my($messages_href,$addresses_href,$data_href,$data_gigs_href);
3334 if ($category =~ /local sender/) {
3335 $messages_href = \%received_count_user;
3336 $addresses_href = undef;
3337 $data_href = \%received_data_user;
3338 $data_gigs_href = \%received_data_gigs_user;
3340 elsif ($category =~ /sending (\S+?)s?\b/) {
3341 #Top 50 sending (host|domain|email|edomain)s
3342 #Top sending (host|domain|email|edomain)
3343 $messages_href = \%{$received_count{"\u$1"}};
3344 $data_href = \%{$received_data{"\u$1"}};
3345 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
3347 elsif ($category =~ /local destination/) {
3348 $messages_href = \%delivered_messages_user;
3349 $addresses_href = \%delivered_addresses_user;
3350 $data_href = \%delivered_data_user;
3351 $data_gigs_href = \%delivered_data_gigs_user;
3353 elsif ($category =~ /(\S+) destination/) {
3354 #Top 50 (host|domain|email|edomain) destinations
3355 #Top (host|domain|email|edomain) destination
3356 $messages_href = \%{$delivered_messages{"\u$1"}};
3357 $addresses_href = \%{$delivered_addresses{"\u$1"}};
3358 $data_href = \%{$delivered_data{"\u$1"}};
3359 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
3361 elsif ($category =~ /rejected ips/) {
3362 $messages_href = \%rejected_count_by_ip;
3364 elsif ($category =~ /non-rejected spamming ips/) {
3365 $messages_href = \%spam_count_by_ip;
3367 elsif ($category =~ /mail rejection reasons/) {
3368 $messages_href = \%rejected_count_by_reason;
3371 my $reached_table = 0;
3374 # Watch out for empty tables.
3375 goto PARSE_OLD_REPORT_LINE if (/<h2>/ or (/^\s*[a-zA-Z]/ && !/^\s*Messages/));
3377 $_ = html2txt($_); #Convert general HTML markup to text.
3379 # Messages Addresses Bytes Average
3380 if (/^\s*Messages/) {
3381 my $pattern = '^\s*(\d+)';
3382 $pattern .= (/Addresses/) ? '\s+(\d+)' : '()';
3383 $pattern .= (/Bytes/) ? '\s+([\dKMGB]+)' : '()';
3384 $pattern .= (/Average/) ? '\s+[\dKMGB]+' : '';
3385 $pattern .= '\s+(.*?)\s*$';
3386 $row_re = qr/$pattern/;
3390 next unless $reached_table;
3392 my($messages, $addresses, $rounded_volume, $entry);
3395 ($messages, $addresses, $rounded_volume, $entry) = ($1, $2, $3, $4);
3398 #Else we have finished the table and we may need to do some
3399 #kludging to retain the order of the entries.
3401 if ($by_count_or_volume =~ /volume/) {
3402 #Add a few bytes to appropriate entries to preserve the order.
3403 foreach $rounded_volume (keys %table_order) {
3404 #For each rounded volume, we want to create a list which has things
3405 #ordered from the volume table at the front, and additional things
3406 #from the count table ordered at the back.
3407 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
3408 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
3410 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
3411 @order = @{$table_order{$rounded_volume}{volume}};
3412 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
3414 my $bonus_bytes = $#order;
3415 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
3416 while (@order and ($bonus_bytes > 0)) {
3417 my $entry = shift(@order);
3418 if ($league_table_value_was_zero{$entry}) {
3419 $$data_href{$entry} += $bonus_bytes;
3420 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
3429 # Store a new table entry.
3431 # Add the entry into the %table_order hash if it has a rounded
3432 # volume (KB/MB/GB).
3433 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
3435 unless ($league_table_value_entered{$entry}) {
3436 $league_table_value_entered{$entry} = 1;
3437 unless ($$messages_href{$entry}) {
3438 $$messages_href{$entry} = 0;
3439 $$addresses_href{$entry} = 0;
3440 $$data_href{$entry} = 0;
3441 $$data_gigs_href{$entry} = 0;
3442 $league_table_value_was_zero{$entry} = 1;
3445 $$messages_href{$entry} += $messages;
3447 # When adding the addresses, be aware that we could be merging
3448 # an old report which does not include addresses. In this case,
3449 # we add the messages instead.
3450 $$addresses_href{$entry} += ($addresses) ? $addresses : $messages;
3452 #Add the rounded value to the data and data_gigs hashes.
3453 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry}) if $rounded_volume;
3454 print STDERR "$category by $by_count_or_volume: added $messages,$rounded_volume to $entry\n" if $debug;
3459 elsif (/List of errors/) {
3463 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
3464 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
3465 # host mail.one2one.net [193.133.192.24]: 550 User unknown
3467 #<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>
3470 my $reached_table = 0;
3471 my($count,$error,$blanks);
3473 $reached_table = 1 if (/^( *|<li>)(\d+)/);
3474 next unless $reached_table;
3476 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
3477 $_ = html2txt($_); #Convert general HTML markup to text.
3480 $error .= ' ' . $1; #Join a multiline error.
3482 elsif (/^\s*(\d+)\s+(.*)/) {
3484 #Finished with a previous multiline error so save it.
3485 $errors_count{$error} = 0 unless $errors_count{$error};
3486 $errors_count{$error} += $count;
3488 ($count,$error) = ($1,$2);
3490 elsif (/Errors encountered/) {
3492 #Finished the section, so save our stored last error.
3493 $errors_count{$error} = 0 unless $errors_count{$error};
3494 $errors_count{$error} += $count;
3504 #######################################################################
3505 # parse_histogram($fh, \@delivered_interval_count);
3506 # Parse a histogram into the provided array of counters.
3507 #######################################################################
3508 sub parse_histogram {
3509 my($fh, $counters_aref) = @_;
3511 # Messages received per hour (each dot is 2 messages)
3512 #---------------------------------------------------
3514 #00-01 106 .....................................................
3515 #01-02 103 ...................................................
3517 my $reached_table = 0;
3519 $reached_table = 1 if (/^00/);
3520 next unless $reached_table;
3521 print STDERR "Parsing $_" if $debug;
3522 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
3523 $$counters_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
3525 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
3526 $$counters_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
3528 else { #Finished the table ?
3535 #######################################################################
3538 # update_relayed($count,$sender,$recipient);
3540 # Adds an entry into the %relayed hash. Currently only used when
3542 #######################################################################
3543 sub update_relayed {
3544 my($count,$sender,$recipient) = @_;
3546 #When generating the key, put in the 'H=' and 'A=' which can be used
3548 my $key = "H=$sender => H=$recipient";
3549 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
3550 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
3551 $relayed{$key} = 0 if !defined $relayed{$key};
3552 $relayed{$key} += $count;
3555 $relayed_unshown += $count;
3560 #######################################################################
3563 # add_to_totals(\%totals,\@keys,$values);
3565 # Given a line of space seperated values, add them into the provided hash using @keys
3568 # If the value contains a '%', then the value is set rather than added. Otherwise, we
3569 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
3570 #######################################################################
3572 my($totals_href,$keys_aref,$values) = @_;
3573 my(@values) = split(/\s+/,$values);
3575 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3576 my $key = $keys_aref->[$i];
3577 if ($values[$i] =~ /%/) {
3578 $$totals_href{$key} = $values[$i];
3581 $$totals_href{$key} = 0 unless ($$totals_href{$key});
3582 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
3583 un_round($values[$i], \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
3584 print STDERR "Added $values[$i] to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
3590 #######################################################################
3593 # line_to_hash(\%hash,\@keys,$line);
3595 # Given a line of space seperated values, set them into the provided hash
3596 # using @keys as the hash keys.
3597 #######################################################################
3599 my($href,$keys_aref,$values) = @_;
3600 my(@values) = split(/\s+/,$values);
3601 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3602 $$href{$keys_aref->[$i]} = $values[$i];
3607 #######################################################################
3608 # get_report_total();
3610 # $total = get_report_total(\%hash,$key);
3612 # If %hash contains values split into Units and Gigs, we calculate and return
3614 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
3615 #######################################################################
3616 sub get_report_total {
3618 my($hash_ref,$key) = @_;
3619 if ($$hash_ref{"${key}-gigs"}) {
3620 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
3622 return $$hash_ref{$key} || 0;
3625 #######################################################################
3628 # $text_line = html2txt($html_line);
3630 # Convert a line from html to text. Currently we just convert HTML tags to spaces
3631 # and convert >, <, and tags back.
3632 #######################################################################
3636 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
3637 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
3638 # (the ones used by this program). If someone is careless enough to have their
3639 # Userid the same as an HTML tag, there's not much we can do about it.
3640 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /g;
3642 s/\<\;/\</og; #Convert '<' to '<'.
3643 s/\>\;/\>/og; #Convert '>' to '>'.
3644 s/\ \;/ /og; #Convert ' ' to ' '.
3648 #######################################################################
3651 # $arg = get_next_arg();
3653 # Because eximstats arguments are often passed as variables,
3654 # we can't rely on shell parsing to deal with quotes. This
3655 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
3656 # starts with a quote (' or "), and doesn't end in one, then
3657 # we append the next argument to it and shift again. We repeat
3658 # until we've got all of the argument.
3660 # This isn't perfect as all white space gets reduced to one space,
3661 # but it's as good as we can get! If it's esential that spacing
3662 # be preserved precisely, then you get that by not using shell
3664 #######################################################################
3667 my $matched_pattern = 0;
3669 $arg .= ' ' if $arg;
3670 $arg .= $ARGV[1]; shift(@ARGV);
3671 if ($arg !~ /^['"]/) {
3672 $matched_pattern = 1;
3675 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
3676 $matched_pattern = 1;
3680 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
3684 #######################################################################
3685 # set_worksheet_line($ws_global, $startrow, $startcol, \@content, $format);
3687 # set values to a sequence of cells in a row.
3689 #######################################################################
3690 sub set_worksheet_line {
3691 my ($worksheet, $row, $col, $content, $format) = @_;
3693 foreach my $token (@$content)
3695 $worksheet->write($row, $col++, $token, $format );
3700 #######################################################################
3701 # @rcpt_times = parse_time_list($string);
3703 # Parse a comma seperated list of time values in seconds given by
3704 # the user and fill an array.
3706 # Return a default list if $string is undefined.
3707 # Return () if $string eq '0'.
3708 #######################################################################
3709 sub parse_time_list {
3711 if (! defined $string) {
3712 return(60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60, 12*60*60, 24*60*60);
3714 my(@times) = split(/,/, $string);
3715 foreach my $q (@times) { $q = eval($q) + 0 }
3716 @times = sort { $a <=> $b } @times;
3717 @times = () if ($#times == 0 && $times[0] == 0);
3722 #######################################################################
3723 # initialise_rcpt_times($protocol);
3724 # Initialise an array of rcpt_times to 0 for the specified protocol.
3725 #######################################################################
3726 sub initialise_rcpt_times {
3728 for (my $i = 0; $i <= $#rcpt_times; ++$i) {
3729 $rcpt_times_bin{$protocol}[$i] = 0;
3731 $rcpt_times_overflow{$protocol} = 0;
3735 ##################################################
3737 ##################################################
3740 $last_timestamp = '';
3744 $show_transport = 1;
3746 $local_league_table = 1;
3747 $include_remote_users = 0;
3748 $include_original_destination = 0;
3750 $volume_rounding = 1;
3751 $localtime_offset = calculate_localtime_offset(); # PH/FANF
3754 $charts_option_specified = 0;
3758 @queue_times = parse_time_list();
3760 @delivery_times = ();
3763 $offset_seconds = 0;
3769 my(%output_files); # What output files have been specified?
3773 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-') {
3774 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
3775 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
3776 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/) {
3777 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
3779 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/) { @queue_times = parse_time_list($1) }
3780 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
3781 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
3783 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
3785 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
3786 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
3787 elsif ($ARGV[0] =~ /^-txt=?(\S*)$/) { $txt_fh = get_filehandle($1,\%output_files) }
3788 elsif ($ARGV[0] =~ /^-html=?(\S*)$/) { $htm_fh = get_filehandle($1,\%output_files) }
3789 elsif ($ARGV[0] =~ /^-xls=?(\S*)$/) {
3790 if ($HAVE_Spreadsheet_WriteExcel) {
3791 $xls_fh = get_filehandle($1,\%output_files);
3794 warn "WARNING: CPAN Module Spreadsheet::WriteExcel not installed. Obtain from www.cpan.org\n";
3797 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
3798 elsif ($ARGV[0] =~ /^-charts$/) {
3800 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
3801 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
3803 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
3804 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
3805 elsif ($ARGV[0] =~ /^-include_original_destination$/) { $include_original_destination = 1 }
3806 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
3807 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
3808 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
3809 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
3810 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
3811 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
3812 elsif ($ARGV[0] =~ /^-emptyok$/) { $emptyOK = 1 }
3813 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
3814 elsif ($ARGV[0] =~ /^-show_rt([,\d\+\-\*\/]+)?$/) { @rcpt_times = parse_time_list($1) }
3815 elsif ($ARGV[0] =~ /^-show_dt([,\d\+\-\*\/]+)?$/) { @delivery_times = parse_time_list($1) }
3816 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
3817 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
3818 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
3819 elsif ($ARGV[0] =~ /^-pattern$/)
3821 push(@user_descriptions,get_next_arg());
3822 push(@user_patterns,get_next_arg());
3824 elsif ($ARGV[0] =~ /^-utc$/)
3826 # We don't need this value if the log is in UTC.
3827 $localtime_offset = undef;
3831 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
3837 # keep old default behaviour
3838 if (! ($xls_fh or $htm_fh or $txt_fh)) {
3842 # Check that all the charts options are specified.
3843 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
3845 # Default to display tables by sending Host.
3846 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
3848 # prepare xls Excel Workbook
3849 if (defined $xls_fh) {
3851 # Create a new Excel workbook
3852 $workbook = Spreadsheet::WriteExcel->new($xls_fh);
3855 $ws_global = $workbook->addworksheet('Exim Statistik');
3856 # show $ws_global as initial sheet
3857 $ws_global->set_first_sheet();
3858 $ws_global->activate();
3861 $ws_relayed = $workbook->addworksheet('Relayed Messages');
3862 $ws_relayed->set_column(1, 2, 80);
3865 $ws_errors = $workbook->addworksheet('Errors');
3870 $ws_global->set_column(0, 2, 20); # Columns B-D width set to 30
3871 $ws_global->set_column(3, 3, 15); # Columns B-D width set to 30
3872 $ws_global->set_column(4, 4, 25); # Columns B-D width set to 30
3875 $f_default = $workbook->add_format();
3877 $f_header1 = $workbook->add_format();
3878 $f_header1->set_bold();
3879 #$f_header1->set_color('red');
3880 $f_header1->set_size('15');
3881 $f_header1->set_valign();
3882 # $f_header1->set_align('center');
3883 # $ws_global->write($row++, 2, "Testing Headers 1", $f_header1);
3885 $f_header2 = $workbook->add_format();
3886 $f_header2->set_bold();
3887 $f_header2->set_size('12');
3888 $f_header2->set_valign();
3889 # $ws_global->write($row++, 2, "Testing Headers 2", $f_header2);
3891 # Create another header2 for use in merged cells.
3892 $f_header2_m = $workbook->add_format();
3893 $f_header2_m->set_bold();
3894 $f_header2_m->set_size('8');
3895 $f_header2_m->set_valign();
3896 $f_header2_m->set_align('center');
3898 $f_percent = $workbook->add_format();
3899 $f_percent->set_num_format('0.0%');
3901 $f_headertab = $workbook->add_format();
3902 $f_headertab->set_bold();
3903 $f_headertab->set_valign();
3904 # $ws_global->write($row++, 2, "Testing Headers tab", $f_headertab);
3909 # Initialise the queue/delivery/rcpt time counters.
3910 for (my $i = 0; $i <= $#queue_times; $i++) {
3911 $qt_all_bin[$i] = 0;
3912 $qt_remote_bin[$i] = 0;
3914 for (my $i = 0; $i <= $#delivery_times; $i++) {
3915 $dt_all_bin[$i] = 0;
3916 $dt_remote_bin[$i] = 0;
3918 initialise_rcpt_times('all');
3921 # Compute the number of slots for the histogram
3924 if ($hist_opt > 60 || 60 % $hist_opt != 0)
3926 print STDERR "Eximstats: -h must specify a factor of 60\n";
3929 $hist_interval = 60/$hist_opt; #Interval in minutes.
3930 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
3931 @received_interval_count = (0) x $hist_number;
3932 @delivered_interval_count = (0) x $hist_number;
3933 my $user_pattern_index = 0;
3934 for (my $user_pattern_index = 0; $user_pattern_index <= $#user_patterns; ++$user_pattern_index) {
3935 @{$user_pattern_interval_count[$user_pattern_index]} = (0) x $hist_number;
3937 @dt_all_bin = (0) x $hist_number;
3938 @dt_remote_bin = (0) x $hist_number;
3941 #$queue_unknown = 0;
3943 $total_received_data = 0;
3944 $total_received_data_gigs = 0;
3945 $total_received_count = 0;
3947 $total_delivered_data = 0;
3948 $total_delivered_data_gigs = 0;
3949 $total_delivered_messages = 0;
3950 $total_delivered_addresses = 0;
3952 $qt_all_overflow = 0;
3953 $qt_remote_overflow = 0;
3954 $dt_all_overflow = 0;
3955 $dt_remote_overflow = 0;
3957 $relayed_unshown = 0;
3958 $message_errors = 0;
3959 $begin = "9999-99-99 99:99:99";
3960 $end = "0000-00-00 00:00:00";
3962 foreach $section ('Received','Delivered','Rejects','Ham','Spam') {
3963 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
3964 $report_totals{$section}{$type} = 0;
3968 # Generate our parser.
3969 my $parser = generate_parser();
3974 # Scan the input files and collect the data
3975 foreach my $file (@ARGV) {
3976 if ($file =~ /\.gz/) {
3977 unless (open(FILE,"gunzip -c $file |")) {
3978 print STDERR "Failed to gunzip -c $file: $!";
3982 elsif ($file =~ /\.Z/) {
3983 unless (open(FILE,"uncompress -c $file |")) {
3984 print STDERR "Failed to uncompress -c $file: $!";
3989 unless (open(FILE,$file)) {
3990 print STDERR "Failed to read $file: $!";
3994 #Now parse the filehandle, updating the global variables.
3995 parse($parser,\*FILE);
4000 #No files provided. Parse STDIN, updating the global variables.
4001 parse($parser,\*STDIN);
4005 if ($begin eq "9999-99-99 99:99:99" && ! $emptyOK) {
4006 print STDERR "**** No valid log lines read\n";
4010 # Output our results.
4012 print_grandtotals();
4014 # Print counts of user specified patterns if required.
4015 print_user_patterns() if @user_patterns;
4017 # Print rejection reasons.
4020 # Print totals by transport if required.
4021 print_transport() if $show_transport;
4023 # Print the deliveries per interval as a histogram, unless configured not to.
4024 # First find the maximum in one interval and scale accordingly.
4025 if ($hist_opt > 0) {
4026 print_histogram("Messages received", 'message', @received_interval_count);
4027 print_histogram("Deliveries", 'delivery', @delivered_interval_count);
4030 # Print times on queue if required.
4031 if ($#queue_times >= 0) {
4032 print_duration_table("Time spent on the queue", "all messages", \@queue_times, \@qt_all_bin,$qt_all_overflow);
4033 print_duration_table("Time spent on the queue", "messages with at least one remote delivery", \@queue_times, \@qt_remote_bin,$qt_remote_overflow);
4036 # Print delivery times if required.
4037 if ($#delivery_times >= 0) {
4038 print_duration_table("Delivery times", "all messages", \@delivery_times, \@dt_all_bin,$dt_all_overflow);
4039 print_duration_table("Delivery times", "messages with at least one remote delivery", \@delivery_times, \@dt_remote_bin,$dt_remote_overflow);
4042 # Print rcpt times if required.
4043 if ($#rcpt_times >= 0) {
4044 foreach my $protocol ('all', grep(!/^all$/, sort keys %rcpt_times_bin)) {
4045 print_duration_table("Receipt times", "$protocol messages", \@rcpt_times, $rcpt_times_bin{$protocol}, $rcpt_times_overflow{$protocol});
4049 # Print relay information if required.
4050 print_relay() if $show_relay;
4052 # Print the league tables, if topcount isn't zero.
4053 if ($topcount > 0) {
4054 my($ws_rej, $ws_top50, $ws_rej_row, $ws_top50_row);
4055 $ws_rej_row = $ws_top50_row = 0;
4057 $ws_top50 = $workbook->addworksheet('Deliveries');
4058 $ws_rej = $workbook->addworksheet('Rejections') if (%rejected_count_by_reason || %rejected_count_by_ip || %spam_count_by_ip);
4061 print_league_table("mail rejection reason", \%rejected_count_by_reason, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_reason;
4063 foreach ('Host','Domain','Email','Edomain') {
4064 next unless $do_sender{$_};
4065 print_league_table("sending \l$_", $received_count{$_}, undef, $received_data{$_},$received_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4068 print_league_table("local sender", \%received_count_user, undef,
4069 \%received_data_user,\%received_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %received_count_user);
4070 foreach ('Host','Domain','Email','Edomain') {
4071 next unless $do_sender{$_};
4072 print_league_table("\l$_ destination", $delivered_messages{$_}, $delivered_addresses{$_}, $delivered_data{$_},$delivered_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4074 print_league_table("local destination", \%delivered_messages_user, \%delivered_addresses_user, \%delivered_data_user,\%delivered_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %delivered_messages_user);
4076 print_league_table("rejected ip", \%rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_ip;
4077 print_league_table("non-rejected spamming ip", \%spam_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %spam_count_by_ip;
4081 # Print the error statistics if required.
4082 print_errors() if $show_errors;
4084 print $htm_fh "</body>\n</html>\n" if $htm_fh;
4087 $txt_fh->close if $txt_fh && ref $txt_fh;
4088 $htm_fh->close if $htm_fh;
4091 # close Excel Workbook
4092 $ws_global->set_first_sheet();
4093 # FIXME: whyever - activate does not work :-/
4094 $ws_global->activate();