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