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