1903 lines
67 KiB
Perl
1903 lines
67 KiB
Perl
|
#!/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")
|
||
|
|
# / <column header> ("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/,/></g;
|
||
|
|
$DMARC_Report_emails .= "<".$emailaddress.">\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,(.*)</ )
|
||
|
|
#if ( $_ =~m/spamassassin plugin.*: check_spam:.*hits=(.*), required.*tests=(.*)/ )
|
||
|
|
{
|
||
|
|
#New version does not seem to have spammassasin tests in logs
|
||
|
|
#if (exists($2){
|
||
|
|
#my (@SAtests) = split(',',$2);
|
||
|
|
#foreach my $SAtest (@SAtests) {
|
||
|
|
#if (!$SAtest eq "") {
|
||
|
|
#$found_SARules{$SAtest}{'count'}++;
|
||
|
|
#$found_SARules{$SAtest}{'totalhits'} += $1;
|
||
|
|
#$sum_SARules++
|
||
|
|
#}
|
||
|
|
#}
|
||
|
|
#}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#Pull out Geoip countries for analysis table
|
||
|
|
if ( $_ =~m/check_badcountries: GeoIP Country: (.*)/ )
|
||
|
|
{
|
||
|
|
$found_countries{$1}++;
|
||
|
|
$total_countries++;
|
||
|
|
}
|
||
|
|
|
||
|
|
#Pull out DMARC approvals
|
||
|
|
if ( $_ =~m/.*$DMARCOkPattern.*/ )
|
||
|
|
{
|
||
|
|
$DMARCOkCount++;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#only select Logterse output
|
||
|
|
next LINE unless m/logging::logterse:/;
|
||
|
|
|
||
|
|
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);
|
||
|
|
|
||
|
|
my $result= "rejected"; #Tag as rejected unti we know otherwise
|
||
|
|
# we store the more recent recipient domain, for domain statistics
|
||
|
|
# in fact, we only store the first recipient. Could be sort of headhache
|
||
|
|
# to obtain precise stats with many recipients on more than one domain !
|
||
|
|
my $proc = $timestamp_items[1] ; #numeric Id for the email
|
||
|
|
my $emailnum = $proc; #proc gets modified later...
|
||
|
|
|
||
|
|
if ($emailnum == 23244) {
|
||
|
|
}
|
||
|
|
|
||
|
|
$totalexamined++;
|
||
|
|
|
||
|
|
|
||
|
|
# first spot the fetchmail and local deliveries.
|
||
|
|
|
||
|
|
# Spot from local workstation
|
||
|
|
$localflag = 0;
|
||
|
|
$WebMailflag = 0;
|
||
|
|
if ( $log_items[1] =~ m/$DomainName/ ) { #bjr
|
||
|
|
$localsendtotal++;
|
||
|
|
$counts{$abshour}{$CATLOCAL}++;
|
||
|
|
$localflag = 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
#Or a remote station
|
||
|
|
elsif ((!test_for_private_ip($log_items[0])) and (test_for_private_ip($log_items[2])) and ($log_items[5] eq "queued"))
|
||
|
|
{
|
||
|
|
#Remote user
|
||
|
|
$localflag = 1;
|
||
|
|
$counts{$abshour}{$CATRELAY}++;
|
||
|
|
}
|
||
|
|
|
||
|
|
elsif (($log_items[2] =~ m/$WebmailIP/) and (!test_for_private_ip($log_items[0]))) {
|
||
|
|
#Webmail
|
||
|
|
$localflag = 1;
|
||
|
|
$WebMailsendtotal++;
|
||
|
|
$counts{$abshour}{$CATWEBMAIL}++;
|
||
|
|
$WebMailflag = 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 {
|
||
|
|
$localflag = 1;
|
||
|
|
# might still be from mailman here
|
||
|
|
if ( $log_items[3] =~ m/$MAILMAN/ ) {
|
||
|
|
$mailmansendcount++;
|
||
|
|
$localsendtotal++;
|
||
|
|
$counts{$abshour}{$CATMAILMAN}++;
|
||
|
|
$localflag = 1;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
#Or sent to the DMARC server
|
||
|
|
#check for email address in $DMARC_Report_emails string
|
||
|
|
my $logemail = $log_items[4];
|
||
|
|
if ((index($DMARC_Report_emails,$logemail)>=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 .="<!DOCTYPE html> <html>\n";
|
||
|
|
$html .= "<head><title>Mailstats -".strftime( "%F", localtime($start) )."</title>";
|
||
|
|
$html .= "<link rel='stylesheet' type='text/css' href='mailstats.css' /></head>\n";
|
||
|
|
$html .= "<body>\n";
|
||
|
|
$html .= $conv->process_chunk($text);
|
||
|
|
$html .= "</body></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();
|
||
|
|
}
|