#!/usr/bin/perl -w

#############################################################################
#
# This script provides daily SpamFilter statistics and deletes all users
# junkmails. Configuration of the script is done by the Spam Filter
# Server-Manager module
# 
# April 2006 - no longer controlled by server manager, and does not delete files
#
# This script has been developed
# by Jesper Knudsen at http://sme.swerts-knudsen.dk
#
# Revision History:
#
# August 13, 2003: Initial version
# August 25, 2004: fixed problem when hostname had no-ASCII chars
# March 23, 2006 Revised for sme7 RM
# March 27, 2006     ditto        BJR (http://www.abandonmicrosoft.co.uk)
#                  - Merged Clamav and SA stats
#                  - Moved all analysis to qsmtpd log
#                  - Removed parameterised interval (for simplicity - not sure of format anyway)
#                  - add in archived log files for people who have high turnover
#                  - Alter labels to be more accurate
#                  - Detect deleted spam (over threshold) without using spam score
#                  - Detect RBL rejections
#                  - Detect pattern (executible) rejections
#                  - Look for the DENY labels - add in Miscellaneous category
# April 6, 2006    - check qpsmtp log level and also DNS enable properties
#                  - Average spam scores for under and over threshold seperatly
#                  - Log tag and Reject levels
#                  - TBD - check that RBL DENY are being detected (I have no date to check this)
# April 7, 2007    - re-written by Charlie Brady totally in Perl
# April 16, 2006   - move warnings to report
#                  - Spot fetchmail deliveries
#                  - Spot Internal connections from client PCs
#                  - TBD check that RBL DENY are being detected (I have no data to check this)
# April 30, 2006   - Pascal Schirrmann Start Time and End Time to noon - should be a param
#                    so the script can be run at any time in the day.
#                  - adds 'by recipients domains' stats Useful for MX-Backup or multi domains hosts
#                  - Add a 'recipients per mail' stat. Useful : until now the sums are correct :-)
#                  - Correct some messages about rbl who can led to wrong entry in the config database
#                    ( and without expected results, of course !)
#                  - improve a regexp in the SPAM detection
# May 1, 2006      - BJR - Fix situation where mxbackup prop is not defined
#                   - fix a spelling and minor format of domain report 
# May 9, 2006      - bjr - Make RBL percentage a percentage of total connections (else it >100%) 
# May 9, 2006      - ps - some 'sanity check' in the 'per domains part of the stats (to avoid  / 0)
# May 12, 2006     - ps - some cleanup in the 'per domains' stats
#                  - Add a version number, logged in the mail 
# June 20, 2006    - bjr - Minor change to RBL instructions, and adjust domain table format
# Feb 19, 2007     - bjr - Adjust table lines oin a couple of places
#                  - bjr - and add documentation details about percentages etc
#                  - bjr - Alter misc to "non conforming" anmd accumulated these hourly
#                  - bjr - Express change over tag count to exclude spam rejected over threshold
#                  - bjr - Change "processsed" to "fully downloaded"
#                  - bjr - Change percentages so that they are all a percetnage of the total emails received 
# 0.6.1            - bjr - Change to use output from the logterse qpsmtpd plugin 
# 0.6.2            - bjr - Fix fetchmail tests
# 0.6.3            - bjr - adjust for log-items change in order 
# 0.6.4&5          - bjr - Adjust table formatting
# 0.6.6            - bjr - Take outgoing emails out of "others", add "Outgoing" and "Internal"
# 0.6.7            - bjr - Fix missing plugins/wrong names. pull invalid recipient out of deny msg for goodrcptto
# 0.6.8            - bjr - catch a few more plugin name failures
# 0.6.9            - bjr - Catch webmail and mailman
# 0.6.10           - bjr - Refine Webmail identification 
# 0.6.11           - bjr - Fix Webmail identification 
# 0.6.12           - bjr - split logterse line a bit more carefully (multiple sent to addresss with space and comma confuse it)
# 0.6.13           - bjr - add totals and percentages to bottom of the table
#                        - Generalise counts so that columns can be brought in and out 
#                        - control columns with Db entries
# 0.6.14           - bjr - Add in league tables of qpsmtpd codes and SA rules
#                        - Add in loglevel check
#                        - parameterise email address for report
# 0.6.15           - bjr - fix columns included in totals
#						 - sort out domains when more that one email address in recipient field
# 0.6.16	   	   - cfc - Fixed issue with previous day for the first day of the month. Initialized an array with empty values so that the script wouldn't issue warning messages when not all the fields were used.
# 0.6.17           - bjr - Add Average SA Scores to SA league table, and sort junkmail counts, sorted out xfererr for domains
#                        - Fixed multiple recipients for single emails
#
#  TODO
#  ----
#
#  Html output to ibay (ibay name as command line param or db entry) 
#  Save data to MySQL table, for later processing 
#
#############################################################################
#
#  SMEServer DB usage
#  ------------------
#
#  mailstats / Status ("enabled"|"disabled") 
#            / <column header> ("yes"|"no"|"auto") - enable, supress or only show if nonzero
#            / QpsmtpdCodes ("enabled"|"disabled")    
#            / SARules ("enabled"|"disabled") 
#            / JunkMailList  ("enabled"|"disabled") 
#            / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff
#            / Email (admin) - email to send report 
#
#
#
#
#############################################################################


