src/src/eximstats.src

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