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