# internal modules (part of core perl distribution)
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use POSIX qw/strftime floor/;
use Time::Local;
use Date::Manip;
use Time::TAI64;
use esmith::ConfigDB;
use esmith::DomainsDB;
use Sys::Hostname;
use Switch;

my $hostname = hostname();

#Configuration section
my %opt = ();

$opt{'version'}  = '0.6.17';                        # please update at each change.
$opt{'debug'}    = 0;                               # guess what ?
$opt{'sendmail'} = '/usr/sbin/sendmail';            # Path to sendmail stub
$opt{'from'}     = 'spamfilter-stats';              # Who is the mail from
$opt{'end'}      = `date --iso-8601`;               # midnight today
$opt{'start'} = UnixDate(DateCalc($opt{'end'},"- 24hours"),"%Y-%m-%d");
$opt{'timezone'} = `date +%z`;
Date_Init("TZ=$opt{'timezone'}");

my $FetchmailIP = '127.0.0.200';       #Apparent Ip address of fetchmail deliveries
my $WebmailIP = '127.0.0.1';           #Apparent Ip of Webmail sender
my $localhost = 'localhost';           #Apparent sender for webmail
my $FETCHMAIL = 'FETCHMAIL';    #Sender from fetchmail when Ip address not 127.0.0.200 - when qpsmtpd denies the email
my $MAILMAN = "bounces";        #sender when mailman sending when orig is localhost

my $MinCol = 8;                 #Minimum column width
my $HourColWidth = 16;			#Date and time column width

my $SARulethresholdPercent = 10;  #If Sa rules less than this of total emails, then cutoff reduced
my $maxcutoff = 1; #max percent cutoff applied
my $mincutoff = 0.2; #min percent cutoff applied

my $true = 1;
my $false = 0;

my $tstart = time;

#Local variables
my $YEAR = ( localtime(time) )[5];    # this is years since 1900

my $total         = 0;
my $spamcount     = 0;
my $spamavg       = 0;
my $hamcount      = 0;
my $hamavg        = 0;
my $rejectspamavg = 0;

my $Accepttotal      = 0;
my $localAccepttotal = 0;             #Fetchmail connections
my $localsendtotal   = 0;             #Connections from local PCs
my $totalexamined = 0;                #total download + RBL etc
my $WebMailsendtotal = 0;             #total from Webmail
my $mailmansendcount = 0;             #total from mailman

my %found_viruses = ();
my %found_qpcodes  = ();
my %found_SARules = ();

# replaced by...
my %counts = ();               		#Hold all counts in 2-D matrix
my @display = ();					#used to switch on and off columns  - yes, no or auto for each category 
my @colwidth = ();                  #width of each column
									#(auto means only if non zero) - populated from possible db entries
my @finaldisplay = ();              #final decision on display or not  - true or false
my $disabled;

#count column names, used for headings  - also used for DB mailstats property names
my $CATHOUR='Hour';
my $CATFETCHMAIL='Fetchmail';
my $CATWEBMAIL='WebMail';
my $CATMAILMAN='Mailman';
my $CATLOCAL='Local';
# border between where it came from and where it ended..
my $countfromhere = 5;

my $CATVIRUS='Virus';
my $CATRBLDNS='RBL/DNS';
my $CATEXECUT='Execut.';
my $CATNONCONF='Non.Conf.';
my $CATSPAMDEL='Del.Spam';
my $CATSPAM='Qued.Spam?';
my $CATHAM='Ham';
my $CATTOTALS='TOTALS';
my $CATPERCENT='PERCENT';
my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATNONCONF,$CATSPAMDEL,$CATSPAM,$CATHAM,$CATTOTALS,$CATPERCENT);
my $GRANDTOTAL = '99';            	#subs for count arrays, for grand total
my $PERCENT = '98';                 # for column percentages

my $categlen = @categs-2;  #-2 to avoid the total and percent column 

my $above15 = 0;
my $RBLcount  = 0;
my $MiscDenyCount = 0;
my $PatternFilterCount  = 0;
my $noninfectedcount = 0;
my $okemailcount     = 0;
my $infectedcount  = 0;
my $warnnoreject = " ";
my $rblnotset    = ' ';

my $FS = "\t";	# field separator used by logterse plugin
my %log_items = ("","","","","","","","");
my $score;
my %timestamp_items = ();
my $localflag = 0;        #indicate if current email is local or not
my $WebMailflag = 0;      #indicate if current mail is send from webmail

# some storage for by recipient domains stats (PS)
# my bad : I have to deal with multiple simoultaneous connections
# will play with the process number.
# my $currentrcptdomain = '' ;
my %currentrcptdomain ;      # temporay store the recipient domain until end of mail processing
my %byrcptdomain ;           # Store 'by domains stats'
my @extdomain ;              # only useful in some MX-Backup case, when any subdomains are allowed
my $recipcount = 0 ;         # count every recipient email address received.

