src/src/eximstats.src

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