2 # $Cambridge: exim/src/src/eximstats.src,v 1.14 2007/02/14 12:20:43 steve Exp $
4 # Copyright (c) 2001 University of Cambridge.
5 # See the file NOTICE for conditions of use and distribution.
7 # Perl script to generate statistics from one or more Exim log files.
9 # Usage: eximstats [<options>] <log file> <log file> ...
11 # 1996-05-21: Ignore lines not starting with valid date/time, just in case
12 # these get into a log file.
13 # 1996-11-19: Add the -h option to control the size of the histogram,
14 # and optionally turn it off.
15 # Use some Perl 5 things; it should be everywhere by now.
16 # Add the Perl -w option and rewrite so no warnings are given.
17 # Add the -t option to control the length of the "top" listing.
18 # Add the -ne, -nt options to turn off errors and transport
20 # Add information about length of time on queue, and -q<list> to
21 # control the intervals and turn it off.
22 # Add count and percentage of delayed messages to the Received
24 # Show total number of errors.
25 # Add count and percentage of messages with errors to Received
27 # Add information about relaying and -nr to suppress it.
28 # 1997-02-03 Merged in some of the things Nigel Metheringham had done:
30 # Added received histogram as well as delivered
31 # Added local senders' league table
32 # Added local recipients' league table
33 # 1997-03-10 Fixed typo "destinationss"
34 # Allow for intermediate address between final and original
35 # when testing for relaying
36 # Give better message when no input
37 # 1997-04-24 Fixed bug in layout of error listing that was depending on
38 # text length (output line got repeated).
39 # 1997-05-06 Bug in option decoding when only one option.
40 # Overflow bug when handling very large volumes.
41 # 1997-10-28 Updated to handle revised log format that might show
42 # HELO name as well as host name before IP number
43 # 1998-01-26 Bugs in the function for calculating the number of seconds
44 # since 1970 from a log date
45 # 1998-02-02 Delivery to :blackhole: doesn't have a T= entry in the log
46 # line; cope with this, thereby avoiding undefined problems
47 # Very short log line gave substring error
48 # 1998-02-03 A routed delivery to a local transport may not have <> in the
49 # log line; terminate the address at white space, not <
50 # 1998-09-07 If first line of input was a => line, $thissize was undefined;
52 # 1998-12-21 Adding of $thissize from => line should have been adding $size.
53 # Oops. Should have looked more closely when fixing the previous
55 # 1999-11-12 Increased the field widths for printed integers; numbers are
56 # bigger than originally envisaged.
57 # 2001-03-21 Converted seconds() routine to use Time::Local, fixing a bug
58 # whereby seconds($timestamp) - id_seconds($id) gave an
60 # Added POD documentation.
61 # Moved usage instructions into help() subroutine.
62 # Added 'use strict' and declared all global variables.
63 # Added '-html' flag and resultant code.
64 # Added '-cache' flag and resultant code.
65 # Added add_volume() routine and converted all volume variables
66 # to use it, fixing the overflow problems for individual hosts
68 # Converted all volume output to GB/MB/KB as appropriate.
69 # Don't store local user stats if -nfl is specified.
70 # Modifications done by: Steve Campbell (<steve@computurn.com>)
71 # 2001-04-02 Added the -t_remote_users flag. Steve Campbell.
72 # 2001-10-15 Added the -domain flag. Steve Campbell.
73 # 2001-10-16 Accept files on STDIN or on the command line. Steve Campbell.
74 # 2001-10-21 Removed -domain flag and added -bydomain, -byhost, and -byemail.
75 # We now generate our main parsing subroutine as an eval statement
76 # which improves performance dramatically when not all the results
77 # are required. We also cache the last timestamp to time convertion.
79 # NOTE: 'Top 50 destinations by (message count|volume)' lines are
80 # now 'Top N (host|email|domain) destinations by (message count|volume)'
81 # where N is the topcount. Steve Campbell.
83 # 2001-10-30 V1.16 Joachim Wieland.
84 # Fixed minor bugs in add_volume() when taking over this version
85 # for use in Exim 4: -w gave uninitialized value warnings in
86 # two situations: for the first addition to a counter, and if
87 # there were never any gigabytes, thereby leaving the $gigs
89 # Initialized $last_timestamp to stop a -w uninitialized warning.
90 # Minor layout tweak for grand totals (nitpicking).
91 # Put the IP addresses for relaying stats in [] and separated by
92 # a space from the domain name.
93 # Removed the IPv4-specific address test when picking out addresses
94 # for relaying. Anything inside [] is OK.
96 # 2002-07-02 Philip Hazel
97 # Fixed "uninitialized variable" message that occurred for relay
98 # messages that arrived from H=[1.2.3.4] hosts (no name shown).
99 # This bug didn't affect the output.
101 # 2002-04-15 V1.17 Joachim Wieland.
102 # Added -charts, -chartdir. -chartrel options which use
103 # GD::Graph modules to create graphical charts of the statistics.
105 # 2002-04-15 V1.18 Steve Campbell.
106 # Added a check for $domain to to stop a -w uninitialized warning.
107 # Added -byemaildomain option.
108 # Only print HTML header links to included tables!
110 # 2002-08-02 V1.19 Steve Campbell.
111 # Changed the debug mode to dump the parser onto STDERR rather
112 # than STDOUT. Documented the -d flag into the help().
113 # Rejoined the divergent 2002-04-15 and 2002-07-02 releases.
115 # 2002-08-21 V1.20 Steve Campbell.
116 # Added the '-merge' option to allow merging of previous reports.
117 # Fixed a missing semicolon when doing -bydomain.
118 # Make volume charts plot the data gigs and bytes rather than just bytes.
119 # Only process log lines with $flag =~ /<=|=>|->|==|\*\*|Co/
120 # Converted Emaildomain to Edomain - the column header was too wide!
121 # This changes the text output slightly. You can revert to the old
122 # column widths by changing $COLUMN_WIDTHS to 7;
124 # 2002-09-04 V1.21 Andreas J Mueller
125 # Local deliveries domain now defaults to 'localdomain'.
126 # Don't match F=<From> when looking for the user.
128 # 2002-09-05 V1.22 Steve Campbell
129 # Fixed a perl 5.005 incompatibility problem ('our' variables).
131 # 2002-09-11 V1.23 Steve Campbell
132 # Stopped -charts option from throwing errors on null data.
133 # Don't print out 'Errors encountered' unless there are any.
135 # 2002-10-21 V1.23a Philip Hazel - patch from Tony Finch put in until
136 # Steve's eximstats catches up.
137 # Handle log files that include the timezone after the timestamp.
138 # Switch to assuming that log timestamps are in local time, with
139 # an option for UTC timestamps, as in Exim itself.
141 # 2003-02-05 V1.24 Steve Campbell
142 # Added in Sergey Sholokh's code to convert '<' and '>' characters
143 # in HTML output. Also added code to convert them back with -merge.
144 # Fixed timestamp offsets to convert to seconds rather than minutes.
145 # Updated -merge to work with output files using timezones.
146 # Added cacheing to speed up the calculation of timezone offsets.
148 # 2003-02-07 V1.25 Steve Campbell
149 # Optimised the usage of mktime() in the seconds subroutine.
150 # Removed the now redundant '-cache' option.
151 # html2txt() now explicitly matches HTML tags.
152 # Implemented a new sorting algorithm - the top_n_sort() routine.
153 # Added Danny Carroll's '-nvr' flag and code.
155 # 2003-03-13 V1.26 Steve Campbell
156 # Implemented HTML compliance changes recommended by Bernard Massot.
157 # Bug fix to allow top_n_sort() to handle null keys.
158 # Convert all domains and edomains to lowercase.
159 # Remove preceding dots from domains.
161 # 2003-03-13 V1.27 Steve Campbell
162 # Replaced border attributes with 'border=1', as recommended by
165 # 2003-06-03 V1.28 John Newman
166 # Added in the ability to skip over the parsing and evaulation of
167 # specific transports as passed to eximstats via the new "-nt/.../"
168 # command line argument. This new switch allows the viewing of
169 # not more accurate statistics but more applicable statistics when
170 # special transports are in use (ie; SpamAssassin). We need to be
171 # able to ignore transports such as this otherwise the resulting
172 # local deliveries are significantly skewed (doubled)...
174 # 2003-11-06 V1.29 Steve Campbell
175 # Added the '-pattern "Description" "/pattern/"' option.
177 # 2004-02-17 V1.30 Steve Campbell
178 # Added warnings if required GD::Graph modules are not available or
179 # insufficient -chart* options are specified.
181 # 2004-02-20 V1.31 Andrea Balzi
182 # Only show the Local Sender/Destination links if the tables exist.
184 # 2004-07-05 V1.32 Steve Campbell
185 # Fix '-merge -h0' divide by zero error.
187 # 2004-07-15 V1.33 Steve Campbell
188 # Documentation update - I've converted the subroutine
189 # documentation from POD to comments.
191 # 2004-12-10 V1.34 Steve Campbell
192 # Eximstats can now parse syslog lines as well as mainlog lines.
194 # 2004-12-20 V1.35 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
266 # 2007-02-14 V1.54 Daniel Tiefnig
267 # Improved the '($parent) =' pattern match.
271 # For documentation on the logfile format, see
272 # http://www.exim.org/exim-html-4.50/doc/html/spec_48.html#IX2793
276 eximstats - generates statistics from Exim mainlog or syslog files.
280 eximstats [Output] [Options] mainlog1 mainlog2 ...
281 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
289 Output the results in plain text to STDOUT.
291 =item B<-txt>=I<filename>
293 Output the results in plain text. Filename '-' for STDOUT is accepted.
297 Output the results in HTML to STDOUT.
299 =item B<-html>=I<filename>
301 Output the results in HTML. Filename '-' for STDOUT is accepted.
305 Output the results in Excel compatible Format to STDOUT.
306 Requires the Spreadsheet::WriteExcel CPAN module.
308 =item B<-xls>=I<filename>
310 Output the results in Excel compatible format. Filename '-' for STDOUT is accepted.
321 histogram divisions per hour. The default is 1, and
322 0 suppresses histograms. Valid values are:
324 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
328 Don't display error information.
332 Don't display relaying information.
334 =item B<-nr>I</pattern/>
336 Don't display relaying information that matches.
340 Don't display transport information.
342 =item B<-nt>I</pattern/>
344 Don't display transport information that matches
348 List of times for queuing information single 0 item suppresses.
352 Display top <number> sources/destinations
353 default is 50, 0 suppresses top listing.
357 Omit local sources/destinations in top listing.
359 =item B<-t_remote_users>
361 Include remote users in the top source/destination listings.
363 =item B<-include_original_destination>
365 Include the original destination email addresses rather than just
366 using the final ones.
367 Useful for finding out which of your mailing lists are receiving mail.
369 =item B<-show_dt>I<list>
371 Show the delivery times (B<DT>)for all the messages.
373 Exim must have been configured to use the +delivery_time logging option
374 for this option to work.
376 I<list> is an optional list of times. Eg -show_dt1,2,4,8 will show
377 the number of messages with delivery times under 1 second, 2 seconds, 4 seconds,
378 8 seconds, and over 8 seconds.
380 =item B<-show_rt>I<list>
382 Show the receipt times for all the messages. The receipt time is
383 defined as the Completed hh:mm:ss - queue_time_overall - the Receipt hh:mm:ss.
384 These figures will be skewed by pipelined messages so might not be that useful.
386 Exim must have been configured to use the +queue_time_overall logging option
387 for this option to work.
389 I<list> is an optional list of times. Eg -show_rt1,2,4,8 will show
390 the number of messages with receipt times under 1 second, 2 seconds, 4 seconds,
391 8 seconds, and over 8 seconds.
395 Show results by sending host. This may be combined with
396 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
397 are specified, then B<-byhost> is assumed as a default.
401 Show results by sending domain.
402 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
406 Show results by sender's email address.
407 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
409 =item B<-byemaildomain> or B<-byedomain>
411 Show results by sender's email domain.
412 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
414 =item B<-pattern> I<Description> I</Pattern/>
416 Look for the specified pattern and count the number of lines in which it appears.
417 This option can be specified multiple times. Eg:
419 -pattern 'Refused connections' '/refused connection/'
424 This option allows eximstats to merge old eximstat reports together. Eg:
426 eximstats mainlog.sun > report.sun.txt
427 eximstats mainlog.mon > report.mon.txt
428 eximstats mainlog.tue > report.tue.txt
429 eximstats mainlog.wed > report.web.txt
430 eximstats mainlog.thu > report.thu.txt
431 eximstats mainlog.fri > report.fri.txt
432 eximstats mainlog.sat > report.sat.txt
433 eximstats -merge report.*.txt > weekly_report.txt
434 eximstats -merge -html report.*.txt > weekly_report.html
440 You can merge text or html reports and output the results as text or html.
444 You can use all the normal eximstat output options, but only data
445 included in the original reports can be shown!
449 When merging reports, some loss of accuracy may occur in the top I<n> lists.
450 This will be towards the ends of the lists.
454 The order of items in the top I<n> lists may vary when the data volumes
455 round to the same value.
461 Create graphical charts to be displayed in HTML output.
462 Only valid in combination with I<-html>.
464 This requires the following modules which can be obtained
465 from http://www.cpan.org/modules/01modules.index.html
477 To install these, download and unpack them, then use the normal perl installation procedure:
484 =item B<-chartdir>I <dir>
486 Create the charts in the directory <dir>
488 =item B<-chartrel>I <dir>
490 Specify the relative directory for the "img src=" tags from where to include
495 Specify that it's OK to not find any valid log lines. Without this
496 we will output an error message if we don't find any.
500 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
501 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
508 Eximstats parses exim mainlog and syslog files to output a statistical
509 analysis of the messages processed. By default, a text
510 analysis is generated, but you can request other output formats
511 using flags. See the help (B<-help>) to learn
512 about how to create charts from the tables.
516 There is a web site at http://www.exim.org - this contains details of the
517 mailing list exim-users@exim.org.
521 This program does not perfectly handle messages whose received
522 and delivered log lines are in different files, which can happen
523 when you have multiple mail servers and a message cannot be
524 immeadiately delivered. Fixing this could be tricky...
526 Merging of xls files is not (yet) possible. Be free to implement :)
534 # use Time::Local; # PH/FANF
537 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints $HAVE_Spreadsheet_WriteExcel);
538 eval { require GD::Graph::pie; };
539 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
540 eval { require GD::Graph::linespoints; };
541 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
542 eval { require Spreadsheet::WriteExcel; };
543 $HAVE_Spreadsheet_WriteExcel = $@ ? 0 : 1;
546 ##################################################
548 ##################################################
549 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
550 use vars qw(@tab62 @days_per_month $gig);
551 use vars qw($VERSION);
552 use vars qw($COLUMN_WIDTHS);
553 use vars qw($WEEK $DAY $HOUR $MINUTE);
557 (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, # 0-9
558 0,10,11,12,13,14,15,16,17,18,19,20, # A-K
559 21,22,23,24,25,26,27,28,29,30,31,32, # L-W
560 33,34,35, 0, 0, 0, 0, 0, # X-Z
561 0,36,37,38,39,40,41,42,43,44,45,46, # a-k
562 47,48,49,50,51,52,53,54,55,56,57,58, # l-w
565 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
566 $gig = 1024 * 1024 * 1024;
569 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
573 $HOUR = 60 * $MINUTE;
577 # Declare global variables.
578 use vars qw($total_received_data $total_received_data_gigs $total_received_count);
579 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_messages $total_delivered_addresses);
580 use vars qw(%timestamp2time); #Hash of timestamp => time.
581 use vars qw($last_timestamp $last_time); #The last time convertion done.
582 use vars qw($last_date $date_seconds); #The last date convertion done.
583 use vars qw($last_offset $offset_seconds); #The last time offset convertion done.
584 use vars qw($localtime_offset);
585 use vars qw($i); #General loop counter.
586 use vars qw($debug); #Debug mode?
587 use vars qw($ntopchart); #How many entries should make it into the chart?
588 use vars qw($gddirectory); #Where to put files from GD::Graph
590 # SpamAssassin variables
591 use vars qw($spam_score $spam_score_gigs);
592 use vars qw($ham_score $ham_score_gigs);
593 use vars qw(%ham_count_by_ip %spam_count_by_ip);
594 use vars qw(%rejected_count_by_ip %rejected_count_by_reason);
596 #For use in Speadsheed::WriteExcel
597 use vars qw($workbook $ws_global $ws_relayed $ws_errors);
598 use vars qw($row $col $row_hist $col_hist);
599 use vars qw($run_hist);
600 use vars qw($f_default $f_header1 $f_header2 $f_header2_m $f_headertab $f_percent); #Format Header
603 use vars qw($txt_fh $htm_fh $xls_fh);
607 # The following are parameters whose values are
608 # set by command line switches:
609 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
610 use vars qw($topcount $local_league_table $include_remote_users);
611 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding $emptyOK);
612 use vars qw($relay_pattern @queue_times @user_patterns @user_descriptions);
613 use vars qw(@rcpt_times @delivery_times);
614 use vars qw($include_original_destination);
615 use vars qw($txt_fh $htm_fh $xls_fh);
617 use vars qw(%do_sender); #Do sender by Host, Domain, Email, and/or Edomain tables.
618 use vars qw($charts $chartrel $chartdir $charts_option_specified);
619 use vars qw($merge_reports); #Merge old reports ?
621 # The following are modified in the parse() routine, and
622 # referred to in the print_*() routines.
623 use vars qw($delayed_count $relayed_unshown $begin $end);
624 use vars qw(%messages @message);
625 use vars qw(%received_count %received_data %received_data_gigs);
626 use vars qw(%delivered_messages %delivered_data %delivered_data_gigs %delivered_addresses);
627 use vars qw(%received_count_user %received_data_user %received_data_gigs_user);
628 use vars qw(%delivered_messages_user %delivered_addresses_user %delivered_data_user %delivered_data_gigs_user);
629 use vars qw(%transported_count %transported_data %transported_data_gigs);
630 use vars qw(%relayed %errors_count $message_errors);
631 use vars qw(@qt_all_bin @qt_remote_bin);
632 use vars qw($qt_all_overflow $qt_remote_overflow);
633 use vars qw(@dt_all_bin @dt_remote_bin %rcpt_times_bin);
634 use vars qw($dt_all_overflow $dt_remote_overflow %rcpt_times_overflow);
635 use vars qw(@received_interval_count @delivered_interval_count);
636 use vars qw(@user_pattern_totals @user_pattern_interval_count);
638 use vars qw(%report_totals);
641 use vars qw($SIZE $FROM_HOST $FROM_ADDRESS $ARRIVAL_TIME $REMOTE_DELIVERED $PROTOCOL);
642 use vars qw($DELAYED $HAD_ERROR);
647 $REMOTE_DELIVERED = 4;
654 ##################################################
656 ##################################################
658 #######################################################################
659 # get_filehandle($file,\%output_files);
660 # Return a filehandle writing to $file.
662 # If %output_files is defined, check that $output_files{$file}
663 # doesn't exist and die if it does, or set it if it doesn't.
664 #######################################################################
666 my($file,$output_files_href) = @_;
668 $file = '-' if ($file eq '');
670 if (defined $output_files_href) {
671 die "You can only output to '$file' once! Use -h for help.\n" if exists $output_files_href->{$file};
672 $output_files_href->{$file} = 1;
680 unlink $file or die "Failed to rm $file: $!";
683 my $fh = new IO::File $file, O_WRONLY|O_CREAT|O_EXCL;
684 die "new IO::File $file failed: $!" unless (defined $fh);
689 #######################################################################
692 # $rounded_volume = volume_rounded($bytes,$gigabytes);
694 # Given a data size in bytes, round it to KB, MB, or GB
697 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
699 # Note: I've experimented with Math::BigInt and it results in a 33%
700 # performance degredation as opposed to storing numbers split into
701 # bytes and gigabytes.
702 #######################################################################
714 if ($volume_rounding) {
718 $rounded = sprintf("%6d", $x);
720 elsif ($x < 10000000) {
721 $rounded = sprintf("%4dKB", ($x + 512)/1024);
724 $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
727 # Values between 1GB and 10GB are printed in MB
729 $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
732 # Handle values over 10GB
733 $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
737 # We don't want any rounding to be done.
738 # and we don't need broken formated output which on one hand avoids numbers from
739 # being interpreted as string by Spreadsheed Calculators, on the other hand
740 # breaks if more than 4 digits! -> flexible length instead of fixed length
741 # Format the return value at the output routine! -fh
742 #$rounded = sprintf("%d", ($g * $gig) + $x);
744 $rounded = sprintf("%.0f", ($g * $gig) + $x);
751 #######################################################################
754 # un_round($rounded_volume,\$bytes,\$gigabytes);
756 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
757 # do the reverse transformation and convert it back into Bytes and Gigabytes.
758 # These are added to the $bytes and $gigabytes parameters.
760 # Given a data size in bytes, round it to KB, MB, or GB
763 # EG: 500 => (500,0), 14GB => (0,14), etc.
764 #######################################################################
766 my($rounded,$bytes_sref,$gigabytes_sref) = @_;
768 if ($rounded =~ /(\d+)GB/) {
769 $$gigabytes_sref += $1;
771 elsif ($rounded =~ /(\d+)MB/) {
772 $$gigabytes_sref += $1 / 1024;
773 $$bytes_sref += (($1 % 1024 ) * 1024 * 1024);
775 elsif ($rounded =~ /(\d+)KB/) {
776 $$gigabytes_sref += $1 / (1024 * 1024);
777 $$bytes_sref += ($1 % (1024 * 1024) * 1024);
779 elsif ($rounded =~ /(\d+)/) {
780 # We need to turn off integer in case we are merging an -nvr report.
782 $$gigabytes_sref += int($1 / $gig);
783 $$bytes_sref += $1 % $gig;
786 #Now reduce the bytes down to less than 1GB.
787 add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
791 #######################################################################
794 # add_volume(\$bytes,\$gigs,$size);
796 # Add $size to $bytes/$gigs where this is a number split into
797 # bytes ($bytes) and gigabytes ($gigs). This is significantly
798 # faster than using Math::BigInt.
799 #######################################################################
801 my($bytes_ref,$gigs_ref,$size) = @_;
802 $$bytes_ref = 0 if ! defined $$bytes_ref;
803 $$gigs_ref = 0 if ! defined $$gigs_ref;
804 $$bytes_ref += $size;
805 while ($$bytes_ref > $gig) {
812 #######################################################################
815 # $formatted_time = format_time($seconds);
817 # Given a time in seconds, break it down into
818 # weeks, days, hours, minutes, and seconds.
820 # Eg 12005 => 3h20m5s
821 #######################################################################
833 $p .= "$w"."w" if $w > 0;
834 $p .= "$d"."d" if $d > 0;
835 $p .= "$h"."h" if $h > 0;
836 $p .= "$m"."m" if $m > 0;
837 $p .= "$s"."s" if $s > 0 || $p eq "";
842 #######################################################################
845 # $seconds = unformat_time($formatted_time);
847 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
849 # Eg 3h20m5s => 12005
850 #######################################################################
852 my($formated_time) = pop @_;
855 while ($formated_time =~ s/^(\d+)([wdhms]?)//) {
856 $time += $1 if ($2 eq '' || $2 eq 's');
857 $time += $1 * 60 if ($2 eq 'm');
858 $time += $1 * 60 * 60 if ($2 eq 'h');
859 $time += $1 * 60 * 60 * 24 if ($2 eq 'd');
860 $time += $1 * 60 * 60 * 24 * 7 if ($2 eq 'w');
866 #######################################################################
869 # $time = seconds($timestamp);
871 # Given a time-of-day timestamp, convert it into a time() value using
872 # POSIX::mktime. We expect the timestamp to be of the form
873 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
874 # and the year to be absolute (we do the necessary conversions). The
875 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
876 # offset is not present, and we have not been told that the log is in UTC
877 # (with the -utc option), then we adjust the time by the current local
878 # time offset so that it can be compared with the time recorded in message
881 # To improve performance, we only use mktime on the date ($year-$mon-$day),
882 # and only calculate it if the date is different to the previous time we
883 # came here. We then add on seconds for the '$hour:$min:$sec'.
885 # We also store the results of the last conversion done, and only
886 # recalculate if the date is different.
888 # We used to have the '-cache' flag which would store the results of the
889 # mktime() call. However, the current way of just using mktime() on the
890 # date obsoletes this.
891 #######################################################################
895 # Is the timestamp the same as the last one?
896 return $last_time if ($last_timestamp eq $timestamp);
898 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
900 unless ($last_date eq $1) {
902 my(@timestamp) = (0,0,0,$4,$3,$2);
903 $timestamp[5] -= 1900;
905 $date_seconds = mktime(@timestamp);
907 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
909 # SC. Use cacheing. Also note we want seconds not minutes.
910 #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
911 if (defined $8 && ($8 ne $last_offset)) {
913 $offset_seconds = ($10 * 60 + $11) * 60;
914 $offset_seconds = -$offset_seconds if ($9 eq '-');
919 #$time -= $this_offset;
920 $time -= $offset_seconds;
921 } elsif (defined $localtime_offset) {
922 $time -= $localtime_offset;
925 # Store the last timestamp received.
926 $last_timestamp = $timestamp;
933 #######################################################################
936 # $time = id_seconds($message_id);
938 # Given a message ID, convert it into a time() value.
939 #######################################################################
941 my($sub_id) = substr((pop @_), 0, 6);
943 my(@c) = split(//, $sub_id);
944 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
948 #######################################################################
951 # $seconds = wdhms_seconds($string);
953 # Convert a string in a week/day/hour/minute/second format (eg 4h10s)
955 #######################################################################
957 if ($_[0] =~ /^(?:(\d+)w)?(?:(\d+)d)?(?:(\d+)h)?(?:(\d+)m)?(?:(\d+)s)?/) {
958 return((($1||0) * $WEEK) + (($2||0) * $DAY) + (($3||0) * $HOUR) + (($4||0) * $MINUTE) + ($5||0));
963 #######################################################################
966 # $queued = queue_time($completed_tod, $arrival_time, $id);
968 # Given the completed time of day and either the arrival time
969 # (preferred), or the message ID, calculate how long the message has
972 #######################################################################
974 my($completed_tod, $arrival_time, $id) = @_;
976 # Note: id_seconds() benchmarks as 42% slower than seconds()
977 # and computing the time accounts for a significant portion of
979 if (defined $arrival_time) {
980 return(seconds($completed_tod) - seconds($arrival_time));
983 return(seconds($completed_tod) - id_seconds($id));
988 #######################################################################
989 # calculate_localtime_offset();
991 # $localtime_offset = calculate_localtime_offset();
993 # Calculate the the localtime offset from gmtime in seconds.
995 # $localtime = time() + $localtime_offset.
997 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
998 # (West is negative, East is positive.)
999 #######################################################################
1001 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
1002 # This subroutine commented out as it's not currently in use.
1004 #sub calculate_localtime_offset {
1005 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
1006 # my (@sample_date) = (0,0,0,5,5,100);
1007 # my $localtime = timelocal(@sample_date);
1008 # my $gmtime = timegm(@sample_date);
1009 # my $offset = $localtime - $gmtime;
1013 sub calculate_localtime_offset {
1014 # Assume that the offset at the moment is valid across the whole
1015 # period covered by the logs that we're analysing. This may not
1016 # be true around the time the clocks change in spring or autumn.
1018 # mktime works on local time and gmtime works in UTC
1019 my $local = mktime(gmtime($utc));
1020 return $local - $utc;
1025 #######################################################################
1026 # print_duration_table();
1028 # print_duration_table($title, $message_type, \@times, \@values, $overflow);
1030 # Print a table showing how long a particular step took for
1031 # the messages. The parameters are:
1032 # $title Eg "Time spent on the queue"
1033 # $message_type Eg "Remote"
1034 # \@times The maximum time a message took for it to increment
1035 # the corresponding @values counter.
1036 # \@values An array of message counters.
1037 # $overflow The number of messages which exceeded the maximum
1039 #######################################################################
1040 sub print_duration_table {
1042 my($title, $message_type, $times_aref, $values_aref, $overflow) = @_;
1043 my(@chartdatanames);
1046 my $printed_one = 0;
1047 my $cumulative_percent = 0;
1049 my $queue_total = $overflow;
1050 map {$queue_total += $_} @$values_aref;
1052 my $temp = "$title: $message_type";
1055 my $txt_format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
1056 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";
1059 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
1061 print $htm_fh "<hr><a name=\"$title $message_type\"></a><h2>$temp</h2>\n";
1062 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
1063 print $htm_fh "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
1066 $ws_global->write($row++, $col, "$title: ".$message_type, $f_header2);
1067 my @content=("Time", "Messages", "Percentage", "Cumulative Percentage");
1068 &set_worksheet_line($ws_global, $row++, 1, \@content, $f_headertab);
1072 for ($i = 0; $i <= $#$times_aref; ++$i) {
1073 if ($$values_aref[$i] > 0)
1075 my $percent = ($values_aref->[$i] * 100)/$queue_total;
1076 $cumulative_percent += $percent;
1078 my @content=($printed_one? " " : "Under",
1079 format_time($times_aref->[$i]),
1080 $values_aref->[$i], $percent, $cumulative_percent);
1083 printf $htm_fh ($htm_format, @content);
1084 if (!defined($values_aref->[$i])) {
1085 print $htm_fh "Not defined";
1089 printf $txt_fh ($txt_format, @content);
1090 if (!defined($times_aref->[$i])) {
1091 print $txt_fh "Not defined";
1097 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1098 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1100 if (!defined($times_aref->[$i])) {
1102 $ws_global->write($row++, $col, "Not defined" );
1106 push(@chartdatanames,
1107 ($printed_one? "" : "Under") . format_time($times_aref->[$i]));
1108 push(@chartdatavals, $$values_aref[$i]);
1113 if ($overflow && $overflow > 0) {
1114 my $percent = ($overflow * 100)/$queue_total;
1115 $cumulative_percent += $percent;
1117 my @content = ("Over ", format_time($times_aref->[-1]),
1118 $overflow, $percent, $cumulative_percent);
1120 printf $txt_fh ($txt_format, @content) if $txt_fh;
1121 printf $htm_fh ($htm_format, @content) if $htm_fh;
1124 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1125 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1130 push(@chartdatanames, "Over " . format_time($times_aref->[-1]));
1131 push(@chartdatavals, $overflow);
1133 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
1135 print $htm_fh "</table></td><td>";
1137 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1142 my $graph = GD::Graph::pie->new(200, 200);
1143 my $pngname = "$title-$message_type.png";
1144 $pngname =~ s/[^\w\-\.]/_/;
1146 my $graph_title = "$title ($message_type)";
1147 $graph->set(title => $graph_title) if (length($graph_title) < 21);
1149 my $gd = $graph->plot(\@data) or warn($graph->error);
1151 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1155 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1158 print $htm_fh "</td></tr></table>\n";
1165 print $txt_fh "\n" if $txt_fh;
1166 print $htm_fh "\n" if $htm_fh;
1171 #######################################################################
1172 # print_histogram();
1174 # print_histogram('Deliveries|Messages received|$pattern', $unit, @interval_count);
1176 # Print a histogram of the messages delivered/received per time slot
1177 # (hour by default).
1178 #######################################################################
1179 sub print_histogram {
1180 my($text, $unit, @interval_count) = @_;
1181 my(@chartdatanames);
1185 # save first row of print_histogram for xls output
1193 for ($i = 0; $i < $hist_number; $i++)
1194 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
1196 my $scale = int(($maxd + 25)/50);
1197 $scale = 1 if $scale == 0;
1200 if ($unit !~ s/y$/ies/) {
1205 # make and output title
1206 my $title = sprintf("$text per %s",
1207 ($hist_interval == 60)? "hour" :
1208 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
1210 my $txt_htm_title = $title . " (each dot is $scale $unit)";
1212 printf $txt_fh ("%s\n%s\n\n", $txt_htm_title, "-" x length($txt_htm_title)) if $txt_fh;
1215 print $htm_fh "<hr><a name=\"$text\"></a><h2>$txt_htm_title</h2>\n";
1216 print $htm_fh "<table border=0 width=\"100%\">\n";
1217 print $htm_fh "<tr><td><pre>\n";
1221 $title =~ s/Messages/Msg/ ;
1223 $ws_global->write($row++, $col_hist+1, $title, $f_headertab);
1229 for ($i = 0; $i < $hist_number; $i++) {
1230 my $c = $interval_count[$i];
1232 # If the interval is an hour (the maximum) print the starting and
1233 # ending hours as a label. Otherwise print the starting hour and
1234 # minutes, which take up the same space.
1237 if ($hist_opt == 1) {
1238 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
1240 print $txt_fh $temp if $txt_fh;
1241 print $htm_fh $temp if $htm_fh;
1246 $ws_global->write($row, 0, [$temp], $f_default);
1250 push(@chartdatanames, $temp);
1255 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
1257 { $temp = sprintf(" :%02d", $minutes) }
1259 print $txt_fh $temp if $txt_fh;
1260 print $htm_fh $temp if $htm_fh;
1261 if (($xls_fh) and ($run_hist==0)) {
1263 $temp = sprintf("%02d:%02d", $hour, $minutes);
1264 $ws_global->write($row, 0, [$temp], $f_default);
1267 push(@chartdatanames, $temp);
1268 $minutes += $hist_interval;
1269 if ($minutes >= 60) {
1274 push(@chartdatavals, $c);
1276 printf $txt_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $txt_fh;
1277 printf $htm_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $htm_fh;
1278 $ws_global->write($row++, $col_hist+1, [$c], $f_default) if $xls_fh;
1282 printf $txt_fh "\n" if $txt_fh;
1283 printf $htm_fh "\n" if $htm_fh;
1287 print $htm_fh "</pre>\n";
1288 print $htm_fh "</td><td>\n";
1289 if ($HAVE_GD_Graph_linespoints && $charts && ($#chartdatavals > 0)) {
1290 # calculate the graph
1295 my $graph = GD::Graph::linespoints->new(300, 300);
1298 y_label => 'Amount',
1300 x_labels_vertical => 1
1302 my $pngname = "histogram_$text.png";
1303 $pngname =~ s/[^\w\._]/_/g;
1305 my $gd = $graph->plot(\@data) or warn($graph->error);
1307 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1311 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1314 print $htm_fh "</td></tr></table>\n";
1317 $col_hist++; # where to continue next times
1319 $row+=2; # leave some space after history block
1320 $run_hist=1; # we have done this once or more
1325 #######################################################################
1326 # print_league_table();
1328 # print_league_table($league_table_type,\%message_count,\%address_count,\%message_data,\%message_data_gigs, $spreadsheet, $row_sref);
1330 # Given hashes of message count, address count, and message data,
1331 # which are keyed by the table type (eg by the sending host), print a
1332 # league table showing the top $topcount (defaults to 50).
1333 #######################################################################
1334 sub print_league_table {
1335 my($text,$m_count,$a_count,$m_data,$m_data_gigs,$spreadsheet, $row_sref) = @_;
1336 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
1337 my($title) = "Top $name by message count";
1338 my(@chartdatanames) = ();
1339 my(@chartdatavals) = ();
1340 my $chartotherval = 0;
1341 $text = ucfirst($text);
1343 # Align non-local addresses to the right (so all the .com's line up).
1344 # Local addresses are aligned on the left as they are userids.
1345 my $align = ($text !~ /local/i) ? 'right' : 'left';
1348 ################################################
1349 # Generate the printf formats and table headers.
1350 ################################################
1351 my(@headers) = ('Messages');
1352 push(@headers,'Addresses') if defined $a_count;
1353 push(@headers,'Bytes','Average') if defined $m_data;
1355 my $txt_format = "%10s " x @headers . " %s\n";
1356 my $txt_col_headers = sprintf $txt_format, @headers, $text;
1357 my $htm_format = "<tr>" . '<td align="right">%s</td>'x@headers . "<td align=\"$align\" nowrap>%s</td></tr>\n";
1358 my $htm_col_headers = sprintf $htm_format, @headers, $text;
1359 $htm_col_headers =~ s/(<\/?)td/$1th/g; #Convert <td>'s to <th>'s for the header.
1362 ################################################
1363 # Write the table headers
1364 ################################################
1365 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1368 print $htm_fh <<EoText;
1369 <hr><a name="$text count"></a><h2>$title</h2>
1370 <table border=0 width="100%">
1374 print $htm_col_headers;
1378 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1379 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1384 foreach my $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1386 # When displaying the average figures, we calculate the average of
1387 # the rounded data, as the user would calculate it. This reduces
1388 # the accuracy slightly, but we have to do it this way otherwise
1389 # when using -merge to convert results from text to HTML and
1390 # vice-versa discrepencies would occur.
1391 my $messages = $$m_count{$key};
1392 my @content = ($messages);
1393 push(@content, $$a_count{$key}) if defined $a_count;
1394 if (defined $m_data) {
1395 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1396 my($data,$gigs) = (0,0);
1397 un_round($rounded_volume,\$data,\$gigs);
1398 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1399 push(@content, $rounded_volume, $rounded_average);
1403 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1407 $htmlkey =~ s/>/\>\;/g;
1408 $htmlkey =~ s/</\<\;/g;
1409 printf $htm_fh ($htm_format, @content, $htmlkey);
1411 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1413 if (scalar @chartdatanames < $ntopchart) {
1414 push(@chartdatanames, $key);
1415 push(@chartdatavals, $$m_count{$key});
1418 $chartotherval += $$m_count{$key};
1422 push(@chartdatanames, "Other");
1423 push(@chartdatavals, $chartotherval);
1425 print $txt_fh "\n" if $txt_fh;
1427 print $htm_fh "</table>\n";
1428 print $htm_fh "</td><td>\n";
1429 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0))
1431 # calculate the graph
1436 my $graph = GD::Graph::pie->new(300, 300);
1439 y_label => 'Amount',
1440 title => 'By count',
1442 my $gd = $graph->plot(\@data) or warn($graph->error);
1446 open(IMG, ">$chartdir/${temp}_count.png") or die "Could not write $chartdir/${temp}_count.png: $!\n";
1450 print $htm_fh "<img src=\"$chartrel/${temp}_count.png\">";
1453 print $htm_fh "</td><td>\n";
1454 print $htm_fh "</td></tr></table>\n\n";
1456 ++${$row_sref} if $xls_fh;
1459 if (defined $m_data) {
1462 $title = "Top $name by volume";
1464 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1467 print $htm_fh <<EoText;
1468 <hr><a name="$text volume"></a><h2>$title</h2>
1469 <table border=0 width="100%">
1473 print $htm_col_headers;
1476 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1477 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1480 @chartdatanames = ();
1481 @chartdatavals = ();
1484 foreach my $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1485 # The largest volume will be the first (top of the list).
1486 # If it has at least 1 gig, then just use gigabytes to avoid
1487 # risking an integer overflow when generating the pie charts.
1488 if ($$m_data_gigs{$key}) {
1492 my $messages = $$m_count{$key};
1493 my @content = ($messages);
1494 push(@content, $$a_count{$key}) if defined $a_count;
1495 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1496 my($data ,$gigs) = (0,0);
1497 un_round($rounded_volume,\$data,\$gigs);
1498 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1499 push(@content, $rounded_volume, $rounded_average );
1502 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1505 $htmlkey =~ s/>/\>\;/g;
1506 $htmlkey =~ s/</\<\;/g;
1507 printf $htm_fh ($htm_format, @content, $htmlkey);
1509 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1512 if (scalar @chartdatanames < $ntopchart) {
1514 if ($$m_data_gigs{$key}) {
1515 push(@chartdatanames, $key);
1516 push(@chartdatavals, $$m_data_gigs{$key});
1520 push(@chartdatanames, $key);
1521 push(@chartdatavals, $$m_data{$key});
1525 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1528 push(@chartdatanames, "Other");
1529 push(@chartdatavals, $chartotherval);
1531 print $txt_fh "\n" if $txt_fh;
1533 print $htm_fh "</table>\n";
1534 print $htm_fh "</td><td>\n";
1535 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1536 # calculate the graph
1541 my $graph = GD::Graph::pie->new(300, 300);
1544 y_label => 'Volume' ,
1545 title => 'By Volume',
1547 my $gd = $graph->plot(\@data) or warn($graph->error);
1551 open(IMG, ">$chartdir/${temp}_volume.png") or die "Could not write $chartdir/${temp}_volume.png: $!\n";
1555 print $htm_fh "<img src=\"$chartrel/${temp}_volume.png\">";
1558 print $htm_fh "</td><td>\n";
1559 print $htm_fh "</td></tr></table>\n\n";
1562 ++${$row_sref} if $xls_fh;
1567 #######################################################################
1570 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1572 # Given a hash which has numerical values, return the sorted $n keys which
1573 # point to the top values. The second and third hashes are used as
1574 # tiebreakers. They all must have the same keys.
1576 # The idea behind this routine is that when you only want to see the
1577 # top n members of a set, rather than sorting the entire set and then
1578 # plucking off the top n, sort through the stack as you go, discarding
1579 # any member which is lower than your current n'th highest member.
1581 # This proves to be an order of magnitude faster for large hashes.
1582 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1583 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1585 # We assume the values are > 0.
1586 #######################################################################
1588 my($n,$href1,$href2,$href3) = @_;
1590 # PH's original sort was:
1592 # foreach $key (sort
1594 # $$m_count{$b} <=> $$m_count{$a} ||
1595 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1596 # $$m_data{$b} <=> $$m_data{$a} ||
1602 #We use a key of '_' to represent non-existant values, as null keys are valid.
1603 #'_' is not a valid domain, edomain, host, or email.
1604 my(@top_n_keys) = ('_') x $n;
1605 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1607 my $n_minus_1 = $n - 1;
1608 my $n_minus_2 = $n - 2;
1610 # Create a dummy hash incase the user has not provided us with
1611 # tiebreaker hashes.
1613 $href2 = \%dummy_hash unless defined $href2;
1614 $href3 = \%dummy_hash unless defined $href3;
1616 # Pick out the top $n keys.
1617 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1618 while (($key,$value1) = each %$href1) {
1620 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1622 # Check to see that the new value is bigger than the lowest of the
1623 # top n keys that we're keeping. We test the main key first, because
1624 # for the majority of cases we can skip creating dummy hash values
1625 # should the user have not provided real tie-breaking hashes.
1626 next unless $value1 >= $minimum_value1;
1628 # Create a dummy hash entry for the key if required.
1629 # Note that setting the dummy_hash value sets it for both href2 &
1630 # href3. Also note that currently we are guarenteed to have a real
1631 # value for href3 if a real value for href2 exists so don't need to
1632 # test for it as well.
1633 $dummy_hash{$key} = 0 unless exists $href2->{$key};
1635 $comparison = $value1 <=> $minimum_value1 ||
1636 $href2->{$key} <=> $minimum_value2 ||
1637 $href3->{$key} <=> $minimum_value3 ||
1638 $top_n_key cmp $key;
1639 next unless ($comparison == 1);
1641 # As we will be using these values a few times, extract them into scalars.
1642 $value2 = $href2->{$key};
1643 $value3 = $href3->{$key};
1645 # This key is bigger than the bottom n key, so the lowest position we
1646 # will insert it into is $n minus 1 (the bottom of the list).
1647 $insert_position = $n_minus_1;
1649 # Now go through the list, stopping when we find a key that we're
1650 # bigger than, or we come to the penultimate position - we've
1651 # already tested bigger than the last.
1653 # Note: we go top down as the list starts off empty.
1654 # Note: stepping through the list in this way benchmarks nearly
1655 # three times faster than doing a sort() on the reduced list.
1656 # I assume this is because the list is already in order, and
1657 # we get a performance boost from not having to do hash lookups
1659 for ($i = 0; $i < $n_minus_1; $i++) {
1660 $top_n_key = $top_n_keys[$i];
1661 if ( ($top_n_key eq '_') ||
1662 ( ($value1 <=> $href1->{$top_n_key} ||
1663 $value2 <=> $href2->{$top_n_key} ||
1664 $value3 <=> $href3->{$top_n_key} ||
1665 $top_n_key cmp $key) == 1
1668 $insert_position = $i;
1673 # Remove the last element, then insert the new one.
1674 $#top_n_keys = $n_minus_2;
1675 splice(@top_n_keys,$insert_position,0,$key);
1677 # Extract our new minimum values.
1678 $top_n_key = $top_n_keys[$n_minus_1];
1679 if ($top_n_key ne '_') {
1680 $minimum_value1 = $href1->{$top_n_key};
1681 $minimum_value2 = $href2->{$top_n_key};
1682 $minimum_value3 = $href3->{$top_n_key};
1686 # Return the top n list, grepping out non-existant values, just in case
1687 # we didn't have that many values.
1688 return(grep(!/^_$/,@top_n_keys));
1693 #######################################################################
1696 # $header = html_header($title);
1698 # Print our HTML header and start the <body> block.
1699 #######################################################################
1702 my $text = << "EoText";
1703 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1706 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1707 <title>$title</title>
1709 <body bgcolor="white">
1717 #######################################################################
1722 # Display usage instructions and exit.
1723 #######################################################################
1727 eximstats Version $VERSION
1730 eximstats [Output] [Options] mainlog1 mainlog2 ...
1731 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1734 eximstats -html=eximstats.html mainlog1 mainlog2 ...
1735 eximstats mainlog1 mainlog2 ... > report.txt
1737 Parses exim mainlog or syslog files and generates a statistical analysis
1738 of the messages processed.
1740 Valid output types are:
1741 -txt[=<file>] plain text (default unless no other type is specified)
1744 With no type and file given, defaults to -txt and STDOUT.
1747 -h<number> histogram divisions per hour. The default is 1, and
1748 0 suppresses histograms. Other valid values are:
1749 2, 3, 5, 10, 15, 20, 30 or 60.
1750 -ne don't display error information
1751 -nr don't display relaying information
1752 -nr/pattern/ don't display relaying information that matches
1753 -nt don't display transport information
1754 -nt/pattern/ don't display transport information that matches
1755 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1756 -t<number> display top <number> sources/destinations
1757 default is 50, 0 suppresses top listing
1758 -tnl omit local sources/destinations in top listing
1759 -t_remote_users show top user sources/destinations from non-local domains
1760 -q<list> list of times for queuing information. -q0 suppresses.
1761 -show_rt<list> Show the receipt times for all the messages.
1762 -show_dt<list> Show the delivery times for all the messages.
1763 <list> is an optional list of times in seconds.
1766 -include_original_destination show both the final and original
1767 destinations in the results rather than just the final ones.
1769 -byhost show results by sending host (default unless bydomain or
1770 byemail is specified)
1771 -bydomain show results by sending domain.
1772 -byemail show results by sender's email address
1773 -byedomain show results by sender's email domain
1775 -pattern "Description" /pattern/
1776 Count lines matching specified patterns and show them in
1777 the results. It can be specified multiple times. Eg:
1778 -pattern 'Refused connections' '/refused connection/'
1780 -merge merge previously generated reports into a new report
1782 -charts Create charts (this requires the GD::Graph modules).
1783 Only valid with -html.
1784 -chartdir <dir> Create the charts' png files in the directory <dir>
1785 -chartrel <dir> Specify the relative directory for the "img src=" tags
1786 from where to include the charts in the html file
1787 -chartdir and -chartrel default to '.'
1789 -emptyok It is OK if there is no valid input, don't print an error.
1791 -d Debug mode - dump the eval'ed parser onto STDERR.
1800 #######################################################################
1801 # generate_parser();
1803 # $parser = generate_parser();
1805 # This subroutine generates the parsing routine which will be
1806 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1807 # This improves performance depending on what bits you take out or add.
1809 # I've tested using study(), but this does not improve performance.
1811 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1812 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1813 # the expression evaluates to true, then it is included/excluded accordingly.
1814 #######################################################################
1815 sub generate_parser {
1817 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1818 my($tod,$m_hour,$m_min,$id,$flag,$extra,$length);
1819 my($seconds,$queued,$rcpt_time);
1823 # Convert syslog lines to mainlog format.
1825 next unless s/^.*? exim\\b.*?: //;
1828 $length = length($_);
1829 next if ($length < 38);
1830 next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)( \\[\\d+\\])?/o;
1832 ($tod,$m_hour,$m_min) = ($1,$2,$3);
1834 # PH - watch for GMT offsets in the timestamp.
1837 next if ($length < 44);
1843 # PH - watch for PID added after the timestamp.
1845 $extra += length($5);
1846 next if ($length < 38 + $extra);
1849 $id = substr($_, 20 + $extra, 16);
1850 $flag = substr($_, 37 + $extra, 2);
1852 if ($flag !~ /^([<>=*-]+|SA)$/ && /rejected|refused|dropped/) {
1857 # Rejects can have no MSGID...
1858 if ($flag eq "Re" && $id !~ /^[-0-9a-zA-Z]+$/) {
1859 $id = "reject:" . ++$rej_id;
1864 # Watch for user specified patterns.
1865 my $user_pattern_index = 0;
1866 foreach (@user_patterns) {
1867 $user_pattern_totals[$user_pattern_index] = 0;
1868 $parser .= " if ($_) {\n";
1869 $parser .= " \$user_pattern_totals[$user_pattern_index]++;\n";
1870 $parser .= " \$user_pattern_interval_count[$user_pattern_index][(\$m_hour*60 + \$m_min)/$hist_interval]++;\n" if ($hist_opt > 0);
1872 $user_pattern_index++;
1876 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co|SA|Re/);
1878 #Strip away the timestamp, ID and flag to speed up later pattern matches.
1879 #The flags include Co (Completed), Re (Rejected), and SA (SpamAssassin).
1880 $_ = substr($_, 40 + $extra); # PH
1882 # Alias @message to the array of information about the message.
1883 # This minimises the number of calls to hash functions.
1884 $messages{$id} = [] unless exists $messages{$id};
1885 *message = $messages{$id};
1888 # JN - Skip over certain transports as specified via the "-nt/.../" command
1889 # line switch (where ... is a perl style regular expression). This is
1890 # required so that transports that skew stats such as SpamAssassin can be
1892 #IFDEF ($transport_pattern)
1893 if (/\\sT=(\\S+)/) {
1894 next if ($1 =~ /$transport_pattern/o) ;
1896 #ENDIF ($transport_pattern)
1900 # Do some pattern matches to get the host and IP address.
1901 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1902 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1903 # We do 2 separate matches to keep the matches simple and fast.
1904 # Host is local unless otherwise specified.
1905 $ip = (/\\bH=.*?(\\[[^]]+\\])/) ? $1 : "local";
1906 $host = (/\\bH=(\\S+)/) ? $1 : "local";
1908 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1910 #IFDEF ($do_sender{Domain})
1911 if ($host !~ /^\\[/ && $host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1912 # Remove the host portion from the DNS name. We ensure that we end up
1913 # with at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1914 $domain = lc("$1.$2");
1915 $domain =~ s/^\\.//; #Remove preceding dot.
1917 #ENDIF ($do_sender{Domain})
1919 #IFDEF ($do_sender{Email})
1920 #IFDEF ($include_original_destination)
1921 # Catch both "a@b.com <c@d.com>" and "e@f.com"
1922 #$email = (/^(\S+) (<(\S*?)>)?/) ? $3 || $1 : "";
1923 $email = (/^(\S+ (<[^@>]+@?[^>]*>)?)/) ? $1 : "";
1925 #ENDIF ($include_original_destination)
1927 #IFNDEF ($include_original_destination)
1928 $email = (/^(\S+)/) ? $1 : "";
1929 #ENDIF ($include_original_destination)
1930 #ENDIF ($do_sender{Email})
1932 #IFDEF ($do_sender{Edomain})
1933 #IFDEF ($include_original_destination)
1934 #$edomain = (/^(\S+) (<\S*?\\@(\S+)>)?/) ? $3 || $1 : "";
1935 $edomain = (/^(\S+ (<\S*?\\@(\S+?)>)?)/) ? $1 : "";
1938 #ENDIF ($include_original_destination)
1940 #IFNDEF ($include_original_destination)
1941 $edomain = (/^\S*?\\@(\S+)/) ? lc($1) : "";
1942 #ENDIF ($include_original_destination)
1943 #ENDIF ($do_sender{Edomain})
1945 if ($tod lt $begin) {
1948 elsif ($tod gt $end) {
1953 if ($flag eq "<=") {
1954 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
1955 $message[$SIZE] = $thissize;
1956 $message[$PROTOCOL] = (/ P=(\S+)/) ? $1 : undef;
1958 #IFDEF ($show_relay)
1959 if ($host ne "local") {
1960 # Save incoming information in case it becomes interesting
1961 # later, when delivery lines are read.
1962 my($from) = /^(\\S+)/;
1963 $message[$FROM_HOST] = "$host$ip";
1964 $message[$FROM_ADDRESS] = $from;
1966 #ENDIF ($show_relay)
1968 #IFDEF ($local_league_table || $include_remote_users)
1972 #IFDEF ($local_league_table && $include_remote_users)
1973 { #Store both local and remote users.
1974 #ENDIF ($local_league_table && $include_remote_users)
1976 #IFDEF ($local_league_table && ! $include_remote_users)
1977 if ($host eq "local") { #Store local users only.
1978 #ENDIF ($local_league_table && ! $include_remote_users)
1980 #IFDEF ($include_remote_users && ! $local_league_table)
1981 if ($host ne "local") { #Store remote users only.
1982 #ENDIF ($include_remote_users && ! $local_league_table)
1984 ++$received_count_user{$user};
1985 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
1988 #ENDIF ($local_league_table || $include_remote_users)
1990 #IFDEF ($do_sender{Host})
1991 ++$received_count{Host}{$host};
1992 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
1993 #ENDIF ($do_sender{Host})
1995 #IFDEF ($do_sender{Domain})
1997 ++$received_count{Domain}{$domain};
1998 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
2000 #ENDIF ($do_sender{Domain})
2002 #IFDEF ($do_sender{Email})
2003 ++$received_count{Email}{$email};
2004 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
2005 #ENDIF ($do_sender{Email})
2007 #IFDEF ($do_sender{Edomain})
2008 ++$received_count{Edomain}{$edomain};
2009 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
2010 #ENDIF ($do_sender{Edomain})
2012 ++$total_received_count;
2013 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
2015 #IFDEF ($#queue_times >= 0 || $#rcpt_times >= 0)
2016 $message[$ARRIVAL_TIME] = $tod;
2017 #ENDIF ($#queue_times >= 0 || $#rcpt_times >= 0)
2019 #IFDEF ($hist_opt > 0)
2020 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2021 #ENDIF ($hist_opt > 0)
2024 elsif ($flag eq "=>") {
2025 $size = $message[$SIZE] || 0;
2026 if ($host ne "local") {
2027 $message[$REMOTE_DELIVERED] = 1;
2030 #IFDEF ($show_relay)
2031 # Determine relaying address if either only one address listed,
2032 # or two the same. If they are different, it implies a forwarding
2033 # or aliasing, which is not relaying. Note that for multi-aliased
2034 # addresses, there may be a further address between the first
2037 if (defined $message[$FROM_HOST]) {
2038 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
2039 ($old,$new) = ($1,$2);
2045 if ("\\L$new" eq "\\L$old") {
2046 ($old) = /^(\\S+)/ if $old eq "";
2047 my $key = "H=\\L$message[$FROM_HOST]\\E A=\\L$message[$FROM_ADDRESS]\\E => " .
2048 "H=\\L$host\\E$ip A=\\L$old\\E";
2049 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2050 $relayed{$key} = 0 if !defined $relayed{$key};
2058 #ENDIF ($show_relay)
2062 #IFDEF ($local_league_table || $include_remote_users)
2063 #IFDEF ($local_league_table && $include_remote_users)
2064 { #Store both local and remote users.
2065 #ENDIF ($local_league_table && $include_remote_users)
2067 #IFDEF ($local_league_table && ! $include_remote_users)
2068 if ($host eq "local") { #Store local users only.
2069 #ENDIF ($local_league_table && ! $include_remote_users)
2071 #IFDEF ($include_remote_users && ! $local_league_table)
2072 if ($host ne "local") { #Store remote users only.
2073 #ENDIF ($include_remote_users && ! $local_league_table)
2075 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2076 #IFDEF ($include_original_destination)
2078 #ENDIF ($include_original_destination)
2079 #IFNDEF ($include_original_destination)
2080 if ($user =~ /^[\\/|]/) {
2081 #ENDIF ($include_original_destination)
2082 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2083 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2084 $user = "$user $parent" if defined $parent;
2086 ++$delivered_messages_user{$user};
2087 ++$delivered_addresses_user{$user};
2088 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
2091 #ENDIF ($local_league_table || $include_remote_users)
2093 #IFDEF ($do_sender{Host})
2094 $delivered_messages{Host}{$host}++;
2095 $delivered_addresses{Host}{$host}++;
2096 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
2097 #ENDIF ($do_sender{Host})
2098 #IFDEF ($do_sender{Domain})
2100 ++$delivered_messages{Domain}{$domain};
2101 ++$delivered_addresses{Domain}{$domain};
2102 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
2104 #ENDIF ($do_sender{Domain})
2105 #IFDEF ($do_sender{Email})
2106 ++$delivered_messages{Email}{$email};
2107 ++$delivered_addresses{Email}{$email};
2108 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
2109 #ENDIF ($do_sender{Email})
2110 #IFDEF ($do_sender{Edomain})
2111 ++$delivered_messages{Edomain}{$edomain};
2112 ++$delivered_addresses{Edomain}{$edomain};
2113 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
2114 #ENDIF ($do_sender{Edomain})
2116 ++$total_delivered_messages;
2117 ++$total_delivered_addresses;
2118 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
2120 #IFDEF ($show_transport)
2121 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
2122 ++$transported_count{$transport};
2123 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
2124 #ENDIF ($show_transport)
2126 #IFDEF ($hist_opt > 0)
2127 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2128 #ENDIF ($hist_opt > 0)
2130 #IFDEF ($#delivery_times > 0)
2132 $seconds = wdhms_seconds($1);
2133 for ($i = 0; $i <= $#delivery_times; $i++) {
2134 if ($seconds < $delivery_times[$i]) {
2136 ++$dt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2140 if ($i > $#delivery_times) {
2142 ++$dt_remote_overflow if $message[$REMOTE_DELIVERED];
2145 #ENDIF ($#delivery_times > 0)
2149 elsif ($flag eq "->") {
2151 #IFDEF ($local_league_table || $include_remote_users)
2152 #IFDEF ($local_league_table && $include_remote_users)
2153 { #Store both local and remote users.
2154 #ENDIF ($local_league_table && $include_remote_users)
2156 #IFDEF ($local_league_table && ! $include_remote_users)
2157 if ($host eq "local") { #Store local users only.
2158 #ENDIF ($local_league_table && ! $include_remote_users)
2160 #IFDEF ($include_remote_users && ! $local_league_table)
2161 if ($host ne "local") { #Store remote users only.
2162 #ENDIF ($include_remote_users && ! $local_league_table)
2164 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2165 #IFDEF ($include_original_destination)
2167 #ENDIF ($include_original_destination)
2168 #IFNDEF ($include_original_destination)
2169 if ($user =~ /^[\\/|]/) {
2170 #ENDIF ($include_original_destination)
2171 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2172 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2173 $user = "$user $parent" if defined $parent;
2175 ++$delivered_addresses_user{$user};
2178 #ENDIF ($local_league_table || $include_remote_users)
2180 #IFDEF ($do_sender{Host})
2181 $delivered_addresses{Host}{$host}++;
2182 #ENDIF ($do_sender{Host})
2183 #IFDEF ($do_sender{Domain})
2185 ++$delivered_addresses{Domain}{$domain};
2187 #ENDIF ($do_sender{Domain})
2188 #IFDEF ($do_sender{Email})
2189 ++$delivered_addresses{Email}{$email};
2190 #ENDIF ($do_sender{Email})
2191 #IFDEF ($do_sender{Edomain})
2192 ++$delivered_addresses{Edomain}{$edomain};
2193 #ENDIF ($do_sender{Edomain})
2195 ++$total_delivered_addresses;
2198 elsif ($flag eq "==" && defined($message[$SIZE]) && !defined($message[$DELAYED])) {
2200 $message[$DELAYED] = 1;
2203 elsif ($flag eq "**") {
2204 if (defined ($message[$SIZE])) {
2205 unless (defined $message[$HAD_ERROR]) {
2207 $message[$HAD_ERROR] = 1;
2211 #IFDEF ($show_errors)
2212 ++$errors_count{$_};
2213 #ENDIF ($show_errors)
2217 elsif ($flag eq "Co") {
2219 #IFDEF ($#queue_times >= 0)
2220 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2222 for ($i = 0; $i <= $#queue_times; $i++) {
2223 if ($queued < $queue_times[$i]) {
2225 ++$qt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2229 if ($i > $#queue_times) {
2231 ++$qt_remote_overflow if $message[$REMOTE_DELIVERED];
2233 #ENDIF ($#queue_times >= 0)
2235 #IFDEF ($#rcpt_times >= 0)
2237 $seconds = wdhms_seconds($1);
2238 #Calculate $queued if not previously calculated above.
2239 #IFNDEF ($#queue_times >= 0)
2240 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2241 #ENDIF ($#queue_times >= 0)
2242 $rcpt_time = $seconds - $queued;
2245 if (defined $message[$PROTOCOL]) {
2246 $protocol = $message[$PROTOCOL];
2248 # Create the bin if its not already defined.
2249 unless (exists $rcpt_times_bin{$protocol}) {
2250 initialise_rcpt_times($protocol);
2255 for ($i = 0; $i <= $#rcpt_times; ++$i) {
2256 if ($rcpt_time < $rcpt_times[$i]) {
2257 ++$rcpt_times_bin{all}[$i];
2258 ++$rcpt_times_bin{$protocol}[$i] if defined $protocol;
2263 if ($i > $#rcpt_times) {
2264 ++$rcpt_times_overflow{all};
2265 ++$rcpt_times_overflow{$protocol} if defined $protocol;
2268 #ENDIF ($#rcpt_times >= 0)
2270 delete($messages{$id});
2272 elsif ($flag eq "SA") {
2273 $ip = (/From.*?(\\[[^]]+\\])/ || /\\((local)\\)/) ? $1 : "";
2274 #SpamAssassin message
2275 if (/Action: ((permanently|temporarily) rejected message|flagged as Spam but accepted): score=(\d+\.\d)/) {
2276 #add_volume(\\$spam_score,\\$spam_score_gigs,$3);
2277 ++$spam_count_by_ip{$ip};
2278 } elsif (/Action: scanned but message isn\'t spam: score=(-?\d+\.\d)/) {
2279 #add_volume(\\$ham_score,\\$ham_score_gigs,$1);
2280 ++$ham_count_by_ip{$ip};
2281 } elsif (/(Not running SA because SAEximRunCond expanded to false|check skipped due to message size)/) {
2282 ++$ham_count_by_ip{$ip};
2286 # Look for Reject messages or blackholed messages (deliveries
2287 # without a transport)
2288 if ($flag eq "Re" || ($flag eq "=>" && ! /\\sT=\\S+/)) {
2289 # Correct the IP address for rejects:
2290 # rejected EHLO from my.test.net [10.0.0.5]: syntactically invalid argument(s):
2291 # rejected EHLO from [10.0.0.6]: syntactically invalid argument(s):
2292 $ip = $1 if ($ip eq "local" && /^rejected [HE][HE]LO from .*?(\[.+?\]):/);
2293 ++$rejected_count_by_ip{$ip};
2294 if (/SpamAssassin/) {
2295 ++$rejected_count_by_reason{"Rejected by SpamAssassin"};
2298 /(listed at [^ ]+)/ ||
2299 /(Forged IP detected in HELO)/ ||
2300 /(Invalid domain or IP given in HELO\/EHLO)/ ||
2301 /(unqualified recipient rejected)/ ||
2302 /(closed connection (after|in response) .*?)\s*$/ ||
2303 /(sender rejected)/ ||
2304 # 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.
2305 # 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.
2306 / rejected after DATA: (.*)/ ||
2307 /.DATA ACL discarded recipients.: (.*)/ ||
2308 /rejected after DATA: (unqualified address not permitted)/ ||
2309 /(VRFY rejected)/ ||
2310 # /(sender verify (defer|fail))/i ||
2311 /(too many recipients)/ ||
2312 /(refused relay.*?) to/ ||
2313 /(rejected by non-SMTP ACL: .*)/ ||
2314 /(rejected by local_scan.*)/ ||
2315 # SMTP call from %s dropped: too many syntax or protocol errors (last command was "%s"
2316 # SMTP call from %s dropped: too many nonmail commands
2317 /(dropped: too many ((nonmail|unrecognized) commands|syntax or protocol errors))/ ||
2319 # local_scan() function crashed with signal %d - message temporarily rejected
2320 # local_scan() function timed out - message temporarily rejected
2321 /(local_scan.. function .* - message temporarily rejected)/ ||
2322 /(temporarily refused connection)/ ||
2323 # SMTP protocol synchronization error (input sent without waiting for greeting): rejected connection from %s
2324 /(SMTP protocol .*?(error|violation))/ ||
2327 ++$rejected_count_by_reason{"\u$1"};
2329 elsif (/rejected [HE][HE]LO from [^:]*: syntactically invalid argument/) {
2330 ++$rejected_count_by_reason{"Rejected HELO/EHLO: syntactically invalid argument"};
2332 elsif (/response to "RCPT TO.*? was: (.*)/) {
2333 ++$rejected_count_by_reason{"Response to RCPT TO was: $1"};
2336 /(lookup of host )\S+ (failed)/ ||
2338 # rejected from <%s>%s%s%s%s: message too big:
2339 /(rejected [A-Z]*) .*?(: .*?)(:|\s*$)/ ||
2340 # refused connection from %s (host_reject_connection)
2341 # refused connection from %s (tcp wrappers)
2342 /(refused connection )from.*? (\(.*)/ ||
2344 # 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
2345 # 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.
2346 /(error from remote mailer after .*?:).*(: .*?)(:|\s*$)/ ||
2348 # a.b.c F=<a@b.c> rejected after DATA: "@" or "." expected after "Undisclosed-Recipient": failing address in "To" header is: <Undisclosed-Recipient:;>
2349 /rejected after DATA: ("." or "." expected).*?(: failing address in .*? header)/ ||
2351 # connection from %s refused load average = %.2f
2352 /(Connection )from.*? (refused: load average)/ ||
2353 # connection from %s refused (IP options)
2354 # Connection from %s refused: too many connections
2355 # connection from %s refused
2356 /([Cc]onnection )from.*? (refused.*)/ ||
2357 # [10.0.0.1]: connection refused
2358 /: (Connection refused)()/
2360 ++$rejected_count_by_reason{"\u$1$2"};
2363 ++$rejected_count_by_reason{Unknown};
2364 print STDERR "Unknown rejection: $_" if $debug;
2369 # We now do a 'C preprocessor style operation on our parser
2370 # to remove bits not in use.
2371 my(%defines_in_operation,$removing_lines,$processed_parser);
2372 foreach (split (/\n/,$parser)) {
2373 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
2374 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
2375 $defines_in_operation{$1} = 1;
2376 $removing_lines = 1;
2379 # Convert constants.
2380 while (/(\$[A-Z][A-Z_]*)\b/) {
2381 my $constant = eval $1;
2382 s/(\$[A-Z][A-Z_]*)\b/$constant/;
2385 $processed_parser .= $_."\n" unless $removing_lines;
2387 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
2388 delete $defines_in_operation{$1};
2389 unless (keys %defines_in_operation) {
2390 $removing_lines = 0;
2394 print STDERR "# START OF PARSER:$processed_parser\n# END OF PARSER\n\n" if $debug;
2396 return $processed_parser;
2401 #######################################################################
2404 # parse($parser,\*FILEHANDLE);
2406 # This subroutine accepts a parser and a filehandle from main and parses each
2407 # line. We store the results into global variables.
2408 #######################################################################
2410 my($parser,$fh) = @_;
2412 if ($merge_reports) {
2413 parse_old_eximstat_reports($fh);
2424 #######################################################################
2429 # Print our headers and contents.
2430 #######################################################################
2434 my $title = "Exim statistics from $begin to $end";
2436 print $txt_fh "\n$title\n" if $txt_fh;
2438 print $htm_fh html_header($title);
2439 print $htm_fh "<ul>\n";
2440 print $htm_fh "<li><a href=\"#grandtotal\">Grand total summary</a>\n";
2441 print $htm_fh "<li><a href=\"#patterns\">User Specified Patterns</a>\n" if @user_patterns;
2442 print $htm_fh "<li><a href=\"#transport\">Deliveries by Transport</a>\n" if $show_transport;
2444 print $htm_fh "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
2445 print $htm_fh "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
2448 if ($#queue_times >= 0) {
2449 print $htm_fh "<li><a href=\"#Time spent on the queue all messages\">Time spent on the queue: all messages</a>\n";
2450 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";
2453 if ($#delivery_times >= 0) {
2454 print $htm_fh "<li><a href=\"#Delivery times all messages\">Delivery times: all messages</a>\n";
2455 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";
2458 if ($#rcpt_times >= 0) {
2459 print $htm_fh "<li><a href=\"#Receipt times all messages\">Receipt times</a>\n";
2462 print $htm_fh "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
2464 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;
2465 foreach ('Host','Domain','Email','Edomain') {
2466 next unless $do_sender{$_};
2467 print $htm_fh "<li><a href=\"#sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
2468 print $htm_fh "<li><a href=\"#sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
2470 if (($local_league_table || $include_remote_users) && %received_count_user) {
2471 print $htm_fh "<li><a href=\"#local sender count\">Top $topcount local senders by message count</a>\n";
2472 print $htm_fh "<li><a href=\"#local sender volume\">Top $topcount local senders by volume</a>\n";
2474 foreach ('Host','Domain','Email','Edomain') {
2475 next unless $do_sender{$_};
2476 print $htm_fh "<li><a href=\"#\l$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
2477 print $htm_fh "<li><a href=\"#\l$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
2479 if (($local_league_table || $include_remote_users) && %delivered_messages_user) {
2480 print $htm_fh "<li><a href=\"#local destination count\">Top $topcount local destinations by message count</a>\n";
2481 print $htm_fh "<li><a href=\"#local destination volume\">Top $topcount local destinations by volume</a>\n";
2484 print $htm_fh "<li><a href=\"#rejected ip count\">Top $topcount rejected ips by message count</a>\n" if %rejected_count_by_ip;
2485 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;
2488 print $htm_fh "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
2489 print $htm_fh "</ul>\n<hr>\n";
2493 $ws_global->write($row++, $col+0, "Exim Statistics", $f_header1);
2494 &set_worksheet_line($ws_global, $row, $col, ["from:", $begin, "to:", $end], $f_default);
2500 #######################################################################
2501 # print_grandtotals();
2503 # print_grandtotals();
2505 # Print the grand totals.
2506 #######################################################################
2507 sub print_grandtotals {
2509 # Get the sender by headings and results. This is complicated as we can have
2510 # different numbers of columns.
2511 my($sender_txt_header,$sender_txt_format,$sender_html_format);
2512 my(@received_totals,@delivered_totals);
2513 my($row_tablehead, $row_max);
2514 my(@col_headers) = ('TOTAL', 'Volume', 'Messages', 'Addresses');
2516 foreach ('Host','Domain','Email','Edomain') {
2517 next unless $do_sender{$_};
2518 if ($merge_reports) {
2519 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
2520 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
2523 push(@received_totals,scalar(keys %{$received_data{$_}}));
2524 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
2526 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
2527 $sender_html_format .= "<td align=\"right\">%d</td>";
2528 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6d";
2529 push(@col_headers,"${_}s");
2532 my $txt_format1 = " %-16s %9s %6d %6s $sender_txt_format";
2533 my $txt_format2 = " %6d %4.1f%% %6d %4.1f%%",
2534 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";
2535 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>";
2538 my $sender_spaces = " " x length($sender_txt_header);
2540 print $txt_fh "Grand total summary\n";
2541 print $txt_fh "-------------------\n";
2542 print $txt_fh " $sender_spaces At least one address\n";
2543 print $txt_fh " TOTAL Volume Messages Addresses $sender_txt_header Delayed Failed\n";
2546 print $htm_fh "<a name=\"grandtotal\"></a>\n";
2547 print $htm_fh "<h2>Grand total summary</h2>\n";
2548 print $htm_fh "<table border=1>\n";
2549 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";
2552 $ws_global->write($row++, 0, "Grand total summary", $f_header2);
2553 $ws_global->write($row, 0, \@col_headers, $f_header2);
2554 $ws_global->merge_range($row, scalar(@col_headers), $row, scalar(@col_headers)+1, "At least one addr Delayed", $f_header2_m);
2555 $ws_global->merge_range($row, scalar(@col_headers)+2, $row, scalar(@col_headers)+3, "At least one addr Failed", $f_header2_m);
2556 #$ws_global->write(++$row, scalar(@col_headers), ['Total','Percent','Total','Percent'], $f_header2);
2560 my($volume,$failed_count);
2561 if ($merge_reports) {
2562 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
2563 $total_received_count = get_report_total($report_totals{Received},'Messages');
2564 $failed_count = get_report_total($report_totals{Received},'Failed');
2565 $delayed_count = get_report_total($report_totals{Received},'Delayed');
2568 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
2569 $failed_count = $message_errors;
2576 $volume,$total_received_count,'',
2579 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
2581 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0
2584 printf $txt_fh ("$txt_format1$txt_format2\n", 'Received', @content) if $txt_fh;
2585 printf $htm_fh ("$htm_format1$htm_format2\n", 'Received', @content) if $htm_fh;
2587 $ws_global->write(++$row, 0, 'Received', $f_default);
2588 for (my $i=0; $i < scalar(@content); $i++) {
2589 if ($i == 4 || $i == 6) {
2590 $ws_global->write($row, $i+1, $content[$i]/100, $f_percent);
2593 $ws_global->write($row, $i+1, $content[$i], $f_default);
2599 if ($merge_reports) {
2600 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
2601 $total_delivered_messages = get_report_total($report_totals{Delivered},'Messages');
2602 $total_delivered_addresses = get_report_total($report_totals{Delivered},'Addresses');
2605 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
2608 my @content=($volume, $total_delivered_messages, $total_delivered_addresses, @delivered_totals);
2609 printf $txt_fh ("$txt_format1\n", 'Delivered', @content) if $txt_fh;
2610 printf $htm_fh ("$htm_format1\n", 'Delivered', @content) if $htm_fh;
2613 $ws_global->write(++$row, 0, 'Delivered', $f_default);
2614 for (my $i=0; $i < scalar(@content); $i++) {
2615 $ws_global->write($row, $i+1, $content[$i], $f_default);
2619 if ($merge_reports) {
2620 foreach ('Rejects', 'Ham', 'Spam') {
2621 my $messages = get_report_total($report_totals{$_},'Messages');
2622 my $addresses = get_report_total($report_totals{$_},'Addresses');
2624 @content = ($_, '', $messages, '');
2625 push(@content,get_report_total($report_totals{$_},'Hosts')) if $do_sender{Host};
2626 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2627 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2628 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2633 foreach my $total_aref (['Rejects',\%rejected_count_by_ip],
2634 ['Ham',\%ham_count_by_ip],
2635 ['Spam',\%spam_count_by_ip]) {
2637 map {$messages += $_} values %{$total_aref->[1]};
2639 if ($messages > 0) {
2640 @content = ($total_aref->[0], '', $messages, '');
2641 push(@content,scalar(keys %{$total_aref->[1]})) if $do_sender{Host};
2643 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2644 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2645 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2650 printf $txt_fh "\n" if $txt_fh;
2651 printf $htm_fh "</table>\n" if $htm_fh;
2656 #######################################################################
2657 # print_user_patterns()
2659 # print_user_patterns();
2661 # Print the counts of user specified patterns.
2662 #######################################################################
2663 sub print_user_patterns {
2664 my $txt_format1 = " %-18s %6d";
2665 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2668 print $txt_fh "User Specified Patterns\n";
2669 print $txt_fh "-----------------------";
2670 print $txt_fh "\n Total\n";
2673 print $htm_fh "<hr><a name=\"patterns\"></a><h2>User Specified Patterns</h2>\n";
2674 print $htm_fh "<table border=0 width=\"100%\">\n";
2675 print $htm_fh "<tr><td>\n";
2676 print $htm_fh "<table border=1>\n";
2677 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2680 $ws_global->write($row++, $col, "User Specified Patterns", $f_header2);
2681 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2686 if ($merge_reports) {
2687 # We are getting our data from previous reports.
2688 foreach $key (@user_descriptions) {
2689 my $count = get_report_total($report_totals{patterns}{$key},'Total');
2690 printf $txt_fh ("$txt_format1\n",$key,$count) if $txt_fh;
2691 printf $htm_fh ("$htm_format1\n",$key,$count) if $htm_fh;
2694 &set_worksheet_line($ws_global, $row++, 0, [$key,$count], $f_default);
2699 # We are getting our data from mainlog files.
2700 my $user_pattern_index = 0;
2701 foreach $key (@user_descriptions) {
2702 printf $txt_fh ("$txt_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $txt_fh;
2703 printf $htm_fh ("$htm_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $htm_fh;
2704 $ws_global->write($row++, 0, [$key,$user_pattern_totals[$user_pattern_index]]) if $xls_fh;
2705 $user_pattern_index++;
2708 print $txt_fh "\n" if $txt_fh;
2709 print $htm_fh "</table>\n\n" if $htm_fh;
2715 if ($hist_opt > 0) {
2716 my $user_pattern_index = 0;
2717 foreach $key (@user_descriptions) {
2718 print_histogram($key, 'occurence', @{$user_pattern_interval_count[$user_pattern_index]});
2719 $user_pattern_index++;
2724 #######################################################################
2729 # Print statistics about rejected mail.
2730 #######################################################################
2732 my($format1,$reason);
2734 my $txt_format1 = " %-40s %6d";
2735 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2738 print $txt_fh "Rejected mail by reason\n";
2739 print $txt_fh "-----------------------";
2740 print $txt_fh "\n Total\n";
2743 print $htm_fh "<hr><a name=\"patterns\"></a><h2>Rejected mail by reason</h2>\n";
2744 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2745 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2748 $ws_global->write($row++, $col, "Rejected mail by reason", $f_header2);
2749 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2753 my $href = ($merge_reports) ? $report_totals{rejected_mail_by_reason} : \%rejected_count_by_reason;
2754 my(@chartdatanames, @chartdatavals_count);
2756 foreach $reason (top_n_sort($topcount, $href, undef, undef)) {
2757 printf $txt_fh ("$txt_format1\n",$reason,$href->{$reason}) if $txt_fh;
2758 printf $htm_fh ("$htm_format1\n",$reason,$href->{$reason}) if $htm_fh;
2759 set_worksheet_line($ws_global, $row++, 0, [$reason,$href->{$reason}], $f_default) if $xls_fh;
2760 push(@chartdatanames, $reason);
2761 push(@chartdatavals_count, $href->{$reason});
2765 print $txt_fh "\n" if $txt_fh;
2768 print $htm_fh "</tr></table></td><td>";
2769 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0)) {
2770 # calculate the graph
2773 \@chartdatavals_count
2775 my $graph = GD::Graph::pie->new(200, 200);
2777 x_label => 'Rejection Reasons',
2778 y_label => 'Messages',
2779 title => 'By count',
2781 my $gd = $graph->plot(\@data) or warn($graph->error);
2783 open(IMG, ">$chartdir/rejections_count.png") or die "Could not write $chartdir/rejections_count.png: $!\n";
2787 print $htm_fh "<img src=\"$chartrel/rejections_count.png\">";
2790 print $htm_fh "</td></tr></table>\n\n";
2798 #######################################################################
2799 # print_transport();
2801 # print_transport();
2803 # Print totals by transport.
2804 #######################################################################
2805 sub print_transport {
2806 my(@chartdatanames);
2807 my(@chartdatavals_count);
2808 my(@chartdatavals_vol);
2809 no integer; #Lose this for charting the data.
2811 my $txt_format1 = " %-18s %6s %6d";
2812 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
2815 print $txt_fh "Deliveries by transport\n";
2816 print $txt_fh "-----------------------";
2817 print $txt_fh "\n Volume Messages\n";
2820 print $htm_fh "<hr><a name=\"transport\"></a><h2>Deliveries by Transport</h2>\n";
2821 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2822 print $htm_fh "<tr><th> </th><th>Volume</th><th>Messages</th>\n";
2825 $ws_global->write(++$row, $col, "Deliveries by transport", $f_header2);
2826 $ws_global->write(++$row, 1, ["Volume", "Messages"], $f_headertab);
2830 if ($merge_reports) {
2831 # We are getting our data from previous reports.
2832 foreach $key (sort keys %{$report_totals{transport}}) {
2833 my $count = get_report_total($report_totals{transport}{$key},'Messages');
2834 my @content=($key, volume_rounded($report_totals{transport}{$key}{Volume},
2835 $report_totals{transport}{$key}{'Volume-gigs'}), $count);
2836 push(@chartdatanames, $key);
2837 push(@chartdatavals_count, $count);
2838 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
2839 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2840 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2841 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2845 # We are getting our data from mainlog files.
2846 foreach $key (sort keys %transported_data) {
2847 my @content=($key, volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
2848 $transported_count{$key});
2849 push(@chartdatanames, $key);
2850 push(@chartdatavals_count, $transported_count{$key});
2851 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
2852 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2853 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2854 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2857 print $txt_fh "\n" if $txt_fh;
2859 print $htm_fh "</tr></table></td><td>";
2861 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0))
2863 # calculate the graph
2866 \@chartdatavals_count
2868 my $graph = GD::Graph::pie->new(200, 200);
2870 x_label => 'Transport',
2871 y_label => 'Messages',
2872 title => 'By count',
2874 my $gd = $graph->plot(\@data) or warn($graph->error);
2876 open(IMG, ">$chartdir/transports_count.png") or die "Could not write $chartdir/transports_count.png: $!\n";
2880 print $htm_fh "<img src=\"$chartrel/transports_count.png\">";
2883 print $htm_fh "</td><td>";
2885 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_vol > 0)) {
2890 my $graph = GD::Graph::pie->new(200, 200);
2892 title => 'By volume',
2894 my $gd = $graph->plot(\@data) or warn($graph->error);
2896 open(IMG, ">$chartdir/transports_vol.png") or die "Could not write $chartdir/transports_vol.png: $!\n";
2900 print $htm_fh "<img src=\"$chartrel/transports_vol.png\">";
2904 print $htm_fh "</td></tr></table>\n\n";
2910 #######################################################################
2915 # Print our totals by relay.
2916 #######################################################################
2918 my $row_print_relay=1;
2919 my $temp = "Relayed messages";
2920 print $htm_fh "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $htm_fh;
2921 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
2924 my $txt_format = "%7d %s\n => %s\n";
2925 my $htm_format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
2927 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2929 print $htm_fh "<table border=1>\n";
2930 print $htm_fh "<tr><th>Count</th><th>From</th><th>To</th>\n";
2933 $ws_relayed->write($row_print_relay++, $col, $temp, $f_header2);
2934 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, ["Count", "From", "To"], $f_headertab);
2939 foreach $key (sort keys %relayed) {
2940 my $count = $relayed{$key};
2943 my($one,$two) = split(/=> /, $key);
2944 my @content=($count, $one, $two);
2945 printf $txt_fh ($txt_format, @content) if $txt_fh;
2946 printf $htm_fh ($htm_format, @content) if $htm_fh;
2949 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, \@content);
2954 print $htm_fh "</table>\n<p>\n" if $htm_fh;
2955 print $txt_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $txt_fh;
2956 print $htm_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $htm_fh;
2959 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$shown, "Sum of shown" ]);
2960 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$relayed_unshown, "unshown"]);
2965 print $txt_fh "No relayed messages\n-------------------\n\n" if $txt_fh;
2966 print $htm_fh "No relayed messages\n\n" if $htm_fh;
2976 #######################################################################
2981 # Print our errors. In HTML, we display them as a list rather than a table -
2982 # Netscape doesn't like large tables!
2983 #######################################################################
2985 my $total_errors = 0;
2988 if (scalar(keys %errors_count) != 0) {
2989 my $temp = "List of errors";
2990 my $htm_format = "<li>%d - %s\n";
2992 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2994 print $htm_fh "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
2995 print $htm_fh "<ul><li><b>Count - Error</b>\n";
2999 $ws_errors->write($row++, 0, $temp, $f_header2);
3000 &set_worksheet_line($ws_errors, $row++, 0, ["Count", "Error"], $f_headertab);
3005 foreach $key (sort keys %errors_count) {
3008 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
3009 $total_errors += $errors_count{$key};
3012 printf $txt_fh ("%5d ", $errors_count{$key});
3013 my $text_remaining = $text;
3014 while (length($text_remaining) > 65) {
3015 my($first,$rest) = $text_remaining =~ /(.{50}\S*)\s+(.+)/;
3017 printf $txt_fh ("%s\n\t ", $first);
3018 $text_remaining = $rest;
3020 printf $txt_fh ("%s\n\n", $text_remaining);
3025 #Translate HTML tag characters. Sergey Sholokh.
3026 $text =~ s/\</\<\;/g;
3027 $text =~ s/\>/\>\;/g;
3029 printf $htm_fh ($htm_format,$errors_count{$key},$text);
3033 &set_worksheet_line($ws_errors, $row++, 0, [$errors_count{$key},$text]);
3037 $temp = "Errors encountered: $total_errors";
3040 print $txt_fh $temp, "\n";
3041 print $txt_fh "-" x length($temp),"\n";
3044 print $htm_fh "</ul>\n<p>\n";
3045 print $htm_fh $temp, "\n";
3049 &set_worksheet_line($ws_errors, $row++, 0, [$total_errors, "Sum of Errors encountered"]);
3056 #######################################################################
3057 # parse_old_eximstat_reports();
3059 # parse_old_eximstat_reports($fh);
3061 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
3063 # To test that the merging still works after changes, do something like the following.
3064 # All the diffs should produce no output.
3066 # options='-bydomain -byemail -byhost -byedomain'
3067 # options="$options -show_rt1,2,4 -show_dt 1,2,4"
3068 # options="$options -pattern 'Completed Messages' /Completed/"
3069 # options="$options -pattern 'Received Messages' /<=/"
3071 # ./eximstats $options mainlog > mainlog.txt
3072 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
3073 # diff mainlog.txt mainlog.2.txt
3075 # ./eximstats $options -html mainlog > mainlog.html
3076 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
3077 # diff mainlog.html mainlog.2.html
3079 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
3080 # diff mainlog.txt mainlog.3.txt
3082 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
3083 # diff mainlog.html mainlog.3.html
3085 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
3086 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
3087 # diff mainlog.txt mainlog.4.txt
3089 # # double_mainlog.txt should have twice the values that mainlog.txt has.
3090 # ./eximstats $options mainlog mainlog > double_mainlog.txt
3091 #######################################################################
3092 sub parse_old_eximstat_reports {
3095 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
3097 my(%user_pattern_index);
3098 my $user_pattern_index = 0;
3099 map {$user_pattern_index{$_} = $user_pattern_index++} @user_descriptions;
3100 my $user_pattern_keys = join('|', @user_descriptions);
3103 PARSE_OLD_REPORT_LINE:
3104 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
3105 $begin = $1 if ($1 lt $begin);
3106 $end = $3 if ($3 gt $end);
3108 elsif (/Grand total summary/) {
3109 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Addresses|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
3110 my(@fields, @delivered_fields);
3111 my $doing_table = 0;
3113 $_ = html2txt($_); #Convert general HTML markup to text.
3114 s/At least one addr//g; #Another part of the HTML output we don't want.
3116 # TOTAL Volume Messages Addresses Hosts Domains Delayed Failed
3117 # Received 26MB 237 177 23 8 3.4% 28 11.8%
3118 # Delivered 13MB 233 250 99 88
3119 if (/TOTAL\s+(.*?)\s*$/) {
3121 @delivered_fields = split(/\s+/,$1);
3123 #Delayed and Failed have two columns each, so add the extra field names in.
3124 splice(@delivered_fields,-1,1,'DelayedPercent','Failed','FailedPercent');
3126 # Addresses only figure in the Delivered row, so remove them from the
3128 @fields = grep !/Addresses/, @delivered_fields;
3130 elsif (/(Received)\s+(.*?)\s*$/) {
3131 print STDERR "Parsing $_" if $debug;
3132 add_to_totals($report_totals{$1},\@fields,$2);
3134 elsif (/(Delivered)\s+(.*?)\s*$/) {
3135 print STDERR "Parsing $_" if $debug;
3136 add_to_totals($report_totals{$1},\@delivered_fields,$2);
3138 # If we're merging an old report which doesn't include addresses,
3139 # then use the Messages field instead.
3140 unless (grep(/Addresses/, @delivered_fields)) {
3142 line_to_hash(\%tmp,\@delivered_fields,$data);
3143 add_to_totals($report_totals{Delivered},['Addresses'],$tmp{Messages});
3146 elsif (/(Rejects|Ham|Spam)\s+(.*?)\s*$/) {
3147 print STDERR "Parsing $_" if $debug;
3148 add_to_totals($report_totals{$1},['Messages','Hosts'],$2);
3151 last if $doing_table;
3156 elsif (/User Specified Patterns/i) {
3157 #User Specified Patterns
3158 #-----------------------
3162 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
3164 print STDERR "Parsing $_" if $debug;
3165 $_ = html2txt($_); #Convert general HTML markup to text.
3166 if (/^\s*(.*?)\s+(\d+)\s*$/) {
3167 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
3168 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
3170 last if (/^\s*$/); #Finished if we have a blank line.
3174 elsif (/(^|<h2>)($user_pattern_keys) per /o) {
3175 # Parse User defined pattern histograms if they exist.
3176 parse_histogram($fh, $user_pattern_interval_count[$user_pattern_index{$2}] );
3180 elsif (/Deliveries by transport/i) {
3181 #Deliveries by transport
3182 #-----------------------
3184 # :blackhole: 70KB 51
3185 # address_pipe 655KB 1
3188 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
3190 print STDERR "Parsing $_" if $debug;
3191 $_ = html2txt($_); #Convert general HTML markup to text.
3192 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
3193 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
3194 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
3196 last if (/^\s*$/); #Finished if we have a blank line.
3199 elsif (/Messages received per/) {
3200 parse_histogram($fh, \@received_interval_count);
3202 elsif (/Deliveries per/) {
3203 parse_histogram($fh, \@delivered_interval_count);
3206 #elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
3207 elsif (/(Time spent on the queue|Delivery times|Receipt times): ((\S+) messages|messages with at least one remote delivery)((<[^>]*>)*\s*)$/) {
3208 #Time spent on the queue: all messages
3209 #-------------------------------------
3211 #Under 1m 217 91.9% 91.9%
3217 # Set a pointer to the queue bin so we can use the same code
3218 # block for both all messages and remote deliveries.
3219 #my $bin_aref = ($1 eq 'all messages') ? \@qt_all_bin : \@qt_remote_bin;
3220 my($bin_aref, $times_aref, $overflow_sref);
3221 if ($1 eq 'Time spent on the queue') {
3222 $times_aref = \@queue_times;
3223 if ($2 eq 'all messages') {
3224 $bin_aref = \@qt_all_bin;
3225 $overflow_sref = \$qt_all_overflow;
3228 $bin_aref = \@qt_remote_bin;
3229 $overflow_sref = \$qt_remote_overflow;
3232 elsif ($1 eq 'Delivery times') {
3233 $times_aref = \@delivery_times;
3234 if ($2 eq 'all messages') {
3235 $bin_aref = \@dt_all_bin;
3236 $overflow_sref = \$dt_all_overflow;
3239 $bin_aref = \@dt_remote_bin;
3240 $overflow_sref = \$dt_remote_overflow;
3244 unless (exists $rcpt_times_bin{$3}) {
3245 initialise_rcpt_times($3);
3247 $bin_aref = $rcpt_times_bin{$3};
3248 $times_aref = \@rcpt_times;
3249 $overflow_sref = \$rcpt_times_overflow{$3};
3253 my ($blank_lines, $reached_table) = (0,0);
3255 $_ = html2txt($_); #Convert general HTML markup to text.
3256 # The table is preceded by one blank line, and has one blank line
3257 # following it. As the table may be empty, the best way to determine
3258 # that we've finished it is to look for the second blank line.
3259 ++$blank_lines if /^\s*$/;
3260 last if ($blank_lines >=2); #Finished the table ?
3261 $reached_table = 1 if (/\d/);
3262 next unless $reached_table;
3263 my $previous_seconds_on_queue = 0;
3264 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
3265 print STDERR "Parsing $_" if $debug;
3266 my($modifier,$formated_time,$count) = ($1,$2,$3);
3267 my $seconds = unformat_time($formated_time);
3268 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
3269 $previous_seconds_on_queue = $seconds;
3270 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
3272 for ($i = 0; $i <= $#$times_aref; $i++) {
3273 if ($time_on_queue < $times_aref->[$i]) {
3274 $$bin_aref[$i] += $count;
3278 $$overflow_sref += $count if ($i > $#$times_aref);
3284 elsif (/Relayed messages/) {
3288 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
3289 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
3291 #<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>
3293 my $reached_table = 0;
3296 unless ($reached_table) {
3297 last if (/No relayed messages/);
3298 $reached_table = 1 if (/^\s*\d/ || />\d+</);
3299 next unless $reached_table;
3301 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
3302 update_relayed($1,$2,$3);
3304 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
3305 ($count,$sender) = ($1,$2);
3307 elsif (/=>\s+(.*?)\s*$/) {
3308 update_relayed($count,$sender,$1);
3311 last; #Finished the table ?
3316 elsif (/Top (.*?) by (message count|volume)/) {
3317 #Top 50 sending hosts by message count
3318 #-------------------------------------
3321 # Could also have average values for HTML output.
3322 # 48 1468KB 30KB local
3324 my($category,$by_count_or_volume) = ($1,$2);
3326 #As we show 2 views of each table (by count and by volume),
3327 #most (but not all) entries will appear in both tables.
3328 #Set up a hash to record which entries we have already seen
3329 #and one to record which ones we are seeing for the first time.
3330 if ($by_count_or_volume =~ /count/) {
3331 undef %league_table_value_entered;
3332 undef %league_table_value_was_zero;
3336 #As this section processes multiple different table categories,
3337 #set up pointers to the hashes to be updated.
3338 my($messages_href,$addresses_href,$data_href,$data_gigs_href);
3339 if ($category =~ /local sender/) {
3340 $messages_href = \%received_count_user;
3341 $addresses_href = undef;
3342 $data_href = \%received_data_user;
3343 $data_gigs_href = \%received_data_gigs_user;
3345 elsif ($category =~ /sending (\S+?)s?\b/) {
3346 #Top 50 sending (host|domain|email|edomain)s
3347 #Top sending (host|domain|email|edomain)
3348 $messages_href = \%{$received_count{"\u$1"}};
3349 $data_href = \%{$received_data{"\u$1"}};
3350 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
3352 elsif ($category =~ /local destination/) {
3353 $messages_href = \%delivered_messages_user;
3354 $addresses_href = \%delivered_addresses_user;
3355 $data_href = \%delivered_data_user;
3356 $data_gigs_href = \%delivered_data_gigs_user;
3358 elsif ($category =~ /(\S+) destination/) {
3359 #Top 50 (host|domain|email|edomain) destinations
3360 #Top (host|domain|email|edomain) destination
3361 $messages_href = \%{$delivered_messages{"\u$1"}};
3362 $addresses_href = \%{$delivered_addresses{"\u$1"}};
3363 $data_href = \%{$delivered_data{"\u$1"}};
3364 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
3366 elsif ($category =~ /rejected ips/) {
3367 $messages_href = \%rejected_count_by_ip;
3369 elsif ($category =~ /non-rejected spamming ips/) {
3370 $messages_href = \%spam_count_by_ip;
3372 elsif ($category =~ /mail rejection reasons/) {
3373 $messages_href = \%rejected_count_by_reason;
3376 my $reached_table = 0;
3379 # Watch out for empty tables.
3380 goto PARSE_OLD_REPORT_LINE if (/<h2>/ or (/^\s*[a-zA-Z]/ && !/^\s*Messages/));
3382 $_ = html2txt($_); #Convert general HTML markup to text.
3384 # Messages Addresses Bytes Average
3385 if (/^\s*Messages/) {
3386 my $pattern = '^\s*(\d+)';
3387 $pattern .= (/Addresses/) ? '\s+(\d+)' : '()';
3388 $pattern .= (/Bytes/) ? '\s+([\dKMGB]+)' : '()';
3389 $pattern .= (/Average/) ? '\s+[\dKMGB]+' : '';
3390 $pattern .= '\s+(.*?)\s*$';
3391 $row_re = qr/$pattern/;
3395 next unless $reached_table;
3397 my($messages, $addresses, $rounded_volume, $entry);
3400 ($messages, $addresses, $rounded_volume, $entry) = ($1, $2, $3, $4);
3403 #Else we have finished the table and we may need to do some
3404 #kludging to retain the order of the entries.
3406 if ($by_count_or_volume =~ /volume/) {
3407 #Add a few bytes to appropriate entries to preserve the order.
3408 foreach $rounded_volume (keys %table_order) {
3409 #For each rounded volume, we want to create a list which has things
3410 #ordered from the volume table at the front, and additional things
3411 #from the count table ordered at the back.
3412 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
3413 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
3415 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
3416 @order = @{$table_order{$rounded_volume}{volume}};
3417 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
3419 my $bonus_bytes = $#order;
3420 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
3421 while (@order and ($bonus_bytes > 0)) {
3422 my $entry = shift(@order);
3423 if ($league_table_value_was_zero{$entry}) {
3424 $$data_href{$entry} += $bonus_bytes;
3425 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
3434 # Store a new table entry.
3436 # Add the entry into the %table_order hash if it has a rounded
3437 # volume (KB/MB/GB).
3438 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
3440 unless ($league_table_value_entered{$entry}) {
3441 $league_table_value_entered{$entry} = 1;
3442 unless ($$messages_href{$entry}) {
3443 $$messages_href{$entry} = 0;
3444 $$addresses_href{$entry} = 0;
3445 $$data_href{$entry} = 0;
3446 $$data_gigs_href{$entry} = 0;
3447 $league_table_value_was_zero{$entry} = 1;
3450 $$messages_href{$entry} += $messages;
3452 # When adding the addresses, be aware that we could be merging
3453 # an old report which does not include addresses. In this case,
3454 # we add the messages instead.
3455 $$addresses_href{$entry} += ($addresses) ? $addresses : $messages;
3457 #Add the rounded value to the data and data_gigs hashes.
3458 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry}) if $rounded_volume;
3459 print STDERR "$category by $by_count_or_volume: added $messages,$rounded_volume to $entry\n" if $debug;
3464 elsif (/List of errors/) {
3468 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
3469 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
3470 # host mail.one2one.net [193.133.192.24]: 550 User unknown
3472 #<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>
3475 my $reached_table = 0;
3476 my($count,$error,$blanks);
3478 $reached_table = 1 if (/^( *|<li>)(\d+)/);
3479 next unless $reached_table;
3481 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
3482 $_ = html2txt($_); #Convert general HTML markup to text.
3485 $error .= ' ' . $1; #Join a multiline error.
3487 elsif (/^\s*(\d+)\s+(.*)/) {
3489 #Finished with a previous multiline error so save it.
3490 $errors_count{$error} = 0 unless $errors_count{$error};
3491 $errors_count{$error} += $count;
3493 ($count,$error) = ($1,$2);
3495 elsif (/Errors encountered/) {
3497 #Finished the section, so save our stored last error.
3498 $errors_count{$error} = 0 unless $errors_count{$error};
3499 $errors_count{$error} += $count;
3509 #######################################################################
3510 # parse_histogram($fh, \@delivered_interval_count);
3511 # Parse a histogram into the provided array of counters.
3512 #######################################################################
3513 sub parse_histogram {
3514 my($fh, $counters_aref) = @_;
3516 # Messages received per hour (each dot is 2 messages)
3517 #---------------------------------------------------
3519 #00-01 106 .....................................................
3520 #01-02 103 ...................................................
3522 my $reached_table = 0;
3524 $reached_table = 1 if (/^00/);
3525 next unless $reached_table;
3526 print STDERR "Parsing $_" if $debug;
3527 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
3528 $$counters_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
3530 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
3531 $$counters_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
3533 else { #Finished the table ?
3540 #######################################################################
3543 # update_relayed($count,$sender,$recipient);
3545 # Adds an entry into the %relayed hash. Currently only used when
3547 #######################################################################
3548 sub update_relayed {
3549 my($count,$sender,$recipient) = @_;
3551 #When generating the key, put in the 'H=' and 'A=' which can be used
3553 my $key = "H=$sender => H=$recipient";
3554 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
3555 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
3556 $relayed{$key} = 0 if !defined $relayed{$key};
3557 $relayed{$key} += $count;
3560 $relayed_unshown += $count;
3565 #######################################################################
3568 # add_to_totals(\%totals,\@keys,$values);
3570 # Given a line of space seperated values, add them into the provided hash using @keys
3573 # If the value contains a '%', then the value is set rather than added. Otherwise, we
3574 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
3575 #######################################################################
3577 my($totals_href,$keys_aref,$values) = @_;
3578 my(@values) = split(/\s+/,$values);
3580 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3581 my $key = $keys_aref->[$i];
3582 if ($values[$i] =~ /%/) {
3583 $$totals_href{$key} = $values[$i];
3586 $$totals_href{$key} = 0 unless ($$totals_href{$key});
3587 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
3588 un_round($values[$i], \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
3589 print STDERR "Added $values[$i] to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
3595 #######################################################################
3598 # line_to_hash(\%hash,\@keys,$line);
3600 # Given a line of space seperated values, set them into the provided hash
3601 # using @keys as the hash keys.
3602 #######################################################################
3604 my($href,$keys_aref,$values) = @_;
3605 my(@values) = split(/\s+/,$values);
3606 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3607 $$href{$keys_aref->[$i]} = $values[$i];
3612 #######################################################################
3613 # get_report_total();
3615 # $total = get_report_total(\%hash,$key);
3617 # If %hash contains values split into Units and Gigs, we calculate and return
3619 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
3620 #######################################################################
3621 sub get_report_total {
3623 my($hash_ref,$key) = @_;
3624 if ($$hash_ref{"${key}-gigs"}) {
3625 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
3627 return $$hash_ref{$key} || 0;
3630 #######################################################################
3633 # $text_line = html2txt($html_line);
3635 # Convert a line from html to text. Currently we just convert HTML tags to spaces
3636 # and convert >, <, and tags back.
3637 #######################################################################
3641 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
3642 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
3643 # (the ones used by this program). If someone is careless enough to have their
3644 # Userid the same as an HTML tag, there's not much we can do about it.
3645 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /g;
3647 s/\<\;/\</og; #Convert '<' to '<'.
3648 s/\>\;/\>/og; #Convert '>' to '>'.
3649 s/\ \;/ /og; #Convert ' ' to ' '.
3653 #######################################################################
3656 # $arg = get_next_arg();
3658 # Because eximstats arguments are often passed as variables,
3659 # we can't rely on shell parsing to deal with quotes. This
3660 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
3661 # starts with a quote (' or "), and doesn't end in one, then
3662 # we append the next argument to it and shift again. We repeat
3663 # until we've got all of the argument.
3665 # This isn't perfect as all white space gets reduced to one space,
3666 # but it's as good as we can get! If it's esential that spacing
3667 # be preserved precisely, then you get that by not using shell
3669 #######################################################################
3672 my $matched_pattern = 0;
3674 $arg .= ' ' if $arg;
3675 $arg .= $ARGV[1]; shift(@ARGV);
3676 if ($arg !~ /^['"]/) {
3677 $matched_pattern = 1;
3680 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
3681 $matched_pattern = 1;
3685 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
3689 #######################################################################
3690 # set_worksheet_line($ws_global, $startrow, $startcol, \@content, $format);
3692 # set values to a sequence of cells in a row.
3694 #######################################################################
3695 sub set_worksheet_line {
3696 my ($worksheet, $row, $col, $content, $format) = @_;
3698 foreach my $token (@$content)
3700 $worksheet->write($row, $col++, $token, $format );
3705 #######################################################################
3706 # @rcpt_times = parse_time_list($string);
3708 # Parse a comma seperated list of time values in seconds given by
3709 # the user and fill an array.
3711 # Return a default list if $string is undefined.
3712 # Return () if $string eq '0'.
3713 #######################################################################
3714 sub parse_time_list {
3716 if (! defined $string) {
3717 return(60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60, 12*60*60, 24*60*60);
3719 my(@times) = split(/,/, $string);
3720 foreach my $q (@times) { $q = eval($q) + 0 }
3721 @times = sort { $a <=> $b } @times;
3722 @times = () if ($#times == 0 && $times[0] == 0);
3727 #######################################################################
3728 # initialise_rcpt_times($protocol);
3729 # Initialise an array of rcpt_times to 0 for the specified protocol.
3730 #######################################################################
3731 sub initialise_rcpt_times {
3733 for (my $i = 0; $i <= $#rcpt_times; ++$i) {
3734 $rcpt_times_bin{$protocol}[$i] = 0;
3736 $rcpt_times_overflow{$protocol} = 0;
3740 ##################################################
3742 ##################################################
3745 $last_timestamp = '';
3749 $show_transport = 1;
3751 $local_league_table = 1;
3752 $include_remote_users = 0;
3753 $include_original_destination = 0;
3755 $volume_rounding = 1;
3756 $localtime_offset = calculate_localtime_offset(); # PH/FANF
3759 $charts_option_specified = 0;
3763 @queue_times = parse_time_list();
3765 @delivery_times = ();
3768 $offset_seconds = 0;
3774 my(%output_files); # What output files have been specified?
3778 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-') {
3779 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
3780 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
3781 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/) {
3782 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
3784 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/) { @queue_times = parse_time_list($1) }
3785 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
3786 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
3788 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
3790 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
3791 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
3792 elsif ($ARGV[0] =~ /^-txt=?(\S*)$/) { $txt_fh = get_filehandle($1,\%output_files) }
3793 elsif ($ARGV[0] =~ /^-html=?(\S*)$/) { $htm_fh = get_filehandle($1,\%output_files) }
3794 elsif ($ARGV[0] =~ /^-xls=?(\S*)$/) {
3795 if ($HAVE_Spreadsheet_WriteExcel) {
3796 $xls_fh = get_filehandle($1,\%output_files);
3799 warn "WARNING: CPAN Module Spreadsheet::WriteExcel not installed. Obtain from www.cpan.org\n";
3802 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
3803 elsif ($ARGV[0] =~ /^-charts$/) {
3805 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
3806 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
3808 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
3809 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
3810 elsif ($ARGV[0] =~ /^-include_original_destination$/) { $include_original_destination = 1 }
3811 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
3812 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
3813 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
3814 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
3815 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
3816 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
3817 elsif ($ARGV[0] =~ /^-emptyok$/) { $emptyOK = 1 }
3818 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
3819 elsif ($ARGV[0] =~ /^-show_rt([,\d\+\-\*\/]+)?$/) { @rcpt_times = parse_time_list($1) }
3820 elsif ($ARGV[0] =~ /^-show_dt([,\d\+\-\*\/]+)?$/) { @delivery_times = parse_time_list($1) }
3821 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
3822 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
3823 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
3824 elsif ($ARGV[0] =~ /^-pattern$/)
3826 push(@user_descriptions,get_next_arg());
3827 push(@user_patterns,get_next_arg());
3829 elsif ($ARGV[0] =~ /^-utc$/)
3831 # We don't need this value if the log is in UTC.
3832 $localtime_offset = undef;
3836 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
3842 # keep old default behaviour
3843 if (! ($xls_fh or $htm_fh or $txt_fh)) {
3847 # Check that all the charts options are specified.
3848 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
3850 # Default to display tables by sending Host.
3851 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
3853 # prepare xls Excel Workbook
3854 if (defined $xls_fh) {
3856 # Create a new Excel workbook
3857 $workbook = Spreadsheet::WriteExcel->new($xls_fh);
3860 $ws_global = $workbook->addworksheet('Exim Statistik');
3861 # show $ws_global as initial sheet
3862 $ws_global->set_first_sheet();
3863 $ws_global->activate();
3866 $ws_relayed = $workbook->addworksheet('Relayed Messages');
3867 $ws_relayed->set_column(1, 2, 80);
3870 $ws_errors = $workbook->addworksheet('Errors');
3875 $ws_global->set_column(0, 2, 20); # Columns B-D width set to 30
3876 $ws_global->set_column(3, 3, 15); # Columns B-D width set to 30
3877 $ws_global->set_column(4, 4, 25); # Columns B-D width set to 30
3880 $f_default = $workbook->add_format();
3882 $f_header1 = $workbook->add_format();
3883 $f_header1->set_bold();
3884 #$f_header1->set_color('red');
3885 $f_header1->set_size('15');
3886 $f_header1->set_valign();
3887 # $f_header1->set_align('center');
3888 # $ws_global->write($row++, 2, "Testing Headers 1", $f_header1);
3890 $f_header2 = $workbook->add_format();
3891 $f_header2->set_bold();
3892 $f_header2->set_size('12');
3893 $f_header2->set_valign();
3894 # $ws_global->write($row++, 2, "Testing Headers 2", $f_header2);
3896 # Create another header2 for use in merged cells.
3897 $f_header2_m = $workbook->add_format();
3898 $f_header2_m->set_bold();
3899 $f_header2_m->set_size('8');
3900 $f_header2_m->set_valign();
3901 $f_header2_m->set_align('center');
3903 $f_percent = $workbook->add_format();
3904 $f_percent->set_num_format('0.0%');
3906 $f_headertab = $workbook->add_format();
3907 $f_headertab->set_bold();
3908 $f_headertab->set_valign();
3909 # $ws_global->write($row++, 2, "Testing Headers tab", $f_headertab);
3914 # Initialise the queue/delivery/rcpt time counters.
3915 for (my $i = 0; $i <= $#queue_times; $i++) {
3916 $qt_all_bin[$i] = 0;
3917 $qt_remote_bin[$i] = 0;
3919 for (my $i = 0; $i <= $#delivery_times; $i++) {
3920 $dt_all_bin[$i] = 0;
3921 $dt_remote_bin[$i] = 0;
3923 initialise_rcpt_times('all');
3926 # Compute the number of slots for the histogram
3929 if ($hist_opt > 60 || 60 % $hist_opt != 0)
3931 print STDERR "Eximstats: -h must specify a factor of 60\n";
3934 $hist_interval = 60/$hist_opt; #Interval in minutes.
3935 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
3936 @received_interval_count = (0) x $hist_number;
3937 @delivered_interval_count = (0) x $hist_number;
3938 my $user_pattern_index = 0;
3939 for (my $user_pattern_index = 0; $user_pattern_index <= $#user_patterns; ++$user_pattern_index) {
3940 @{$user_pattern_interval_count[$user_pattern_index]} = (0) x $hist_number;
3942 @dt_all_bin = (0) x $hist_number;
3943 @dt_remote_bin = (0) x $hist_number;
3946 #$queue_unknown = 0;
3948 $total_received_data = 0;
3949 $total_received_data_gigs = 0;
3950 $total_received_count = 0;
3952 $total_delivered_data = 0;
3953 $total_delivered_data_gigs = 0;
3954 $total_delivered_messages = 0;
3955 $total_delivered_addresses = 0;
3957 $qt_all_overflow = 0;
3958 $qt_remote_overflow = 0;
3959 $dt_all_overflow = 0;
3960 $dt_remote_overflow = 0;
3962 $relayed_unshown = 0;
3963 $message_errors = 0;
3964 $begin = "9999-99-99 99:99:99";
3965 $end = "0000-00-00 00:00:00";
3967 foreach $section ('Received','Delivered','Rejects','Ham','Spam') {
3968 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
3969 $report_totals{$section}{$type} = 0;
3973 # Generate our parser.
3974 my $parser = generate_parser();
3979 # Scan the input files and collect the data
3980 foreach my $file (@ARGV) {
3981 if ($file =~ /\.gz/) {
3982 unless (open(FILE,"gunzip -c $file |")) {
3983 print STDERR "Failed to gunzip -c $file: $!";
3987 elsif ($file =~ /\.Z/) {
3988 unless (open(FILE,"uncompress -c $file |")) {
3989 print STDERR "Failed to uncompress -c $file: $!";
3994 unless (open(FILE,$file)) {
3995 print STDERR "Failed to read $file: $!";
3999 #Now parse the filehandle, updating the global variables.
4000 parse($parser,\*FILE);
4005 #No files provided. Parse STDIN, updating the global variables.
4006 parse($parser,\*STDIN);
4010 if ($begin eq "9999-99-99 99:99:99" && ! $emptyOK) {
4011 print STDERR "**** No valid log lines read\n";
4015 # Output our results.
4017 print_grandtotals();
4019 # Print counts of user specified patterns if required.
4020 print_user_patterns() if @user_patterns;
4022 # Print rejection reasons.
4025 # Print totals by transport if required.
4026 print_transport() if $show_transport;
4028 # Print the deliveries per interval as a histogram, unless configured not to.
4029 # First find the maximum in one interval and scale accordingly.
4030 if ($hist_opt > 0) {
4031 print_histogram("Messages received", 'message', @received_interval_count);
4032 print_histogram("Deliveries", 'delivery', @delivered_interval_count);
4035 # Print times on queue if required.
4036 if ($#queue_times >= 0) {
4037 print_duration_table("Time spent on the queue", "all messages", \@queue_times, \@qt_all_bin,$qt_all_overflow);
4038 print_duration_table("Time spent on the queue", "messages with at least one remote delivery", \@queue_times, \@qt_remote_bin,$qt_remote_overflow);
4041 # Print delivery times if required.
4042 if ($#delivery_times >= 0) {
4043 print_duration_table("Delivery times", "all messages", \@delivery_times, \@dt_all_bin,$dt_all_overflow);
4044 print_duration_table("Delivery times", "messages with at least one remote delivery", \@delivery_times, \@dt_remote_bin,$dt_remote_overflow);
4047 # Print rcpt times if required.
4048 if ($#rcpt_times >= 0) {
4049 foreach my $protocol ('all', grep(!/^all$/, sort keys %rcpt_times_bin)) {
4050 print_duration_table("Receipt times", "$protocol messages", \@rcpt_times, $rcpt_times_bin{$protocol}, $rcpt_times_overflow{$protocol});
4054 # Print relay information if required.
4055 print_relay() if $show_relay;
4057 # Print the league tables, if topcount isn't zero.
4058 if ($topcount > 0) {
4059 my($ws_rej, $ws_top50, $ws_rej_row, $ws_top50_row);
4060 $ws_rej_row = $ws_top50_row = 0;
4062 $ws_top50 = $workbook->addworksheet('Deliveries');
4063 $ws_rej = $workbook->addworksheet('Rejections') if (%rejected_count_by_reason || %rejected_count_by_ip || %spam_count_by_ip);
4066 print_league_table("mail rejection reason", \%rejected_count_by_reason, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_reason;
4068 foreach ('Host','Domain','Email','Edomain') {
4069 next unless $do_sender{$_};
4070 print_league_table("sending \l$_", $received_count{$_}, undef, $received_data{$_},$received_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4073 print_league_table("local sender", \%received_count_user, undef,
4074 \%received_data_user,\%received_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %received_count_user);
4075 foreach ('Host','Domain','Email','Edomain') {
4076 next unless $do_sender{$_};
4077 print_league_table("\l$_ destination", $delivered_messages{$_}, $delivered_addresses{$_}, $delivered_data{$_},$delivered_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4079 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);
4081 print_league_table("rejected ip", \%rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_ip;
4082 print_league_table("non-rejected spamming ip", \%spam_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %spam_count_by_ip;
4086 # Print the error statistics if required.
4087 print_errors() if $show_errors;
4089 print $htm_fh "</body>\n</html>\n" if $htm_fh;
4092 $txt_fh->close if $txt_fh && ref $txt_fh;
4093 $htm_fh->close if $htm_fh;
4096 # close Excel Workbook
4097 $ws_global->set_first_sheet();
4098 # FIXME: whyever - activate does not work :-/
4099 $ws_global->activate();