# store the domain of interest. Every other records are stored in a 'Other' zone
my $ddb = esmith::DomainsDB->open_ro or die "Couldn't open DomainsDB : $!\n";
foreach my $domain( $ddb->get_all_by_prop( type => "domain" ) ) {
    $byrcptdomain{ $domain->key }{ 'type' }='local';
}
$byrcptdomain{ esmith::ConfigDB->open_ro->get('SystemName')->value . "."
               . esmith::ConfigDB->open_ro->get('DomainName')->value }{ 'type' } = 'local';
               
# is this system a MX-Backup ?
if (esmith::ConfigDB->open_ro->get('mxbackup')){
  if ( ( esmith::ConfigDB->open_ro->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) {
      my %MXValues = split( /,/, ( esmith::ConfigDB->open_ro->get('mxbackup')->prop('name') || '' ) ) ;
      foreach my $data ( keys %MXValues ) { 
  	$byrcptdomain{ $data }{ 'type' } = "mxbackup-$MXValues{ $data }" ;
           if ( $MXValues{ $data } == 1 ) { # subdomains allowed, must take care of this
     	      push @extdomain, $data ;
           }
       }
  }
}  

my ( $start, $end ) = parse_arg( $opt{'start'}, $opt{'end'} );

#
# First check current configuration for logging, DNS enable and Max threshold for spamassassin
#

my $LogLevel    = esmith::ConfigDB->open_ro->get('qpsmtpd')->prop('LogLevel');
my $HighLogLevel = ( $LogLevel > 6 );

my $RHSenabled =
  ( esmith::ConfigDB->open_ro->get('qpsmtpd')->prop('RHSBL') eq 'enabled' );
my $DNSenabled =
  ( esmith::ConfigDB->open_ro->get('qpsmtpd')->prop('DNSBL') eq 'enabled' );
my $SARejectLevel =
  esmith::ConfigDB->open_ro->get('spamassassin')->prop('RejectLevel');
my $SATagLevel =
  esmith::ConfigDB->open_ro->get('spamassassin')->prop('TagLevel');
my $DomainName = 
  esmith::ConfigDB->open_ro->get('DomainName')->value;
  
# check that logterse is in use
#my pluginfile = '/var/service/qpsmtpd/config/peers/0';

#and see if mailstats are disabled
if (esmith::ConfigDB->open_ro->get('mailstats')){
  $disabled = !((esmith::ConfigDB->open_ro->get('mailstats')->prop('Status') || 'enabled') eq 'enabled');
} else { 
  my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled' });
  $disabled = $false;
}  
# check mailstats email recipient
my $email = esmith::ConfigDB->open_ro->get('mailstats')->prop('Email') || 'admin';
$opt{'mail'} = $email;


if ( !$RHSenabled || !$DNSenabled ) {
    $rblnotset = '*';
}  

if ( $SARejectLevel == 0 ) {

    $warnnoreject = "(*Warning* 0 = no reject)";

}

#
#---------------------------------------
# Scan the qpsmtpd log file
#---------------------------------------


# Init the hashes
my $nhour = floor( $start / 3600 );
my $ncateg;
while ( $nhour < $end / 3600 ) {
  	$counts{$nhour}=();
    $ncateg = 0;
	while ( $ncateg < @categs) {
	  $counts{$nhour}{$categs[$ncateg-1]} = 0;
	  $ncateg++
	}  
	$nhour++;
}
# and grand totals and display status from db entries, and column widths
$ncateg = 0;
while ( $ncateg < @categs) {
  $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0;
  if (esmith::ConfigDB->open_ro->get('mailstats')){
    $display[$ncateg] = lc(esmith::ConfigDB->open_ro->get('mailstats')->prop($categs[$ncateg])) || "auto"; 
  } else {
    $display[$ncateg] = 'auto'
  }  
  if ($ncateg == 0) {
    $colwidth[$ncateg] = $HourColWidth    
  } else {
    $colwidth[$ncateg] = length($categs[$ncateg])+1
  }  
  if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol}
  $ncateg++
}  

my $starttai = Time::TAI64::unixtai64n($start);
my $endtai = Time::TAI64::unixtai64n($end);
my $sum_SARules = 0;

