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