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