# MAIN LOOP STARTS HERE...
LINE: while (<>) {
    my($tai,$log) = split(' ',$_,2);
    

    #If date specified, only process lines matching date
    next LINE if ( $tai lt $starttai );
    last if ( $tai gt $endtai );

    # pull out spamasassin rule lists and accumulate SA scores
    if ($_ =~ m/spamassassin plugin: check_spam:.*hits=(.*), required.*tests=(.*)/) {
     my ($SAtests) = split(',',$2);
     foreach my $SAtest ($SAtests) {
       if (!$SAtest eq "") {     
         $found_SARules{$SAtest}{'count'}++;
         $found_SARules{$SAtest}{'totalhits'} += $1; 
         $sum_SARules++
       }  
     } 
    
    }
    #only select Logterse output
    next LINE unless m/terse plugin/;


    my $abstime = Time::TAI64::tai2unix($tai);
    my $abshour = floor( $abstime / 3600 );    # Hours since the epoch

 
    my ($timestamp_part, $log_part) = split('`',$_,2);  #bjr 0.6.12
    my (@log_items) = split $FS, $log_part;
    
    my (@timestamp_items) = split(' ',$timestamp_part);

    # we store the more recent recipient domain, for domain statistics
    # in fact, we only store the first recipient. Could be sort of headache
    # to obtain precise stats with many recipients on more than one domain !
	my $proc = $timestamp_items[1] ;  #numeric Id for the email

  	$totalexamined++;
   
	# first spot the fetchmail and local deliveries.
   
    # Spot from local workstation 
    $localflag = 0;
    $WebMailflag=0;
    if ($log_items[1] =~ m/.*$DomainName.*/) {$localsendtotal++;$counts{$abshour}{$CATLOCAL}++;$localflag=1}
    # see if from localhost
    elsif ($log_items[1] =~ m/.*$localhost.*/){
      # but not if it comes from fetchmail
      if ($log_items[3] =~ m/.*$FETCHMAIL.*/){}
      else {
      # might still be from mailman here
        if ($log_items[3] =~ m/.*$MAILMAN.*/){$mailmansendcount++;$localsendtotal++;$counts{$abshour}{$CATMAILMAN}++;$localflag=1}
        else {
          # eliminate incoming localhost spoofs 
          if ($log_items[8] =~ m/.*msg denied before queued.*/){}
            else {$localflag = 1;$WebMailsendtotal++;$counts{$abshour}{$CATWEBMAIL}++;$WebMailflag=1}
        }    
      }
    }  

    # try to spot fetchmail emails   
    if ($log_items[0] =~ m/.*$FetchmailIP.*/) {$localAccepttotal++;$counts{$abshour}{$CATFETCHMAIL}++}
    elsif ($log_items[3] =~ m/.*$FETCHMAIL.*/) {$localAccepttotal++;$counts{$abshour}{$CATFETCHMAIL}++}


    # and adjust for recipient field if not set-up by denying plugin - extract from deny msg
    
    if (length($log_items[4])==0) {
	    if ($log_items[5] eq 'check_goodrcptto') {
	      if ($log_items[7] gt "invalid recipient") {
	        $log_items[4] = substr($log_items[7],18)  #Leave only email address
	      }  
	    }
	}    

#	if ( ( $currentrcptdomain{ $proc } || '' ) eq '' ) {	
	    # reduce to lc and process each e,mail if a list, pseperatedy commas
	    my $recipientmail = lc($log_items[4]);
	    if ($recipientmail =~ m/.*,/) {
	      #comma - split the line and deal with each domain 
#	      print $recipientmail."\n";
	      my ($recipients) = split(',',$recipientmail);
          foreach my $recip ($recipients) {
            $proc = $proc.$recip;
#            print $proc."\n";
   	        $currentrcptdomain{ $proc} = $recip;              
            add_in_domain($proc);          
  	        $recipcount++;  
          } 
#         print "*\n";
          #count emails with more than one recipient 
#	      $recipientmail =~ m/(.*),/;
#	      $currentrcptdomain{ $proc } = $1;     
	    } else {
	      $proc = $proc.$recipientmail;
	      $currentrcptdomain{ $proc} = $recipientmail;
	      add_in_domain($proc);
          $recipcount++;  
	    }
#	} else {
#	    # there more than a recipient for a mail, how many daily ?
#	    $morethanonercpt++;
#	}
	
   # then categorise the result
   

   if (exists $log_items[5]) {
   
    $found_qpcodes{$log_items[5]}++;  ##Count different qpsmtpd result codes
    
    #Check for badly formed lines (from earlier testing) 

   if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}
   
   if ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}

   if ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
   
   if ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}

   if ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_err($proc);next LINE}

   if ($log_items[5] eq 'tnef2mime') { next LINE} #Not expecting this one.
   
   if ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++;
            # and extract the spam score
            if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)") {$rejectspamavg += $1}
            mark_domain_rejected($proc);
            next LINE
   }
   
   if ($log_items[5] eq 'virus::clamav') { $infectedcount++;$counts{$abshour}{$CATVIRUS}++;
            #extract the virus name
            if ($log_items[7] =~ "Virus Found: (.*)" ) {$found_viruses{$1}++;}
            mark_domain_rejected($proc);
            next LINE
   }
   
   if ($log_items[5] eq 'queued') { $Accepttotal++;
            #extract the spam score
            if ($log_items[8] =~ ".*hits=(.*) required=([0-9\.]+)") {     
              $score = $1;
#              print $log_items[8]."<".$score.">\n";  
              if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score}
              else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score}
            } else {
              # no SA score - so it must be ham
              $hamcount++;$counts{$abshour}{$CATHAM}++;
            }
            if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
	                $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ;
	                $currentrcptdomain{ $proc } = '' ;
            }
            next LINE
   }
   
   print $log_items[5]."\n";  #Not detected
   
   }
   
}  #END OF MAIN LOOP

