Bail out if a configuration file starts with a byte order mark
[exim.git] / src / src / eximstats.src
1 #!PERL_COMMAND
2
3 # Copyright (c) 2001-2016 University of Cambridge.
4 # See the file NOTICE for conditions of use and distribution.
5
6 # Perl script to generate statistics from one or more Exim log files.
7
8 # Usage: eximstats [<options>] <log file> <log file> ...
9
10 # 1996-05-21: Ignore lines not starting with valid date/time, just in case
11 # these get into a log file.
12 # 1996-11-19: Add the -h option to control the size of the histogram,
13 # and optionally turn it off.
14 # Use some Perl 5 things; it should be everywhere by now.
15 # Add the Perl -w option and rewrite so no warnings are given.
16 # Add the -t option to control the length of the "top" listing.
17 # Add the -ne, -nt options to turn off errors and transport
18 # information.
19 # Add information about length of time on queue, and -q<list> to
20 # control the intervals and turn it off.
21 # Add count and percentage of delayed messages to the Received
22 # line.
23 # Show total number of errors.
24 # Add count and percentage of messages with errors to Received
25 # line.
26 # Add information about relaying and -nr to suppress it.
27 # 1997-02-03 Merged in some of the things Nigel Metheringham had done:
28 # Re-worded headings
29 # Added received histogram as well as delivered
30 # Added local senders' league table
31 # Added local recipients' league table
32 # 1997-03-10 Fixed typo "destinationss"
33 # Allow for intermediate address between final and original
34 # when testing for relaying
35 # Give better message when no input
36 # 1997-04-24 Fixed bug in layout of error listing that was depending on
37 # text length (output line got repeated).
38 # 1997-05-06 Bug in option decoding when only one option.
39 # Overflow bug when handling very large volumes.
40 # 1997-10-28 Updated to handle revised log format that might show
41 # HELO name as well as host name before IP number
42 # 1998-01-26 Bugs in the function for calculating the number of seconds
43 # since 1970 from a log date
44 # 1998-02-02 Delivery to :blackhole: doesn't have a T= entry in the log
45 # line; cope with this, thereby avoiding undefined problems
46 # Very short log line gave substring error
47 # 1998-02-03 A routed delivery to a local transport may not have <> in the
48 # log line; terminate the address at white space, not <
49 # 1998-09-07 If first line of input was a => line, $thissize was undefined;
50 # ensure it is zero.
51 # 1998-12-21 Adding of $thissize from => line should have been adding $size.
52 # Oops. Should have looked more closely when fixing the previous
53 # bug!
54 # 1999-11-12 Increased the field widths for printed integers; numbers are
55 # bigger than originally envisaged.
56 # 2001-03-21 Converted seconds() routine to use Time::Local, fixing a bug
57 # whereby seconds($timestamp) - id_seconds($id) gave an
58 # incorrect result.
59 # Added POD documentation.
60 # Moved usage instructions into help() subroutine.
61 # Added 'use strict' and declared all global variables.
62 # Added '-html' flag and resultant code.
63 # Added '-cache' flag and resultant code.
64 # Added add_volume() routine and converted all volume variables
65 # to use it, fixing the overflow problems for individual hosts
66 # on large sites.
67 # Converted all volume output to GB/MB/KB as appropriate.
68 # Don't store local user stats if -nfl is specified.
69 # Modifications done by: Steve Campbell (<steve@computurn.com>)
70 # 2001-04-02 Added the -t_remote_users flag. Steve Campbell.
71 # 2001-10-15 Added the -domain flag. Steve Campbell.
72 # 2001-10-16 Accept files on STDIN or on the command line. Steve Campbell.
73 # 2001-10-21 Removed -domain flag and added -bydomain, -byhost, and -byemail.
74 # We now generate our main parsing subroutine as an eval statement
75 # which improves performance dramatically when not all the results
76 # are required. We also cache the last timestamp to time conversion.
77 #
78 # NOTE: 'Top 50 destinations by (message count|volume)' lines are
79 # now 'Top N (host|email|domain) destinations by (message count|volume)'
80 # where N is the topcount. Steve Campbell.
81 #
82 # 2001-10-30 V1.16 Joachim Wieland.
83 # Fixed minor bugs in add_volume() when taking over this version
84 # for use in Exim 4: -w gave uninitialized value warnings in
85 # two situations: for the first addition to a counter, and if
86 # there were never any gigabytes, thereby leaving the $gigs
87 # value unset.
88 # Initialized $last_timestamp to stop a -w uninitialized warning.
89 # Minor layout tweak for grand totals (nitpicking).
90 # Put the IP addresses for relaying stats in [] and separated by
91 # a space from the domain name.
92 # Removed the IPv4-specific address test when picking out addresses
93 # for relaying. Anything inside [] is OK.
94 #
95 # 2002-07-02 Philip Hazel
96 # Fixed "uninitialized variable" message that occurred for relay
97 # messages that arrived from H=[1.2.3.4] hosts (no name shown).
98 # This bug didn't affect the output.
99 #
100 # 2002-04-15 V1.17 Joachim Wieland.
101 # Added -charts, -chartdir. -chartrel options which use
102 # GD::Graph modules to create graphical charts of the statistics.
103 #
104 # 2002-04-15 V1.18 Steve Campbell.
105 # Added a check for $domain to to stop a -w uninitialized warning.
106 # Added -byemaildomain option.
107 # Only print HTML header links to included tables!
108 #
109 # 2002-08-02 V1.19 Steve Campbell.
110 # Changed the debug mode to dump the parser onto STDERR rather
111 # than STDOUT. Documented the -d flag into the help().
112 # Rejoined the divergent 2002-04-15 and 2002-07-02 releases.
113 #
114 # 2002-08-21 V1.20 Steve Campbell.
115 # Added the '-merge' option to allow merging of previous reports.
116 # Fixed a missing semicolon when doing -bydomain.
117 # Make volume charts plot the data gigs and bytes rather than just bytes.
118 # Only process log lines with $flag =~ /<=|=>|->|==|\*\*|Co/
119 # Converted Emaildomain to Edomain - the column header was too wide!
120 # This changes the text output slightly. You can revert to the old
121 # column widths by changing $COLUMN_WIDTHS to 7;
122 #
123 # 2002-09-04 V1.21 Andreas J Mueller
124 # Local deliveries domain now defaults to 'localdomain'.
125 # Don't match F=<From> when looking for the user.
126 #
127 # 2002-09-05 V1.22 Steve Campbell
128 # Fixed a perl 5.005 incompatibility problem ('our' variables).
129 #
130 # 2002-09-11 V1.23 Steve Campbell
131 # Stopped -charts option from throwing errors on null data.
132 # Don't print out 'Errors encountered' unless there are any.
133
134 # 2002-10-21 V1.23a Philip Hazel - patch from Tony Finch put in until
135 # Steve's eximstats catches up.
136 # Handle log files that include the timezone after the timestamp.
137 # Switch to assuming that log timestamps are in local time, with
138 # an option for UTC timestamps, as in Exim itself.
139 #
140 # 2003-02-05 V1.24 Steve Campbell
141 # Added in Sergey Sholokh's code to convert '<' and '>' characters
142 # in HTML output. Also added code to convert them back with -merge.
143 # Fixed timestamp offsets to convert to seconds rather than minutes.
144 # Updated -merge to work with output files using timezones.
145 # Added caching to speed up the calculation of timezone offsets.
146 #
147 # 2003-02-07 V1.25 Steve Campbell
148 # Optimised the usage of mktime() in the seconds subroutine.
149 # Removed the now redundant '-cache' option.
150 # html2txt() now explicitly matches HTML tags.
151 # Implemented a new sorting algorithm - the top_n_sort() routine.
152 # Added Danny Carroll's '-nvr' flag and code.
153 #
154 # 2003-03-13 V1.26 Steve Campbell
155 # Implemented HTML compliance changes recommended by Bernard Massot.
156 # Bug fix to allow top_n_sort() to handle null keys.
157 # Convert all domains and edomains to lowercase.
158 # Remove preceding dots from domains.
159 #
160 # 2003-03-13 V1.27 Steve Campbell
161 # Replaced border attributes with 'border=1', as recommended by
162 # Bernard Massot.
163 #
164 # 2003-06-03 V1.28 John Newman
165 # Added in the ability to skip over the parsing and evaluation of
166 # specific transports as passed to eximstats via the new "-nt/.../"
167 # command line argument. This new switch allows the viewing of
168 # not more accurate statistics but more applicable statistics when
169 # special transports are in use (ie; SpamAssassin). We need to be
170 # able to ignore transports such as this otherwise the resulting
171 # local deliveries are significantly skewed (doubled)...
172 #
173 # 2003-11-06 V1.29 Steve Campbell
174 # Added the '-pattern "Description" "/pattern/"' option.
175 #
176 # 2004-02-17 V1.30 Steve Campbell
177 # Added warnings if required GD::Graph modules are not available or
178 # insufficient -chart* options are specified.
179 #
180 # 2004-02-20 V1.31 Andrea Balzi
181 # Only show the Local Sender/Destination links if the tables exist.
182 #
183 # 2004-07-05 V1.32 Steve Campbell
184 # Fix '-merge -h0' divide by zero error.
185 #
186 # 2004-07-15 V1.33 Steve Campbell
187 # Documentation update - I've converted the subroutine
188 # documentation from POD to comments.
189 #
190 # 2004-12-10 V1.34 Steve Campbell
191 # Eximstats can now parse syslog lines as well as mainlog lines.
192 #
193 # 2004-12-20 V1.35 Wouter Verhelst
194 # Pie charts by volume were actually generated by count. Fixed.
195 #
196 # 2005-02-07 V1.36 Gregor Herrmann / Steve Campbell
197 # Added average sizes to HTML Top tables.
198 #
199 # 2005-04-26 V1.37 Frank Heydlauf
200 # Added -xls and the ability to specify output files.
201 #
202 # 2005-04-29 V1.38 Steve Campbell
203 # Use FileHandles for outputting results.
204 # Allow any combination of xls, txt, and html output.
205 # Fixed display of large numbers with -nvr option
206 # Fixed merging of reports with empty tables.
207 #
208 # 2005-05-27 V1.39 Steve Campbell
209 # Added the -include_original_destination flag
210 # Removed tabs and trailing whitespace.
211 #
212 # 2005-06-03 V1.40 Steve Campbell
213 # Whilst parsing the mainlog(s), store information about
214 # the messages in a hash of arrays rather than using
215 # individual hashes. This is a bit cleaner and results in
216 # dramatic memory savings, albeit at a slight CPU cost.
217 #
218 # 2005-06-15 V1.41 Steve Campbell
219 # Added the -show_rt<list> flag.
220 # Added the -show_dt<list> flag.
221 #
222 # 2005-06-24 V1.42 Steve Campbell
223 # Added Histograms for user specified patterns.
224 #
225 # 2005-06-30 V1.43 Steve Campbell
226 # Bug fix for V1.42 with -h0 specified. Spotted by Chris Lear.
227 #
228 # 2005-07-26 V1.44 Steve Campbell
229 # Use a glob alias rather than an array ref in the generated
230 # parser. This improves both readability and performance.
231 #
232 # 2005-09-30 V1.45 Marco Gaiarin / Steve Campbell
233 # Collect SpamAssassin and rejection statistics.
234 # Don't display local sender or destination tables unless
235 # there is data to show.
236 # Added average volumes into the top table text output.
237 #
238 # 2006-02-07 V1.46 Steve Campbell
239 # Collect data on the number of addresses (recipients)
240 # as well as the number of messages.
241 #
242 # 2006-05-05 V1.47 Steve Campbell
243 # Added 'Message too big' to the list of mail rejection
244 # reasons (thanks to Marco Gaiarin).
245 #
246 # 2006-06-05 V1.48 Steve Campbell
247 # Mainlog lines which have GMT offsets and are too short to
248 # have a flag are now skipped.
249 #
250 # 2006-11-10 V1.49 Alain Williams
251 # Added the -emptyok flag.
252 #
253 # 2006-11-16 V1.50 Steve Campbell
254 # Fixes for obtaining the IP address from reject messages.
255 #
256 # 2006-11-27 V1.51 Steve Campbell
257 # Another update for obtaining the IP address from reject messages.
258 #
259 # 2006-11-27 V1.52 Steve Campbell
260 # Tally any reject message containing SpamAssassin.
261 #
262 # 2007-01-31 V1.53 Philip Hazel
263 # Allow for [pid] after date in log lines
264 #
265 # 2007-02-14 V1.54 Daniel Tiefnig
266 # Improved the '($parent) =' pattern match.
267 #
268 # 2007-03-19 V1.55 Steve Campbell
269 # Differentiate between permanent and temporary rejects.
270 #
271 # 2007-03-29 V1.56 Jez Hancock
272 # Fixed some broken HTML links and added missing column headers.
273 #
274 # 2007-03-30 V1.57 Steve Campbell
275 # Fixed Grand Total Summary Domains, Edomains, and Email columns
276 # for Rejects, Temp Rejects, Ham, and Spam rows.
277 #
278 # 2007-04-11 V1.58 Steve Campbell
279 # Fix to get <> and blackhole to show in edomain tables.
280 #
281 # 2007-09-20 V1.59 Steve Campbell
282 # Added the -bylocaldomain option
283 #
284 # 2007-09-20 V1.60 Heiko Schlittermann
285 # Fix for misinterpreted log lines
286 #
287 # 2013-01-14 V1.61 Steve Campbell
288 # Watch out for senders sending "HELO [IpAddr]"
289 #
290 #
291 # For documentation on the logfile format, see
292 # http://www.exim.org/exim-html-4.50/doc/html/spec_48.html#IX2793
293
294 =head1 NAME
295
296 eximstats - generates statistics from Exim mainlog or syslog files.
297
298 =head1 SYNOPSIS
299
300 eximstats [Output] [Options] mainlog1 mainlog2 ...
301 eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
302
303 =head2 Output:
304
305 =over 4
306
307 =item B<-txt>
308
309 Output the results in plain text to STDOUT.
310
311 =item B<-txt>=I<filename>
312
313 Output the results in plain text. Filename '-' for STDOUT is accepted.
314
315 =item B<-html>
316
317 Output the results in HTML to STDOUT.
318
319 =item B<-html>=I<filename>
320
321 Output the results in HTML. Filename '-' for STDOUT is accepted.
322
323 =item B<-xls>
324
325 Output the results in Excel compatible Format to STDOUT.
326 Requires the Spreadsheet::WriteExcel CPAN module.
327
328 =item B<-xls>=I<filename>
329
330 Output the results in Excel compatible format. Filename '-' for STDOUT is accepted.
331
332
333 =back
334
335 =head2 Options:
336
337 =over 4
338
339 =item B<-h>I<number>
340
341 histogram divisions per hour. The default is 1, and
342 0 suppresses histograms. Valid values are:
343
344 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
345
346 =item B<-ne>
347
348 Don't display error information.
349
350 =item B<-nr>
351
352 Don't display relaying information.
353
354 =item B<-nr>I</pattern/>
355
356 Don't display relaying information that matches.
357
358 =item B<-nt>
359
360 Don't display transport information.
361
362 =item B<-nt>I</pattern/>
363
364 Don't display transport information that matches
365
366 =item B<-q>I<list>
367
368 List of times for queuing information single 0 item suppresses.
369
370 =item B<-t>I<number>
371
372 Display top <number> sources/destinations
373 default is 50, 0 suppresses top listing.
374
375 =item B<-tnl>
376
377 Omit local sources/destinations in top listing.
378
379 =item B<-t_remote_users>
380
381 Include remote users in the top source/destination listings.
382
383 =item B<-include_original_destination>
384
385 Include the original destination email addresses rather than just
386 using the final ones.
387 Useful for finding out which of your mailing lists are receiving mail.
388
389 =item B<-show_dt>I<list>
390
391 Show the delivery times (B<DT>)for all the messages.
392
393 Exim must have been configured to use the +deliver_time logging option
394 for this option to work.
395
396 I<list> is an optional list of times. Eg -show_dt1,2,4,8 will show
397 the number of messages with delivery times under 1 second, 2 seconds, 4 seconds,
398 8 seconds, and over 8 seconds.
399
400 =item B<-show_rt>I<list>
401
402 Show the receipt times for all the messages. The receipt time is
403 defined as the Completed hh:mm:ss - queue_time_overall - the Receipt hh:mm:ss.
404 These figures will be skewed by pipelined messages so might not be that useful.
405
406 Exim must have been configured to use the +queue_time_overall logging option
407 for this option to work.
408
409 I<list> is an optional list of times. Eg -show_rt1,2,4,8 will show
410 the number of messages with receipt times under 1 second, 2 seconds, 4 seconds,
411 8 seconds, and over 8 seconds.
412
413 =item B<-byhost>
414
415 Show results by sending host. This may be combined with
416 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
417 are specified, then B<-byhost> is assumed as a default.
418
419 =item B<-bydomain>
420
421 Show results by sending domain.
422 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
423
424 =item B<-byemail>
425
426 Show results by sender's email address.
427 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
428
429 =item B<-byemaildomain> or B<-byedomain>
430
431 Show results by sender's email domain.
432 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
433
434 =item B<-pattern> I<Description> I</Pattern/>
435
436 Look for the specified pattern and count the number of lines in which it appears.
437 This option can be specified multiple times. Eg:
438
439 -pattern 'Refused connections' '/refused connection/'
440
441
442 =item B<-merge>
443
444 This option allows eximstats to merge old eximstat reports together. Eg:
445
446 eximstats mainlog.sun > report.sun.txt
447 eximstats mainlog.mon > report.mon.txt
448 eximstats mainlog.tue > report.tue.txt
449 eximstats mainlog.wed > report.web.txt
450 eximstats mainlog.thu > report.thu.txt
451 eximstats mainlog.fri > report.fri.txt
452 eximstats mainlog.sat > report.sat.txt
453 eximstats -merge report.*.txt > weekly_report.txt
454 eximstats -merge -html report.*.txt > weekly_report.html
455
456 =over 4
457
458 =item *
459
460 You can merge text or html reports and output the results as text or html.
461
462 =item *
463
464 You can use all the normal eximstat output options, but only data
465 included in the original reports can be shown!
466
467 =item *
468
469 When merging reports, some loss of accuracy may occur in the top I<n> lists.
470 This will be towards the ends of the lists.
471
472 =item *
473
474 The order of items in the top I<n> lists may vary when the data volumes
475 round to the same value.
476
477 =back
478
479 =item B<-charts>
480
481 Create graphical charts to be displayed in HTML output.
482 Only valid in combination with I<-html>.
483
484 This requires the following modules which can be obtained
485 from http://www.cpan.org/modules/01modules.index.html
486
487 =over 4
488
489 =item GD
490
491 =item GDTextUtil
492
493 =item GDGraph
494
495 =back
496
497 To install these, download and unpack them, then use the normal perl installation procedure:
498
499 perl Makefile.PL
500 make
501 make test
502 make install
503
504 =item B<-chartdir>I <dir>
505
506 Create the charts in the directory <dir>
507
508 =item B<-chartrel>I <dir>
509
510 Specify the relative directory for the "img src=" tags from where to include
511 the charts
512
513 =item B<-emptyok>
514
515 Specify that it's OK to not find any valid log lines. Without this
516 we will output an error message if we don't find any.
517
518 =item B<-d>
519
520 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
521 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
522 title!
523
524 =back
525
526 =head1 DESCRIPTION
527
528 Eximstats parses exim mainlog and syslog files to output a statistical
529 analysis of the messages processed. By default, a text
530 analysis is generated, but you can request other output formats
531 using flags. See the help (B<-help>) to learn
532 about how to create charts from the tables.
533
534 =head1 AUTHOR
535
536 There is a web site at http://www.exim.org - this contains details of the
537 mailing list exim-users@exim.org.
538
539 =head1 TO DO
540
541 This program does not perfectly handle messages whose received
542 and delivered log lines are in different files, which can happen
543 when you have multiple mail servers and a message cannot be
544 immediately delivered. Fixing this could be tricky...
545
546 Merging of xls files is not (yet) possible. Be free to implement :)
547
548 =cut
549
550 use warnings;
551 use integer;
552 BEGIN { pop @INC if $INC[-1] eq '.' };
553 use strict;
554 use IO::File;
555
556 # use Time::Local; # PH/FANF
557 use POSIX;
558
559 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints $HAVE_Spreadsheet_WriteExcel);
560 eval { require GD::Graph::pie; };
561 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
562 eval { require GD::Graph::linespoints; };
563 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
564 eval { require Spreadsheet::WriteExcel; };
565 $HAVE_Spreadsheet_WriteExcel = $@ ? 0 : 1;
566
567
568 ##################################################
569 # Static data #
570 ##################################################
571 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
572 use vars qw(@tab62 @days_per_month $gig);
573 use vars qw($VERSION);
574 use vars qw($COLUMN_WIDTHS);
575 use vars qw($WEEK $DAY $HOUR $MINUTE);
576
577
578 @tab62 =
579 (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, # 0-9
580 0,10,11,12,13,14,15,16,17,18,19,20, # A-K
581 21,22,23,24,25,26,27,28,29,30,31,32, # L-W
582 33,34,35, 0, 0, 0, 0, 0, # X-Z
583 0,36,37,38,39,40,41,42,43,44,45,46, # a-k
584 47,48,49,50,51,52,53,54,55,56,57,58, # l-w
585 59,60,61); # x-z
586
587 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
588 $gig = 1024 * 1024 * 1024;
589 $VERSION = '1.61';
590
591 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
592 $COLUMN_WIDTHS = 8;
593
594 $MINUTE = 60;
595 $HOUR = 60 * $MINUTE;
596 $DAY = 24 * $HOUR;
597 $WEEK = 7 * $DAY;
598
599 # Declare global variables.
600 use vars qw($total_received_data $total_received_data_gigs $total_received_count);
601 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_messages $total_delivered_addresses);
602 use vars qw(%timestamp2time); #Hash of timestamp => time.
603 use vars qw($last_timestamp $last_time); #The last time conversion done.
604 use vars qw($last_date $date_seconds); #The last date conversion done.
605 use vars qw($last_offset $offset_seconds); #The last time offset conversion done.
606 use vars qw($localtime_offset);
607 use vars qw($i); #General loop counter.
608 use vars qw($debug); #Debug mode?
609 use vars qw($ntopchart); #How many entries should make it into the chart?
610 use vars qw($gddirectory); #Where to put files from GD::Graph
611
612 # SpamAssassin variables
613 use vars qw($spam_score $spam_score_gigs);
614 use vars qw($ham_score $ham_score_gigs);
615 use vars qw(%ham_count_by_ip %spam_count_by_ip);
616 use vars qw(%rejected_count_by_ip %rejected_count_by_reason);
617 use vars qw(%temporarily_rejected_count_by_ip %temporarily_rejected_count_by_reason);
618
619 #For use in Spreadsheet::WriteExcel
620 use vars qw($workbook $ws_global $ws_relayed $ws_errors);
621 use vars qw($row $col $row_hist $col_hist);
622 use vars qw($run_hist);
623 use vars qw($f_default $f_header1 $f_header2 $f_header2_m $f_headertab $f_percent); #Format Header
624
625 # Output FileHandles
626 use vars qw($txt_fh $htm_fh $xls_fh);
627
628 $ntopchart = 5;
629
630 # The following are parameters whose values are
631 # set by command line switches:
632 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
633 use vars qw($topcount $local_league_table $include_remote_users $do_local_domain);
634 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding $emptyOK);
635 use vars qw($relay_pattern @queue_times @user_patterns @user_descriptions);
636 use vars qw(@rcpt_times @delivery_times);
637 use vars qw($include_original_destination);
638 use vars qw($txt_fh $htm_fh $xls_fh);
639
640 use vars qw(%do_sender); #Do sender by Host, Domain, Email, and/or Edomain tables.
641 use vars qw($charts $chartrel $chartdir $charts_option_specified);
642 use vars qw($merge_reports); #Merge old reports ?
643
644 # The following are modified in the parse() routine, and
645 # referred to in the print_*() routines.
646 use vars qw($delayed_count $relayed_unshown $begin $end);
647 use vars qw(%messages @message);
648 use vars qw(%received_count %received_data %received_data_gigs);
649 use vars qw(%delivered_messages %delivered_data %delivered_data_gigs %delivered_addresses);
650 use vars qw(%received_count_user %received_data_user %received_data_gigs_user);
651 use vars qw(%delivered_messages_user %delivered_addresses_user %delivered_data_user %delivered_data_gigs_user);
652 use vars qw(%delivered_messages_local_domain %delivered_addresses_local_domain %delivered_data_local_domain %delivered_data_gigs_local_domain);
653 use vars qw(%transported_count %transported_data %transported_data_gigs);
654 use vars qw(%relayed %errors_count $message_errors);
655 use vars qw(@qt_all_bin @qt_remote_bin);
656 use vars qw($qt_all_overflow $qt_remote_overflow);
657 use vars qw(@dt_all_bin @dt_remote_bin %rcpt_times_bin);
658 use vars qw($dt_all_overflow $dt_remote_overflow %rcpt_times_overflow);
659 use vars qw(@received_interval_count @delivered_interval_count);
660 use vars qw(@user_pattern_totals @user_pattern_interval_count);
661
662 use vars qw(%report_totals);
663
664 # Enumerations
665 use vars qw($SIZE $FROM_HOST $FROM_ADDRESS $ARRIVAL_TIME $REMOTE_DELIVERED $PROTOCOL);
666 use vars qw($DELAYED $HAD_ERROR);
667 $SIZE = 0;
668 $FROM_HOST = 1;
669 $FROM_ADDRESS = 2;
670 $ARRIVAL_TIME = 3;
671 $REMOTE_DELIVERED = 4;
672 $DELAYED = 5;
673 $HAD_ERROR = 6;
674 $PROTOCOL = 7;
675
676
677
678 ##################################################
679 # Subroutines #
680 ##################################################
681
682 #######################################################################
683 # get_filehandle($file,\%output_files);
684 # Return a filehandle writing to $file.
685 #
686 # If %output_files is defined, check that $output_files{$file}
687 # doesn't exist and die if it does, or set it if it doesn't.
688 #######################################################################
689 sub get_filehandle {
690 my($file,$output_files_href) = @_;
691
692 $file = '-' if ($file eq '');
693
694 if (defined $output_files_href) {
695 die "You can only output to '$file' once! Use -h for help.\n" if exists $output_files_href->{$file};
696 $output_files_href->{$file} = 1;
697 }
698
699 if ($file eq '-') {
700 return \*STDOUT;
701 }
702
703 if (-e $file) {
704 unlink $file or die "Failed to rm $file: $!";
705 }
706
707 my $fh = new IO::File $file, O_WRONLY|O_CREAT|O_EXCL;
708 die "new IO::File $file failed: $!" unless (defined $fh);
709 return $fh;
710 }
711
712
713 #######################################################################
714 # volume_rounded();
715 #
716 # $rounded_volume = volume_rounded($bytes,$gigabytes);
717 #
718 # Given a data size in bytes, round it to KB, MB, or GB
719 # as appropriate.
720 #
721 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
722 #
723 # Note: I've experimented with Math::BigInt and it results in a 33%
724 # performance degredation as opposed to storing numbers split into
725 # bytes and gigabytes.
726 #######################################################################
727 sub volume_rounded {
728 my($x,$g) = @_;
729 $x = 0 unless $x;
730 $g = 0 unless $g;
731 my($rounded);
732
733 while ($x > $gig) {
734 $g++;
735 $x -= $gig;
736 }
737
738 if ($volume_rounding) {
739 # Values < 1 GB
740 if ($g <= 0) {
741 if ($x < 10000) {
742 $rounded = sprintf("%6d", $x);
743 }
744 elsif ($x < 10000000) {
745 $rounded = sprintf("%4dKB", ($x + 512)/1024);
746 }
747 else {
748 $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
749 }
750 }
751 # Values between 1GB and 10GB are printed in MB
752 elsif ($g < 10) {
753 $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
754 }
755 else {
756 # Handle values over 10GB
757 $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
758 }
759 }
760 else {
761 # We don't want any rounding to be done.
762 # and we don't need broken formatted output which on one hand avoids numbers from
763 # being interpreted as string by Spreadsheet Calculators, on the other hand
764 # breaks if more than 4 digits! -> flexible length instead of fixed length
765 # Format the return value at the output routine! -fh
766 #$rounded = sprintf("%d", ($g * $gig) + $x);
767 no integer;
768 $rounded = sprintf("%.0f", ($g * $gig) + $x);
769 }
770
771 return $rounded;
772 }
773
774
775 #######################################################################
776 # un_round();
777 #
778 # un_round($rounded_volume,\$bytes,\$gigabytes);
779 #
780 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
781 # do the reverse transformation and convert it back into Bytes and Gigabytes.
782 # These are added to the $bytes and $gigabytes parameters.
783 #
784 # Given a data size in bytes, round it to KB, MB, or GB
785 # as appropriate.
786 #
787 # EG: 500 => (500,0), 14GB => (0,14), etc.
788 #######################################################################
789 sub un_round {
790 my($rounded,$bytes_sref,$gigabytes_sref) = @_;
791
792 if ($rounded =~ /(\d+)GB/) {
793 $$gigabytes_sref += $1;
794 }
795 elsif ($rounded =~ /(\d+)MB/) {
796 $$gigabytes_sref += $1 / 1024;
797 $$bytes_sref += (($1 % 1024 ) * 1024 * 1024);
798 }
799 elsif ($rounded =~ /(\d+)KB/) {
800 $$gigabytes_sref += $1 / (1024 * 1024);
801 $$bytes_sref += ($1 % (1024 * 1024) * 1024);
802 }
803 elsif ($rounded =~ /(\d+)/) {
804 # We need to turn off integer in case we are merging an -nvr report.
805 no integer;
806 $$gigabytes_sref += int($1 / $gig);
807 $$bytes_sref += $1 % $gig;
808 }
809
810 #Now reduce the bytes down to less than 1GB.
811 add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
812 }
813
814
815 #######################################################################
816 # add_volume();
817 #
818 # add_volume(\$bytes,\$gigs,$size);
819 #
820 # Add $size to $bytes/$gigs where this is a number split into
821 # bytes ($bytes) and gigabytes ($gigs). This is significantly
822 # faster than using Math::BigInt.
823 #######################################################################
824 sub add_volume {
825 my($bytes_ref,$gigs_ref,$size) = @_;
826 $$bytes_ref = 0 if ! defined $$bytes_ref;
827 $$gigs_ref = 0 if ! defined $$gigs_ref;
828 $$bytes_ref += $size;
829 while ($$bytes_ref > $gig) {
830 $$gigs_ref++;
831 $$bytes_ref -= $gig;
832 }
833 }
834
835
836 #######################################################################
837 # format_time();
838 #
839 # $formatted_time = format_time($seconds);
840 #
841 # Given a time in seconds, break it down into
842 # weeks, days, hours, minutes, and seconds.
843 #
844 # Eg 12005 => 3h20m5s
845 #######################################################################
846 sub format_time {
847 my($t) = pop @_;
848 my($s) = $t % 60;
849 $t /= 60;
850 my($m) = $t % 60;
851 $t /= 60;
852 my($h) = $t % 24;
853 $t /= 24;
854 my($d) = $t % 7;
855 my($w) = $t/7;
856 my($p) = "";
857 $p .= "$w"."w" if $w > 0;
858 $p .= "$d"."d" if $d > 0;
859 $p .= "$h"."h" if $h > 0;
860 $p .= "$m"."m" if $m > 0;
861 $p .= "$s"."s" if $s > 0 || $p eq "";
862 $p;
863 }
864
865
866 #######################################################################
867 # unformat_time();
868 #
869 # $seconds = unformat_time($formatted_time);
870 #
871 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
872 #
873 # Eg 3h20m5s => 12005
874 #######################################################################
875 sub unformat_time {
876 my($formatted_time) = pop @_;
877 my $time = 0;
878
879 while ($formatted_time =~ s/^(\d+)([wdhms]?)//) {
880 $time += $1 if ($2 eq '' || $2 eq 's');
881 $time += $1 * 60 if ($2 eq 'm');
882 $time += $1 * 60 * 60 if ($2 eq 'h');
883 $time += $1 * 60 * 60 * 24 if ($2 eq 'd');
884 $time += $1 * 60 * 60 * 24 * 7 if ($2 eq 'w');
885 }
886 $time;
887 }
888
889
890 #######################################################################
891 # seconds();
892 #
893 # $time = seconds($timestamp);
894 #
895 # Given a time-of-day timestamp, convert it into a time() value using
896 # POSIX::mktime. We expect the timestamp to be of the form
897 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
898 # and the year to be absolute (we do the necessary conversions). The
899 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
900 # offset is not present, and we have not been told that the log is in UTC
901 # (with the -utc option), then we adjust the time by the current local
902 # time offset so that it can be compared with the time recorded in message
903 # IDs, which is UTC.
904 #
905 # To improve performance, we only use mktime on the date ($year-$mon-$day),
906 # and only calculate it if the date is different to the previous time we
907 # came here. We then add on seconds for the '$hour:$min:$sec'.
908 #
909 # We also store the results of the last conversion done, and only
910 # recalculate if the date is different.
911 #
912 # We used to have the '-cache' flag which would store the results of the
913 # mktime() call. However, the current way of just using mktime() on the
914 # date obsoletes this.
915 #######################################################################
916 sub seconds {
917 my($timestamp) = @_;
918
919 # Is the timestamp the same as the last one?
920 return $last_time if ($last_timestamp eq $timestamp);
921
922 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
923
924 unless ($last_date eq $1) {
925 $last_date = $1;
926 my(@timestamp) = (0,0,0,$4,$3,$2);
927 $timestamp[5] -= 1900;
928 $timestamp[4]--;
929 $date_seconds = mktime(@timestamp);
930 }
931 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
932
933 # SC. Use caching. Also note we want seconds not minutes.
934 #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
935 if (defined $8 && ($8 ne $last_offset)) {
936 $last_offset = $8;
937 $offset_seconds = ($10 * 60 + $11) * 60;
938 $offset_seconds = -$offset_seconds if ($9 eq '-');
939 }
940
941
942 if (defined $7) {
943 #$time -= $this_offset;
944 $time -= $offset_seconds;
945 } elsif (defined $localtime_offset) {
946 $time -= $localtime_offset;
947 }
948
949 # Store the last timestamp received.
950 $last_timestamp = $timestamp;
951 $last_time = $time;
952
953 $time;
954 }
955
956
957 #######################################################################
958 # id_seconds();
959 #
960 # $time = id_seconds($message_id);
961 #
962 # Given a message ID, convert it into a time() value.
963 #######################################################################
964 sub id_seconds {
965 my($sub_id) = substr((pop @_), 0, 6);
966 my($s) = 0;
967 my(@c) = split(//, $sub_id);
968 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
969 $s;
970 }
971
972 #######################################################################
973 # wdhms_seconds();
974 #
975 # $seconds = wdhms_seconds($string);
976 #
977 # Convert a string in a week/day/hour/minute/second format (eg 4h10s)
978 # into seconds.
979 #######################################################################
980 sub wdhms_seconds {
981 if ($_[0] =~ /^(?:(\d+)w)?(?:(\d+)d)?(?:(\d+)h)?(?:(\d+)m)?(?:(\d+)s)?/) {
982 return((($1||0) * $WEEK) + (($2||0) * $DAY) + (($3||0) * $HOUR) + (($4||0) * $MINUTE) + ($5||0));
983 }
984 return undef;
985 }
986
987 #######################################################################
988 # queue_time();
989 #
990 # $queued = queue_time($completed_tod, $arrival_time, $id);
991 #
992 # Given the completed time of day and either the arrival time
993 # (preferred), or the message ID, calculate how long the message has
994 # been on the queue.
995 #
996 #######################################################################
997 sub queue_time {
998 my($completed_tod, $arrival_time, $id) = @_;
999
1000 # Note: id_seconds() benchmarks as 42% slower than seconds()
1001 # and computing the time accounts for a significant portion of
1002 # the run time.
1003 if (defined $arrival_time) {
1004 return(seconds($completed_tod) - seconds($arrival_time));
1005 }
1006 else {
1007 return(seconds($completed_tod) - id_seconds($id));
1008 }
1009 }
1010
1011
1012 #######################################################################
1013 # calculate_localtime_offset();
1014 #
1015 # $localtime_offset = calculate_localtime_offset();
1016 #
1017 # Calculate the the localtime offset from gmtime in seconds.
1018 #
1019 # $localtime = time() + $localtime_offset.
1020 #
1021 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
1022 # (West is negative, East is positive.)
1023 #######################################################################
1024
1025 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
1026 # This subroutine commented out as it's not currently in use.
1027
1028 #sub calculate_localtime_offset {
1029 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
1030 # my (@sample_date) = (0,0,0,5,5,100);
1031 # my $localtime = timelocal(@sample_date);
1032 # my $gmtime = timegm(@sample_date);
1033 # my $offset = $localtime - $gmtime;
1034 # return $offset;
1035 #}
1036
1037 sub calculate_localtime_offset {
1038 # Assume that the offset at the moment is valid across the whole
1039 # period covered by the logs that we're analysing. This may not
1040 # be true around the time the clocks change in spring or autumn.
1041 my $utc = time;
1042 # mktime works on local time and gmtime works in UTC
1043 my $local = mktime(gmtime($utc));
1044 return $local - $utc;
1045 }
1046
1047
1048
1049 #######################################################################
1050 # print_duration_table();
1051 #
1052 # print_duration_table($title, $message_type, \@times, \@values, $overflow);
1053 #
1054 # Print a table showing how long a particular step took for
1055 # the messages. The parameters are:
1056 # $title Eg "Time spent on the queue"
1057 # $message_type Eg "Remote"
1058 # \@times The maximum time a message took for it to increment
1059 # the corresponding @values counter.
1060 # \@values An array of message counters.
1061 # $overflow The number of messages which exceeded the maximum
1062 # time.
1063 #######################################################################
1064 sub print_duration_table {
1065 no integer;
1066 my($title, $message_type, $times_aref, $values_aref, $overflow) = @_;
1067 my(@chartdatanames);
1068 my(@chartdatavals);
1069
1070 my $printed_one = 0;
1071 my $cumulative_percent = 0;
1072
1073 my $queue_total = $overflow;
1074 map {$queue_total += $_} @$values_aref;
1075
1076 my $temp = "$title: $message_type";
1077
1078
1079 my $txt_format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
1080 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";
1081
1082 # write header
1083 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
1084 if ($htm_fh) {
1085 print $htm_fh "<hr><a name=\"$title $message_type\"></a><h2>$temp</h2>\n";
1086 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
1087 print $htm_fh "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
1088 }
1089 if ($xls_fh) {
1090 $ws_global->write($row++, $col, "$title: ".$message_type, $f_header2);
1091 my @content=("Time", "Messages", "Percentage", "Cumulative Percentage");
1092 &set_worksheet_line($ws_global, $row++, 1, \@content, $f_headertab);
1093 }
1094
1095
1096 for ($i = 0; $i <= $#$times_aref; ++$i) {
1097 if ($$values_aref[$i] > 0)
1098 {
1099 my $percent = ($values_aref->[$i] * 100)/$queue_total;
1100 $cumulative_percent += $percent;
1101
1102 my @content=($printed_one? " " : "Under",
1103 format_time($times_aref->[$i]),
1104 $values_aref->[$i], $percent, $cumulative_percent);
1105
1106 if ($htm_fh) {
1107 printf $htm_fh ($htm_format, @content);
1108 if (!defined($values_aref->[$i])) {
1109 print $htm_fh "Not defined";
1110 }
1111 }
1112 if ($txt_fh) {
1113 printf $txt_fh ($txt_format, @content);
1114 if (!defined($times_aref->[$i])) {
1115 print $txt_fh "Not defined";
1116 }
1117 }
1118 if ($xls_fh)
1119 {
1120 no integer;
1121 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1122 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1123
1124 if (!defined($times_aref->[$i])) {
1125 $col=0;
1126 $ws_global->write($row++, $col, "Not defined" );
1127 }
1128 }
1129
1130 push(@chartdatanames,
1131 ($printed_one? "" : "Under") . format_time($times_aref->[$i]));
1132 push(@chartdatavals, $$values_aref[$i]);
1133 $printed_one = 1;
1134 }
1135 }
1136
1137 if ($overflow && $overflow > 0) {
1138 my $percent = ($overflow * 100)/$queue_total;
1139 $cumulative_percent += $percent;
1140
1141 my @content = ("Over ", format_time($times_aref->[-1]),
1142 $overflow, $percent, $cumulative_percent);
1143
1144 printf $txt_fh ($txt_format, @content) if $txt_fh;
1145 printf $htm_fh ($htm_format, @content) if $htm_fh;
1146 if ($xls_fh)
1147 {
1148 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1149 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1150 }
1151
1152 }
1153
1154 push(@chartdatanames, "Over " . format_time($times_aref->[-1]));
1155 push(@chartdatavals, $overflow);
1156
1157 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
1158 if ($htm_fh) {
1159 print $htm_fh "</table></td><td>";
1160
1161 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1162 my @data = (
1163 \@chartdatanames,
1164 \@chartdatavals
1165 );
1166 my $graph = GD::Graph::pie->new(200, 200);
1167 my $pngname = "$title-$message_type.png";
1168 $pngname =~ s/[^\w\-\.]/_/;
1169
1170 my $graph_title = "$title ($message_type)";
1171 $graph->set(title => $graph_title) if (length($graph_title) < 21);
1172
1173 my $gd = $graph->plot(\@data) or warn($graph->error);
1174 if ($gd) {
1175 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1176 binmode IMG;
1177 print IMG $gd->png;
1178 close IMG;
1179 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1180 }
1181 }
1182 print $htm_fh "</td></tr></table>\n";
1183 }
1184
1185 if ($xls_fh)
1186 {
1187 $row++;
1188 }
1189 print $txt_fh "\n" if $txt_fh;
1190 print $htm_fh "\n" if $htm_fh;
1191
1192 }
1193
1194
1195 #######################################################################
1196 # print_histogram();
1197 #
1198 # print_histogram('Deliveries|Messages received|$pattern', $unit, @interval_count);
1199 #
1200 # Print a histogram of the messages delivered/received per time slot
1201 # (hour by default).
1202 #######################################################################
1203 sub print_histogram {
1204 my($text, $unit, @interval_count) = @_;
1205 my(@chartdatanames);
1206 my(@chartdatavals);
1207 my($maxd) = 0;
1208
1209 # save first row of print_histogram for xls output
1210 if (!$run_hist) {
1211 $row_hist = $row;
1212 }
1213 else {
1214 $row = $row_hist;
1215 }
1216
1217 for ($i = 0; $i < $hist_number; $i++)
1218 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
1219
1220 my $scale = int(($maxd + 25)/50);
1221 $scale = 1 if $scale == 0;
1222
1223 if ($scale != 1) {
1224 if ($unit !~ s/y$/ies/) {
1225 $unit .= 's';
1226 }
1227 }
1228
1229 # make and output title
1230 my $title = sprintf("$text per %s",
1231 ($hist_interval == 60)? "hour" :
1232 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
1233
1234 my $txt_htm_title = $title . " (each dot is $scale $unit)";
1235
1236 printf $txt_fh ("%s\n%s\n\n", $txt_htm_title, "-" x length($txt_htm_title)) if $txt_fh;
1237
1238 if ($htm_fh) {
1239 print $htm_fh "<hr><a name=\"$text\"></a><h2>$txt_htm_title</h2>\n";
1240 print $htm_fh "<table border=0 width=\"100%\">\n";
1241 print $htm_fh "<tr><td><pre>\n";
1242 }
1243
1244 if ($xls_fh) {
1245 $title =~ s/Messages/Msg/ ;
1246 $row += 2;
1247 $ws_global->write($row++, $col_hist+1, $title, $f_headertab);
1248 }
1249
1250
1251 my $hour = 0;
1252 my $minutes = 0;
1253 for ($i = 0; $i < $hist_number; $i++) {
1254 my $c = $interval_count[$i];
1255
1256 # If the interval is an hour (the maximum) print the starting and
1257 # ending hours as a label. Otherwise print the starting hour and
1258 # minutes, which take up the same space.
1259
1260 my $temp;
1261 if ($hist_opt == 1) {
1262 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
1263
1264 print $txt_fh $temp if $txt_fh;
1265 print $htm_fh $temp if $htm_fh;
1266
1267 if ($xls_fh) {
1268 if ($run_hist==0) {
1269 # only on first run
1270 $ws_global->write($row, 0, [$temp], $f_default);
1271 }
1272 }
1273
1274 push(@chartdatanames, $temp);
1275 $hour++;
1276 }
1277 else {
1278 if ($minutes == 0)
1279 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
1280 else
1281 { $temp = sprintf(" :%02d", $minutes) }
1282
1283 print $txt_fh $temp if $txt_fh;
1284 print $htm_fh $temp if $htm_fh;
1285 if (($xls_fh) and ($run_hist==0)) {
1286 # only on first run
1287 $temp = sprintf("%02d:%02d", $hour, $minutes);
1288 $ws_global->write($row, 0, [$temp], $f_default);
1289 }
1290
1291 push(@chartdatanames, $temp);
1292 $minutes += $hist_interval;
1293 if ($minutes >= 60) {
1294 $minutes = 0;
1295 $hour++;
1296 }
1297 }
1298 push(@chartdatavals, $c);
1299
1300 printf $txt_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $txt_fh;
1301 printf $htm_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $htm_fh;
1302 $ws_global->write($row++, $col_hist+1, [$c], $f_default) if $xls_fh;
1303
1304 } #end for
1305
1306 printf $txt_fh "\n" if $txt_fh;
1307 printf $htm_fh "\n" if $htm_fh;
1308
1309 if ($htm_fh)
1310 {
1311 print $htm_fh "</pre>\n";
1312 print $htm_fh "</td><td>\n";
1313 if ($HAVE_GD_Graph_linespoints && $charts && ($#chartdatavals > 0)) {
1314 # calculate the graph
1315 my @data = (
1316 \@chartdatanames,
1317 \@chartdatavals
1318 );
1319 my $graph = GD::Graph::linespoints->new(300, 300);
1320 $graph->set(
1321 x_label => 'Time',
1322 y_label => 'Amount',
1323 title => $text,
1324 x_labels_vertical => 1
1325 );
1326 my $pngname = "histogram_$text.png";
1327 $pngname =~ s/[^\w\._]/_/g;
1328
1329 my $gd = $graph->plot(\@data) or warn($graph->error);
1330 if ($gd) {
1331 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1332 binmode IMG;
1333 print IMG $gd->png;
1334 close IMG;
1335 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1336 }
1337 }
1338 print $htm_fh "</td></tr></table>\n";
1339 }
1340
1341 $col_hist++; # where to continue next times
1342
1343 $row+=2; # leave some space after history block
1344 $run_hist=1; # we have done this once or more
1345 }
1346
1347
1348
1349 #######################################################################
1350 # print_league_table();
1351 #
1352 # print_league_table($league_table_type,\%message_count,\%address_count,\%message_data,\%message_data_gigs, $spreadsheet, $row_sref);
1353 #
1354 # Given hashes of message count, address count, and message data,
1355 # which are keyed by the table type (eg by the sending host), print a
1356 # league table showing the top $topcount (defaults to 50).
1357 #######################################################################
1358 sub print_league_table {
1359 my($text,$m_count,$a_count,$m_data,$m_data_gigs,$spreadsheet, $row_sref) = @_;
1360 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
1361 my($title) = "Top $name by message count";
1362 my(@chartdatanames) = ();
1363 my(@chartdatavals) = ();
1364 my $chartotherval = 0;
1365 $text = ucfirst($text);
1366
1367 # Align non-local addresses to the right (so all the .com's line up).
1368 # Local addresses are aligned on the left as they are userids.
1369 my $align = ($text !~ /local/i) ? 'right' : 'left';
1370
1371
1372 ################################################
1373 # Generate the printf formats and table headers.
1374 ################################################
1375 my(@headers) = ('Messages');
1376 #push(@headers,'Addresses') if defined $a_count;
1377 push(@headers,'Addresses') if defined $a_count && %$a_count;
1378 push(@headers,'Bytes','Average') if defined $m_data;
1379
1380 my $txt_format = "%10s " x @headers . " %s\n";
1381 my $txt_col_headers = sprintf $txt_format, @headers, $text;
1382 my $htm_format = "<tr>" . '<td align="right">%s</td>'x@headers . "<td align=\"$align\" nowrap>%s</td></tr>\n";
1383 my $htm_col_headers = sprintf $htm_format, @headers, $text;
1384 $htm_col_headers =~ s/(<\/?)td/$1th/g; #Convert <td>'s to <th>'s for the header.
1385
1386
1387 ################################################
1388 # Write the table headers
1389 ################################################
1390 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1391
1392 if ($htm_fh) {
1393 print $htm_fh <<EoText;
1394 <hr><a name="$text count"></a><h2>$title</h2>
1395 <table border=0 width="100%">
1396 <tr><td>
1397 <table border=1>
1398 EoText
1399 print $htm_fh $htm_col_headers
1400 }
1401
1402 if ($xls_fh) {
1403 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1404 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1405 }
1406
1407
1408 # write content
1409 foreach my $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1410
1411 # When displaying the average figures, we calculate the average of
1412 # the rounded data, as the user would calculate it. This reduces
1413 # the accuracy slightly, but we have to do it this way otherwise
1414 # when using -merge to convert results from text to HTML and
1415 # vice-versa discrepencies would occur.
1416 my $messages = $$m_count{$key};
1417 my @content = ($messages);
1418 push(@content, $$a_count{$key}) if defined $a_count;
1419 if (defined $m_data) {
1420 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1421 my($data,$gigs) = (0,0);
1422 un_round($rounded_volume,\$data,\$gigs);
1423 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1424 push(@content, $rounded_volume, $rounded_average);
1425 }
1426
1427 # write content
1428 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1429
1430 if ($htm_fh) {
1431 my $htmlkey = $key;
1432 $htmlkey =~ s/>/\&gt\;/g;
1433 $htmlkey =~ s/</\&lt\;/g;
1434 printf $htm_fh ($htm_format, @content, $htmlkey);
1435 }
1436 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1437
1438 if (scalar @chartdatanames < $ntopchart) {
1439 push(@chartdatanames, $key);
1440 push(@chartdatavals, $$m_count{$key});
1441 }
1442 else {
1443 $chartotherval += $$m_count{$key};
1444 }
1445 }
1446
1447 push(@chartdatanames, "Other");
1448 push(@chartdatavals, $chartotherval);
1449
1450 print $txt_fh "\n" if $txt_fh;
1451 if ($htm_fh) {
1452 print $htm_fh "</table>\n";
1453 print $htm_fh "</td><td>\n";
1454 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0))
1455 {
1456 # calculate the graph
1457 my @data = (
1458 \@chartdatanames,
1459 \@chartdatavals
1460 );
1461 my $graph = GD::Graph::pie->new(300, 300);
1462 $graph->set(
1463 x_label => 'Name',
1464 y_label => 'Amount',
1465 title => 'By count',
1466 );
1467 my $gd = $graph->plot(\@data) or warn($graph->error);
1468 if ($gd) {
1469 my $temp = $text;
1470 $temp =~ s/ /_/g;
1471 open(IMG, ">$chartdir/${temp}_count.png") or die "Could not write $chartdir/${temp}_count.png: $!\n";
1472 binmode IMG;
1473 print IMG $gd->png;
1474 close IMG;
1475 print $htm_fh "<img src=\"$chartrel/${temp}_count.png\">";
1476 }
1477 }
1478 print $htm_fh "</td><td>\n";
1479 print $htm_fh "</td></tr></table>\n\n";
1480 }
1481 ++${$row_sref} if $xls_fh;
1482
1483
1484 if (defined $m_data) {
1485 # write header
1486
1487 $title = "Top $name by volume";
1488
1489 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1490
1491 if ($htm_fh) {
1492 print $htm_fh <<EoText;
1493 <hr><a name="$text volume"></a><h2>$title</h2>
1494 <table border=0 width="100%">
1495 <tr><td>
1496 <table border=1>
1497 EoText
1498 print $htm_fh $htm_col_headers;
1499 }
1500 if ($xls_fh) {
1501 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1502 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1503 }
1504
1505 @chartdatanames = ();
1506 @chartdatavals = ();
1507 $chartotherval = 0;
1508 my $use_gig = 0;
1509 foreach my $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1510 # The largest volume will be the first (top of the list).
1511 # If it has at least 1 gig, then just use gigabytes to avoid
1512 # risking an integer overflow when generating the pie charts.
1513 if ($$m_data_gigs{$key}) {
1514 $use_gig = 1;
1515 }
1516
1517 my $messages = $$m_count{$key};
1518 my @content = ($messages);
1519 push(@content, $$a_count{$key}) if defined $a_count;
1520 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1521 my($data ,$gigs) = (0,0);
1522 un_round($rounded_volume,\$data,\$gigs);
1523 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1524 push(@content, $rounded_volume, $rounded_average );
1525
1526 # write content
1527 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1528 if ($htm_fh) {
1529 my $htmlkey = $key;
1530 $htmlkey =~ s/>/\&gt\;/g;
1531 $htmlkey =~ s/</\&lt\;/g;
1532 printf $htm_fh ($htm_format, @content, $htmlkey);
1533 }
1534 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1535
1536
1537 if (scalar @chartdatanames < $ntopchart) {
1538 if ($use_gig) {
1539 if ($$m_data_gigs{$key}) {
1540 push(@chartdatanames, $key);
1541 push(@chartdatavals, $$m_data_gigs{$key});
1542 }
1543 }
1544 else {
1545 push(@chartdatanames, $key);
1546 push(@chartdatavals, $$m_data{$key});
1547 }
1548 }
1549 else {
1550 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1551 }
1552 }
1553 push(@chartdatanames, "Other");
1554 push(@chartdatavals, $chartotherval);
1555
1556 print $txt_fh "\n" if $txt_fh;
1557 if ($htm_fh) {
1558 print $htm_fh "</table>\n";
1559 print $htm_fh "</td><td>\n";
1560 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1561 # calculate the graph
1562 my @data = (
1563 \@chartdatanames,
1564 \@chartdatavals
1565 );
1566 my $graph = GD::Graph::pie->new(300, 300);
1567 $graph->set(
1568 x_label => 'Name',
1569 y_label => 'Volume' ,
1570 title => 'By Volume',
1571 );
1572 my $gd = $graph->plot(\@data) or warn($graph->error);
1573 if ($gd) {
1574 my $temp = $text;
1575 $temp =~ s/ /_/g;
1576 open(IMG, ">$chartdir/${temp}_volume.png") or die "Could not write $chartdir/${temp}_volume.png: $!\n";
1577 binmode IMG;
1578 print IMG $gd->png;
1579 close IMG;
1580 print $htm_fh "<img src=\"$chartrel/${temp}_volume.png\">";
1581 }
1582 }
1583 print $htm_fh "</td><td>\n";
1584 print $htm_fh "</td></tr></table>\n\n";
1585 }
1586
1587 ++${$row_sref} if $xls_fh;
1588 }
1589 }
1590
1591
1592 #######################################################################
1593 # top_n_sort();
1594 #
1595 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1596 #
1597 # Given a hash which has numerical values, return the sorted $n keys which
1598 # point to the top values. The second and third hashes are used as
1599 # tiebreakers. They all must have the same keys.
1600 #
1601 # The idea behind this routine is that when you only want to see the
1602 # top n members of a set, rather than sorting the entire set and then
1603 # plucking off the top n, sort through the stack as you go, discarding
1604 # any member which is lower than your current n'th highest member.
1605 #
1606 # This proves to be an order of magnitude faster for large hashes.
1607 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1608 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1609 #
1610 # We assume the values are > 0.
1611 #######################################################################
1612 sub top_n_sort {
1613 my($n,$href1,$href2,$href3) = @_;
1614
1615 # PH's original sort was:
1616 #
1617 # foreach $key (sort
1618 # {
1619 # $$m_count{$b} <=> $$m_count{$a} ||
1620 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1621 # $$m_data{$b} <=> $$m_data{$a} ||
1622 # $a cmp $b
1623 # }
1624 # keys %{$m_count})
1625 #
1626
1627 #We use a key of '_' to represent non-existant values, as null keys are valid.
1628 #'_' is not a valid domain, edomain, host, or email.
1629 my(@top_n_keys) = ('_') x $n;
1630 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1631 my $top_n_key = '';
1632 my $n_minus_1 = $n - 1;
1633 my $n_minus_2 = $n - 2;
1634
1635 # Create a dummy hash incase the user has not provided us with
1636 # tiebreaker hashes.
1637 my(%dummy_hash);
1638 $href2 = \%dummy_hash unless defined $href2;
1639 $href3 = \%dummy_hash unless defined $href3;
1640
1641 # Pick out the top $n keys.
1642 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1643 while (($key,$value1) = each %$href1) {
1644
1645 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1646
1647 # Check to see that the new value is bigger than the lowest of the
1648 # top n keys that we're keeping. We test the main key first, because
1649 # for the majority of cases we can skip creating dummy hash values
1650 # should the user have not provided real tie-breaking hashes.
1651 next unless $value1 >= $minimum_value1;
1652
1653 # Create a dummy hash entry for the key if required.
1654 # Note that setting the dummy_hash value sets it for both href2 &
1655 # href3. Also note that currently we are guaranteed to have a real
1656 # value for href3 if a real value for href2 exists so don't need to
1657 # test for it as well.
1658 $dummy_hash{$key} = 0 unless exists $href2->{$key};
1659
1660 $comparison = $value1 <=> $minimum_value1 ||
1661 $href2->{$key} <=> $minimum_value2 ||
1662 $href3->{$key} <=> $minimum_value3 ||
1663 $top_n_key cmp $key;
1664 next unless ($comparison == 1);
1665
1666 # As we will be using these values a few times, extract them into scalars.
1667 $value2 = $href2->{$key};
1668 $value3 = $href3->{$key};
1669
1670 # This key is bigger than the bottom n key, so the lowest position we
1671 # will insert it into is $n minus 1 (the bottom of the list).
1672 $insert_position = $n_minus_1;
1673
1674 # Now go through the list, stopping when we find a key that we're
1675 # bigger than, or we come to the penultimate position - we've
1676 # already tested bigger than the last.
1677 #
1678 # Note: we go top down as the list starts off empty.
1679 # Note: stepping through the list in this way benchmarks nearly
1680 # three times faster than doing a sort() on the reduced list.
1681 # I assume this is because the list is already in order, and
1682 # we get a performance boost from not having to do hash lookups
1683 # on the new key.
1684 for ($i = 0; $i < $n_minus_1; $i++) {
1685 $top_n_key = $top_n_keys[$i];
1686 if ( ($top_n_key eq '_') ||
1687 ( ($value1 <=> $href1->{$top_n_key} ||
1688 $value2 <=> $href2->{$top_n_key} ||
1689 $value3 <=> $href3->{$top_n_key} ||
1690 $top_n_key cmp $key) == 1
1691 )
1692 ) {
1693 $insert_position = $i;
1694 last;
1695 }
1696 }
1697
1698 # Remove the last element, then insert the new one.
1699 $#top_n_keys = $n_minus_2;
1700 splice(@top_n_keys,$insert_position,0,$key);
1701
1702 # Extract our new minimum values.
1703 $top_n_key = $top_n_keys[$n_minus_1];
1704 if ($top_n_key ne '_') {
1705 $minimum_value1 = $href1->{$top_n_key};
1706 $minimum_value2 = $href2->{$top_n_key};
1707 $minimum_value3 = $href3->{$top_n_key};
1708 }
1709 }
1710
1711 # Return the top n list, grepping out non-existant values, just in case
1712 # we didn't have that many values.
1713 return(grep(!/^_$/,@top_n_keys));
1714 }
1715
1716
1717
1718 #######################################################################
1719 # html_header();
1720 #
1721 # $header = html_header($title);
1722 #
1723 # Print our HTML header and start the <body> block.
1724 #######################################################################
1725 sub html_header {
1726 my($title) = @_;
1727 my $text = << "EoText";
1728 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1729 <html>
1730 <head>
1731 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1732 <title>$title</title>
1733 </head>
1734 <body bgcolor="white">
1735 <h1>$title</h1>
1736 EoText
1737 return $text;
1738 }
1739
1740
1741
1742 #######################################################################
1743 # help();
1744 #
1745 # help();
1746 #
1747 # Display usage instructions and exit.
1748 #######################################################################
1749 sub help {
1750 print << "EoText";
1751
1752 eximstats Version $VERSION
1753
1754 Usage:
1755 eximstats [Output] [Options] mainlog1 mainlog2 ...
1756 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1757
1758 Examples:
1759 eximstats -html=eximstats.html mainlog1 mainlog2 ...
1760 eximstats mainlog1 mainlog2 ... > report.txt
1761
1762 Parses exim mainlog or syslog files and generates a statistical analysis
1763 of the messages processed.
1764
1765 Valid output types are:
1766 -txt[=<file>] plain text (default unless no other type is specified)
1767 -html[=<file>] HTML
1768 -xls[=<file>] Excel
1769 With no type and file given, defaults to -txt and STDOUT.
1770
1771 Valid options are:
1772 -h<number> histogram divisions per hour. The default is 1, and
1773 0 suppresses histograms. Other valid values are:
1774 2, 3, 5, 10, 15, 20, 30 or 60.
1775 -ne don't display error information
1776 -nr don't display relaying information
1777 -nr/pattern/ don't display relaying information that matches
1778 -nt don't display transport information
1779 -nt/pattern/ don't display transport information that matches
1780 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1781 -t<number> display top <number> sources/destinations
1782 default is 50, 0 suppresses top listing
1783 -tnl omit local sources/destinations in top listing
1784 -t_remote_users show top user sources/destinations from non-local domains
1785 -q<list> list of times for queuing information. -q0 suppresses.
1786 -show_rt<list> Show the receipt times for all the messages.
1787 -show_dt<list> Show the delivery times for all the messages.
1788 <list> is an optional list of times in seconds.
1789 Eg -show_rt1,2,4,8.
1790
1791 -include_original_destination show both the final and original
1792 destinations in the results rather than just the final ones.
1793
1794 -byhost show results by sending host (default unless bydomain or
1795 byemail is specified)
1796 -bydomain show results by sending domain.
1797 -byemail show results by sender's email address
1798 -byedomain show results by sender's email domain
1799 -bylocaldomain show results by local domain
1800
1801 -pattern "Description" /pattern/
1802 Count lines matching specified patterns and show them in
1803 the results. It can be specified multiple times. Eg:
1804 -pattern 'Refused connections' '/refused connection/'
1805
1806 -merge merge previously generated reports into a new report
1807
1808 -charts Create charts (this requires the GD::Graph modules).
1809 Only valid with -html.
1810 -chartdir <dir> Create the charts' png files in the directory <dir>
1811 -chartrel <dir> Specify the relative directory for the "img src=" tags
1812 from where to include the charts in the html file
1813 -chartdir and -chartrel default to '.'
1814
1815 -emptyok It is OK if there is no valid input, don't print an error.
1816
1817 -d Debug mode - dump the eval'ed parser onto STDERR.
1818
1819 EoText
1820
1821 exit 1;
1822 }
1823
1824
1825
1826 #######################################################################
1827 # generate_parser();
1828 #
1829 # $parser = generate_parser();
1830 #
1831 # This subroutine generates the parsing routine which will be
1832 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1833 # This improves performance depending on what bits you take out or add.
1834 #
1835 # I've tested using study(), but this does not improve performance.
1836 #
1837 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1838 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1839 # the expression evaluates to true, then it is included/excluded accordingly.
1840 #######################################################################
1841 sub generate_parser {
1842 my $parser = '
1843 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1844 my($tod,$m_hour,$m_min,$id,$flag,$extra,$length);
1845 my($seconds,$queued,$rcpt_time,$local_domain);
1846 my $rej_id = 0;
1847 while (<$fh>) {
1848
1849 # Convert syslog lines to mainlog format.
1850 if (! /^\\d{4}/) {
1851 next unless s/^.*? exim\\b.*?: //;
1852 }
1853
1854 $length = length($_);
1855 next if ($length < 38);
1856 next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)( \\[\\d+\\])?/o;
1857
1858 ($tod,$m_hour,$m_min) = ($1,$2,$3);
1859
1860 # PH - watch for GMT offsets in the timestamp.
1861 if (defined($4)) {
1862 $extra = 6;
1863 next if ($length < 44);
1864 }
1865 else {
1866 $extra = 0;
1867 }
1868
1869 # PH - watch for PID added after the timestamp.
1870 if (defined($5)) {
1871 $extra += length($5);
1872 next if ($length < 38 + $extra);
1873 }
1874
1875 $id = substr($_, 20 + $extra, 16);
1876 $flag = substr($_, 37 + $extra, 2);
1877
1878 if ($flag !~ /^([<>=*-]+|SA)$/ && /rejected|refused|dropped/) {
1879 $flag = "Re";
1880 $extra -= 3;
1881 }
1882
1883 # Rejects can have no MSGID...
1884 if ($flag eq "Re" && $id !~ /^[-0-9a-zA-Z]+$/) {
1885 $id = "reject:" . ++$rej_id;
1886 $extra -= 17;
1887 }
1888 ';
1889
1890 # Watch for user specified patterns.
1891 my $user_pattern_index = 0;
1892 foreach (@user_patterns) {
1893 $user_pattern_totals[$user_pattern_index] = 0;
1894 $parser .= " if ($_) {\n";
1895 $parser .= " \$user_pattern_totals[$user_pattern_index]++;\n";
1896 $parser .= " \$user_pattern_interval_count[$user_pattern_index][(\$m_hour*60 + \$m_min)/$hist_interval]++;\n" if ($hist_opt > 0);
1897 $parser .= " }\n";
1898 $user_pattern_index++;
1899 }
1900
1901 $parser .= '
1902 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co|SA|Re/);
1903
1904 #Strip away the timestamp, ID and flag to speed up later pattern matches.
1905 #The flags include Co (Completed), Re (Rejected), and SA (SpamAssassin).
1906 $_ = substr($_, 40 + $extra); # PH
1907
1908 # Alias @message to the array of information about the message.
1909 # This minimises the number of calls to hash functions.
1910 $messages{$id} = [] unless exists $messages{$id};
1911 *message = $messages{$id};
1912
1913
1914 # JN - Skip over certain transports as specified via the "-nt/.../" command
1915 # line switch (where ... is a perl style regular expression). This is
1916 # required so that transports that skew stats such as SpamAssassin can be
1917 # ignored.
1918 #IFDEF ($transport_pattern)
1919 if (/\\sT=(\\S+)/) {
1920 next if ($1 =~ /$transport_pattern/o) ;
1921 }
1922 #ENDIF ($transport_pattern)
1923
1924
1925
1926 # Do some pattern matches to get the host and IP address.
1927 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1928 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1929 # We do 2 separate matches to keep the matches simple and fast.
1930 # Host is local unless otherwise specified.
1931 # Watch out for "H=([IpAddr])" in case they send "[IpAddr]" as their HELO!
1932 $ip = (/\\bH=(?:|.*? )(\\[[^]]+\\])/) ? $1
1933 # 2008-03-31 06:25:22 Connection from [213.246.33.217]:39456 refused: too many connections from that IP address // .hs
1934 : (/Connection from (\[\S+\])/) ? $1
1935 # 2008-03-31 06:52:40 SMTP call from mail.cacoshrf.com (ccsd02.ccsd.local) [69.24.118.229]:4511 dropped: too many nonmail commands (last was "RSET") // .hs
1936 : (/SMTP call from .*?(\[\S+\])/) ? $1
1937 : "local";
1938 $host = (/\\bH=(\\S+)/) ? $1 : "local";
1939
1940 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1941
1942 #IFDEF ($do_sender{Domain})
1943 if ($host =~ /^\\[/ || $host =~ /^[\\d\\.]+$/) {
1944 # Host is just an IP address.
1945 $domain = $host;
1946 }
1947 elsif ($host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1948 # Remove the host portion from the DNS name. We ensure that we end up
1949 # with at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1950 $domain = lc("$1.$2");
1951 $domain =~ s/^\\.//; #Remove preceding dot.
1952 }
1953 #ENDIF ($do_sender{Domain})
1954
1955 #IFDEF ($do_sender{Email})
1956 #IFDEF ($include_original_destination)
1957 # Catch both "a@b.com <c@d.com>" and "e@f.com"
1958 #$email = (/^(\S+) (<(\S*?)>)?/) ? $3 || $1 : "";
1959 $email = (/^(\S+ (<[^@>]+@?[^>]*>)?)/) ? $1 : "";
1960 chomp($email);
1961 #ENDIF ($include_original_destination)
1962
1963 #IFNDEF ($include_original_destination)
1964 $email = (/^(\S+)/) ? $1 : "";
1965 #ENDIF ($include_original_destination)
1966 #ENDIF ($do_sender{Email})
1967
1968 #IFDEF ($do_sender{Edomain})
1969 if (/^(<>|blackhole)/) {
1970 $edomain = $1;
1971 }
1972 #IFDEF ($include_original_destination)
1973 elsif (/^(\S+ (<\S*?\\@(\S+?)>)?)/) {
1974 $edomain = $1;
1975 chomp($edomain);
1976 $edomain =~ s/@(\S+?)>/"@" . lc($1) . ">"/e;
1977 }
1978 #ENDIF ($include_original_destination)
1979 #IFNDEF ($include_original_destination)
1980 elsif (/^\S*?\\@(\S+)/) {
1981 $edomain = lc($1);
1982 }
1983 #ENDIF ($include_original_destination)
1984 else {
1985 $edomain = "";
1986 }
1987
1988 #ENDIF ($do_sender{Edomain})
1989
1990 if ($tod lt $begin) {
1991 $begin = $tod;
1992 }
1993 elsif ($tod gt $end) {
1994 $end = $tod;
1995 }
1996
1997
1998 if ($flag eq "<=") {
1999 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
2000 $message[$SIZE] = $thissize;
2001 $message[$PROTOCOL] = (/ P=(\S+)/) ? $1 : undef;
2002
2003 #IFDEF ($show_relay)
2004 if ($host ne "local") {
2005 # Save incoming information in case it becomes interesting
2006 # later, when delivery lines are read.
2007 my($from) = /^(\\S+)/;
2008 $message[$FROM_HOST] = "$host$ip";
2009 $message[$FROM_ADDRESS] = $from;
2010 }
2011 #ENDIF ($show_relay)
2012
2013 #IFDEF ($local_league_table || $include_remote_users)
2014 if (/\sU=(\\S+)/) {
2015 my $user = $1;
2016
2017 #IFDEF ($local_league_table && $include_remote_users)
2018 { #Store both local and remote users.
2019 #ENDIF ($local_league_table && $include_remote_users)
2020
2021 #IFDEF ($local_league_table && ! $include_remote_users)
2022 if ($host eq "local") { #Store local users only.
2023 #ENDIF ($local_league_table && ! $include_remote_users)
2024
2025 #IFDEF ($include_remote_users && ! $local_league_table)
2026 if ($host ne "local") { #Store remote users only.
2027 #ENDIF ($include_remote_users && ! $local_league_table)
2028
2029 ++$received_count_user{$user};
2030 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
2031 }
2032 }
2033 #ENDIF ($local_league_table || $include_remote_users)
2034
2035 #IFDEF ($do_sender{Host})
2036 ++$received_count{Host}{$host};
2037 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
2038 #ENDIF ($do_sender{Host})
2039
2040 #IFDEF ($do_sender{Domain})
2041 if ($domain) {
2042 ++$received_count{Domain}{$domain};
2043 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
2044 }
2045 #ENDIF ($do_sender{Domain})
2046
2047 #IFDEF ($do_sender{Email})
2048 ++$received_count{Email}{$email};
2049 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
2050 #ENDIF ($do_sender{Email})
2051
2052 #IFDEF ($do_sender{Edomain})
2053 ++$received_count{Edomain}{$edomain};
2054 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
2055 #ENDIF ($do_sender{Edomain})
2056
2057 ++$total_received_count;
2058 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
2059
2060 #IFDEF ($#queue_times >= 0 || $#rcpt_times >= 0)
2061 $message[$ARRIVAL_TIME] = $tod;
2062 #ENDIF ($#queue_times >= 0 || $#rcpt_times >= 0)
2063
2064 #IFDEF ($hist_opt > 0)
2065 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2066 #ENDIF ($hist_opt > 0)
2067 }
2068
2069 elsif ($flag eq "=>") {
2070 $size = $message[$SIZE] || 0;
2071 if ($host ne "local") {
2072 $message[$REMOTE_DELIVERED] = 1;
2073
2074
2075 #IFDEF ($show_relay)
2076 # Determine relaying address if either only one address listed,
2077 # or two the same. If they are different, it implies a forwarding
2078 # or aliasing, which is not relaying. Note that for multi-aliased
2079 # addresses, there may be a further address between the first
2080 # and last.
2081
2082 if (defined $message[$FROM_HOST]) {
2083 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
2084 ($old,$new) = ($1,$2);
2085 }
2086 else {
2087 $old = $new = "";
2088 }
2089
2090 if ("\\L$new" eq "\\L$old") {
2091 ($old) = /^(\\S+)/ if $old eq "";
2092 my $key = "H=\\L$message[$FROM_HOST]\\E A=\\L$message[$FROM_ADDRESS]\\E => " .
2093 "H=\\L$host\\E$ip A=\\L$old\\E";
2094 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2095 $relayed{$key} = 0 if !defined $relayed{$key};
2096 ++$relayed{$key};
2097 }
2098 else {
2099 ++$relayed_unshown;
2100 }
2101 }
2102 }
2103 #ENDIF ($show_relay)
2104
2105 }
2106
2107 #IFDEF ($local_league_table || $include_remote_users)
2108 #IFDEF ($local_league_table && $include_remote_users)
2109 { #Store both local and remote users.
2110 #ENDIF ($local_league_table && $include_remote_users)
2111
2112 #IFDEF ($local_league_table && ! $include_remote_users)
2113 if ($host eq "local") { #Store local users only.
2114 #ENDIF ($local_league_table && ! $include_remote_users)
2115
2116 #IFDEF ($include_remote_users && ! $local_league_table)
2117 if ($host ne "local") { #Store remote users only.
2118 #ENDIF ($include_remote_users && ! $local_league_table)
2119
2120 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2121 #IFDEF ($include_original_destination)
2122 {
2123 #ENDIF ($include_original_destination)
2124 #IFNDEF ($include_original_destination)
2125 if ($user =~ /^[\\/|]/) {
2126 #ENDIF ($include_original_destination)
2127 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2128 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2129 if (defined $parent) {
2130 $user = "$user $parent";
2131 #IFDEF ($do_local_domain)
2132 if ($parent =~ /\\@(.+)>/) {
2133 $local_domain = lc($1);
2134 ++$delivered_messages_local_domain{$local_domain};
2135 ++$delivered_addresses_local_domain{$local_domain};
2136 add_volume(\\$delivered_data_local_domain{$local_domain},\\$delivered_data_gigs_local_domain{$local_domain},$size);
2137 }
2138 #ENDIF ($do_local_domain)
2139 }
2140 }
2141 ++$delivered_messages_user{$user};
2142 ++$delivered_addresses_user{$user};
2143 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
2144 }
2145 }
2146 #ENDIF ($local_league_table || $include_remote_users)
2147
2148 #IFDEF ($do_sender{Host})
2149 $delivered_messages{Host}{$host}++;
2150 $delivered_addresses{Host}{$host}++;
2151 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
2152 #ENDIF ($do_sender{Host})
2153 #IFDEF ($do_sender{Domain})
2154 if ($domain) {
2155 ++$delivered_messages{Domain}{$domain};
2156 ++$delivered_addresses{Domain}{$domain};
2157 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
2158 }
2159 #ENDIF ($do_sender{Domain})
2160 #IFDEF ($do_sender{Email})
2161 ++$delivered_messages{Email}{$email};
2162 ++$delivered_addresses{Email}{$email};
2163 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
2164 #ENDIF ($do_sender{Email})
2165 #IFDEF ($do_sender{Edomain})
2166 ++$delivered_messages{Edomain}{$edomain};
2167 ++$delivered_addresses{Edomain}{$edomain};
2168 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
2169 #ENDIF ($do_sender{Edomain})
2170
2171 ++$total_delivered_messages;
2172 ++$total_delivered_addresses;
2173 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
2174
2175 #IFDEF ($show_transport)
2176 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
2177 ++$transported_count{$transport};
2178 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
2179 #ENDIF ($show_transport)
2180
2181 #IFDEF ($hist_opt > 0)
2182 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2183 #ENDIF ($hist_opt > 0)
2184
2185 #IFDEF ($#delivery_times > 0)
2186 if (/ DT=(\S+)/) {
2187 $seconds = wdhms_seconds($1);
2188 for ($i = 0; $i <= $#delivery_times; $i++) {
2189 if ($seconds < $delivery_times[$i]) {
2190 ++$dt_all_bin[$i];
2191 ++$dt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2192 last;
2193 }
2194 }
2195 if ($i > $#delivery_times) {
2196 ++$dt_all_overflow;
2197 ++$dt_remote_overflow if $message[$REMOTE_DELIVERED];
2198 }
2199 }
2200 #ENDIF ($#delivery_times > 0)
2201
2202 }
2203
2204 elsif ($flag eq "->") {
2205
2206 #IFDEF ($local_league_table || $include_remote_users)
2207 #IFDEF ($local_league_table && $include_remote_users)
2208 { #Store both local and remote users.
2209 #ENDIF ($local_league_table && $include_remote_users)
2210
2211 #IFDEF ($local_league_table && ! $include_remote_users)
2212 if ($host eq "local") { #Store local users only.
2213 #ENDIF ($local_league_table && ! $include_remote_users)
2214
2215 #IFDEF ($include_remote_users && ! $local_league_table)
2216 if ($host ne "local") { #Store remote users only.
2217 #ENDIF ($include_remote_users && ! $local_league_table)
2218
2219 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2220 #IFDEF ($include_original_destination)
2221 {
2222 #ENDIF ($include_original_destination)
2223 #IFNDEF ($include_original_destination)
2224 if ($user =~ /^[\\/|]/) {
2225 #ENDIF ($include_original_destination)
2226 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2227 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2228 $user = "$user $parent" if defined $parent;
2229 }
2230 ++$delivered_addresses_user{$user};
2231 }
2232 }
2233 #ENDIF ($local_league_table || $include_remote_users)
2234
2235 #IFDEF ($do_sender{Host})
2236 $delivered_addresses{Host}{$host}++;
2237 #ENDIF ($do_sender{Host})
2238 #IFDEF ($do_sender{Domain})
2239 if ($domain) {
2240 ++$delivered_addresses{Domain}{$domain};
2241 }
2242 #ENDIF ($do_sender{Domain})
2243 #IFDEF ($do_sender{Email})
2244 ++$delivered_addresses{Email}{$email};
2245 #ENDIF ($do_sender{Email})
2246 #IFDEF ($do_sender{Edomain})
2247 ++$delivered_addresses{Edomain}{$edomain};
2248 #ENDIF ($do_sender{Edomain})
2249
2250 ++$total_delivered_addresses;
2251 }
2252
2253 elsif ($flag eq "==" && defined($message[$SIZE]) && !defined($message[$DELAYED])) {
2254 ++$delayed_count;
2255 $message[$DELAYED] = 1;
2256 }
2257
2258 elsif ($flag eq "**") {
2259 if (defined ($message[$SIZE])) {
2260 unless (defined $message[$HAD_ERROR]) {
2261 ++$message_errors;
2262 $message[$HAD_ERROR] = 1;
2263 }
2264 }
2265
2266 #IFDEF ($show_errors)
2267 ++$errors_count{$_};
2268 #ENDIF ($show_errors)
2269
2270 }
2271
2272 elsif ($flag eq "Co") {
2273 #Completed?
2274 #IFDEF ($#queue_times >= 0)
2275 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2276
2277 for ($i = 0; $i <= $#queue_times; $i++) {
2278 if ($queued < $queue_times[$i]) {
2279 ++$qt_all_bin[$i];
2280 ++$qt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2281 last;
2282 }
2283 }
2284 if ($i > $#queue_times) {
2285 ++$qt_all_overflow;
2286 ++$qt_remote_overflow if $message[$REMOTE_DELIVERED];
2287 }
2288 #ENDIF ($#queue_times >= 0)
2289
2290 #IFDEF ($#rcpt_times >= 0)
2291 if (/ QT=(\S+)/) {
2292 $seconds = wdhms_seconds($1);
2293 #Calculate $queued if not previously calculated above.
2294 #IFNDEF ($#queue_times >= 0)
2295 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2296 #ENDIF ($#queue_times >= 0)
2297 $rcpt_time = $seconds - $queued;
2298 my($protocol);
2299
2300 if (defined $message[$PROTOCOL]) {
2301 $protocol = $message[$PROTOCOL];
2302
2303 # Create the bin if its not already defined.
2304 unless (exists $rcpt_times_bin{$protocol}) {
2305 initialise_rcpt_times($protocol);
2306 }
2307 }
2308
2309
2310 for ($i = 0; $i <= $#rcpt_times; ++$i) {
2311 if ($rcpt_time < $rcpt_times[$i]) {
2312 ++$rcpt_times_bin{all}[$i];
2313 ++$rcpt_times_bin{$protocol}[$i] if defined $protocol;
2314 last;
2315 }
2316 }
2317
2318 if ($i > $#rcpt_times) {
2319 ++$rcpt_times_overflow{all};
2320 ++$rcpt_times_overflow{$protocol} if defined $protocol;
2321 }
2322 }
2323 #ENDIF ($#rcpt_times >= 0)
2324
2325 delete($messages{$id});
2326 }
2327 elsif ($flag eq "SA") {
2328 $ip = (/From.*?(\\[[^]]+\\])/ || /\\((local)\\)/) ? $1 : "";
2329 #SpamAssassin message
2330 if (/Action: ((permanently|temporarily) rejected message|flagged as Spam but accepted): score=(\d+\.\d)/) {
2331 #add_volume(\\$spam_score,\\$spam_score_gigs,$3);
2332 ++$spam_count_by_ip{$ip};
2333 } elsif (/Action: scanned but message isn\'t spam: score=(-?\d+\.\d)/) {
2334 #add_volume(\\$ham_score,\\$ham_score_gigs,$1);
2335 ++$ham_count_by_ip{$ip};
2336 } elsif (/(Not running SA because SAEximRunCond expanded to false|check skipped due to message size)/) {
2337 ++$ham_count_by_ip{$ip};
2338 }
2339 }
2340
2341 # Look for Reject messages or blackholed messages (deliveries
2342 # without a transport)
2343 if ($flag eq "Re" || ($flag eq "=>" && ! /\\sT=\\S+/)) {
2344 # Correct the IP address for rejects:
2345 # rejected EHLO from my.test.net [10.0.0.5]: syntactically invalid argument(s):
2346 # rejected EHLO from [10.0.0.6]: syntactically invalid argument(s):
2347 $ip = $1 if ($ip eq "local" && /^rejected [HE][HE]LO from .*?(\[.+?\]):/);
2348 if (/SpamAssassin/) {
2349 ++$rejected_count_by_reason{"Rejected by SpamAssassin"};
2350 ++$rejected_count_by_ip{$ip};
2351 }
2352 elsif (
2353 /(temporarily rejected [A-Z]*) .*?(: .*?)(:|\s*$)/
2354 ) {
2355 ++$temporarily_rejected_count_by_reason{"\u$1$2"};
2356 ++$temporarily_rejected_count_by_ip{$ip};
2357 }
2358 elsif (
2359 /(temporarily refused connection)/
2360 ) {
2361 ++$temporarily_rejected_count_by_reason{"\u$1"};
2362 ++$temporarily_rejected_count_by_ip{$ip};
2363 }
2364 elsif (
2365 /(listed at [^ ]+)/ ||
2366 /(Forged IP detected in HELO)/ ||
2367 /(Invalid domain or IP given in HELO\/EHLO)/ ||
2368 /(unqualified recipient rejected)/ ||
2369 /(closed connection (after|in response) .*?)\s*$/ ||
2370 /(sender rejected)/ ||
2371 # 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.
2372 # 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.
2373 / rejected after DATA: (.*)/ ||
2374 / (rejected DATA: .*)/ ||
2375 /.DATA ACL discarded recipients.: (.*)/ ||
2376 /rejected after DATA: (unqualified address not permitted)/ ||
2377 /(VRFY rejected)/ ||
2378 # /(sender verify (defer|fail))/i ||
2379 /(too many recipients)/ ||
2380 /(refused relay.*?) to/ ||
2381 /(rejected by non-SMTP ACL: .*)/ ||
2382 /(rejected by local_scan.*)/ ||
2383 # SMTP call from %s dropped: too many syntax or protocol errors (last command was "%s"
2384 # SMTP call from %s dropped: too many nonmail commands
2385 /(dropped: too many ((nonmail|unrecognized) commands|syntax or protocol errors))/ ||
2386
2387 # local_scan() function crashed with signal %d - message temporarily rejected
2388 # local_scan() function timed out - message temporarily rejected
2389 /(local_scan.. function .* - message temporarily rejected)/ ||
2390 # SMTP protocol synchronization error (input sent without waiting for greeting): rejected connection from %s
2391 /(SMTP protocol .*?(error|violation))/ ||
2392 /(message too big)/
2393 ) {
2394 ++$rejected_count_by_reason{"\u$1"};
2395 ++$rejected_count_by_ip{$ip};
2396 }
2397 elsif (/rejected [HE][HE]LO from [^:]*: syntactically invalid argument/) {
2398 ++$rejected_count_by_reason{"Rejected HELO/EHLO: syntactically invalid argument"};
2399 ++$rejected_count_by_ip{$ip};
2400 }
2401 elsif (/response to "RCPT TO.*? was: (.*)/) {
2402 ++$rejected_count_by_reason{"Response to RCPT TO was: $1"};
2403 ++$rejected_count_by_ip{$ip};
2404 }
2405 elsif (
2406 /(lookup of host )\S+ (failed)/ ||
2407
2408 # rejected from <%s>%s%s%s%s: message too big:
2409 /(rejected [A-Z]*) .*?(: .*?)(:|\s*$)/ ||
2410 # refused connection from %s (host_reject_connection)
2411 # refused connection from %s (tcp wrappers)
2412 /(refused connection )from.*? (\(.*)/ ||
2413
2414 # 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
2415 # 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.
2416 /(error from remote mailer after .*?:).*(: .*?)(:|\s*$)/ ||
2417
2418 # a.b.c F=<a@b.c> rejected after DATA: "@" or "." expected after "Undisclosed-Recipient": failing address in "To" header is: <Undisclosed-Recipient:;>
2419 /rejected after DATA: ("." or "." expected).*?(: failing address in .*? header)/ ||
2420
2421 # connection from %s refused load average = %.2f
2422 /(Connection )from.*? (refused: load average)/ ||
2423 # connection from %s refused (IP options)
2424 # Connection from %s refused: too many connections
2425 # connection from %s refused
2426 /([Cc]onnection )from.*? (refused.*)/ ||
2427 # [10.0.0.1]: connection refused
2428 /: (Connection refused)()/
2429 ) {
2430 ++$rejected_count_by_reason{"\u$1$2"};
2431 ++$rejected_count_by_ip{$ip};
2432 }
2433 elsif (
2434 # 2008-03-31 06:25:22 H=mail.densitron.com [216.70.140.224]:45386 temporarily rejected connection in "connect" ACL: too fast reconnects // .hs
2435 # 2008-03-31 06:25:22 H=mail.densitron.com [216.70.140.224]:45386 temporarily rejected connection in "connect" ACL // .hs
2436 /(temporarily rejected connection in .*?ACL:?.*)/
2437 ) {
2438 ++$temporarily_rejected_count_by_ip{$ip};
2439 ++$temporarily_rejected_count_by_reason{"\u$1"};
2440 }
2441 else {
2442 ++$rejected_count_by_reason{Unknown};
2443 ++$rejected_count_by_ip{$ip};
2444 print STDERR "Unknown rejection: $_" if $debug;
2445 }
2446 }
2447 }';
2448
2449 # We now do a 'C preprocessor style operation on our parser
2450 # to remove bits not in use.
2451 my(%defines_in_operation,$removing_lines,$processed_parser);
2452 foreach (split (/\n/,$parser)) {
2453 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
2454 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
2455 $defines_in_operation{$1} = 1;
2456 $removing_lines = 1;
2457 }
2458
2459 # Convert constants.
2460 while (/(\$[A-Z][A-Z_]*)\b/) {
2461 my $constant = eval $1;
2462 s/(\$[A-Z][A-Z_]*)\b/$constant/;
2463 }
2464
2465 $processed_parser .= $_."\n" unless $removing_lines;
2466
2467 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
2468 delete $defines_in_operation{$1};
2469 unless (keys %defines_in_operation) {
2470 $removing_lines = 0;
2471 }
2472 }
2473 }
2474 print STDERR "# START OF PARSER:$processed_parser\n# END OF PARSER\n\n" if $debug;
2475
2476 return $processed_parser;
2477 }
2478
2479
2480
2481 #######################################################################
2482 # parse();
2483 #
2484 # parse($parser,\*FILEHANDLE);
2485 #
2486 # This subroutine accepts a parser and a filehandle from main and parses each
2487 # line. We store the results into global variables.
2488 #######################################################################
2489 sub parse {
2490 my($parser,$fh) = @_;
2491
2492 if ($merge_reports) {
2493 parse_old_eximstat_reports($fh);
2494 }
2495 else {
2496 eval $parser;
2497 die ($@) if $@;
2498 }
2499
2500 }
2501
2502
2503
2504 #######################################################################
2505 # print_header();
2506 #
2507 # print_header();
2508 #
2509 # Print our headers and contents.
2510 #######################################################################
2511 sub print_header {
2512
2513
2514 my $title = "Exim statistics from $begin to $end";
2515
2516 print $txt_fh "\n$title\n" if $txt_fh;
2517 if ($htm_fh) {
2518 print $htm_fh html_header($title);
2519 print $htm_fh "<ul>\n";
2520 print $htm_fh "<li><a href=\"#Grandtotal\">Grand total summary</a>\n";
2521 print $htm_fh "<li><a href=\"#Patterns\">User Specified Patterns</a>\n" if @user_patterns;
2522 print $htm_fh "<li><a href=\"#Transport\">Deliveries by Transport</a>\n" if $show_transport;
2523 if ($hist_opt) {
2524 print $htm_fh "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
2525 print $htm_fh "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
2526 }
2527
2528 if ($#queue_times >= 0) {
2529 print $htm_fh "<li><a href=\"#Time spent on the queue all messages\">Time spent on the queue: all messages</a>\n";
2530 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";
2531 }
2532
2533 if ($#delivery_times >= 0) {
2534 print $htm_fh "<li><a href=\"#Delivery times all messages\">Delivery times: all messages</a>\n";
2535 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";
2536 }
2537
2538 if ($#rcpt_times >= 0) {
2539 print $htm_fh "<li><a href=\"#Receipt times all messages\">Receipt times</a>\n";
2540 }
2541
2542 print $htm_fh "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
2543 if ($topcount) {
2544 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;
2545 foreach ('Host','Domain','Email','Edomain') {
2546 next unless $do_sender{$_};
2547 print $htm_fh "<li><a href=\"#Sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
2548 print $htm_fh "<li><a href=\"#Sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
2549 }
2550 if (($local_league_table || $include_remote_users) && %received_count_user) {
2551 print $htm_fh "<li><a href=\"#Local sender count\">Top $topcount local senders by message count</a>\n";
2552 print $htm_fh "<li><a href=\"#Local sender volume\">Top $topcount local senders by volume</a>\n";
2553 }
2554 foreach ('Host','Domain','Email','Edomain') {
2555 next unless $do_sender{$_};
2556 print $htm_fh "<li><a href=\"#$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
2557 print $htm_fh "<li><a href=\"#$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
2558 }
2559 if (($local_league_table || $include_remote_users) && %delivered_messages_user) {
2560 print $htm_fh "<li><a href=\"#Local destination count\">Top $topcount local destinations by message count</a>\n";
2561 print $htm_fh "<li><a href=\"#Local destination volume\">Top $topcount local destinations by volume</a>\n";
2562 }
2563 if (($local_league_table || $include_remote_users) && %delivered_messages_local_domain) {
2564 print $htm_fh "<li><a href=\"#Local domain destination count\">Top $topcount local domain destinations by message count</a>\n";
2565 print $htm_fh "<li><a href=\"#Local domain destination volume\">Top $topcount local domain destinations by volume</a>\n";
2566 }
2567
2568 print $htm_fh "<li><a href=\"#Rejected ip count\">Top $topcount rejected ips by message count</a>\n" if %rejected_count_by_ip;
2569 print $htm_fh "<li><a href=\"#Temporarily rejected ip count\">Top $topcount temporarily rejected ips by message count</a>\n" if %temporarily_rejected_count_by_ip;
2570 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;
2571
2572 }
2573 print $htm_fh "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
2574 print $htm_fh "</ul>\n<hr>\n";
2575 }
2576 if ($xls_fh)
2577 {
2578 $ws_global->write($row++, $col+0, "Exim Statistics", $f_header1);
2579 &set_worksheet_line($ws_global, $row, $col, ["from:", $begin, "to:", $end], $f_default);
2580 $row+=2;
2581 }
2582 }
2583
2584
2585 #######################################################################
2586 # print_grandtotals();
2587 #
2588 # print_grandtotals();
2589 #
2590 # Print the grand totals.
2591 #######################################################################
2592 sub print_grandtotals {
2593
2594 # Get the sender by headings and results. This is complicated as we can have
2595 # different numbers of columns.
2596 my($sender_txt_header,$sender_txt_format,$sender_html_format);
2597 my(@received_totals,@delivered_totals);
2598 my($row_tablehead, $row_max);
2599 my(@col_headers) = ('TOTAL', 'Volume', 'Messages', 'Addresses');
2600
2601 foreach ('Host','Domain','Email','Edomain') {
2602 next unless $do_sender{$_};
2603 if ($merge_reports) {
2604 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
2605 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
2606 }
2607 else {
2608 push(@received_totals,scalar(keys %{$received_data{$_}}));
2609 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
2610 }
2611 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
2612 $sender_html_format .= "<td align=\"right\">%s</td>";
2613 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6s";
2614 push(@col_headers,"${_}s");
2615 }
2616
2617 my $txt_format1 = " %-16s %9s %6d %6s $sender_txt_format";
2618 my $txt_format2 = " %6d %4.1f%% %6d %4.1f%%",
2619 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";
2620 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>";
2621
2622 if ($txt_fh) {
2623 my $sender_spaces = " " x length($sender_txt_header);
2624 print $txt_fh "\n";
2625 print $txt_fh "Grand total summary\n";
2626 print $txt_fh "-------------------\n";
2627 print $txt_fh " $sender_spaces At least one address\n";
2628 print $txt_fh " TOTAL Volume Messages Addresses $sender_txt_header Delayed Failed\n";
2629 }
2630 if ($htm_fh) {
2631 print $htm_fh "<a name=\"Grandtotal\"></a>\n";
2632 print $htm_fh "<h2>Grand total summary</h2>\n";
2633 print $htm_fh "<table border=1>\n";
2634 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";
2635 }
2636 if ($xls_fh) {
2637 $ws_global->write($row++, 0, "Grand total summary", $f_header2);
2638 $ws_global->write($row, 0, \@col_headers, $f_header2);
2639 $ws_global->merge_range($row, scalar(@col_headers), $row, scalar(@col_headers)+1, "At least one addr Delayed", $f_header2_m);
2640 $ws_global->merge_range($row, scalar(@col_headers)+2, $row, scalar(@col_headers)+3, "At least one addr Failed", $f_header2_m);
2641 #$ws_global->write(++$row, scalar(@col_headers), ['Total','Percent','Total','Percent'], $f_header2);
2642 }
2643
2644
2645 my($volume,$failed_count);
2646 if ($merge_reports) {
2647 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
2648 $total_received_count = get_report_total($report_totals{Received},'Messages');
2649 $failed_count = get_report_total($report_totals{Received},'Failed');
2650 $delayed_count = get_report_total($report_totals{Received},'Delayed');
2651 }
2652 else {
2653 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
2654 $failed_count = $message_errors;
2655 }
2656
2657 {
2658 no integer;
2659
2660 my @content=(
2661 $volume,$total_received_count,'',
2662 @received_totals,
2663 $delayed_count,
2664 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
2665 $failed_count,
2666 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0
2667 );
2668
2669 printf $txt_fh ("$txt_format1$txt_format2\n", 'Received', @content) if $txt_fh;
2670 printf $htm_fh ("$htm_format1$htm_format2\n", 'Received', @content) if $htm_fh;
2671 if ($xls_fh) {
2672 $ws_global->write(++$row, 0, 'Received', $f_default);
2673 for (my $i=0; $i < scalar(@content); $i++) {
2674 if ($i == 4 || $i == 6) {
2675 $ws_global->write($row, $i+1, $content[$i]/100, $f_percent);
2676 }
2677 else {
2678 $ws_global->write($row, $i+1, $content[$i], $f_default);
2679 }
2680 }
2681 }
2682 }
2683
2684 if ($merge_reports) {
2685 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
2686 $total_delivered_messages = get_report_total($report_totals{Delivered},'Messages');
2687 $total_delivered_addresses = get_report_total($report_totals{Delivered},'Addresses');
2688 }
2689 else {
2690 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
2691 }
2692
2693 my @content=($volume, $total_delivered_messages, $total_delivered_addresses, @delivered_totals);
2694 printf $txt_fh ("$txt_format1\n", 'Delivered', @content) if $txt_fh;
2695 printf $htm_fh ("$htm_format1\n", 'Delivered', @content) if $htm_fh;
2696
2697 if ($xls_fh) {
2698 $ws_global->write(++$row, 0, 'Delivered', $f_default);
2699 for (my $i=0; $i < scalar(@content); $i++) {
2700 $ws_global->write($row, $i+1, $content[$i], $f_default);
2701 }
2702 }
2703
2704 if ($merge_reports) {
2705 foreach ('Rejects', 'Temp Rejects', 'Ham', 'Spam') {
2706 my $messages = get_report_total($report_totals{$_},'Messages');
2707 my $addresses = get_report_total($report_totals{$_},'Addresses');
2708 if ($messages) {
2709 @content = ($_, '', $messages, '');
2710 push(@content,get_report_total($report_totals{$_},'Hosts')) if $do_sender{Host};
2711 #These rows do not have entries for the following columns (if specified)
2712 foreach ('Domain','Email','Edomain') {
2713 push(@content,'') if $do_sender{$_};
2714 }
2715
2716 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2717 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2718 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2719 }
2720 }
2721 }
2722 else {
2723 foreach my $total_aref (['Rejects',\%rejected_count_by_ip],
2724 ['Temp Rejects',\%temporarily_rejected_count_by_ip],
2725 ['Ham',\%ham_count_by_ip],
2726 ['Spam',\%spam_count_by_ip]) {
2727 #Count the number of messages of this type.
2728 my $messages = 0;
2729 map {$messages += $_} values %{$total_aref->[1]};
2730
2731 if ($messages > 0) {
2732 @content = ($total_aref->[0], '', $messages, '');
2733
2734 #Count the number of distinct IPs for the Hosts column.
2735 push(@content,scalar(keys %{$total_aref->[1]})) if $do_sender{Host};
2736
2737 #These rows do not have entries for the following columns (if specified)
2738 foreach ('Domain','Email','Edomain') {
2739 push(@content,'') if $do_sender{$_};
2740 }
2741
2742 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2743 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2744 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2745 }
2746 }
2747 }
2748
2749 printf $txt_fh "\n" if $txt_fh;
2750 printf $htm_fh "</table>\n" if $htm_fh;
2751 ++$row;
2752 }
2753
2754
2755 #######################################################################
2756 # print_user_patterns()
2757 #
2758 # print_user_patterns();
2759 #
2760 # Print the counts of user specified patterns.
2761 #######################################################################
2762 sub print_user_patterns {
2763 my $txt_format1 = " %-18s %6d";
2764 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2765
2766 if ($txt_fh) {
2767 print $txt_fh "User Specified Patterns\n";
2768 print $txt_fh "-----------------------";
2769 print $txt_fh "\n Total\n";
2770 }
2771 if ($htm_fh) {
2772 print $htm_fh "<hr><a name=\"Patterns\"></a><h2>User Specified Patterns</h2>\n";
2773 print $htm_fh "<table border=0 width=\"100%\">\n";
2774 print $htm_fh "<tr><td>\n";
2775 print $htm_fh "<table border=1>\n";
2776 print $htm_fh "<tr><th>&nbsp;</th><th>Total</th>\n";
2777 }
2778 if ($xls_fh) {
2779 $ws_global->write($row++, $col, "User Specified Patterns", $f_header2);
2780 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2781 }
2782
2783
2784 my($key);
2785 if ($merge_reports) {
2786 # We are getting our data from previous reports.
2787 foreach $key (@user_descriptions) {
2788 my $count = get_report_total($report_totals{patterns}{$key},'Total');
2789 printf $txt_fh ("$txt_format1\n",$key,$count) if $txt_fh;
2790 printf $htm_fh ("$htm_format1\n",$key,$count) if $htm_fh;
2791 if ($xls_fh)
2792 {
2793 &set_worksheet_line($ws_global, $row++, 0, [$key,$count], $f_default);
2794 }
2795 }
2796 }
2797 else {
2798 # We are getting our data from mainlog files.
2799 my $user_pattern_index = 0;
2800 foreach $key (@user_descriptions) {
2801 printf $txt_fh ("$txt_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $txt_fh;
2802 printf $htm_fh ("$htm_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $htm_fh;
2803 $ws_global->write($row++, 0, [$key,$user_pattern_totals[$user_pattern_index]]) if $xls_fh;
2804 $user_pattern_index++;
2805 }
2806 }
2807 print $txt_fh "\n" if $txt_fh;
2808 print $htm_fh "</table>\n\n" if $htm_fh;
2809 if ($xls_fh)
2810 {
2811 ++$row;
2812 }
2813
2814 if ($hist_opt > 0) {
2815 my $user_pattern_index = 0;
2816 foreach $key (@user_descriptions) {
2817 print_histogram($key, 'occurence', @{$user_pattern_interval_count[$user_pattern_index]});
2818 $user_pattern_index++;
2819 }
2820 }
2821 }
2822
2823 #######################################################################
2824 # print_rejects()
2825 #
2826 # print_rejects();
2827 #
2828 # Print statistics about rejected mail.
2829 #######################################################################
2830 sub print_rejects {
2831 my($format1,$reason);
2832
2833 my $txt_format1 = " %-40s %6d";
2834 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2835
2836 if ($txt_fh) {
2837 print $txt_fh "Rejected mail by reason\n";
2838 print $txt_fh "-----------------------";
2839 print $txt_fh "\n Total\n";
2840 }
2841 if ($htm_fh) {
2842 print $htm_fh "<hr><a name=\"patterns\"></a><h2>Rejected mail by reason</h2>\n";
2843 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2844 print $htm_fh "<tr><th>&nbsp;</th><th>Total</th>\n";
2845 }
2846 if ($xls_fh) {
2847 $ws_global->write($row++, $col, "Rejected mail by reason", $f_header2);
2848 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2849 }
2850
2851
2852 my $href = ($merge_reports) ? $report_totals{rejected_mail_by_reason} : \%rejected_count_by_reason;
2853 my(@chartdatanames, @chartdatavals_count);
2854
2855 foreach $reason (top_n_sort($topcount, $href, undef, undef)) {
2856 printf $txt_fh ("$txt_format1\n",$reason,$href->{$reason}) if $txt_fh;
2857 printf $htm_fh ("$htm_format1\n",$reason,$href->{$reason}) if $htm_fh;
2858 set_worksheet_line($ws_global, $row++, 0, [$reason,$href->{$reason}], $f_default) if $xls_fh;
2859 push(@chartdatanames, $reason);
2860 push(@chartdatavals_count, $href->{$reason});
2861 }
2862
2863 $row++ if $xls_fh;
2864 print $txt_fh "\n" if $txt_fh;
2865
2866 if ($htm_fh) {
2867 print $htm_fh "</tr></table></td><td>";
2868 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0)) {
2869 # calculate the graph
2870 my @data = (
2871 \@chartdatanames,
2872 \@chartdatavals_count
2873 );
2874 my $graph = GD::Graph::pie->new(200, 200);
2875 $graph->set(
2876 x_label => 'Rejection Reasons',
2877 y_label => 'Messages',
2878 title => 'By count',
2879 );
2880 my $gd = $graph->plot(\@data) or warn($graph->error);
2881 if ($gd) {
2882 open(IMG, ">$chartdir/rejections_count.png") or die "Could not write $chartdir/rejections_count.png: $!\n";
2883 binmode IMG;
2884 print IMG $gd->png;
2885 close IMG;
2886 print $htm_fh "<img src=\"$chartrel/rejections_count.png\">";
2887 }
2888 }
2889 print $htm_fh "</td></tr></table>\n\n";
2890 }
2891 }
2892
2893
2894
2895
2896
2897 #######################################################################
2898 # print_transport();
2899 #
2900 # print_transport();
2901 #
2902 # Print totals by transport.
2903 #######################################################################
2904 sub print_transport {
2905 my(@chartdatanames);
2906 my(@chartdatavals_count);
2907 my(@chartdatavals_vol);
2908 no integer; #Lose this for charting the data.
2909
2910 my $txt_format1 = " %-18s %6s %6d";
2911 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
2912
2913 if ($txt_fh) {
2914 print $txt_fh "Deliveries by transport\n";
2915 print $txt_fh "-----------------------";
2916 print $txt_fh "\n Volume Messages\n";
2917 }
2918 if ($htm_fh) {
2919 print $htm_fh "<hr><a name=\"Transport\"></a><h2>Deliveries by Transport</h2>\n";
2920 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2921 print $htm_fh "<tr><th>&nbsp;</th><th>Volume</th><th>Messages</th>\n";
2922 }
2923 if ($xls_fh) {
2924 $ws_global->write(++$row, $col, "Deliveries by transport", $f_header2);
2925 $ws_global->write(++$row, 1, ["Volume", "Messages"], $f_headertab);
2926 }
2927
2928 my($key);
2929 if ($merge_reports) {
2930 # We are getting our data from previous reports.
2931 foreach $key (sort keys %{$report_totals{transport}}) {
2932 my $count = get_report_total($report_totals{transport}{$key},'Messages');
2933 my @content=($key, volume_rounded($report_totals{transport}{$key}{Volume},
2934 $report_totals{transport}{$key}{'Volume-gigs'}), $count);
2935 push(@chartdatanames, $key);
2936 push(@chartdatavals_count, $count);
2937 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
2938 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2939 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2940 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2941 }
2942 }
2943 else {
2944 # We are getting our data from mainlog files.
2945 foreach $key (sort keys %transported_data) {
2946 my @content=($key, volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
2947 $transported_count{$key});
2948 push(@chartdatanames, $key);
2949 push(@chartdatavals_count, $transported_count{$key});
2950 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
2951 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2952 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2953 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2954 }
2955 }
2956 print $txt_fh "\n" if $txt_fh;
2957 if ($htm_fh) {
2958 print $htm_fh "</tr></table></td><td>";
2959
2960 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0))
2961 {
2962 # calculate the graph
2963 my @data = (
2964 \@chartdatanames,
2965 \@chartdatavals_count
2966 );
2967 my $graph = GD::Graph::pie->new(200, 200);
2968 $graph->set(
2969 x_label => 'Transport',
2970 y_label => 'Messages',
2971 title => 'By count',
2972 );
2973 my $gd = $graph->plot(\@data) or warn($graph->error);
2974 if ($gd) {
2975 open(IMG, ">$chartdir/transports_count.png") or die "Could not write $chartdir/transports_count.png: $!\n";
2976 binmode IMG;
2977 print IMG $gd->png;
2978 close IMG;
2979 print $htm_fh "<img src=\"$chartrel/transports_count.png\">";
2980 }
2981 }
2982 print $htm_fh "</td><td>";
2983
2984 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_vol > 0)) {
2985 my @data = (
2986 \@chartdatanames,
2987 \@chartdatavals_vol
2988 );
2989 my $graph = GD::Graph::pie->new(200, 200);
2990 $graph->set(
2991 title => 'By volume',
2992 );
2993 my $gd = $graph->plot(\@data) or warn($graph->error);
2994 if ($gd) {
2995 open(IMG, ">$chartdir/transports_vol.png") or die "Could not write $chartdir/transports_vol.png: $!\n";
2996 binmode IMG;
2997 print IMG $gd->png;
2998 close IMG;
2999 print $htm_fh "<img src=\"$chartrel/transports_vol.png\">";
3000 }
3001 }
3002
3003 print $htm_fh "</td></tr></table>\n\n";
3004 }
3005 }
3006
3007
3008
3009 #######################################################################
3010 # print_relay();
3011 #
3012 # print_relay();
3013 #
3014 # Print our totals by relay.
3015 #######################################################################
3016 sub print_relay {
3017 my $row_print_relay=1;
3018 my $temp = "Relayed messages";
3019 print $htm_fh "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $htm_fh;
3020 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
3021 my $shown = 0;
3022 my $spacing = "";
3023 my $txt_format = "%7d %s\n => %s\n";
3024 my $htm_format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
3025
3026 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
3027 if ($htm_fh) {
3028 print $htm_fh "<table border=1>\n";
3029 print $htm_fh "<tr><th>Count</th><th>From</th><th>To</th>\n";
3030 }
3031 if ($xls_fh) {
3032 $ws_relayed->write($row_print_relay++, $col, $temp, $f_header2);
3033 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, ["Count", "From", "To"], $f_headertab);
3034 }
3035
3036
3037 my($key);
3038 foreach $key (sort keys %relayed) {
3039 my $count = $relayed{$key};
3040 $shown += $count;
3041 $key =~ s/[HA]=//g;
3042 my($one,$two) = split(/=> /, $key);
3043 my @content=($count, $one, $two);
3044 printf $txt_fh ($txt_format, @content) if $txt_fh;
3045 printf $htm_fh ($htm_format, @content) if $htm_fh;
3046 if ($xls_fh)
3047 {
3048 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, \@content);
3049 }
3050 $spacing = "\n";
3051 }
3052
3053 print $htm_fh "</table>\n<p>\n" if $htm_fh;
3054 print $txt_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $txt_fh;
3055 print $htm_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $htm_fh;
3056 if ($xls_fh)
3057 {
3058 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$shown, "Sum of shown" ]);
3059 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$relayed_unshown, "unshown"]);
3060 $row_print_relay++;
3061 }
3062 }
3063 else {
3064 print $txt_fh "No relayed messages\n-------------------\n\n" if $txt_fh;
3065 print $htm_fh "No relayed messages\n\n" if $htm_fh;
3066 if ($xls_fh)
3067 {
3068 $row_print_relay++;
3069 }
3070 }
3071 }
3072
3073
3074
3075 #######################################################################
3076 # print_errors();
3077 #
3078 # print_errors();
3079 #
3080 # Print our errors. In HTML, we display them as a list rather than a table -
3081 # Netscape doesn't like large tables!
3082 #######################################################################
3083 sub print_errors {
3084 my $total_errors = 0;
3085 $row=1;
3086
3087 if (scalar(keys %errors_count) != 0) {
3088 my $temp = "List of errors";
3089 my $htm_format = "<li>%d - %s\n";
3090
3091 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
3092 if ($htm_fh) {
3093 print $htm_fh "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
3094 print $htm_fh "<ul><li><b>Count - Error</b>\n";
3095 }
3096 if ($xls_fh)
3097 {
3098 $ws_errors->write($row++, 0, $temp, $f_header2);
3099 &set_worksheet_line($ws_errors, $row++, 0, ["Count", "Error"], $f_headertab);
3100 }
3101
3102
3103 my($key);
3104 foreach $key (sort keys %errors_count) {
3105 my $text = $key;
3106 chomp($text);
3107 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
3108 $total_errors += $errors_count{$key};
3109
3110 if ($txt_fh) {
3111 printf $txt_fh ("%5d ", $errors_count{$key});
3112 my $text_remaining = $text;
3113 while (length($text_remaining) > 65) {
3114 my($first,$rest) = $text_remaining =~ /(.{50}\S*)\s+(.+)/;
3115 last if !$first;
3116 printf $txt_fh ("%s\n\t ", $first);
3117 $text_remaining = $rest;
3118 }
3119 printf $txt_fh ("%s\n\n", $text_remaining);
3120 }
3121
3122 if ($htm_fh) {
3123
3124 #Translate HTML tag characters. Sergey Sholokh.
3125 $text =~ s/\</\&lt\;/g;
3126 $text =~ s/\>/\&gt\;/g;
3127
3128 printf $htm_fh ($htm_format,$errors_count{$key},$text);
3129 }
3130 if ($xls_fh)
3131 {
3132 &set_worksheet_line($ws_errors, $row++, 0, [$errors_count{$key},$text]);
3133 }
3134 }
3135
3136 $temp = "Errors encountered: $total_errors";
3137
3138 if ($txt_fh) {
3139 print $txt_fh $temp, "\n";
3140 print $txt_fh "-" x length($temp),"\n";
3141 }
3142 if ($htm_fh) {
3143 print $htm_fh "</ul>\n<p>\n";
3144 print $htm_fh $temp, "\n";
3145 }
3146 if ($xls_fh)
3147 {
3148 &set_worksheet_line($ws_errors, $row++, 0, [$total_errors, "Sum of Errors encountered"]);
3149 }
3150 }
3151
3152 }
3153
3154
3155 #######################################################################
3156 # parse_old_eximstat_reports();
3157 #
3158 # parse_old_eximstat_reports($fh);
3159 #
3160 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
3161 #
3162 # To test that the merging still works after changes, do something like the following.
3163 # All the diffs should produce no output.
3164 #
3165 # options='-bydomain -byemail -byhost -byedomain'
3166 # options="$options -show_rt1,2,4 -show_dt 1,2,4"
3167 # options="$options -pattern 'Completed Messages' /Completed/"
3168 # options="$options -pattern 'Received Messages' /<=/"
3169 #
3170 # ./eximstats $options mainlog > mainlog.txt
3171 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
3172 # diff mainlog.txt mainlog.2.txt
3173 #
3174 # ./eximstats $options -html mainlog > mainlog.html
3175 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
3176 # diff mainlog.html mainlog.2.html
3177 #
3178 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
3179 # diff mainlog.txt mainlog.3.txt
3180 #
3181 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
3182 # diff mainlog.html mainlog.3.html
3183 #
3184 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
3185 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
3186 # diff mainlog.txt mainlog.4.txt
3187 #
3188 # # double_mainlog.txt should have twice the values that mainlog.txt has.
3189 # ./eximstats $options mainlog mainlog > double_mainlog.txt
3190 #######################################################################
3191 sub parse_old_eximstat_reports {
3192 my($fh) = @_;
3193
3194 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
3195
3196 my(%user_pattern_index);
3197 my $user_pattern_index = 0;
3198 map {$user_pattern_index{$_} = $user_pattern_index++} @user_descriptions;
3199 my $user_pattern_keys = join('|', @user_descriptions);
3200
3201 while (<$fh>) {
3202 PARSE_OLD_REPORT_LINE:
3203 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
3204 $begin = $1 if ($1 lt $begin);
3205 $end = $3 if ($3 gt $end);
3206 }
3207 elsif (/Grand total summary/) {
3208 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Addresses|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
3209 my(@fields, @delivered_fields);
3210 my $doing_table = 0;
3211 while (<$fh>) {
3212 $_ = html2txt($_); #Convert general HTML markup to text.
3213 s/At least one addr//g; #Another part of the HTML output we don't want.
3214
3215 # TOTAL Volume Messages Addresses Hosts Domains Delayed Failed
3216 # Received 26MB 237 177 23 8 3.4% 28 11.8%
3217 # Delivered 13MB 233 250 99 88
3218 if (/TOTAL\s+(.*?)\s*$/) {
3219 $doing_table = 1;
3220 @delivered_fields = split(/\s+/,$1);
3221
3222 #Delayed and Failed have two columns each, so add the extra field names in.
3223 splice(@delivered_fields,-1,1,'DelayedPercent','Failed','FailedPercent');
3224
3225 # Addresses only figure in the Delivered row, so remove them from the
3226 # normal fields.
3227 @fields = grep !/Addresses/, @delivered_fields;
3228 }
3229 elsif (/(Received)\s+(.*?)\s*$/) {
3230 print STDERR "Parsing $_" if $debug;
3231 add_to_totals($report_totals{$1},\@fields,$2);
3232 }
3233 elsif (/(Delivered)\s+(.*?)\s*$/) {
3234 print STDERR "Parsing $_" if $debug;
3235 add_to_totals($report_totals{$1},\@delivered_fields,$2);
3236 my $data = $2;
3237 # If we're merging an old report which doesn't include addresses,
3238 # then use the Messages field instead.
3239 unless (grep(/Addresses/, @delivered_fields)) {
3240 my %tmp;
3241 line_to_hash(\%tmp,\@delivered_fields,$data);
3242 add_to_totals($report_totals{Delivered},['Addresses'],$tmp{Messages});
3243 }
3244 }
3245 elsif (/(Temp Rejects|Rejects|Ham|Spam)\s+(.*?)\s*$/) {
3246 print STDERR "Parsing $_" if $debug;
3247 add_to_totals($report_totals{$1},['Messages','Hosts'],$2);
3248 }
3249 else {
3250 last if $doing_table;
3251 }
3252 }
3253 }
3254
3255 elsif (/User Specified Patterns/i) {
3256 #User Specified Patterns
3257 #-----------------------
3258 # Total
3259 # Description 85
3260
3261 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
3262 while (<$fh>) {
3263 print STDERR "Parsing $_" if $debug;
3264 $_ = html2txt($_); #Convert general HTML markup to text.
3265 if (/^\s*(.*?)\s+(\d+)\s*$/) {
3266 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
3267 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
3268 }
3269 last if (/^\s*$/); #Finished if we have a blank line.
3270 }
3271 }
3272
3273 elsif (/(^|<h2>)($user_pattern_keys) per /o) {
3274 # Parse User defined pattern histograms if they exist.
3275 parse_histogram($fh, $user_pattern_interval_count[$user_pattern_index{$2}] );
3276 }
3277
3278
3279 elsif (/Deliveries by transport/i) {
3280 #Deliveries by transport
3281 #-----------------------
3282 # Volume Messages
3283 # :blackhole: 70KB 51
3284 # address_pipe 655KB 1
3285 # smtp 11MB 151
3286
3287 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
3288 while (<$fh>) {
3289 print STDERR "Parsing $_" if $debug;
3290 $_ = html2txt($_); #Convert general HTML markup to text.
3291 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
3292 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
3293 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
3294 }
3295 last if (/^\s*$/); #Finished if we have a blank line.
3296 }
3297 }
3298 elsif (/Messages received per/) {
3299 parse_histogram($fh, \@received_interval_count);
3300 }
3301 elsif (/Deliveries per/) {
3302 parse_histogram($fh, \@delivered_interval_count);
3303 }
3304
3305 #elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
3306 elsif (/(Time spent on the queue|Delivery times|Receipt times): ((\S+) messages|messages with at least one remote delivery)((<[^>]*>)*\s*)$/) {
3307 #Time spent on the queue: all messages
3308 #-------------------------------------
3309 #
3310 #Under 1m 217 91.9% 91.9%
3311 # 5m 2 0.8% 92.8%
3312 # 3h 8 3.4% 96.2%
3313 # 6h 7 3.0% 99.2%
3314 # 12h 2 0.8% 100.0%
3315
3316 # Set a pointer to the queue bin so we can use the same code
3317 # block for both all messages and remote deliveries.
3318 #my $bin_aref = ($1 eq 'all messages') ? \@qt_all_bin : \@qt_remote_bin;
3319 my($bin_aref, $times_aref, $overflow_sref);
3320 if ($1 eq 'Time spent on the queue') {
3321 $times_aref = \@queue_times;
3322 if ($2 eq 'all messages') {
3323 $bin_aref = \@qt_all_bin;
3324 $overflow_sref = \$qt_all_overflow;
3325 }
3326 else {
3327 $bin_aref = \@qt_remote_bin;
3328 $overflow_sref = \$qt_remote_overflow;
3329 }
3330 }
3331 elsif ($1 eq 'Delivery times') {
3332 $times_aref = \@delivery_times;
3333 if ($2 eq 'all messages') {
3334 $bin_aref = \@dt_all_bin;
3335 $overflow_sref = \$dt_all_overflow;
3336 }
3337 else {
3338 $bin_aref = \@dt_remote_bin;
3339 $overflow_sref = \$dt_remote_overflow;
3340 }
3341 }
3342 else {
3343 unless (exists $rcpt_times_bin{$3}) {
3344 initialise_rcpt_times($3);
3345 }
3346 $bin_aref = $rcpt_times_bin{$3};
3347 $times_aref = \@rcpt_times;
3348 $overflow_sref = \$rcpt_times_overflow{$3};
3349 }
3350
3351
3352 my ($blank_lines, $reached_table) = (0,0);
3353 while (<$fh>) {
3354 $_ = html2txt($_); #Convert general HTML markup to text.
3355 # The table is preceded by one blank line, and has one blank line
3356 # following it. As the table may be empty, the best way to determine
3357 # that we've finished it is to look for the second blank line.
3358 ++$blank_lines if /^\s*$/;
3359 last if ($blank_lines >=2); #Finished the table ?
3360 $reached_table = 1 if (/\d/);
3361 next unless $reached_table;
3362 my $previous_seconds_on_queue = 0;
3363 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
3364 print STDERR "Parsing $_" if $debug;
3365 my($modifier,$formatted_time,$count) = ($1,$2,$3);
3366 my $seconds = unformat_time($formatted_time);
3367 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
3368 $previous_seconds_on_queue = $seconds;
3369 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
3370 my($i);
3371 for ($i = 0; $i <= $#$times_aref; $i++) {
3372 if ($time_on_queue < $times_aref->[$i]) {
3373 $$bin_aref[$i] += $count;
3374 last;
3375 }
3376 }
3377 $$overflow_sref += $count if ($i > $#$times_aref);
3378
3379 }
3380 }
3381 }
3382
3383 elsif (/Relayed messages/) {
3384 #Relayed messages
3385 #----------------
3386 #
3387 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
3388 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
3389 #
3390 #<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>
3391
3392 my $reached_table = 0;
3393 my($count,$sender);
3394 while (<$fh>) {
3395 unless ($reached_table) {
3396 last if (/No relayed messages/);
3397 $reached_table = 1 if (/^\s*\d/ || />\d+</);
3398 next unless $reached_table;
3399 }
3400 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
3401 update_relayed($1,$2,$3);
3402 }
3403 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
3404 ($count,$sender) = ($1,$2);
3405 }
3406 elsif (/=>\s+(.*?)\s*$/) {
3407 update_relayed($count,$sender,$1);
3408 }
3409 else {
3410 last; #Finished the table ?
3411 }
3412 }
3413 }
3414
3415 elsif (/Top (.*?) by (message count|volume)/) {
3416 #Top 50 sending hosts by message count
3417 #-------------------------------------
3418 #
3419 # 48 1468KB local
3420 # Could also have average values for HTML output.
3421 # 48 1468KB 30KB local
3422
3423 my($category,$by_count_or_volume) = ($1,$2);
3424
3425 #As we show 2 views of each table (by count and by volume),
3426 #most (but not all) entries will appear in both tables.
3427 #Set up a hash to record which entries we have already seen
3428 #and one to record which ones we are seeing for the first time.
3429 if ($by_count_or_volume =~ /count/) {
3430 undef %league_table_value_entered;
3431 undef %league_table_value_was_zero;
3432 undef %table_order;
3433 }
3434
3435 #As this section processes multiple different table categories,
3436 #set up pointers to the hashes to be updated.
3437 my($messages_href,$addresses_href,$data_href,$data_gigs_href);
3438 if ($category =~ /local sender/) {
3439 $messages_href = \%received_count_user;
3440 $addresses_href = undef;
3441 $data_href = \%received_data_user;
3442 $data_gigs_href = \%received_data_gigs_user;
3443 }
3444 elsif ($category =~ /sending (\S+?)s?\b/) {
3445 #Top 50 sending (host|domain|email|edomain)s
3446 #Top sending (host|domain|email|edomain)
3447 $messages_href = \%{$received_count{"\u$1"}};
3448 $data_href = \%{$received_data{"\u$1"}};
3449 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
3450 }
3451 elsif ($category =~ /local destination/) {
3452 $messages_href = \%delivered_messages_user;
3453 $addresses_href = \%delivered_addresses_user;
3454 $data_href = \%delivered_data_user;
3455 $data_gigs_href = \%delivered_data_gigs_user;
3456 }
3457 elsif ($category =~ /local domain destination/) {
3458 $messages_href = \%delivered_messages_local_domain;
3459 $addresses_href = \%delivered_addresses_local_domain;
3460 $data_href = \%delivered_data_local_domain;
3461 $data_gigs_href = \%delivered_data_gigs_local_domain;
3462 }
3463 elsif ($category =~ /(\S+) destination/) {
3464 #Top 50 (host|domain|email|edomain) destinations
3465 #Top (host|domain|email|edomain) destination
3466 $messages_href = \%{$delivered_messages{"\u$1"}};
3467 $addresses_href = \%{$delivered_addresses{"\u$1"}};
3468 $data_href = \%{$delivered_data{"\u$1"}};
3469 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
3470 }
3471 elsif ($category =~ /temporarily rejected ips/) {
3472 $messages_href = \%temporarily_rejected_count_by_ip;
3473 }
3474 elsif ($category =~ /rejected ips/) {
3475 $messages_href = \%rejected_count_by_ip;
3476 }
3477 elsif ($category =~ /non-rejected spamming ips/) {
3478 $messages_href = \%spam_count_by_ip;
3479 }
3480 elsif ($category =~ /mail temporary rejection reasons/) {
3481 $messages_href = \%temporarily_rejected_count_by_reason;
3482 }
3483 elsif ($category =~ /mail rejection reasons/) {
3484 $messages_href = \%rejected_count_by_reason;
3485 }
3486
3487 my $reached_table = 0;
3488 my $row_re;
3489 while (<$fh>) {
3490 # Watch out for empty tables.
3491 goto PARSE_OLD_REPORT_LINE if (/<h2>/ or (/^\s*[a-zA-Z]/ && !/^\s*Messages/));
3492
3493 $_ = html2txt($_); #Convert general HTML markup to text.
3494
3495 # Messages Addresses Bytes Average
3496 if (/^\s*Messages/) {
3497 my $pattern = '^\s*(\d+)';
3498 $pattern .= (/Addresses/) ? '\s+(\d+)' : '()';
3499 $pattern .= (/Bytes/) ? '\s+([\dKMGB]+)' : '()';
3500 $pattern .= (/Average/) ? '\s+[\dKMGB]+' : '';
3501 $pattern .= '\s+(.*?)\s*$';
3502 $row_re = qr/$pattern/;
3503 $reached_table = 1;
3504 next;
3505 }
3506 next unless $reached_table;
3507
3508 my($messages, $addresses, $rounded_volume, $entry);
3509
3510 if (/$row_re/) {
3511 ($messages, $addresses, $rounded_volume, $entry) = ($1, $2, $3, $4);
3512 }
3513 else {
3514 #Else we have finished the table and we may need to do some
3515 #kludging to retain the order of the entries.
3516
3517 if ($by_count_or_volume =~ /volume/) {
3518 #Add a few bytes to appropriate entries to preserve the order.
3519 foreach $rounded_volume (keys %table_order) {
3520 #For each rounded volume, we want to create a list which has things
3521 #ordered from the volume table at the front, and additional things
3522 #from the count table ordered at the back.
3523 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
3524 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
3525 my(@order,%mark);
3526 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
3527 @order = @{$table_order{$rounded_volume}{volume}};
3528 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
3529
3530 my $bonus_bytes = $#order;
3531 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
3532 while (@order and ($bonus_bytes > 0)) {
3533 my $entry = shift(@order);
3534 if ($league_table_value_was_zero{$entry}) {
3535 $$data_href{$entry} += $bonus_bytes;
3536 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
3537 }
3538 $bonus_bytes--;
3539 }
3540 }
3541 }
3542 last;
3543 }
3544
3545 # Store a new table entry.
3546
3547 # Add the entry into the %table_order hash if it has a rounded
3548 # volume (KB/MB/GB).
3549 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
3550
3551 unless ($league_table_value_entered{$entry}) {
3552 $league_table_value_entered{$entry} = 1;
3553 unless ($$messages_href{$entry}) {
3554 $$messages_href{$entry} = 0;
3555 $$addresses_href{$entry} = 0;
3556 $$data_href{$entry} = 0;
3557 $$data_gigs_href{$entry} = 0;
3558 $league_table_value_was_zero{$entry} = 1;
3559 }
3560
3561 $$messages_href{$entry} += $messages;
3562
3563 # When adding the addresses, be aware that we could be merging
3564 # an old report which does not include addresses. In this case,
3565 # we add the messages instead.
3566 $$addresses_href{$entry} += ($addresses) ? $addresses : $messages;
3567
3568 #Add the rounded value to the data and data_gigs hashes.
3569 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry}) if $rounded_volume;
3570 print STDERR "$category by $by_count_or_volume: added $messages,$rounded_volume to $entry\n" if $debug;
3571 }
3572
3573 }
3574 }
3575 elsif (/List of errors/) {
3576 #List of errors
3577 #--------------
3578 #
3579 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
3580 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
3581 # host mail.one2one.net [193.133.192.24]: 550 User unknown
3582 #
3583 #<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>
3584
3585
3586 my $reached_table = 0;
3587 my($count,$error,$blanks);
3588 while (<$fh>) {
3589 $reached_table = 1 if (/^( *|<li>)(\d+)/);
3590 next unless $reached_table;
3591
3592 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
3593 $_ = html2txt($_); #Convert general HTML markup to text.
3594
3595 if (/\t\s*(.*)/) {
3596 $error .= ' ' . $1; #Join a multiline error.
3597 }
3598 elsif (/^\s*(\d+)\s+(.*)/) {
3599 if ($error) {
3600 #Finished with a previous multiline error so save it.
3601 $errors_count{$error} = 0 unless $errors_count{$error};
3602 $errors_count{$error} += $count;
3603 }
3604 ($count,$error) = ($1,$2);
3605 }
3606 elsif (/Errors encountered/) {
3607 if ($error) {
3608 #Finished the section, so save our stored last error.
3609 $errors_count{$error} = 0 unless $errors_count{$error};
3610 $errors_count{$error} += $count;
3611 }
3612 last;
3613 }
3614 }
3615 }
3616
3617 }
3618 }
3619
3620 #######################################################################
3621 # parse_histogram($fh, \@delivered_interval_count);
3622 # Parse a histogram into the provided array of counters.
3623 #######################################################################
3624 sub parse_histogram {
3625 my($fh, $counters_aref) = @_;
3626
3627 # Messages received per hour (each dot is 2 messages)
3628 #---------------------------------------------------
3629 #
3630 #00-01 106 .....................................................
3631 #01-02 103 ...................................................
3632
3633 my $reached_table = 0;
3634 while (<$fh>) {
3635 $reached_table = 1 if (/^00/);
3636 next unless $reached_table;
3637 print STDERR "Parsing $_" if $debug;
3638 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
3639 $$counters_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
3640 }
3641 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
3642 $$counters_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
3643 }
3644 else { #Finished the table ?
3645 last;
3646 }
3647 }
3648 }
3649
3650
3651 #######################################################################
3652 # update_relayed();
3653 #
3654 # update_relayed($count,$sender,$recipient);
3655 #
3656 # Adds an entry into the %relayed hash. Currently only used when
3657 # merging reports.
3658 #######################################################################
3659 sub update_relayed {
3660 my($count,$sender,$recipient) = @_;
3661
3662 #When generating the key, put in the 'H=' and 'A=' which can be used
3663 #in searches.
3664 my $key = "H=$sender => H=$recipient";
3665 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
3666 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
3667 $relayed{$key} = 0 if !defined $relayed{$key};
3668 $relayed{$key} += $count;
3669 }
3670 else {
3671 $relayed_unshown += $count;
3672 }
3673 }
3674
3675
3676 #######################################################################
3677 # add_to_totals();
3678 #
3679 # add_to_totals(\%totals,\@keys,$values);
3680 #
3681 # Given a line of space separated values, add them into the provided hash using @keys
3682 # as the hash keys.
3683 #
3684 # If the value contains a '%', then the value is set rather than added. Otherwise, we
3685 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
3686 #######################################################################
3687 sub add_to_totals {
3688 my($totals_href,$keys_aref,$values) = @_;
3689 my(@values) = split(/\s+/,$values);
3690
3691 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3692 my $key = $keys_aref->[$i];
3693 if ($values[$i] =~ /%/) {
3694 $$totals_href{$key} = $values[$i];
3695 }
3696 else {
3697 $$totals_href{$key} = 0 unless ($$totals_href{$key});
3698 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
3699 un_round($values[$i], \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
3700 print STDERR "Added $values[$i] to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
3701 }
3702 }
3703 }
3704
3705
3706 #######################################################################
3707 # line_to_hash();
3708 #
3709 # line_to_hash(\%hash,\@keys,$line);
3710 #
3711 # Given a line of space separated values, set them into the provided hash
3712 # using @keys as the hash keys.
3713 #######################################################################
3714 sub line_to_hash {
3715 my($href,$keys_aref,$values) = @_;
3716 my(@values) = split(/\s+/,$values);
3717 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3718 $$href{$keys_aref->[$i]} = $values[$i];
3719 }
3720 }
3721
3722
3723 #######################################################################
3724 # get_report_total();
3725 #
3726 # $total = get_report_total(\%hash,$key);
3727 #
3728 # If %hash contains values split into Units and Gigs, we calculate and return
3729 #
3730 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
3731 #######################################################################
3732 sub get_report_total {
3733 no integer;
3734 my($hash_ref,$key) = @_;
3735 if ($$hash_ref{"${key}-gigs"}) {
3736 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
3737 }
3738 return $$hash_ref{$key} || 0;
3739 }
3740
3741 #######################################################################
3742 # html2txt();
3743 #
3744 # $text_line = html2txt($html_line);
3745 #
3746 # Convert a line from html to text. Currently we just convert HTML tags to spaces
3747 # and convert &gt;, &lt;, and &nbsp; tags back.
3748 #######################################################################
3749 sub html2txt {
3750 ($_) = @_;
3751
3752 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
3753 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
3754 # (the ones used by this program). If someone is careless enough to have their
3755 # Userid the same as an HTML tag, there's not much we can do about it.
3756 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /g;
3757
3758 s/\&lt\;/\</og; #Convert '&lt;' to '<'.
3759 s/\&gt\;/\>/og; #Convert '&gt;' to '>'.
3760 s/\&nbsp\;/ /og; #Convert '&nbsp;' to ' '.
3761 return($_);
3762 }
3763
3764 #######################################################################
3765 # get_next_arg();
3766 #
3767 # $arg = get_next_arg();
3768 #
3769 # Because eximstats arguments are often passed as variables,
3770 # we can't rely on shell parsing to deal with quotes. This
3771 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
3772 # starts with a quote (' or "), and doesn't end in one, then
3773 # we append the next argument to it and shift again. We repeat
3774 # until we've got all of the argument.
3775 #
3776 # This isn't perfect as all white space gets reduced to one space,
3777 # but it's as good as we can get! If it's essential that spacing
3778 # be preserved precisely, then you get that by not using shell
3779 # variables.
3780 #######################################################################
3781 sub get_next_arg {
3782 my $arg = '';
3783 my $matched_pattern = 0;
3784 while ($ARGV[1]) {
3785 $arg .= ' ' if $arg;
3786 $arg .= $ARGV[1]; shift(@ARGV);
3787 if ($arg !~ /^['"]/) {
3788 $matched_pattern = 1;
3789 last;
3790 }
3791 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
3792 $matched_pattern = 1;
3793 last;
3794 }
3795 }
3796 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
3797 return $arg;
3798 }
3799
3800 #######################################################################
3801 # set_worksheet_line($ws_global, $startrow, $startcol, \@content, $format);
3802 #
3803 # set values to a sequence of cells in a row.
3804 #
3805 #######################################################################
3806 sub set_worksheet_line {
3807 my ($worksheet, $row, $col, $content, $format) = @_;
3808
3809 foreach my $token (@$content)
3810 {
3811 $worksheet->write($row, $col++, $token, $format );
3812 }
3813
3814 }
3815
3816 #######################################################################
3817 # @rcpt_times = parse_time_list($string);
3818 #
3819 # Parse a comma separated list of time values in seconds given by
3820 # the user and fill an array.
3821 #
3822 # Return a default list if $string is undefined.
3823 # Return () if $string eq '0'.
3824 #######################################################################
3825 sub parse_time_list {
3826 my($string) = @_;
3827 if (! defined $string) {
3828 return(60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60, 12*60*60, 24*60*60);
3829 }
3830 my(@times) = split(/,/, $string);
3831 foreach my $q (@times) { $q = eval($q) + 0 }
3832 @times = sort { $a <=> $b } @times;
3833 @times = () if ($#times == 0 && $times[0] == 0);
3834 return(@times);
3835 }
3836
3837
3838 #######################################################################
3839 # initialise_rcpt_times($protocol);
3840 # Initialise an array of rcpt_times to 0 for the specified protocol.
3841 #######################################################################
3842 sub initialise_rcpt_times {
3843 my($protocol) = @_;
3844 for (my $i = 0; $i <= $#rcpt_times; ++$i) {
3845 $rcpt_times_bin{$protocol}[$i] = 0;
3846 }
3847 $rcpt_times_overflow{$protocol} = 0;
3848 }
3849
3850
3851 ##################################################
3852 # Main Program #
3853 ##################################################
3854
3855
3856 $last_timestamp = '';
3857 $last_date = '';
3858 $show_errors = 1;
3859 $show_relay = 1;
3860 $show_transport = 1;
3861 $topcount = 50;
3862 $local_league_table = 1;
3863 $include_remote_users = 0;
3864 $include_original_destination = 0;
3865 $hist_opt = 1;
3866 $volume_rounding = 1;
3867 $localtime_offset = calculate_localtime_offset(); # PH/FANF
3868
3869 $charts = 0;
3870 $charts_option_specified = 0;
3871 $chartrel = ".";
3872 $chartdir = ".";
3873
3874 @queue_times = parse_time_list();
3875 @rcpt_times = ();
3876 @delivery_times = ();
3877
3878 $last_offset = '';
3879 $offset_seconds = 0;
3880
3881 $row=1;
3882 $col=0;
3883 $col_hist=0;
3884 $run_hist=0;
3885 my(%output_files); # What output files have been specified?
3886
3887 # Decode options
3888
3889 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-') {
3890 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
3891 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
3892 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/) {
3893 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
3894 }
3895 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/) { @queue_times = parse_time_list($1) }
3896 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
3897 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
3898 {
3899 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
3900 }
3901 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
3902 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
3903 elsif ($ARGV[0] =~ /^-txt=?(\S*)$/) { $txt_fh = get_filehandle($1,\%output_files) }
3904 elsif ($ARGV[0] =~ /^-html=?(\S*)$/) { $htm_fh = get_filehandle($1,\%output_files) }
3905 elsif ($ARGV[0] =~ /^-xls=?(\S*)$/) {
3906 if ($HAVE_Spreadsheet_WriteExcel) {
3907 $xls_fh = get_filehandle($1,\%output_files);
3908 }
3909 else {
3910 warn "WARNING: CPAN Module Spreadsheet::WriteExcel not installed. Obtain from www.cpan.org\n";
3911 }
3912 }
3913 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
3914 elsif ($ARGV[0] =~ /^-charts$/) {
3915 $charts = 1;
3916 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
3917 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
3918 }
3919 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
3920 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
3921 elsif ($ARGV[0] =~ /^-include_original_destination$/) { $include_original_destination = 1 }
3922 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
3923 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
3924 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
3925 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
3926 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
3927 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
3928 elsif ($ARGV[0] =~ /^-bylocaldomain$/) { $do_local_domain = 1 }
3929 elsif ($ARGV[0] =~ /^-emptyok$/) { $emptyOK = 1 }
3930 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
3931 elsif ($ARGV[0] =~ /^-show_rt([,\d\+\-\*\/]+)?$/) { @rcpt_times = parse_time_list($1) }
3932 elsif ($ARGV[0] =~ /^-show_dt([,\d\+\-\*\/]+)?$/) { @delivery_times = parse_time_list($1) }
3933 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
3934 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
3935 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
3936 elsif ($ARGV[0] =~ /^-pattern$/)
3937 {
3938 push(@user_descriptions,get_next_arg());
3939 push(@user_patterns,get_next_arg());
3940 }
3941 elsif ($ARGV[0] =~ /^-utc$/)
3942 {
3943 # We don't need this value if the log is in UTC.
3944 $localtime_offset = undef;
3945 }
3946 else
3947 {
3948 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
3949 help();
3950 }
3951 shift;
3952 }
3953
3954 # keep old default behaviour
3955 if (! ($xls_fh or $htm_fh or $txt_fh)) {
3956 $txt_fh = \*STDOUT;
3957 }
3958
3959 # Check that all the charts options are specified.
3960 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
3961
3962 # Default to display tables by sending Host.
3963 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
3964
3965 # prepare xls Excel Workbook
3966 if (defined $xls_fh) {
3967
3968 # Create a new Excel workbook
3969 $workbook = Spreadsheet::WriteExcel->new($xls_fh);
3970
3971 # Add worksheets
3972 $ws_global = $workbook->addworksheet('Exim Statistik');
3973 # show $ws_global as initial sheet
3974 $ws_global->set_first_sheet();
3975 $ws_global->activate();
3976
3977 if ($show_relay) {
3978 $ws_relayed = $workbook->addworksheet('Relayed Messages');
3979 $ws_relayed->set_column(1, 2, 80);
3980 }
3981 if ($show_errors) {
3982 $ws_errors = $workbook->addworksheet('Errors');
3983 }
3984
3985
3986 # set column widths
3987 $ws_global->set_column(0, 2, 20); # Columns B-D width set to 30
3988 $ws_global->set_column(3, 3, 15); # Columns B-D width set to 30
3989 $ws_global->set_column(4, 4, 25); # Columns B-D width set to 30
3990
3991 # Define Formats
3992 $f_default = $workbook->add_format();
3993
3994 $f_header1 = $workbook->add_format();
3995 $f_header1->set_bold();
3996 #$f_header1->set_color('red');
3997 $f_header1->set_size('15');
3998 $f_header1->set_valign();
3999 # $f_header1->set_align('center');
4000 # $ws_global->write($row++, 2, "Testing Headers 1", $f_header1);
4001
4002 $f_header2 = $workbook->add_format();
4003 $f_header2->set_bold();
4004 $f_header2->set_size('12');
4005 $f_header2->set_valign();
4006 # $ws_global->write($row++, 2, "Testing Headers 2", $f_header2);
4007
4008 # Create another header2 for use in merged cells.
4009 $f_header2_m = $workbook->add_format();
4010 $f_header2_m->set_bold();
4011 $f_header2_m->set_size('8');
4012 $f_header2_m->set_valign();
4013 $f_header2_m->set_align('center');
4014
4015 $f_percent = $workbook->add_format();
4016 $f_percent->set_num_format('0.0%');
4017
4018 $f_headertab = $workbook->add_format();
4019 $f_headertab->set_bold();
4020 $f_headertab->set_valign();
4021 # $ws_global->write($row++, 2, "Testing Headers tab", $f_headertab);
4022
4023 }
4024
4025
4026 # Initialise the queue/delivery/rcpt time counters.
4027 for (my $i = 0; $i <= $#queue_times; $i++) {
4028 $qt_all_bin[$i] = 0;
4029 $qt_remote_bin[$i] = 0;
4030 }
4031 for (my $i = 0; $i <= $#delivery_times; $i++) {
4032 $dt_all_bin[$i] = 0;
4033 $dt_remote_bin[$i] = 0;
4034 }
4035 initialise_rcpt_times('all');
4036
4037
4038 # Compute the number of slots for the histogram
4039 if ($hist_opt > 0)
4040 {
4041 if ($hist_opt > 60 || 60 % $hist_opt != 0)
4042 {
4043 print STDERR "Eximstats: -h must specify a factor of 60\n";
4044 exit 1;
4045 }
4046 $hist_interval = 60/$hist_opt; #Interval in minutes.
4047 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
4048 @received_interval_count = (0) x $hist_number;
4049 @delivered_interval_count = (0) x $hist_number;
4050 my $user_pattern_index = 0;
4051 for (my $user_pattern_index = 0; $user_pattern_index <= $#user_patterns; ++$user_pattern_index) {
4052 @{$user_pattern_interval_count[$user_pattern_index]} = (0) x $hist_number;
4053 }
4054 @dt_all_bin = (0) x $hist_number;
4055 @dt_remote_bin = (0) x $hist_number;
4056 }
4057
4058 #$queue_unknown = 0;
4059
4060 $total_received_data = 0;
4061 $total_received_data_gigs = 0;
4062 $total_received_count = 0;
4063
4064 $total_delivered_data = 0;
4065 $total_delivered_data_gigs = 0;
4066 $total_delivered_messages = 0;
4067 $total_delivered_addresses = 0;
4068
4069 $qt_all_overflow = 0;
4070 $qt_remote_overflow = 0;
4071 $dt_all_overflow = 0;
4072 $dt_remote_overflow = 0;
4073 $delayed_count = 0;
4074 $relayed_unshown = 0;
4075 $message_errors = 0;
4076 $begin = "9999-99-99 99:99:99";
4077 $end = "0000-00-00 00:00:00";
4078 my($section,$type);
4079 foreach $section ('Received','Delivered','Temp Rejects', 'Rejects','Ham','Spam') {
4080 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
4081 $report_totals{$section}{$type} = 0;
4082 }
4083 }
4084
4085 # Generate our parser.
4086 my $parser = generate_parser();
4087
4088
4089
4090 if (@ARGV) {
4091 # Scan the input files and collect the data
4092 foreach my $file (@ARGV) {
4093 if ($file =~ /\.gz/) {
4094 unless (open(FILE,"gunzip -c $file |")) {
4095 print STDERR "Failed to gunzip -c $file: $!";
4096 next;
4097 }
4098 }
4099 elsif ($file =~ /\.Z/) {
4100 unless (open(FILE,"uncompress -c $file |")) {
4101 print STDERR "Failed to uncompress -c $file: $!";
4102 next;
4103 }
4104 }
4105 else {
4106 unless (open(FILE,$file)) {
4107 print STDERR "Failed to read $file: $!";
4108 next;
4109 }
4110 }
4111 #Now parse the filehandle, updating the global variables.
4112 parse($parser,\*FILE);
4113 close FILE;
4114 }
4115 }
4116 else {
4117 #No files provided. Parse STDIN, updating the global variables.
4118 parse($parser,\*STDIN);
4119 }
4120
4121
4122 if ($begin eq "9999-99-99 99:99:99" && ! $emptyOK) {
4123 print STDERR "**** No valid log lines read\n";
4124 exit 1;
4125 }
4126
4127 # Output our results.
4128 print_header();
4129 print_grandtotals();
4130
4131 # Print counts of user specified patterns if required.
4132 print_user_patterns() if @user_patterns;
4133
4134 # Print rejection reasons.
4135 # print_rejects();
4136
4137 # Print totals by transport if required.
4138 print_transport() if $show_transport;
4139
4140 # Print the deliveries per interval as a histogram, unless configured not to.
4141 # First find the maximum in one interval and scale accordingly.
4142 if ($hist_opt > 0) {
4143 print_histogram("Messages received", 'message', @received_interval_count);
4144 print_histogram("Deliveries", 'delivery', @delivered_interval_count);
4145 }
4146
4147 # Print times on queue if required.
4148 if ($#queue_times >= 0) {
4149 print_duration_table("Time spent on the queue", "all messages", \@queue_times, \@qt_all_bin,$qt_all_overflow);
4150 print_duration_table("Time spent on the queue", "messages with at least one remote delivery", \@queue_times, \@qt_remote_bin,$qt_remote_overflow);
4151 }
4152
4153 # Print delivery times if required.
4154 if ($#delivery_times >= 0) {
4155 print_duration_table("Delivery times", "all messages", \@delivery_times, \@dt_all_bin,$dt_all_overflow);
4156 print_duration_table("Delivery times", "messages with at least one remote delivery", \@delivery_times, \@dt_remote_bin,$dt_remote_overflow);
4157 }
4158
4159 # Print rcpt times if required.
4160 if ($#rcpt_times >= 0) {
4161 foreach my $protocol ('all', grep(!/^all$/, sort keys %rcpt_times_bin)) {
4162 print_duration_table("Receipt times", "$protocol messages", \@rcpt_times, $rcpt_times_bin{$protocol}, $rcpt_times_overflow{$protocol});
4163 }
4164 }
4165
4166 # Print relay information if required.
4167 print_relay() if $show_relay;
4168
4169 # Print the league tables, if topcount isn't zero.
4170 if ($topcount > 0) {
4171 my($ws_rej, $ws_top50, $ws_rej_row, $ws_top50_row, $ws_temp_rej, $ws_temp_rej_row);
4172 $ws_rej_row = $ws_temp_rej_row = $ws_top50_row = 0;
4173 if ($xls_fh) {
4174 $ws_top50 = $workbook->addworksheet('Deliveries');
4175 $ws_rej = $workbook->addworksheet('Rejections') if (%rejected_count_by_reason || %rejected_count_by_ip || %spam_count_by_ip);
4176 $ws_temp_rej = $workbook->addworksheet('Temporary Rejections') if (%temporarily_rejected_count_by_reason || %temporarily_rejected_count_by_ip);
4177 }
4178
4179 print_league_table("mail rejection reason", \%rejected_count_by_reason, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_reason;
4180 print_league_table("mail temporary rejection reason", \%temporarily_rejected_count_by_reason, undef, undef, undef, $ws_temp_rej, \$ws_temp_rej_row) if %temporarily_rejected_count_by_reason;
4181
4182 foreach ('Host','Domain','Email','Edomain') {
4183 next unless $do_sender{$_};
4184 print_league_table("sending \l$_", $received_count{$_}, undef, $received_data{$_},$received_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4185 }
4186
4187 print_league_table("local sender", \%received_count_user, undef,
4188 \%received_data_user,\%received_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %received_count_user);
4189 foreach ('Host','Domain','Email','Edomain') {
4190 next unless $do_sender{$_};
4191 print_league_table("\l$_ destination", $delivered_messages{$_}, $delivered_addresses{$_}, $delivered_data{$_},$delivered_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4192 }
4193 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);
4194 print_league_table("local domain destination", \%delivered_messages_local_domain, \%delivered_addresses_local_domain, \%delivered_data_local_domain,\%delivered_data_gigs_local_domain, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %delivered_messages_local_domain);
4195
4196 print_league_table("rejected ip", \%rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_ip;
4197 print_league_table("temporarily rejected ip", \%temporarily_rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %temporarily_rejected_count_by_ip;
4198 print_league_table("non-rejected spamming ip", \%spam_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %spam_count_by_ip;
4199
4200 }
4201
4202 # Print the error statistics if required.
4203 print_errors() if $show_errors;
4204
4205 print $htm_fh "</body>\n</html>\n" if $htm_fh;
4206
4207
4208 $txt_fh->close if $txt_fh && ref $txt_fh;
4209 $htm_fh->close if $htm_fh;
4210
4211 if ($xls_fh) {
4212 # close Excel Workbook
4213 $ws_global->set_first_sheet();
4214 # FIXME: whyever - activate does not work :-/
4215 $ws_global->activate();
4216 $workbook->close();
4217 }
4218
4219
4220 # End of eximstats