src/src/eximstats.src

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