#total up grand total Columns
$nhour = floor( $start / 3600 );
while ( $nhour < $end / 3600 ) {
	$ncateg = 0; #past the where it came from columns
	while ( $ncateg < @categs) {
	  #total columns
	   	$counts{$GRANDTOTAL}{$categs[$ncateg]} += $counts{$nhour}{$categs[$ncateg]};

      # and total rows
      if ( $ncateg < $categlen && $ncateg>=$countfromhere) {#skip initial columns of non final reasons
        $counts{$nhour}{$categs[@categs-2]} += $counts{$nhour}{$categs[$ncateg]}; 
      }  
	  $ncateg++
	}  
	  
	$nhour++;
}	



#Compute row totals and row percentages
$nhour = floor( $start / 3600 );   
while ( $nhour < $end / 3600 ) {
  $counts{$nhour}{$categs[@categs-1]} =  $counts{$nhour}{$categs[@categs-2]}*100/$totalexamined if $totalexamined;
  $nhour++;

}

#compute column percentages
	$ncateg = 0;
	while ( $ncateg < @categs) {
	 if ($ncateg == @categs-1) {
     	  $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg-1]}*100/$totalexamined if $totalexamined;
	 } else {
     	  $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg]}*100/$totalexamined if $totalexamined;
     }  
	  $ncateg++
	}  

#compute sum of row percentages
$nhour = floor( $start / 3600 );   
while ( $nhour < $end / 3600 ) {
  $counts{$GRANDTOTAL}{$categs[@categs-1]} += $counts{$nhour}{$categs[@categs-1]};
  $nhour++;

}

my $QueryNoLogTerse = ($totalexamined==0); #might indicate logterse not installed in qpsmtpd plugins

#Calculate some numbers

$spamavg       = $spamavg / $spamcount if $spamcount;   
$rejectspamavg = $rejectspamavg / $above15 if $above15;
$hamavg = $hamavg / $hamcount if $hamcount;

#  RBL etc percent of total SMTP sessions

my $rblpercent           = ( ( $RBLcount / $totalexamined ) * 100 )           if $totalexamined;
my $PatternFilterpercent = ( ( $PatternFilterCount / $totalexamined ) * 100 ) if $totalexamined;
my $Miscpercent          = ( ( $MiscDenyCount / $totalexamined ) * 100 )      if $totalexamined;

#Spam and virus percent of total email downloaded
#Expressed as a % of total examined
my $spampercent          = ( ( $spamcount / $totalexamined ) * 100 )          if $totalexamined;
my $hampercent           = ( ( $hamcount / $totalexamined ) * 100 )           if $totalexamined;
my $hrsinperiod          = ( ( $end - $start ) / 3600 );
my $emailperhour = ( $totalexamined / $hrsinperiod ) if $totalexamined;
my $above15percent =  ( $above15 / $totalexamined * 100 ) if $totalexamined;
my $infectedpercent = ( ( $infectedcount / ($totalexamined) ) * 100 ) if $totalexamined;
my $AcceptPercent = ( ( $Accepttotal / ($totalexamined) ) * 100 ) if $totalexamined;

my $oldfh;

#Open Sendmail if we are mailing it
if ( $opt{'mail'} && !$disabled ) {
    open( SENDMAIL, "|$opt{'sendmail'} -oi -t -odq" )
      or die "Can't open sendmail: $!\n";
    print SENDMAIL "From: $opt{'from'}\n";
    print SENDMAIL "To: $opt{'mail'}\n";
    print SENDMAIL "Subject: Spam Filter Statistics from $hostname - ",
      strftime( "%F", localtime($start) ), "\n\n";
    $oldfh = select SENDMAIL;
}

my $telapsed = time - $tstart;

