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