Copyright year bumps for substantive changes 2017
[exim.git] / src / src / eximstats.src
1 #!PERL_COMMAND
2
3 # Copyright (c) 2001-2017 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 # seconds value can be followed by decimals, which we ignore. The
900 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
901 # offset is not present, and we have not been told that the log is in UTC
902 # (with the -utc option), then we adjust the time by the current local
903 # time offset so that it can be compared with the time recorded in message
904 # IDs, which is UTC.
905 #
906 # To improve performance, we only use mktime on the date ($year-$mon-$day),
907 # and only calculate it if the date is different to the previous time we
908 # came here. We then add on seconds for the '$hour:$min:$sec'.
909 #
910 # We also store the results of the last conversion done, and only
911 # recalculate if the date is different.
912 #
913 # We used to have the '-cache' flag which would store the results of the
914 # mktime() call. However, the current way of just using mktime() on the
915 # date obsoletes this.
916 #######################################################################
917 sub seconds {
918 my($timestamp) = @_;
919
920 # Is the timestamp the same as the last one?
921 return $last_time if ($last_timestamp eq $timestamp);
922
923 return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)(?:\.\d+)?( ([+-])(\d\d)(\d\d))?/o);
924
925 unless ($last_date eq $1) {
926 $last_date = $1;
927 my(@timestamp) = (0,0,0,$4,$3,$2);
928 $timestamp[5] -= 1900;
929 $timestamp[4]--;
930 $date_seconds = mktime(@timestamp);
931 }
932 my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
933
934 # SC. Use caching. Also note we want seconds not minutes.
935 #my($this_offset) = ($10 * 60 + $12) * ($9 . "1") if defined $8;
936 if (defined $8 && ($8 ne $last_offset)) {
937 $last_offset = $8;
938 $offset_seconds = ($10 * 60 + $11) * 60;
939 $offset_seconds = -$offset_seconds if ($9 eq '-');
940 }
941
942
943 if (defined $8) {
944 #$time -= $this_offset;
945 $time -= $offset_seconds;
946 } elsif (defined $localtime_offset) {
947 $time -= $localtime_offset;
948 }
949
950 # Store the last timestamp received.
951 $last_timestamp = $timestamp;
952 $last_time = $time;
953
954 $time;
955 }
956
957
958 #######################################################################
959 # id_seconds();
960 #
961 # $time = id_seconds($message_id);
962 #
963 # Given a message ID, convert it into a time() value.
964 #######################################################################
965 sub id_seconds {
966 my($sub_id) = substr((pop @_), 0, 6);
967 my($s) = 0;
968 my(@c) = split(//, $sub_id);
969 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
970 $s;
971 }
972
973 #######################################################################
974 # wdhms_seconds();
975 #
976 # $seconds = wdhms_seconds($string);
977 #
978 # Convert a string in a week/day/hour/minute/second format (eg 4h10s)
979 # into seconds.
980 #######################################################################
981 sub wdhms_seconds {
982 if ($_[0] =~ /^(?:(\d+)w)?(?:(\d+)d)?(?:(\d+)h)?(?:(\d+)m)?(?:(\d+)s)?/) {
983 return((($1||0) * $WEEK) + (($2||0) * $DAY) + (($3||0) * $HOUR) + (($4||0) * $MINUTE) + ($5||0));
984 }
985 return undef;
986 }
987
988 #######################################################################
989 # queue_time();
990 #
991 # $queued = queue_time($completed_tod, $arrival_time, $id);
992 #
993 # Given the completed time of day and either the arrival time
994 # (preferred), or the message ID, calculate how long the message has
995 # been on the queue.
996 #
997 #######################################################################
998 sub queue_time {
999 my($completed_tod, $arrival_time, $id) = @_;
1000
1001 # Note: id_seconds() benchmarks as 42% slower than seconds()
1002 # and computing the time accounts for a significant portion of
1003 # the run time.
1004 if (defined $arrival_time) {
1005 return(seconds($completed_tod) - seconds($arrival_time));
1006 }
1007 else {
1008 return(seconds($completed_tod) - id_seconds($id));
1009 }
1010 }
1011
1012
1013 #######################################################################
1014 # calculate_localtime_offset();
1015 #
1016 # $localtime_offset = calculate_localtime_offset();
1017 #
1018 # Calculate the the localtime offset from gmtime in seconds.
1019 #
1020 # $localtime = time() + $localtime_offset.
1021 #
1022 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
1023 # (West is negative, East is positive.)
1024 #######################################################################
1025
1026 # $localtime = gmtime() + $localtime_offset. OLD COMMENT
1027 # This subroutine commented out as it's not currently in use.
1028
1029 #sub calculate_localtime_offset {
1030 # # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
1031 # my (@sample_date) = (0,0,0,5,5,100);
1032 # my $localtime = timelocal(@sample_date);
1033 # my $gmtime = timegm(@sample_date);
1034 # my $offset = $localtime - $gmtime;
1035 # return $offset;
1036 #}
1037
1038 sub calculate_localtime_offset {
1039 # Assume that the offset at the moment is valid across the whole
1040 # period covered by the logs that we're analysing. This may not
1041 # be true around the time the clocks change in spring or autumn.
1042 my $utc = time;
1043 # mktime works on local time and gmtime works in UTC
1044 my $local = mktime(gmtime($utc));
1045 return $local - $utc;
1046 }
1047
1048
1049
1050 #######################################################################
1051 # print_duration_table();
1052 #
1053 # print_duration_table($title, $message_type, \@times, \@values, $overflow);
1054 #
1055 # Print a table showing how long a particular step took for
1056 # the messages. The parameters are:
1057 # $title Eg "Time spent on the queue"
1058 # $message_type Eg "Remote"
1059 # \@times The maximum time a message took for it to increment
1060 # the corresponding @values counter.
1061 # \@values An array of message counters.
1062 # $overflow The number of messages which exceeded the maximum
1063 # time.
1064 #######################################################################
1065 sub print_duration_table {
1066 no integer;
1067 my($title, $message_type, $times_aref, $values_aref, $overflow) = @_;
1068 my(@chartdatanames);
1069 my(@chartdatavals);
1070
1071 my $printed_one = 0;
1072 my $cumulative_percent = 0;
1073
1074 my $queue_total = $overflow;
1075 map {$queue_total += $_} @$values_aref;
1076
1077 my $temp = "$title: $message_type";
1078
1079
1080 my $txt_format = "%5s %4s %6d %5.1f%% %5.1f%%\n";
1081 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";
1082
1083 # write header
1084 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
1085 if ($htm_fh) {
1086 print $htm_fh "<hr><a name=\"$title $message_type\"></a><h2>$temp</h2>\n";
1087 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
1088 print $htm_fh "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
1089 }
1090 if ($xls_fh) {
1091 $ws_global->write($row++, $col, "$title: ".$message_type, $f_header2);
1092 my @content=("Time", "Messages", "Percentage", "Cumulative Percentage");
1093 &set_worksheet_line($ws_global, $row++, 1, \@content, $f_headertab);
1094 }
1095
1096
1097 for ($i = 0; $i <= $#$times_aref; ++$i) {
1098 if ($$values_aref[$i] > 0)
1099 {
1100 my $percent = ($values_aref->[$i] * 100)/$queue_total;
1101 $cumulative_percent += $percent;
1102
1103 my @content=($printed_one? " " : "Under",
1104 format_time($times_aref->[$i]),
1105 $values_aref->[$i], $percent, $cumulative_percent);
1106
1107 if ($htm_fh) {
1108 printf $htm_fh ($htm_format, @content);
1109 if (!defined($values_aref->[$i])) {
1110 print $htm_fh "Not defined";
1111 }
1112 }
1113 if ($txt_fh) {
1114 printf $txt_fh ($txt_format, @content);
1115 if (!defined($times_aref->[$i])) {
1116 print $txt_fh "Not defined";
1117 }
1118 }
1119 if ($xls_fh)
1120 {
1121 no integer;
1122 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1123 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1124
1125 if (!defined($times_aref->[$i])) {
1126 $col=0;
1127 $ws_global->write($row++, $col, "Not defined" );
1128 }
1129 }
1130
1131 push(@chartdatanames,
1132 ($printed_one? "" : "Under") . format_time($times_aref->[$i]));
1133 push(@chartdatavals, $$values_aref[$i]);
1134 $printed_one = 1;
1135 }
1136 }
1137
1138 if ($overflow && $overflow > 0) {
1139 my $percent = ($overflow * 100)/$queue_total;
1140 $cumulative_percent += $percent;
1141
1142 my @content = ("Over ", format_time($times_aref->[-1]),
1143 $overflow, $percent, $cumulative_percent);
1144
1145 printf $txt_fh ($txt_format, @content) if $txt_fh;
1146 printf $htm_fh ($htm_format, @content) if $htm_fh;
1147 if ($xls_fh)
1148 {
1149 &set_worksheet_line($ws_global, $row, 0, [@content[0,1,2]], $f_default);
1150 &set_worksheet_line($ws_global, $row++, 3, [$content[3]/100,$content[4]/100], $f_percent);
1151 }
1152
1153 }
1154
1155 push(@chartdatanames, "Over " . format_time($times_aref->[-1]));
1156 push(@chartdatavals, $overflow);
1157
1158 #printf("Unknown %6d\n", $queue_unknown) if $queue_unknown > 0;
1159 if ($htm_fh) {
1160 print $htm_fh "</table></td><td>";
1161
1162 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1163 my @data = (
1164 \@chartdatanames,
1165 \@chartdatavals
1166 );
1167 my $graph = GD::Graph::pie->new(200, 200);
1168 my $pngname = "$title-$message_type.png";
1169 $pngname =~ s/[^\w\-\.]/_/;
1170
1171 my $graph_title = "$title ($message_type)";
1172 $graph->set(title => $graph_title) if (length($graph_title) < 21);
1173
1174 my $gd = $graph->plot(\@data) or warn($graph->error);
1175 if ($gd) {
1176 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1177 binmode IMG;
1178 print IMG $gd->png;
1179 close IMG;
1180 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1181 }
1182 }
1183 print $htm_fh "</td></tr></table>\n";
1184 }
1185
1186 if ($xls_fh)
1187 {
1188 $row++;
1189 }
1190 print $txt_fh "\n" if $txt_fh;
1191 print $htm_fh "\n" if $htm_fh;
1192
1193 }
1194
1195
1196 #######################################################################
1197 # print_histogram();
1198 #
1199 # print_histogram('Deliveries|Messages received|$pattern', $unit, @interval_count);
1200 #
1201 # Print a histogram of the messages delivered/received per time slot
1202 # (hour by default).
1203 #######################################################################
1204 sub print_histogram {
1205 my($text, $unit, @interval_count) = @_;
1206 my(@chartdatanames);
1207 my(@chartdatavals);
1208 my($maxd) = 0;
1209
1210 # save first row of print_histogram for xls output
1211 if (!$run_hist) {
1212 $row_hist = $row;
1213 }
1214 else {
1215 $row = $row_hist;
1216 }
1217
1218 for ($i = 0; $i < $hist_number; $i++)
1219 { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
1220
1221 my $scale = int(($maxd + 25)/50);
1222 $scale = 1 if $scale == 0;
1223
1224 if ($scale != 1) {
1225 if ($unit !~ s/y$/ies/) {
1226 $unit .= 's';
1227 }
1228 }
1229
1230 # make and output title
1231 my $title = sprintf("$text per %s",
1232 ($hist_interval == 60)? "hour" :
1233 ($hist_interval == 1)? "minute" : "$hist_interval minutes");
1234
1235 my $txt_htm_title = $title . " (each dot is $scale $unit)";
1236
1237 printf $txt_fh ("%s\n%s\n\n", $txt_htm_title, "-" x length($txt_htm_title)) if $txt_fh;
1238
1239 if ($htm_fh) {
1240 print $htm_fh "<hr><a name=\"$text\"></a><h2>$txt_htm_title</h2>\n";
1241 print $htm_fh "<table border=0 width=\"100%\">\n";
1242 print $htm_fh "<tr><td><pre>\n";
1243 }
1244
1245 if ($xls_fh) {
1246 $title =~ s/Messages/Msg/ ;
1247 $row += 2;
1248 $ws_global->write($row++, $col_hist+1, $title, $f_headertab);
1249 }
1250
1251
1252 my $hour = 0;
1253 my $minutes = 0;
1254 for ($i = 0; $i < $hist_number; $i++) {
1255 my $c = $interval_count[$i];
1256
1257 # If the interval is an hour (the maximum) print the starting and
1258 # ending hours as a label. Otherwise print the starting hour and
1259 # minutes, which take up the same space.
1260
1261 my $temp;
1262 if ($hist_opt == 1) {
1263 $temp = sprintf("%02d-%02d", $hour, $hour + 1);
1264
1265 print $txt_fh $temp if $txt_fh;
1266 print $htm_fh $temp if $htm_fh;
1267
1268 if ($xls_fh) {
1269 if ($run_hist==0) {
1270 # only on first run
1271 $ws_global->write($row, 0, [$temp], $f_default);
1272 }
1273 }
1274
1275 push(@chartdatanames, $temp);
1276 $hour++;
1277 }
1278 else {
1279 if ($minutes == 0)
1280 { $temp = sprintf("%02d:%02d", $hour, $minutes) }
1281 else
1282 { $temp = sprintf(" :%02d", $minutes) }
1283
1284 print $txt_fh $temp if $txt_fh;
1285 print $htm_fh $temp if $htm_fh;
1286 if (($xls_fh) and ($run_hist==0)) {
1287 # only on first run
1288 $temp = sprintf("%02d:%02d", $hour, $minutes);
1289 $ws_global->write($row, 0, [$temp], $f_default);
1290 }
1291
1292 push(@chartdatanames, $temp);
1293 $minutes += $hist_interval;
1294 if ($minutes >= 60) {
1295 $minutes = 0;
1296 $hour++;
1297 }
1298 }
1299 push(@chartdatavals, $c);
1300
1301 printf $txt_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $txt_fh;
1302 printf $htm_fh (" %6d %s\n", $c, "." x ($c/$scale)) if $htm_fh;
1303 $ws_global->write($row++, $col_hist+1, [$c], $f_default) if $xls_fh;
1304
1305 } #end for
1306
1307 printf $txt_fh "\n" if $txt_fh;
1308 printf $htm_fh "\n" if $htm_fh;
1309
1310 if ($htm_fh)
1311 {
1312 print $htm_fh "</pre>\n";
1313 print $htm_fh "</td><td>\n";
1314 if ($HAVE_GD_Graph_linespoints && $charts && ($#chartdatavals > 0)) {
1315 # calculate the graph
1316 my @data = (
1317 \@chartdatanames,
1318 \@chartdatavals
1319 );
1320 my $graph = GD::Graph::linespoints->new(300, 300);
1321 $graph->set(
1322 x_label => 'Time',
1323 y_label => 'Amount',
1324 title => $text,
1325 x_labels_vertical => 1
1326 );
1327 my $pngname = "histogram_$text.png";
1328 $pngname =~ s/[^\w\._]/_/g;
1329
1330 my $gd = $graph->plot(\@data) or warn($graph->error);
1331 if ($gd) {
1332 open(IMG, ">$chartdir/$pngname") or die "Could not write $chartdir/$pngname: $!\n";
1333 binmode IMG;
1334 print IMG $gd->png;
1335 close IMG;
1336 print $htm_fh "<img src=\"$chartrel/$pngname\">";
1337 }
1338 }
1339 print $htm_fh "</td></tr></table>\n";
1340 }
1341
1342 $col_hist++; # where to continue next times
1343
1344 $row+=2; # leave some space after history block
1345 $run_hist=1; # we have done this once or more
1346 }
1347
1348
1349
1350 #######################################################################
1351 # print_league_table();
1352 #
1353 # print_league_table($league_table_type,\%message_count,\%address_count,\%message_data,\%message_data_gigs, $spreadsheet, $row_sref);
1354 #
1355 # Given hashes of message count, address count, and message data,
1356 # which are keyed by the table type (eg by the sending host), print a
1357 # league table showing the top $topcount (defaults to 50).
1358 #######################################################################
1359 sub print_league_table {
1360 my($text,$m_count,$a_count,$m_data,$m_data_gigs,$spreadsheet, $row_sref) = @_;
1361 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
1362 my($title) = "Top $name by message count";
1363 my(@chartdatanames) = ();
1364 my(@chartdatavals) = ();
1365 my $chartotherval = 0;
1366 $text = ucfirst($text);
1367
1368 # Align non-local addresses to the right (so all the .com's line up).
1369 # Local addresses are aligned on the left as they are userids.
1370 my $align = ($text !~ /local/i) ? 'right' : 'left';
1371
1372
1373 ################################################
1374 # Generate the printf formats and table headers.
1375 ################################################
1376 my(@headers) = ('Messages');
1377 #push(@headers,'Addresses') if defined $a_count;
1378 push(@headers,'Addresses') if defined $a_count && %$a_count;
1379 push(@headers,'Bytes','Average') if defined $m_data;
1380
1381 my $txt_format = "%10s " x @headers . " %s\n";
1382 my $txt_col_headers = sprintf $txt_format, @headers, $text;
1383 my $htm_format = "<tr>" . '<td align="right">%s</td>'x@headers . "<td align=\"$align\" nowrap>%s</td></tr>\n";
1384 my $htm_col_headers = sprintf $htm_format, @headers, $text;
1385 $htm_col_headers =~ s/(<\/?)td/$1th/g; #Convert <td>'s to <th>'s for the header.
1386
1387
1388 ################################################
1389 # Write the table headers
1390 ################################################
1391 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1392
1393 if ($htm_fh) {
1394 print $htm_fh <<EoText;
1395 <hr><a name="$text count"></a><h2>$title</h2>
1396 <table border=0 width="100%">
1397 <tr><td>
1398 <table border=1>
1399 EoText
1400 print $htm_fh $htm_col_headers
1401 }
1402
1403 if ($xls_fh) {
1404 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1405 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1406 }
1407
1408
1409 # write content
1410 foreach my $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1411
1412 # When displaying the average figures, we calculate the average of
1413 # the rounded data, as the user would calculate it. This reduces
1414 # the accuracy slightly, but we have to do it this way otherwise
1415 # when using -merge to convert results from text to HTML and
1416 # vice-versa discrepencies would occur.
1417 my $messages = $$m_count{$key};
1418 my @content = ($messages);
1419 push(@content, $$a_count{$key}) if defined $a_count;
1420 if (defined $m_data) {
1421 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1422 my($data,$gigs) = (0,0);
1423 un_round($rounded_volume,\$data,\$gigs);
1424 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1425 push(@content, $rounded_volume, $rounded_average);
1426 }
1427
1428 # write content
1429 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1430
1431 if ($htm_fh) {
1432 my $htmlkey = $key;
1433 $htmlkey =~ s/>/\&gt\;/g;
1434 $htmlkey =~ s/</\&lt\;/g;
1435 printf $htm_fh ($htm_format, @content, $htmlkey);
1436 }
1437 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1438
1439 if (scalar @chartdatanames < $ntopchart) {
1440 push(@chartdatanames, $key);
1441 push(@chartdatavals, $$m_count{$key});
1442 }
1443 else {
1444 $chartotherval += $$m_count{$key};
1445 }
1446 }
1447
1448 push(@chartdatanames, "Other");
1449 push(@chartdatavals, $chartotherval);
1450
1451 print $txt_fh "\n" if $txt_fh;
1452 if ($htm_fh) {
1453 print $htm_fh "</table>\n";
1454 print $htm_fh "</td><td>\n";
1455 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0))
1456 {
1457 # calculate the graph
1458 my @data = (
1459 \@chartdatanames,
1460 \@chartdatavals
1461 );
1462 my $graph = GD::Graph::pie->new(300, 300);
1463 $graph->set(
1464 x_label => 'Name',
1465 y_label => 'Amount',
1466 title => 'By count',
1467 );
1468 my $gd = $graph->plot(\@data) or warn($graph->error);
1469 if ($gd) {
1470 my $temp = $text;
1471 $temp =~ s/ /_/g;
1472 open(IMG, ">$chartdir/${temp}_count.png") or die "Could not write $chartdir/${temp}_count.png: $!\n";
1473 binmode IMG;
1474 print IMG $gd->png;
1475 close IMG;
1476 print $htm_fh "<img src=\"$chartrel/${temp}_count.png\">";
1477 }
1478 }
1479 print $htm_fh "</td><td>\n";
1480 print $htm_fh "</td></tr></table>\n\n";
1481 }
1482 ++${$row_sref} if $xls_fh;
1483
1484
1485 if (defined $m_data) {
1486 # write header
1487
1488 $title = "Top $name by volume";
1489
1490 printf $txt_fh ("%s\n%s\n%s", $title, "-" x length($title),$txt_col_headers) if $txt_fh;
1491
1492 if ($htm_fh) {
1493 print $htm_fh <<EoText;
1494 <hr><a name="$text volume"></a><h2>$title</h2>
1495 <table border=0 width="100%">
1496 <tr><td>
1497 <table border=1>
1498 EoText
1499 print $htm_fh $htm_col_headers;
1500 }
1501 if ($xls_fh) {
1502 $spreadsheet->write(${$row_sref}++, 0, $title, $f_header2);
1503 $spreadsheet->write(${$row_sref}++, 0, [@headers, $text], $f_headertab);
1504 }
1505
1506 @chartdatanames = ();
1507 @chartdatavals = ();
1508 $chartotherval = 0;
1509 my $use_gig = 0;
1510 foreach my $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1511 # The largest volume will be the first (top of the list).
1512 # If it has at least 1 gig, then just use gigabytes to avoid
1513 # risking an integer overflow when generating the pie charts.
1514 if ($$m_data_gigs{$key}) {
1515 $use_gig = 1;
1516 }
1517
1518 my $messages = $$m_count{$key};
1519 my @content = ($messages);
1520 push(@content, $$a_count{$key}) if defined $a_count;
1521 my $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1522 my($data ,$gigs) = (0,0);
1523 un_round($rounded_volume,\$data,\$gigs);
1524 my $rounded_average = volume_rounded($data/$messages,$gigs/$messages);
1525 push(@content, $rounded_volume, $rounded_average );
1526
1527 # write content
1528 printf $txt_fh ($txt_format, @content, $key) if $txt_fh;
1529 if ($htm_fh) {
1530 my $htmlkey = $key;
1531 $htmlkey =~ s/>/\&gt\;/g;
1532 $htmlkey =~ s/</\&lt\;/g;
1533 printf $htm_fh ($htm_format, @content, $htmlkey);
1534 }
1535 $spreadsheet->write(${$row_sref}++, 0, [@content, $key], $f_default) if $xls_fh;
1536
1537
1538 if (scalar @chartdatanames < $ntopchart) {
1539 if ($use_gig) {
1540 if ($$m_data_gigs{$key}) {
1541 push(@chartdatanames, $key);
1542 push(@chartdatavals, $$m_data_gigs{$key});
1543 }
1544 }
1545 else {
1546 push(@chartdatanames, $key);
1547 push(@chartdatavals, $$m_data{$key});
1548 }
1549 }
1550 else {
1551 $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1552 }
1553 }
1554 push(@chartdatanames, "Other");
1555 push(@chartdatavals, $chartotherval);
1556
1557 print $txt_fh "\n" if $txt_fh;
1558 if ($htm_fh) {
1559 print $htm_fh "</table>\n";
1560 print $htm_fh "</td><td>\n";
1561 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals > 0)) {
1562 # calculate the graph
1563 my @data = (
1564 \@chartdatanames,
1565 \@chartdatavals
1566 );
1567 my $graph = GD::Graph::pie->new(300, 300);
1568 $graph->set(
1569 x_label => 'Name',
1570 y_label => 'Volume' ,
1571 title => 'By Volume',
1572 );
1573 my $gd = $graph->plot(\@data) or warn($graph->error);
1574 if ($gd) {
1575 my $temp = $text;
1576 $temp =~ s/ /_/g;
1577 open(IMG, ">$chartdir/${temp}_volume.png") or die "Could not write $chartdir/${temp}_volume.png: $!\n";
1578 binmode IMG;
1579 print IMG $gd->png;
1580 close IMG;
1581 print $htm_fh "<img src=\"$chartrel/${temp}_volume.png\">";
1582 }
1583 }
1584 print $htm_fh "</td><td>\n";
1585 print $htm_fh "</td></tr></table>\n\n";
1586 }
1587
1588 ++${$row_sref} if $xls_fh;
1589 }
1590 }
1591
1592
1593 #######################################################################
1594 # top_n_sort();
1595 #
1596 # @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1597 #
1598 # Given a hash which has numerical values, return the sorted $n keys which
1599 # point to the top values. The second and third hashes are used as
1600 # tiebreakers. They all must have the same keys.
1601 #
1602 # The idea behind this routine is that when you only want to see the
1603 # top n members of a set, rather than sorting the entire set and then
1604 # plucking off the top n, sort through the stack as you go, discarding
1605 # any member which is lower than your current n'th highest member.
1606 #
1607 # This proves to be an order of magnitude faster for large hashes.
1608 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1609 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1610 #
1611 # We assume the values are > 0.
1612 #######################################################################
1613 sub top_n_sort {
1614 my($n,$href1,$href2,$href3) = @_;
1615
1616 # PH's original sort was:
1617 #
1618 # foreach $key (sort
1619 # {
1620 # $$m_count{$b} <=> $$m_count{$a} ||
1621 # $$m_data_gigs{$b} <=> $$m_data_gigs{$a} ||
1622 # $$m_data{$b} <=> $$m_data{$a} ||
1623 # $a cmp $b
1624 # }
1625 # keys %{$m_count})
1626 #
1627
1628 #We use a key of '_' to represent non-existant values, as null keys are valid.
1629 #'_' is not a valid domain, edomain, host, or email.
1630 my(@top_n_keys) = ('_') x $n;
1631 my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1632 my $top_n_key = '';
1633 my $n_minus_1 = $n - 1;
1634 my $n_minus_2 = $n - 2;
1635
1636 # Create a dummy hash incase the user has not provided us with
1637 # tiebreaker hashes.
1638 my(%dummy_hash);
1639 $href2 = \%dummy_hash unless defined $href2;
1640 $href3 = \%dummy_hash unless defined $href3;
1641
1642 # Pick out the top $n keys.
1643 my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1644 while (($key,$value1) = each %$href1) {
1645
1646 #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1647
1648 # Check to see that the new value is bigger than the lowest of the
1649 # top n keys that we're keeping. We test the main key first, because
1650 # for the majority of cases we can skip creating dummy hash values
1651 # should the user have not provided real tie-breaking hashes.
1652 next unless $value1 >= $minimum_value1;
1653
1654 # Create a dummy hash entry for the key if required.
1655 # Note that setting the dummy_hash value sets it for both href2 &
1656 # href3. Also note that currently we are guaranteed to have a real
1657 # value for href3 if a real value for href2 exists so don't need to
1658 # test for it as well.
1659 $dummy_hash{$key} = 0 unless exists $href2->{$key};
1660
1661 $comparison = $value1 <=> $minimum_value1 ||
1662 $href2->{$key} <=> $minimum_value2 ||
1663 $href3->{$key} <=> $minimum_value3 ||
1664 $top_n_key cmp $key;
1665 next unless ($comparison == 1);
1666
1667 # As we will be using these values a few times, extract them into scalars.
1668 $value2 = $href2->{$key};
1669 $value3 = $href3->{$key};
1670
1671 # This key is bigger than the bottom n key, so the lowest position we
1672 # will insert it into is $n minus 1 (the bottom of the list).
1673 $insert_position = $n_minus_1;
1674
1675 # Now go through the list, stopping when we find a key that we're
1676 # bigger than, or we come to the penultimate position - we've
1677 # already tested bigger than the last.
1678 #
1679 # Note: we go top down as the list starts off empty.
1680 # Note: stepping through the list in this way benchmarks nearly
1681 # three times faster than doing a sort() on the reduced list.
1682 # I assume this is because the list is already in order, and
1683 # we get a performance boost from not having to do hash lookups
1684 # on the new key.
1685 for ($i = 0; $i < $n_minus_1; $i++) {
1686 $top_n_key = $top_n_keys[$i];
1687 if ( ($top_n_key eq '_') ||
1688 ( ($value1 <=> $href1->{$top_n_key} ||
1689 $value2 <=> $href2->{$top_n_key} ||
1690 $value3 <=> $href3->{$top_n_key} ||
1691 $top_n_key cmp $key) == 1
1692 )
1693 ) {
1694 $insert_position = $i;
1695 last;
1696 }
1697 }
1698
1699 # Remove the last element, then insert the new one.
1700 $#top_n_keys = $n_minus_2;
1701 splice(@top_n_keys,$insert_position,0,$key);
1702
1703 # Extract our new minimum values.
1704 $top_n_key = $top_n_keys[$n_minus_1];
1705 if ($top_n_key ne '_') {
1706 $minimum_value1 = $href1->{$top_n_key};
1707 $minimum_value2 = $href2->{$top_n_key};
1708 $minimum_value3 = $href3->{$top_n_key};
1709 }
1710 }
1711
1712 # Return the top n list, grepping out non-existant values, just in case
1713 # we didn't have that many values.
1714 return(grep(!/^_$/,@top_n_keys));
1715 }
1716
1717
1718
1719 #######################################################################
1720 # html_header();
1721 #
1722 # $header = html_header($title);
1723 #
1724 # Print our HTML header and start the <body> block.
1725 #######################################################################
1726 sub html_header {
1727 my($title) = @_;
1728 my $text = << "EoText";
1729 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1730 <html>
1731 <head>
1732 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1733 <title>$title</title>
1734 </head>
1735 <body bgcolor="white">
1736 <h1>$title</h1>
1737 EoText
1738 return $text;
1739 }
1740
1741
1742
1743 #######################################################################
1744 # help();
1745 #
1746 # help();
1747 #
1748 # Display usage instructions and exit.
1749 #######################################################################
1750 sub help {
1751 print << "EoText";
1752
1753 eximstats Version $VERSION
1754
1755 Usage:
1756 eximstats [Output] [Options] mainlog1 mainlog2 ...
1757 eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1758
1759 Examples:
1760 eximstats -html=eximstats.html mainlog1 mainlog2 ...
1761 eximstats mainlog1 mainlog2 ... > report.txt
1762
1763 Parses exim mainlog or syslog files and generates a statistical analysis
1764 of the messages processed.
1765
1766 Valid output types are:
1767 -txt[=<file>] plain text (default unless no other type is specified)
1768 -html[=<file>] HTML
1769 -xls[=<file>] Excel
1770 With no type and file given, defaults to -txt and STDOUT.
1771
1772 Valid options are:
1773 -h<number> histogram divisions per hour. The default is 1, and
1774 0 suppresses histograms. Other valid values are:
1775 2, 3, 5, 10, 15, 20, 30 or 60.
1776 -ne don't display error information
1777 -nr don't display relaying information
1778 -nr/pattern/ don't display relaying information that matches
1779 -nt don't display transport information
1780 -nt/pattern/ don't display transport information that matches
1781 -nvr don't do volume rounding. Display in bytes, not KB/MB/GB.
1782 -t<number> display top <number> sources/destinations
1783 default is 50, 0 suppresses top listing
1784 -tnl omit local sources/destinations in top listing
1785 -t_remote_users show top user sources/destinations from non-local domains
1786 -q<list> list of times for queuing information. -q0 suppresses.
1787 -show_rt<list> Show the receipt times for all the messages.
1788 -show_dt<list> Show the delivery times for all the messages.
1789 <list> is an optional list of times in seconds.
1790 Eg -show_rt1,2,4,8.
1791
1792 -include_original_destination show both the final and original
1793 destinations in the results rather than just the final ones.
1794
1795 -byhost show results by sending host (default unless bydomain or
1796 byemail is specified)
1797 -bydomain show results by sending domain.
1798 -byemail show results by sender's email address
1799 -byedomain show results by sender's email domain
1800 -bylocaldomain show results by local domain
1801
1802 -pattern "Description" /pattern/
1803 Count lines matching specified patterns and show them in
1804 the results. It can be specified multiple times. Eg:
1805 -pattern 'Refused connections' '/refused connection/'
1806
1807 -merge merge previously generated reports into a new report
1808
1809 -charts Create charts (this requires the GD::Graph modules).
1810 Only valid with -html.
1811 -chartdir <dir> Create the charts' png files in the directory <dir>
1812 -chartrel <dir> Specify the relative directory for the "img src=" tags
1813 from where to include the charts in the html file
1814 -chartdir and -chartrel default to '.'
1815
1816 -emptyok It is OK if there is no valid input, don't print an error.
1817
1818 -d Debug mode - dump the eval'ed parser onto STDERR.
1819
1820 EoText
1821
1822 exit 1;
1823 }
1824
1825
1826
1827 #######################################################################
1828 # generate_parser();
1829 #
1830 # $parser = generate_parser();
1831 #
1832 # This subroutine generates the parsing routine which will be
1833 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1834 # This improves performance depending on what bits you take out or add.
1835 #
1836 # I've tested using study(), but this does not improve performance.
1837 #
1838 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1839 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1840 # the expression evaluates to true, then it is included/excluded accordingly.
1841 #######################################################################
1842 sub generate_parser {
1843 my $parser = '
1844 my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1845 my($tod,$m_hour,$m_min,$id,$flag,$extra,$length);
1846 my($seconds,$queued,$rcpt_time,$local_domain);
1847 my $rej_id = 0;
1848 while (<$fh>) {
1849
1850 # Convert syslog lines to mainlog format.
1851 if (! /^\\d{4}/) {
1852 next unless s/^.*? exim\\b.*?: //;
1853 }
1854
1855 $length = length($_);
1856 next if ($length < 38);
1857 next unless /^
1858 (\\d{4}\\-\\d\\d-\\d\\d\\s # 1: YYYYMMDD HHMMSS
1859 (\\d\\d) # 2: HH
1860 :
1861 (\\d\\d) # 3: MM
1862 :\\d\\d
1863 )
1864 (\\.\\d+)? # 4: subseconds
1865 (\s[-+]\\d\\d\\d\\d)? # 5: tz-offset
1866 (\s\\[\\d+\\])? # 6: pid
1867 /ox;
1868
1869 $tod = defined($5) ? $1 . $5 : $1;
1870 ($m_hour,$m_min) = ($2,$3);
1871
1872 # PH - watch for GMT offsets in the timestamp.
1873 if (defined($5)) {
1874 $extra = 6;
1875 next if ($length < 44);
1876 }
1877 else {
1878 $extra = 0;
1879 }
1880
1881 # watch for subsecond precision
1882 if (defined($4)) {
1883 $extra += length($4);
1884 next if ($length < 38 + $extra);
1885 }
1886
1887 # PH - watch for PID added after the timestamp.
1888 if (defined($6)) {
1889 $extra += length($6);
1890 next if ($length < 38 + $extra);
1891 }
1892
1893 $id = substr($_, 20 + $extra, 16);
1894 $flag = substr($_, 37 + $extra, 2);
1895
1896 if ($flag !~ /^([<>=*-]+|SA)$/ && /rejected|refused|dropped/) {
1897 $flag = "Re";
1898 $extra -= 3;
1899 }
1900
1901 # Rejects can have no MSGID...
1902 if ($flag eq "Re" && $id !~ /^[-0-9a-zA-Z]+$/) {
1903 $id = "reject:" . ++$rej_id;
1904 $extra -= 17;
1905 }
1906 ';
1907
1908 # Watch for user specified patterns.
1909 my $user_pattern_index = 0;
1910 foreach (@user_patterns) {
1911 $user_pattern_totals[$user_pattern_index] = 0;
1912 $parser .= " if ($_) {\n";
1913 $parser .= " \$user_pattern_totals[$user_pattern_index]++;\n";
1914 $parser .= " \$user_pattern_interval_count[$user_pattern_index][(\$m_hour*60 + \$m_min)/$hist_interval]++;\n" if ($hist_opt > 0);
1915 $parser .= " }\n";
1916 $user_pattern_index++;
1917 }
1918
1919 $parser .= '
1920 next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co|SA|Re/);
1921
1922 #Strip away the timestamp, ID and flag to speed up later pattern matches.
1923 #The flags include Co (Completed), Re (Rejected), and SA (SpamAssassin).
1924 $_ = substr($_, 40 + $extra); # PH
1925
1926 # Alias @message to the array of information about the message.
1927 # This minimises the number of calls to hash functions.
1928 $messages{$id} = [] unless exists $messages{$id};
1929 *message = $messages{$id};
1930
1931
1932 # JN - Skip over certain transports as specified via the "-nt/.../" command
1933 # line switch (where ... is a perl style regular expression). This is
1934 # required so that transports that skew stats such as SpamAssassin can be
1935 # ignored.
1936 #IFDEF ($transport_pattern)
1937 if (/\\sT=(\\S+)/) {
1938 next if ($1 =~ /$transport_pattern/o) ;
1939 }
1940 #ENDIF ($transport_pattern)
1941
1942
1943
1944 # Do some pattern matches to get the host and IP address.
1945 # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1946 # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1947 # We do 2 separate matches to keep the matches simple and fast.
1948 # Host is local unless otherwise specified.
1949 # Watch out for "H=([IpAddr])" in case they send "[IpAddr]" as their HELO!
1950 $ip = (/\\bH=(?:|.*? )(\\[[^]]+\\])/) ? $1
1951 # 2008-03-31 06:25:22 Connection from [213.246.33.217]:39456 refused: too many connections from that IP address // .hs
1952 : (/Connection from (\[\S+\])/) ? $1
1953 # 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
1954 : (/SMTP call from .*?(\[\S+\])/) ? $1
1955 : "local";
1956 $host = (/\\bH=(\\S+)/) ? $1 : "local";
1957
1958 $domain = "localdomain"; #Domain is localdomain unless otherwise specified.
1959
1960 #IFDEF ($do_sender{Domain})
1961 if ($host =~ /^\\[/ || $host =~ /^[\\d\\.]+$/) {
1962 # Host is just an IP address.
1963 $domain = $host;
1964 }
1965 elsif ($host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1966 # Remove the host portion from the DNS name. We ensure that we end up
1967 # with at least xxx.yyy. $host can be "(x.y.z)" or "x.y.z".
1968 $domain = lc("$1.$2");
1969 $domain =~ s/^\\.//; #Remove preceding dot.
1970 }
1971 #ENDIF ($do_sender{Domain})
1972
1973 #IFDEF ($do_sender{Email})
1974 #IFDEF ($include_original_destination)
1975 # Catch both "a@b.com <c@d.com>" and "e@f.com"
1976 #$email = (/^(\S+) (<(\S*?)>)?/) ? $3 || $1 : "";
1977 $email = (/^(\S+ (<[^@>]+@?[^>]*>)?)/) ? $1 : "";
1978 chomp($email);
1979 #ENDIF ($include_original_destination)
1980
1981 #IFNDEF ($include_original_destination)
1982 $email = (/^(\S+)/) ? $1 : "";
1983 #ENDIF ($include_original_destination)
1984 #ENDIF ($do_sender{Email})
1985
1986 #IFDEF ($do_sender{Edomain})
1987 if (/^(<>|blackhole)/) {
1988 $edomain = $1;
1989 }
1990 #IFDEF ($include_original_destination)
1991 elsif (/^(\S+ (<\S*?\\@(\S+?)>)?)/) {
1992 $edomain = $1;
1993 chomp($edomain);
1994 $edomain =~ s/@(\S+?)>/"@" . lc($1) . ">"/e;
1995 }
1996 #ENDIF ($include_original_destination)
1997 #IFNDEF ($include_original_destination)
1998 elsif (/^\S*?\\@(\S+)/) {
1999 $edomain = lc($1);
2000 }
2001 #ENDIF ($include_original_destination)
2002 else {
2003 $edomain = "";
2004 }
2005
2006 #ENDIF ($do_sender{Edomain})
2007
2008 if ($tod lt $begin) {
2009 $begin = $tod;
2010 }
2011 elsif ($tod gt $end) {
2012 $end = $tod;
2013 }
2014
2015
2016 if ($flag eq "<=") {
2017 $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
2018 $message[$SIZE] = $thissize;
2019 $message[$PROTOCOL] = (/ P=(\S+)/) ? $1 : undef;
2020
2021 #IFDEF ($show_relay)
2022 if ($host ne "local") {
2023 # Save incoming information in case it becomes interesting
2024 # later, when delivery lines are read.
2025 my($from) = /^(\\S+)/;
2026 $message[$FROM_HOST] = "$host$ip";
2027 $message[$FROM_ADDRESS] = $from;
2028 }
2029 #ENDIF ($show_relay)
2030
2031 #IFDEF ($local_league_table || $include_remote_users)
2032 if (/\sU=(\\S+)/) {
2033 my $user = $1;
2034
2035 #IFDEF ($local_league_table && $include_remote_users)
2036 { #Store both local and remote users.
2037 #ENDIF ($local_league_table && $include_remote_users)
2038
2039 #IFDEF ($local_league_table && ! $include_remote_users)
2040 if ($host eq "local") { #Store local users only.
2041 #ENDIF ($local_league_table && ! $include_remote_users)
2042
2043 #IFDEF ($include_remote_users && ! $local_league_table)
2044 if ($host ne "local") { #Store remote users only.
2045 #ENDIF ($include_remote_users && ! $local_league_table)
2046
2047 ++$received_count_user{$user};
2048 add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
2049 }
2050 }
2051 #ENDIF ($local_league_table || $include_remote_users)
2052
2053 #IFDEF ($do_sender{Host})
2054 ++$received_count{Host}{$host};
2055 add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
2056 #ENDIF ($do_sender{Host})
2057
2058 #IFDEF ($do_sender{Domain})
2059 if ($domain) {
2060 ++$received_count{Domain}{$domain};
2061 add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
2062 }
2063 #ENDIF ($do_sender{Domain})
2064
2065 #IFDEF ($do_sender{Email})
2066 ++$received_count{Email}{$email};
2067 add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
2068 #ENDIF ($do_sender{Email})
2069
2070 #IFDEF ($do_sender{Edomain})
2071 ++$received_count{Edomain}{$edomain};
2072 add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
2073 #ENDIF ($do_sender{Edomain})
2074
2075 ++$total_received_count;
2076 add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
2077
2078 #IFDEF ($#queue_times >= 0 || $#rcpt_times >= 0)
2079 $message[$ARRIVAL_TIME] = $tod;
2080 #ENDIF ($#queue_times >= 0 || $#rcpt_times >= 0)
2081
2082 #IFDEF ($hist_opt > 0)
2083 $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2084 #ENDIF ($hist_opt > 0)
2085 }
2086
2087 elsif ($flag eq "=>") {
2088 $size = $message[$SIZE] || 0;
2089 if ($host ne "local") {
2090 $message[$REMOTE_DELIVERED] = 1;
2091
2092
2093 #IFDEF ($show_relay)
2094 # Determine relaying address if either only one address listed,
2095 # or two the same. If they are different, it implies a forwarding
2096 # or aliasing, which is not relaying. Note that for multi-aliased
2097 # addresses, there may be a further address between the first
2098 # and last.
2099
2100 if (defined $message[$FROM_HOST]) {
2101 if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
2102 ($old,$new) = ($1,$2);
2103 }
2104 else {
2105 $old = $new = "";
2106 }
2107
2108 if ("\\L$new" eq "\\L$old") {
2109 ($old) = /^(\\S+)/ if $old eq "";
2110 my $key = "H=\\L$message[$FROM_HOST]\\E A=\\L$message[$FROM_ADDRESS]\\E => " .
2111 "H=\\L$host\\E$ip A=\\L$old\\E";
2112 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2113 $relayed{$key} = 0 if !defined $relayed{$key};
2114 ++$relayed{$key};
2115 }
2116 else {
2117 ++$relayed_unshown;
2118 }
2119 }
2120 }
2121 #ENDIF ($show_relay)
2122
2123 }
2124
2125 #IFDEF ($local_league_table || $include_remote_users)
2126 #IFDEF ($local_league_table && $include_remote_users)
2127 { #Store both local and remote users.
2128 #ENDIF ($local_league_table && $include_remote_users)
2129
2130 #IFDEF ($local_league_table && ! $include_remote_users)
2131 if ($host eq "local") { #Store local users only.
2132 #ENDIF ($local_league_table && ! $include_remote_users)
2133
2134 #IFDEF ($include_remote_users && ! $local_league_table)
2135 if ($host ne "local") { #Store remote users only.
2136 #ENDIF ($include_remote_users && ! $local_league_table)
2137
2138 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2139 #IFDEF ($include_original_destination)
2140 {
2141 #ENDIF ($include_original_destination)
2142 #IFNDEF ($include_original_destination)
2143 if ($user =~ /^[\\/|]/) {
2144 #ENDIF ($include_original_destination)
2145 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2146 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2147 if (defined $parent) {
2148 $user = "$user $parent";
2149 #IFDEF ($do_local_domain)
2150 if ($parent =~ /\\@(.+)>/) {
2151 $local_domain = lc($1);
2152 ++$delivered_messages_local_domain{$local_domain};
2153 ++$delivered_addresses_local_domain{$local_domain};
2154 add_volume(\\$delivered_data_local_domain{$local_domain},\\$delivered_data_gigs_local_domain{$local_domain},$size);
2155 }
2156 #ENDIF ($do_local_domain)
2157 }
2158 }
2159 ++$delivered_messages_user{$user};
2160 ++$delivered_addresses_user{$user};
2161 add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
2162 }
2163 }
2164 #ENDIF ($local_league_table || $include_remote_users)
2165
2166 #IFDEF ($do_sender{Host})
2167 $delivered_messages{Host}{$host}++;
2168 $delivered_addresses{Host}{$host}++;
2169 add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
2170 #ENDIF ($do_sender{Host})
2171 #IFDEF ($do_sender{Domain})
2172 if ($domain) {
2173 ++$delivered_messages{Domain}{$domain};
2174 ++$delivered_addresses{Domain}{$domain};
2175 add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
2176 }
2177 #ENDIF ($do_sender{Domain})
2178 #IFDEF ($do_sender{Email})
2179 ++$delivered_messages{Email}{$email};
2180 ++$delivered_addresses{Email}{$email};
2181 add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
2182 #ENDIF ($do_sender{Email})
2183 #IFDEF ($do_sender{Edomain})
2184 ++$delivered_messages{Edomain}{$edomain};
2185 ++$delivered_addresses{Edomain}{$edomain};
2186 add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
2187 #ENDIF ($do_sender{Edomain})
2188
2189 ++$total_delivered_messages;
2190 ++$total_delivered_addresses;
2191 add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
2192
2193 #IFDEF ($show_transport)
2194 my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
2195 ++$transported_count{$transport};
2196 add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
2197 #ENDIF ($show_transport)
2198
2199 #IFDEF ($hist_opt > 0)
2200 $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
2201 #ENDIF ($hist_opt > 0)
2202
2203 #IFDEF ($#delivery_times > 0)
2204 if (/ DT=(\S+)/) {
2205 $seconds = wdhms_seconds($1);
2206 for ($i = 0; $i <= $#delivery_times; $i++) {
2207 if ($seconds < $delivery_times[$i]) {
2208 ++$dt_all_bin[$i];
2209 ++$dt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2210 last;
2211 }
2212 }
2213 if ($i > $#delivery_times) {
2214 ++$dt_all_overflow;
2215 ++$dt_remote_overflow if $message[$REMOTE_DELIVERED];
2216 }
2217 }
2218 #ENDIF ($#delivery_times > 0)
2219
2220 }
2221
2222 elsif ($flag eq "->") {
2223
2224 #IFDEF ($local_league_table || $include_remote_users)
2225 #IFDEF ($local_league_table && $include_remote_users)
2226 { #Store both local and remote users.
2227 #ENDIF ($local_league_table && $include_remote_users)
2228
2229 #IFDEF ($local_league_table && ! $include_remote_users)
2230 if ($host eq "local") { #Store local users only.
2231 #ENDIF ($local_league_table && ! $include_remote_users)
2232
2233 #IFDEF ($include_remote_users && ! $local_league_table)
2234 if ($host ne "local") { #Store remote users only.
2235 #ENDIF ($include_remote_users && ! $local_league_table)
2236
2237 if (my($user) = split((/\\s</)? " <" : " ", $_)) {
2238 #IFDEF ($include_original_destination)
2239 {
2240 #ENDIF ($include_original_destination)
2241 #IFNDEF ($include_original_destination)
2242 if ($user =~ /^[\\/|]/) {
2243 #ENDIF ($include_original_destination)
2244 #my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
2245 my($parent) = $_ =~ / (<.+?>) /; #DT 1.54
2246 $user = "$user $parent" if defined $parent;
2247 }
2248 ++$delivered_addresses_user{$user};
2249 }
2250 }
2251 #ENDIF ($local_league_table || $include_remote_users)
2252
2253 #IFDEF ($do_sender{Host})
2254 $delivered_addresses{Host}{$host}++;
2255 #ENDIF ($do_sender{Host})
2256 #IFDEF ($do_sender{Domain})
2257 if ($domain) {
2258 ++$delivered_addresses{Domain}{$domain};
2259 }
2260 #ENDIF ($do_sender{Domain})
2261 #IFDEF ($do_sender{Email})
2262 ++$delivered_addresses{Email}{$email};
2263 #ENDIF ($do_sender{Email})
2264 #IFDEF ($do_sender{Edomain})
2265 ++$delivered_addresses{Edomain}{$edomain};
2266 #ENDIF ($do_sender{Edomain})
2267
2268 ++$total_delivered_addresses;
2269 }
2270
2271 elsif ($flag eq "==" && defined($message[$SIZE]) && !defined($message[$DELAYED])) {
2272 ++$delayed_count;
2273 $message[$DELAYED] = 1;
2274 }
2275
2276 elsif ($flag eq "**") {
2277 if (defined ($message[$SIZE])) {
2278 unless (defined $message[$HAD_ERROR]) {
2279 ++$message_errors;
2280 $message[$HAD_ERROR] = 1;
2281 }
2282 }
2283
2284 #IFDEF ($show_errors)
2285 ++$errors_count{$_};
2286 #ENDIF ($show_errors)
2287
2288 }
2289
2290 elsif ($flag eq "Co") {
2291 #Completed?
2292 #IFDEF ($#queue_times >= 0)
2293 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2294
2295 for ($i = 0; $i <= $#queue_times; $i++) {
2296 if ($queued < $queue_times[$i]) {
2297 ++$qt_all_bin[$i];
2298 ++$qt_remote_bin[$i] if $message[$REMOTE_DELIVERED];
2299 last;
2300 }
2301 }
2302 if ($i > $#queue_times) {
2303 ++$qt_all_overflow;
2304 ++$qt_remote_overflow if $message[$REMOTE_DELIVERED];
2305 }
2306 #ENDIF ($#queue_times >= 0)
2307
2308 #IFDEF ($#rcpt_times >= 0)
2309 if (/ QT=(\S+)/) {
2310 $seconds = wdhms_seconds($1);
2311 #Calculate $queued if not previously calculated above.
2312 #IFNDEF ($#queue_times >= 0)
2313 $queued = queue_time($tod, $message[$ARRIVAL_TIME], $id);
2314 #ENDIF ($#queue_times >= 0)
2315 $rcpt_time = $seconds - $queued;
2316 my($protocol);
2317
2318 if (defined $message[$PROTOCOL]) {
2319 $protocol = $message[$PROTOCOL];
2320
2321 # Create the bin if its not already defined.
2322 unless (exists $rcpt_times_bin{$protocol}) {
2323 initialise_rcpt_times($protocol);
2324 }
2325 }
2326
2327
2328 for ($i = 0; $i <= $#rcpt_times; ++$i) {
2329 if ($rcpt_time < $rcpt_times[$i]) {
2330 ++$rcpt_times_bin{all}[$i];
2331 ++$rcpt_times_bin{$protocol}[$i] if defined $protocol;
2332 last;
2333 }
2334 }
2335
2336 if ($i > $#rcpt_times) {
2337 ++$rcpt_times_overflow{all};
2338 ++$rcpt_times_overflow{$protocol} if defined $protocol;
2339 }
2340 }
2341 #ENDIF ($#rcpt_times >= 0)
2342
2343 delete($messages{$id});
2344 }
2345 elsif ($flag eq "SA") {
2346 $ip = (/From.*?(\\[[^]]+\\])/ || /\\((local)\\)/) ? $1 : "";
2347 #SpamAssassin message
2348 if (/Action: ((permanently|temporarily) rejected message|flagged as Spam but accepted): score=(\d+\.\d)/) {
2349 #add_volume(\\$spam_score,\\$spam_score_gigs,$3);
2350 ++$spam_count_by_ip{$ip};
2351 } elsif (/Action: scanned but message isn\'t spam: score=(-?\d+\.\d)/) {
2352 #add_volume(\\$ham_score,\\$ham_score_gigs,$1);
2353 ++$ham_count_by_ip{$ip};
2354 } elsif (/(Not running SA because SAEximRunCond expanded to false|check skipped due to message size)/) {
2355 ++$ham_count_by_ip{$ip};
2356 }
2357 }
2358
2359 # Look for Reject messages or blackholed messages (deliveries
2360 # without a transport)
2361 if ($flag eq "Re" || ($flag eq "=>" && ! /\\sT=\\S+/)) {
2362 # Correct the IP address for rejects:
2363 # rejected EHLO from my.test.net [10.0.0.5]: syntactically invalid argument(s):
2364 # rejected EHLO from [10.0.0.6]: syntactically invalid argument(s):
2365 $ip = $1 if ($ip eq "local" && /^rejected [HE][HE]LO from .*?(\[.+?\]):/);
2366 if (/SpamAssassin/) {
2367 ++$rejected_count_by_reason{"Rejected by SpamAssassin"};
2368 ++$rejected_count_by_ip{$ip};
2369 }
2370 elsif (
2371 /(temporarily rejected [A-Z]*) .*?(: .*?)(:|\s*$)/
2372 ) {
2373 ++$temporarily_rejected_count_by_reason{"\u$1$2"};
2374 ++$temporarily_rejected_count_by_ip{$ip};
2375 }
2376 elsif (
2377 /(temporarily refused connection)/
2378 ) {
2379 ++$temporarily_rejected_count_by_reason{"\u$1"};
2380 ++$temporarily_rejected_count_by_ip{$ip};
2381 }
2382 elsif (
2383 /(listed at [^ ]+)/ ||
2384 /(Forged IP detected in HELO)/ ||
2385 /(Invalid domain or IP given in HELO\/EHLO)/ ||
2386 /(unqualified recipient rejected)/ ||
2387 /(closed connection (after|in response) .*?)\s*$/ ||
2388 /(sender rejected)/ ||
2389 # 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.
2390 # 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.
2391 / rejected after DATA: (.*)/ ||
2392 / (rejected DATA: .*)/ ||
2393 /.DATA ACL discarded recipients.: (.*)/ ||
2394 /rejected after DATA: (unqualified address not permitted)/ ||
2395 /(VRFY rejected)/ ||
2396 # /(sender verify (defer|fail))/i ||
2397 /(too many recipients)/ ||
2398 /(refused relay.*?) to/ ||
2399 /(rejected by non-SMTP ACL: .*)/ ||
2400 /(rejected by local_scan.*)/ ||
2401 # SMTP call from %s dropped: too many syntax or protocol errors (last command was "%s"
2402 # SMTP call from %s dropped: too many nonmail commands
2403 /(dropped: too many ((nonmail|unrecognized) commands|syntax or protocol errors))/ ||
2404
2405 # local_scan() function crashed with signal %d - message temporarily rejected
2406 # local_scan() function timed out - message temporarily rejected
2407 /(local_scan.. function .* - message temporarily rejected)/ ||
2408 # SMTP protocol synchronization error (input sent without waiting for greeting): rejected connection from %s
2409 /(SMTP protocol .*?(error|violation))/ ||
2410 /(message too big)/
2411 ) {
2412 ++$rejected_count_by_reason{"\u$1"};
2413 ++$rejected_count_by_ip{$ip};
2414 }
2415 elsif (/rejected [HE][HE]LO from [^:]*: syntactically invalid argument/) {
2416 ++$rejected_count_by_reason{"Rejected HELO/EHLO: syntactically invalid argument"};
2417 ++$rejected_count_by_ip{$ip};
2418 }
2419 elsif (/response to "RCPT TO.*? was: (.*)/) {
2420 ++$rejected_count_by_reason{"Response to RCPT TO was: $1"};
2421 ++$rejected_count_by_ip{$ip};
2422 }
2423 elsif (
2424 /(lookup of host )\S+ (failed)/ ||
2425
2426 # rejected from <%s>%s%s%s%s: message too big:
2427 /(rejected [A-Z]*) .*?(: .*?)(:|\s*$)/ ||
2428 # refused connection from %s (host_reject_connection)
2429 # refused connection from %s (tcp wrappers)
2430 /(refused connection )from.*? (\(.*)/ ||
2431
2432 # 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
2433 # 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.
2434 /(error from remote mailer after .*?:).*(: .*?)(:|\s*$)/ ||
2435
2436 # a.b.c F=<a@b.c> rejected after DATA: "@" or "." expected after "Undisclosed-Recipient": failing address in "To" header is: <Undisclosed-Recipient:;>
2437 /rejected after DATA: ("." or "." expected).*?(: failing address in .*? header)/ ||
2438
2439 # connection from %s refused load average = %.2f
2440 /(Connection )from.*? (refused: load average)/ ||
2441 # connection from %s refused (IP options)
2442 # Connection from %s refused: too many connections
2443 # connection from %s refused
2444 /([Cc]onnection )from.*? (refused.*)/ ||
2445 # [10.0.0.1]: connection refused
2446 /: (Connection refused)()/
2447 ) {
2448 ++$rejected_count_by_reason{"\u$1$2"};
2449 ++$rejected_count_by_ip{$ip};
2450 }
2451 elsif (
2452 # 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
2453 # 2008-03-31 06:25:22 H=mail.densitron.com [216.70.140.224]:45386 temporarily rejected connection in "connect" ACL // .hs
2454 /(temporarily rejected connection in .*?ACL:?.*)/
2455 ) {
2456 ++$temporarily_rejected_count_by_ip{$ip};
2457 ++$temporarily_rejected_count_by_reason{"\u$1"};
2458 }
2459 else {
2460 ++$rejected_count_by_reason{Unknown};
2461 ++$rejected_count_by_ip{$ip};
2462 print STDERR "Unknown rejection: $_" if $debug;
2463 }
2464 }
2465 }';
2466
2467 # We now do a 'C preprocessor style operation on our parser
2468 # to remove bits not in use.
2469 my(%defines_in_operation,$removing_lines,$processed_parser);
2470 foreach (split (/\n/,$parser)) {
2471 if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i && ! eval $1) ||
2472 (/^\s*#\s*IFNDEF\s*\((.*?)\)/i && eval $1) ) {
2473 $defines_in_operation{$1} = 1;
2474 $removing_lines = 1;
2475 }
2476
2477 # Convert constants.
2478 while (/(\$[A-Z][A-Z_]*)\b/) {
2479 my $constant = eval $1;
2480 s/(\$[A-Z][A-Z_]*)\b/$constant/;
2481 }
2482
2483 $processed_parser .= $_."\n" unless $removing_lines;
2484
2485 if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
2486 delete $defines_in_operation{$1};
2487 unless (keys %defines_in_operation) {
2488 $removing_lines = 0;
2489 }
2490 }
2491 }
2492 print STDERR "# START OF PARSER:$processed_parser\n# END OF PARSER\n\n" if $debug;
2493
2494 return $processed_parser;
2495 }
2496
2497
2498
2499 #######################################################################
2500 # parse();
2501 #
2502 # parse($parser,\*FILEHANDLE);
2503 #
2504 # This subroutine accepts a parser and a filehandle from main and parses each
2505 # line. We store the results into global variables.
2506 #######################################################################
2507 sub parse {
2508 my($parser,$fh) = @_;
2509
2510 if ($merge_reports) {
2511 parse_old_eximstat_reports($fh);
2512 }
2513 else {
2514 eval $parser;
2515 die ($@) if $@;
2516 }
2517
2518 }
2519
2520
2521
2522 #######################################################################
2523 # print_header();
2524 #
2525 # print_header();
2526 #
2527 # Print our headers and contents.
2528 #######################################################################
2529 sub print_header {
2530
2531
2532 my $title = "Exim statistics from $begin to $end";
2533
2534 print $txt_fh "\n$title\n" if $txt_fh;
2535 if ($htm_fh) {
2536 print $htm_fh html_header($title);
2537 print $htm_fh "<ul>\n";
2538 print $htm_fh "<li><a href=\"#Grandtotal\">Grand total summary</a>\n";
2539 print $htm_fh "<li><a href=\"#Patterns\">User Specified Patterns</a>\n" if @user_patterns;
2540 print $htm_fh "<li><a href=\"#Transport\">Deliveries by Transport</a>\n" if $show_transport;
2541 if ($hist_opt) {
2542 print $htm_fh "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
2543 print $htm_fh "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
2544 }
2545
2546 if ($#queue_times >= 0) {
2547 print $htm_fh "<li><a href=\"#Time spent on the queue all messages\">Time spent on the queue: all messages</a>\n";
2548 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";
2549 }
2550
2551 if ($#delivery_times >= 0) {
2552 print $htm_fh "<li><a href=\"#Delivery times all messages\">Delivery times: all messages</a>\n";
2553 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";
2554 }
2555
2556 if ($#rcpt_times >= 0) {
2557 print $htm_fh "<li><a href=\"#Receipt times all messages\">Receipt times</a>\n";
2558 }
2559
2560 print $htm_fh "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
2561 if ($topcount) {
2562 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;
2563 foreach ('Host','Domain','Email','Edomain') {
2564 next unless $do_sender{$_};
2565 print $htm_fh "<li><a href=\"#Sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
2566 print $htm_fh "<li><a href=\"#Sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
2567 }
2568 if (($local_league_table || $include_remote_users) && %received_count_user) {
2569 print $htm_fh "<li><a href=\"#Local sender count\">Top $topcount local senders by message count</a>\n";
2570 print $htm_fh "<li><a href=\"#Local sender volume\">Top $topcount local senders by volume</a>\n";
2571 }
2572 foreach ('Host','Domain','Email','Edomain') {
2573 next unless $do_sender{$_};
2574 print $htm_fh "<li><a href=\"#$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
2575 print $htm_fh "<li><a href=\"#$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
2576 }
2577 if (($local_league_table || $include_remote_users) && %delivered_messages_user) {
2578 print $htm_fh "<li><a href=\"#Local destination count\">Top $topcount local destinations by message count</a>\n";
2579 print $htm_fh "<li><a href=\"#Local destination volume\">Top $topcount local destinations by volume</a>\n";
2580 }
2581 if (($local_league_table || $include_remote_users) && %delivered_messages_local_domain) {
2582 print $htm_fh "<li><a href=\"#Local domain destination count\">Top $topcount local domain destinations by message count</a>\n";
2583 print $htm_fh "<li><a href=\"#Local domain destination volume\">Top $topcount local domain destinations by volume</a>\n";
2584 }
2585
2586 print $htm_fh "<li><a href=\"#Rejected ip count\">Top $topcount rejected ips by message count</a>\n" if %rejected_count_by_ip;
2587 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;
2588 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;
2589
2590 }
2591 print $htm_fh "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
2592 print $htm_fh "</ul>\n<hr>\n";
2593 }
2594 if ($xls_fh)
2595 {
2596 $ws_global->write($row++, $col+0, "Exim Statistics", $f_header1);
2597 &set_worksheet_line($ws_global, $row, $col, ["from:", $begin, "to:", $end], $f_default);
2598 $row+=2;
2599 }
2600 }
2601
2602
2603 #######################################################################
2604 # print_grandtotals();
2605 #
2606 # print_grandtotals();
2607 #
2608 # Print the grand totals.
2609 #######################################################################
2610 sub print_grandtotals {
2611
2612 # Get the sender by headings and results. This is complicated as we can have
2613 # different numbers of columns.
2614 my($sender_txt_header,$sender_txt_format,$sender_html_format);
2615 my(@received_totals,@delivered_totals);
2616 my($row_tablehead, $row_max);
2617 my(@col_headers) = ('TOTAL', 'Volume', 'Messages', 'Addresses');
2618
2619 foreach ('Host','Domain','Email','Edomain') {
2620 next unless $do_sender{$_};
2621 if ($merge_reports) {
2622 push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
2623 push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
2624 }
2625 else {
2626 push(@received_totals,scalar(keys %{$received_data{$_}}));
2627 push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
2628 }
2629 $sender_txt_header .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
2630 $sender_html_format .= "<td align=\"right\">%s</td>";
2631 $sender_txt_format .= " " x ($COLUMN_WIDTHS - 5) . "%6s";
2632 push(@col_headers,"${_}s");
2633 }
2634
2635 my $txt_format1 = " %-16s %9s %6d %6s $sender_txt_format";
2636 my $txt_format2 = " %6d %4.1f%% %6d %4.1f%%",
2637 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";
2638 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>";
2639
2640 if ($txt_fh) {
2641 my $sender_spaces = " " x length($sender_txt_header);
2642 print $txt_fh "\n";
2643 print $txt_fh "Grand total summary\n";
2644 print $txt_fh "-------------------\n";
2645 print $txt_fh " $sender_spaces At least one address\n";
2646 print $txt_fh " TOTAL Volume Messages Addresses $sender_txt_header Delayed Failed\n";
2647 }
2648 if ($htm_fh) {
2649 print $htm_fh "<a name=\"Grandtotal\"></a>\n";
2650 print $htm_fh "<h2>Grand total summary</h2>\n";
2651 print $htm_fh "<table border=1>\n";
2652 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";
2653 }
2654 if ($xls_fh) {
2655 $ws_global->write($row++, 0, "Grand total summary", $f_header2);
2656 $ws_global->write($row, 0, \@col_headers, $f_header2);
2657 $ws_global->merge_range($row, scalar(@col_headers), $row, scalar(@col_headers)+1, "At least one addr Delayed", $f_header2_m);
2658 $ws_global->merge_range($row, scalar(@col_headers)+2, $row, scalar(@col_headers)+3, "At least one addr Failed", $f_header2_m);
2659 #$ws_global->write(++$row, scalar(@col_headers), ['Total','Percent','Total','Percent'], $f_header2);
2660 }
2661
2662
2663 my($volume,$failed_count);
2664 if ($merge_reports) {
2665 $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
2666 $total_received_count = get_report_total($report_totals{Received},'Messages');
2667 $failed_count = get_report_total($report_totals{Received},'Failed');
2668 $delayed_count = get_report_total($report_totals{Received},'Delayed');
2669 }
2670 else {
2671 $volume = volume_rounded($total_received_data, $total_received_data_gigs);
2672 $failed_count = $message_errors;
2673 }
2674
2675 {
2676 no integer;
2677
2678 my @content=(
2679 $volume,$total_received_count,'',
2680 @received_totals,
2681 $delayed_count,
2682 ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
2683 $failed_count,
2684 ($total_received_count) ? ($failed_count*100/$total_received_count) : 0
2685 );
2686
2687 printf $txt_fh ("$txt_format1$txt_format2\n", 'Received', @content) if $txt_fh;
2688 printf $htm_fh ("$htm_format1$htm_format2\n", 'Received', @content) if $htm_fh;
2689 if ($xls_fh) {
2690 $ws_global->write(++$row, 0, 'Received', $f_default);
2691 for (my $i=0; $i < scalar(@content); $i++) {
2692 if ($i == 4 || $i == 6) {
2693 $ws_global->write($row, $i+1, $content[$i]/100, $f_percent);
2694 }
2695 else {
2696 $ws_global->write($row, $i+1, $content[$i], $f_default);
2697 }
2698 }
2699 }
2700 }
2701
2702 if ($merge_reports) {
2703 $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
2704 $total_delivered_messages = get_report_total($report_totals{Delivered},'Messages');
2705 $total_delivered_addresses = get_report_total($report_totals{Delivered},'Addresses');
2706 }
2707 else {
2708 $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
2709 }
2710
2711 my @content=($volume, $total_delivered_messages, $total_delivered_addresses, @delivered_totals);
2712 printf $txt_fh ("$txt_format1\n", 'Delivered', @content) if $txt_fh;
2713 printf $htm_fh ("$htm_format1\n", 'Delivered', @content) if $htm_fh;
2714
2715 if ($xls_fh) {
2716 $ws_global->write(++$row, 0, 'Delivered', $f_default);
2717 for (my $i=0; $i < scalar(@content); $i++) {
2718 $ws_global->write($row, $i+1, $content[$i], $f_default);
2719 }
2720 }
2721
2722 if ($merge_reports) {
2723 foreach ('Rejects', 'Temp Rejects', 'Ham', 'Spam') {
2724 my $messages = get_report_total($report_totals{$_},'Messages');
2725 my $addresses = get_report_total($report_totals{$_},'Addresses');
2726 if ($messages) {
2727 @content = ($_, '', $messages, '');
2728 push(@content,get_report_total($report_totals{$_},'Hosts')) if $do_sender{Host};
2729 #These rows do not have entries for the following columns (if specified)
2730 foreach ('Domain','Email','Edomain') {
2731 push(@content,'') if $do_sender{$_};
2732 }
2733
2734 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2735 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2736 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2737 }
2738 }
2739 }
2740 else {
2741 foreach my $total_aref (['Rejects',\%rejected_count_by_ip],
2742 ['Temp Rejects',\%temporarily_rejected_count_by_ip],
2743 ['Ham',\%ham_count_by_ip],
2744 ['Spam',\%spam_count_by_ip]) {
2745 #Count the number of messages of this type.
2746 my $messages = 0;
2747 map {$messages += $_} values %{$total_aref->[1]};
2748
2749 if ($messages > 0) {
2750 @content = ($total_aref->[0], '', $messages, '');
2751
2752 #Count the number of distinct IPs for the Hosts column.
2753 push(@content,scalar(keys %{$total_aref->[1]})) if $do_sender{Host};
2754
2755 #These rows do not have entries for the following columns (if specified)
2756 foreach ('Domain','Email','Edomain') {
2757 push(@content,'') if $do_sender{$_};
2758 }
2759
2760 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2761 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2762 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2763 }
2764 }
2765 }
2766
2767 printf $txt_fh "\n" if $txt_fh;
2768 printf $htm_fh "</table>\n" if $htm_fh;
2769 ++$row;
2770 }
2771
2772
2773 #######################################################################
2774 # print_user_patterns()
2775 #
2776 # print_user_patterns();
2777 #
2778 # Print the counts of user specified patterns.
2779 #######################################################################
2780 sub print_user_patterns {
2781 my $txt_format1 = " %-18s %6d";
2782 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2783
2784 if ($txt_fh) {
2785 print $txt_fh "User Specified Patterns\n";
2786 print $txt_fh "-----------------------";
2787 print $txt_fh "\n Total\n";
2788 }
2789 if ($htm_fh) {
2790 print $htm_fh "<hr><a name=\"Patterns\"></a><h2>User Specified Patterns</h2>\n";
2791 print $htm_fh "<table border=0 width=\"100%\">\n";
2792 print $htm_fh "<tr><td>\n";
2793 print $htm_fh "<table border=1>\n";
2794 print $htm_fh "<tr><th>&nbsp;</th><th>Total</th>\n";
2795 }
2796 if ($xls_fh) {
2797 $ws_global->write($row++, $col, "User Specified Patterns", $f_header2);
2798 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2799 }
2800
2801
2802 my($key);
2803 if ($merge_reports) {
2804 # We are getting our data from previous reports.
2805 foreach $key (@user_descriptions) {
2806 my $count = get_report_total($report_totals{patterns}{$key},'Total');
2807 printf $txt_fh ("$txt_format1\n",$key,$count) if $txt_fh;
2808 printf $htm_fh ("$htm_format1\n",$key,$count) if $htm_fh;
2809 if ($xls_fh)
2810 {
2811 &set_worksheet_line($ws_global, $row++, 0, [$key,$count], $f_default);
2812 }
2813 }
2814 }
2815 else {
2816 # We are getting our data from mainlog files.
2817 my $user_pattern_index = 0;
2818 foreach $key (@user_descriptions) {
2819 printf $txt_fh ("$txt_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $txt_fh;
2820 printf $htm_fh ("$htm_format1\n",$key,$user_pattern_totals[$user_pattern_index]) if $htm_fh;
2821 $ws_global->write($row++, 0, [$key,$user_pattern_totals[$user_pattern_index]]) if $xls_fh;
2822 $user_pattern_index++;
2823 }
2824 }
2825 print $txt_fh "\n" if $txt_fh;
2826 print $htm_fh "</table>\n\n" if $htm_fh;
2827 if ($xls_fh)
2828 {
2829 ++$row;
2830 }
2831
2832 if ($hist_opt > 0) {
2833 my $user_pattern_index = 0;
2834 foreach $key (@user_descriptions) {
2835 print_histogram($key, 'occurence', @{$user_pattern_interval_count[$user_pattern_index]});
2836 $user_pattern_index++;
2837 }
2838 }
2839 }
2840
2841 #######################################################################
2842 # print_rejects()
2843 #
2844 # print_rejects();
2845 #
2846 # Print statistics about rejected mail.
2847 #######################################################################
2848 sub print_rejects {
2849 my($format1,$reason);
2850
2851 my $txt_format1 = " %-40s %6d";
2852 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
2853
2854 if ($txt_fh) {
2855 print $txt_fh "Rejected mail by reason\n";
2856 print $txt_fh "-----------------------";
2857 print $txt_fh "\n Total\n";
2858 }
2859 if ($htm_fh) {
2860 print $htm_fh "<hr><a name=\"patterns\"></a><h2>Rejected mail by reason</h2>\n";
2861 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2862 print $htm_fh "<tr><th>&nbsp;</th><th>Total</th>\n";
2863 }
2864 if ($xls_fh) {
2865 $ws_global->write($row++, $col, "Rejected mail by reason", $f_header2);
2866 &set_worksheet_line($ws_global, $row++, 1, ["Total"], $f_headertab);
2867 }
2868
2869
2870 my $href = ($merge_reports) ? $report_totals{rejected_mail_by_reason} : \%rejected_count_by_reason;
2871 my(@chartdatanames, @chartdatavals_count);
2872
2873 foreach $reason (top_n_sort($topcount, $href, undef, undef)) {
2874 printf $txt_fh ("$txt_format1\n",$reason,$href->{$reason}) if $txt_fh;
2875 printf $htm_fh ("$htm_format1\n",$reason,$href->{$reason}) if $htm_fh;
2876 set_worksheet_line($ws_global, $row++, 0, [$reason,$href->{$reason}], $f_default) if $xls_fh;
2877 push(@chartdatanames, $reason);
2878 push(@chartdatavals_count, $href->{$reason});
2879 }
2880
2881 $row++ if $xls_fh;
2882 print $txt_fh "\n" if $txt_fh;
2883
2884 if ($htm_fh) {
2885 print $htm_fh "</tr></table></td><td>";
2886 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0)) {
2887 # calculate the graph
2888 my @data = (
2889 \@chartdatanames,
2890 \@chartdatavals_count
2891 );
2892 my $graph = GD::Graph::pie->new(200, 200);
2893 $graph->set(
2894 x_label => 'Rejection Reasons',
2895 y_label => 'Messages',
2896 title => 'By count',
2897 );
2898 my $gd = $graph->plot(\@data) or warn($graph->error);
2899 if ($gd) {
2900 open(IMG, ">$chartdir/rejections_count.png") or die "Could not write $chartdir/rejections_count.png: $!\n";
2901 binmode IMG;
2902 print IMG $gd->png;
2903 close IMG;
2904 print $htm_fh "<img src=\"$chartrel/rejections_count.png\">";
2905 }
2906 }
2907 print $htm_fh "</td></tr></table>\n\n";
2908 }
2909 }
2910
2911
2912
2913
2914
2915 #######################################################################
2916 # print_transport();
2917 #
2918 # print_transport();
2919 #
2920 # Print totals by transport.
2921 #######################################################################
2922 sub print_transport {
2923 my(@chartdatanames);
2924 my(@chartdatavals_count);
2925 my(@chartdatavals_vol);
2926 no integer; #Lose this for charting the data.
2927
2928 my $txt_format1 = " %-18s %6s %6d";
2929 my $htm_format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
2930
2931 if ($txt_fh) {
2932 print $txt_fh "Deliveries by transport\n";
2933 print $txt_fh "-----------------------";
2934 print $txt_fh "\n Volume Messages\n";
2935 }
2936 if ($htm_fh) {
2937 print $htm_fh "<hr><a name=\"Transport\"></a><h2>Deliveries by Transport</h2>\n";
2938 print $htm_fh "<table border=0 width=\"100%\"><tr><td><table border=1>\n";
2939 print $htm_fh "<tr><th>&nbsp;</th><th>Volume</th><th>Messages</th>\n";
2940 }
2941 if ($xls_fh) {
2942 $ws_global->write(++$row, $col, "Deliveries by transport", $f_header2);
2943 $ws_global->write(++$row, 1, ["Volume", "Messages"], $f_headertab);
2944 }
2945
2946 my($key);
2947 if ($merge_reports) {
2948 # We are getting our data from previous reports.
2949 foreach $key (sort keys %{$report_totals{transport}}) {
2950 my $count = get_report_total($report_totals{transport}{$key},'Messages');
2951 my @content=($key, volume_rounded($report_totals{transport}{$key}{Volume},
2952 $report_totals{transport}{$key}{'Volume-gigs'}), $count);
2953 push(@chartdatanames, $key);
2954 push(@chartdatavals_count, $count);
2955 push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
2956 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2957 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2958 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2959 }
2960 }
2961 else {
2962 # We are getting our data from mainlog files.
2963 foreach $key (sort keys %transported_data) {
2964 my @content=($key, volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
2965 $transported_count{$key});
2966 push(@chartdatanames, $key);
2967 push(@chartdatavals_count, $transported_count{$key});
2968 push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
2969 printf $txt_fh ("$txt_format1\n", @content) if $txt_fh;
2970 printf $htm_fh ("$htm_format1\n", @content) if $htm_fh;
2971 $ws_global->write(++$row, 0, \@content) if $xls_fh;
2972 }
2973 }
2974 print $txt_fh "\n" if $txt_fh;
2975 if ($htm_fh) {
2976 print $htm_fh "</tr></table></td><td>";
2977
2978 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_count > 0))
2979 {
2980 # calculate the graph
2981 my @data = (
2982 \@chartdatanames,
2983 \@chartdatavals_count
2984 );
2985 my $graph = GD::Graph::pie->new(200, 200);
2986 $graph->set(
2987 x_label => 'Transport',
2988 y_label => 'Messages',
2989 title => 'By count',
2990 );
2991 my $gd = $graph->plot(\@data) or warn($graph->error);
2992 if ($gd) {
2993 open(IMG, ">$chartdir/transports_count.png") or die "Could not write $chartdir/transports_count.png: $!\n";
2994 binmode IMG;
2995 print IMG $gd->png;
2996 close IMG;
2997 print $htm_fh "<img src=\"$chartrel/transports_count.png\">";
2998 }
2999 }
3000 print $htm_fh "</td><td>";
3001
3002 if ($HAVE_GD_Graph_pie && $charts && ($#chartdatavals_vol > 0)) {
3003 my @data = (
3004 \@chartdatanames,
3005 \@chartdatavals_vol
3006 );
3007 my $graph = GD::Graph::pie->new(200, 200);
3008 $graph->set(
3009 title => 'By volume',
3010 );
3011 my $gd = $graph->plot(\@data) or warn($graph->error);
3012 if ($gd) {
3013 open(IMG, ">$chartdir/transports_vol.png") or die "Could not write $chartdir/transports_vol.png: $!\n";
3014 binmode IMG;
3015 print IMG $gd->png;
3016 close IMG;
3017 print $htm_fh "<img src=\"$chartrel/transports_vol.png\">";
3018 }
3019 }
3020
3021 print $htm_fh "</td></tr></table>\n\n";
3022 }
3023 }
3024
3025
3026
3027 #######################################################################
3028 # print_relay();
3029 #
3030 # print_relay();
3031 #
3032 # Print our totals by relay.
3033 #######################################################################
3034 sub print_relay {
3035 my $row_print_relay=1;
3036 my $temp = "Relayed messages";
3037 print $htm_fh "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $htm_fh;
3038 if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
3039 my $shown = 0;
3040 my $spacing = "";
3041 my $txt_format = "%7d %s\n => %s\n";
3042 my $htm_format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
3043
3044 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
3045 if ($htm_fh) {
3046 print $htm_fh "<table border=1>\n";
3047 print $htm_fh "<tr><th>Count</th><th>From</th><th>To</th>\n";
3048 }
3049 if ($xls_fh) {
3050 $ws_relayed->write($row_print_relay++, $col, $temp, $f_header2);
3051 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, ["Count", "From", "To"], $f_headertab);
3052 }
3053
3054
3055 my($key);
3056 foreach $key (sort keys %relayed) {
3057 my $count = $relayed{$key};
3058 $shown += $count;
3059 $key =~ s/[HA]=//g;
3060 my($one,$two) = split(/=> /, $key);
3061 my @content=($count, $one, $two);
3062 printf $txt_fh ($txt_format, @content) if $txt_fh;
3063 printf $htm_fh ($htm_format, @content) if $htm_fh;
3064 if ($xls_fh)
3065 {
3066 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, \@content);
3067 }
3068 $spacing = "\n";
3069 }
3070
3071 print $htm_fh "</table>\n<p>\n" if $htm_fh;
3072 print $txt_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $txt_fh;
3073 print $htm_fh "${spacing}Total: $shown (plus $relayed_unshown unshown)\n\n" if $htm_fh;
3074 if ($xls_fh)
3075 {
3076 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$shown, "Sum of shown" ]);
3077 &set_worksheet_line($ws_relayed, $row_print_relay++, 0, [$relayed_unshown, "unshown"]);
3078 $row_print_relay++;
3079 }
3080 }
3081 else {
3082 print $txt_fh "No relayed messages\n-------------------\n\n" if $txt_fh;
3083 print $htm_fh "No relayed messages\n\n" if $htm_fh;
3084 if ($xls_fh)
3085 {
3086 $row_print_relay++;
3087 }
3088 }
3089 }
3090
3091
3092
3093 #######################################################################
3094 # print_errors();
3095 #
3096 # print_errors();
3097 #
3098 # Print our errors. In HTML, we display them as a list rather than a table -
3099 # Netscape doesn't like large tables!
3100 #######################################################################
3101 sub print_errors {
3102 my $total_errors = 0;
3103 $row=1;
3104
3105 if (scalar(keys %errors_count) != 0) {
3106 my $temp = "List of errors";
3107 my $htm_format = "<li>%d - %s\n";
3108
3109 printf $txt_fh ("%s\n%s\n\n", $temp, "-" x length($temp)) if $txt_fh;
3110 if ($htm_fh) {
3111 print $htm_fh "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
3112 print $htm_fh "<ul><li><b>Count - Error</b>\n";
3113 }
3114 if ($xls_fh)
3115 {
3116 $ws_errors->write($row++, 0, $temp, $f_header2);
3117 &set_worksheet_line($ws_errors, $row++, 0, ["Count", "Error"], $f_headertab);
3118 }
3119
3120
3121 my($key);
3122 foreach $key (sort keys %errors_count) {
3123 my $text = $key;
3124 chomp($text);
3125 $text =~ s/\s\s+/ /g; #Convert multiple spaces to a single space.
3126 $total_errors += $errors_count{$key};
3127
3128 if ($txt_fh) {
3129 printf $txt_fh ("%5d ", $errors_count{$key});
3130 my $text_remaining = $text;
3131 while (length($text_remaining) > 65) {
3132 my($first,$rest) = $text_remaining =~ /(.{50}\S*)\s+(.+)/;
3133 last if !$first;
3134 printf $txt_fh ("%s\n\t ", $first);
3135 $text_remaining = $rest;
3136 }
3137 printf $txt_fh ("%s\n\n", $text_remaining);
3138 }
3139
3140 if ($htm_fh) {
3141
3142 #Translate HTML tag characters. Sergey Sholokh.
3143 $text =~ s/\</\&lt\;/g;
3144 $text =~ s/\>/\&gt\;/g;
3145
3146 printf $htm_fh ($htm_format,$errors_count{$key},$text);
3147 }
3148 if ($xls_fh)
3149 {
3150 &set_worksheet_line($ws_errors, $row++, 0, [$errors_count{$key},$text]);
3151 }
3152 }
3153
3154 $temp = "Errors encountered: $total_errors";
3155
3156 if ($txt_fh) {
3157 print $txt_fh $temp, "\n";
3158 print $txt_fh "-" x length($temp),"\n";
3159 }
3160 if ($htm_fh) {
3161 print $htm_fh "</ul>\n<p>\n";
3162 print $htm_fh $temp, "\n";
3163 }
3164 if ($xls_fh)
3165 {
3166 &set_worksheet_line($ws_errors, $row++, 0, [$total_errors, "Sum of Errors encountered"]);
3167 }
3168 }
3169
3170 }
3171
3172
3173 #######################################################################
3174 # parse_old_eximstat_reports();
3175 #
3176 # parse_old_eximstat_reports($fh);
3177 #
3178 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
3179 #
3180 # To test that the merging still works after changes, do something like the following.
3181 # All the diffs should produce no output.
3182 #
3183 # options='-bydomain -byemail -byhost -byedomain'
3184 # options="$options -show_rt1,2,4 -show_dt 1,2,4"
3185 # options="$options -pattern 'Completed Messages' /Completed/"
3186 # options="$options -pattern 'Received Messages' /<=/"
3187 #
3188 # ./eximstats $options mainlog > mainlog.txt
3189 # ./eximstats $options -merge mainlog.txt > mainlog.2.txt
3190 # diff mainlog.txt mainlog.2.txt
3191 #
3192 # ./eximstats $options -html mainlog > mainlog.html
3193 # ./eximstats $options -merge -html mainlog.txt > mainlog.2.html
3194 # diff mainlog.html mainlog.2.html
3195 #
3196 # ./eximstats $options -merge mainlog.html > mainlog.3.txt
3197 # diff mainlog.txt mainlog.3.txt
3198 #
3199 # ./eximstats $options -merge -html mainlog.html > mainlog.3.html
3200 # diff mainlog.html mainlog.3.html
3201 #
3202 # ./eximstats $options -nvr mainlog > mainlog.nvr.txt
3203 # ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
3204 # diff mainlog.txt mainlog.4.txt
3205 #
3206 # # double_mainlog.txt should have twice the values that mainlog.txt has.
3207 # ./eximstats $options mainlog mainlog > double_mainlog.txt
3208 #######################################################################
3209 sub parse_old_eximstat_reports {
3210 my($fh) = @_;
3211
3212 my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
3213
3214 my(%user_pattern_index);
3215 my $user_pattern_index = 0;
3216 map {$user_pattern_index{$_} = $user_pattern_index++} @user_descriptions;
3217 my $user_pattern_keys = join('|', @user_descriptions);
3218
3219 while (<$fh>) {
3220 PARSE_OLD_REPORT_LINE:
3221 if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
3222 $begin = $1 if ($1 lt $begin);
3223 $end = $3 if ($3 gt $end);
3224 }
3225 elsif (/Grand total summary/) {
3226 # Fill in $report_totals{Received|Delivered}{Volume|Messages|Addresses|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
3227 my(@fields, @delivered_fields);
3228 my $doing_table = 0;
3229 while (<$fh>) {
3230 $_ = html2txt($_); #Convert general HTML markup to text.
3231 s/At least one addr//g; #Another part of the HTML output we don't want.
3232
3233 # TOTAL Volume Messages Addresses Hosts Domains Delayed Failed
3234 # Received 26MB 237 177 23 8 3.4% 28 11.8%
3235 # Delivered 13MB 233 250 99 88
3236 if (/TOTAL\s+(.*?)\s*$/) {
3237 $doing_table = 1;
3238 @delivered_fields = split(/\s+/,$1);
3239
3240 #Delayed and Failed have two columns each, so add the extra field names in.
3241 splice(@delivered_fields,-1,1,'DelayedPercent','Failed','FailedPercent');
3242
3243 # Addresses only figure in the Delivered row, so remove them from the
3244 # normal fields.
3245 @fields = grep !/Addresses/, @delivered_fields;
3246 }
3247 elsif (/(Received)\s+(.*?)\s*$/) {
3248 print STDERR "Parsing $_" if $debug;
3249 add_to_totals($report_totals{$1},\@fields,$2);
3250 }
3251 elsif (/(Delivered)\s+(.*?)\s*$/) {
3252 print STDERR "Parsing $_" if $debug;
3253 add_to_totals($report_totals{$1},\@delivered_fields,$2);
3254 my $data = $2;
3255 # If we're merging an old report which doesn't include addresses,
3256 # then use the Messages field instead.
3257 unless (grep(/Addresses/, @delivered_fields)) {
3258 my %tmp;
3259 line_to_hash(\%tmp,\@delivered_fields,$data);
3260 add_to_totals($report_totals{Delivered},['Addresses'],$tmp{Messages});
3261 }
3262 }
3263 elsif (/(Temp Rejects|Rejects|Ham|Spam)\s+(.*?)\s*$/) {
3264 print STDERR "Parsing $_" if $debug;
3265 add_to_totals($report_totals{$1},['Messages','Hosts'],$2);
3266 }
3267 else {
3268 last if $doing_table;
3269 }
3270 }
3271 }
3272
3273 elsif (/User Specified Patterns/i) {
3274 #User Specified Patterns
3275 #-----------------------
3276 # Total
3277 # Description 85
3278
3279 while (<$fh>) { last if (/Total/); } #Wait until we get the table headers.
3280 while (<$fh>) {
3281 print STDERR "Parsing $_" if $debug;
3282 $_ = html2txt($_); #Convert general HTML markup to text.
3283 if (/^\s*(.*?)\s+(\d+)\s*$/) {
3284 $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
3285 add_to_totals($report_totals{patterns}{$1},['Total'],$2);
3286 }
3287 last if (/^\s*$/); #Finished if we have a blank line.
3288 }
3289 }
3290
3291 elsif (/(^|<h2>)($user_pattern_keys) per /o) {
3292 # Parse User defined pattern histograms if they exist.
3293 parse_histogram($fh, $user_pattern_interval_count[$user_pattern_index{$2}] );
3294 }
3295
3296
3297 elsif (/Deliveries by transport/i) {
3298 #Deliveries by transport
3299 #-----------------------
3300 # Volume Messages
3301 # :blackhole: 70KB 51
3302 # address_pipe 655KB 1
3303 # smtp 11MB 151
3304
3305 while (<$fh>) { last if (/Volume/); } #Wait until we get the table headers.
3306 while (<$fh>) {
3307 print STDERR "Parsing $_" if $debug;
3308 $_ = html2txt($_); #Convert general HTML markup to text.
3309 if (/(\S+)\s+(\d+\S*\s+\d+)/) {
3310 $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
3311 add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
3312 }
3313 last if (/^\s*$/); #Finished if we have a blank line.
3314 }
3315 }
3316 elsif (/Messages received per/) {
3317 parse_histogram($fh, \@received_interval_count);
3318 }
3319 elsif (/Deliveries per/) {
3320 parse_histogram($fh, \@delivered_interval_count);
3321 }
3322
3323 #elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
3324 elsif (/(Time spent on the queue|Delivery times|Receipt times): ((\S+) messages|messages with at least one remote delivery)((<[^>]*>)*\s*)$/) {
3325 #Time spent on the queue: all messages
3326 #-------------------------------------
3327 #
3328 #Under 1m 217 91.9% 91.9%
3329 # 5m 2 0.8% 92.8%
3330 # 3h 8 3.4% 96.2%
3331 # 6h 7 3.0% 99.2%
3332 # 12h 2 0.8% 100.0%
3333
3334 # Set a pointer to the queue bin so we can use the same code
3335 # block for both all messages and remote deliveries.
3336 #my $bin_aref = ($1 eq 'all messages') ? \@qt_all_bin : \@qt_remote_bin;
3337 my($bin_aref, $times_aref, $overflow_sref);
3338 if ($1 eq 'Time spent on the queue') {
3339 $times_aref = \@queue_times;
3340 if ($2 eq 'all messages') {
3341 $bin_aref = \@qt_all_bin;
3342 $overflow_sref = \$qt_all_overflow;
3343 }
3344 else {
3345 $bin_aref = \@qt_remote_bin;
3346 $overflow_sref = \$qt_remote_overflow;
3347 }
3348 }
3349 elsif ($1 eq 'Delivery times') {
3350 $times_aref = \@delivery_times;
3351 if ($2 eq 'all messages') {
3352 $bin_aref = \@dt_all_bin;
3353 $overflow_sref = \$dt_all_overflow;
3354 }
3355 else {
3356 $bin_aref = \@dt_remote_bin;
3357 $overflow_sref = \$dt_remote_overflow;
3358 }
3359 }
3360 else {
3361 unless (exists $rcpt_times_bin{$3}) {
3362 initialise_rcpt_times($3);
3363 }
3364 $bin_aref = $rcpt_times_bin{$3};
3365 $times_aref = \@rcpt_times;
3366 $overflow_sref = \$rcpt_times_overflow{$3};
3367 }
3368
3369
3370 my ($blank_lines, $reached_table) = (0,0);
3371 while (<$fh>) {
3372 $_ = html2txt($_); #Convert general HTML markup to text.
3373 # The table is preceded by one blank line, and has one blank line
3374 # following it. As the table may be empty, the best way to determine
3375 # that we've finished it is to look for the second blank line.
3376 ++$blank_lines if /^\s*$/;
3377 last if ($blank_lines >=2); #Finished the table ?
3378 $reached_table = 1 if (/\d/);
3379 next unless $reached_table;
3380 my $previous_seconds_on_queue = 0;
3381 if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
3382 print STDERR "Parsing $_" if $debug;
3383 my($modifier,$formatted_time,$count) = ($1,$2,$3);
3384 my $seconds = unformat_time($formatted_time);
3385 my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
3386 $previous_seconds_on_queue = $seconds;
3387 $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
3388 my($i);
3389 for ($i = 0; $i <= $#$times_aref; $i++) {
3390 if ($time_on_queue < $times_aref->[$i]) {
3391 $$bin_aref[$i] += $count;
3392 last;
3393 }
3394 }
3395 $$overflow_sref += $count if ($i > $#$times_aref);
3396
3397 }
3398 }
3399 }
3400
3401 elsif (/Relayed messages/) {
3402 #Relayed messages
3403 #----------------
3404 #
3405 # 1 addr.domain.com [1.2.3.4] a.user@domain.com
3406 # => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
3407 #
3408 #<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>
3409
3410 my $reached_table = 0;
3411 my($count,$sender);
3412 while (<$fh>) {
3413 unless ($reached_table) {
3414 last if (/No relayed messages/);
3415 $reached_table = 1 if (/^\s*\d/ || />\d+</);
3416 next unless $reached_table;
3417 }
3418 if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
3419 update_relayed($1,$2,$3);
3420 }
3421 elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
3422 ($count,$sender) = ($1,$2);
3423 }
3424 elsif (/=>\s+(.*?)\s*$/) {
3425 update_relayed($count,$sender,$1);
3426 }
3427 else {
3428 last; #Finished the table ?
3429 }
3430 }
3431 }
3432
3433 elsif (/Top (.*?) by (message count|volume)/) {
3434 #Top 50 sending hosts by message count
3435 #-------------------------------------
3436 #
3437 # 48 1468KB local
3438 # Could also have average values for HTML output.
3439 # 48 1468KB 30KB local
3440
3441 my($category,$by_count_or_volume) = ($1,$2);
3442
3443 #As we show 2 views of each table (by count and by volume),
3444 #most (but not all) entries will appear in both tables.
3445 #Set up a hash to record which entries we have already seen
3446 #and one to record which ones we are seeing for the first time.
3447 if ($by_count_or_volume =~ /count/) {
3448 undef %league_table_value_entered;
3449 undef %league_table_value_was_zero;
3450 undef %table_order;
3451 }
3452
3453 #As this section processes multiple different table categories,
3454 #set up pointers to the hashes to be updated.
3455 my($messages_href,$addresses_href,$data_href,$data_gigs_href);
3456 if ($category =~ /local sender/) {
3457 $messages_href = \%received_count_user;
3458 $addresses_href = undef;
3459 $data_href = \%received_data_user;
3460 $data_gigs_href = \%received_data_gigs_user;
3461 }
3462 elsif ($category =~ /sending (\S+?)s?\b/) {
3463 #Top 50 sending (host|domain|email|edomain)s
3464 #Top sending (host|domain|email|edomain)
3465 $messages_href = \%{$received_count{"\u$1"}};
3466 $data_href = \%{$received_data{"\u$1"}};
3467 $data_gigs_href = \%{$received_data_gigs{"\u$1"}};
3468 }
3469 elsif ($category =~ /local destination/) {
3470 $messages_href = \%delivered_messages_user;
3471 $addresses_href = \%delivered_addresses_user;
3472 $data_href = \%delivered_data_user;
3473 $data_gigs_href = \%delivered_data_gigs_user;
3474 }
3475 elsif ($category =~ /local domain destination/) {
3476 $messages_href = \%delivered_messages_local_domain;
3477 $addresses_href = \%delivered_addresses_local_domain;
3478 $data_href = \%delivered_data_local_domain;
3479 $data_gigs_href = \%delivered_data_gigs_local_domain;
3480 }
3481 elsif ($category =~ /(\S+) destination/) {
3482 #Top 50 (host|domain|email|edomain) destinations
3483 #Top (host|domain|email|edomain) destination
3484 $messages_href = \%{$delivered_messages{"\u$1"}};
3485 $addresses_href = \%{$delivered_addresses{"\u$1"}};
3486 $data_href = \%{$delivered_data{"\u$1"}};
3487 $data_gigs_href = \%{$delivered_data_gigs{"\u$1"}};
3488 }
3489 elsif ($category =~ /temporarily rejected ips/) {
3490 $messages_href = \%temporarily_rejected_count_by_ip;
3491 }
3492 elsif ($category =~ /rejected ips/) {
3493 $messages_href = \%rejected_count_by_ip;
3494 }
3495 elsif ($category =~ /non-rejected spamming ips/) {
3496 $messages_href = \%spam_count_by_ip;
3497 }
3498 elsif ($category =~ /mail temporary rejection reasons/) {
3499 $messages_href = \%temporarily_rejected_count_by_reason;
3500 }
3501 elsif ($category =~ /mail rejection reasons/) {
3502 $messages_href = \%rejected_count_by_reason;
3503 }
3504
3505 my $reached_table = 0;
3506 my $row_re;
3507 while (<$fh>) {
3508 # Watch out for empty tables.
3509 goto PARSE_OLD_REPORT_LINE if (/<h2>/ or (/^\s*[a-zA-Z]/ && !/^\s*Messages/));
3510
3511 $_ = html2txt($_); #Convert general HTML markup to text.
3512
3513 # Messages Addresses Bytes Average
3514 if (/^\s*Messages/) {
3515 my $pattern = '^\s*(\d+)';
3516 $pattern .= (/Addresses/) ? '\s+(\d+)' : '()';
3517 $pattern .= (/Bytes/) ? '\s+([\dKMGB]+)' : '()';
3518 $pattern .= (/Average/) ? '\s+[\dKMGB]+' : '';
3519 $pattern .= '\s+(.*?)\s*$';
3520 $row_re = qr/$pattern/;
3521 $reached_table = 1;
3522 next;
3523 }
3524 next unless $reached_table;
3525
3526 my($messages, $addresses, $rounded_volume, $entry);
3527
3528 if (/$row_re/) {
3529 ($messages, $addresses, $rounded_volume, $entry) = ($1, $2, $3, $4);
3530 }
3531 else {
3532 #Else we have finished the table and we may need to do some
3533 #kludging to retain the order of the entries.
3534
3535 if ($by_count_or_volume =~ /volume/) {
3536 #Add a few bytes to appropriate entries to preserve the order.
3537 foreach $rounded_volume (keys %table_order) {
3538 #For each rounded volume, we want to create a list which has things
3539 #ordered from the volume table at the front, and additional things
3540 #from the count table ordered at the back.
3541 @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
3542 @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
3543 my(@order,%mark);
3544 map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
3545 @order = @{$table_order{$rounded_volume}{volume}};
3546 map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
3547
3548 my $bonus_bytes = $#order;
3549 $bonus_bytes = 511 if ($bonus_bytes > 511); #Don't go over the half-K boundary!
3550 while (@order and ($bonus_bytes > 0)) {
3551 my $entry = shift(@order);
3552 if ($league_table_value_was_zero{$entry}) {
3553 $$data_href{$entry} += $bonus_bytes;
3554 print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
3555 }
3556 $bonus_bytes--;
3557 }
3558 }
3559 }
3560 last;
3561 }
3562
3563 # Store a new table entry.
3564
3565 # Add the entry into the %table_order hash if it has a rounded
3566 # volume (KB/MB/GB).
3567 push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
3568
3569 unless ($league_table_value_entered{$entry}) {
3570 $league_table_value_entered{$entry} = 1;
3571 unless ($$messages_href{$entry}) {
3572 $$messages_href{$entry} = 0;
3573 $$addresses_href{$entry} = 0;
3574 $$data_href{$entry} = 0;
3575 $$data_gigs_href{$entry} = 0;
3576 $league_table_value_was_zero{$entry} = 1;
3577 }
3578
3579 $$messages_href{$entry} += $messages;
3580
3581 # When adding the addresses, be aware that we could be merging
3582 # an old report which does not include addresses. In this case,
3583 # we add the messages instead.
3584 $$addresses_href{$entry} += ($addresses) ? $addresses : $messages;
3585
3586 #Add the rounded value to the data and data_gigs hashes.
3587 un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry}) if $rounded_volume;
3588 print STDERR "$category by $by_count_or_volume: added $messages,$rounded_volume to $entry\n" if $debug;
3589 }
3590
3591 }
3592 }
3593 elsif (/List of errors/) {
3594 #List of errors
3595 #--------------
3596 #
3597 # 1 07904931641@one2one.net R=external T=smtp: SMTP error
3598 # from remote mailer after RCPT TO:<07904931641@one2one.net>:
3599 # host mail.one2one.net [193.133.192.24]: 550 User unknown
3600 #
3601 #<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>
3602
3603
3604 my $reached_table = 0;
3605 my($count,$error,$blanks);
3606 while (<$fh>) {
3607 $reached_table = 1 if (/^( *|<li>)(\d+)/);
3608 next unless $reached_table;
3609
3610 s/^<li>(\d+) -/$1/; #Convert an HTML line to a text line.
3611 $_ = html2txt($_); #Convert general HTML markup to text.
3612
3613 if (/\t\s*(.*)/) {
3614 $error .= ' ' . $1; #Join a multiline error.
3615 }
3616 elsif (/^\s*(\d+)\s+(.*)/) {
3617 if ($error) {
3618 #Finished with a previous multiline error so save it.
3619 $errors_count{$error} = 0 unless $errors_count{$error};
3620 $errors_count{$error} += $count;
3621 }
3622 ($count,$error) = ($1,$2);
3623 }
3624 elsif (/Errors encountered/) {
3625 if ($error) {
3626 #Finished the section, so save our stored last error.
3627 $errors_count{$error} = 0 unless $errors_count{$error};
3628 $errors_count{$error} += $count;
3629 }
3630 last;
3631 }
3632 }
3633 }
3634
3635 }
3636 }
3637
3638 #######################################################################
3639 # parse_histogram($fh, \@delivered_interval_count);
3640 # Parse a histogram into the provided array of counters.
3641 #######################################################################
3642 sub parse_histogram {
3643 my($fh, $counters_aref) = @_;
3644
3645 # Messages received per hour (each dot is 2 messages)
3646 #---------------------------------------------------
3647 #
3648 #00-01 106 .....................................................
3649 #01-02 103 ...................................................
3650
3651 my $reached_table = 0;
3652 while (<$fh>) {
3653 $reached_table = 1 if (/^00/);
3654 next unless $reached_table;
3655 print STDERR "Parsing $_" if $debug;
3656 if (/^(\d+):(\d+)\s+(\d+)/) { #hh:mm start time format ?
3657 $$counters_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
3658 }
3659 elsif (/^(\d+)-(\d+)\s+(\d+)/) { #hh-hh start-end time format ?
3660 $$counters_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
3661 }
3662 else { #Finished the table ?
3663 last;
3664 }
3665 }
3666 }
3667
3668
3669 #######################################################################
3670 # update_relayed();
3671 #
3672 # update_relayed($count,$sender,$recipient);
3673 #
3674 # Adds an entry into the %relayed hash. Currently only used when
3675 # merging reports.
3676 #######################################################################
3677 sub update_relayed {
3678 my($count,$sender,$recipient) = @_;
3679
3680 #When generating the key, put in the 'H=' and 'A=' which can be used
3681 #in searches.
3682 my $key = "H=$sender => H=$recipient";
3683 $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
3684 if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
3685 $relayed{$key} = 0 if !defined $relayed{$key};
3686 $relayed{$key} += $count;
3687 }
3688 else {
3689 $relayed_unshown += $count;
3690 }
3691 }
3692
3693
3694 #######################################################################
3695 # add_to_totals();
3696 #
3697 # add_to_totals(\%totals,\@keys,$values);
3698 #
3699 # Given a line of space separated values, add them into the provided hash using @keys
3700 # as the hash keys.
3701 #
3702 # If the value contains a '%', then the value is set rather than added. Otherwise, we
3703 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
3704 #######################################################################
3705 sub add_to_totals {
3706 my($totals_href,$keys_aref,$values) = @_;
3707 my(@values) = split(/\s+/,$values);
3708
3709 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3710 my $key = $keys_aref->[$i];
3711 if ($values[$i] =~ /%/) {
3712 $$totals_href{$key} = $values[$i];
3713 }
3714 else {
3715 $$totals_href{$key} = 0 unless ($$totals_href{$key});
3716 $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
3717 un_round($values[$i], \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
3718 print STDERR "Added $values[$i] to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
3719 }
3720 }
3721 }
3722
3723
3724 #######################################################################
3725 # line_to_hash();
3726 #
3727 # line_to_hash(\%hash,\@keys,$line);
3728 #
3729 # Given a line of space separated values, set them into the provided hash
3730 # using @keys as the hash keys.
3731 #######################################################################
3732 sub line_to_hash {
3733 my($href,$keys_aref,$values) = @_;
3734 my(@values) = split(/\s+/,$values);
3735 for(my $i = 0; $i < @values && $i < @$keys_aref; ++$i) {
3736 $$href{$keys_aref->[$i]} = $values[$i];
3737 }
3738 }
3739
3740
3741 #######################################################################
3742 # get_report_total();
3743 #
3744 # $total = get_report_total(\%hash,$key);
3745 #
3746 # If %hash contains values split into Units and Gigs, we calculate and return
3747 #
3748 # $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
3749 #######################################################################
3750 sub get_report_total {
3751 no integer;
3752 my($hash_ref,$key) = @_;
3753 if ($$hash_ref{"${key}-gigs"}) {
3754 return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
3755 }
3756 return $$hash_ref{$key} || 0;
3757 }
3758
3759 #######################################################################
3760 # html2txt();
3761 #
3762 # $text_line = html2txt($html_line);
3763 #
3764 # Convert a line from html to text. Currently we just convert HTML tags to spaces
3765 # and convert &gt;, &lt;, and &nbsp; tags back.
3766 #######################################################################
3767 sub html2txt {
3768 ($_) = @_;
3769
3770 # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
3771 # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
3772 # (the ones used by this program). If someone is careless enough to have their
3773 # Userid the same as an HTML tag, there's not much we can do about it.
3774 s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /g;
3775
3776 s/\&lt\;/\</og; #Convert '&lt;' to '<'.
3777 s/\&gt\;/\>/og; #Convert '&gt;' to '>'.
3778 s/\&nbsp\;/ /og; #Convert '&nbsp;' to ' '.
3779 return($_);
3780 }
3781
3782 #######################################################################
3783 # get_next_arg();
3784 #
3785 # $arg = get_next_arg();
3786 #
3787 # Because eximstats arguments are often passed as variables,
3788 # we can't rely on shell parsing to deal with quotes. This
3789 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
3790 # starts with a quote (' or "), and doesn't end in one, then
3791 # we append the next argument to it and shift again. We repeat
3792 # until we've got all of the argument.
3793 #
3794 # This isn't perfect as all white space gets reduced to one space,
3795 # but it's as good as we can get! If it's essential that spacing
3796 # be preserved precisely, then you get that by not using shell
3797 # variables.
3798 #######################################################################
3799 sub get_next_arg {
3800 my $arg = '';
3801 my $matched_pattern = 0;
3802 while ($ARGV[1]) {
3803 $arg .= ' ' if $arg;
3804 $arg .= $ARGV[1]; shift(@ARGV);
3805 if ($arg !~ /^['"]/) {
3806 $matched_pattern = 1;
3807 last;
3808 }
3809 if ($arg =~ s/^(['"])(.*)\1$/$2/) {
3810 $matched_pattern = 1;
3811 last;
3812 }
3813 }
3814 die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
3815 return $arg;
3816 }
3817
3818 #######################################################################
3819 # set_worksheet_line($ws_global, $startrow, $startcol, \@content, $format);
3820 #
3821 # set values to a sequence of cells in a row.
3822 #
3823 #######################################################################
3824 sub set_worksheet_line {
3825 my ($worksheet, $row, $col, $content, $format) = @_;
3826
3827 foreach my $token (@$content)
3828 {
3829 $worksheet->write($row, $col++, $token, $format );
3830 }
3831
3832 }
3833
3834 #######################################################################
3835 # @rcpt_times = parse_time_list($string);
3836 #
3837 # Parse a comma separated list of time values in seconds given by
3838 # the user and fill an array.
3839 #
3840 # Return a default list if $string is undefined.
3841 # Return () if $string eq '0'.
3842 #######################################################################
3843 sub parse_time_list {
3844 my($string) = @_;
3845 if (! defined $string) {
3846 return(60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60, 12*60*60, 24*60*60);
3847 }
3848 my(@times) = split(/,/, $string);
3849 foreach my $q (@times) { $q = eval($q) + 0 }
3850 @times = sort { $a <=> $b } @times;
3851 @times = () if ($#times == 0 && $times[0] == 0);
3852 return(@times);
3853 }
3854
3855
3856 #######################################################################
3857 # initialise_rcpt_times($protocol);
3858 # Initialise an array of rcpt_times to 0 for the specified protocol.
3859 #######################################################################
3860 sub initialise_rcpt_times {
3861 my($protocol) = @_;
3862 for (my $i = 0; $i <= $#rcpt_times; ++$i) {
3863 $rcpt_times_bin{$protocol}[$i] = 0;
3864 }
3865 $rcpt_times_overflow{$protocol} = 0;
3866 }
3867
3868
3869 ##################################################
3870 # Main Program #
3871 ##################################################
3872
3873
3874 $last_timestamp = '';
3875 $last_date = '';
3876 $show_errors = 1;
3877 $show_relay = 1;
3878 $show_transport = 1;
3879 $topcount = 50;
3880 $local_league_table = 1;
3881 $include_remote_users = 0;
3882 $include_original_destination = 0;
3883 $hist_opt = 1;
3884 $volume_rounding = 1;
3885 $localtime_offset = calculate_localtime_offset(); # PH/FANF
3886
3887 $charts = 0;
3888 $charts_option_specified = 0;
3889 $chartrel = ".";
3890 $chartdir = ".";
3891
3892 @queue_times = parse_time_list();
3893 @rcpt_times = ();
3894 @delivery_times = ();
3895
3896 $last_offset = '';
3897 $offset_seconds = 0;
3898
3899 $row=1;
3900 $col=0;
3901 $col_hist=0;
3902 $run_hist=0;
3903 my(%output_files); # What output files have been specified?
3904
3905 # Decode options
3906
3907 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-') {
3908 if ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
3909 elsif ($ARGV[0] =~ /^\-ne$/) { $show_errors = 0 }
3910 elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/) {
3911 if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
3912 }
3913 elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/) { @queue_times = parse_time_list($1) }
3914 elsif ($ARGV[0] =~ /^-nt$/) { $show_transport = 0 }
3915 elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
3916 {
3917 if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
3918 }
3919 elsif ($ARGV[0] =~ /^-t(\d+)$/) { $topcount = $1 }
3920 elsif ($ARGV[0] =~ /^-tnl$/) { $local_league_table = 0 }
3921 elsif ($ARGV[0] =~ /^-txt=?(\S*)$/) { $txt_fh = get_filehandle($1,\%output_files) }
3922 elsif ($ARGV[0] =~ /^-html=?(\S*)$/) { $htm_fh = get_filehandle($1,\%output_files) }
3923 elsif ($ARGV[0] =~ /^-xls=?(\S*)$/) {
3924 if ($HAVE_Spreadsheet_WriteExcel) {
3925 $xls_fh = get_filehandle($1,\%output_files);
3926 }
3927 else {
3928 warn "WARNING: CPAN Module Spreadsheet::WriteExcel not installed. Obtain from www.cpan.org\n";
3929 }
3930 }
3931 elsif ($ARGV[0] =~ /^-merge$/) { $merge_reports = 1 }
3932 elsif ($ARGV[0] =~ /^-charts$/) {
3933 $charts = 1;
3934 warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
3935 warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
3936 }
3937 elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
3938 elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
3939 elsif ($ARGV[0] =~ /^-include_original_destination$/) { $include_original_destination = 1 }
3940 elsif ($ARGV[0] =~ /^-cache$/) { } #Not currently used.
3941 elsif ($ARGV[0] =~ /^-byhost$/) { $do_sender{Host} = 1 }
3942 elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
3943 elsif ($ARGV[0] =~ /^-byemail$/) { $do_sender{Email} = 1 }
3944 elsif ($ARGV[0] =~ /^-byemaildomain$/) { $do_sender{Edomain} = 1 }
3945 elsif ($ARGV[0] =~ /^-byedomain$/) { $do_sender{Edomain} = 1 }
3946 elsif ($ARGV[0] =~ /^-bylocaldomain$/) { $do_local_domain = 1 }
3947 elsif ($ARGV[0] =~ /^-emptyok$/) { $emptyOK = 1 }
3948 elsif ($ARGV[0] =~ /^-nvr$/) { $volume_rounding = 0 }
3949 elsif ($ARGV[0] =~ /^-show_rt([,\d\+\-\*\/]+)?$/) { @rcpt_times = parse_time_list($1) }
3950 elsif ($ARGV[0] =~ /^-show_dt([,\d\+\-\*\/]+)?$/) { @delivery_times = parse_time_list($1) }
3951 elsif ($ARGV[0] =~ /^-d$/) { $debug = 1 }
3952 elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
3953 elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
3954 elsif ($ARGV[0] =~ /^-pattern$/)
3955 {
3956 push(@user_descriptions,get_next_arg());
3957 push(@user_patterns,get_next_arg());
3958 }
3959 elsif ($ARGV[0] =~ /^-utc$/)
3960 {
3961 # We don't need this value if the log is in UTC.
3962 $localtime_offset = undef;
3963 }
3964 else
3965 {
3966 print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
3967 help();
3968 }
3969 shift;
3970 }
3971
3972 # keep old default behaviour
3973 if (! ($xls_fh or $htm_fh or $txt_fh)) {
3974 $txt_fh = \*STDOUT;
3975 }
3976
3977 # Check that all the charts options are specified.
3978 warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
3979
3980 # Default to display tables by sending Host.
3981 $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
3982
3983 # prepare xls Excel Workbook
3984 if (defined $xls_fh) {
3985
3986 # Create a new Excel workbook
3987 $workbook = Spreadsheet::WriteExcel->new($xls_fh);
3988
3989 # Add worksheets
3990 $ws_global = $workbook->addworksheet('Exim Statistik');
3991 # show $ws_global as initial sheet
3992 $ws_global->set_first_sheet();
3993 $ws_global->activate();
3994
3995 if ($show_relay) {
3996 $ws_relayed = $workbook->addworksheet('Relayed Messages');
3997 $ws_relayed->set_column(1, 2, 80);
3998 }
3999 if ($show_errors) {
4000 $ws_errors = $workbook->addworksheet('Errors');
4001 }
4002
4003
4004 # set column widths
4005 $ws_global->set_column(0, 2, 20); # Columns B-D width set to 30
4006 $ws_global->set_column(3, 3, 15); # Columns B-D width set to 30
4007 $ws_global->set_column(4, 4, 25); # Columns B-D width set to 30
4008
4009 # Define Formats
4010 $f_default = $workbook->add_format();
4011
4012 $f_header1 = $workbook->add_format();
4013 $f_header1->set_bold();
4014 #$f_header1->set_color('red');
4015 $f_header1->set_size('15');
4016 $f_header1->set_valign();
4017 # $f_header1->set_align('center');
4018 # $ws_global->write($row++, 2, "Testing Headers 1", $f_header1);
4019
4020 $f_header2 = $workbook->add_format();
4021 $f_header2->set_bold();
4022 $f_header2->set_size('12');
4023 $f_header2->set_valign();
4024 # $ws_global->write($row++, 2, "Testing Headers 2", $f_header2);
4025
4026 # Create another header2 for use in merged cells.
4027 $f_header2_m = $workbook->add_format();
4028 $f_header2_m->set_bold();
4029 $f_header2_m->set_size('8');
4030 $f_header2_m->set_valign();
4031 $f_header2_m->set_align('center');
4032
4033 $f_percent = $workbook->add_format();
4034 $f_percent->set_num_format('0.0%');
4035
4036 $f_headertab = $workbook->add_format();
4037 $f_headertab->set_bold();
4038 $f_headertab->set_valign();
4039 # $ws_global->write($row++, 2, "Testing Headers tab", $f_headertab);
4040
4041 }
4042
4043
4044 # Initialise the queue/delivery/rcpt time counters.
4045 for (my $i = 0; $i <= $#queue_times; $i++) {
4046 $qt_all_bin[$i] = 0;
4047 $qt_remote_bin[$i] = 0;
4048 }
4049 for (my $i = 0; $i <= $#delivery_times; $i++) {
4050 $dt_all_bin[$i] = 0;
4051 $dt_remote_bin[$i] = 0;
4052 }
4053 initialise_rcpt_times('all');
4054
4055
4056 # Compute the number of slots for the histogram
4057 if ($hist_opt > 0)
4058 {
4059 if ($hist_opt > 60 || 60 % $hist_opt != 0)
4060 {
4061 print STDERR "Eximstats: -h must specify a factor of 60\n";
4062 exit 1;
4063 }
4064 $hist_interval = 60/$hist_opt; #Interval in minutes.
4065 $hist_number = (24*60)/$hist_interval; #Number of intervals per day.
4066 @received_interval_count = (0) x $hist_number;
4067 @delivered_interval_count = (0) x $hist_number;
4068 my $user_pattern_index = 0;
4069 for (my $user_pattern_index = 0; $user_pattern_index <= $#user_patterns; ++$user_pattern_index) {
4070 @{$user_pattern_interval_count[$user_pattern_index]} = (0) x $hist_number;
4071 }
4072 @dt_all_bin = (0) x $hist_number;
4073 @dt_remote_bin = (0) x $hist_number;
4074 }
4075
4076 #$queue_unknown = 0;
4077
4078 $total_received_data = 0;
4079 $total_received_data_gigs = 0;
4080 $total_received_count = 0;
4081
4082 $total_delivered_data = 0;
4083 $total_delivered_data_gigs = 0;
4084 $total_delivered_messages = 0;
4085 $total_delivered_addresses = 0;
4086
4087 $qt_all_overflow = 0;
4088 $qt_remote_overflow = 0;
4089 $dt_all_overflow = 0;
4090 $dt_remote_overflow = 0;
4091 $delayed_count = 0;
4092 $relayed_unshown = 0;
4093 $message_errors = 0;
4094 $begin = "9999-99-99 99:99:99";
4095 $end = "0000-00-00 00:00:00";
4096 my($section,$type);
4097 foreach $section ('Received','Delivered','Temp Rejects', 'Rejects','Ham','Spam') {
4098 foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
4099 $report_totals{$section}{$type} = 0;
4100 }
4101 }
4102
4103 # Generate our parser.
4104 my $parser = generate_parser();
4105
4106
4107
4108 if (@ARGV) {
4109 # Scan the input files and collect the data
4110 foreach my $file (@ARGV) {
4111 if ($file =~ /\.gz/) {
4112 unless (open(FILE,"gunzip -c $file |")) {
4113 print STDERR "Failed to gunzip -c $file: $!";
4114 next;
4115 }
4116 }
4117 elsif ($file =~ /\.Z/) {
4118 unless (open(FILE,"uncompress -c $file |")) {
4119 print STDERR "Failed to uncompress -c $file: $!";
4120 next;
4121 }
4122 }
4123 else {
4124 unless (open(FILE,$file)) {
4125 print STDERR "Failed to read $file: $!";
4126 next;
4127 }
4128 }
4129 #Now parse the filehandle, updating the global variables.
4130 parse($parser,\*FILE);
4131 close FILE;
4132 }
4133 }
4134 else {
4135 #No files provided. Parse STDIN, updating the global variables.
4136 parse($parser,\*STDIN);
4137 }
4138
4139
4140 if ($begin eq "9999-99-99 99:99:99" && ! $emptyOK) {
4141 print STDERR "**** No valid log lines read\n";
4142 exit 1;
4143 }
4144
4145 # Output our results.
4146 print_header();
4147 print_grandtotals();
4148
4149 # Print counts of user specified patterns if required.
4150 print_user_patterns() if @user_patterns;
4151
4152 # Print rejection reasons.
4153 # print_rejects();
4154
4155 # Print totals by transport if required.
4156 print_transport() if $show_transport;
4157
4158 # Print the deliveries per interval as a histogram, unless configured not to.
4159 # First find the maximum in one interval and scale accordingly.
4160 if ($hist_opt > 0) {
4161 print_histogram("Messages received", 'message', @received_interval_count);
4162 print_histogram("Deliveries", 'delivery', @delivered_interval_count);
4163 }
4164
4165 # Print times on queue if required.
4166 if ($#queue_times >= 0) {
4167 print_duration_table("Time spent on the queue", "all messages", \@queue_times, \@qt_all_bin,$qt_all_overflow);
4168 print_duration_table("Time spent on the queue", "messages with at least one remote delivery", \@queue_times, \@qt_remote_bin,$qt_remote_overflow);
4169 }
4170
4171 # Print delivery times if required.
4172 if ($#delivery_times >= 0) {
4173 print_duration_table("Delivery times", "all messages", \@delivery_times, \@dt_all_bin,$dt_all_overflow);
4174 print_duration_table("Delivery times", "messages with at least one remote delivery", \@delivery_times, \@dt_remote_bin,$dt_remote_overflow);
4175 }
4176
4177 # Print rcpt times if required.
4178 if ($#rcpt_times >= 0) {
4179 foreach my $protocol ('all', grep(!/^all$/, sort keys %rcpt_times_bin)) {
4180 print_duration_table("Receipt times", "$protocol messages", \@rcpt_times, $rcpt_times_bin{$protocol}, $rcpt_times_overflow{$protocol});
4181 }
4182 }
4183
4184 # Print relay information if required.
4185 print_relay() if $show_relay;
4186
4187 # Print the league tables, if topcount isn't zero.
4188 if ($topcount > 0) {
4189 my($ws_rej, $ws_top50, $ws_rej_row, $ws_top50_row, $ws_temp_rej, $ws_temp_rej_row);
4190 $ws_rej_row = $ws_temp_rej_row = $ws_top50_row = 0;
4191 if ($xls_fh) {
4192 $ws_top50 = $workbook->addworksheet('Deliveries');
4193 $ws_rej = $workbook->addworksheet('Rejections') if (%rejected_count_by_reason || %rejected_count_by_ip || %spam_count_by_ip);
4194 $ws_temp_rej = $workbook->addworksheet('Temporary Rejections') if (%temporarily_rejected_count_by_reason || %temporarily_rejected_count_by_ip);
4195 }
4196
4197 print_league_table("mail rejection reason", \%rejected_count_by_reason, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_reason;
4198 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;
4199
4200 foreach ('Host','Domain','Email','Edomain') {
4201 next unless $do_sender{$_};
4202 print_league_table("sending \l$_", $received_count{$_}, undef, $received_data{$_},$received_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4203 }
4204
4205 print_league_table("local sender", \%received_count_user, undef,
4206 \%received_data_user,\%received_data_gigs_user, $ws_top50, \$ws_top50_row) if (($local_league_table || $include_remote_users) && %received_count_user);
4207 foreach ('Host','Domain','Email','Edomain') {
4208 next unless $do_sender{$_};
4209 print_league_table("\l$_ destination", $delivered_messages{$_}, $delivered_addresses{$_}, $delivered_data{$_},$delivered_data_gigs{$_}, $ws_top50, \$ws_top50_row);
4210 }
4211 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);
4212 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);
4213
4214 print_league_table("rejected ip", \%rejected_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %rejected_count_by_ip;
4215 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;
4216 print_league_table("non-rejected spamming ip", \%spam_count_by_ip, undef, undef, undef, $ws_rej, \$ws_rej_row) if %spam_count_by_ip;
4217
4218 }
4219
4220 # Print the error statistics if required.
4221 print_errors() if $show_errors;
4222
4223 print $htm_fh "</body>\n</html>\n" if $htm_fh;
4224
4225
4226 $txt_fh->close if $txt_fh && ref $txt_fh;
4227 $htm_fh->close if $htm_fh;
4228
4229 if ($xls_fh) {
4230 # close Excel Workbook
4231 $ws_global->set_first_sheet();
4232 # FIXME: whyever - activate does not work :-/
4233 $ws_global->activate();
4234 $workbook->close();
4235 }
4236
4237
4238 # End of eximstats