#!/usr/bin/perl use strict; ############################################################################# # # This script provides daily SpamFilter statistics. # # This script was originally developed # by Jesper Knudsen at http://sme.swerts-knudsen.dk # and re-written by brian read at bjsystems.co.uk (with some help from the community - thanks guys) # # bjr - 02sept12 - Add in qpsmtpd failure code auth::auth_cvm_unix_local as per Bug 7089 # bjr - 10Jun15 - Sort out multiple files as input parameters as per bug 5613 # - Sort out geoip failure status as per Bug 4262 # - change final message about the DB (it is created automatically these days by the rpm) # bjr - 17Jun15 - Add annotation showing Badcountries being eliminated # - correct Spamfilter details extract, as per Bug 8656 # - Add analysis table of Geoip results # bjr - 19Jun15 - Add totals for the League tables # bjr and Unnilennium - 08Apr16 - Add in else for unrecognised plugin detection # bjr - 08Apr16 - Add in link for SaneSecurity "extra" virus detection # bjr - 14Jun16 - make compatible with qpsmtpd 0.96 # bjr - 16Jun16 - Add code to create an html equivalent of the text email (v0.7) # bjr - 04Aug16 - Add code to log and count the blacklist RBL urls that have triggered, this (NFR) is Bugzilla 9717 # bjr - 04Aug16 - Add code to expand the junkmail table to include daily ham and spam and deleted spam for each user - (NFR bugzilla 9716) # bjr - 05Aug16 - Add code to log remote relay incoming emails # bjr - 10Oct16 - Add code to show stats for the smeoptimizer package # bjr - 16dec16 - Fix dnsbl code to deal with psbl.surriel.com - Bug 9717 # bjr - 16Dec16 - Change geopip table code to show even if no exclusions found (assuming geoip data found) - Bug 9888 # bjr - 30Apr17 - Change Categ index code - Bug 9888 again # bjr - 18Dec19 - Sort out a few format problems and also remove some debugging crud - Bug 10858 # bjr - 18Dec19 - change to fix truncation of email address in by email table - bug 10327 # bjr - 18Oct20 - Alter use of lc to avoid uninitialised messages - bug 11044 # bjr - 02Apr21 - Fix up lc to try to avoif uninit messages - and alter warning status - bug 11519 # bjr - 15Feb23 - Add in auth::auth_imap after change to use dovecot as incoming authorisation Bugzilla 12327 # ############################################################################# # # SMEServer DB usage # ------------------ # # mailstats / Status ("enabled"|"disabled") # / ("yes"|"no"|"auto") - enable, supress or only show if nonzero # / QpsmtpdCodes ("enabled"|"disabled") # / SARules ("enabled"|"disabled") # / GeoipTable ("enabled"|"disabled") # / GeoipCutoffPercent (0.5%) - threshold to show Geoip country in league table # / JunkMailList ("enabled"|"disabled") # / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff # / Email (admin) - email to send report # / SaveDataToMySQL - save data to MySQL database (default is "no") # / ShowLeagueTotals - Show totals row after league tables - (default is "yes") # / DBHost - MySQL server hostname (default is "localhost"). # / DBPort - MySQL server post (default is "3306") # / Interval - "daily", "weekly", "fortnightly", "monthly", "99999" - last is number of hours (default is daily) # / Base - "Midnight", "Midday", "Now", "99" hour (0-23) (default is midnight) # / HTMLEmail - "yes", "no", "both" - default is "No" - Send email in HTML # NOT YET INUSE - WIP! # / HTMLPage - "yes" / "no" - default is "yes" if HTMLEmail is "yes" or "both" otherwise "no" # ############################################################################# # # # TODO # # 1. Delete loglines records from any previous run of same table # 2. Add tracking LogId for each cont in the table # 3. Use link directory file to generate h1 / h2 tags for title and section headings # 4. Ditto for links to underlying data # # 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::Parse; use Time::TAI64; use esmith::ConfigDB; use esmith::DomainsDB; use Sys::Hostname; use Switch; use DBIx::Simple; use URI::URL; #use CGI; #use HTML::TextToHTML; my $hostname = hostname(); my $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n"; my $true = 1; my $false = 0; #and see if mailstats are disabled my $disabled; if ($cdb->get('mailstats')){ $disabled = !(($cdb->get('mailstats')->prop('Status') || 'enabled') eq 'enabled'); } else { my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled', Email => 'admin' }); $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n"; #Open up again to pick up new record $disabled = $false; } #Configuration section my %opt = ( version => '0.7.16', # please update at each change. debug => 0, # guess what ? sendmail => '/usr/sbin/sendmail', # Path to sendmail stub from => 'spamfilter-stats', # Who is the mail from mail => $cdb->get('mailstats')->prop('Email') || 'admin', # mailstats email recipient timezone => `date +%z`, ); 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 $DMARCDomain="dmarc"; #Pattern to recognised DMARC sent emails (this not very reliable, as the email address could be anything) my $DMARCOkPattern="dmarc: pass"; #Pattern to use to detect DMARC approval my $localIPregexp = ".*((127\.)|(10\.)|(172\.1[6-9]\.)|(172\.2[0-9]\.)|(172\.3[0-1]\.)|(192\.168\.)).*"; my $MinCol = 6; #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 $tstart = time; #Local variables my $YEAR = ( localtime(time) )[5]; # this is years since 1900 my $total = 0; my $spamcount = 0; my $spamavg = 0; my $spamhits = 0; my $hamcount = 0; my $hamavg = 0; my $hamhits = 0; my $rejectspamavg = 0; my $rejectspamhits= 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 $DMARCSendCount = 0; #total DMARC reporting emails sent (approx) my $DMARCOkCount = 0; #Total emails approved through DMARC my %found_viruses = (); my %found_qpcodes = (); my %found_SARules = (); my %junkcount = (); my %unrecog_plugin = (); my %blacklistURL = (); #Count of use of each balcklist rhsbl my %usercounts = (); #Count per received email of sucessful delivery, queued spam and deleted Spam, and rejected # 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 #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'; my $CATRELAY="Relay"; # border between where it came from and where it ended.. my $countfromhere = 6; #Temp - Check this not moved!! my $CATVIRUS='Virus'; my $CATRBLDNS='RBL/DNS'; my $CATEXECUT='Execut.'; my $CATNONCONF='Non.Conf.'; my $CATBADCOUNTRIES='Geoip.'; my $CATKARMA="Karma"; my $CATSPAMDEL='Del.Spam'; my $CATSPAM='Qued.Spam?'; my $CATHAM='Ham'; my $CATTOTALS='TOTALS'; my $CATPERCENT='PERCENT'; my $CATDMARC="DMARC Rej."; my $CATLOAD="Rej.Load"; my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATRELAY,$CATDMARC,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATBADCOUNTRIES,$CATNONCONF,$CATLOAD,$CATKARMA,$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 # # Index for certain columns - check these do not move if we add columns # #my $BadCountryCateg=9; #my $DMARCcateg = 5; #Not used. #my $KarmaCateg=$BadCountryCateg+3; my %categindex; @categindex{@categs} = (0..$#categs); my $BadCountryCateg=$categindex{$CATBADCOUNTRIES}; my $DMARCcateg = $categindex{$CATDMARC}; #Not used. my $KarmaCateg=$categindex{$CATKARMA}; 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 %found_countries = (); my $total_countries = 0; my $BadCountries = ""; #From the DB 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 $morethanonercpt = 0 ; # count every 'second' recipients for a mail. my $recipcount = 0; # count every recipient email address received. # #Load up the emails curreently stored for DMARC reporting - so that we cna spot the reports being sent. #Held in an slqite db, created by the DMARC perl lib. # my $dsn = "dbi:SQLite:dbname=/var/lib/qpsmtpd/dmarc/reports.sqlite"; #Taken from /etc/mail-dmarc.ini # doesn't seem to need my $user = ""; my $pass = ""; my $DMARC_Report_emails = ""; #Flat string of all email addresses if (my $dbix = DBIx::Simple->connect( $dsn, $user, $pass )){ my $result = $dbix->query("select rua from report_policy_published;"); $result->bind(my ($emailaddress)); while ($result->fetch){ #remember email from logterse entry has chevrons round it - so we add them here to guarantee the alighment of the match #Remove the mailto: $emailaddress =~ s/mailto://g; # and map any commas to >< $emailaddress =~ s/,/>\n" } $dbix->disconnect(); } else { $DMARC_Report_emails = "None found - DB not opened"} # and setup list of local domains for spotting the local one in a list of email addresses (Remote station processing) use esmith::DomainsDB; my $d = esmith::DomainsDB->open_ro(); my @domains = $d->keys(); my $alldomains = "("; foreach my $dom (@domains){$alldomains .= $dom."|"} $alldomains .= ")"; # Saving the Log lines processed my %LogLines = (); #Save all the log lines processed for writing to the DB my %LogId = (); #Save the Log Ids. my $CurrentLogId = ""; my $Sequence = 0; # 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{ $cdb->get('SystemName')->value . "." . $cdb->get('DomainName')->value }{ 'type' } = 'local'; # is this system a MX-Backup ? if ($cdb->get('mxbackup')){ if ( ( $cdb->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) { my %MXValues = split( /,/, ( $cdb->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 ) = analysis_period(); # # First check current configuration for logging, DNS enable and Max threshold for spamassassin # my $LogLevel = $cdb->get('qpsmtpd')->prop('LogLevel'); my $HighLogLevel = ( $LogLevel > 6 ); my $RHSenabled = ( $cdb->get('qpsmtpd')->prop('RHSBL') eq 'enabled' ); my $DNSenabled = ( $cdb->get('qpsmtpd')->prop('DNSBL') eq 'enabled' ); my $SARejectLevel = $cdb->get('spamassassin')->prop('RejectLevel'); my $SATagLevel = $cdb->get('spamassassin')->prop('TagLevel'); my $DomainName = $cdb->get('DomainName')->value; # check that logterse is in use #my pluginfile = '/var/service/qpsmtpd/config/peers/0'; if ( !$RHSenabled || !$DNSenabled ) { $rblnotset = '*'; } if ( $SARejectLevel == 0 ) { $warnnoreject = "(*Warning* 0 = no reject)"; } # get enable/disable subsections my $enableqpsmtpdcodes; my $enableSARules; my $enableGeoiptable; my $enablejunkMailList; my $savedata; my $enableblacklist; #Enabled according to setting in qpsmtpd if ($cdb->get('mailstats')){ $enableqpsmtpdcodes = ($cdb->get('mailstats')->prop("QpsmtpdCodes") || "enabled") eq "enabled" || $false; $enableSARules = ($cdb->get('mailstats')->prop("SARules") || "enabled") eq "enabled" || $false; $enablejunkMailList = ($cdb->get('mailstats')->prop("JunkMailList") || "enabled") eq "enabled" || $false; $enableGeoiptable = ($cdb->get('mailstats')->prop("Geoiptable") || "enabled") eq "enabled" || $false; $savedata = ($cdb->get('mailstats')->prop("SaveDataToMySQL") || "no") eq "yes" || $false; } else { $enableqpsmtpdcodes = $true; $enableSARules = $true; $enablejunkMailList = $true; $enableGeoiptable = $true; $savedata = $false; } $enableblacklist = ($cdb->get('qpsmtpd')->prop("RHSBL") || "disabled") eq "enabled" || ($cdb->get('qpsmtpd')->prop("URIBL") || "disabled") eq "enabled"; my $makeHTMLemail = "no"; #if ($cdb->get('mailstats')){$makeHTMLemail = $cdb->get('mailstats')->prop('HTMLEmail') || "no"} #TEMP!! my $makeHTMLpage = "no"; #if ($makeHTMLemail eq "yes" || $makeHTMLemail eq "both") {$makeHTMLpage = "yes"} #if ($cdb->get('mailstats')){$makeHTMLpage = $cdb->get('mailstats')->prop('HTMLPage') || "no"} # 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, percent and display status from db entries, and column widths $ncateg = 0; my $colpadding = 0; while ( $ncateg < @categs) { $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0; $counts{$PERCENT}{$categs[$ncateg]} = 0; if ($cdb->get('mailstats')){ $display[$ncateg] = lc($cdb->get_prop('mailstats',$categs[$ncateg]) || "auto"); } else { $display[$ncateg] = 'auto' } if ($ncateg == 0) { $colwidth[$ncateg] = $HourColWidth + $colpadding; } else { $colwidth[$ncateg] = length($categs[$ncateg])+1+$colpadding; } if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol + $colpadding} $ncateg++ } my $starttai = Time::TAI64::unixtai64n($start); my $endtai = Time::TAI64::unixtai64n($end); my $sum_SARules = 0; # we remove non valid files my @ARGV2; foreach ( map { glob } @ARGV){ push(@ARGV2,($_)); } @ARGV=@ARGV2; my $count = -1; #for loop reduction in debugging mode # #--------------------------------------- # Scan the qpsmtpd log file(s) #--------------------------------------- my $CurrentMailId = ""; LINE: while (<>) { next LINE if !(my($tai,$log) = split(' ',$_,2)); #If date specified, only process lines matching date next LINE if ( $tai lt $starttai ); next LINE if ( $tai gt $endtai ); #Count lines and skip out if debugging $count++; #last LINE if ($opt{debug} && $count >= 100); #Loglines to Saved String for later DB write if ($savedata) { my $CurrentLine = $_; $CurrentLine = /^\@([0-9a-z]*) ([0-9]*) .*$/; my $l = length($CurrentLine); if ($l != 0){ if (defined($2)){ if ($2 ne $CurrentMailId) { print "CL:$CurrentLine*\n" if !defined($1); $CurrentLogId = $1."-".$2; $CurrentMailId = $2; $Sequence = 0; } else {$Sequence++} #$CurrentLogId .=":".$Sequence; $LogLines{$CurrentLogId.":".$Sequence} = $_; } } } # pull out spamasassin rule lists if ( $_ =~m/spamassassin: pass, Ham,(.*)=0) or ($logemail =~ m/$DMARCDomain/)){ $localsendtotal++; $DMARCSendCount++; $localflag = 1; } else { if (exists $log_items[8]){ # ignore incoming localhost spoofs if ( $log_items[8] =~ m/msg denied before queued/ ) { } else { #Webmail $localflag = 1; $WebMailsendtotal++; $counts{$abshour}{$CATWEBMAIL}++; $WebMailflag = 1; } } 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], 16 ); #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]) { if ($log_items[5] eq 'naughty') { my $rejreason = $log_items[7]; $rejreason = /.*(\(.*\)).*/; if (!defined($1)){$rejreason = "unknown"} else {$rejreason = $1} $found_qpcodes{$log_items[5]."-".$rejreason}++} else {$found_qpcodes{$log_items[5]}++} ##Count different qpsmtpd result codes if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++} elsif ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++} elsif ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_badcountries') {$MiscDenyCount++;$counts{$abshour}{$CATBADCOUNTRIES}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'tnef2mime') { } #Not expecting this one. elsif ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++; # and extract the spam score # if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)") if ($log_items[8] =~ "Yes, score=(.*) required=([0-9\.]+)") {$rejectspamavg += $1} mark_domain_rejected($proc); } elsif (($log_items[5] eq 'virus::clamav') or ($log_items[5] eq 'virus::clamdscan')) { $infectedcount++;$counts{$abshour}{$CATVIRUS}++; #extract the virus name if ($log_items[7] =~ "Virus found: (.*)" ) {$found_viruses{$1}++;} else {$found_viruses{$log_items[7]}++} #Some other message!! mark_domain_rejected($proc); } elsif ($log_items[5] eq 'queued') { $Accepttotal++; #extract the spam score # Remove count for rejectred as it looks as if it might get through!! $result= "queued"; if ($log_items[8] =~ ".*score=([+-]?\\d+\.?\\d*).* required=([0-9\.]+)") { $score = trim($1); if ($score =~ /^[+-]?\d+\.?\d*$/ ) #check its numeric { if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score;} else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score;$result= "spam";} } else { print "Unexpected non numeric found in $proc:".$log_items[8]."($score)\n"; } } else { # no SA score - treat it as ham $hamcount++;$counts{$abshour}{$CATHAM}++; } if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) { $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ; $currentrcptdomain{ $proc } = '' ; } } elsif ($log_items[5] eq 'tls') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'auth::auth_cvm_unix_local') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'auth::auth_imap') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'uribl') {$RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++} elsif ($log_items[5] eq 'naughty') { #Naughty plugin seems to span a number of rejection reasons - so we have to use the next but one log_item[7] to identify if ($log_items[7] =~ m/(karma)/) { $MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)} elsif ($log_items[7] =~ m/(dnsbl)/){ $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++} elsif ($log_items[7] =~ m/(helo)/){ $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} else { #Unidentified Naughty rejection $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]."-".$log_items[7]}++} } elsif ($log_items[5] eq 'resolvable_fromhost') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'loadcheck') {$MiscDenyCount++;$counts{$abshour}{$CATLOAD}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'karma') {$MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'dmarc') {$MiscDenyCount++;$counts{$abshour}{$CATDMARC}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'headers') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'mailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'helo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'check_smtp_forward') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} elsif ($log_items[5] eq 'sender_permitted_from') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)} #Treat it as Unconf if not recognised else {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]}++} } #Log[5] exists #Entry if not local send if ($localflag == 0) { if (length($log_items[4]) > 0){ # Need to check here for multiple email addresses my @emails = split(",",lc($log_items[4] || ' ')); if (scalar(@emails) > 1) { #Just pick the first local address to hang it on. # TEMP - just go for the first address until I can work out how to spot the 1st "local" one $usercounts{$emails[0]}{$result}++; $usercounts{$emails[0]}{"proc"} = $proc; #Compare with @domains array until we get a local one my $gotone = $false; foreach my $email (@emails){ #Extract the domain from the email address my $fullemail = $email; $email = s/.*\@(.*)$/$1/; #and see if it is local if (length($fullemail)>0) { if ($email =~ m/$alldomains/){ $usercounts{lc($fullemail || ' ')}{$result}++; $usercounts{lc($fullemail || ' ')}{"proc"} = $proc; $gotone = $true; last; } } } if (!$gotone) { $usercounts{'No internal email $proc'}{$result}++; $usercounts{'No internal email $proc'}{"proc"} = $proc; } } else { $usercounts{lc($log_items[4])}{$result}++; $usercounts{lc($log_items[4])}{"proc"} = $proc; } } } #exit if $emailnum == 15858; } #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 and $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'} and !$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 # NEW - save the print to a variable so that it can be processed into html. # #Save current output selection and divert into variable # my $output; my $tablestr=""; open(my $outputFH, '>', \$tablestr) or die; # This shouldn't fail my $oldFH = select $outputFH; print "SMEServer daily Anti-Virus and Spamfilter statistics from $hostname - ".strftime( "%F", localtime($start))."\n"; print "----------------------------------------------------------------------------------", "\n\n"; print "$0 Version : $opt{'version'}", "\n"; print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n"; print "Period Ending : ", strftime( "%c", localtime($end) ), "\n"; print "Clam Version/DB Count/Last DB update: ",`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"; } printf "Reporting Period : %-.2f hrs\n", $hrsinperiod; printf "All SMTP connections accepted:%-8d \n", $totalexamined; printf "Emails per hour : %-8.1f/hr\n", $emailperhour || 0; 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; printf "Number of DMARC reporting emails sent:\t%-11d (not shown on table)\n", $DMARCSendCount || 0; if ($hamcount != 0){ printf "Number of emails approved through DMARC:\t%-11d (%-3d%% of Ham count)\n", $DMARCOkCount|| 0,$DMARCOkCount*100/$hamcount || 0;} my $smeoptimizerprog = "/usr/local/smeoptimizer/SMEOptimizer.pl"; if (-e $smeoptimizerprog) { #smeoptimizer installed - get result of status my @smeoptimizerlines = split(/\n/,`/usr/local/smeoptimizer/SMEOptimizer.pl -status`); print("SMEOptimizer status:\n"); print("\t".$smeoptimizerlines[6]."\n"); print("\t".$smeoptimizerlines[7]."\n"); print("\t".$smeoptimizerlines[8]."\n"); print("\t".$smeoptimizerlines[9]."\n"); print("\t".$smeoptimizerlines[10]."\n"); } print "\nStatistics 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"; #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line1."\n";} #These lines mess up the HTML conversion .... print $Titles."\n"; #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line2."\n";} #ditto print $Line2."\n"; print $Values; 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\n"; print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol"; print " or email was to non existant address.\n\n"; if ($finaldisplay[$KarmaCateg]){ print "*Karma* means email was rejected based on the mailserver's previous activities.\n\n"; } if ($finaldisplay[$BadCountryCateg]){ $BadCountries = $cdb->get('qpsmtpd')->prop('BadCountries') || "*none*"; print "*Geoip\.*:Bad Countries mask is:".$BadCountries."\n\n"; } if (scalar keys %unrecog_plugin > 0){ #Show unrecog plugins found print "*Unrecognised plugins found - categorised as Non-Conf\n"; foreach my $unrec (keys %unrecog_plugin){ print "\t$unrec\t($unrecog_plugin{$unrec})\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\n"; # print " to enable it follow the instructions at .............................\n"; } if ( !$RHSenabled or !$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 "Incoming 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 = ( ( $total{'total'} + $morethanonercpt ) / $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'}, ( $total{'total'} + $morethanonercpt ), $perc2; if ( $infectedcount > 0 ) { show_virus_variants(); } if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();} if ($enableSARules) {show_SARules_codes();} if ($enableGeoiptable and (($total_countries > 0) or $finaldisplay[$BadCountryCateg])){show_Geoip_results();} if ($enablejunkMailList) {List_Junkmail();} if ($enableblacklist) {show_blacklist_counts();} show_user_stats(); print "\nReport generated in $telapsed sec.\n"; if ($savedata) { save_data(); } else { print "No data saved - if you want to save data to a MySQL database, then please use:\n". "config setprop mailstats SaveDataToMySQL yes\n"; } select $oldFH; close $outputFH; if ($makeHTMLemail eq "no" or $makeHTMLemail eq "both") {print $tablestr} if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" or $makeHTMLpage eq "yes"){ #Convert text to html and send it require CGI; require TextToHTML; my $cgi = new CGI; my $text = $tablestr; my %paramhash = (default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>10,tab_width=>20); my $conv = new HTML::TextToHTML(); $conv->args(default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>2,preformat_whitespace_min=>2, underline_length_tolerance=>1); my $html = $cgi->header(); $html .=" \n"; $html .= "Mailstats -".strftime( "%F", localtime($start) ).""; $html .= "\n"; $html .= "\n"; $html .= $conv->process_chunk($text); $html .= "\n"; if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" ) {print $html} #And drop it into a file if ($makeHTMLpage eq "yes") { my $filename = "mailstats.html"; open(my $fh, '>', $filename) or die "Could not open file '$filename' $!"; print $fh $html; close $fh; } } #Close Sendmail if it was opened if ( $opt{'mail'} ) { select $oldfh; close(SENDMAIL); } } ##report disabled #All done exit 0; ############################################################################# # Subroutines ############################################################### ############################################################################# ################################################ # Determine analysis period (start and end time) ################################################ sub analysis_period { my $startdate = shift; my $enddate = shift; my $secsininterval = 86400; #daily default my $time; if ($cdb->get('mailstats')) { my $interval = $cdb->get('mailstats')->prop('Interval') || 'daily'; #"fortnightly"; #"daily";# #; TEMP!! if ($interval eq "weekly") { $secsininterval = 86400*7; } elsif ($interval eq "fortnightly") { $secsininterval = 86400*14; } elsif ($interval eq "monthly") { $secsininterval = 86400*30; } elsif ($interval =~m/\d+/) { $secsininterval = $interval*3600; }; my $base = $cdb->get('mailstats')->prop('Base') || 'Midnight'; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($base eq "Midnight"){ $sec = 0;$min=0;$hour=0; } elsif ($base eq "Midday"){ $sec = 0;$min=0;$hour=12; } elsif ($base =~m/\d+/){ $sec=0;$min=0;$hour=$base; }; #$mday="05"; #$mday="03"; #$mday="16"; #Temp!! $time = timelocal($sec,$min,$hour,$mday,$mon,$year); } my $start = str2time( $startdate ); my $end = $enddate ? str2time( $enddate ) : $startdate ? $start + $secsininterval : $time; $start = $startdate ? $start : $end - $secsininterval; return ( $start > $end ) ? ( $end, $start ) : ( $start, $end ); } sub dbg { my $msg = shift; my $time = scalar localtime; $msg = $time.":".$msg."\n"; 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; 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("\nJunk 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 # { my $line = "------------------------------------------------------------------------\n"; print("\nVirus Statistics by name:\n"); print($line); foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} } keys %found_viruses) { if (index($virus,"Sanesecurity") !=-1 or index($virus,"UNOFFICIAL") !=-1){ print "Rejected $found_viruses{$virus}\thttp://sane.mxuptime.com/s.aspx?id=$virus\n"; } else { print "Rejected $found_viruses{$virus}\t$virus\n"; } } print($line); } sub show_qpsmtpd_codes # # Show a league table of the qpsmtpd result codes found today # { my $line = "---------------------------------------------\n"; print("\nQpsmtpd codes league table:\n"); print($line); print("Count\tPercent\tReason\n"); print($line); 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\t$qpcode\n" if $totalexamined; } print($line); } sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s }; sub get_domain { my $url = shift; $url =~ s!^\(dnsbl\)\s!!; $url =~ s!^.*https?://(?:www\.)?!!i; $url =~ s!/.*!!; $url =~ s/[\?\#\:].*//; $url =~ s/^([\d]{1,3}.){4}//; my $domain = trim($url); return $domain; } sub show_blacklist_counts # # Show a sorted league table of the blacklist URL counts # { my $line = "------------------\n"; print("\nBlacklist details:\n"); print($line); if ($cdb->get('qpsmtpd')->prop("RHSBL") eq "enabled") {print "RBLLIST:".$cdb->get('qpsmtpd')->prop("RBLList")."\n";} if ($cdb->get('qpsmtpd')->prop("URIBL") eq "enabled") {print "UBLLIST:".$cdb->get('qpsmtpd')->prop("UBLList")."\n";} if (!$cdb->get('qpsmtpd')->prop("SBLList") eq "") {print "SBLLIST:".$cdb->get('qpsmtpd')->prop("SBLList")."\n";} print($line); print("Count\tURL\n"); print($line); foreach my $blcode (sort { $blacklistURL{$b} <=> $blacklistURL{$a} } keys %blacklistURL) { print sprintf('%3u',$blacklistURL{$blcode})."\t$blcode\n"; } print($line); } sub show_user_stats # # Show a sorted league table of the user counts # { #Compute totals for each entry my $grandtotals=0; my $totalqueued=0; my $totalspam=0; my $totalrejected=0; foreach my $user (keys %usercounts){ $usercounts{$user}{"queued"} = 0 if !(exists $usercounts{$user}{"queued"}); $usercounts{$user}{"rejected"} = 0 if !(exists $usercounts{$user}{"rejected"}); $usercounts{$user}{"spam"} = 0 if !(exists $usercounts{$user}{"spam"}); $usercounts{$user}{"totals"} = $usercounts{$user}{"queued"}+$usercounts{$user}{"rejected"}+$usercounts{$user}{"spam"}; $grandtotals += $usercounts{$user}{"totals"}; $totalspam += $usercounts{$user}{"spam"}; $totalqueued += $usercounts{$user}{"queued"}; $totalrejected += $usercounts{$user}{"rejected"}; } my $line = "--------------------------------------------------\n"; print("\nStatistics by email address received:\n"); print($line); print("Queued\tRejected\tSpam tagged\tEmail Address\n"); print($line); foreach my $user (sort { $usercounts{$b}{"totals"} <=> $usercounts{$a}{"totals"} } keys %usercounts) { print sprintf('%3u',$usercounts{$user}{"queued"})."\t".sprintf('%3u',$usercounts{$user}{"rejected"})."\t\t".sprintf('%3u',$usercounts{$user}{"spam"})."\t\t$user\n"; } print($line); print sprintf('%3u',$totalqueued)."\t".sprintf('%3u',$totalrejected)."\t\t".sprintf('%3u',$totalspam)."\n"; print($line); } sub show_Geoip_results # # Show league table of GEoip results # { my ($percentthreshold); my ($reject); my ($percent); my ($totalpercent)=0; if ($cdb->get('mailstats')){ $percentthreshold = $cdb->get('mailstats')->prop("GeoipCutoffPercent") || 0.5; } else { $percentthreshold = 0.5; } if ($total_countries > 0) { my $line = "---------------------------------------------\n"; print("\nGeoip results: (cutoff at $percentthreshold%) \n"); print($line); print("Country\tPercent\tCount\tRejected?\n"); print($line); foreach my $country (sort { $found_countries{$b} <=> $found_countries{$a} } keys %found_countries) { $percent = $found_countries{$country} * 100 / $total_countries if $total_countries; $totalpercent = $totalpercent + $percent; if (index($BadCountries, $country) != -1) {$reject = "*";} else { $reject = " ";} if ( $percent >= $percentthreshold ) { print "$country\t\t" . sprintf( '%4.1f', $percent ) . "%\t\t$found_countries{$country}","\t$reject\n" if $total_countries; } } print($line); my ($showtotals); if ($cdb->get('mailstats')){ $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes"); } else { $showtotals = $true; } if ($showtotals){ print "TOTALS\t\t".sprintf("%4.1f",$totalpercent)."%\t\t$total_countries\n"; print($line); } } } 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); my ($totalpercent) = 0; if ($sum_SARules > 0){ if ($totalexamined >0 and $sum_SARules*100/$totalexamined > $SARulethresholdPercent) { $defaultpercentthreshold = $maxcutoff } else { $defaultpercentthreshold = $mincutoff } if ($cdb->get('mailstats')){ $percentthreshold = $cdb->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold; } else { $percentthreshold = $defaultpercentthreshold } my $line = "---------------------------------------------\n"; print("\nSpamassassin Rules:(cutoff at ".sprintf('%4.1f',$percentthreshold)."%)\n"); print($line); print("Count\tPercent\tScore\t\t\n"); print($line); 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($line); my ($showtotals); if ($cdb->get('mailstats')){ $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes"); } else { $showtotals = $true; } if ($showtotals){ print "$totalexamined\t(TOTALS)\n"; print($line); } print "\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'}++; } sub save_data # # Save the data to a MySQL database # { use DBI; my $tstart = time; my $DBname = "mailstats"; my $host = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBHost') || "localhost"; my $port = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBPort') || "3306"; print "Saving data.."; my $dbh = DBI->connect( "DBI:mysql:database=$DBname;host=$host;port=$port", "mailstats", "mailstats" ) or die "Cannot open mailstats db - has it beeen created?"; my $hour = floor( $start / 3600 ); my $reportdate = strftime( "%F", localtime( $hour * 3600 ) ); my $dateid = get_dateid($dbh,$reportdate); my $reccount = 0; #count number of records written my $servername = esmith::ConfigDB->open_ro->get('SystemName')->value . "." . esmith::ConfigDB->open_ro->get('DomainName')->value; # now fill in day related stats - must always check for it already there # incase the module is run more than once in a day my $SAScoresid = check_date_rec($dbh,"SAscores",$dateid,$servername); $dbh->do( "UPDATE SAscores SET ". "acceptedcount=".$spamcount. ",rejectedcount=".$above15. ",hamcount=".$hamcount. ",acceptedscore=".$spamhits. ",rejectedscore=".$rejectspamhits. ",hamscore=".$hamhits. ",totalsmtp=".$totalexamined. ",totalrecip=".$recipcount. ",servername='".$servername. "' WHERE SAscoresid =".$SAScoresid); # Junkmail stats # delete if already there $dbh->do("DELETE from JunkMailStats WHERE dateid = ".$dateid." AND servername='".$servername."'"); # and add records foreach my $thisuser (keys %junkcount){ $dbh->do("INSERT INTO JunkMailStats (dateid,user,count,servername) VALUES ('". $dateid."','".$thisuser."','".$junkcount{$thisuser}."','".$servername."')"); $reccount++; } #SA rules - delete any first $dbh->do("DELETE from SARules WHERE dateid = ".$dateid." AND servername='".$servername."'"); # and add records foreach my $thisrule (keys %found_SARules){ $dbh->do("INSERT INTO SARules (dateid,rule,count,totalhits,servername) VALUES ('". $dateid."','".$thisrule."','".$found_SARules{$thisrule}{'count'}."','". $found_SARules{$thisrule}{'totalhits'}."','".$servername."')"); $reccount++; } #qpsmtpd result codes $dbh->do("DELETE from qpsmtpdcodes WHERE dateid = ".$dateid." AND servername='".$servername."'"); # and add records foreach my $thiscode (keys %found_qpcodes){ $dbh->do("INSERT INTO qpsmtpdcodes (dateid,reason,count,servername) VALUES ('". $dateid."','".$thiscode."','".$found_qpcodes{$thiscode}."','".$servername."')"); $reccount++; } # virus stats $dbh->do("DELETE from VirusStats WHERE dateid = ".$dateid." AND servername='".$servername."'"); # and add records foreach my $thisvirus (keys %found_viruses){ $dbh->do("INSERT INTO VirusStats (dateid,descr,count,servername) VALUES ('". $dateid."','".$thisvirus."','".$found_viruses{$thisvirus}."','".$servername."')"); $reccount++; } # domain details $dbh->do("DELETE from domains WHERE dateid = ".$dateid." AND servername='".$servername."'"); # and add records foreach my $domain (keys %byrcptdomain){ next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 ); $dbh->do("INSERT INTO domains (dateid,domain,type,total,denied,xfererr,accept,servername) VALUES ('". $dateid."','".$domain."','".($byrcptdomain{$domain}{'type'}||'other')."','" .$byrcptdomain{$domain}{'total'}."','" .($byrcptdomain{$domain}{'deny'}||0)."','" .($byrcptdomain{$domain}{'xfer'}||0)."','" .($byrcptdomain{$domain}{'accept'}||0)."','" .$servername ."')"); $reccount++; } # finally - the hourly breakdown # need to remember here that the date might change during the 24 hour span my $nhour = floor( $start / 3600 ); my $ncateg; while ( $nhour < $end / 3600 ) { #see if the time record has been created # print strftime("%H",localtime( $nhour * 3600 ) ).":00:00\n"; my $sth = $dbh->prepare( "SELECT timeid FROM time WHERE time = '" . strftime("%H",localtime( $nhour * 3600 ) ).":00:00'"); $sth->execute(); if ( $sth->rows == 0 ) { #create entry $dbh->do( "INSERT INTO time (time) VALUES ('" .strftime("%H",localtime( $nhour * 3600 ) ).":00:00')" ); # and pick up timeid $sth = $dbh->prepare("SELECT last_insert_id() AS timeid FROM time"); $sth->execute(); $reccount++; } my $timerec = $sth->fetchrow_hashref(); my $timeid = $timerec->{"timeid"}; $ncateg = 0; # and extract date from first column of $count array my $currentdate = strftime( "%F", localtime( $hour * 3600 ) ); # print "$currentdate.\n"; if ($currentdate ne $reportdate) { #same as before? $dateid = get_dateid($dbh,$currentdate); $reportdate = $currentdate; } # delete for this date and time $dbh->do("DELETE from ColumnStats WHERE dateid = ".$dateid." AND timeid = ".$timeid." AND servername='".$servername."'"); while ( $ncateg < @categs-1 ) { # then add in each entry if (($counts{$nhour}{$categs[$ncateg]} || 0) != 0) { $dbh->do("INSERT INTO ColumnStats (dateid,timeid,descr,count,servername) VALUES (" .$dateid.",".$timeid.",'".$categs[$ncateg]."'," .$counts{$nhour}{$categs[$ncateg]}.",'".$servername."')"); $reccount++; } # print("INSERT INTO ColumnStats (dateid,timeid,descr,count) VALUES (" # .$dateid.",".$timeid.",'".$categs[$ncateg]."'," # .$counts{$nhour}{$categs[$ncateg]}.")\n"); $ncateg++; } $nhour++; } # and write out the log lines saved - only if html wanted if ($makeHTMLemail eq 'yes' or $makeHTMLemail eq 'both' or $makeHTMLpage eq 'yes'){ foreach my $logid (keys %LogLines){ $reccount++; #Extract from keys my $extract = $logid; $extract =~/^(.*)-(.*):(.*)$/; my $Log64n = $1; my $LogMailId = $2; my $LogSeq = $3; my $LogLine = $dbh->quote($LogLines{$logid}); my $sql = "INSERT INTO LogData (Log64n,MailID,Sequence,LogStr) VALUES ('"; $sql .= $Log64n."','".$LogMailId."','".$LogSeq."',".$LogLine.")"; $dbh->do($sql) or die($sql); } $dbh->disconnect(); $telapsed = time - $tstart; print "Saved $reccount records in $telapsed sec."; } } sub check_date_rec # # check that a specific dated rec is there, create if not # { my ( $dbh, $table, $dateid ) = @_; my $sth = $dbh->prepare( "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid'" ); $sth->execute(); if ( $sth->rows == 0 ) { #create entry $dbh->do( "INSERT INTO ".$table." (dateid) VALUES ('" . $dateid . "')" ); # and pick up recordid $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table); $sth->execute(); } my $rec = $sth->fetchrow_hashref(); $rec->{$table."id"}; #return the id of the reocrd (new or not) } sub check_time_rec # # check that a specific dated amd timed rec is there, create if not # { my ( $dbh, $table, $dateid, $timeid ) = @_; my $sth = $dbh->prepare( "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid' AND timeid = ".$timeid ); $sth->execute(); if ( $sth->rows == 0 ) { #create entry $dbh->do( "INSERT INTO ".$table." (dateid,timeid) VALUES ('" . $dateid . "', '".$timeid."')" ); # and pick up recordid $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table); $sth->execute(); } my $rec = $sth->fetchrow_hashref(); $rec->{$table."id"}; #return the id of the record (new or not) } sub get_dateid # # Check that date is in db, and return corresponding id # { my ($dbh,$reportdate) = @_; my $sth = $dbh->prepare( "SELECT dateid FROM date WHERE date = '" . $reportdate."'" ); $sth->execute(); if ( $sth->rows == 0 ) { #create entry $dbh->do( "INSERT INTO date (date) VALUES ('" . $reportdate . "')" ); # and pick up dateid $sth = $dbh->prepare("SELECT last_insert_id() AS dateid FROM date"); $sth->execute(); } my $daterec = $sth->fetchrow_hashref(); $daterec->{"dateid"}; } sub dump_entries { my $msg = shift; #if ($opt{debug} == 1){exit;} } #sub test_for_private_ip { #use NetAddr::IP; #my $ip = shift; #$ip =~ s/^\D*(([0-9]{1,3}\.){3}[0-9]{1,3}).*/$1/e; #print "\nIP:$ip"; #my $nip = NetAddr::IP->new($ip); #if ($nip){ #if ( $nip->is_rfc1918() ){ #return 1; #} else { return 0} #} else { return 0} #} sub test_for_private_ip { use NetAddr::IP; $_ = shift; return unless /(\d+\.\d+\.\d+\.\d+)/; my $ip = NetAddr::IP->new($1); return unless $ip; return $ip->is_rfc1918(); }