src/src/eximstats.src

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