src/src/eximstats.src

   1 #!PERL_COMMAND -w
   2 # $Cambridge: exim/src/src/eximstats.src,v 1.5 2005/02/16 15:49:36 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
 201 =head1 NAME
 202
 203 eximstats - generates statistics from Exim mainlog or syslog files.
 204
 205 =head1 SYNOPSIS
 206
 207  eximstats [Options] mainlog1 mainlog2 ... > report.txt
 208  eximstats -html [Options] mainlog1 mainlog2 ... > report.html
 209  eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_report.txt
 210
 211 Options:
 212
 213 =over 4
 214
 215 =item B<-h>I<number>
 216
 217 histogram divisions per hour. The default is 1, and
 218 0 suppresses histograms. Valid values are:
 219
 220 0, 1, 2, 3, 5, 10, 15, 20, 30 or 60.
 221
 222 =item B<-ne>
 223
 224 Don't display error information.
 225
 226 =item B<-nr>
 227
 228 Don't display relaying information.
 229
 230 =item B<-nr>I</pattern/>
 231
 232 Don't display relaying information that matches.
 233
 234 =item B<-nt>
 235
 236 Don't display transport information.
 237
 238 =item B<-nt>I</pattern/>
 239
 240 Don't display transport information that matches
 241
 242 =item B<-q>I<list>
 243
 244 List of times for queuing information single 0 item suppresses.
 245
 246 =item B<-t>I<number>
 247
 248 Display top <number> sources/destinations
 249 default is 50, 0 suppresses top listing.
 250
 251 =item B<-tnl>
 252
 253 Omit local sources/destinations in top listing.
 254
 255 =item B<-t_remote_users>
 256
 257 Include remote users in the top source/destination listings.
 258
 259 =item B<-byhost>
 260
 261 Show results by sending host. This may be combined with
 262 B<-bydomain> and/or B<-byemail> and/or B<-byedomain>. If none of these options
 263 are specified, then B<-byhost> is assumed as a default.
 264
 265 =item B<-bydomain>
 266
 267 Show results by sending domain.
 268 May be combined with B<-byhost> and/or B<-byemail> and/or B<-byedomain>.
 269
 270 =item B<-byemail>
 271
 272 Show results by sender's email address.
 273 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byedomain>.
 274
 275 =item B<-byemaildomain> or B<-byedomain>
 276
 277 Show results by sender's email domain.
 278 May be combined with B<-byhost> and/or B<-bydomain> and/or B<-byemail>.
 279
 280 =item B<-pattern> I<Description> I</Pattern/>
 281
 282 Look for the specified pattern and count the number of lines in which it appears.
 283 This option can be specified multiple times. Eg:
 284
 285  -pattern 'Refused connections' '/refused connection/'
 286
 287
 288 =item B<-merge>
 289
 290 This option allows eximstats to merge old eximstat reports together. Eg:
 291
 292  eximstats mainlog.sun > report.sun.txt
 293  eximstats mainlog.mon > report.mon.txt
 294  eximstats mainlog.tue > report.tue.txt
 295  eximstats mainlog.wed > report.web.txt
 296  eximstats mainlog.thu > report.thu.txt
 297  eximstats mainlog.fri > report.fri.txt
 298  eximstats mainlog.sat > report.sat.txt
 299  eximstats -merge       report.*.txt > weekly_report.txt
 300  eximstats -merge -html report.*.txt > weekly_report.html
 301
 302 =over 4
 303
 304 =item *
 305
 306 You can merge text or html reports and output the results as text or html.
 307
 308 =item *
 309
 310 You can use all the normal eximstat output options, but only data
 311 included in the original reports can be shown!
 312
 313 =item *
 314
 315 When merging reports, some loss of accuracy may occur in the top I<n> lists.
 316 This will be towards the ends of the lists.
 317
 318 =item *
 319
 320 The order of items in the top I<n> lists may vary when the data volumes
 321 round to the same value.
 322
 323 =back
 324
 325 =item B<-html>
 326
 327 Output the results in HTML.
 328
 329 =item B<-charts>
 330
 331 Create graphical charts to be displayed in HTML output.
 332
 333 This requires the following modules which can be obtained
 334 from http://www.cpan.org/modules/01modules.index.html
 335
 336 =over 4
 337
 338 =item GD
 339
 340 =item GDTextUtil
 341
 342 =item GDGraph
 343
 344 =back
 345
 346 To install these, download and unpack them, then use the normal perl installation procedure:
 347
 348  perl Makefile.PL
 349  make
 350  make test
 351  make install
 352
 353 =item B<-chartdir>I <dir>
 354
 355 Create the charts in the directory <dir>
 356
 357 =item B<-chartrel>I <dir>
 358
 359 Specify the relative directory for the "img src=" tags from where to include
 360 the charts
 361
 362 =item B<-d>
 363
 364 Debug flag. This outputs the eval()'d parser onto STDOUT which makes it
 365 easier to trap errors in the eval section. Remember to add 1 to the line numbers to allow for the
 366 title!
 367
 368 =back
 369
 370 =head1 DESCRIPTION
 371
 372 Eximstats parses exim mainlog and syslog files to output a statistical
 373 analysis of the messages processed. By default, a text
 374 analysis is generated, but you can request an html analysis
 375 by using the B<-html> flag. See the help (B<-help>) to learn
 376 about how to create charts from the tables.
 377
 378 =head1 AUTHOR
 379
 380 There is a web site at http://www.exim.org - this contains details of the
 381 mailing list exim-users@exim.org.
 382
 383 =head1 TO DO
 384
 385 This program does not perfectly handle messages whose received
 386 and delivered log lines are in different files, which can happen
 387 when you have multiple mail servers and a message cannot be
 388 immeadiately delivered. Fixing this could be tricky...
 389
 390 =cut
 391
 392 use integer;
 393 use strict;
 394
 395 # use Time::Local;  # PH/FANF
 396 use POSIX;
 397
 398 use vars qw($HAVE_GD_Graph_pie $HAVE_GD_Graph_linespoints);
 399 eval { require GD::Graph::pie; };
 400 $HAVE_GD_Graph_pie = $@ ? 0 : 1;
 401 eval { require GD::Graph::linespoints; };
 402 $HAVE_GD_Graph_linespoints = $@ ? 0 : 1;
 403
 404
 405 ##################################################
 406 #             Static data                        #
 407 ##################################################
 408 # 'use vars' instead of 'our' as perl5.005 is still in use out there!
 409 use vars qw(@tab62 @days_per_month $gig);
 410 use vars qw($VERSION);
 411 use vars qw($COLUMN_WIDTHS);
 412
 413
 414 @tab62 =
 415   (0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0,     # 0-9
 416    0,10,11,12,13,14,15,16,17,18,19,20,  # A-K
 417   21,22,23,24,25,26,27,28,29,30,31,32,  # L-W
 418   33,34,35, 0, 0, 0, 0, 0,              # X-Z
 419    0,36,37,38,39,40,41,42,43,44,45,46,  # a-k
 420   47,48,49,50,51,52,53,54,55,56,57,58,  # l-w
 421   59,60,61);                            # x-z
 422
 423 @days_per_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
 424 $gig     = 1024 * 1024 * 1024;
 425 $VERSION = '1.36';
 426
 427 # How much space do we allow for the Hosts/Domains/Emails/Edomains column headers?
 428 $COLUMN_WIDTHS = 8;
 429
 430 # Declare global variables.
 431 use vars qw($total_received_data  $total_received_data_gigs  $total_received_count);
 432 use vars qw($total_delivered_data $total_delivered_data_gigs $total_delivered_count);
 433 use vars qw(%arrival_time %size %from_host %from_address);
 434 use vars qw(%timestamp2time);                   #Hash of timestamp => time.
 435 use vars qw($last_timestamp $last_time);        #The last time convertion done.
 436 use vars qw($last_date $date_seconds);          #The last date convertion done.
 437 use vars qw($last_offset $offset_seconds);      #The last time offset convertion done.
 438 use vars qw($localtime_offset);
 439 use vars qw($i);                                #General loop counter.
 440 use vars qw($debug);                            #Debug mode?
 441 use vars qw($ntopchart);                        #How many entries should make it into the chart?
 442 use vars qw($gddirectory);                      #Where to put files from GD::Graph
 443
 444 $ntopchart = 5;
 445
 446 # The following are parameters whose values are
 447 # set by command line switches:
 448 use vars qw($show_errors $show_relay $show_transport $transport_pattern);
 449 use vars qw($topcount $local_league_table $include_remote_users);
 450 use vars qw($hist_opt $hist_interval $hist_number $volume_rounding);
 451 use vars qw($relay_pattern @queue_times $html @user_patterns @user_descriptions);
 452
 453 use vars qw(%do_sender);                #Do sender by Host, Domain, Email, and/or Edomain tables.
 454 use vars qw($charts $chartrel $chartdir $charts_option_specified);
 455 use vars qw($merge_reports);                    #Merge old reports ?
 456
 457 # The following are modified in the parse() routine, and
 458 # referred to in the print_*() routines.
 459 use vars qw($queue_more_than $delayed_count $relayed_unshown $begin $end);
 460 use vars qw(%received_count       %received_data       %received_data_gigs);
 461 use vars qw(%delivered_count      %delivered_data      %delivered_data_gigs);
 462 use vars qw(%received_count_user  %received_data_user  %received_data_gigs_user);
 463 use vars qw(%delivered_count_user %delivered_data_user %delivered_data_gigs_user);
 464 use vars qw(%transported_count    %transported_data    %transported_data_gigs);
 465 use vars qw(%remote_delivered %relayed %delayed %had_error %errors_count);
 466 use vars qw(@queue_bin @remote_queue_bin @received_interval_count @delivered_interval_count);
 467 use vars qw(@user_pattern_totals);
 468
 469 use vars qw(%report_totals);
 470
 471
 472
 473
 474 ##################################################
 475 #                   Subroutines                  #
 476 ##################################################
 477
 478
 479 #######################################################################
 480 # volume_rounded();
 481 #
 482 # $rounded_volume = volume_rounded($bytes,$gigabytes);
 483 #
 484 # Given a data size in bytes, round it to KB, MB, or GB
 485 # as appropriate.
 486 #
 487 # Eg 12000 => 12KB, 15000000 => 14GB, etc.
 488 #
 489 # Note: I've experimented with Math::BigInt and it results in a 33%
 490 # performance degredation as opposed to storing numbers split into
 491 # bytes and gigabytes.
 492 #######################################################################
 493 sub volume_rounded {
 494   my($x,$g) = @_;
 495   $x = 0 unless $x;
 496   $g = 0 unless $g;
 497   my($rounded);
 498
 499   while ($x > $gig) {
 500     $g++;
 501     $x -= $gig;
 502   }
 503
 504   if ($volume_rounding) {
 505     # Values < 1 GB
 506     if ($g <= 0) {
 507       if ($x < 10000) {
 508         $rounded = sprintf("%6d", $x);
 509       }
 510       elsif ($x < 10000000) {
 511         $rounded = sprintf("%4dKB", ($x + 512)/1024);
 512       }
 513       else {
 514         $rounded = sprintf("%4dMB", ($x + 512*1024)/(1024*1024));
 515       }
 516     }
 517     # Values between 1GB and 10GB are printed in MB
 518     elsif ($g < 10) {
 519       $rounded = sprintf("%4dMB", ($g * 1024) + ($x + 512*1024)/(1024*1024));
 520     }
 521     else {
 522       # Handle values over 10GB
 523       $rounded = sprintf("%4dGB", $g + ($x + $gig/2)/$gig);
 524     }
 525   }
 526   else {
 527     # We don't want any rounding to be done.
 528     $rounded = sprintf("%4d", ($g * $gig) + $x);
 529   }
 530
 531   return $rounded;
 532 }
 533
 534
 535 #######################################################################
 536 # un_round();
 537 #
 538 #  un_round($rounded_volume,\$bytes,\$gigabytes);
 539 #
 540 # Given a volume in KB, MB or GB, as generated by volume_rounded(),
 541 # do the reverse transformation and convert it back into Bytes and Gigabytes.
 542 # These are added to the $bytes and $gigabytes parameters.
 543 #
 544 # Given a data size in bytes, round it to KB, MB, or GB
 545 # as appropriate.
 546 #
 547 # EG: 500 => (500,0), 14GB => (0,14), etc.
 548 #######################################################################
 549 sub un_round {
 550   my($rounded,$bytes_sref,$gigabytes_sref) = @_;
 551
 552   if ($rounded =~ /(\d+)GB/) {
 553     $$gigabytes_sref += $1;
 554   }
 555   elsif ($rounded =~ /(\d+)MB/) {
 556     $$gigabytes_sref +=   $1 / 1024;
 557     $$bytes_sref     += (($1 % 1024 ) * 1024 * 1024);
 558   }
 559   elsif ($rounded =~ /(\d+)KB/) {
 560     $$gigabytes_sref +=  $1 / (1024 * 1024);
 561     $$bytes_sref     += ($1 % (1024 * 1024) * 1024);
 562   }
 563   elsif ($rounded =~ /(\d+)/) {
 564     $$gigabytes_sref += $1 / $gig;
 565     $$bytes_sref     += $1 % $gig;
 566   }
 567
 568   #Now reduce the bytes down to less than 1GB.
 569   add_volume($bytes_sref,$gigabytes_sref,0) if ($$bytes_sref > $gig);
 570 }
 571
 572
 573 #######################################################################
 574 # add_volume();
 575 #
 576 #   add_volume(\$bytes,\$gigs,$size);
 577 #
 578 # Add $size to $bytes/$gigs where this is a number split into
 579 # bytes ($bytes) and gigabytes ($gigs). This is significantly
 580 # faster than using Math::BigInt.
 581 #######################################################################
 582 sub add_volume {
 583   my($bytes_ref,$gigs_ref,$size) = @_;
 584   $$bytes_ref = 0 if ! defined $$bytes_ref;
 585   $$gigs_ref = 0 if ! defined $$gigs_ref;
 586   $$bytes_ref += $size;
 587   while ($$bytes_ref > $gig) {
 588     $$gigs_ref++;
 589     $$bytes_ref -= $gig;
 590   }
 591 }
 592
 593
 594 #######################################################################
 595 # format_time();
 596 #
 597 #  $formatted_time = format_time($seconds);
 598 #
 599 # Given a time in seconds, break it down into
 600 # weeks, days, hours, minutes, and seconds.
 601 #
 602 # Eg 12005 => 3h20m5s
 603 #######################################################################
 604 sub format_time {
 605 my($t) = pop @_;
 606 my($s) = $t % 60;
 607 $t /= 60;
 608 my($m) = $t % 60;
 609 $t /= 60;
 610 my($h) = $t % 24;
 611 $t /= 24;
 612 my($d) = $t % 7;
 613 my($w) = $t/7;
 614 my($p) = "";
 615 $p .= "$w"."w" if $w > 0;
 616 $p .= "$d"."d" if $d > 0;
 617 $p .= "$h"."h" if $h > 0;
 618 $p .= "$m"."m" if $m > 0;
 619 $p .= "$s"."s" if $s > 0 || $p eq "";
 620 $p;
 621 }
 622
 623
 624 #######################################################################
 625 #  unformat_time();
 626 #
 627 #  $seconds = unformat_time($formatted_time);
 628 #
 629 # Given a time in weeks, days, hours, minutes, or seconds, convert it to seconds.
 630 #
 631 # Eg 3h20m5s => 12005
 632 #######################################################################
 633 sub unformat_time {
 634   my($formated_time) = pop @_;
 635   my $time = 0;
 636
 637   while ($formated_time =~ s/^(\d+)([wdhms]?)//) {
 638     $time +=  $1 if ($2 eq '' || $2 eq 's');
 639     $time +=  $1 * 60 if ($2 eq 'm');
 640     $time +=  $1 * 60 * 60 if ($2 eq 'h');
 641     $time +=  $1 * 60 * 60 * 24 if ($2 eq 'd');
 642     $time +=  $1 * 60 * 60 * 24  * 7 if ($2 eq 'w');
 643   }
 644   $time;
 645 }
 646
 647
 648 #######################################################################
 649 # seconds();
 650 #
 651 #  $time = seconds($timestamp);
 652 #
 653 # Given a time-of-day timestamp, convert it into a time() value using
 654 # POSIX::mktime.  We expect the timestamp to be of the form
 655 # "$year-$mon-$day $hour:$min:$sec", with month going from 1 to 12,
 656 # and the year to be absolute (we do the necessary conversions). The
 657 # timestamp may be followed with an offset from UTC like "+$hh$mm"; if the
 658 # offset is not present, and we have not been told that the log is in UTC
 659 # (with the -utc option), then we adjust the time by the current local
 660 # time offset so that it can be compared with the time recorded in message
 661 # IDs, which is UTC.
 662 #
 663 # To improve performance, we only use mktime on the date ($year-$mon-$day),
 664 # and only calculate it if the date is different to the previous time we
 665 # came here. We then add on seconds for the '$hour:$min:$sec'.
 666 #
 667 # We also store the results of the last conversion done, and only
 668 # recalculate if the date is different.
 669 #
 670 # We used to have the '-cache' flag which would store the results of the
 671 # mktime() call. However, the current way of just using mktime() on the
 672 # date obsoletes this.
 673 #######################################################################
 674 sub seconds {
 675   my($timestamp) = @_;
 676
 677   # Is the timestamp the same as the last one?
 678   return $last_time if ($last_timestamp eq $timestamp);
 679
 680   return 0 unless ($timestamp =~ /^((\d{4})\-(\d\d)-(\d\d))\s(\d\d):(\d\d):(\d\d)( ([+-])(\d\d)(\d\d))?/o);
 681
 682   unless ($last_date eq $1) {
 683     $last_date = $1;
 684     my(@timestamp) = (0,0,0,$4,$3,$2);
 685     $timestamp[5] -= 1900;
 686     $timestamp[4]--;
 687     $date_seconds = mktime(@timestamp);
 688   }
 689   my $time = $date_seconds + ($5 * 3600) + ($6 * 60) + $7;
 690
 691   # SC. Use cacheing. Also note we want seconds not minutes.
 692   #my($this_offset) = ($10 * 60 + $11) * ($9 . "1") if defined $8;
 693   if (defined $8 && ($8 ne $last_offset)) {
 694     $last_offset = $8;
 695     $offset_seconds = ($10 * 60 + $11) * 60;
 696     $offset_seconds = -$offset_seconds if ($9 eq '-');
 697   }
 698
 699
 700   if (defined $7) {
 701     #$time -= $this_offset;
 702     $time -= $offset_seconds;
 703   } elsif (defined $localtime_offset) {
 704     $time -= $localtime_offset;
 705   }
 706
 707   # Store the last timestamp received.
 708   $last_timestamp = $timestamp;
 709   $last_time      = $time;
 710
 711   $time;
 712 }
 713
 714
 715 #######################################################################
 716 #  id_seconds();
 717 #
 718 #  $time = id_seconds($message_id);
 719 #
 720 # Given a message ID, convert it into a time() value.
 721 #######################################################################
 722 sub id_seconds {
 723 my($sub_id) = substr((pop @_), 0, 6);
 724 my($s) = 0;
 725 my(@c) = split(//, $sub_id);
 726 while($#c >= 0) { $s = $s * 62 + $tab62[ord(shift @c) - ord('0')] }
 727 $s;
 728 }
 729
 730
 731
 732 #######################################################################
 733 #  calculate_localtime_offset();
 734 #
 735 #  $localtime_offset = calculate_localtime_offset();
 736 #
 737 # Calculate the the localtime offset from gmtime in seconds.
 738 #
 739 #  $localtime = time() + $localtime_offset.
 740 #
 741 # These are the same semantics as ISO 8601 and RFC 2822 timezone offsets.
 742 # (West is negative, East is positive.)
 743 #######################################################################
 744
 745 # $localtime = gmtime() + $localtime_offset.  OLD COMMENT
 746 # This subroutine commented out as it's not currently in use.
 747
 748 #sub calculate_localtime_offset {
 749 #  # Pick an arbitrary date, convert it to localtime & gmtime, and return the difference.
 750 #  my (@sample_date) = (0,0,0,5,5,100);
 751 #  my $localtime = timelocal(@sample_date);
 752 #  my $gmtime    = timegm(@sample_date);
 753 #  my $offset = $localtime - $gmtime;
 754 #  return $offset;
 755 #}
 756
 757 sub calculate_localtime_offset {
 758   # Assume that the offset at the moment is valid across the whole
 759   # period covered by the logs that we're analysing. This may not
 760   # be true around the time the clocks change in spring or autumn.
 761   my $utc = time;
 762   # mktime works on local time and gmtime works in UTC
 763   my $local = mktime(gmtime($utc));
 764   return $local - $utc;
 765 }
 766
 767
 768 #######################################################################
 769 # print_queue_times();
 770 #
 771 #  $time = print_queue_times($message_type,\@queue_times,$queue_more_than);
 772 #
 773 # Given the type of messages being output, the array of message queue times,
 774 # and the number of messages which exceeded the queue times, print out
 775 # a table.
 776 #######################################################################
 777 sub print_queue_times {
 778 no integer;
 779 my($string,$array,$queue_more_than) = @_;
 780 my(@chartdatanames);
 781 my(@chartdatavals);
 782
 783 my $printed_one = 0;
 784 my $cumulative_percent = 0;
 785 #$queue_unknown += keys %arrival_time;
 786
 787 my $queue_total = $queue_more_than;
 788 for ($i = 0; $i <= $#queue_times; $i++) { $queue_total += $$array[$i] }
 789
 790 my $temp = "Time spent on the queue: $string";
 791
 792 my($format);
 793 if ($html) {
 794   print "<hr><a name=\"$string time\"></a><h2>$temp</h2>\n";
 795   print "<table border=0 width=\"100%\">\n";
 796   print "<tr><td>\n";
 797   print "<table border=1>\n";
 798   print "<tr><th>Time</th><th>Messages</th><th>Percentage</th><th>Cumulative Percentage</th>\n";
 799   $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";
 800 }
 801 else
 802 {
 803   printf("%s\n%s\n\n", $temp, "-" x length($temp));
 804   $format = "%5s %4s   %6d %5.1f%%  %5.1f%%\n";
 805 }
 806
 807 for ($i = 0; $i <= $#queue_times; $i++) {
 808   if ($$array[$i] > 0)
 809     {
 810     my $percent = ($$array[$i] * 100)/$queue_total;
 811     $cumulative_percent += $percent;
 812     printf($format,
 813       $printed_one? "     " : "Under",
 814       format_time($queue_times[$i]),
 815       $$array[$i], $percent, $cumulative_percent);
 816     if (!defined($queue_times[$i])) {
 817       print "Not defined";
 818     }
 819     push(@chartdatanames,
 820       ($printed_one? "" : "Under") . format_time($queue_times[$i]));
 821     push(@chartdatavals, $$array[$i]);
 822     $printed_one = 1;
 823   }
 824 }
 825
 826 if ($queue_more_than > 0) {
 827   my $percent = ($queue_more_than * 100)/$queue_total;
 828   $cumulative_percent += $percent;
 829   printf($format,
 830     "Over ",
 831     format_time($queue_times[$#queue_times]),
 832     $queue_more_than, $percent, $cumulative_percent);
 833 }
 834 push(@chartdatanames, "Over " . format_time($queue_times[$#queue_times]));
 835 push(@chartdatavals, $queue_more_than);
 836
 837 #printf("Unknown   %6d\n", $queue_unknown) if $queue_unknown > 0;
 838 if ($html) {
 839   print "</table>\n";
 840   print "</td><td>\n";
 841
 842   if ($HAVE_GD_Graph_pie && $charts) {
 843     my @data = (
 844        \@chartdatanames,
 845        \@chartdatavals
 846     );
 847     my $graph = GD::Graph::pie->new(200, 200);
 848     my $pngname;
 849     my $title;
 850     if ($string =~ /all/) { $pngname = "queue_all.png"; $title = "Queue (all)"; }
 851     if ($string =~ /remote/) { $pngname = "queue_rem.png"; $title = "Queue (remote)"; }
 852     $graph->set(
 853         title             => $title,
 854     );
 855     my $gd = $graph->plot(\@data) or warn($graph->error);
 856     if ($gd) {
 857       open(IMG, ">$chartdir/$pngname") or die $!;
 858       binmode IMG;
 859       print IMG $gd->png;
 860       close IMG;
 861       print "<img src=\"$chartrel/$pngname\">";
 862     }
 863   }
 864   print "</td></tr></table>\n";
 865 }
 866 print "\n";
 867 }
 868
 869
 870
 871 #######################################################################
 872 # print_histogram();
 873 #
 874 #  print_histogram('Deliverieds|Messages received',@interval_count);
 875 #
 876 # Print a histogram of the messages delivered/received per time slot
 877 # (hour by default).
 878 #######################################################################
 879 sub print_histogram {
 880 my($text) = shift;
 881 my(@interval_count) = @_;
 882 my(@chartdatanames);
 883 my(@chartdatavals);
 884 my($maxd) = 0;
 885 for ($i = 0; $i < $hist_number; $i++)
 886   { $maxd = $interval_count[$i] if $interval_count[$i] > $maxd; }
 887
 888 my $scale = int(($maxd + 25)/50);
 889 $scale = 1 if $scale == 0;
 890
 891 my($type);
 892 if ($text eq "Deliveries")
 893   {
 894   $type = ($scale == 1)? "delivery" : "deliveries";
 895   }
 896 else
 897   {
 898   $type = ($scale == 1)? "message" : "messages";
 899   }
 900
 901 my($title) = sprintf("$text per %s (each dot is $scale $type)",
 902   ($hist_interval == 60)? "hour" :
 903   ($hist_interval == 1)?  "minute" : "$hist_interval minutes");
 904
 905 if ($html) {
 906   print "<hr><a name=\"$text\"></a><h2>$title</h2>\n";
 907   print "<table border=0 width=\"100%\">\n";
 908   print "<tr><td><pre>\n";
 909 }
 910 else {
 911   printf("%s\n%s\n\n", $title, "-" x length($title));
 912 }
 913
 914 my $hour = 0;
 915 my $minutes = 0;
 916 for ($i = 0; $i < $hist_number; $i++)
 917   {
 918   my $c = $interval_count[$i];
 919
 920   # If the interval is an hour (the maximum) print the starting and
 921   # ending hours as a label. Otherwise print the starting hour and
 922   # minutes, which take up the same space.
 923
 924   my $temp;
 925   if ($hist_opt == 1)
 926     {
 927     $temp = sprintf("%02d-%02d", $hour, $hour + 1);
 928     print $temp;
 929     push(@chartdatanames, $temp);
 930     $hour++;
 931     }
 932   else
 933     {
 934     if ($minutes == 0)
 935       { $temp = sprintf("%02d:%02d", $hour, $minutes) }
 936     else
 937       { $temp = sprintf("  :%02d", $minutes) }
 938     print $temp;
 939     push(@chartdatanames, $temp);
 940     $minutes += $hist_interval;
 941     if ($minutes >= 60)
 942       {
 943       $minutes = 0;
 944       $hour++;
 945       }
 946     }
 947   push(@chartdatavals, $c);
 948   printf(" %6d %s\n", $c, "." x ($c/$scale));
 949   }
 950 print "\n";
 951 if ($html)
 952   {
 953   print "</pre>\n";
 954   print "</td><td>\n";
 955   if ($HAVE_GD_Graph_linespoints && $charts) {
 956     # calculate the graph
 957     my @data = (
 958        \@chartdatanames,
 959        \@chartdatavals
 960     );
 961     my $graph = GD::Graph::linespoints->new(300, 300);
 962     $graph->set(
 963         x_label           => 'Time',
 964         y_label           => 'Amount',
 965         title             => $text,
 966         x_labels_vertical => 1
 967     );
 968     my($pngname);
 969     if ($text =~ /Deliveries/) { $pngname = "histogram_del.png"; }
 970     if ($text =~ /Messages/)   { $pngname = "histogram_mes.png"; }
 971     my $gd = $graph->plot(\@data) or warn($graph->error);
 972     if ($gd) {
 973       open(IMG, ">$chartdir/$pngname") or die $!;
 974       binmode IMG;
 975       print IMG $gd->png;
 976       close IMG;
 977       print "<img src=\"$chartrel/$pngname\">";
 978     }
 979   }
 980   print "</td></tr></table>\n";
 981 }
 982 }
 983
 984
 985
 986 #######################################################################
 987 # print_league_table();
 988 #
 989 #  print_league_table($league_table_type,\%message_count,\%message_data,\%message_data_gigs);
 990 #
 991 # Given hashes of message count and message data, which are keyed by
 992 # the table type (eg by the sending host), print a league table
 993 # showing the top $topcount (defaults to 50).
 994 #######################################################################
 995 sub print_league_table {
 996 my($text,$m_count,$m_data,$m_data_gigs) = @_;
 997 my($name) = ($topcount == 1)? "$text" : "$topcount ${text}s";
 998 my($temp) = "Top $name by message count";
 999 my(@chartdatanames) = ();
1000 my(@chartdatavals) = ();
1001 my $chartotherval = 0;
1002
1003 my($format);
1004 if ($html) {
1005   print "<hr><a name=\"$text count\"></a><h2>$temp</h2>\n";
1006   print "<table border=0 width=\"100%\">\n";
1007   print "<tr><td>\n";
1008   print "<table border=1>\n";
1009   print "<tr><th>Messages</th><th>Bytes</th><th>Average</th><th>\u$text</th>\n";
1010
1011   # Align non-local addresses to the right (so all the .com's line up).
1012   # Local addresses are aligned on the left as they are userids.
1013   my $align = ($text !~ /local/i) ? 'right' : 'left';
1014   $format = "<tr><td align=\"right\">%d</td><td align=\"right\">%s</td><td align=\"right\">%s</td><td align=\"$align\" nowrap>%s</td>\n";
1015 }
1016 else {
1017   printf("%s\n%s\n\n", $temp, "-" x length($temp));
1018   $format = "%7d %10s   %s\n";
1019 }
1020
1021 my($key,$htmlkey,$rounded_volume,$rounded_average,$count,$data,$gigs);
1022 foreach $key (top_n_sort($topcount,$m_count,$m_data_gigs,$m_data)) {
1023   if ($html) {
1024     $htmlkey = $key;
1025     $htmlkey =~ s/>/\&gt\;/g;
1026     $htmlkey =~ s/</\&lt\;/g;
1027
1028     # When displaying the average figures, we calculate the average of
1029     # the rounded data, as the user would calculate it. This reduces
1030     # the accuracy slightly, but we have to do it this way otherwise
1031     # when using -merge to convert results from text to HTML and
1032     # vice-versa discrepencies would occur.
1033     $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1034     $data = $gigs = 0;
1035     un_round($rounded_volume,\$data,\$gigs);
1036     $count = $$m_count{$key};
1037     $rounded_average = volume_rounded($data/$count,$gigs/$count);
1038     printf($format, $count, $rounded_volume, $rounded_average, $htmlkey);
1039   }
1040   else {
1041     printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $key);
1042   }
1043   if (scalar @chartdatanames < $ntopchart)
1044     {
1045     push(@chartdatanames, $key);
1046     push(@chartdatavals, $$m_count{$key});
1047     }
1048   else
1049     {
1050     $chartotherval += $$m_count{$key};
1051     }
1052   }
1053 push(@chartdatanames, "Other");
1054 push(@chartdatavals, $chartotherval);
1055
1056 if ($html)
1057   {
1058   print "</table>\n";
1059   print "</td><td>\n";
1060   if ($HAVE_GD_Graph_pie && $charts)
1061     {
1062     # calculate the graph
1063     my @data = (
1064        \@chartdatanames,
1065        \@chartdatavals
1066     );
1067     my $graph = GD::Graph::pie->new(300, 300);
1068     $graph->set(
1069         x_label           => 'Name',
1070         y_label           => 'Amount',
1071         title             => 'By count',
1072     );
1073     my $gd = $graph->plot(\@data) or warn($graph->error);
1074     if ($gd) {
1075       my $temp = $text;
1076       $temp =~ s/ /_/g;
1077       open(IMG, ">$chartdir/${temp}_count.png") or die $!;
1078       binmode IMG;
1079       print IMG $gd->png;
1080       close IMG;
1081       print "<img src=\"$chartrel/${temp}_count.png\">";
1082     }
1083   }
1084   print "</td><td>\n";
1085   print "</td></tr></table>\n";
1086 }
1087 print "\n";
1088
1089 $temp = "Top $name by volume";
1090 if ($html) {
1091   print "<hr><a name=\"$text volume\"></a><h2>$temp</h2>\n";
1092   print "<table border=0 width=\"100%\">\n";
1093   print "<tr><td>\n";
1094   print "<table border=1>\n";
1095   print "<tr><th>Messages</th><th>Bytes</th><th>Average</th><th>\u$text</th>\n";
1096 }
1097 else {
1098   printf("%s\n%s\n\n", $temp, "-" x length($temp));
1099 }
1100
1101 @chartdatanames = ();
1102 @chartdatavals = ();
1103 $chartotherval = 0;
1104 my $use_gig = 0;
1105 foreach $key (top_n_sort($topcount,$m_data_gigs,$m_data,$m_count)) {
1106   # The largest volume will be the first (top of the list).
1107   # If it has at least 1 gig, then just use gigabytes to avoid
1108   # risking an integer overflow when generating the pie charts.
1109   if ($$m_data_gigs{$key}) {
1110     $use_gig = 1;
1111   }
1112   if ($html) {
1113     $htmlkey = $key;
1114     $htmlkey =~ s/>/\&gt\;/g;
1115     $htmlkey =~ s/</\&lt\;/g;
1116
1117     $rounded_volume = volume_rounded($$m_data{$key},$$m_data_gigs{$key});
1118     $data = $gigs = 0;
1119     un_round($rounded_volume,\$data,\$gigs);
1120     $count = $$m_count{$key};
1121     $rounded_average = volume_rounded($data/$count,$gigs/$count);
1122     printf($format, $count, $rounded_volume, $rounded_average, $htmlkey);
1123   }
1124   else {
1125     printf($format, $$m_count{$key}, volume_rounded($$m_data{$key},$$m_data_gigs{$key}), $key);
1126   }
1127
1128   if (scalar @chartdatanames < $ntopchart) {
1129     if ($use_gig) {
1130       if ($$m_data_gigs{$key}) {
1131         push(@chartdatanames, $key);
1132         push(@chartdatavals, $$m_data_gigs{$key});
1133       }
1134     }
1135     else {
1136       push(@chartdatanames, $key);
1137       push(@chartdatavals, $$m_data{$key});
1138     }
1139   }
1140   else {
1141     $chartotherval += ($use_gig) ? $$m_data_gigs{$key} : $$m_data{$key};
1142   }
1143 }
1144 push(@chartdatanames, "Other");
1145 push(@chartdatavals, $chartotherval);
1146
1147 if ($html) {
1148   print "</table>\n";
1149   print "</td><td>\n";
1150   if ($HAVE_GD_Graph_pie && $charts) {
1151     # calculate the graph
1152     my @data = (
1153        \@chartdatanames,
1154        \@chartdatavals
1155     );
1156     my $graph = GD::Graph::pie->new(300, 300);
1157     $graph->set(
1158         x_label           => 'Name',
1159         y_label           => 'Volume' ,
1160         title             => 'By Volume',
1161     );
1162     my $gd = $graph->plot(\@data) or warn($graph->error);
1163     if ($gd) {
1164       my $temp = $text;
1165       $temp =~ s/ /_/g;
1166       open(IMG, ">$chartdir/${temp}_volume.png") or die $!;
1167       binmode IMG;
1168       print IMG $gd->png;
1169       close IMG;
1170       print "<img src=\"$chartrel/${temp}_volume.png\">";
1171     }
1172   }
1173   print "</td><td>\n";
1174   print "</td></tr></table>\n";
1175 }
1176
1177 print "\n";
1178 }
1179
1180
1181 #######################################################################
1182 # top_n_sort();
1183 #
1184 #   @sorted_keys = top_n_sort($n,$href1,$href2,$href3);
1185 #
1186 # Given a hash which has numerical values, return the sorted $n keys which
1187 # point to the top values. The second and third hashes are used as
1188 # tiebreakers. They all must have the same keys.
1189 #
1190 # The idea behind this routine is that when you only want to see the
1191 # top n members of a set, rather than sorting the entire set and then
1192 # plucking off the top n, sort through the stack as you go, discarding
1193 # any member which is lower than your current n'th highest member.
1194 #
1195 # This proves to be an order of magnitude faster for large hashes.
1196 # On 200,000 lines of mainlog it benchmarked 9 times faster.
1197 # On 700,000 lines of mainlog it benchmarked 13.8 times faster.
1198 #
1199 # We assume the values are > 0.
1200 #######################################################################
1201 sub top_n_sort {
1202   my($n,$href1,$href2,$href3) = @_;
1203
1204   # PH's original sort was:
1205   #
1206   # foreach $key (sort
1207   #               {
1208   #               $$m_count{$b}     <=> $$m_count{$a} ||
1209   #               $$m_data_gigs{$b} <=> $$m_data_gigs{$a}  ||
1210   #               $$m_data{$b}      <=> $$m_data{$a}  ||
1211   #               $a cmp $b
1212   #               }
1213   #             keys %{$m_count})
1214   #
1215
1216   #We use a key of '_' to represent non-existant values, as null keys are valid.
1217   #'_' is not a valid domain, edomain, host, or email.
1218   my(@top_n_keys) = ('_') x $n;
1219   my($minimum_value1,$minimum_value2,$minimum_value3) = (0,0,0);
1220   my $top_n_key = '';
1221   my $n_minus_1 = $n - 1;
1222   my $n_minus_2 = $n - 2;
1223
1224   # Pick out the top $n keys.
1225   my($key,$value1,$value2,$value3,$i,$comparison,$insert_position);
1226   while (($key,$value1) = each %$href1) {
1227
1228     #print STDERR "key $key ($value1,",$href2->{$key},",",$href3->{$key},") <=> ($minimum_value1,$minimum_value2,$minimum_value3)\n";
1229
1230     # Check to see that the new value is bigger than the lowest of the
1231     # top n keys that we're keeping.
1232     $comparison = $value1        <=> $minimum_value1 ||
1233                   $href2->{$key} <=> $minimum_value2 ||
1234                   $href3->{$key} <=> $minimum_value3 ||
1235                   $top_n_key cmp $key;
1236     next unless ($comparison == 1);
1237
1238     # As we will be using these values a few times, extract them into scalars.
1239     $value2 = $href2->{$key};
1240     $value3 = $href3->{$key};
1241
1242     # This key is bigger than the bottom n key, so the lowest position we
1243     # will insert it into is $n minus 1 (the bottom of the list).
1244     $insert_position = $n_minus_1;
1245
1246     # Now go through the list, stopping when we find a key that we're
1247     # bigger than, or we come to the penultimate position - we've
1248     # already tested bigger than the last.
1249     #
1250     # Note: we go top down as the list starts off empty.
1251     # Note: stepping through the list in this way benchmarks nearly
1252     # three times faster than doing a sort() on the reduced list.
1253     # I assume this is because the list is already in order, and
1254     # we get a performance boost from not having to do hash lookups
1255     # on the new key.
1256     for ($i = 0; $i < $n_minus_1; $i++) {
1257       $top_n_key = $top_n_keys[$i];
1258       if ( ($top_n_key eq '_') ||
1259            ( ($value1 <=> $href1->{$top_n_key} ||
1260               $value2 <=> $href2->{$top_n_key} ||
1261               $value3 <=> $href3->{$top_n_key} ||
1262               $top_n_key cmp $key) == 1
1263            )
1264          ) {
1265         $insert_position = $i;
1266         last;
1267       }
1268     }
1269
1270     # Remove the last element, then insert the new one.
1271     $#top_n_keys = $n_minus_2;
1272     splice(@top_n_keys,$insert_position,0,$key);
1273
1274     # Extract our new minimum values.
1275     $top_n_key = $top_n_keys[$n_minus_1];
1276     if ($top_n_key ne '_') {
1277       $minimum_value1 = $href1->{$top_n_key};
1278       $minimum_value2 = $href2->{$top_n_key};
1279       $minimum_value3 = $href3->{$top_n_key};
1280     }
1281   }
1282
1283   # Return the top n list, grepping out non-existant values, just in case
1284   # we didn't have that many values.
1285   return(grep(!/^_$/,@top_n_keys));
1286 }
1287
1288
1289 #######################################################################
1290 # html_header();
1291 #
1292 #  $header = html_header($title);
1293 #
1294 # Print our HTML header and start the <body> block.
1295 #######################################################################
1296 sub html_header {
1297   my($title) = @_;
1298   my $text = << "EoText";
1299 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
1300 <html>
1301 <head>
1302 <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-15">
1303 <title>$title</title>
1304 </head>
1305 <body bgcolor="white">
1306 <h1>$title</h1>
1307 EoText
1308   return $text;
1309 }
1310
1311
1312
1313 #######################################################################
1314 # help();
1315 #
1316 #  help();
1317 #
1318 # Display usage instructions and exit.
1319 #######################################################################
1320 sub help {
1321   print << "EoText";
1322
1323 eximstats Version $VERSION
1324
1325 Usage: eximstats [Options] mainlog1 mainlog2 ... > report.txt
1326        eximstats -html  [Options] mainlog1 mainlog2 ... > report.html
1327        eximstats -merge [Options] report.1.txt report.2.txt ... > weekly_rep.txt
1328        eximstats -merge -html [Options] report.1.html ... > weekly_rep.html
1329
1330 Parses exim mainlog or syslog files and generates a statistical analysis
1331 of the messages processed. Valid options are:
1332
1333 -h<number>      histogram divisions per hour. The default is 1, and
1334                 0 suppresses histograms. Other valid values are:
1335                 2, 3, 5, 10, 15, 20, 30 or 60.
1336 -ne             don't display error information
1337 -nr             don't display relaying information
1338 -nr/pattern/    don't display relaying information that matches
1339 -nt             don't display transport information
1340 -nt/pattern/    don't display transport information that matches
1341 -nvr            don't do volume rounding. Display in bytes, not KB/MB/GB.
1342 -q<list>        list of times for queuing information
1343                 single 0 item suppresses
1344 -t<number>      display top <number> sources/destinations
1345                 default is 50, 0 suppresses top listing
1346 -tnl            omit local sources/destinations in top listing
1347 -t_remote_users show top user sources/destinations from non-local domains
1348
1349 -byhost         show results by sending host (default unless bydomain or
1350                 byemail is specified)
1351 -bydomain       show results by sending domain.
1352 -byemail        show results by sender's email address
1353 -byedomain      show results by sender's email domain
1354
1355 -pattern "Description" /pattern/
1356                 Count lines matching specified patterns and show them in
1357                 the results. It can be specified multiple times. Eg:
1358                 -pattern 'Refused connections' '/refused connection/'
1359
1360 -merge          merge previously generated reports into a new report
1361
1362 -html           output the results in HTML
1363 -charts         Create charts (this requires the GD::Graph modules)
1364 -chartdir <dir> Create the charts' png files in the directory <dir>
1365 -chartrel <dir> Specify the relative directory for the "img src=" tags
1366                 from where to include the charts in the html file
1367                 -chartdir and -chartrel default to '.'
1368
1369 -d              Debug mode - dump the eval'ed parser onto STDERR.
1370
1371 EoText
1372
1373   exit 1;
1374 }
1375
1376
1377
1378 #######################################################################
1379 # generate_parser();
1380 #
1381 #  $parser = generate_parser();
1382 #
1383 # This subroutine generates the parsing routine which will be
1384 # used to parse the mainlog. We take the base operation, and remove bits not in use.
1385 # This improves performance depending on what bits you take out or add.
1386 #
1387 # I've tested using study(), but this does not improve performance.
1388 #
1389 # We store our parsing routing in a variable, and process it looking for #IFDEF (Expression)
1390 # or #IFNDEF (Expression) statements and corresponding #ENDIF (Expression) statements. If
1391 # the expression evaluates to true, then it is included/excluded accordingly.
1392 #######################################################################
1393 sub generate_parser {
1394   my $parser = '
1395   my($ip,$host,$email,$edomain,$domain,$thissize,$size,$old,$new);
1396   my($tod,$m_hour,$m_min,$id,$flag);
1397   while (<$fh>) {
1398
1399     # Convert syslog lines to mainlog format.
1400     if (! /^\\d{4}/) {
1401       next unless s/^.*? exim\\b.*?: //;
1402     }
1403
1404     next if length($_) < 38;
1405     next unless /^(\\d{4}\\-\\d\\d-\\d\\d\\s(\\d\\d):(\\d\\d):\\d\\d( [-+]\\d\\d\\d\\d)?)/o;
1406
1407     ($tod,$m_hour,$m_min) = ($1,$2,$3);
1408
1409     # PH
1410     my($extra) = defined($4)? 6 : 0;
1411     $id   = substr($_, 20 + $extra, 16);
1412     $flag = substr($_, 37 + $extra, 2);
1413 ';
1414
1415   # Watch for user specified patterns.
1416   my $user_pattern_index = 0;
1417   foreach (@user_patterns) {
1418     $user_pattern_totals[$user_pattern_index] = 0;
1419     $parser .= "  \$user_pattern_totals[$user_pattern_index]++ if $_;\n";
1420     $user_pattern_index++;
1421   }
1422
1423   $parser .= '
1424     next unless ($flag =~ /<=|=>|->|==|\\*\\*|Co/);
1425
1426     #Strip away the timestamp, ID and flag (which could be "Com" for completed)
1427     #This speeds up the later pattern matches.
1428     # $_ = substr($_, 40);
1429
1430     $_ = substr($_, 40 + $extra);  # PH
1431
1432     # JN - Skip over certain transports as specified via the "-nt/.../" command
1433     # line switch (where ... is a perl style regular expression).  This is
1434     # required so that transports that skew stats such as SpamAssassin can be
1435     # ignored.
1436     #IFDEF ($transport_pattern)
1437     if (/\\sT=(\\S+)/) {
1438        next if ($1 =~ /$transport_pattern/o) ;
1439     }
1440     #ENDIF ($transport_pattern)
1441
1442
1443     $host = "local";            #Host is local unless otherwise specified.
1444     $domain = "localdomain";    #Domain is localdomain unless otherwise specified.
1445
1446
1447     # Do some pattern matches to get the host and IP address.
1448     # We expect lines to be of the form "H=[IpAddr]" or "H=Host [IpAddr]" or
1449     # "H=Host (UnverifiedHost) [IpAddr]" or "H=(UnverifiedHost) [IpAddr]".
1450     # We do 2 separate matches to keep the matches simple and fast.
1451     if (/\\sH=(\\S+)/) {
1452       $host = $1;
1453
1454       ($ip) = /\\sH=.*?(\\s\\[[^]]+\\])/;
1455       # If there is only an IP address, it will be in $host and $ip will be
1456       # unset. That is OK, because we only use $ip in conjunction with $host
1457       # below. But make it empty to avoid warning messages.
1458       $ip = "" if !defined $ip;
1459
1460       #IFDEF ($do_sender{Domain})
1461       if ($host !~ /^\\[/ && $host =~ /^(\\(?)[^\\.]+\\.([^\\.]+\\..*)/) {
1462         # Remove the host portion from the DNS name. We ensure that we end up with
1463         # at least xxx.yyy. $host can be "(x.y.z)" or  "x.y.z".
1464         $domain = lc("$1.$2");
1465         $domain =~ s/^\\.//;            #Remove preceding dot.
1466       }
1467       #ENDIF ($do_sender{Domain})
1468
1469     }
1470
1471     #IFDEF ($do_sender{Email})
1472     $email = (/^(\S+)/) ? $1 : "";
1473     #ENDIF ($do_sender{Email})
1474
1475     #IFDEF ($do_sender{Edomain})
1476     $edomain = (/^\S*?\\@(\S+)/) ? lc($1) : "";
1477     #ENDIF ($do_sender{Edomain})
1478
1479     if ($tod lt $begin) {
1480       $begin = $tod;
1481     }
1482     elsif ($tod gt $end) {
1483       $end   = $tod;
1484     }
1485
1486
1487     if ($flag eq "<=") {
1488       $thissize = (/\\sS=(\\d+)( |$)/) ? $1 : 0;
1489       $size{$id} = $thissize;
1490
1491       #IFDEF ($show_relay)
1492       if ($host ne "local") {
1493         # Save incoming information in case it becomes interesting
1494         # later, when delivery lines are read.
1495         my($from) = /^(\\S+)/;
1496         $from_host{$id} = "$host$ip";
1497         $from_address{$id} = $from;
1498       }
1499       #ENDIF ($show_relay)
1500
1501       #IFDEF ($local_league_table || $include_remote_users)
1502         if (/\sU=(\\S+)/) {
1503           my $user = $1;
1504
1505           #IFDEF ($local_league_table && $include_remote_users)
1506           {                             #Store both local and remote users.
1507           #ENDIF ($local_league_table && $include_remote_users)
1508
1509           #IFDEF ($local_league_table && ! $include_remote_users)
1510           if ($host eq "local") {               #Store local users only.
1511           #ENDIF ($local_league_table && ! $include_remote_users)
1512
1513           #IFDEF ($include_remote_users && ! $local_league_table)
1514           if ($host ne "local") {               #Store remote users only.
1515           #ENDIF ($include_remote_users && ! $local_league_table)
1516
1517             $received_count_user{$user}++;
1518             add_volume(\\$received_data_user{$user},\\$received_data_gigs_user{$user},$thissize);
1519           }
1520         }
1521       #ENDIF ($local_league_table || $include_remote_users)
1522
1523       #IFDEF ($do_sender{Host})
1524         $received_count{Host}{$host}++;
1525         add_volume(\\$received_data{Host}{$host},\\$received_data_gigs{Host}{$host},$thissize);
1526       #ENDIF ($do_sender{Host})
1527
1528       #IFDEF ($do_sender{Domain})
1529         if ($domain) {
1530           $received_count{Domain}{$domain}++;
1531           add_volume(\\$received_data{Domain}{$domain},\\$received_data_gigs{Domain}{$domain},$thissize);
1532         }
1533       #ENDIF ($do_sender{Domain})
1534
1535       #IFDEF ($do_sender{Email})
1536         $received_count{Email}{$email}++;
1537         add_volume(\\$received_data{Email}{$email},\\$received_data_gigs{Email}{$email},$thissize);
1538       #ENDIF ($do_sender{Email})
1539
1540       #IFDEF ($do_sender{Edomain})
1541         $received_count{Edomain}{$edomain}++;
1542         add_volume(\\$received_data{Edomain}{$edomain},\\$received_data_gigs{Edomain}{$edomain},$thissize);
1543       #ENDIF ($do_sender{Edomain})
1544
1545       $total_received_count++;
1546       add_volume(\\$total_received_data,\\$total_received_data_gigs,$thissize);
1547
1548       #IFDEF ($#queue_times >= 0)
1549         $arrival_time{$id} = $tod;
1550       #ENDIF ($#queue_times >= 0)
1551
1552       #IFDEF ($hist_opt > 0)
1553         $received_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
1554       #ENDIF ($hist_opt > 0)
1555     }
1556
1557     elsif ($flag eq "=>") {
1558       $size = $size{$id} || 0;
1559       if ($host ne "local") {
1560         $remote_delivered{$id} = 1;
1561
1562
1563         #IFDEF ($show_relay)
1564         # Determine relaying address if either only one address listed,
1565         # or two the same. If they are different, it implies a forwarding
1566         # or aliasing, which is not relaying. Note that for multi-aliased
1567         # addresses, there may be a further address between the first
1568         # and last.
1569
1570         if (defined $from_host{$id}) {
1571           if (/^(\\S+)(?:\\s+\\([^)]\\))?\\s+<([^>]+)>/) {
1572             ($old,$new) = ($1,$2);
1573           }
1574           else {
1575             $old = $new = "";
1576           }
1577
1578           if ("\\L$new" eq "\\L$old") {
1579             ($old) = /^(\\S+)/ if $old eq "";
1580             my $key = "H=\\L$from_host{$id}\\E A=\\L$from_address{$id}\\E => " .
1581               "H=\\L$host\\E$ip A=\\L$old\\E";
1582             if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
1583               $relayed{$key} = 0 if !defined $relayed{$key};
1584               $relayed{$key}++;
1585             }
1586             else {
1587               $relayed_unshown++
1588             }
1589           }
1590         }
1591         #ENDIF ($show_relay)
1592
1593       }
1594
1595       #IFDEF ($local_league_table || $include_remote_users)
1596         #IFDEF ($local_league_table && $include_remote_users)
1597         {                               #Store both local and remote users.
1598         #ENDIF ($local_league_table && $include_remote_users)
1599
1600         #IFDEF ($local_league_table && ! $include_remote_users)
1601         if ($host eq "local") {         #Store local users only.
1602         #ENDIF ($local_league_table && ! $include_remote_users)
1603
1604         #IFDEF ($include_remote_users && ! $local_league_table)
1605         if ($host ne "local") {         #Store remote users only.
1606         #ENDIF ($include_remote_users && ! $local_league_table)
1607
1608           if (my($user) = split((/\\s</)? " <" : " ", $_)) {
1609             if ($user =~ /^[\\/|]/) {
1610               my($parent) = $_ =~ /(<[^@]+@?[^>]*>)/;
1611               $user = "$user $parent" if defined $parent;
1612             }
1613             $delivered_count_user{$user}++;
1614             add_volume(\\$delivered_data_user{$user},\\$delivered_data_gigs_user{$user},$size);
1615           }
1616         }
1617       #ENDIF ($local_league_table || $include_remote_users)
1618
1619       #IFDEF ($do_sender{Host})
1620         $delivered_count{Host}{$host}++;
1621         add_volume(\\$delivered_data{Host}{$host},\\$delivered_data_gigs{Host}{$host},$size);
1622       #ENDIF ($do_sender{Host})
1623       #IFDEF ($do_sender{Domain})
1624         if ($domain) {
1625           $delivered_count{Domain}{$domain}++;
1626           add_volume(\\$delivered_data{Domain}{$domain},\\$delivered_data_gigs{Domain}{$domain},$size);
1627         }
1628       #ENDIF ($do_sender{Domain})
1629       #IFDEF ($do_sender{Email})
1630         $delivered_count{Email}{$email}++;
1631         add_volume(\\$delivered_data{Email}{$email},\\$delivered_data_gigs{Email}{$email},$size);
1632       #ENDIF ($do_sender{Email})
1633       #IFDEF ($do_sender{Edomain})
1634         $delivered_count{Edomain}{$edomain}++;
1635         add_volume(\\$delivered_data{Edomain}{$edomain},\\$delivered_data_gigs{Edomain}{$edomain},$size);
1636       #ENDIF ($do_sender{Edomain})
1637
1638       $total_delivered_count++;
1639       add_volume(\\$total_delivered_data,\\$total_delivered_data_gigs,$size);
1640
1641       #IFDEF ($show_transport)
1642         my $transport = (/\\sT=(\\S+)/) ? $1 : ":blackhole:";
1643         $transported_count{$transport}++;
1644         add_volume(\\$transported_data{$transport},\\$transported_data_gigs{$transport},$size);
1645       #ENDIF ($show_transport)
1646
1647       #IFDEF ($hist_opt > 0)
1648         $delivered_interval_count[($m_hour*60 + $m_min)/$hist_interval]++;
1649       #ENDIF ($hist_opt > 0)
1650
1651     }
1652
1653     elsif ($flag eq "==" && defined($size{$id}) && !defined($delayed{$id})) {
1654       $delayed_count++;
1655       $delayed{$id} = 1;
1656     }
1657
1658     elsif ($flag eq "**") {
1659       $had_error{$id} = 1 if defined ($size{$id});
1660
1661       #IFDEF ($show_errors)
1662         $errors_count{$_}++;
1663       #ENDIF ($show_errors)
1664
1665     }
1666
1667     elsif ($flag eq "Co") {
1668       #Completed?
1669       #IFDEF ($#queue_times >= 0)
1670         #Note: id_seconds() benchmarks as 42% slower than seconds() and computing
1671         #the time accounts for a significant portion of the run time.
1672         my($queued);
1673         if (defined $arrival_time{$id}) {
1674           $queued = seconds($tod) - seconds($arrival_time{$id});
1675           delete($arrival_time{$id});
1676         }
1677         else {
1678           $queued = seconds($tod) - id_seconds($id);
1679         }
1680
1681         for ($i = 0; $i <= $#queue_times; $i++) {
1682           if ($queued < $queue_times[$i]) {
1683             $queue_bin[$i]++;
1684             $remote_queue_bin[$i]++ if $remote_delivered{$id};
1685             last;
1686           }
1687         }
1688         $queue_more_than++ if $i > $#queue_times;
1689       #ENDIF ($#queue_times >= 0)
1690
1691       #IFDEF ($show_relay)
1692         delete($from_host{$id});
1693         delete($from_address{$id});
1694       #ENDIF ($show_relay)
1695
1696     }
1697   }';
1698
1699   # We now do a 'C preprocessor style operation on our parser
1700   # to remove bits not in use.
1701   my(%defines_in_operation,$removing_lines,$processed_parser);
1702   foreach (split (/\n/,$parser)) {
1703     if ((/^\s*#\s*IFDEF\s*\((.*?)\)/i  && ! eval $1) ||
1704         (/^\s*#\s*IFNDEF\s*\((.*?)\)/i &&   eval $1)    ) {
1705       $defines_in_operation{$1} = 1;
1706       $removing_lines = 1;
1707     }
1708
1709     $processed_parser .= $_."\n" unless $removing_lines;
1710
1711     if (/^\s*#\s*ENDIF\s*\((.*?)\)/i) {
1712       delete $defines_in_operation{$1};
1713       unless (keys %defines_in_operation) {
1714         $removing_lines = 0;
1715       }
1716     }
1717   }
1718   print STDERR "# START OF PARSER:\n$processed_parser\n# END OF PARSER\n\n" if $debug;
1719
1720   return $processed_parser;
1721 }
1722
1723
1724
1725 #######################################################################
1726 # parse();
1727 #
1728 #  parse($parser,\*FILEHANDLE);
1729 #
1730 # This subroutine accepts a parser and a filehandle from main and parses each
1731 # line. We store the results into global variables.
1732 #######################################################################
1733 sub parse {
1734   my($parser,$fh) = @_;
1735
1736   if ($merge_reports) {
1737     parse_old_eximstat_reports($fh);
1738   }
1739   else {
1740     eval $parser;
1741     die ($@) if $@;
1742   }
1743
1744 }
1745
1746
1747
1748 #######################################################################
1749 # print_header();
1750 #
1751 #  print_header();
1752 #
1753 # Print our headers and contents.
1754 #######################################################################
1755 sub print_header {
1756
1757   my $title = "Exim statistics from $begin to $end";
1758
1759   if ($html) {
1760     print html_header($title);
1761     print "<ul>\n";
1762     print "<li><a href=\"#grandtotal\">Grand total summary</a>\n";
1763     print "<li><a href=\"#patterns\">User Specified Patterns</a>\n" if @user_patterns;
1764     print "<li><a href=\"#transport\">Deliveries by Transport</a>\n" if $show_transport;
1765     if ($hist_opt) {
1766       print "<li><a href=\"#Messages received\">Messages received per hour</a>\n";
1767       print "<li><a href=\"#Deliveries\">Deliveries per hour</a>\n";
1768     }
1769     if ($#queue_times >= 0) {
1770       print "<li><a href=\"#all messages time\">Time spent on the queue: all messages</a>\n";
1771       print "<li><a href=\"#messages with at least one remote delivery time\">Time spent on the queue: messages with at least one remote delivery</a>\n";
1772     }
1773     print "<li><a href=\"#Relayed messages\">Relayed messages</a>\n" if $show_relay;
1774     if ($topcount) {
1775       foreach ('Host','Domain','Email','Edomain') {
1776         next unless $do_sender{$_};
1777         print "<li><a href=\"#sending \l$_ count\">Top $topcount sending \l${_}s by message count</a>\n";
1778         print "<li><a href=\"#sending \l$_ volume\">Top $topcount sending \l${_}s by volume</a>\n";
1779       }
1780       if ($local_league_table || $include_remote_users) {
1781         print "<li><a href=\"#local sender count\">Top $topcount local senders by message count</a>\n";
1782         print "<li><a href=\"#local sender volume\">Top $topcount local senders by volume</a>\n";
1783       }
1784       foreach ('Host','Domain','Email','Edomain') {
1785         next unless $do_sender{$_};
1786         print "<li><a href=\"#\l$_ destination count\">Top $topcount \l$_ destinations by message count</a>\n";
1787         print "<li><a href=\"#\l$_ destination volume\">Top $topcount \l$_ destinations by volume</a>\n";
1788       }
1789       if ($local_league_table || $include_remote_users) {
1790         print "<li><a href=\"#local destination count\">Top $topcount local destinations by message count</a>\n";
1791         print "<li><a href=\"#local destination volume\">Top $topcount local destinations by volume</a>\n";
1792       }
1793     }
1794     print "<li><a href=\"#errors\">List of errors</a>\n" if %errors_count;
1795     print "</ul>\n<hr>\n";
1796
1797   }
1798   else {
1799     print "\n$title\n";
1800   }
1801 }
1802
1803
1804 #######################################################################
1805 # print_grandtotals();
1806 #
1807 #  print_grandtotals();
1808 #
1809 # Print the grand totals.
1810 #######################################################################
1811 sub print_grandtotals {
1812
1813   # Get the sender by headings and results. This is complicated as we can have
1814   # different numbers of columns.
1815   my($sender_txt_header,$sender_html_header,$sender_txt_format,$sender_html_format);
1816   my(@received_totals,@delivered_totals);
1817   foreach ('Host','Domain','Email','Edomain') {
1818     next unless $do_sender{$_};
1819     if ($merge_reports) {
1820       push(@received_totals, get_report_total($report_totals{Received},"${_}s"));
1821       push(@delivered_totals,get_report_total($report_totals{Delivered},"${_}s"));
1822     }
1823     else {
1824       push(@received_totals,scalar(keys %{$received_data{$_}}));
1825       push(@delivered_totals,scalar(keys %{$delivered_data{$_}}));
1826     }
1827     $sender_html_header .= "<th>${_}s</th>";
1828     $sender_txt_header  .= " " x ($COLUMN_WIDTHS - length($_)) . $_ . 's';
1829     $sender_html_format .= "<td align=\"right\">%d</td>";
1830     $sender_txt_format  .= " " x ($COLUMN_WIDTHS - 5) . "%6d";
1831   }
1832
1833   my($format1,$format2);
1834   if ($html) {
1835     print << "EoText";
1836 <a name="grandtotal"></a>
1837 <h2>Grand total summary</h2>
1838 <table border=1>
1839 <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>
1840 EoText
1841
1842     $format1 = "<tr><td>%s</td><td align=\"right\">%s</td>$sender_html_format<td align=\"right\">%d</td>";
1843     $format2 = "<td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td><td align=\"right\">%d</td><td align=\"right\">%4.1f%%</td>";
1844   }
1845   else {
1846     my $sender_spaces = " " x length($sender_txt_header);
1847     print << "EoText";
1848
1849 Grand total summary
1850 -------------------
1851                                     $sender_spaces           At least one address
1852   TOTAL               Volume    Messages $sender_txt_header      Delayed       Failed
1853 EoText
1854     $format1 = "  %-16s %9s      %6d $sender_txt_format";
1855     $format2 = "  %6d %4.1f%% %6d %4.1f%%",
1856   }
1857
1858   my($volume,$failed_count);
1859   if ($merge_reports) {
1860     $volume = volume_rounded($report_totals{Received}{Volume}, $report_totals{Received}{'Volume-gigs'});
1861     $total_received_count = get_report_total($report_totals{Received},'Messages');
1862     $failed_count  = get_report_total($report_totals{Received},'Failed');
1863     $delayed_count = get_report_total($report_totals{Received},'Delayed');
1864   }
1865   else {
1866     $volume = volume_rounded($total_received_data, $total_received_data_gigs);
1867     $failed_count = keys %had_error;
1868   }
1869
1870   {
1871     no integer;
1872     printf("$format1$format2\n",'Received',$volume,$total_received_count,
1873       @received_totals,$delayed_count,
1874       ($total_received_count) ? ($delayed_count*100/$total_received_count) : 0,
1875       $failed_count,
1876       ($total_received_count) ? ($failed_count*100/$total_received_count) : 0);
1877   }
1878
1879   if ($merge_reports) {
1880     $volume = volume_rounded($report_totals{Delivered}{Volume}, $report_totals{Delivered}{'Volume-gigs'});
1881     $total_delivered_count = get_report_total($report_totals{Delivered},'Messages');
1882   }
1883   else {
1884     $volume = volume_rounded($total_delivered_data, $total_delivered_data_gigs);
1885   }
1886   printf("$format1\n\n",'Delivered',$volume,$total_delivered_count,@delivered_totals);
1887   print "</table>\n" if $html;
1888 }
1889
1890
1891 #######################################################################
1892 # print_user_patterns()
1893 #
1894 #  print_user_patterns();
1895 #
1896 # Print the counts of user specified patterns.
1897 #######################################################################
1898 sub print_user_patterns {
1899   my($format1);
1900
1901   if ($html) {
1902     print "<hr><a name=\"patterns\"></a><h2>User Specified Patterns</h2>\n";
1903     print "<table border=0 width=\"100%\">\n";
1904     print "<tr><td>\n";
1905     print "<table border=1>\n";
1906     print "<tr><th>&nbsp;</th><th>Total</th>\n";
1907     $format1 = "<tr><td>%s</td><td align=\"right\">%d</td>";
1908   }
1909   else {
1910     print "User Specified Patterns\n";
1911     print "-----------------------";
1912     print "\n                       Total\n";
1913     $format1 = "  %-18s  %6d";
1914   }
1915
1916   my($key);
1917   if ($merge_reports) {
1918     # We are getting our data from previous reports.
1919     foreach $key (@user_descriptions) {
1920       my $count = get_report_total($report_totals{patterns}{$key},'Total');
1921       printf("$format1\n",$key,$count);
1922     }
1923   }
1924   else {
1925     # We are getting our data from mainlog files.
1926     my $user_pattern_index = 0;
1927     foreach $key (@user_descriptions) {
1928       printf("$format1\n",$key,$user_pattern_totals[$user_pattern_index]);
1929       $user_pattern_index++;
1930     }
1931   }
1932   if ($html) {
1933     print "</table>\n";
1934   }
1935   print "\n";
1936 }
1937
1938
1939 #######################################################################
1940 # print_transport();
1941 #
1942 #  print_transport();
1943 #
1944 # Print totals by transport.
1945 #######################################################################
1946 sub print_transport {
1947   my($format1);
1948   my(@chartdatanames);
1949   my(@chartdatavals_count);
1950   my(@chartdatavals_vol);
1951   no integer;           #Lose this for charting the data.
1952
1953   if ($html) {
1954     print "<hr><a name=\"transport\"></a><h2>Deliveries by Transport</h2>\n";
1955     print "<table border=0 width=\"100%\">\n";
1956     print "<tr><td>\n";
1957     print "<table border=1>\n";
1958     print "<tr><th>&nbsp;</th><th>Volume</th><th>Messages</th>\n";
1959     $format1 = "<tr><td>%s</td><td align=\"right\">%s</td><td align=\"right\">%d</td>";
1960   }
1961   else {
1962     print "Deliveries by transport\n";
1963     print "-----------------------";
1964     print "\n                      Volume    Messages\n";
1965     $format1 = "  %-18s  %6s      %6d";
1966   }
1967
1968   my($key);
1969   if ($merge_reports) {
1970     # We are getting our data from previous reports.
1971     foreach $key (sort keys %{$report_totals{transport}}) {
1972       my $count = get_report_total($report_totals{transport}{$key},'Messages');
1973       printf("$format1\n",$key,
1974         volume_rounded($report_totals{transport}{$key}{Volume},$report_totals{transport}{$key}{'Volume-gigs'}),
1975         $count);
1976       push(@chartdatanames, $key);
1977       push(@chartdatavals_count, $count);
1978       push(@chartdatavals_vol, $report_totals{transport}{$key}{'Volume-gigs'}*$gig + $report_totals{transport}{$key}{Volume} );
1979     }
1980   }
1981   else {
1982     # We are getting our data from mainlog files.
1983     foreach $key (sort keys %transported_data) {
1984       printf("$format1\n",$key,
1985         volume_rounded($transported_data{$key},$transported_data_gigs{$key}),
1986         $transported_count{$key});
1987       push(@chartdatanames, $key);
1988       push(@chartdatavals_count, $transported_count{$key});
1989       push(@chartdatavals_vol, $transported_data_gigs{$key}*$gig + $transported_data{$key});
1990     }
1991   }
1992   if ($html) {
1993     print "</table>\n";
1994     print "</td><td>\n";
1995     if ($HAVE_GD_Graph_pie && $charts)
1996       {
1997       # calculate the graph
1998       my @data = (
1999          \@chartdatanames,
2000          \@chartdatavals_count
2001       );
2002       my $graph = GD::Graph::pie->new(200, 200);
2003       $graph->set(
2004           x_label           => 'Transport',
2005           y_label           => 'Messages',
2006           title             => 'By count',
2007       );
2008       my $gd = $graph->plot(\@data) or warn($graph->error);
2009       if ($gd) {
2010         open(IMG, ">$chartdir/transports_count.png") or die $!;
2011         binmode IMG;
2012         print IMG $gd->png;
2013         close IMG;
2014         print "<img src=\"$chartrel/transports_count.png\">";
2015       }
2016     }
2017     print "</td><td>\n";
2018
2019     if ($HAVE_GD_Graph_pie && $charts) {
2020       my @data = (
2021          \@chartdatanames,
2022          \@chartdatavals_vol
2023       );
2024       my $graph = GD::Graph::pie->new(200, 200);
2025       $graph->set(
2026           title             => 'By volume',
2027       );
2028       my $gd = $graph->plot(\@data) or warn($graph->error);
2029       if ($gd) {
2030         open(IMG, ">$chartdir/transports_vol.png") or die $!;
2031         binmode IMG;
2032         print IMG $gd->png;
2033         close IMG;
2034         print "<img src=\"$chartrel/transports_vol.png\">";
2035       }
2036     }
2037     print "</td></tr></table>\n";
2038   }
2039   print "\n";
2040 }
2041
2042
2043
2044 #######################################################################
2045 # print_relay();
2046 #
2047 #  print_relay();
2048 #
2049 # Print our totals by relay.
2050 #######################################################################
2051 sub print_relay {
2052   my $temp = "Relayed messages";
2053   print "<hr><a name=\"$temp\"></a><h2>$temp</h2>\n" if $html;
2054   if (scalar(keys %relayed) > 0 || $relayed_unshown > 0) {
2055     my $shown = 0;
2056     my $spacing = "";
2057     my($format);
2058
2059     if ($html) {
2060       print "<table border=1>\n";
2061       print "<tr><th>Count</th><th>From</th><th>To</th>\n";
2062       $format = "<tr><td align=\"right\">%d</td><td>%s</td><td>%s</td>\n";
2063     }
2064     else {
2065       printf("%s\n%s\n\n", $temp, "-" x length($temp));
2066       $format = "%7d %s\n      => %s\n";
2067     }
2068
2069     my($key);
2070     foreach $key (sort keys %relayed) {
2071       my $count = $relayed{$key};
2072       $shown += $count;
2073       $key =~ s/[HA]=//g;
2074       my($one,$two) = split(/=> /, $key);
2075       printf($format, $count, $one, $two);
2076       $spacing = "\n";
2077     }
2078     print "</table>\n<p>\n" if $html;
2079     print "${spacing}Total: $shown (plus $relayed_unshown unshown)\n";
2080   }
2081   else {
2082     print "No relayed messages\n";
2083     print "-------------------\n" unless $html;
2084   }
2085   print "\n";
2086 }
2087
2088
2089
2090 #######################################################################
2091 # print_errors();
2092 #
2093 #  print_errors();
2094 #
2095 # Print our errors. In HTML, we display them as a list rather than a table -
2096 # Netscape doesn't like large tables!
2097 #######################################################################
2098 sub print_errors {
2099   my $total_errors = 0;
2100
2101   if (scalar(keys %errors_count) != 0) {
2102     my $temp = "List of errors";
2103     my($format);
2104     if ($html) {
2105       print "<hr><a name=\"errors\"></a><h2>$temp</h2>\n";
2106       print "<ul><li><b>Count - Error</b>\n";
2107       $format = "<li>%d - %s\n";
2108     }
2109     else {
2110       printf("%s\n%s\n\n", $temp, "-" x length($temp));
2111     }
2112
2113     my($key);
2114     foreach $key (sort keys %errors_count) {
2115       my $text = $key;
2116       chomp($text);
2117       $text =~ s/\s\s+/ /g;     #Convert multiple spaces to a single space.
2118       $total_errors += $errors_count{$key};
2119       if ($html) {
2120
2121         #Translate HTML tag characters. Sergey Sholokh.
2122         $text =~ s/\</\&lt\;/g;
2123         $text =~ s/\>/\&gt\;/g;
2124
2125         printf($format,$errors_count{$key},$text);
2126       }
2127       else {
2128         printf("%5d ", $errors_count{$key});
2129         while (length($text) > 65) {
2130           my($first,$rest) = $text =~ /(.{50}\S*)\s+(.+)/;
2131           last if !$first;
2132           printf("%s\n      ", $first);
2133           $text = $rest;
2134         }
2135         printf("%s\n\n", $text);
2136       }
2137     }
2138     print "</ul>\n<p>\n" if $html;
2139
2140     $temp = "Errors encountered: $total_errors";
2141     print $temp,"\n";
2142     print "-" x length($temp),"\n" unless $html;
2143   }
2144
2145 }
2146
2147
2148 #######################################################################
2149 # parse_old_eximstat_reports();
2150 #
2151 #  parse_old_eximstat_reports($fh);
2152 #
2153 # Parse old eximstat output so we can merge daily stats to weekly stats and weekly to monthly etc.
2154 #
2155 # To test that the merging still works after changes, do something like the following.
2156 # All the diffs should produce no output.
2157 #
2158 #  options='-bydomain -byemail -byhost -byedomain'
2159 #  options="$options -pattern 'Completed Messages' /Completed/"
2160 #  options="$options -pattern 'Received Messages' /<=/"
2161 #
2162 #  ./eximstats $options mainlog > mainlog.txt
2163 #  ./eximstats $options -merge mainlog.txt > mainlog.2.txt
2164 #  diff mainlog.txt mainlog.2.txt
2165 #
2166 #  ./eximstats $options -html mainlog > mainlog.html
2167 #  ./eximstats $options -merge -html mainlog.txt  > mainlog.2.html
2168 #  diff mainlog.html mainlog.2.html
2169 #
2170 #  ./eximstats $options -merge mainlog.html > mainlog.3.txt
2171 #  diff mainlog.txt mainlog.3.txt
2172 #
2173 #  ./eximstats $options -merge -html mainlog.html > mainlog.3.html
2174 #  diff mainlog.html mainlog.3.html
2175 #
2176 #  ./eximstats $options -nvr   mainlog > mainlog.nvr.txt
2177 #  ./eximstats $options -merge mainlog.nvr.txt > mainlog.4.txt
2178 #  diff mainlog.txt mainlog.4.txt
2179 #
2180 #  # double_mainlog.txt should have twice the values that mainlog.txt has.
2181 #  ./eximstats $options mainlog mainlog > double_mainlog.txt
2182 #######################################################################
2183 sub parse_old_eximstat_reports {
2184   my($fh) = @_;
2185
2186   my(%league_table_value_entered, %league_table_value_was_zero, %table_order);
2187
2188   while (<$fh>) {
2189     if (/Exim statistics from ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?) to ([\d\-]+ [\d:]+(\s+[\+\-]\d+)?)/) {
2190       $begin = $1 if ($1 lt $begin);
2191       $end   = $3 if ($3 gt $end);
2192     }
2193     elsif (/Grand total summary/) {
2194       # Fill in $report_totals{Received|Delivered}{Volume|Messages|Hosts|Domains|...|Delayed|DelayedPercent|Failed|FailedPercent}
2195       my(@fields);
2196       while (<$fh>) {
2197         $_ = html2txt($_);              #Convert general HTML markup to text.
2198         s/At least one addr//g;         #Another part of the HTML output we don't want.
2199
2200 #  TOTAL               Volume    Messages    Hosts Domains      Delayed       Failed
2201 #  Received              26MB         237      177      23       8  3.4%     28 11.8%
2202 #  Delivered             13MB         233       99      88
2203         if (/TOTAL\s+(.*?)\s*$/) {
2204           @fields = split(/\s+/,$1);
2205           #Delayed and Failed have two columns each, so add the extra field names in.
2206           splice(@fields,-1,1,'DelayedPercent','Failed','FailedPercent');
2207         }
2208         elsif (/(Received|Delivered)\s+(.*?)\s*$/) {
2209           print STDERR "Parsing $_" if $debug;
2210           add_to_totals($report_totals{$1},\@fields,$2);
2211         }
2212         last if (/Delivered/);          #Last line of this section.
2213       }
2214     }
2215
2216     elsif (/User Specified Patterns/i) {
2217 #User Specified Patterns
2218 #-----------------------
2219 #                       Total
2220 #  Description             85
2221
2222       while (<$fh>) { last if (/Total/); }      #Wait until we get the table headers.
2223       while (<$fh>) {
2224         print STDERR "Parsing $_" if $debug;
2225         $_ = html2txt($_);              #Convert general HTML markup to text.
2226         if (/^\s*(.*?)\s+(\d+)\s*$/) {
2227           $report_totals{patterns}{$1} = {} unless (defined $report_totals{patterns}{$1});
2228           add_to_totals($report_totals{patterns}{$1},['Total'],$2);
2229         }
2230         last if (/^\s*$/);                      #Finished if we have a blank line.
2231       }
2232     }
2233
2234     elsif (/Deliveries by transport/i) {
2235 #Deliveries by transport
2236 #-----------------------
2237 #                      Volume    Messages
2238 #  :blackhole:           70KB          51
2239 #  address_pipe         655KB           1
2240 #  smtp                  11MB         151
2241
2242       while (<$fh>) { last if (/Volume/); }     #Wait until we get the table headers.
2243       while (<$fh>) {
2244         print STDERR "Parsing $_" if $debug;
2245         $_ = html2txt($_);              #Convert general HTML markup to text.
2246         if (/(\S+)\s+(\d+\S*\s+\d+)/) {
2247           $report_totals{transport}{$1} = {} unless (defined $report_totals{transport}{$1});
2248           add_to_totals($report_totals{transport}{$1},['Volume','Messages'],$2);
2249         }
2250         last if (/^\s*$/);                      #Finished if we have a blank line.
2251       }
2252     }
2253     elsif (/(Messages received|Deliveries) per/) {
2254 #      Messages received per hour (each dot is 2 messages)
2255 #---------------------------------------------------
2256 #
2257 #00-01    106 .....................................................
2258 #01-02    103 ...................................................
2259
2260       # Set a pointer to the interval array so we can use the same code
2261       # block for both messages received and delivered.
2262       my $interval_aref = ($1 eq 'Deliveries') ? \@delivered_interval_count : \@received_interval_count;
2263       my $reached_table = 0;
2264       while (<$fh>) {
2265         $reached_table = 1 if (/^00/);
2266         next unless $reached_table;
2267         print STDERR "Parsing $_" if $debug;
2268         if (/^(\d+):(\d+)\s+(\d+)/) {           #hh:mm start time format ?
2269           $$interval_aref[($1*60 + $2)/$hist_interval] += $3 if $hist_opt;
2270         }
2271         elsif (/^(\d+)-(\d+)\s+(\d+)/) {        #hh-hh start-end time format ?
2272           $$interval_aref[($1*60)/$hist_interval] += $3 if $hist_opt;
2273         }
2274         else {                                  #Finished the table ?
2275           last;
2276         }
2277       }
2278     }
2279
2280     elsif (/Time spent on the queue: (all messages|messages with at least one remote delivery)/) {
2281 #Time spent on the queue: all messages
2282 #-------------------------------------
2283 #
2284 #Under   1m      217  91.9%   91.9%
2285 #        5m        2   0.8%   92.8%
2286 #        3h        8   3.4%   96.2%
2287 #        6h        7   3.0%   99.2%
2288 #       12h        2   0.8%  100.0%
2289
2290       # Set a pointer to the queue bin so we can use the same code
2291       # block for both all messages and remote deliveries.
2292       my $bin_aref = ($1 eq 'all messages') ? \@queue_bin : \@remote_queue_bin;
2293       my $reached_table = 0;
2294       while (<$fh>) {
2295         $_ = html2txt($_);              #Convert general HTML markup to text.
2296         $reached_table = 1 if (/^\s*Under/);
2297         next unless $reached_table;
2298         my $previous_seconds_on_queue = 0;
2299         if (/^\s*(Under|Over|)\s+(\d+[smhdw])\s+(\d+)/) {
2300           print STDERR "Parsing $_" if $debug;
2301           my($modifier,$formated_time,$count) = ($1,$2,$3);
2302           my $seconds = unformat_time($formated_time);
2303           my $time_on_queue = ($seconds + $previous_seconds_on_queue) / 2;
2304           $previous_seconds_on_queue = $seconds;
2305           $time_on_queue = $seconds * 2 if ($modifier eq 'Over');
2306           my($i);
2307           for ($i = 0; $i <= $#queue_times; $i++) {
2308             if ($time_on_queue < $queue_times[$i]) {
2309               $$bin_aref[$i] += $count;
2310               last;
2311             }
2312           }
2313           # There's only one counter for messages going over the queue
2314           # times so make sure we only count it once.
2315           $queue_more_than += $count if (($bin_aref == \@queue_bin) && ($i > $#queue_times));
2316         }
2317         else {
2318           last;                                 #Finished the table ?
2319         }
2320       }
2321     }
2322
2323     elsif (/Relayed messages/) {
2324 #Relayed messages
2325 #----------------
2326 #
2327 #      1 addr.domain.com [1.2.3.4] a.user@domain.com
2328 #      => addr2.domain2.com [5.6.7.8] a2.user2@domain2.com
2329 #
2330 #<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>
2331
2332       my $reached_table = 0;
2333       my($count,$sender);
2334       while (<$fh>) {
2335         unless ($reached_table) {
2336           last if (/No relayed messages/);
2337           $reached_table = 1 if (/^\s*\d/ || />\d+</);
2338           next unless $reached_table;
2339         }
2340         if (/>(\d+)<.td><td>(.*?) ?<.td><td>(.*?)</) {
2341           update_relayed($1,$2,$3);
2342         }
2343         elsif (/^\s*(\d+)\s+(.*?)\s*$/) {
2344           ($count,$sender) = ($1,$2);
2345         }
2346         elsif (/=>\s+(.*?)\s*$/) {
2347           update_relayed($count,$sender,$1);
2348         }
2349         else {
2350           last;                                 #Finished the table ?
2351         }
2352       }
2353     }
2354
2355     elsif (/Top (.*?) by (message count|volume)/) {
2356 #Top 50 sending hosts by message count
2357 #-------------------------------------
2358 #
2359 #     48     1468KB   local
2360 # Could also have average values for HTML output.
2361 #     48     1468KB   30KB  local
2362
2363       my($category,$by_count_or_volume) = ($1,$2);
2364
2365       #As we show 2 views of each table (by count and by volume),
2366       #most (but not all) entries will appear in both tables.
2367       #Set up a hash to record which entries we have already seen
2368       #and one to record which ones we are seeing for the first time.
2369       if ($by_count_or_volume =~ /count/) {
2370         undef %league_table_value_entered;
2371         undef %league_table_value_was_zero;
2372         undef %table_order;
2373       }
2374
2375       #As this section processes multiple different table categories,
2376       #set up pointers to the hashes to be updated.
2377       my($count_href,$data_href,$data_gigs_href);
2378       if ($category =~ /local sender/) {
2379         $count_href      = \%received_count_user;
2380         $data_href       = \%received_data_user;
2381         $data_gigs_href  = \%received_data_gigs_user;
2382       }
2383       elsif ($category =~ /sending (\S+?)s?\b/) {
2384         #Top 50 sending (host|domain|email|edomain)s
2385         #Top sending (host|domain|email|edomain)
2386         $count_href      = \%{$received_count{"\u$1"}};
2387         $data_href       = \%{$received_data{"\u$1"}};
2388         $data_gigs_href  = \%{$received_data_gigs{"\u$1"}};
2389       }
2390       elsif ($category =~ /local destination/) {
2391         $count_href      = \%delivered_count_user;
2392         $data_href       = \%delivered_data_user;
2393         $data_gigs_href  = \%delivered_data_gigs_user;
2394       }
2395       elsif ($category =~ /(\S+) destination/) {
2396         #Top 50 (host|domain|email|edomain) destinations
2397         #Top (host|domain|email|edomain) destination
2398         $count_href      = \%{$delivered_count{"\u$1"}};
2399         $data_href       = \%{$delivered_data{"\u$1"}};
2400         $data_gigs_href  = \%{$delivered_data_gigs{"\u$1"}};
2401       }
2402
2403       my $reached_table = 0;
2404       while (<$fh>) {
2405         $_ = html2txt($_);              #Convert general HTML markup to text.
2406         $reached_table = 1 if (/^\s*\d/);
2407         next unless $reached_table;
2408
2409         # Remove optional 'average value' column.
2410         s/^\s*(\d+)\s+(\S+)\s+(\d+(KB|MB|GB|\b)\s+)/$1 $2 /;
2411
2412         if (/^\s*(\d+)\s+(\S+)\s*(.*?)\s*$/) {
2413           my($count,$rounded_volume,$entry) = ($1,$2,$3);
2414           #Note: $entry fields can be both null and can contain spaces.
2415
2416           #Add the entry into the %table_order hash if it has a rounded volume (KB/MB/GB).
2417           push(@{$table_order{$rounded_volume}{$by_count_or_volume}},$entry) if ($rounded_volume =~ /\D/);
2418
2419           unless ($league_table_value_entered{$entry}) {
2420             $league_table_value_entered{$entry} = 1;
2421             unless ($$count_href{$entry}) {
2422               $$count_href{$entry}     = 0;
2423               $$data_href{$entry}      = 0;
2424               $$data_gigs_href{$entry} = 0;
2425               $league_table_value_was_zero{$entry} = 1;
2426             }
2427
2428             $$count_href{$entry} += $count;
2429             #Add the rounded value to the data and data_gigs hashes.
2430             un_round($rounded_volume,\$$data_href{$entry},\$$data_gigs_href{$entry});
2431             print STDERR "$category by $by_count_or_volume: added $count,$rounded_volume to $entry\n" if $debug;
2432           }
2433         }
2434         else {          #Finished the table ?
2435           if ($by_count_or_volume =~ /volume/) {
2436             #Add a few bytes to appropriate entries to preserve the order.
2437
2438             my($rounded_volume);
2439             foreach $rounded_volume (keys %table_order) {
2440               #For each rounded volume, we want to create a list which has things
2441               #ordered from the volume table at the front, and additional things
2442               #from the count table ordered at the back.
2443               @{$table_order{$rounded_volume}{volume}} = () unless defined $table_order{$rounded_volume}{volume};
2444               @{$table_order{$rounded_volume}{'message count'}} = () unless defined $table_order{$rounded_volume}{'message count'};
2445               my(@order,%mark);
2446               map {$mark{$_} = 1} @{$table_order{$rounded_volume}{volume}};
2447               @order = @{$table_order{$rounded_volume}{volume}};
2448               map {push(@order,$_)} grep(!$mark{$_},@{$table_order{$rounded_volume}{'message count'}});
2449
2450               my $bonus_bytes = $#order;
2451               $bonus_bytes = 511 if ($bonus_bytes > 511);       #Don't go over the half-K boundary!
2452               while (@order and ($bonus_bytes > 0)) {
2453                 my $entry = shift(@order);
2454                 if ($league_table_value_was_zero{$entry}) {
2455                   $$data_href{$entry} += $bonus_bytes;
2456                   print STDERR "$category by $by_count_or_volume: added $bonus_bytes bonus bytes to $entry\n" if $debug;
2457                 }
2458                 $bonus_bytes--;
2459               }
2460             }
2461           }
2462
2463           last;
2464         }
2465       }
2466     }
2467     elsif (/List of errors/) {
2468 #List of errors
2469 #--------------
2470 #
2471 #    1 07904931641@one2one.net R=external T=smtp: SMTP error
2472 #            from remote mailer after RCPT TO:<07904931641@one2one.net>:
2473 #            host mail.one2one.net [193.133.192.24]: 550 User unknown
2474 #
2475 #<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>
2476
2477
2478       my $reached_table = 0;
2479       my($count,$error,$blanks);
2480       while (<$fh>) {
2481         $reached_table = 1 if (/^( *|<li>)(\d+)/);
2482         next unless $reached_table;
2483
2484         s/^<li>(\d+) -/$1/;     #Convert an HTML line to a text line.
2485         $_ = html2txt($_);      #Convert general HTML markup to text.
2486
2487         if (/\t\s*(.*)/) {
2488           $error .= ' ' . $1;   #Join a multiline error.
2489         }
2490         elsif (/^\s*(\d+)\s+(.*)/) {
2491           if ($error) {
2492             #Finished with a previous multiline error so save it.
2493             $errors_count{$error} = 0 unless $errors_count{$error};
2494             $errors_count{$error} += $count;
2495           }
2496           ($count,$error) = ($1,$2);
2497         }
2498         elsif (/Errors encountered/) {
2499           if ($error) {
2500             #Finished the section, so save our stored last error.
2501             $errors_count{$error} = 0 unless $errors_count{$error};
2502             $errors_count{$error} += $count;
2503           }
2504           last;
2505         }
2506       }
2507     }
2508
2509   }
2510 }
2511
2512
2513
2514 #######################################################################
2515 # update_relayed();
2516 #
2517 #  update_relayed($count,$sender,$recipient);
2518 #
2519 # Adds an entry into the %relayed hash. Currently only used when
2520 # merging reports.
2521 #######################################################################
2522 sub update_relayed {
2523   my($count,$sender,$recipient) = @_;
2524
2525   #When generating the key, put in the 'H=' and 'A=' which can be used
2526   #in searches.
2527   my $key = "H=$sender => H=$recipient";
2528   $key =~ s/ ([^=\s]+\@\S+|<>)/ A=$1/g;
2529   if (!defined $relay_pattern || $key !~ /$relay_pattern/o) {
2530     $relayed{$key} = 0 if !defined $relayed{$key};
2531     $relayed{$key} += $count;
2532   }
2533   else {
2534     $relayed_unshown += $count;
2535   }
2536 }
2537
2538
2539 #######################################################################
2540 # add_to_totals();
2541 #
2542 #  add_to_totals(\%totals,\@keys,$values);
2543 #
2544 # Given a line of space seperated values, add them into the provided hash using @keys
2545 # as the hash keys.
2546 #
2547 # If the value contains a '%', then the value is set rather than added. Otherwise, we
2548 # convert the value to bytes and gigs. The gigs get added to I<Key>-gigs.
2549 #######################################################################
2550 sub add_to_totals {
2551   my($totals_href,$keys_aref,$values) = @_;
2552   my(@values) = split(/\s+/,$values);
2553   my(@keys) = @$keys_aref;              #Make a copy as we destroy the one we use.
2554   my($value);
2555   foreach $value (@values) {
2556     my $key = shift(@keys) or next;
2557     if ($value =~ /%/) {
2558       $$totals_href{$key} = $value;
2559     }
2560     else {
2561       $$totals_href{$key} = 0 unless ($$totals_href{$key});
2562       $$totals_href{"$key-gigs"} = 0 unless ($$totals_href{"$key-gigs"});
2563       un_round($value, \$$totals_href{$key}, \$$totals_href{"$key-gigs"});
2564       print STDERR "Added $value to $key - $$totals_href{$key} , " . $$totals_href{"$key-gigs"} . "GB.\n" if $debug;
2565     }
2566   }
2567 }
2568
2569 #######################################################################
2570 # get_report_total();
2571 #
2572 #  $total = get_report_total(\%hash,$key);
2573 #
2574 # If %hash contains values split into Units and Gigs, we calculate and return
2575 #
2576 #   $hash{$key} + 1024*1024*1024 * $hash{"${key}-gigs"}
2577 #######################################################################
2578 sub get_report_total {
2579   no integer;
2580   my($hash_ref,$key) = @_;
2581   if ($$hash_ref{"${key}-gigs"}) {
2582     return $$hash_ref{$key} + $gig * $$hash_ref{"${key}-gigs"};
2583   }
2584   return $$hash_ref{$key} || 0;
2585 }
2586
2587 #######################################################################
2588 # html2txt();
2589 #
2590 #  $text_line = html2txt($html_line);
2591 #
2592 # Convert a line from html to text. Currently we just convert HTML tags to spaces
2593 # and convert &gt;, &lt;, and &nbsp; tags back.
2594 #######################################################################
2595 sub html2txt {
2596   ($_) = @_;
2597
2598   # Convert HTML tags to spacing. Note that the reports may contain <Userid> and
2599   # <Userid@Domain> words, so explicitly specify the HTML tags we will remove
2600   # (the ones used by this program). If someone is careless enough to have their
2601   # Userid the same as an HTML tag, there's not much we can do about it.
2602   s/<\/?(html|head|title|body|h\d|ul|li|a\s+|table|tr|td|th|pre|hr|p|br)\b.*?>/ /og;
2603
2604   s/\&lt\;/\</og;             #Convert '&lt;' to '<'.
2605   s/\&gt\;/\>/og;             #Convert '&gt;' to '>'.
2606   s/\&nbsp\;/ /og;            #Convert '&nbsp;' to ' '.
2607   return($_);
2608 }
2609
2610 #######################################################################
2611 # get_next_arg();
2612 #
2613 #  $arg = get_next_arg();
2614 #
2615 # Because eximstats arguments are often passed as variables,
2616 # we can't rely on shell parsing to deal with quotes. This
2617 # subroutine returns $ARGV[1] and does a shift. If $ARGV[1]
2618 # starts with a quote (' or "), and doesn't end in one, then
2619 # we append the next argument to it and shift again. We repeat
2620 # until we've got all of the argument.
2621 #
2622 # This isn't perfect as all white space gets reduced to one space,
2623 # but it's as good as we can get! If it's esential that spacing
2624 # be preserved precisely, then you get that by not using shell
2625 # variables.
2626 #######################################################################
2627 sub get_next_arg {
2628   my $arg = '';
2629   my $matched_pattern = 0;
2630   while ($ARGV[1]) {
2631     $arg .= ' ' if $arg;
2632     $arg .= $ARGV[1]; shift(@ARGV);
2633     if ($arg !~ /^['"]/) {
2634       $matched_pattern = 1;
2635       last;
2636     }
2637     if ($arg =~ s/^(['"])(.*)\1$/$2/) {
2638       $matched_pattern = 1;
2639       last;
2640     }
2641   }
2642   die "Mismatched argument quotes - <$arg>.\n" unless $matched_pattern;
2643   return $arg;
2644 }
2645
2646
2647
2648 ##################################################
2649 #                 Main Program                   #
2650 ##################################################
2651
2652
2653 $last_timestamp = '';
2654 $last_date = '';
2655 $show_errors = 1;
2656 $show_relay = 1;
2657 $show_transport = 1;
2658 $topcount = 50;
2659 $local_league_table = 1;
2660 $include_remote_users = 0;
2661 $hist_opt = 1;
2662 $volume_rounding = 1;
2663 $localtime_offset = calculate_localtime_offset();    # PH/FANF
2664
2665 $charts = 0;
2666 $charts_option_specified = 0;
2667 $chartrel = ".";
2668 $chartdir = ".";
2669
2670 @queue_times = (60, 5*60, 15*60, 30*60, 60*60, 3*60*60, 6*60*60,
2671                 12*60*60, 24*60*60);
2672
2673 $last_offset = '';
2674 $offset_seconds = 0;
2675
2676 # Decode options
2677
2678 while (@ARGV > 0 && substr($ARGV[0], 0, 1) eq '-')
2679   {
2680   if    ($ARGV[0] =~ /^\-h(\d+)$/) { $hist_opt = $1 }
2681   elsif ($ARGV[0] =~ /^\-ne$/)     { $show_errors = 0 }
2682   elsif ($ARGV[0] =~ /^\-nr(.?)(.*)\1$/)
2683     {
2684     if ($1 eq "") { $show_relay = 0 } else { $relay_pattern = $2 }
2685     }
2686   elsif ($ARGV[0] =~ /^\-q([,\d\+\-\*\/]+)$/)
2687     {
2688     @queue_times = split(/,/, $1);
2689     my($q);
2690     foreach $q (@queue_times) { $q = eval($q) + 0 }
2691     @queue_times = sort { $a <=> $b } @queue_times;
2692     @queue_times = () if ($#queue_times == 0 && $queue_times[0] == 0);
2693     }
2694   elsif ($ARGV[0] =~ /^-nt$/)       { $show_transport = 0 }
2695   elsif ($ARGV[0] =~ /^\-nt(.?)(.*)\1$/)
2696     {
2697     if ($1 eq "") { $show_transport = 0 } else { $transport_pattern = $2 }
2698     }
2699   elsif ($ARGV[0] =~ /^-t(\d+)$/)   { $topcount = $1 }
2700   elsif ($ARGV[0] =~ /^-tnl$/)      { $local_league_table = 0 }
2701   elsif ($ARGV[0] =~ /^-html$/)     { $html = 1 }
2702   elsif ($ARGV[0] =~ /^-merge$/)    { $merge_reports = 1 }
2703   elsif ($ARGV[0] =~ /^-charts$/)   {
2704     $charts = 1;
2705     warn "WARNING: CPAN Module GD::Graph::pie not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_pie;
2706     warn "WARNING: CPAN Module GD::Graph::linespoints not installed. Obtain from www.cpan.org\n" unless $HAVE_GD_Graph_linespoints;
2707   }
2708   elsif ($ARGV[0] =~ /^-chartdir$/) { $chartdir = $ARGV[1]; shift; $charts_option_specified = 1; }
2709   elsif ($ARGV[0] =~ /^-chartrel$/) { $chartrel = $ARGV[1]; shift; $charts_option_specified = 1; }
2710   elsif ($ARGV[0] =~ /^-cache$/)    { } #Not currently used.
2711   elsif ($ARGV[0] =~ /^-byhost$/)   { $do_sender{Host} = 1 }
2712   elsif ($ARGV[0] =~ /^-bydomain$/) { $do_sender{Domain} = 1 }
2713   elsif ($ARGV[0] =~ /^-byemail$/)  { $do_sender{Email} = 1 }
2714   elsif ($ARGV[0] =~ /^-byemaildomain$/)  { $do_sender{Edomain} = 1 }
2715   elsif ($ARGV[0] =~ /^-byedomain$/)  { $do_sender{Edomain} = 1 }
2716   elsif ($ARGV[0] =~ /^-nvr$/)      { $volume_rounding = 0 }
2717   elsif ($ARGV[0] =~ /^-d$/)        { $debug = 1 }
2718   elsif ($ARGV[0] =~ /^--?h(elp)?$/){ help() }
2719   elsif ($ARGV[0] =~ /^-t_remote_users$/) { $include_remote_users = 1 }
2720   elsif ($ARGV[0] =~ /^-pattern$/)
2721     {
2722     push(@user_descriptions,get_next_arg());
2723     push(@user_patterns,get_next_arg());
2724     }
2725   elsif ($ARGV[0] =~ /^-utc$/)
2726     {
2727     # We don't need this value if the log is in UTC.
2728     $localtime_offset = undef;
2729     }
2730   else
2731     {
2732     print STDERR "Eximstats: Unknown or malformed option $ARGV[0]\n";
2733     help();
2734     }
2735   shift;
2736   }
2737
2738   # Check that all the charts options are specified.
2739   warn "-charts option not specified. Use -help for help.\n" if ($charts_option_specified && ! $charts);
2740
2741   # Default to display tables by sending Host.
2742   $do_sender{Host} = 1 unless ($do_sender{Domain} || $do_sender{Email} || $do_sender{Edomain});
2743
2744
2745 for (my $i = 0; $i <= $#queue_times; $i++) {
2746   $queue_bin[$i] = 0;
2747   $remote_queue_bin[$i] = 0;
2748 }
2749
2750 # Compute the number of slots for the histogram
2751
2752 if ($hist_opt > 0)
2753   {
2754   if ($hist_opt > 60 || 60 % $hist_opt != 0)
2755     {
2756     print "Eximstats: -h must specify a factor of 60\n";
2757     exit 1;
2758     }
2759   $hist_interval = 60/$hist_opt;                #Interval in minutes.
2760   $hist_number = (24*60)/$hist_interval;        #Number of intervals per day.
2761   @received_interval_count = (0) x $hist_number;
2762   @delivered_interval_count = (0) x $hist_number;
2763   }
2764
2765 #$queue_unknown = 0;
2766
2767 $total_received_data = 0;
2768 $total_received_data_gigs = 0;
2769 $total_received_count = 0;
2770
2771 $total_delivered_data = 0;
2772 $total_delivered_data_gigs = 0;
2773 $total_delivered_count = 0;
2774
2775 $queue_more_than = 0;
2776 $delayed_count = 0;
2777 $relayed_unshown = 0;
2778 $begin = "9999-99-99 99:99:99";
2779 $end = "0000-00-00 00:00:00";
2780 my($section,$type);
2781 foreach $section ('Received','Delivered') {
2782   foreach $type ('Volume','Messages','Delayed','Failed','Hosts','Domains','Emails','Edomains') {
2783     $report_totals{$section}{$type} = 0;
2784   }
2785 }
2786
2787 # Generate our parser.
2788 my $parser = generate_parser();
2789
2790
2791
2792 if (@ARGV) {
2793   # Scan the input files and collect the data
2794   foreach my $file (@ARGV) {
2795     if ($file =~ /\.gz/) {
2796       unless (open(FILE,"gunzip -c $file |")) {
2797         print STDERR "Failed to gunzip -c $file: $!";
2798         next;
2799       }
2800     }
2801     elsif ($file =~ /\.Z/) {
2802       unless (open(FILE,"uncompress -c $file |")) {
2803         print STDERR "Failed to uncompress -c $file: $!";
2804         next;
2805       }
2806     }
2807     else {
2808       unless (open(FILE,$file)) {
2809         print STDERR "Failed to read $file: $!";
2810         next;
2811       }
2812     }
2813     #Now parse the filehandle, updating the global variables.
2814     parse($parser,\*FILE);
2815     close FILE;
2816   }
2817 }
2818 else {
2819   #No files provided. Parse STDIN, updating the global variables.
2820   parse($parser,\*STDIN);
2821 }
2822
2823
2824 if ($begin eq "9999-99-99 99:99:99") {
2825   print "**** No valid log lines read\n";
2826   exit 1;
2827 }
2828
2829 # Output our results.
2830 print_header();
2831 print_grandtotals();
2832
2833 # Print counts of user specified patterns if required.
2834 print_user_patterns() if @user_patterns;
2835
2836 # Print totals by transport if required.
2837 print_transport() if $show_transport;
2838
2839 # Print the deliveries per interval as a histogram, unless configured not to.
2840 # First find the maximum in one interval and scale accordingly.
2841 if ($hist_opt > 0) {
2842   print_histogram("Messages received", @received_interval_count);
2843   print_histogram("Deliveries", @delivered_interval_count);
2844 }
2845
2846 # Print times on queue if required.
2847 if ($#queue_times >= 0) {
2848   print_queue_times("all messages", \@queue_bin,$queue_more_than);
2849   print_queue_times("messages with at least one remote delivery",\@remote_queue_bin,$queue_more_than);
2850 }
2851
2852 # Print relay information if required.
2853 print_relay() if $show_relay;
2854
2855 # Print the league tables, if topcount isn't zero.
2856 if ($topcount > 0) {
2857   foreach ('Host','Domain','Email','Edomain') {
2858     next unless $do_sender{$_};
2859     print_league_table("sending \l$_", $received_count{$_}, $received_data{$_},$received_data_gigs{$_});
2860   }
2861
2862   print_league_table("local sender", \%received_count_user,
2863     \%received_data_user,\%received_data_gigs_user) if ($local_league_table || $include_remote_users);
2864   foreach ('Host','Domain','Email','Edomain') {
2865     next unless $do_sender{$_};
2866     print_league_table("\l$_ destination", $delivered_count{$_}, $delivered_data{$_},$delivered_data_gigs{$_});
2867   }
2868   print_league_table("local destination", \%delivered_count_user,
2869     \%delivered_data_user,\%delivered_data_gigs_user) if ($local_league_table || $include_remote_users);
2870 }
2871
2872 # Print the error statistics if required.
2873 print_errors() if $show_errors;
2874
2875 if ($html) {
2876   print "</body>\n</html>\n"
2877 }
2878
2879 # End of eximstats