smecontribs/smeserver-mailstats
7
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
906448378f
smeserver-mailstats/root/usr/bin/mailstats.pl

1903 lines
67 KiB
Perl
Raw Normal View History

initial commit of file from CVS for smeserver-mailstats on Sun 9 Jul 11:18:48 BST 2023
2023-07-09 12:18:48 +02:00
#!/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}++;
}
Fix up counts in main table
2024-06-25 13:52:12 +02:00
elsif (($log_items[2] =~ m/$WebmailIP/) and (!test_for_private_ip($log_items[0]))) {
initial commit of file from CVS for smeserver-mailstats on Sun 9 Jul 11:18:48 BST 2023
2023-07-09 12:18:48 +02:00
#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 {
Fix up counts in main table
2024-06-25 13:52:12 +02:00
#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;
}
}
initial commit of file from CVS for smeserver-mailstats on Sun 9 Jul 11:18:48 BST 2023
2023-07-09 12:18:48 +02:00
}
}
}
# 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();
}
Copy Permalink