src/src/eximstats.src

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