src/src/eximstats.src

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