if ( !$disabled ) {

    #Output results
    print "SMEServer daily Anti-Virus and Spamfilter statistics", "\n";
    print "----------------------------------------------------", "\n\n";

    print "$0 Version : $opt{'version'}", "\n\n";
    print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n";
    print "Period Ending    : ", strftime( "%c", localtime($end) ),   "\n";
    print "\n";

    print "Clam Version : ",         `freshclam -V`;
    print "SpamAssassin Version : ", `spamassassin -V`;
    printf "Tag level: %3d; Reject level: %3d $warnnoreject\n", $SATagLevel,
      $SARejectLevel;
    if ($HighLogLevel) {
      printf "*Loglevel is set to: ".$LogLevel. " - you only need it set to 6\n";
      printf "\tYou can set it this way:\n";
      printf "\tconfig setprop qpsmtpd LogLevel 6\n";
      printf "\tsignal-event email-update\n";
      printf "\tsv t /var/service/qpsmtpd\n\n";
    }  
    print "\n";
    printf "Reporting Period : %.2f hrs\n", $hrsinperiod;
    print "----------------------------\n";
    print "\n";

   	printf "All SMTP connections accepted:%8d          \n", $totalexamined;  

    printf "Emails per hour              : %8.1f/hr\n", $emailperhour || 0;
    print "\n";
    printf "Average spam score (accepted): %11.2f\n", $spamavg       || 0;
    printf "Average spam score (rejected): %11.2f\n", $rejectspamavg || 0;
    printf "Average ham score            : %11.2f\n", $hamavg        || 0;
    print "\n";
    print "Statistics by Hour\n";

	#
	# start by working out which colunns to show - tag the display array
	#
	$ncateg = 1;  ##skip the first column
	$finaldisplay[0] = $true;
	while ( $ncateg < $categlen) {
      if ($display[$ncateg] eq 'yes') { $finaldisplay[$ncateg] = $true }
      elsif ($display[$ncateg] eq 'no') { $finaldisplay[$ncateg] = $false }
      else {
        $finaldisplay[$ncateg] = ($counts{$GRANDTOTAL}{$categs[$ncateg]} != 0);
        if ($finaldisplay[$ncateg]) {
           #if it has been non zero and auto, then make it yes for the future.
           esmith::ConfigDB->open->get('mailstats')->set_prop($categs[$ncateg],'yes')
        }
     
      }
	  $ncateg++
	}  
    #make sure total and percentages are shown
    $finaldisplay[@categs-2] = $true;
    $finaldisplay[@categs-1] = $true;        
	

    # and put together the print lines
    #
    my $Line1; 			#Full Line across the page
    my $Line2; 			#Broken Line across the page
    my $Titles;			#Column headers  
    my $Values;		    #Values
    my $Totals;		    #Corresponding totals
    my $Percent;        # and column percentages
    
    my $hour = floor( $start / 3600 );   
	$Line1 = '';
	$Line2 = '';
	$Titles = '';
	$Values = '';
	$Totals = '';
	$Percent = '';
    while ( $hour < $end / 3600 ) {
	     if ($hour == floor( $start / 3600 )){
		    #Do all the once only things
 			$ncateg = 0;
			while ( $ncateg < @categs) {
              if ($finaldisplay[$ncateg]){
				  $Line1 .= substr('---------------------',0,$colwidth[$ncateg]);
				  $Line2 .= substr('---------------------',0,$colwidth[$ncateg]-1);
				  $Line2 .= " ";
				  $Titles .= sprintf('%'.($colwidth[$ncateg]-1).'s',$categs[$ncateg])." ";
                  if ($ncateg == 0) {
                    $Totals .= substr('TOTALS                                   ',0,$colwidth[$ncateg]-2);
                    $Percent .= substr('PERCENTAGES                              ',0,$colwidth[$ncateg]-1);
                  } else {
                    # identify bottom right group and supress unless db->ShowGranPerc set
                    if ($ncateg==@categs-1){ 
				      $Totals .= sprintf('%'.$colwidth[$ncateg].'.1f',$counts{$GRANDTOTAL}{$categs[$ncateg]}).'%';                                               
				    } else {
				      $Totals .= sprintf('%'.$colwidth[$ncateg].'d',$counts{$GRANDTOTAL}{$categs[$ncateg]});                          
				    }
			      $Percent .= sprintf('%'.($colwidth[$ncateg]-1).'.1f',$counts{$PERCENT}{$categs[$ncateg]}).'%';                          
				  }  
              }
			  $ncateg++
			}  		    		    
		}    

		$ncateg = 0;
		while ( $ncateg < @categs) {
		  if ($finaldisplay[$ncateg]){
		      if ($ncateg == 0) {
		        $Values .= strftime( "%F, %H", localtime( $hour * 3600 ) )." " 
		      } elsif ($ncateg == @categs-1) {
		        #percentages in last column
		        $Values .= sprintf('%'.($colwidth[$ncateg]-2).'.1f',$counts{$hour}{$categs[$ncateg]})."%";
		      } else {
		        #body numbers
		  	 	$Values .= sprintf('%'.($colwidth[$ncateg]-1).'d',$counts{$hour}{$categs[$ncateg]})." "; 
		  	 }	
		  	 if (($ncateg == @categs-1)){$Values=$Values."\n"} #&& ($hour == floor($end / 3600)-1)
		  }   
		  $ncateg++
		}  
	   
    	$hour++;
	}

  	# print it.
    print $Line1."\n";
    print $Titles."\n";
    print $Line2."\n";
    print $Values."\n";
    print $Line2."\n";
    print $Totals."\n";
    print $Percent."\n"; 
    print $Line1."\n";
 
    
    if ($localAccepttotal>0) {
      print "*Fetchml* means connections from Fetchmail delivering email\n";
    }
    print "*Local* means connections from workstations on local LAN.\n";
    print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol.\n";
    print "            or email was to non existant address.\n";
    print "\n";
    
    if ($QueryNoLogTerse) {
      print "* - as no records where found, it looks as though you may not have the *logterse* \nplugin running as part of qpsmtpd \n";
#      print " to enable it follow the instructions at .............................\n";
    }  
      

    if ( !$RHSenabled || !$DNSenabled ) {

        # comment about RBL not set
        print
"* - This means that one or more of the possible spam black listing services\n    that are available have not been enabled.\n";
        print " You have not enabled:\n";

        if ( !$RHSenabled ) {
            print "    RHSBL\n";
        }

        if ( !$DNSenabled ) {
            print "    DNSBL\n";
        }


        print " To enable these you can use the following commands:\n";
        if ( !$RHSenabled ) {
            print " config setprop qpsmtpd RHSBL enabled\n";
        }

        if ( !$DNSenabled ) {
            print " config setprop qpsmtpd DNSBL enabled\n";
        }

        # there so much templates to expand... (PS)
        print " Followed by:\n signal-event email-update and\n sv t /var/service/qpsmtpd\n\n";
    }

#    if ($Webmailsendtotal > 0) {print "If you have the mailman contrib installed, then the webmail totals might include some mailman emails\n"}
    
    # time to do a 'by recipient domain' report
    print "\nIncoming mails by recipient domains usage\n";
    print "-----------------------------------------\n";
    print
        "Domains                      Type       Total  Denied XferErr Accept \%accept\n";
    print
        "---------------------------- ---------- ------ ------ ------- ------ -------\n";
    my %total = (
        total  => 0,
        deny   => 0,
        xfer   => 0,
        accept => 0,
    );
    foreach my $domain (
        sort {
            join( "\.",     reverse( split /\./, $a ) ) cmp
                join( "\.", reverse( split /\./, $b ) )
        } keys %byrcptdomain
        )
    {
        next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
        my $tp = $byrcptdomain{$domain}{'type'}   || 'other';
        my $to = $byrcptdomain{$domain}{'total'}  || 0;
        my $de = $byrcptdomain{$domain}{'deny'}   || 0;
        my $xr = $byrcptdomain{$domain}{'xfer'}   || 0;
        my $ac = $byrcptdomain{$domain}{'accept'} || 0;
        printf "%-28s %-10s %6d %6d %7d %6d %6.2f%%\n", $domain, $tp, $to,
            $de, $xr, $ac, $ac * 100 / $to;
        $total{'total'}  += $to;
        $total{'deny'}   += $de;
        $total{'xfer'}   += $xr;
        $total{'accept'} += $ac;
    }
    print
        "---------------------------- ---------- ------ ------- ------ ------ -------\n";

    # $total{ 'total' } can be equal to 0, bad for divisions...
    my $perc1 = 0;
    my $perc2 = 0;
    

    if ( $total{'total'} != 0 ) {
        $perc1 = $total{'accept'} * 100 / $total{'total'};
        $perc2 = ($recipcount  / $total{'total'} );
    }
    printf 
        "Total                                   %6d %6d %7d %6d %6.2f%%\n\n",
        $total{'total'}, $total{'deny'}, $total{'xfer'}, $total{'accept'},
        $perc1;
    printf
        "%d mails were processed for %d Recipients\nThe average recipients by mail is %4.2f\n\n",
        $total{'total'}, $recipcount , $perc2;
    
    if ( $infectedcount > 0 ) {
        show_virus_variants();
    }
    
    # get enable/disable subsections
	my $enableqpsmtpdcodes;
	my $enableSARules;
	my $enablejunkMailList; 
    if (esmith::ConfigDB->open_ro->get('mailstats')){
	    $enableqpsmtpdcodes = esmith::ConfigDB->open_ro->get('mailstats')->prop("QpsmtpdCodes") || "enabled" eq "enabled" || $true; 
	    $enableSARules = esmith::ConfigDB->open_ro->get('mailstats')->prop("SARules") || "enabled" eq "enabled" || $true; 
	    $enablejunkMailList = esmith::ConfigDB->open_ro->get('mailstats')->prop("JunkMailList") || "enabled" eq "enabled" || $true; 
	  } else {
	    $enableqpsmtpdcodes = $true;
	    $enableSARules = $true;
	    $enablejunkMailList = $true; 
	  }  

    if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();}
    
    if ($enableSARules) {show_SARules_codes();}

	if ($enablejunkMailList) {List_Junkmail();}

    print "\nDone. Report generated in $telapsed sec.\n\n";

    #Close Senmdmail if it was opened
    if ( $opt{'mail'} ) {
        select $oldfh;
        close(SENDMAIL);
    }

}  ##report disabled

