src/src/eximstats.src

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