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