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