src/src/eximstats.src

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