src/src/eximstats.src

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