src/src/eximstats.src

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