src/src/eximstats.src

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