2 # $Cambridge: exim/src/src/eximstats.src,v 1.11 2006/11/16 16:16:30 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.
259 # For documentation on the logfile format, see
260 # http://www.exim.org/exim-html-4.50/doc/html/spec_48.html#IX2793
264 eximstats - generates statistics from Exim mainlog or syslog files.
268 eximstats [Output] [Options] mainlog1 mainlog2 ...
269 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
277 Output the results in plain text to STDOUT.
279 =item B<-txt>=I<filename>
281 Output the results in plain text. Filename '-' for STDOUT is accepted.
285 Output the results in HTML to STDOUT.
287 =item B<-html>=I<filename>
289 Output the results in HTML. Filename '-' for STDOUT is accepted.
293 Output the results in Excel compatible Format to STDOUT.
294 Requires the Spreadsheet::WriteExcel CPAN module.
296 =item B<-xls>=I<filename>
298 Output the results in Excel compatible format. Filename '-' for STDOUT is accepted.
309 histogram divisions per hour. The default is 1, and
310 0 suppresses histograms. Valid values are:
312 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
316 Don't display error information.
320 Don't display relaying information.
322 =item B<-nr>I</pattern/>
324 Don't display relaying information that matches.
328 Don't display transport information.
330 =item B<-nt>I</pattern/>
332 Don't display transport information that matches
336 List of times for queuing information single 0 item suppresses.
340 Display top <number> sources/destinations
341 default is 50, 0 suppresses top listing.
345 Omit local sources/destinations in top listing.
347 =item B<-t_remote_users>
349 Include remote users in the top source/destination listings.
351 =item B<-include_original_destination>
353 Include the original destination email addresses rather than just
354 using the final ones.
355 Useful for finding out which of your mailing lists are receiving mail.
357 =item B<-show_dt>I<list>
359 Show the delivery times (B<DT>)for all the messages.
361 Exim must have been configured to use the +delivery_time logging option
362 for this option to work.
364 I<list> is an optional list of times. Eg -show_dt1,2,4,8 will show
365 the number of messages with delivery times under 1 second, 2 seconds, 4 seconds,
366 8 seconds, and over 8 seconds.
368 =item B<-show_rt>I<list>
370 Show the receipt times for all the messages. The receipt time is
371 defined as the Completed hh:mm:ss - queue_time_overall - the Receipt hh:mm:ss.
372 These figures will be skewed by pipelined messages so might not be that useful.
374 Exim must have been configured to use the +queue_time_overall logging option
375 for this option to work.
377 I<list> is an optional list of times. Eg -show_rt1,2,4,8 will show
378 the number of messages with receipt times under 1 second, 2 seconds, 4 seconds,
379 8 seconds, and over 8 seconds.
383 Show results by sending host. This may be combined with
384 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
385 are specified, then B<-byhost> is assumed as a default.
389 Show results by sending domain.
390 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
394 Show results by sender's email address.
395 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
397 =item B<-byemaildomain> or B<-byedomain>
399 Show results by sender's email domain.
400 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
402 =item B<-pattern> I<Description> I</Pattern/>
404 Look for the specified pattern and count the number of lines in which it appears.
405 This option can be specified multiple times. Eg:
407 -pattern 'Refused connections' '/refused connection/'
412 This option allows eximstats to merge old eximstat reports together. Eg:
414 eximstats mainlog.sun > report.sun.txt
415 eximstats mainlog.mon > report.mon.txt
416 eximstats mainlog.tue > report.tue.txt
417 eximstats mainlog.wed > report.web.txt
418 eximstats mainlog.thu > report.thu.txt
419 eximstats mainlog.fri > report.fri.txt
420 eximstats mainlog.sat > report.sat.txt
421 eximstats -merge report.*.txt > weekly_report.txt
422 eximstats -merge -html report.*.txt > weekly_report.html
428 You can merge text or html reports and output the results as text or html.
432 You can use all the normal eximstat output options, but only data
433 included in the original reports can be shown!
437 When merging reports, some loss of accuracy may occur in the top I<n> lists.
438 This will be towards the ends of the lists.
442 The order of items in the top I<n> lists may vary when the data volumes
443 round to the same value.
449 Create graphical charts to be displayed in HTML output.
450 Only valid in combination with I<-html>.
452 This requires the following modules which can be obtained
453 from http://www.cpan.org/modules/01modules.index.html
465 To install these, download and unpack them, then use the normal perl installation procedure:
472 =item B<-chartdir>I <dir>
474 Create the charts in the directory <dir>
476 =item B<-chartrel>I <dir>
478 Specify the relative directory for the "img src=" tags from where to include
483 Specify that it's OK to not find any valid log lines. Without this
484 we will output an error message if we don't find any.
488 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
489 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
496 Eximstats parses exim mainlog and syslog files to output a statistical
497 analysis of the messages processed. By default, a text
498 analysis is generated, but you can request other output formats
499 using flags. See the help (B<-help>) to learn
500 about how to create charts from the tables.
504 There is a web site at http://www.exim.org - this contains details of the
505 mailing list exim-users@exim.org.
509 This program does not perfectly handle messages whose received
510 and delivered log lines are in different files, which can happen
511 when you have multiple mail servers and a message cannot be
512 immeadiately delivered. Fixing this could be tricky...
514 Merging of xls files is not (yet) possible. Be free to implement :)
522 # use Time::Local; # PH/FANF
525 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints $HAVE_Spreadsheet_WriteExcel);
526 eval { require GD::Graph::pie; };
527 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
528 eval { require GD::Graph::linespoints; };
529 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
530 eval { require Spreadsheet::WriteExcel; };
531 $HAVE_Spreadsheet_WriteExcel = $@ ? 0 : 1;
534 ##################################################
536 ##################################################
537 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
538 use vars qw(@tab62 @days_per_month $gig);
539 use vars qw($VERSION);
540 use vars qw($COLUMN_WIDTHS);
541 use vars qw($WEEK $DAY $HOUR $MINUTE);
545 (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, # 0-9
546 0,10,11,12,13,14,15,16,17,18,19,20, # A-K
547 21,22,23,24,25,26,27,28,29,30,31,32, # L-W
548 33,34,35, 0, 0, 0, 0, 0, # X-Z
549 0,36,37,38,39,40,41,42,43,44,45,46, # a-k
550 47,48,49,50,51,52,53,54,55,56,57,58, # l-w
553 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
554 $gig = 1024 * 1024 * 1024;
557 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
561 $HOUR = 60 * $MINUTE;
565 # Declare global variables.
566 use vars qw($total_received_data $total_received_data_gigs $total_received_count);
567 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_messages $total_delivered_addresses);
568 use vars qw(%timestamp2time); #Hash of timestamp => time.
569 use vars qw($last_timestamp $last_time); #The last time convertion done.
570 use vars qw($last_date $date_seconds); #The last date convertion done.
571 use vars qw($last_offset $offset_seconds); #The last time offset convertion done.
572 use vars qw($localtime_offset);
573 use vars qw($i); #General loop counter.
574 use vars qw($debug); #Debug mode?
575 use vars qw($ntopchart); #How many entries should make it into the chart?
576 use vars qw($gddirectory); #Where to put files from GD::Graph
578 # SpamAssassin variables
579 use vars qw($spam_score $spam_score_gigs);
580 use vars qw($ham_score $ham_score_gigs);
581 use vars qw(%ham_count_by_ip %spam_count_by_ip);
582 use vars qw(%rejected_count_by_ip %rejected_count_by_reason);
584 #For use in Speadsheed::WriteExcel
585 use vars qw($workbook $ws_global $ws_relayed $ws_errors);
586 use vars qw($row $col $row_hist $col_hist);
587 use vars qw($run_hist);
588 use vars qw($f_default $f_header1 $f_header2 $f_header2_m $f_headertab $f_percent); #Format Header
591 use vars qw($txt_fh $htm_fh $xls_fh);
595 # The following are parameters whose values are
596 # set by command line switches:
597 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
598 use vars qw($topcount $local_league_table $include_remote_users);
599 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding $emptyOK);
600 use vars qw($relay_pattern @queue_times @user_patterns @user_descriptions);
601 use vars qw(@rcpt_times @delivery_times);
602 use vars qw($include_original_destination);
603 use vars qw($txt_fh $htm_fh $xls_fh);
605 use vars qw(%do_sender); #Do sender by Host, Domain, Email, and/or Edomain tables.
606 use vars qw($charts $chartrel $chartdir $charts_option_specified);
607 use vars qw($merge_reports); #Merge old reports ?
609 # The following are modified in the parse() routine, and
610 # referred to in the print_*() routines.
611 use vars qw($delayed_count $relayed_unshown $begin $end);
612 use vars qw(%messages @message);
613 use vars qw(%received_count %received_data %received_data_gigs);
614 use vars qw(%delivered_messages %delivered_data %delivered_data_gigs %delivered_addresses);
615 use vars qw(%received_count_user %received_data_user %received_data_gigs_user);
616 use vars qw(%delivered_messages_user %delivered_addresses_user %delivered_data_user %delivered_data_gigs_user);
617 use vars qw(%transported_count %transported_data %transported_data_gigs);
618 use vars qw(%relayed %errors_count $message_errors);
619 use vars qw(@qt_all_bin @qt_remote_bin);
620 use vars qw($qt_all_overflow $qt_remote_overflow);
621 use vars qw(@dt_all_bin @dt_remote_bin %rcpt_times_bin);
622 use vars qw($dt_all_overflow $dt_remote_overflow %rcpt_times_overflow);
623 use vars qw(@received_interval_count @delivered_interval_count);
624 use vars qw(@user_pattern_totals @user_pattern_interval_count);
626 use vars qw(%report_totals);
629 use vars qw($SIZE $FROM_HOST $FROM_ADDRESS $ARRIVAL_TIME $REMOTE_DELIVERED $PROTOCOL);
630 use vars qw($DELAYED $HAD_ERROR);
635 $REMOTE_DELIVERED = 4;
642 ##################################################
644 ##################################################
646 #######################################################################
647 # get_filehandle($file,\%output_files);
648 # Return a filehandle writing to $file.
650 # If %output_files is defined, check that $output_files{$file}
651 # doesn't exist and die if it does, or set it if it doesn't.
652 #######################################################################
654 my($file,$output_files_href) = @_;
656 $file = '-' if ($file eq '');
658 if (defined $output_files_href) {
659 die "You can only output to '$file' once! Use -h for help.\n" if exists $output_files_href->{$file};
660 $output_files_href->{$file} = 1;
668 unlink $file or die "Failed to rm $file: $!";
671 my $fh = new IO::File $file, O_WRONLY|O_CREAT|O_EXCL;
672 die "new IO::File $file failed: $!" unless (defined $fh);
677 #######################################################################
680 # $rounded_volume = volume_rounded($bytes,$gigabytes);
682 # Given a data size in bytes, round it to KB, MB, or GB
685 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
687 # Note: I've experimented with Math::BigInt and it results in a 33%
688 # performance degredation as opposed to storing numbers split into
689 # bytes and gigabytes.
690 #######################################################################
702 if ($volume_rounding) {
706 $rounded = sprintf("%6d", $x);
708 elsif ($x < 10000000) {
709 $rounded = sprintf("%4dKB", ($x + 512)/1024);
712 $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
715 # Values between 1GB and 10GB are printed in MB
717 $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
720 # Handle values over 10GB
721 $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
725 # We don't want any rounding to be done.
726 # and we don't need broken formated output which on one hand avoids numbers from
727 # being interpreted as string by Spreadsheed Calculators, on the other hand
728 # breaks if more than 4 digits! -> flexible length instead of fixed length
729 # Format the return value at the output routine! -fh
730 #$rounded = sprintf("%d", ($g * $gig) + $x);
732 $rounded = sprintf("%.0f", ($g * $gig) + $x);
739 #######################################################################
742 # un_round($rounded_volume,\$bytes,\$gigabytes);
744 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
745 # do the reverse transformation and convert it back into Bytes and Gigabytes.
746 # These are added to the $bytes and $gigabytes parameters.
748 # Given a data size in bytes, round it to KB, MB, or GB
751 # EG: 500 => (500,0), 14GB => (0,14), etc.
752 #######################################################################
754 my($rounded,$bytes_sref,$gigabytes_sref) = @_;
756 if ($rounded =~ /(\d+)GB/) {
757 $$gigabytes_sref += $1;
759 elsif ($rounded =~ /(\d+)MB/) {
760 $$gigabytes_sref += $1 / 1024;
761 $$bytes_sref += (($1 % 1024 ) * 1024 * 1024);
763 elsif ($rounded =~ /(\d+)KB/) {
764 $$gigabytes_sref += $1 / (1024 * 1024);
765 $$bytes_sref += ($1 % (1024 * 1024) * 1024);
767 elsif ($rounded =~ /(\d+)/) {
768 # We need to turn off integer in case we are merging an -nvr report.
770 $$gigabytes_sref += int($1 / $gig);
771 $$bytes_sref += $1 % $gig;
774 #Now reduce the bytes down to less than 1GB.
775 add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
779 #######################################################################
782 # add_volume(\$bytes,\$gigs,$size);
784 # Add $size to $bytes/$gigs where this is a number split into
785 # bytes ($bytes) and gigabytes ($gigs). This is significantly
786 # faster than using Math::BigInt.
787 #######################################################################
789 my($bytes_ref,$gigs_ref,$size) = @_;
790 $$bytes_ref = 0 if ! defined $$bytes_ref;
791 $$gigs_ref = 0 if ! defined $$gigs_ref;
792 $$bytes_ref += $size;
793 while ($$bytes_ref > $gig) {
800 #######################################################################
803 # $formatted_time = format_time($seconds);
805 # Given a time in seconds, break it down into
806 # weeks, days, hours, minutes, and seconds.
808 # Eg 12005 => 3h20m5s
809 #######################################################################
821 $p .= "$w"."w" if $w > 0;
822 $p .= "$d"."d" if $d > 0;
823 $p .= "$h"."h" if $h > 0;
824 $p .= "$m"."m" if $m > 0;
825 $p .= "$s"."s" if $s > 0 || $p eq "";
830 #######################################################################
833 # $seconds = unformat_time($formatted_time);
835 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
837 # Eg 3h20m5s => 12005
838 #######################################################################
840 my($formated_time) = pop @_;
843 while ($formated_time =~ s/^(\d+)([wdhms]?)//) {
844 $time += $1 if ($2 eq '' || $2 eq 's');
845 $time += $1 * 60 if ($2 eq 'm');
846 $time += $1 * 60 * 60 if ($2 eq 'h');
847 $time += $1 * 60 * 60 * 24 if ($2 eq 'd');
848 $time += $1 * 60 * 60 * 24 * 7 if ($2 eq 'w');
854 #######################################################################
857 # $time = seconds($timestamp);
859 # Given a time-of-day timestamp, convert it into a time() value using
860 # POSIX::mktime. We expect the timestamp to be of the form
861 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
862 # and the year to be absolute (we do the necessary conversions). The
863 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
864 # offset is not present, and we have not been told that the log is in UTC
865 # (with the -utc option), then we adjust the time by the current local
866 # time offset so that it can be compared with the time recorded in message
869 # To improve performance, we only use mktime on the date ($year-$mon-$day),
870 # and only calculate it if the date is different to the previous time we
871 # came here. We then add on seconds for the '$hour:$min:$sec'.
873 # We also store the results of the last conversion done, and only
874 # recalculate if the date is different.
876 # We used to have the '-cache' flag which would store the results of the
877 # mktime() call. However, the current way of just using mktime() on the
878 # date obsoletes this.
879 #######################################################################
883 # Is the timestamp the same as the last one?
884 return $last_time if ($last_timestamp eq $timestamp);
886 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
888 unless ($last_date eq $1) {
890 my(@timestamp) = (0,0,0,$4,$3,$2);
891 $timestamp[5] -= 1900;
893 $date_seconds = mktime(@timestamp);
895 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
897 # SC. Use cacheing. Also note we want seconds not minutes.
898 #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
899 if (defined $8 && ($8 ne $last_offset)) {
901 $offset_seconds = ($10 * 60 + $11) * 60;
902 $offset_seconds = -$offset_seconds if ($9 eq '-');
907 #$time -= $this_offset;
908 $time -= $offset_seconds;
909 } elsif (defined $localtime_offset) {
910 $time -= $localtime_offset;
913 # Store the last timestamp received.
914 $last_timestamp = $timestamp;
921 #######################################################################
924 # $time = id_seconds($message_id);
926 # Given a message ID, convert it into a time() value.
927 #######################################################################
929 my($sub_id) = substr((pop @_), 0, 6);
931 my(@c) = split(//, $sub_id);
932 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
936 #######################################################################
939 # $seconds = wdhms_seconds($string);
941 # Convert a string in a week/day/hour/minute/second format (eg 4h10s)
943 #######################################################################
945 if ($_[0] =~ /^(?:(\d+)w)?(?:(\d+)d)?(?:(\d+)h)?(?:(\d+)m)?(?:(\d+)s)?/) {
946 return((($1||0) * $WEEK) + (($2||0) * $DAY) + (($3||0) * $HOUR) + (($4||0) * $MINUTE) + ($5||0));
951 #######################################################################
954 # $queued = queue_time($completed_tod, $arrival_time, $id);
956 # Given the completed time of day and either the arrival time
957 # (preferred), or the message ID, calculate how long the message has
960 #######################################################################
962 my($completed_tod, $arrival_time, $id) = @_;
964 # Note: id_seconds() benchmarks as 42% slower than seconds()
965 # and computing the time accounts for a significant portion of
967 if (defined $arrival_time) {
968 return(seconds($completed_tod) - seconds($arrival_time));
971 return(seconds($completed_tod) - id_seconds($id));
976 #######################################################################
977 # calculate_localtime_offset();
979 # $localtime_offset = calculate_localtime_offset();
981 # Calculate the the localtime offset from gmtime in seconds.
983 # $localtime = time() + $localtime_offset.
985 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
986 # (West is negative, East is positive.)
987 #######################################################################
989 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
990 # This subroutine commented out as it's not currently in use.
992 #sub calculate_localtime_offset {
993 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
994 # my (@sample_date) = (0,0,0,5,5,100);
995 # my $localtime = timelocal(@sample_date);
996 # my $gmtime = timegm(@sample_date);
997 # my $offset = $localtime - $gmtime;
1001 sub calculate_localtime_offset {
1002 # Assume that the offset at the moment is valid across the whole
1003 # period covered by the logs that we're analysing. This may not
1004 # be true around the time the clocks change in spring or autumn.
1006 # mktime works on local time and gmtime works in UTC
1007 my $local = mktime(gmtime($utc));
1008 return $local - $utc;
1013 #######################################################################
1014 # print_duration_table();
1016 # print_duration_table($title, $message_type, \@times, \@values, $overflow);
1018 # Print a table showing how long a particular step took for
1019 # the messages. The parameters are:
1020 # $title Eg "Time spent on the queue"
1021 # $message_type Eg "Remote"
1022 # \@times The maximum time a message took for it to increment
1023 # the corresponding @values counter.
1024 # \@values An array of message counters.
1025 # $overflow The number of messages which exceeded the maximum
1027 #######################################################################
1028 sub print_duration_table {
1030 my($title, $message_type, $times_aref, $values_aref, $overflow) = @_;
1031 my(@chartdatanames);
1034 my $printed_one = 0;
1035 my $cumulative_percent = 0;
1037 my $queue_total = $overflow;
1038 map {$queue_total += $_} @$values_aref;
1040 my $temp = "$title: $message_type";
1043 my $txt_format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
1044 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";
1047 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
1049 print $htm_fh "<hr><a name=\"$title $message_type\"></a><h2>$temp</h2>\n";
1050 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
1051 print $htm_fh "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
1054 $ws_global->write($row++, $col, "$title: ".$message_type, $f_header2);
1055 my @content=("Time", "Messages", "Percentage", "Cumulative Percentage");
1056 &set_worksheet_line($ws_global, $row++, 1, \@content, $f_headertab);
1060 for ($i = 0; $i <= $#$times_aref; ++$i) {
1061 if ($$values_aref[$i] > 0)
1063 my $percent = ($values_aref->[$i] * 100)/$queue_total;
1064 $cumulative_percent += $percent;
1066 my @content=($printed_one? " " : "Under",
1067 format_time($times_aref->[$i]),
1068 $values_aref->[$i], $percent, $cumulative_percent);
1071 printf $htm_fh ($htm_format, @content);
1072 if (!defined($values_aref->[$i])) {
1073 print $htm_fh "Not defined";
1077 printf $txt_fh ($txt_format, @content);
1078 if (!defined($times_aref->[$i])) {
1079 print $txt_fh "Not defined";
1085 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1086 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1088 if (!defined($times_aref->[$i])) {
1090 $ws_global->write($row++, $col, "Not defined" );
1094 push(@chartdatanames,
1095 ($printed_one? "" : "Under") . format_time($times_aref->[$i]));
1096 push(@chartdatavals, $$values_aref[$i]);
1101 if ($overflow && $overflow > 0) {
1102 my $percent = ($overflow * 100)/$queue_total;
1103 $cumulative_percent += $percent;
1105 my @content = ("Over ", format_time($times_aref->[-1]),
1106 $overflow, $percent, $cumulative_percent);
1108 printf $txt_fh ($txt_format, @content) if $txt_fh;
1109 printf $htm_fh ($htm_format, @content) if $htm_fh;
1112 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1113 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1118 push(@chartdatanames, "Over " . format_time($times_aref->[-1]));
1119 push(@chartdatavals, $overflow);
1121 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
1123 print $htm_fh "</table></td><td>";
1125 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1130 my $graph = GD::Graph::pie->new(200, 200);
1131 my $pngname = "$title-$message_type.png";
1132 $pngname =~ s/[^\w\-\.]/_/;
1134 my $graph_title = "$title ($message_type)";
1135 $graph->set(title => $graph_title) if (length($graph_title) < 21);
1137 my $gd = $graph->plot(\@data) or warn($graph->error);
1139 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1143 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1146 print $htm_fh "</td></tr></table>\n";
1153 print $txt_fh "\n" if $txt_fh;
1154 print $htm_fh "\n" if $htm_fh;
1159 #######################################################################
1160 # print_histogram();
1162 # print_histogram('Deliveries|Messages received|$pattern', $unit, @interval_count);
1164 # Print a histogram of the messages delivered/received per time slot
1165 # (hour by default).
1166 #######################################################################
1167 sub print_histogram {
1168 my($text, $unit, @interval_count) = @_;
1169 my(@chartdatanames);
1173 # save first row of print_histogram for xls output
1181 for ($i = 0; $i < $hist_number; $i++)
1182 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
1184 my $scale = int(($maxd + 25)/50);
1185 $scale = 1 if $scale == 0;
1188 if ($unit !~ s/y$/ies/) {
1193 # make and output title
1194 my $title = sprintf("$text per %s",
1195 ($hist_interval == 60)? "hour" :
1196 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
1198 my $txt_htm_title = $title . " (each dot is $scale $unit)";
1200 printf $txt_fh ("%s\n%s\n\n", $txt_htm_title, "-" x length($txt_htm_title)) if $txt_fh;
1203 print $htm_fh "<hr><a name=\"$text\"></a><h2>$txt_htm_title</h2>\n";
1204 print $htm_fh "<table border=0 width=\"100%\">\n";
1205 print $htm_fh "<tr><td><pre>\n";
1209 $title =~ s/Messages/Msg/ ;
1211 $ws_global->write($row++, $col_hist+1, $title, $f_headertab);
1217 for ($i = 0; $i < $hist_number; $i++) {
1218 my $c = $interval_count[$i];
1220 # If the interval is an hour (the maximum) print the starting and
1221 # ending hours as a label. Otherwise print the starting hour and
1222 # minutes, which take up the same space.
1225 if ($hist_opt == 1) {
1226 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
1228 print $txt_fh $temp if $txt_fh;
1229 print $htm_fh $temp if $htm_fh;
1234 $ws_global->write($row, 0, [$temp], $f_default);
1238 push(@chartdatanames, $temp);
1243 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
1245 { $temp = sprintf(" :%02d", $minutes) }
1247 print $txt_fh $temp if $txt_fh;
1248 print $htm_fh $temp if $htm_fh;
1249 if (($xls_fh) and ($run_hist==0)) {
1251 $temp = sprintf("%02d:%02d", $hour, $minutes);
1252 $ws_global->write($row, 0, [$temp], $f_default);
1255 push(@chartdatanames, $temp);
1256 $minutes += $hist_interval;
1257 if ($minutes >= 60) {
1262 push(@chartdatavals, $c);
1264 printf $txt_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $txt_fh;
1265 printf $htm_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $htm_fh;
1266 $ws_global->write($row++, $col_hist+1, [$c], $f_default) if $xls_fh;
1270 printf $txt_fh "\n" if $txt_fh;
1271 printf $htm_fh "\n" if $htm_fh;
1275 print $htm_fh "</pre>\n";
1276 print $htm_fh "</td><td>\n";
1277 if ($HAVE_GD_Graph_linespoints && $charts && ($#chartdatavals > 0)) {
1278 # calculate the graph
1283 my $graph = GD::Graph::linespoints->new(300, 300);
1286 y_label => 'Amount',
1288 x_labels_vertical => 1
1290 my $pngname = "histogram_$text.png";
1291 $pngname =~ s/[^\w\._]/_/g;
1293 my $gd = $graph->plot(\@data) or warn($graph->error);
1295 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1299 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1302 print $htm_fh "</td></tr></table>\n";
1305 $col_hist++; # where to continue next times
1307 $row+=2; # leave some space after history block
1308 $run_hist=1; # we have done this once or more
1313 #######################################################################
1314 # print_league_table();
1316 # print_league_table($league_table_type,\%message_count,\%address_count,\%message_data,\%message_data_gigs, $spreadsheet, $row_sref);
1318 # Given hashes of message count, address count, and message data,
1319 # which are keyed by the table type (eg by the sending host), print a
1320 # league table showing the top $topcount (defaults to 50).
1321 #######################################################################
1322 sub print_league_table {
1323 my($text,$m_count,$a_count,$m_data,$m_data_gigs,$spreadsheet, $row_sref) = @_;
1324 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
1325 my($title) = "Top $name by message count";
1326 my(@chartdatanames) = ();
1327 my(@chartdatavals) = ();
1328 my $chartotherval = 0;
1329 $text = ucfirst($text);
1331 # Align non-local addresses to the right (so all the .com's line up).
1332 # Local addresses are aligned on the left as they are userids.
1333 my $align = ($text !~ /local/i) ? 'right' : 'left';
1336 ################################################
1337 # Generate the printf formats and table headers.
1338 ################################################
1339 my(@headers) = ('Messages');
1340 push(@headers,'Addresses') if defined $a_count;
1341 push(@headers,'Bytes','Average') if defined $m_data;
1343 my $txt_format = "%10s " x @headers . " %s\n";
1344 my $txt_col_headers = sprintf $txt_format, @headers, $text;
1345 my $htm_format = "<tr>" . '<td align="right">%s</td>'x@headers . "<td align=\"$align\" nowrap>%s</td></tr>\n";
1346 my $htm_col_headers = sprintf $htm_format, @headers, $text;
1347 $htm_col_headers =~ s/(<\/?)td/$1th/g; #Convert <td>'s to <th>'s for the header.
1350 ################################################
1351 # Write the table headers
1352 ################################################
1353 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1356 print $htm_fh <<EoText;
1357 <hr><a name="$text count"></a><h2>$title</h2>
1358 <table border=0 width="100%">
1362 print $htm_col_headers;
1366 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1367 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1372 foreach my $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1374 # When displaying the average figures, we calculate the average of
1375 # the rounded data, as the user would calculate it. This reduces
1376 # the accuracy slightly, but we have to do it this way otherwise
1377 # when using -merge to convert results from text to HTML and
1378 # vice-versa discrepencies would occur.
1379 my $messages = $$m_count{$key};
1380 my @content = ($messages);
1381 push(@content, $$a_count{$key}) if defined $a_count;
1382 if (defined $m_data) {
1383 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1384 my($data,$gigs) = (0,0);
1385 un_round($rounded_volume,\$data,\$gigs);
1386 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1387 push(@content, $rounded_volume, $rounded_average);
1391 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1395 $htmlkey =~ s/>/\>\;/g;
1396 $htmlkey =~ s/</\<\;/g;
1397 printf $htm_fh ($htm_format, @content, $htmlkey);
1399 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1401 if (scalar @chartdatanames < $ntopchart) {
1402 push(@chartdatanames, $key);
1403 push(@chartdatavals, $$m_count{$key});
1406 $chartotherval += $$m_count{$key};
1410 push(@chartdatanames, "Other");
1411 push(@chartdatavals, $chartotherval);
1413 print $txt_fh "\n" if $txt_fh;
1415 print $htm_fh "</table>\n";
1416 print $htm_fh "</td><td>\n";
1417 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0))
1419 # calculate the graph
1424 my $graph = GD::Graph::pie->new(300, 300);
1427 y_label => 'Amount',
1428 title => 'By count',
1430 my $gd = $graph->plot(\@data) or warn($graph->error);
1434 open(IMG, ">$chartdir/${temp}_count.png") or die "Could not write $chartdir/${temp}_count.png: $!\n";
1438 print $htm_fh "<img src=\"$chartrel/${temp}_count.png\">";
1441 print $htm_fh "</td><td>\n";
1442 print $htm_fh "</td></tr></table>\n\n";
1444 ++${$row_sref} if $xls_fh;
1447 if (defined $m_data) {
1450 $title = "Top $name by volume";
1452 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1455 print $htm_fh <<EoText;
1456 <hr><a name="$text volume"></a><h2>$title</h2>
1457 <table border=0 width="100%">
1461 print $htm_col_headers;
1464 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1465 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1468 @chartdatanames = ();
1469 @chartdatavals = ();
1472 foreach my $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1473 # The largest volume will be the first (top of the list).
1474 # If it has at least 1 gig, then just use gigabytes to avoid
1475 # risking an integer overflow when generating the pie charts.
1476 if ($$m_data_gigs{$key}) {
1480 my $messages = $$m_count{$key};
1481 my @content = ($messages);
1482 push(@content, $$a_count{$key}) if defined $a_count;
1483 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1484 my($data ,$gigs) = (0,0);
1485 un_round($rounded_volume,\$data,\$gigs);
1486 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1487 push(@content, $rounded_volume, $rounded_average );
1490 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1493 $htmlkey =~ s/>/\>\;/g;
1494 $htmlkey =~ s/</\<\;/g;
1495 printf $htm_fh ($htm_format, @content, $htmlkey);
1497 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1500 if (scalar @chartdatanames < $ntopchart) {
1502 if ($$m_data_gigs{$key}) {
1503 push(@chartdatanames, $key);
1504 push(@chartdatavals, $$m_data_gigs{$key});
1508 push(@chartdatanames, $key);
1509 push(@chartdatavals, $$m_data{$key});
1513 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1516 push(@chartdatanames, "Other");
1517 push(@chartdatavals, $chartotherval);
1519 print $txt_fh "\n" if $txt_fh;
1521 print $htm_fh "</table>\n";
1522 print $htm_fh "</td><td>\n";
1523 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1524 # calculate the graph
1529 my $graph = GD::Graph::pie->new(300, 300);
1532 y_label => 'Volume' ,
1533 title => 'By Volume',
1535 my $gd = $graph->plot(\@data) or warn($graph->error);
1539 open(IMG, ">$chartdir/${temp}_volume.png") or die "Could not write $chartdir/${temp}_volume.png: $!\n";
1543 print $htm_fh "<img src=\"$chartrel/${temp}_volume.png\">";
1546 print $htm_fh "</td><td>\n";
1547 print $htm_fh "</td></tr></table>\n\n";
1550 ++${$row_sref} if $xls_fh;
1555 #######################################################################
1558 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1560 # Given a hash which has numerical values, return the sorted $n keys which
1561 # point to the top values. The second and third hashes are used as
1562 # tiebreakers. They all must have the same keys.
1564 # The idea behind this routine is that when you only want to see the
1565 # top n members of a set, rather than sorting the entire set and then
1566 # plucking off the top n, sort through the stack as you go, discarding
1567 # any member which is lower than your current n'th highest member.
1569 # This proves to be an order of magnitude faster for large hashes.
1570 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1571 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1573 # We assume the values are > 0.
1574 #######################################################################
1576 my($n,$href1,$href2,$href3) = @_;
1578 # PH's original sort was:
1580 # foreach $key (sort
1582 # $$m_count{$b} <=> $$m_count{$a} ||
1583 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1584 # $$m_data{$b} <=> $$m_data{$a} ||
1590 #We use a key of '_' to represent non-existant values, as null keys are valid.
1591 #'_' is not a valid domain, edomain, host, or email.
1592 my(@top_n_keys) = ('_') x $n;
1593 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1595 my $n_minus_1 = $n - 1;
1596 my $n_minus_2 = $n - 2;
1598 # Create a dummy hash incase the user has not provided us with
1599 # tiebreaker hashes.
1601 $href2 = \%dummy_hash unless defined $href2;
1602 $href3 = \%dummy_hash unless defined $href3;
1604 # Pick out the top $n keys.
1605 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1606 while (($key,$value1) = each %$href1) {
1608 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1610 # Check to see that the new value is bigger than the lowest of the
1611 # top n keys that we're keeping. We test the main key first, because
1612 # for the majority of cases we can skip creating dummy hash values
1613 # should the user have not provided real tie-breaking hashes.
1614 next unless $value1 >= $minimum_value1;
1616 # Create a dummy hash entry for the key if required.
1617 # Note that setting the dummy_hash value sets it for both href2 &
1618 # href3. Also note that currently we are guarenteed to have a real
1619 # value for href3 if a real value for href2 exists so don't need to
1620 # test for it as well.
1621 $dummy_hash{$key} = 0 unless exists $href2->{$key};
1623 $comparison = $value1 <=> $minimum_value1 ||
1624 $href2->{$key} <=> $minimum_value2 ||
1625 $href3->{$key} <=> $minimum_value3 ||
1626 $top_n_key cmp $key;
1627 next unless ($comparison == 1);
1629 # As we will be using these values a few times, extract them into scalars.
1630 $value2 = $href2->{$key};
1631 $value3 = $href3->{$key};
1633 # This key is bigger than the bottom n key, so the lowest position we
1634 # will insert it into is $n minus 1 (the bottom of the list).
1635 $insert_position = $n_minus_1;
1637 # Now go through the list, stopping when we find a key that we're
1638 # bigger than, or we come to the penultimate position - we've
1639 # already tested bigger than the last.
1641 # Note: we go top down as the list starts off empty.
1642 # Note: stepping through the list in this way benchmarks nearly
1643 # three times faster than doing a sort() on the reduced list.
1644 # I assume this is because the list is already in order, and
1645 # we get a performance boost from not having to do hash lookups
1647 for ($i = 0; $i < $n_minus_1; $i++) {
1648 $top_n_key = $top_n_keys[$i];
1649 if ( ($top_n_key eq '_') ||
1650 ( ($value1 <=> $href1->{$top_n_key} ||
1651 $value2 <=> $href2->{$top_n_key} ||
1652 $value3 <=> $href3->{$top_n_key} ||
1653 $top_n_key cmp $key) == 1
1656 $insert_position = $i;
1661 # Remove the last element, then insert the new one.
1662 $#top_n_keys = $n_minus_2;
1663 splice(@top_n_keys,$insert_position,0,$key);
1665 # Extract our new minimum values.
1666 $top_n_key = $top_n_keys[$n_minus_1];
1667 if ($top_n_key ne '_') {
1668 $minimum_value1 = $href1->{$top_n_key};
1669 $minimum_value2 = $href2->{$top_n_key};
1670 $minimum_value3 = $href3->{$top_n_key};
1674 # Return the top n list, grepping out non-existant values, just in case
1675 # we didn't have that many values.
1676 return(grep(!/^_$/,@top_n_keys));
1681 #######################################################################
1684 # $header = html_header($title);
1686 # Print our HTML header and start the <body> block.
1687 #######################################################################
1690 my $text = << "EoText";
1691 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1694 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1695 <title>$title</title>
1697 <body bgcolor="white">
1705 #######################################################################
1710 # Display usage instructions and exit.
1711 #######################################################################
1715 eximstats Version $VERSION
1718 eximstats [Output] [Options] mainlog1 mainlog2 ...
1719 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1722 eximstats -html=eximstats.html mainlog1 mainlog2 ...
1723 eximstats mainlog1 mainlog2 ... > report.txt
1725 Parses exim mainlog or syslog files and generates a statistical analysis
1726 of the messages processed.
1728 Valid output types are:
1729 -txt[=<file>] plain text (default unless no other type is specified)
1732 With no type and file given, defaults to -txt and STDOUT.
1735 -h<number> histogram divisions per hour. The default is 1, and
1736 0 suppresses histograms. Other valid values are:
1737 2, 3, 5, 10, 15, 20, 30 or 60.
1738 -ne don't display error information
1739 -nr don't display relaying information
1740 -nr/pattern/ don't display relaying information that matches
1741 -nt don't display transport information
1742 -nt/pattern/ don't display transport information that matches
1743 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1744 -t<number> display top <number> sources/destinations
1745 default is 50, 0 suppresses top listing
1746 -tnl omit local sources/destinations in top listing
1747 -t_remote_users show top user sources/destinations from non-local domains
1748 -q<list> list of times for queuing information. -q0 suppresses.
1749 -show_rt<list> Show the receipt times for all the messages.
1750 -show_dt<list> Show the delivery times for all the messages.
1751 <list> is an optional list of times in seconds.
1754 -include_original_destination show both the final and original
1755 destinations in the results rather than just the final ones.
1757 -byhost show results by sending host (default unless bydomain or
1758 byemail is specified)
1759 -bydomain show results by sending domain.
1760 -byemail show results by sender's email address
1761 -byedomain show results by sender's email domain
1763 -pattern "Description" /pattern/
1764 Count lines matching specified patterns and show them in
1765 the results. It can be specified multiple times. Eg:
1766 -pattern 'Refused connections' '/refused connection/'
1768 -merge merge previously generated reports into a new report
1770 -charts Create charts (this requires the GD::Graph modules).
1771 Only valid with -html.
1772 -chartdir <dir> Create the charts' png files in the directory <dir>
1773 -chartrel <dir> Specify the relative directory for the "img src=" tags
1774 from where to include the charts in the html file
1775 -chartdir and -chartrel default to '.'
1777 -emptyok It is OK if there is no valid input, don't print an error.
1779 -d Debug mode - dump the eval'ed parser onto STDERR.
1788 #######################################################################
1789 # generate_parser();
1791 # $parser = generate_parser();
1793 # This subroutine generates the parsing routine which will be
1794 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1795 # This improves performance depending on what bits you take out or add.
1797 # I've tested using study(), but this does not improve performance.
1799 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1800 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1801 # the expression evaluates to true, then it is included/excluded accordingly.
1802 #######################################################################
1803 sub generate_parser {
1805 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1806 my($tod,$m_hour,$m_min,$id,$flag,$extra,$length);
1807 my($seconds,$queued,$rcpt_time);
1811 # Convert syslog lines to mainlog format.
1813 next unless s/^.*? exim\\b.*?: //;
1816 $length = length($_);
1817 next if ($length < 38);
1818 next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)/o;
1820 ($tod,$m_hour,$m_min) = ($1,$2,$3);
1822 # PH - watch for GMT offsets in the timestamp.
1825 next if ($length < 44);
1831 $id = substr($_, 20 + $extra, 16);
1832 $flag = substr($_, 37 + $extra, 2);
1834 if ($flag !~ /^([<>=*-]+|SA)$/ && /rejected|refused|dropped/) {
1839 # Rejects can have no MSGID...
1840 if ($flag eq "Re" && $id !~ /^[-0-9a-zA-Z]+$/) {
1841 $id = "reject:" . ++$rej_id;
1846 # Watch for user specified patterns.
1847 my $user_pattern_index = 0;
1848 foreach (@user_patterns) {
1849 $user_pattern_totals[$user_pattern_index] = 0;
1850 $parser .= " if ($_) {\n";
1851 $parser .= " \$user_pattern_totals[$user_pattern_index]++;\n";
1852 $parser .= " \$user_pattern_interval_count[$user_pattern_index][(\$m_hour*60 + \$m_min)/$hist_interval]++;\n" if ($hist_opt > 0);
1854 $user_pattern_index++;
1858 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co|SA|Re/);
1860 #Strip away the timestamp, ID and flag to speed up later pattern matches.
1861 #The flags include Co (Completed), Re (Rejected), and SA (SpamAssassin).
1862 $_ = substr($_, 40 + $extra); # PH
1864 # Alias @message to the array of information about the message.
1865 # This minimises the number of calls to hash functions.
1866 $messages{$id} = [] unless exists $messages{$id};
1867 *message = $messages{$id};
1870 # JN - Skip over certain transports as specified via the "-nt/.../" command
1871 # line switch (where ... is a perl style regular expression). This is
1872 # required so that transports that skew stats such as SpamAssassin can be
1874 #IFDEF ($transport_pattern)
1875 if (/\\sT=(\\S+)/) {
1876 next if ($1 =~ /$transport_pattern/o) ;
1878 #ENDIF ($transport_pattern)
1882 # Do some pattern matches to get the host and IP address.
1883 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1884 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1885 # We do 2 separate matches to keep the matches simple and fast.
1886 # Host is local unless otherwise specified.
1887 $ip = (/\\bH=.*?(\\[[^]]+\\])/) ? $1 : "local";
1888 $host = (/\\bH=(\\S+)/) ? $1 : "local";
1890 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1892 #IFDEF ($do_sender{Domain})
1893 if ($host !~ /^\\[/ && $host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1894 # Remove the host portion from the DNS name. We ensure that we end up
1895 # with at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1896 $domain = lc("$1.$2");
1897 $domain =~ s/^\\.//; #Remove preceding dot.
1899 #ENDIF ($do_sender{Domain})
1901 #IFDEF ($do_sender{Email})
1902 #IFDEF ($include_original_destination)
1903 # Catch both "a@b.com <c@d.com>" and "e@f.com"
1904 #$email = (/^(\S+) (<(\S*?)>)?/) ? $3 || $1 : "";
1905 $email = (/^(\S+ (<[^@>]+@?[^>]*>)?)/) ? $1 : "";
1907 #ENDIF ($include_original_destination)
1909 #IFNDEF ($include_original_destination)
1910 $email = (/^(\S+)/) ? $1 : "";
1911 #ENDIF ($include_original_destination)
1912 #ENDIF ($do_sender{Email})
1914 #IFDEF ($do_sender{Edomain})
1915 #IFDEF ($include_original_destination)
1916 #$edomain = (/^(\S+) (<\S*?\\@(\S+)>)?/) ? $3 || $1 : "";
1917 $edomain = (/^(\S+ (<\S*?\\@(\S+?)>)?)/) ? $1 : "";
1920 #ENDIF ($include_original_destination)
1922 #IFNDEF ($include_original_destination)
1923 $edomain = (/^\S*?\\@(\S+)/) ? lc($1) : "";
1924 #ENDIF ($include_original_destination)
1925 #ENDIF ($do_sender{Edomain})
1927 if ($tod lt $begin) {
1930 elsif ($tod gt $end) {
1935 if ($flag eq "<=") {
1936 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
1937 $message[$SIZE] = $thissize;
1938 $message[$PROTOCOL] = (/ P=(\S+)/) ? $1 : undef;
1940 #IFDEF ($show_relay)
1941 if ($host ne "local") {
1942 # Save incoming information in case it becomes interesting
1943 # later, when delivery lines are read.
1944 my($from) = /^(\\S+)/;
1945 $message[$FROM_HOST] = "$host$ip";
1946 $message[$FROM_ADDRESS] = $from;
1948 #ENDIF ($show_relay)
1950 #IFDEF ($local_league_table || $include_remote_users)
1954 #IFDEF ($local_league_table && $include_remote_users)
1955 { #Store both local and remote users.
1956 #ENDIF ($local_league_table && $include_remote_users)
1958 #IFDEF ($local_league_table && ! $include_remote_users)
1959 if ($host eq "local") { #Store local users only.
1960 #ENDIF ($local_league_table && ! $include_remote_users)
1962 #IFDEF ($include_remote_users && ! $local_league_table)
1963 if ($host ne "local") { #Store remote users only.
1964 #ENDIF ($include_remote_users && ! $local_league_table)
1966 ++$received_count_user{$user};
1967 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
1970 #ENDIF ($local_league_table || $include_remote_users)
1972 #IFDEF ($do_sender{Host})
1973 ++$received_count{Host}{$host};
1974 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
1975 #ENDIF ($do_sender{Host})
1977 #IFDEF ($do_sender{Domain})
1979 ++$received_count{Domain}{$domain};
1980 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
1982 #ENDIF ($do_sender{Domain})
1984 #IFDEF ($do_sender{Email})
1985 ++$received_count{Email}{$email};
1986 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
1987 #ENDIF ($do_sender{Email})
1989 #IFDEF ($do_sender{Edomain})
1990 ++$received_count{Edomain}{$edomain};
1991 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
1992 #ENDIF ($do_sender{Edomain})
1994 ++$total_received_count;
1995 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
1997 #IFDEF ($#queue_times >= 0 || $#rcpt_times >= 0)
1998 $message[$ARRIVAL_TIME] = $tod;
1999 #ENDIF ($#queue_times >= 0 || $#rcpt_times >= 0)
2001 #IFDEF ($hist_opt > 0)
2002 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2003 #ENDIF ($hist_opt > 0)
2006 elsif ($flag eq "=>") {
2007 $size = $message[$SIZE] || 0;
2008 if ($host ne "local") {
2009 $message[$REMOTE_DELIVERED] = 1;
2012 #IFDEF ($show_relay)
2013 # Determine relaying address if either only one address listed,
2014 # or two the same. If they are different, it implies a forwarding
2015 # or aliasing, which is not relaying. Note that for multi-aliased
2016 # addresses, there may be a further address between the first
2019 if (defined $message[$FROM_HOST]) {
2020 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
2021 ($old,$new) = ($1,$2);
2027 if ("\\L$new" eq "\\L$old") {
2028 ($old) = /^(\\S+)/ if $old eq "";
2029 my $key = "H=\\L$message[$FROM_HOST]\\E A=\\L$message[$FROM_ADDRESS]\\E => " .
2030 "H=\\L$host\\E$ip A=\\L$old\\E";
2031 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2032 $relayed{$key} = 0 if !defined $relayed{$key};
2040 #ENDIF ($show_relay)
2044 #IFDEF ($local_league_table || $include_remote_users)
2045 #IFDEF ($local_league_table && $include_remote_users)
2046 { #Store both local and remote users.
2047 #ENDIF ($local_league_table && $include_remote_users)
2049 #IFDEF ($local_league_table && ! $include_remote_users)
2050 if ($host eq "local") { #Store local users only.
2051 #ENDIF ($local_league_table && ! $include_remote_users)
2053 #IFDEF ($include_remote_users && ! $local_league_table)
2054 if ($host ne "local") { #Store remote users only.
2055 #ENDIF ($include_remote_users && ! $local_league_table)
2057 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2058 #IFDEF ($include_original_destination)
2060 #ENDIF ($include_original_destination)
2061 #IFNDEF ($include_original_destination)
2062 if ($user =~ /^[\\/|]/) {
2063 #ENDIF ($include_original_destination)
2064 my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2065 $user = "$user $parent" if defined $parent;
2067 ++$delivered_messages_user{$user};
2068 ++$delivered_addresses_user{$user};
2069 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
2072 #ENDIF ($local_league_table || $include_remote_users)
2074 #IFDEF ($do_sender{Host})
2075 $delivered_messages{Host}{$host}++;
2076 $delivered_addresses{Host}{$host}++;
2077 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
2078 #ENDIF ($do_sender{Host})
2079 #IFDEF ($do_sender{Domain})
2081 ++$delivered_messages{Domain}{$domain};
2082 ++$delivered_addresses{Domain}{$domain};
2083 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
2085 #ENDIF ($do_sender{Domain})
2086 #IFDEF ($do_sender{Email})
2087 ++$delivered_messages{Email}{$email};
2088 ++$delivered_addresses{Email}{$email};
2089 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
2090 #ENDIF ($do_sender{Email})
2091 #IFDEF ($do_sender{Edomain})
2092 ++$delivered_messages{Edomain}{$edomain};
2093 ++$delivered_addresses{Edomain}{$edomain};
2094 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
2095 #ENDIF ($do_sender{Edomain})
2097 ++$total_delivered_messages;
2098 ++$total_delivered_addresses;
2099 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
2101 #IFDEF ($show_transport)
2102 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
2103 ++$transported_count{$transport};
2104 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
2105 #ENDIF ($show_transport)
2107 #IFDEF ($hist_opt > 0)
2108 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2109 #ENDIF ($hist_opt > 0)
2111 #IFDEF ($#delivery_times > 0)
2113 $seconds = wdhms_seconds($1);
2114 for ($i = 0; $i <= $#delivery_times; $i++) {
2115 if ($seconds < $delivery_times[$i]) {
2117 ++$dt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2121 if ($i > $#delivery_times) {
2123 ++$dt_remote_overflow if $message[$REMOTE_DELIVERED];
2126 #ENDIF ($#delivery_times > 0)
2130 elsif ($flag eq "->") {
2132 #IFDEF ($local_league_table || $include_remote_users)
2133 #IFDEF ($local_league_table && $include_remote_users)
2134 { #Store both local and remote users.
2135 #ENDIF ($local_league_table && $include_remote_users)
2137 #IFDEF ($local_league_table && ! $include_remote_users)
2138 if ($host eq "local") { #Store local users only.
2139 #ENDIF ($local_league_table && ! $include_remote_users)
2141 #IFDEF ($include_remote_users && ! $local_league_table)
2142 if ($host ne "local") { #Store remote users only.
2143 #ENDIF ($include_remote_users && ! $local_league_table)
2145 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2146 #IFDEF ($include_original_destination)
2148 #ENDIF ($include_original_destination)
2149 #IFNDEF ($include_original_destination)
2150 if ($user =~ /^[\\/|]/) {
2151 #ENDIF ($include_original_destination)
2152 my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2153 $user = "$user $parent" if defined $parent;
2155 ++$delivered_addresses_user{$user};
2158 #ENDIF ($local_league_table || $include_remote_users)
2160 #IFDEF ($do_sender{Host})
2161 $delivered_addresses{Host}{$host}++;
2162 #ENDIF ($do_sender{Host})
2163 #IFDEF ($do_sender{Domain})
2165 ++$delivered_addresses{Domain}{$domain};
2167 #ENDIF ($do_sender{Domain})
2168 #IFDEF ($do_sender{Email})
2169 ++$delivered_addresses{Email}{$email};
2170 #ENDIF ($do_sender{Email})
2171 #IFDEF ($do_sender{Edomain})
2172 ++$delivered_addresses{Edomain}{$edomain};
2173 #ENDIF ($do_sender{Edomain})
2175 ++$total_delivered_addresses;
2178 elsif ($flag eq "==" && defined($message[$SIZE]) && !defined($message[$DELAYED])) {
2180 $message[$DELAYED] = 1;
2183 elsif ($flag eq "**") {
2184 if (defined ($message[$SIZE])) {
2185 unless (defined $message[$HAD_ERROR]) {
2187 $message[$HAD_ERROR] = 1;
2191 #IFDEF ($show_errors)
2192 ++$errors_count{$_};
2193 #ENDIF ($show_errors)
2197 elsif ($flag eq "Co") {
2199 #IFDEF ($#queue_times >= 0)
2200 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2202 for ($i = 0; $i <= $#queue_times; $i++) {
2203 if ($queued < $queue_times[$i]) {
2205 ++$qt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2209 if ($i > $#queue_times) {
2211 ++$qt_remote_overflow if $message[$REMOTE_DELIVERED];
2213 #ENDIF ($#queue_times >= 0)
2215 #IFDEF ($#rcpt_times >= 0)
2217 $seconds = wdhms_seconds($1);
2218 #Calculate $queued if not previously calculated above.
2219 #IFNDEF ($#queue_times >= 0)
2220 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2221 #ENDIF ($#queue_times >= 0)
2222 $rcpt_time = $seconds - $queued;
2225 if (defined $message[$PROTOCOL]) {
2226 $protocol = $message[$PROTOCOL];
2228 # Create the bin if its not already defined.
2229 unless (exists $rcpt_times_bin{$protocol}) {
2230 initialise_rcpt_times($protocol);
2235 for ($i = 0; $i <= $#rcpt_times; ++$i) {
2236 if ($rcpt_time < $rcpt_times[$i]) {
2237 ++$rcpt_times_bin{all}[$i];
2238 ++$rcpt_times_bin{$protocol}[$i] if defined $protocol;
2243 if ($i > $#rcpt_times) {
2244 ++$rcpt_times_overflow{all};
2245 ++$rcpt_times_overflow{$protocol} if defined $protocol;
2248 #ENDIF ($#rcpt_times >= 0)
2250 delete($messages{$id});
2252 elsif ($flag eq "SA") {
2253 $ip = (/From.*?(\\[[^]]+\\])/ || /\\((local)\\)/) ? $1 : "";
2254 #SpamAssassin message
2255 if (/Action: ((permanently|temporarily) rejected message|flagged as Spam but accepted): score=(\d+\.\d)/) {
2256 #add_volume(\\$spam_score,\\$spam_score_gigs,$3);
2257 ++$spam_count_by_ip{$ip};
2258 } elsif (/Action: scanned but message isn\'t spam: score=(-?\d+\.\d)/) {
2259 #add_volume(\\$ham_score,\\$ham_score_gigs,$1);
2260 ++$ham_count_by_ip{$ip};
2261 } elsif (/(Not running SA because SAEximRunCond expanded to false|check skipped due to message size)/) {
2262 ++$ham_count_by_ip{$ip};
2266 # Look for Reject messages or blackholed messages (deliveries
2267 # without a transport)
2268 if ($flag eq "Re" || ($flag eq "=>" && ! /\\sT=\\S+/)) {
2269 # Correct the IP address for rejects:
2270 # rejected EHLO from my.test.net [10.0.0.5]: syntactically invalid argument(s):
2271 $ip = $1 if ($ip eq "local" && /^rejected [HE][HE]LO from .*? (\[.+?\]):/);
2272 ++$rejected_count_by_ip{$ip};
2274 /(listed at [^ ]+)/ ||
2275 /(Forged IP detected in HELO)/ ||
2276 /(Invalid domain or IP given in HELO\/EHLO)/ ||
2277 /(unqualified recipient rejected)/ ||
2278 /(closed connection (after|in response) .*?)\s*$/ ||
2279 /(sender rejected)/ ||
2280 # 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.
2281 # 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.
2282 / rejected after DATA: (.*)/ ||
2283 /.DATA ACL discarded recipients.: (.*)/ ||
2284 /rejected after DATA: (unqualified address not permitted)/ ||
2285 /(VRFY rejected)/ ||
2286 # /(sender verify (defer|fail))/i ||
2287 /(too many recipients)/ ||
2288 /(refused relay.*?) to/ ||
2289 /(rejected by non-SMTP ACL: .*)/ ||
2290 /(rejected by local_scan.*)/ ||
2291 # SMTP call from %s dropped: too many syntax or protocol errors (last command was "%s"
2292 # SMTP call from %s dropped: too many nonmail commands
2293 /(dropped: too many ((nonmail|unrecognized) commands|syntax or protocol errors))/ ||
2295 # local_scan() function crashed with signal %d - message temporarily rejected
2296 # local_scan() function timed out - message temporarily rejected
2297 /(local_scan.. function .* - message temporarily rejected)/ ||
2298 /(temporarily refused connection)/ ||
2299 # SMTP protocol synchronization error (input sent without waiting for greeting): rejected connection from %s
2300 /(SMTP protocol .*?(error|violation))/ ||
2303 ++$rejected_count_by_reason{"\u$1"};
2305 elsif (/rejected [HE][HE]LO from [^:]*: syntactically invalid argument/) {
2306 ++$rejected_count_by_reason{"Rejected HELO/EHLO: syntactically invalid argument"};
2308 elsif (/response to "RCPT TO.*? was: (.*)/) {
2309 ++$rejected_count_by_reason{"Response to RCPT TO was: $1"};
2312 /(lookup of host )\S+ (failed)/ ||
2314 # rejected from <%s>%s%s%s%s: message too big:
2315 /(rejected [A-Z]*) .*?(: .*?)(:|\s*$)/ ||
2316 # refused connection from %s (host_reject_connection)
2317 # refused connection from %s (tcp wrappers)
2318 /(refused connection )from.*? (\(.*)/ ||
2320 # 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
2321 # 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.
2322 /(error from remote mailer after .*?:).*(: .*?)(:|\s*$)/ ||
2324 # a.b.c F=<a@b.c> rejected after DATA: "@" or "." expected after "Undisclosed-Recipient": failing address in "To" header is: <Undisclosed-Recipient:;>
2325 /rejected after DATA: ("." or "." expected).*?(: failing address in .*? header)/ ||
2327 # connection from %s refused load average = %.2f
2328 /(Connection )from.*? (refused: load average)/ ||
2329 # connection from %s refused (IP options)
2330 # Connection from %s refused: too many connections
2331 # connection from %s refused
2332 /([Cc]onnection )from.*? (refused.*)/ ||
2333 # [10.0.0.1]: connection refused
2334 /: (Connection refused)()/
2336 ++$rejected_count_by_reason{"\u$1$2"};
2339 ++$rejected_count_by_reason{Unknown};
2340 print STDERR "Unknown rejection: $_" if $debug;
2345 # We now do a 'C preprocessor style operation on our parser
2346 # to remove bits not in use.
2347 my(%defines_in_operation,$removing_lines,$processed_parser);
2348 foreach (split (/\n/,$parser)) {
2349 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
2350 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
2351 $defines_in_operation{$1} = 1;
2352 $removing_lines = 1;
2355 # Convert constants.
2356 while (/(\$[A-Z][A-Z_]*)\b/) {
2357 my $constant = eval $1;
2358 s/(\$[A-Z][A-Z_]*)\b/$constant/;
2361 $processed_parser .= $_."\n" unless $removing_lines;
2363 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
2364 delete $defines_in_operation{$1};
2365 unless (keys %defines_in_operation) {
2366 $removing_lines = 0;
2370 print STDERR "# START OF PARSER:$processed_parser\n# END OF PARSER\n\n" if $debug;
2372 return $processed_parser;
2377 #######################################################################
2380 # parse($parser,\*FILEHANDLE);
2382 # This subroutine accepts a parser and a filehandle from main and parses each
2383 # line. We store the results into global variables.
2384 #######################################################################
2386 my($parser,$fh) = @_;
2388 if ($merge_reports) {
2389 parse_old_eximstat_reports($fh);
2400 #######################################################################
2405 # Print our headers and contents.
2406 #######################################################################
2410 my $title = "Exim statistics from $begin to $end";
2412 print $txt_fh "\n$title\n" if $txt_fh;
2414 print $htm_fh html_header($title);
2415 print $htm_fh "<ul>\n";
2416 print $htm_fh "<li><a href=\"#grandtotal\">Grand total summary</a>\n";
2417 print $htm_fh "<li><a href=\"#patterns\">User Specified Patterns</a>\n" if @user_patterns;
2418 print $htm_fh "<li><a href=\"#transport\">Deliveries by Transport</a>\n" if $show_transport;
2420 print $htm_fh "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
2421 print $htm_fh "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
2424 if ($#queue_times >= 0) {
2425 print $htm_fh "<li><a href=\"#Time spent on the queue all messages\">Time spent on the queue: all messages</a>\n";
2426 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";
2429 if ($#delivery_times >= 0) {
2430 print $htm_fh "<li><a href=\"#Delivery times all messages\">Delivery times: all messages</a>\n";
2431 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";
2434 if ($#rcpt_times >= 0) {
2435 print $htm_fh "<li><a href=\"#Receipt times all messages\">Receipt times</a>\n";
2438 print $htm_fh "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
2440 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;
2441 foreach ('Host','Domain','Email','Edomain') {
2442 next unless $do_sender{$_};
2443 print $htm_fh "<li><a href=\"#sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
2444 print $htm_fh "<li><a href=\"#sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
2446 if (($local_league_table || $include_remote_users) && %received_count_user) {
2447 print $htm_fh "<li><a href=\"#local sender count\">Top $topcount local senders by message count</a>\n";
2448 print $htm_fh "<li><a href=\"#local sender volume\">Top $topcount local senders by volume</a>\n";
2450 foreach ('Host','Domain','Email','Edomain') {
2451 next unless $do_sender{$_};
2452 print $htm_fh "<li><a href=\"#\l$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
2453 print $htm_fh "<li><a href=\"#\l$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
2455 if (($local_league_table || $include_remote_users) && %delivered_messages_user) {
2456 print $htm_fh "<li><a href=\"#local destination count\">Top $topcount local destinations by message count</a>\n";
2457 print $htm_fh "<li><a href=\"#local destination volume\">Top $topcount local destinations by volume</a>\n";
2460 print $htm_fh "<li><a href=\"#rejected ip count\">Top $topcount rejected ips by message count</a>\n" if %rejected_count_by_ip;
2461 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;
2464 print $htm_fh "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
2465 print $htm_fh "</ul>\n<hr>\n";
2469 $ws_global->write($row++, $col+0, "Exim Statistics", $f_header1);
2470 &set_worksheet_line($ws_global, $row, $col, ["from:", $begin, "to:", $end], $f_default);
2476 #######################################################################
2477 # print_grandtotals();
2479 # print_grandtotals();
2481 # Print the grand totals.
2482 #######################################################################
2483 sub print_grandtotals {
2485 # Get the sender by headings and results. This is complicated as we can have
2486 # different numbers of columns.
2487 my($sender_txt_header,$sender_txt_format,$sender_html_format);
2488 my(@received_totals,@delivered_totals);
2489 my($row_tablehead, $row_max);
2490 my(@col_headers) = ('TOTAL', 'Volume', 'Messages', 'Addresses');
2492 foreach ('Host','Domain','Email','Edomain') {
2493 next unless $do_sender{$_};
2494 if ($merge_reports) {
2495 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
2496 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
2499 push(@received_totals,scalar(keys %{$received_data{$_}}));
2500 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
2502 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
2503 $sender_html_format .= "<td align=\"right\">%d</td>";
2504 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6d";
2505 push(@col_headers,"${_}s");
2508 my $txt_format1 = " %-16s %9s %6d %6s $sender_txt_format";
2509 my $txt_format2 = " %6d %4.1f%% %6d %4.1f%%",
2510 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";
2511 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>";
2514 my $sender_spaces = " " x length($sender_txt_header);
2516 print $txt_fh "Grand total summary\n";
2517 print $txt_fh "-------------------\n";
2518 print $txt_fh " $sender_spaces At least one address\n";
2519 print $txt_fh " TOTAL Volume Messages Addresses $sender_txt_header Delayed Failed\n";
2522 print $htm_fh "<a name=\"grandtotal\"></a>\n";
2523 print $htm_fh "<h2>Grand total summary</h2>\n";
2524 print $htm_fh "<table border=1>\n";
2525 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";
2528 $ws_global->write($row++, 0, "Grand total summary", $f_header2);
2529 $ws_global->write($row, 0, \@col_headers, $f_header2);
2530 $ws_global->merge_range($row, scalar(@col_headers), $row, scalar(@col_headers)+1, "At least one addr Delayed", $f_header2_m);
2531 $ws_global->merge_range($row, scalar(@col_headers)+2, $row, scalar(@col_headers)+3, "At least one addr Failed", $f_header2_m);
2532 #$ws_global->write(++$row, scalar(@col_headers), ['Total','Percent','Total','Percent'], $f_header2);
2536 my($volume,$failed_count);
2537 if ($merge_reports) {
2538 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
2539 $total_received_count = get_report_total($report_totals{Received},'Messages');
2540 $failed_count = get_report_total($report_totals{Received},'Failed');
2541 $delayed_count = get_report_total($report_totals{Received},'Delayed');
2544 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
2545 $failed_count = $message_errors;
2552 $volume,$total_received_count,'',
2555 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
2557 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0
2560 printf $txt_fh ("$txt_format1$txt_format2\n", 'Received', @content) if $txt_fh;
2561 printf $htm_fh ("$htm_format1$htm_format2\n", 'Received', @content) if $htm_fh;
2563 $ws_global->write(++$row, 0, 'Received', $f_default);
2564 for (my $i=0; $i < scalar(@content); $i++) {
2565 if ($i == 4 || $i == 6) {
2566 $ws_global->write($row, $i+1, $content[$i]/100, $f_percent);
2569 $ws_global->write($row, $i+1, $content[$i], $f_default);
2575 if ($merge_reports) {
2576 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
2577 $total_delivered_messages = get_report_total($report_totals{Delivered},'Messages');
2578 $total_delivered_addresses = get_report_total($report_totals{Delivered},'Addresses');
2581 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
2584 my @content=($volume, $total_delivered_messages, $total_delivered_addresses, @delivered_totals);
2585 printf $txt_fh ("$txt_format1\n", 'Delivered', @content) if $txt_fh;
2586 printf $htm_fh ("$htm_format1\n", 'Delivered', @content) if $htm_fh;
2589 $ws_global->write(++$row, 0, 'Delivered', $f_default);
2590 for (my $i=0; $i < scalar(@content); $i++) {
2591 $ws_global->write($row, $i+1, $content[$i], $f_default);
2595 if ($merge_reports) {
2596 foreach ('Rejects', 'Ham', 'Spam') {
2597 my $messages = get_report_total($report_totals{$_},'Messages');
2598 my $addresses = get_report_total($report_totals{$_},'Addresses');
2600 @content = ($_, '', $messages, '');
2601 push(@content,get_report_total($report_totals{$_},'Hosts')) if $do_sender{Host};
2602 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2603 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2604 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2609 foreach my $total_aref (['Rejects',\%rejected_count_by_ip],
2610 ['Ham',\%ham_count_by_ip],
2611 ['Spam',\%spam_count_by_ip]) {
2613 map {$messages += $_} values %{$total_aref->[1]};
2615 if ($messages > 0) {
2616 @content = ($total_aref->[0], '', $messages, '');
2617 push(@content,scalar(keys %{$total_aref->[1]})) if $do_sender{Host};
2619 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2620 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2621 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2626 printf $txt_fh "\n" if $txt_fh;
2627 printf $htm_fh "</table>\n" if $htm_fh;
2632 #######################################################################
2633 # print_user_patterns()
2635 # print_user_patterns();
2637 # Print the counts of user specified patterns.
2638 #######################################################################
2639 sub print_user_patterns {
2640 my $txt_format1 = " %-18s %6d";
2641 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2644 print $txt_fh "User Specified Patterns\n";
2645 print $txt_fh "-----------------------";
2646 print $txt_fh "\n Total\n";
2649 print $htm_fh "<hr><a name=\"patterns\"></a><h2>User Specified Patterns</h2>\n";
2650 print $htm_fh "<table border=0 width=\"100%\">\n";
2651 print $htm_fh "<tr><td>\n";
2652 print $htm_fh "<table border=1>\n";
2653 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2656 $ws_global->write($row++, $col, "User Specified Patterns", $f_header2);
2657 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2662 if ($merge_reports) {
2663 # We are getting our data from previous reports.
2664 foreach $key (@user_descriptions) {
2665 my $count = get_report_total($report_totals{patterns}{$key},'Total');
2666 printf $txt_fh ("$txt_format1\n",$key,$count) if $txt_fh;
2667 printf $htm_fh ("$htm_format1\n",$key,$count) if $htm_fh;
2670 &set_worksheet_line($ws_global, $row++, 0, [$key,$count], $f_default);
2675 # We are getting our data from mainlog files.
2676 my $user_pattern_index = 0;
2677 foreach $key (@user_descriptions) {
2678 printf $txt_fh ("$txt_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $txt_fh;
2679 printf $htm_fh ("$htm_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $htm_fh;
2680 $ws_global->write($row++, 0, [$key,$user_pattern_totals[$user_pattern_index]]) if $xls_fh;
2681 $user_pattern_index++;
2684 print $txt_fh "\n" if $txt_fh;
2685 print $htm_fh "</table>\n\n" if $htm_fh;
2691 if ($hist_opt > 0) {
2692 my $user_pattern_index = 0;
2693 foreach $key (@user_descriptions) {
2694 print_histogram($key, 'occurence', @{$user_pattern_interval_count[$user_pattern_index]});
2695 $user_pattern_index++;
2700 #######################################################################
2705 # Print statistics about rejected mail.
2706 #######################################################################
2708 my($format1,$reason);
2710 my $txt_format1 = " %-40s %6d";
2711 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2714 print $txt_fh "Rejected mail by reason\n";
2715 print $txt_fh "-----------------------";
2716 print $txt_fh "\n Total\n";
2719 print $htm_fh "<hr><a name=\"patterns\"></a><h2>Rejected mail by reason</h2>\n";
2720 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2721 print $htm_fh "<tr><th> </th><th>Total</th>\n";
2724 $ws_global->write($row++, $col, "Rejected mail by reason", $f_header2);
2725 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2729 my $href = ($merge_reports) ? $report_totals{rejected_mail_by_reason} : \%rejected_count_by_reason;
2730 my(@chartdatanames, @chartdatavals_count);
2732 foreach $reason (top_n_sort($topcount, $href, undef, undef)) {
2733 printf $txt_fh ("$txt_format1\n",$reason,$href->{$reason}) if $txt_fh;
2734 printf $htm_fh ("$htm_format1\n",$reason,$href->{$reason}) if $htm_fh;
2735 set_worksheet_line($ws_global, $row++, 0, [$reason,$href->{$reason}], $f_default) if $xls_fh;
2736 push(@chartdatanames, $reason);
2737 push(@chartdatavals_count, $href->{$reason});
2741 print $txt_fh "\n" if $txt_fh;
2744 print $htm_fh "</tr></table></td><td>";
2745 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0)) {
2746 # calculate the graph
2749 \@chartdatavals_count
2751 my $graph = GD::Graph::pie->new(200, 200);
2753 x_label => 'Rejection Reasons',
2754 y_label => 'Messages',
2755 title => 'By count',
2757 my $gd = $graph->plot(\@data) or warn($graph->error);
2759 open(IMG, ">$chartdir/rejections_count.png") or die "Could not write $chartdir/rejections_count.png: $!\n";
2763 print $htm_fh "<img src=\"$chartrel/rejections_count.png\">";
2766 print $htm_fh "</td></tr></table>\n\n";
2774 #######################################################################
2775 # print_transport();
2777 # print_transport();
2779 # Print totals by transport.
2780 #######################################################################
2781 sub print_transport {
2782 my(@chartdatanames);
2783 my(@chartdatavals_count);
2784 my(@chartdatavals_vol);
2785 no integer; #Lose this for charting the data.
2787 my $txt_format1 = " %-18s %6s %6d";
2788 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
2791 print $txt_fh "Deliveries by transport\n";
2792 print $txt_fh "-----------------------";
2793 print $txt_fh "\n Volume Messages\n";
2796 print $htm_fh "<hr><a name=\"transport\"></a><h2>Deliveries by Transport</h2>\n";
2797 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2798 print $htm_fh "<tr><th> </th><th>Volume</th><th>Messages</th>\n";
2801 $ws_global->write(++$row, $col, "Deliveries by transport", $f_header2);
2802 $ws_global->write(++$row, 1, ["Volume", "Messages"], $f_headertab);
2806 if ($merge_reports) {
2807 # We are getting our data from previous reports.
2808 foreach $key (sort keys %{$report_totals{transport}}) {
2809 my $count = get_report_total($report_totals{transport}{$key},'Messages');
2810 my @content=($key, volume_rounded($report_totals{transport}{$key}{Volume},
2811 $report_totals{transport}{$key}{'Volume-gigs'}), $count);
2812 push(@chartdatanames, $key);
2813 push(@chartdatavals_count, $count);
2814 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
2815 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2816 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2817 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2821 # We are getting our data from mainlog files.
2822 foreach $key (sort keys %transported_data) {
2823 my @content=($key, volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
2824 $transported_count{$key});
2825 push(@chartdatanames, $key);
2826 push(@chartdatavals_count, $transported_count{$key});
2827 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
2828 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2829 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2830 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2833 print $txt_fh "\n" if $txt_fh;
2835 print $htm_fh "</tr></table></td><td>";
2837 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0))
2839 # calculate the graph
2842 \@chartdatavals_count
2844 my $graph = GD::Graph::pie->new(200, 200);
2846 x_label => 'Transport',
2847 y_label => 'Messages',
2848 title => 'By count',
2850 my $gd = $graph->plot(\@data) or warn($graph->error);
2852 open(IMG, ">$chartdir/transports_count.png") or die "Could not write $chartdir/transports_count.png: $!\n";
2856 print $htm_fh "<img src=\"$chartrel/transports_count.png\">";
2859 print $htm_fh "</td><td>";
2861 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_vol > 0)) {
2866 my $graph = GD::Graph::pie->new(200, 200);
2868 title => 'By volume',
2870 my $gd = $graph->plot(\@data) or warn($graph->error);
2872 open(IMG, ">$chartdir/transports_vol.png") or die "Could not write $chartdir/transports_vol.png: $!\n";
2876 print $htm_fh "<img src=\"$chartrel/transports_vol.png\">";
2880 print $htm_fh "</td></tr></table>\n\n";
2886 #######################################################################
2891 # Print our totals by relay.
2892 #######################################################################
2894 my $row_print_relay=1;
2895 my $temp = "Relayed messages";
2896 print $htm_fh "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $htm_fh;
2897 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
2900 my $txt_format = "%7d %s\n => %s\n";
2901 my $htm_format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
2903 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2905 print $htm_fh "<table border=1>\n";
2906 print $htm_fh "<tr><th>Count</th><th>From</th><th>To</th>\n";
2909 $ws_relayed->write($row_print_relay++, $col, $temp, $f_header2);
2910 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, ["Count", "From", "To"], $f_headertab);
2915 foreach $key (sort keys %relayed) {
2916 my $count = $relayed{$key};
2919 my($one,$two) = split(/=> /, $key);
2920 my @content=($count, $one, $two);
2921 printf $txt_fh ($txt_format, @content) if $txt_fh;
2922 printf $htm_fh ($htm_format, @content) if $htm_fh;
2925 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, \@content);
2930 print $htm_fh "</table>\n<p>\n" if $htm_fh;
2931 print $txt_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $txt_fh;
2932 print $htm_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $htm_fh;
2935 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$shown, "Sum of shown" ]);
2936 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$relayed_unshown, "unshown"]);
2941 print $txt_fh "No relayed messages\n-------------------\n\n" if $txt_fh;
2942 print $htm_fh "No relayed messages\n\n" if $htm_fh;
2952 #######################################################################
2957 # Print our errors. In HTML, we display them as a list rather than a table -
2958 # Netscape doesn't like large tables!
2959 #######################################################################
2961 my $total_errors = 0;
2964 if (scalar(keys %errors_count) != 0) {
2965 my $temp = "List of errors";
2966 my $htm_format = "<li>%d - %s\n";
2968 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
2970 print $htm_fh "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
2971 print $htm_fh "<ul><li><b>Count - Error</b>\n";
2975 $ws_errors->write($row++, 0, $temp, $f_header2);
2976 &set_worksheet_line($ws_errors, $row++, 0, ["Count", "Error"], $f_headertab);
2981 foreach $key (sort keys %errors_count) {
2984 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
2985 $total_errors += $errors_count{$key};
2988 printf $txt_fh ("%5d ", $errors_count{$key});
2989 my $text_remaining = $text;
2990 while (length($text_remaining) > 65) {
2991 my($first,$rest) = $text_remaining =~ /(.{50}\S*)\s+(.+)/;
2993 printf $txt_fh ("%s\n\t ", $first);
2994 $text_remaining = $rest;
2996 printf $txt_fh ("%s\n\n", $text_remaining);
3001 #Translate HTML tag characters. Sergey Sholokh.
3002 $text =~ s/\</\<\;/g;
3003 $text =~ s/\>/\>\;/g;
3005 printf $htm_fh ($htm_format,$errors_count{$key},$text);
3009 &set_worksheet_line($ws_errors, $row++, 0, [$errors_count{$key},$text]);
3013 $temp = "Errors encountered: $total_errors";
3016 print $txt_fh $temp, "\n";
3017 print $txt_fh "-" x length($temp),"\n";
3020 print $htm_fh "</ul>\n<p>\n";
3021 print $htm_fh $temp, "\n";
3025 &set_worksheet_line($ws_errors, $row++, 0, [$total_errors, "Sum of Errors encountered"]);
3032 #######################################################################
3033 # parse_old_eximstat_reports();
3035 # parse_old_eximstat_reports($fh);
3037 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
3039 # To test that the merging still works after changes, do something like the following.
3040 # All the diffs should produce no output.
3042 # options='-bydomain -byemail -byhost -byedomain'
3043 # options="$options -show_rt1,2,4 -show_dt 1,2,4"
3044 # options="$options -pattern 'Completed Messages' /Completed/"
3045 # options="$options -pattern 'Received Messages' /<=/"
3047 # ./eximstats $options mainlog > mainlog.txt
3048 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
3049 # diff mainlog.txt mainlog.2.txt
3051 # ./eximstats $options -html mainlog > mainlog.html
3052 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
3053 # diff mainlog.html mainlog.2.html
3055 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
3056 # diff mainlog.txt mainlog.3.txt
3058 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
3059 # diff mainlog.html mainlog.3.html
3061 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
3062 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
3063 # diff mainlog.txt mainlog.4.txt
3065 # # double_mainlog.txt should have twice the values that mainlog.txt has.
3066 # ./eximstats $options mainlog mainlog > double_mainlog.txt
3067 #######################################################################
3068 sub parse_old_eximstat_reports {
3071 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
3073 my(%user_pattern_index);
3074 my $user_pattern_index = 0;
3075 map {$user_pattern_index{$_} = $user_pattern_index++} @user_descriptions;
3076 my $user_pattern_keys = join('|', @user_descriptions);
3079 PARSE_OLD_REPORT_LINE:
3080 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
3081 $begin = $1 if ($1 lt $begin);
3082 $end = $3 if ($3 gt $end);
3084 elsif (/Grand total summary/) {
3085 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Addresses|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
3086 my(@fields, @delivered_fields);
3087 my $doing_table = 0;
3089 $_ = html2txt($_); #Convert general HTML markup to text.
3090 s/At least one addr//g; #Another part of the HTML output we don't want.
3092 # TOTAL Volume Messages Addresses Hosts Domains Delayed Failed
3093 # Received 26MB 237 177 23 8 3.4% 28 11.8%
3094 # Delivered 13MB 233 250 99 88
3095 if (/TOTAL\s+(.*?)\s*$/) {
3097 @delivered_fields = split(/\s+/,$1);
3099 #Delayed and Failed have two columns each, so add the extra field names in.
3100 splice(@delivered_fields,-1,1,'DelayedPercent','Failed','FailedPercent');
3102 # Addresses only figure in the Delivered row, so remove them from the
3104 @fields = grep !/Addresses/, @delivered_fields;
3106 elsif (/(Received)\s+(.*?)\s*$/) {
3107 print STDERR "Parsing $_" if $debug;
3108 add_to_totals($report_totals{$1},\@fields,$2);
3110 elsif (/(Delivered)\s+(.*?)\s*$/) {
3111 print STDERR "Parsing $_" if $debug;
3112 add_to_totals($report_totals{$1},\@delivered_fields,$2);
3114 # If we're merging an old report which doesn't include addresses,
3115 # then use the Messages field instead.
3116 unless (grep(/Addresses/, @delivered_fields)) {
3118 line_to_hash(\%tmp,\@delivered_fields,$data);
3119 add_to_totals($report_totals{Delivered},['Addresses'],$tmp{Messages});
3122 elsif (/(Rejects|Ham|Spam)\s+(.*?)\s*$/) {
3123 print STDERR "Parsing $_" if $debug;
3124 add_to_totals($report_totals{$1},['Messages','Hosts'],$2);
3127 last if $doing_table;
3132 elsif (/User Specified Patterns/i) {
3133 #User Specified Patterns
3134 #-----------------------
3138 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
3140 print STDERR "Parsing $_" if $debug;
3141 $_ = html2txt($_); #Convert general HTML markup to text.
3142 if (/^\s*(.*?)\s+(\d+)\s*$/) {
3143 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
3144 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
3146 last if (/^\s*$/); #Finished if we have a blank line.
3150 elsif (/(^|<h2>)($user_pattern_keys) per /o) {
3151 # Parse User defined pattern histograms if they exist.
3152 parse_histogram($fh, $user_pattern_interval_count[$user_pattern_index{$2}] );
3156 elsif (/Deliveries by transport/i) {
3157 #Deliveries by transport
3158 #-----------------------
3160 # :blackhole: 70KB 51
3161 # address_pipe 655KB 1
3164 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
3166 print STDERR "Parsing $_" if $debug;
3167 $_ = html2txt($_); #Convert general HTML markup to text.
3168 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
3169 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
3170 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
3172 last if (/^\s*$/); #Finished if we have a blank line.
3175 elsif (/Messages received per/) {
3176 parse_histogram($fh, \@received_interval_count);
3178 elsif (/Deliveries per/) {
3179 parse_histogram($fh, \@delivered_interval_count);
3182 #elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
3183 elsif (/(Time spent on the queue|Delivery times|Receipt times): ((\S+) messages|messages with at least one remote delivery)((<[^>]*>)*\s*)$/) {
3184 #Time spent on the queue: all messages
3185 #-------------------------------------
3187 #Under 1m 217 91.9% 91.9%
3193 # Set a pointer to the queue bin so we can use the same code
3194 # block for both all messages and remote deliveries.
3195 #my $bin_aref = ($1 eq 'all messages') ? \@qt_all_bin : \@qt_remote_bin;
3196 my($bin_aref, $times_aref, $overflow_sref);
3197 if ($1 eq 'Time spent on the queue') {
3198 $times_aref = \@queue_times;
3199 if ($2 eq 'all messages') {
3200 $bin_aref = \@qt_all_bin;
3201 $overflow_sref = \$qt_all_overflow;
3204 $bin_aref = \@qt_remote_bin;
3205 $overflow_sref = \$qt_remote_overflow;
3208 elsif ($1 eq 'Delivery times') {
3209 $times_aref = \@delivery_times;
3210 if ($2 eq 'all messages') {
3211 $bin_aref = \@dt_all_bin;
3212 $overflow_sref = \$dt_all_overflow;
3215 $bin_aref = \@dt_remote_bin;
3216 $overflow_sref = \$dt_remote_overflow;
3220 unless (exists $rcpt_times_bin{$3}) {
3221 initialise_rcpt_times($3);
3223 $bin_aref = $rcpt_times_bin{$3};
3224 $times_aref = \@rcpt_times;
3225 $overflow_sref = \$rcpt_times_overflow{$3};
3229 my ($blank_lines, $reached_table) = (0,0);
3231 $_ = html2txt($_); #Convert general HTML markup to text.
3232 # The table is preceded by one blank line, and has one blank line
3233 # following it. As the table may be empty, the best way to determine
3234 # that we've finished it is to look for the second blank line.
3235 ++$blank_lines if /^\s*$/;
3236 last if ($blank_lines >=2); #Finished the table ?
3237 $reached_table = 1 if (/\d/);
3238 next unless $reached_table;
3239 my $previous_seconds_on_queue = 0;
3240 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
3241 print STDERR "Parsing $_" if $debug;
3242 my($modifier,$formated_time,$count) = ($1,$2,$3);
3243 my $seconds = unformat_time($formated_time);
3244 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
3245 $previous_seconds_on_queue = $seconds;
3246 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
3248 for ($i = 0; $i <= $#$times_aref; $i++) {
3249 if ($time_on_queue < $times_aref->[$i]) {
3250 $$bin_aref[$i] += $count;
3254 $$overflow_sref += $count if ($i > $#$times_aref);
3260 elsif (/Relayed messages/) {
3264 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
3265 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
3267 #<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>
3269 my $reached_table = 0;
3272 unless ($reached_table) {
3273 last if (/No relayed messages/);
3274 $reached_table = 1 if (/^\s*\d/ || />\d+</);
3275 next unless $reached_table;
3277 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
3278 update_relayed($1,$2,$3);
3280 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
3281 ($count,$sender) = ($1,$2);
3283 elsif (/=>\s+(.*?)\s*$/) {
3284 update_relayed($count,$sender,$1);
3287 last; #Finished the table ?
3292 elsif (/Top (.*?) by (message count|volume)/) {
3293 #Top 50 sending hosts by message count
3294 #-------------------------------------
3297 # Could also have average values for HTML output.
3298 # 48 1468KB 30KB local
3300 my($category,$by_count_or_volume) = ($1,$2);
3302 #As we show 2 views of each table (by count and by volume),
3303 #most (but not all) entries will appear in both tables.
3304 #Set up a hash to record which entries we have already seen
3305 #and one to record which ones we are seeing for the first time.
3306 if ($by_count_or_volume =~ /count/) {
3307 undef %league_table_value_entered;
3308 undef %league_table_value_was_zero;
3312 #As this section processes multiple different table categories,
3313 #set up pointers to the hashes to be updated.
3314 my($messages_href,$addresses_href,$data_href,$data_gigs_href);
3315 if ($category =~ /local sender/) {
3316 $messages_href = \%received_count_user;
3317 $addresses_href = undef;
3318 $data_href = \%received_data_user;
3319 $data_gigs_href = \%received_data_gigs_user;
3321 elsif ($category =~ /sending (\S+?)s?\b/) {
3322 #Top 50 sending (host|domain|email|edomain)s
3323 #Top sending (host|domain|email|edomain)
3324 $messages_href = \%{$received_count{"\u$1"}};
3325 $data_href = \%{$received_data{"\u$1"}};
3326 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
3328 elsif ($category =~ /local destination/) {
3329 $messages_href = \%delivered_messages_user;
3330 $addresses_href = \%delivered_addresses_user;
3331 $data_href = \%delivered_data_user;
3332 $data_gigs_href = \%delivered_data_gigs_user;
3334 elsif ($category =~ /(\S+) destination/) {
3335 #Top 50 (host|domain|email|edomain) destinations
3336 #Top (host|domain|email|edomain) destination
3337 $messages_href = \%{$delivered_messages{"\u$1"}};
3338 $addresses_href = \%{$delivered_addresses{"\u$1"}};
3339 $data_href = \%{$delivered_data{"\u$1"}};
3340 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
3342 elsif ($category =~ /rejected ips/) {
3343 $messages_href = \%rejected_count_by_ip;
3345 elsif ($category =~ /non-rejected spamming ips/) {
3346 $messages_href = \%spam_count_by_ip;
3348 elsif ($category =~ /mail rejection reasons/) {
3349 $messages_href = \%rejected_count_by_reason;
3352 my $reached_table = 0;
3355 # Watch out for empty tables.
3356 goto PARSE_OLD_REPORT_LINE if (/<h2>/ or (/^\s*[a-zA-Z]/ && !/^\s*Messages/));
3358 $_ = html2txt($_); #Convert general HTML markup to text.
3360 # Messages Addresses Bytes Average
3361 if (/^\s*Messages/) {
3362 my $pattern = '^\s*(\d+)';
3363 $pattern .= (/Addresses/) ? '\s+(\d+)' : '()';
3364 $pattern .= (/Bytes/) ? '\s+([\dKMGB]+)' : '()';
3365 $pattern .= (/Average/) ? '\s+[\dKMGB]+' : '';
3366 $pattern .= '\s+(.*?)\s*$';
3367 $row_re = qr/$pattern/;
3371 next unless $reached_table;
3373 my($messages, $addresses, $rounded_volume, $entry);
3376 ($messages, $addresses, $rounded_volume, $entry) = ($1, $2, $3, $4);
3379 #Else we have finished the table and we may need to do some
3380 #kludging to retain the order of the entries.
3382 if ($by_count_or_volume =~ /volume/) {
3383 #Add a few bytes to appropriate entries to preserve the order.
3384 foreach $rounded_volume (keys %table_order) {
3385 #For each rounded volume, we want to create a list which has things
3386 #ordered from the volume table at the front, and additional things
3387 #from the count table ordered at the back.
3388 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
3389 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
3391 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
3392 @order = @{$table_order{$rounded_volume}{volume}};
3393 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
3395 my $bonus_bytes = $#order;
3396 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
3397 while (@order and ($bonus_bytes > 0)) {
3398 my $entry = shift(@order);
3399 if ($league_table_value_was_zero{$entry}) {
3400 $$data_href{$entry} += $bonus_bytes;
3401 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
3410 # Store a new table entry.
3412 # Add the entry into the %table_order hash if it has a rounded
3413 # volume (KB/MB/GB).
3414 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
3416 unless ($league_table_value_entered{$entry}) {
3417 $league_table_value_entered{$entry} = 1;
3418 unless ($$messages_href{$entry}) {
3419 $$messages_href{$entry} = 0;
3420 $$addresses_href{$entry} = 0;
3421 $$data_href{$entry} = 0;
3422 $$data_gigs_href{$entry} = 0;
3423 $league_table_value_was_zero{$entry} = 1;
3426 $$messages_href{$entry} += $messages;
3428 # When adding the addresses, be aware that we could be merging
3429 # an old report which does not include addresses. In this case,
3430 # we add the messages instead.
3431 $$addresses_href{$entry} += ($addresses) ? $addresses : $messages;
3433 #Add the rounded value to the data and data_gigs hashes.
3434 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry}) if $rounded_volume;
3435 print STDERR "$category by $by_count_or_volume: added $messages,$rounded_volume to $entry\n" if $debug;
3440 elsif (/List of errors/) {
3444 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
3445 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
3446 # host mail.one2one.net [193.133.192.24]: 550 User unknown
3448 #<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>
3451 my $reached_table = 0;
3452 my($count,$error,$blanks);
3454 $reached_table = 1 if (/^( *|<li>)(\d+)/);
3455 next unless $reached_table;
3457 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
3458 $_ = html2txt($_); #Convert general HTML markup to text.
3461 $error .= ' ' . $1; #Join a multiline error.
3463 elsif (/^\s*(\d+)\s+(.*)/) {
3465 #Finished with a previous multiline error so save it.
3466 $errors_count{$error} = 0 unless $errors_count{$error};
3467 $errors_count{$error} += $count;
3469 ($count,$error) = ($1,$2);
3471 elsif (/Errors encountered/) {
3473 #Finished the section, so save our stored last error.
3474 $errors_count{$error} = 0 unless $errors_count{$error};
3475 $errors_count{$error} += $count;
3485 #######################################################################
3486 # parse_histogram($fh, \@delivered_interval_count);
3487 # Parse a histogram into the provided array of counters.
3488 #######################################################################
3489 sub parse_histogram {
3490 my($fh, $counters_aref) = @_;
3492 # Messages received per hour (each dot is 2 messages)
3493 #---------------------------------------------------
3495 #00-01 106 .....................................................
3496 #01-02 103 ...................................................
3498 my $reached_table = 0;
3500 $reached_table = 1 if (/^00/);
3501 next unless $reached_table;
3502 print STDERR "Parsing $_" if $debug;
3503 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
3504 $$counters_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
3506 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
3507 $$counters_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
3509 else { #Finished the table ?
3516 #######################################################################
3519 # update_relayed($count,$sender,$recipient);
3521 # Adds an entry into the %relayed hash. Currently only used when
3523 #######################################################################
3524 sub update_relayed {
3525 my($count,$sender,$recipient) = @_;
3527 #When generating the key, put in the 'H=' and 'A=' which can be used
3529 my $key = "H=$sender => H=$recipient";
3530 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
3531 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
3532 $relayed{$key} = 0 if !defined $relayed{$key};
3533 $relayed{$key} += $count;
3536 $relayed_unshown += $count;
3541 #######################################################################
3544 # add_to_totals(\%totals,\@keys,$values);
3546 # Given a line of space seperated values, add them into the provided hash using @keys
3549 # If the value contains a '%', then the value is set rather than added. Otherwise, we
3550 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
3551 #######################################################################
3553 my($totals_href,$keys_aref,$values) = @_;
3554 my(@values) = split(/\s+/,$values);
3556 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3557 my $key = $keys_aref->[$i];
3558 if ($values[$i] =~ /%/) {
3559 $$totals_href{$key} = $values[$i];
3562 $$totals_href{$key} = 0 unless ($$totals_href{$key});
3563 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
3564 un_round($values[$i], \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
3565 print STDERR "Added $values[$i] to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
3571 #######################################################################
3574 # line_to_hash(\%hash,\@keys,$line);
3576 # Given a line of space seperated values, set them into the provided hash
3577 # using @keys as the hash keys.
3578 #######################################################################
3580 my($href,$keys_aref,$values) = @_;
3581 my(@values) = split(/\s+/,$values);
3582 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3583 $$href{$keys_aref->[$i]} = $values[$i];
3588 #######################################################################
3589 # get_report_total();
3591 # $total = get_report_total(\%hash,$key);
3593 # If %hash contains values split into Units and Gigs, we calculate and return
3595 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
3596 #######################################################################
3597 sub get_report_total {
3599 my($hash_ref,$key) = @_;
3600 if ($$hash_ref{"${key}-gigs"}) {
3601 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
3603 return $$hash_ref{$key} || 0;
3606 #######################################################################
3609 # $text_line = html2txt($html_line);
3611 # Convert a line from html to text. Currently we just convert HTML tags to spaces
3612 # and convert >, <, and tags back.
3613 #######################################################################
3617 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
3618 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
3619 # (the ones used by this program). If someone is careless enough to have their
3620 # Userid the same as an HTML tag, there's not much we can do about it.
3621 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /g;
3623 s/\<\;/\</og; #Convert '<' to '<'.
3624 s/\>\;/\>/og; #Convert '>' to '>'.
3625 s/\ \;/ /og; #Convert ' ' to ' '.
3629 #######################################################################
3632 # $arg = get_next_arg();
3634 # Because eximstats arguments are often passed as variables,
3635 # we can't rely on shell parsing to deal with quotes. This
3636 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
3637 # starts with a quote (' or "), and doesn't end in one, then
3638 # we append the next argument to it and shift again. We repeat
3639 # until we've got all of the argument.
3641 # This isn't perfect as all white space gets reduced to one space,
3642 # but it's as good as we can get! If it's esential that spacing
3643 # be preserved precisely, then you get that by not using shell
3645 #######################################################################
3648 my $matched_pattern = 0;
3650 $arg .= ' ' if $arg;
3651 $arg .= $ARGV[1]; shift(@ARGV);
3652 if ($arg !~ /^['"]/) {
3653 $matched_pattern = 1;
3656 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
3657 $matched_pattern = 1;
3661 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
3665 #######################################################################
3666 # set_worksheet_line($ws_global, $startrow, $startcol, \@content, $format);
3668 # set values to a sequence of cells in a row.
3670 #######################################################################
3671 sub set_worksheet_line {
3672 my ($worksheet, $row, $col, $content, $format) = @_;
3674 foreach my $token (@$content)
3676 $worksheet->write($row, $col++, $token, $format );
3681 #######################################################################
3682 # @rcpt_times = parse_time_list($string);
3684 # Parse a comma seperated list of time values in seconds given by
3685 # the user and fill an array.
3687 # Return a default list if $string is undefined.
3688 # Return () if $string eq '0'.
3689 #######################################################################
3690 sub parse_time_list {
3692 if (! defined $string) {
3693 return(60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60, 12*60*60, 24*60*60);
3695 my(@times) = split(/,/, $string);
3696 foreach my $q (@times) { $q = eval($q) + 0 }
3697 @times = sort { $a <=> $b } @times;
3698 @times = () if ($#times == 0 && $times[0] == 0);
3703 #######################################################################
3704 # initialise_rcpt_times($protocol);
3705 # Initialise an array of rcpt_times to 0 for the specified protocol.
3706 #######################################################################
3707 sub initialise_rcpt_times {
3709 for (my $i = 0; $i <= $#rcpt_times; ++$i) {
3710 $rcpt_times_bin{$protocol}[$i] = 0;
3712 $rcpt_times_overflow{$protocol} = 0;
3716 ##################################################
3718 ##################################################
3721 $last_timestamp = '';
3725 $show_transport = 1;
3727 $local_league_table = 1;
3728 $include_remote_users = 0;
3729 $include_original_destination = 0;
3731 $volume_rounding = 1;
3732 $localtime_offset = calculate_localtime_offset(); # PH/FANF
3735 $charts_option_specified = 0;
3739 @queue_times = parse_time_list();
3741 @delivery_times = ();
3744 $offset_seconds = 0;
3750 my(%output_files); # What output files have been specified?
3754 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-') {
3755 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
3756 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
3757 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/) {
3758 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
3760 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/) { @queue_times = parse_time_list($1) }
3761 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
3762 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
3764 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
3766 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
3767 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
3768 elsif ($ARGV[0] =~ /^-txt=?(\S*)$/) { $txt_fh = get_filehandle($1,\%output_files) }
3769 elsif ($ARGV[0] =~ /^-html=?(\S*)$/) { $htm_fh = get_filehandle($1,\%output_files) }
3770 elsif ($ARGV[0] =~ /^-xls=?(\S*)$/) {
3771 if ($HAVE_Spreadsheet_WriteExcel) {
3772 $xls_fh = get_filehandle($1,\%output_files);
3775 warn "WARNING: CPAN Module Spreadsheet::WriteExcel not installed. Obtain from www.cpan.org\n";
3778 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
3779 elsif ($ARGV[0] =~ /^-charts$/) {
3781 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
3782 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
3784 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
3785 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
3786 elsif ($ARGV[0] =~ /^-include_original_destination$/) { $include_original_destination = 1 }
3787 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
3788 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
3789 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
3790 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
3791 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
3792 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
3793 elsif ($ARGV[0] =~ /^-emptyok$/) { $emptyOK = 1 }
3794 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
3795 elsif ($ARGV[0] =~ /^-show_rt([,\d\+\-\*\/]+)?$/) { @rcpt_times = parse_time_list($1) }
3796 elsif ($ARGV[0] =~ /^-show_dt([,\d\+\-\*\/]+)?$/) { @delivery_times = parse_time_list($1) }
3797 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
3798 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
3799 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
3800 elsif ($ARGV[0] =~ /^-pattern$/)
3802 push(@user_descriptions,get_next_arg());
3803 push(@user_patterns,get_next_arg());
3805 elsif ($ARGV[0] =~ /^-utc$/)
3807 # We don't need this value if the log is in UTC.
3808 $localtime_offset = undef;
3812 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
3818 # keep old default behaviour
3819 if (! ($xls_fh or $htm_fh or $txt_fh)) {
3823 # Check that all the charts options are specified.
3824 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
3826 # Default to display tables by sending Host.
3827 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
3829 # prepare xls Excel Workbook
3830 if (defined $xls_fh) {
3832 # Create a new Excel workbook
3833 $workbook = Spreadsheet::WriteExcel->new($xls_fh);
3836 $ws_global = $workbook->addworksheet('Exim Statistik');
3837 # show $ws_global as initial sheet
3838 $ws_global->set_first_sheet();
3839 $ws_global->activate();
3842 $ws_relayed = $workbook->addworksheet('Relayed Messages');
3843 $ws_relayed->set_column(1, 2, 80);
3846 $ws_errors = $workbook->addworksheet('Errors');
3851 $ws_global->set_column(0, 2, 20); # Columns B-D width set to 30
3852 $ws_global->set_column(3, 3, 15); # Columns B-D width set to 30
3853 $ws_global->set_column(4, 4, 25); # Columns B-D width set to 30
3856 $f_default = $workbook->add_format();
3858 $f_header1 = $workbook->add_format();
3859 $f_header1->set_bold();
3860 #$f_header1->set_color('red');
3861 $f_header1->set_size('15');
3862 $f_header1->set_valign();
3863 # $f_header1->set_align('center');
3864 # $ws_global->write($row++, 2, "Testing Headers 1", $f_header1);
3866 $f_header2 = $workbook->add_format();
3867 $f_header2->set_bold();
3868 $f_header2->set_size('12');
3869 $f_header2->set_valign();
3870 # $ws_global->write($row++, 2, "Testing Headers 2", $f_header2);
3872 # Create another header2 for use in merged cells.
3873 $f_header2_m = $workbook->add_format();
3874 $f_header2_m->set_bold();
3875 $f_header2_m->set_size('8');
3876 $f_header2_m->set_valign();
3877 $f_header2_m->set_align('center');
3879 $f_percent = $workbook->add_format();
3880 $f_percent->set_num_format('0.0%');
3882 $f_headertab = $workbook->add_format();
3883 $f_headertab->set_bold();
3884 $f_headertab->set_valign();
3885 # $ws_global->write($row++, 2, "Testing Headers tab", $f_headertab);
3890 # Initialise the queue/delivery/rcpt time counters.
3891 for (my $i = 0; $i <= $#queue_times; $i++) {
3892 $qt_all_bin[$i] = 0;
3893 $qt_remote_bin[$i] = 0;
3895 for (my $i = 0; $i <= $#delivery_times; $i++) {
3896 $dt_all_bin[$i] = 0;
3897 $dt_remote_bin[$i] = 0;
3899 initialise_rcpt_times('all');
3902 # Compute the number of slots for the histogram
3905 if ($hist_opt > 60 || 60 % $hist_opt != 0)
3907 print STDERR "Eximstats: -h must specify a factor of 60\n";
3910 $hist_interval = 60/$hist_opt; #Interval in minutes.
3911 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
3912 @received_interval_count = (0) x $hist_number;
3913 @delivered_interval_count = (0) x $hist_number;
3914 my $user_pattern_index = 0;
3915 for (my $user_pattern_index = 0; $user_pattern_index <= $#user_patterns; ++$user_pattern_index) {
3916 @{$user_pattern_interval_count[$user_pattern_index]} = (0) x $hist_number;
3918 @dt_all_bin = (0) x $hist_number;
3919 @dt_remote_bin = (0) x $hist_number;
3922 #$queue_unknown = 0;
3924 $total_received_data = 0;
3925 $total_received_data_gigs = 0;
3926 $total_received_count = 0;
3928 $total_delivered_data = 0;
3929 $total_delivered_data_gigs = 0;
3930 $total_delivered_messages = 0;
3931 $total_delivered_addresses = 0;
3933 $qt_all_overflow = 0;
3934 $qt_remote_overflow = 0;
3935 $dt_all_overflow = 0;
3936 $dt_remote_overflow = 0;
3938 $relayed_unshown = 0;
3939 $message_errors = 0;
3940 $begin = "9999-99-99 99:99:99";
3941 $end = "0000-00-00 00:00:00";
3943 foreach $section ('Received','Delivered','Rejects','Ham','Spam') {
3944 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
3945 $report_totals{$section}{$type} = 0;
3949 # Generate our parser.
3950 my $parser = generate_parser();
3955 # Scan the input files and collect the data
3956 foreach my $file (@ARGV) {
3957 if ($file =~ /\.gz/) {
3958 unless (open(FILE,"gunzip -c $file |")) {
3959 print STDERR "Failed to gunzip -c $file: $!";
3963 elsif ($file =~ /\.Z/) {
3964 unless (open(FILE,"uncompress -c $file |")) {
3965 print STDERR "Failed to uncompress -c $file: $!";
3970 unless (open(FILE,$file)) {
3971 print STDERR "Failed to read $file: $!";
3975 #Now parse the filehandle, updating the global variables.
3976 parse($parser,\*FILE);
3981 #No files provided. Parse STDIN, updating the global variables.
3982 parse($parser,\*STDIN);
3986 if ($begin eq "9999-99-99 99:99:99" && ! $emptyOK) {
3987 print STDERR "**** No valid log lines read\n";
3991 # Output our results.
3993 print_grandtotals();
3995 # Print counts of user specified patterns if required.
3996 print_user_patterns() if @user_patterns;
3998 # Print rejection reasons.
4001 # Print totals by transport if required.
4002 print_transport() if $show_transport;
4004 # Print the deliveries per interval as a histogram, unless configured not to.
4005 # First find the maximum in one interval and scale accordingly.
4006 if ($hist_opt > 0) {
4007 print_histogram("Messages received", 'message', @received_interval_count);
4008 print_histogram("Deliveries", 'delivery', @delivered_interval_count);
4011 # Print times on queue if required.
4012 if ($#queue_times >= 0) {
4013 print_duration_table("Time spent on the queue", "all messages", \@queue_times, \@qt_all_bin,$qt_all_overflow);
4014 print_duration_table("Time spent on the queue", "messages with at least one remote delivery", \@queue_times, \@qt_remote_bin,$qt_remote_overflow);
4017 # Print delivery times if required.
4018 if ($#delivery_times >= 0) {
4019 print_duration_table("Delivery times", "all messages", \@delivery_times, \@dt_all_bin,$dt_all_overflow);
4020 print_duration_table("Delivery times", "messages with at least one remote delivery", \@delivery_times, \@dt_remote_bin,$dt_remote_overflow);
4023 # Print rcpt times if required.
4024 if ($#rcpt_times >= 0) {
4025 foreach my $protocol ('all', grep(!/^all$/, sort keys %rcpt_times_bin)) {
4026 print_duration_table("Receipt times", "$protocol messages", \@rcpt_times, $rcpt_times_bin{$protocol}, $rcpt_times_overflow{$protocol});
4030 # Print relay information if required.
4031 print_relay() if $show_relay;
4033 # Print the league tables, if topcount isn't zero.
4034 if ($topcount > 0) {
4035 my($ws_rej, $ws_top50, $ws_rej_row, $ws_top50_row);
4036 $ws_rej_row = $ws_top50_row = 0;
4038 $ws_top50 = $workbook->addworksheet('Deliveries');
4039 $ws_rej = $workbook->addworksheet('Rejections') if (%rejected_count_by_reason || %rejected_count_by_ip || %spam_count_by_ip);
4042 print_league_table("mail rejection reason", \%rejected_count_by_reason, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_reason;
4044 foreach ('Host','Domain','Email','Edomain') {
4045 next unless $do_sender{$_};
4046 print_league_table("sending \l$_", $received_count{$_}, undef, $received_data{$_},$received_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4049 print_league_table("local sender", \%received_count_user, undef,
4050 \%received_data_user,\%received_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %received_count_user);
4051 foreach ('Host','Domain','Email','Edomain') {
4052 next unless $do_sender{$_};
4053 print_league_table("\l$_ destination", $delivered_messages{$_}, $delivered_addresses{$_}, $delivered_data{$_},$delivered_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4055 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);
4057 print_league_table("rejected ip", \%rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_ip;
4058 print_league_table("non-rejected spamming ip", \%spam_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %spam_count_by_ip;
4062 # Print the error statistics if required.
4063 print_errors() if $show_errors;
4065 print $htm_fh "</body>\n</html>\n" if $htm_fh;
4068 $txt_fh->close if $txt_fh && ref $txt_fh;
4069 $htm_fh->close if $htm_fh;
4072 # close Excel Workbook
4073 $ws_global->set_first_sheet();
4074 # FIXME: whyever - activate does not work :-/
4075 $ws_global->activate();