#All done
exit 0;

#############################################################################
# Subroutines ###############################################################
#############################################################################


########################################
# Process parms #
########################################
sub parse_arg {
    my $startdate = shift;
    my $enddate   = shift;

    my $secsinday = 86400;
    my $time      = 0;

    my $start = UnixDate( $startdate, "%s" );
    my $end   = UnixDate( $enddate,   "%s" );

    if ( !$start && !$end ) {
        $end   = time;
        $start = $end - $secsinday;
        return ( $start, $end );
    }

    if ( !$start ) {
        $start = $end - $secsinday;
        return ( $start, $end );
    }

    if ( !$end ) {
        $end = $start + $secsinday;
        return ( $start, $end );
    }

    if ( $start > $end ) {
        return ( $end, $start );
    }

    return ( $start, $end );

}

sub dbg {
    my $msg = shift;

    if ( $opt{debug} ) {
        print STDERR $msg;
    }
}

sub List_Junkmail {

    #
    # Show how many junkmails in each user's junkmail folder.
    #
    use esmith::AccountsDB;
    my $adb = esmith::AccountsDB->open_ro;
    my $entry;
    my %junkcount;
    foreach my $user ($adb->users) {
		my $found = 0;
		my $junkmail_dir = "/home/e-smith/files/users/" .
		$user->key . "/Maildir/.junkmail";
		foreach my $dir (qw(new cur)) {
			# Now get the content list for the directory.
			if (opendir( QDIR, "$junkmail_dir/$dir" )) {
				while ($entry=readdir(QDIR) ) {
					next if $entry =~ /^\./;
					$found++;
				}
			closedir(QDIR);
			}
		}
        if ($found != 0) {
          $junkcount{$user->key} = $found;	
        }  
    }
    my $i = keys %junkcount;
    if ($i > 0) {
		print("Junk Mails left in folder:\n");
		print("-------------------------\n");
		print("Count\tUser\n"); 
		print("-------------------------\n");
		foreach my $thisuser (sort {$junkcount{$b} <=> $junkcount{$a} }
						   keys %junkcount)
		{   
			printf "%d", $junkcount{$thisuser};
			print "\t".$thisuser."\n";
		}	
		print("-------------------------\n");
	} else {
	   print "***No junkmail folders with emails***\n"
	}   
}

sub show_virus_variants

#
# Show a league table of the different virus types found today
#

{

    print("Virus Statistics by name:\n");
    print("---------------------------------------------\n");
    foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} }
			    keys %found_viruses)
    {
	print "Rejected $found_viruses{$virus}\t$virus\n";
    }
    print("---------------------------------------------\n\n");
}

sub show_qpsmtpd_codes

#
# Show a league table of the qpsmtpd result codes found today
#

{

    print("Qpsmtpd codes league table:\n");
    print("---------------------------------------------\n");
    print("Count\tPercent\tReason\t\n");
    print("---------------------------------------------\n");
    foreach my $qpcode (sort { $found_qpcodes{$b} <=> $found_qpcodes{$a} }
			    keys %found_qpcodes)
    {
	print "$found_qpcodes{$qpcode}\t".sprintf('%4.1f',$found_qpcodes{$qpcode}*100/$totalexamined)."%\t$qpcode\n" if $totalexamined;
    }
    print("---------------------------------------------\n\n");
}

sub show_SARules_codes

#
# Show a league table of the SARules result codes found today
# suppress any lower than DB mailstats/SARulePercentThreshold
#

{

    my ($percentthreshold);
    my ($defaultpercentthreshold);  

    if ($totalexamined >0 && $sum_SARules*100/$totalexamined > $SARulethresholdPercent) {
      $defaultpercentthreshold = $maxcutoff
    } else { 
      $defaultpercentthreshold = $mincutoff
    }  
    if (esmith::ConfigDB->open_ro->get('mailstats')){
	    $percentthreshold = esmith::ConfigDB->open_ro->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold; 
	  } else {
	    $percentthreshold = $defaultpercentthreshold
	  }  
    print("Spamassassin Rules:\n");
    print("---------------------------------------------\n");
    print("Count\tPercent\tAve.Hits\tRule\t\n");
    print("---------------------------------------------\n");
    foreach my $SARule (sort { $found_SARules{$b}{'count'} <=> $found_SARules{$a}{'count'} }
			    keys %found_SARules)
    {
    	my $percent = $found_SARules{$SARule}{'count'}*100/$totalexamined if $totalexamined;
    	my $avehits = $found_SARules{$SARule}{'totalhits'} / $found_SARules{$SARule}{'count'} if $found_SARules{$SARule}{'count'};
    	if ($percent > $percentthreshold) {
			print "$found_SARules{$SARule}{'count'}\t".sprintf('%4.1f',$percent)."%\t".sprintf('%4.1f',$avehits)."\t$SARule\n" if $totalexamined;
		}
    }
    print("---------------------------------------------\n\n");
}


sub mark_domain_rejected

#
# Tag domain as having a rejected email
#
{ 
my ($proc) = @_;
if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
            $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'deny' }++ ;
            $currentrcptdomain{ $proc } = '' ;
        }
}   

sub mark_domain_err

#
# Tag domain as having an error on email transfer
#
{ 
my ($proc) = @_;
if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
            $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'xfer' }++ ;
            $currentrcptdomain{ $proc } = '' ;
        }
}

sub add_in_domain
#
# add recipient domain into hash
#
{
	my ($proc) = @_;
	#split to just domain bit.
	$currentrcptdomain{ $proc } =~ s/.*@//;  
	$currentrcptdomain{ $proc } =~ s/[^\w\-\.]//g ;
	$currentrcptdomain{ $proc } =~ s/>//g ; 
	my $NotableDomain = 0 ;
	if ( defined ( $byrcptdomain{ $currentrcptdomain{ $proc  } }{ 'type' } ) ) {
		$NotableDomain = 1 ;
	} else {
		foreach ( @extdomain ) {
			if ( $currentrcptdomain{ $proc } =~ m/$_$/ ) {
				$NotableDomain = 1 ;
				last ;
			}
		}
	}
	if ( !$NotableDomain ) {
		# check for outgoing email
		if ($localflag==1) {$currentrcptdomain{ $proc } = 'Outgoing'}
		  else {$currentrcptdomain{ $proc } = 'Others'} 
	} else {
		if ($localflag==1) {$currentrcptdomain{ $proc } = 'Internal'}
	}
	$byrcptdomain{ $currentrcptdomain{ $proc } }{ 'total' }++ ; 
}