/[smecontribs]/rpms/smeserver-mailstats/contribs9/smeserver-mailstats-1.1.bz10858_10327.cleanup_and_email_truncate.patch
ViewVC logotype

Annotation of /rpms/smeserver-mailstats/contribs9/smeserver-mailstats-1.1.bz10858_10327.cleanup_and_email_truncate.patch

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Tue Jan 7 10:12:12 2020 UTC (4 years, 4 months ago) by brianr
Branch: MAIN
CVS Tags: smeserver-mailstats-1_1-12_el6_sme, smeserver-mailstats-1_1-11_el6_sme, HEAD
*** empty log message ***

1 brianr 1.1 diff -urN smeserver-mailstats-1.1.old/root/etc/cron.d/mailstats.cron smeserver-mailstats-1.1/root/etc/cron.d/mailstats.cron
2     --- smeserver-mailstats-1.1.old/root/etc/cron.d/mailstats.cron 2020-01-03 09:09:24.548263432 +0000
3     +++ smeserver-mailstats-1.1/root/etc/cron.d/mailstats.cron 2020-01-03 12:35:36.668239291 +0000
4     @@ -1,2 +1,2 @@
5     -0 0 * * * root sleep $[ $RANDOM \% 3600 ]; perl /usr/bin/spamfilter-stats-7.pl /var/log/qpsmtpd/\@* /var/log/qpsmtpd/current /var/log/sqpsmtpd/\@* /var/log/sqpsmtpd/current
6     +0 0 * * * root sleep $[ $RANDOM \% 3600 ]; perl /usr/bin/mailstats.pl /var/log/qpsmtpd/\@* /var/log/qpsmtpd/current /var/log/sqpsmtpd/\@* /var/log/sqpsmtpd/current
7    
8     diff -urN smeserver-mailstats-1.1.old/root/usr/bin/mailstats.pl smeserver-mailstats-1.1/root/usr/bin/mailstats.pl
9     --- smeserver-mailstats-1.1.old/root/usr/bin/mailstats.pl 1970-01-01 01:00:00.000000000 +0100
10     +++ smeserver-mailstats-1.1/root/usr/bin/mailstats.pl 2020-01-03 12:26:47.043199450 +0000
11     @@ -0,0 +1,1896 @@
12     +#!/usr/bin/perl -w
13     +
14     +#############################################################################
15     +#
16     +# This script provides daily SpamFilter statistics.
17     +#
18     +# This script was originally developed
19     +# by Jesper Knudsen at http://sme.swerts-knudsen.dk
20     +# and re-written by brian read at bjsystems.co.uk (with some help from the community - thanks guys)
21     +#
22     +# bjr - 02sept12 - Add in qpsmtpd failure code auth::auth_cvm_unix_local as per Bug 7089
23     +# bjr - 10Jun15 - Sort out multiple files as input parameters as per bug 5613
24     +# - Sort out geoip failure status as per Bug 4262
25     +# - change final message about the DB (it is created automatically these days by the rpm)
26     +# bjr - 17Jun15 - Add annotation showing Badcountries being eliminated
27     +# - correct Spamfilter details extract, as per Bug 8656
28     +# - Add analysis table of Geoip results
29     +# bjr - 19Jun15 - Add totals for the League tables
30     +# bjr and Unnilennium - 08Apr16 - Add in else for unrecognised plugin detection
31     +# bjr - 08Apr16 - Add in link for SaneSecurity "extra" virus detection
32     +# bjr - 14Jun16 - make compatible with qpsmtpd 0.96
33     +# bjr - 16Jun16 - Add code to create an html equivalent of the text email (v0.7)
34     +# bjr - 04Aug16 - Add code to log and count the blacklist RBL urls that have triggered, this (NFR) is Bugzilla 9717
35     +# bjr - 04Aug16 - Add code to expand the junkmail table to include daily ham and spam and deleted spam for each user - (NFR bugzilla 9716)
36     +# bjr - 05Aug16 - Add code to log remote relay incoming emails
37     +# bjr - 10Oct16 - Add code to show stats for the smeoptimizer package
38     +# bjr - 16dec16 - Fix dnsbl code to deal with psbl.surriel.com - Bug 9717
39     +# bjr - 16Dec16 - Change geopip table code to show even if no exclusions found (assuming geoip data found) - Bug 9888
40     +# bjr - 30Apr17 - Change Categ index code - Bug 9888 again
41     +# bjr - 18Dec19 - Sort out a few format problems and also remove some debugging crud - Bug 10858
42     +# bjr - 18Dec19 - change to fix truncation of email address in by email table - bug 10327
43     +#
44     +#############################################################################
45     +#
46     +# SMEServer DB usage
47     +# ------------------
48     +#
49     +# mailstats / Status ("enabled"|"disabled")
50     +# / <column header> ("yes"|"no"|"auto") - enable, supress or only show if nonzero
51     +# / QpsmtpdCodes ("enabled"|"disabled")
52     +# / SARules ("enabled"|"disabled")
53     +# / GeoipTable ("enabled"|"disabled")
54     +# / GeoipCutoffPercent (0.5%) - threshold to show Geoip country in league table
55     +# / JunkMailList ("enabled"|"disabled")
56     +# / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff
57     +# / Email (admin) - email to send report
58     +# / SaveDataToMySQL - save data to MySQL database (default is "no")
59     +# / ShowLeagueTotals - Show totals row after league tables - (default is "yes")
60     +# / DBHost - MySQL server hostname (default is "localhost").
61     +# / DBPort - MySQL server post (default is "3306")
62     +# / Interval - "daily", "weekly", "fortnightly", "monthly", "99999" - last is number of hours (default is daily)
63     +# / Base - "Midnight", "Midday", "Now", "99" hour (0-23) (default is midnight)
64     +# / HTMLEmail - "yes", "no", "both" - default is "No" - Send email in HTML
65     +# NOT YET INUSE - WIP!
66     +# / HTMLPage - "yes" / "no" - default is "yes" if HTMLEmail is "yes" or "both" otherwise "no"
67     +#
68     +#############################################################################
69     +#
70     +#
71     +# TODO
72     +#
73     +# 1. Delete loglines records from any previous run of same table
74     +# 2. Add tracking LogId for each cont in the table
75     +# 3. Use link directory file to generate h1 / h2 tags for title and section headings
76     +# 4. Ditto for links to underlying data
77     +#
78     +
79     +# internal modules (part of core perl distribution)
80     +use strict;
81     +use warnings;
82     +use Getopt::Long;
83     +use Pod::Usage;
84     +use POSIX qw/strftime floor/;
85     +use Time::Local;
86     +use Date::Parse;
87     +use Time::TAI64;
88     +use esmith::ConfigDB;
89     +use esmith::DomainsDB;
90     +use Sys::Hostname;
91     +use Switch;
92     +use DBIx::Simple;
93     +use URI::URL;
94     +
95     +#use CGI;
96     +#use HTML::TextToHTML;
97     +
98     +my $hostname = hostname();
99     +my $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n";
100     +
101     +my $true = 1;
102     +my $false = 0;
103     +#and see if mailstats are disabled
104     +my $disabled;
105     +if ($cdb->get('mailstats')){
106     + $disabled = !(($cdb->get('mailstats')->prop('Status') || 'enabled') eq 'enabled');
107     +} else {
108     + my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled', Email => 'admin' });
109     + $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n"; #Open up again to pick up new record
110     + $disabled = $false;
111     +}
112     +
113     +#Configuration section
114     +my %opt = (
115     + version => '0.7.13', # please update at each change.
116     + debug => 0, # guess what ?
117     + sendmail => '/usr/sbin/sendmail', # Path to sendmail stub
118     + from => 'spamfilter-stats', # Who is the mail from
119     + mail => $cdb->get('mailstats')->prop('Email') || 'admin', # mailstats email recipient
120     + timezone => `date +%z`,
121     +);
122     +
123     +my $FetchmailIP = '127.0.0.200'; #Apparent Ip address of fetchmail deliveries
124     +my $WebmailIP = '127.0.0.1'; #Apparent Ip of Webmail sender
125     +my $localhost = 'localhost'; #Apparent sender for webmail
126     +my $FETCHMAIL = 'FETCHMAIL'; #Sender from fetchmail when Ip address not 127.0.0.200 - when qpsmtpd denies the email
127     +my $MAILMAN = "bounces"; #sender when mailman sending when orig is localhost
128     +my $DMARCDomain="dmarc"; #Pattern to recognised DMARC sent emails (this not very reliable, as the email address could be anything)
129     +my $DMARCOkPattern="dmarc: pass"; #Pattern to use to detect DMARC approval
130     +my $localIPregexp = ".*((127\.)|(10\.)|(172\.1[6-9]\.)|(172\.2[0-9]\.)|(172\.3[0-1]\.)|(192\.168\.)).*";
131     +my $MinCol = 6; #Minimum column width
132     +my $HourColWidth = 16; #Date and time column width
133     +
134     +my $SARulethresholdPercent = 10; #If Sa rules less than this of total emails, then cutoff reduced
135     +my $maxcutoff = 1; #max percent cutoff applied
136     +my $mincutoff = 0.2; #min percent cutoff applied
137     +
138     +my $tstart = time;
139     +
140     +#Local variables
141     +my $YEAR = ( localtime(time) )[5]; # this is years since 1900
142     +
143     +my $total = 0;
144     +my $spamcount = 0;
145     +my $spamavg = 0;
146     +my $spamhits = 0;
147     +my $hamcount = 0;
148     +my $hamavg = 0;
149     +my $hamhits = 0;
150     +my $rejectspamavg = 0;
151     +my $rejectspamhits= 0;
152     +
153     +my $Accepttotal = 0;
154     +my $localAccepttotal = 0; #Fetchmail connections
155     +my $localsendtotal = 0; #Connections from local PCs
156     +my $totalexamined = 0; #total download + RBL etc
157     +my $WebMailsendtotal = 0; #total from Webmail
158     +my $mailmansendcount = 0; #total from mailman
159     +my $DMARCSendCount = 0; #total DMARC reporting emails sent (approx)
160     +my $DMARCOkCount = 0; #Total emails approved through DMARC
161     +
162     +
163     +
164     +my %found_viruses = ();
165     +my %found_qpcodes = ();
166     +my %found_SARules = ();
167     +my %junkcount = ();
168     +my %unrecog_plugin = ();
169     +my %blacklistURL = (); #Count of use of each balcklist rhsbl
170     +my %usercounts = (); #Count per received email of sucessful delivery, queued spam and deleted Spam, and rejected
171     +
172     +# replaced by...
173     +my %counts = (); #Hold all counts in 2-D matrix
174     +my @display = (); #used to switch on and off columns - yes, no or auto for each category
175     +my @colwidth = (); #width of each column
176     + #(auto means only if non zero) - populated from possible db entries
177     +my @finaldisplay = (); #final decision on display or not - true or false
178     +
179     +#count column names, used for headings - also used for DB mailstats property names
180     +my $CATHOUR='Hour';
181     +my $CATFETCHMAIL='Fetchmail';
182     +my $CATWEBMAIL='WebMail';
183     +my $CATMAILMAN='Mailman';
184     +my $CATLOCAL='Local';
185     +my $CATRELAY="Relay";
186     +# border between where it came from and where it ended..
187     +my $countfromhere = 6; #Temp - Check this not moved!!
188     +
189     +my $CATVIRUS='Virus';
190     +my $CATRBLDNS='RBL/DNS';
191     +my $CATEXECUT='Execut.';
192     +my $CATNONCONF='Non.Conf.';
193     +my $CATBADCOUNTRIES='Geoip.';
194     +my $CATKARMA="Karma";
195     +
196     +my $CATSPAMDEL='Del.Spam';
197     +my $CATSPAM='Qued.Spam?';
198     +my $CATHAM='Ham';
199     +my $CATTOTALS='TOTALS';
200     +my $CATPERCENT='PERCENT';
201     +my $CATDMARC="DMARC Rej.";
202     +my $CATLOAD="Rej.Load";
203     +my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATRELAY,$CATDMARC,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATBADCOUNTRIES,$CATNONCONF,$CATLOAD,$CATKARMA,$CATSPAMDEL,$CATSPAM,$CATHAM,$CATTOTALS,$CATPERCENT);
204     +my $GRANDTOTAL = '99'; #subs for count arrays, for grand total
205     +my $PERCENT = '98'; # for column percentages
206     +
207     +my $categlen = @categs-2; #-2 to avoid the total and percent column
208     +
209     +#
210     +# Index for certain columns - check these do not move if we add columns
211     +#
212     +#my $BadCountryCateg=9;
213     +#my $DMARCcateg = 5; #Not used.
214     +#my $KarmaCateg=$BadCountryCateg+3;
215     +
216     +my %categindex;
217     +@categindex{@categs} = (0..$#categs);
218     +my $BadCountryCateg=$categindex{$CATBADCOUNTRIES};
219     +my $DMARCcateg = $categindex{$CATDMARC}; #Not used.
220     +my $KarmaCateg=$categindex{$CATKARMA};
221     +
222     +my $above15 = 0;
223     +my $RBLcount = 0;
224     +my $MiscDenyCount = 0;
225     +my $PatternFilterCount = 0;
226     +my $noninfectedcount = 0;
227     +my $okemailcount = 0;
228     +my $infectedcount = 0;
229     +my $warnnoreject = " ";
230     +my $rblnotset = ' ';
231     +
232     +my %found_countries = ();
233     +my $total_countries = 0;
234     +my $BadCountries = ""; #From the DB
235     +
236     +my $FS = "\t"; # field separator used by logterse plugin
237     +my %log_items = ( "", "", "", "", "", "", "", "" );
238     +my $score;
239     +my %timestamp_items = ();
240     +my $localflag = 0; #indicate if current email is local or not
241     +my $WebMailflag = 0; #indicate if current mail is send from webmail
242     +
243     +# some storage for by recipient domains stats (PS)
244     +# my bad : I have to deal with multiple simoultaneous connections
245     +# will play with the process number.
246     +# my $currentrcptdomain = '' ;
247     +my %currentrcptdomain ; # temporay store the recipient domain until end of mail processing
248     +my %byrcptdomain ; # Store 'by domains stats'
249     +my @extdomain ; # only useful in some MX-Backup case, when any subdomains are allowed
250     +my $morethanonercpt = 0 ; # count every 'second' recipients for a mail.
251     +my $recipcount = 0; # count every recipient email address received.
252     +
253     +#
254     +#Load up the emails curreently stored for DMARC reporting - so that we cna spot the reports being sent.
255     +#Held in an slqite db, created by the DMARC perl lib.
256     +#
257     +my $dsn = "dbi:SQLite:dbname=/var/lib/qpsmtpd/dmarc/reports.sqlite"; #Taken from /etc/mail-dmarc.ini
258     +# doesn't seem to need
259     +my $user = "";
260     +my $pass = "";
261     +my $DMARC_Report_emails = ""; #Flat string of all email addresses
262     +
263     + if (my $dbix = DBIx::Simple->connect( $dsn, $user, $pass )){
264     + my $result = $dbix->query("select rua from report_policy_published;");
265     + $result->bind(my ($emailaddress));
266     + while ($result->fetch){
267     + #remember email from logterse entry has chevrons round it - so we add them here to guarantee the alighment of the match
268     + #Remove the mailto:
269     + $emailaddress =~ s/mailto://g;
270     + # and map any commas to ><
271     + $emailaddress =~ s/,/></g;
272     + $DMARC_Report_emails .= "<".$emailaddress.">\n"
273     + }
274     + $dbix->disconnect();
275     + } else { $DMARC_Report_emails = "None found - DB not opened"}
276     +
277     +
278     +
279     +# and setup list of local domains for spotting the local one in a list of email addresses (Remote station processing)
280     +use esmith::DomainsDB;
281     +my $d = esmith::DomainsDB->open_ro();
282     +my @domains = $d->keys();
283     +my $alldomains = "(";
284     +foreach my $dom (@domains){$alldomains .= $dom."|"}
285     +$alldomains .= ")";
286     +
287     +# Saving the Log lines processed
288     +my %LogLines = (); #Save all the log lines processed for writing to the DB
289     +my %LogId = (); #Save the Log Ids.
290     +my $CurrentLogId = "";
291     +my $Sequence = 0;
292     +
293     +
294     +# store the domain of interest. Every other records are stored in a 'Other' zone
295     +my $ddb = esmith::DomainsDB->open_ro or die "Couldn't open DomainsDB : $!\n";
296     +
297     +foreach my $domain( $ddb->get_all_by_prop( type => "domain" ) ) {
298     + $byrcptdomain{ $domain->key }{ 'type' }='local';
299     +}
300     +$byrcptdomain{ $cdb->get('SystemName')->value . "."
301     + . $cdb->get('DomainName')->value }{ 'type' } = 'local';
302     +
303     +# is this system a MX-Backup ?
304     +if ($cdb->get('mxbackup')){
305     + if ( ( $cdb->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) {
306     + my %MXValues = split( /,/, ( $cdb->get('mxbackup')->prop('name') || '' ) ) ;
307     + foreach my $data ( keys %MXValues ) {
308     + $byrcptdomain{ $data }{ 'type' } = "mxbackup-$MXValues{ $data }" ;
309     + if ( $MXValues{ $data } == 1 ) { # subdomains allowed, must take care of this
310     + push @extdomain, $data ;
311     + }
312     + }
313     + }
314     +}
315     +
316     +my ( $start, $end ) = analysis_period();
317     +
318     +
319     +#
320     +# First check current configuration for logging, DNS enable and Max threshold for spamassassin
321     +#
322     +
323     +my $LogLevel = $cdb->get('qpsmtpd')->prop('LogLevel');
324     +my $HighLogLevel = ( $LogLevel > 6 );
325     +
326     +my $RHSenabled =
327     + ( $cdb->get('qpsmtpd')->prop('RHSBL') eq 'enabled' );
328     +my $DNSenabled =
329     + ( $cdb->get('qpsmtpd')->prop('DNSBL') eq 'enabled' );
330     +my $SARejectLevel =
331     + $cdb->get('spamassassin')->prop('RejectLevel');
332     +my $SATagLevel =
333     + $cdb->get('spamassassin')->prop('TagLevel');
334     +my $DomainName =
335     + $cdb->get('DomainName')->value;
336     +
337     +# check that logterse is in use
338     +#my pluginfile = '/var/service/qpsmtpd/config/peers/0';
339     +
340     +if ( !$RHSenabled || !$DNSenabled ) {
341     + $rblnotset = '*';
342     +}
343     +
344     +if ( $SARejectLevel == 0 ) {
345     +
346     + $warnnoreject = "(*Warning* 0 = no reject)";
347     +
348     +}
349     +
350     +# get enable/disable subsections
351     +my $enableqpsmtpdcodes;
352     +my $enableSARules;
353     +my $enableGeoiptable;
354     +my $enablejunkMailList;
355     +my $savedata;
356     +my $enableblacklist; #Enabled according to setting in qpsmtpd
357     +if ($cdb->get('mailstats')){
358     + $enableqpsmtpdcodes = ($cdb->get('mailstats')->prop("QpsmtpdCodes") || "enabled") eq "enabled" || $false;
359     + $enableSARules = ($cdb->get('mailstats')->prop("SARules") || "enabled") eq "enabled" || $false;
360     + $enablejunkMailList = ($cdb->get('mailstats')->prop("JunkMailList") || "enabled") eq "enabled" || $false;
361     + $enableGeoiptable = ($cdb->get('mailstats')->prop("Geoiptable") || "enabled") eq "enabled" || $false;
362     + $savedata = ($cdb->get('mailstats')->prop("SaveDataToMySQL") || "no") eq "yes" || $false;
363     + } else {
364     + $enableqpsmtpdcodes = $true;
365     + $enableSARules = $true;
366     + $enablejunkMailList = $true;
367     + $enableGeoiptable = $true;
368     + $savedata = $false;
369     + }
370     + $enableblacklist = ($cdb->get('qpsmtpd')->prop("RHSBL") || "disabled") eq "enabled" || ($cdb->get('qpsmtpd')->prop("URIBL") || "disabled") eq "enabled";
371     +
372     +my $makeHTMLemail = "no";
373     +#if ($cdb->get('mailstats')){$makeHTMLemail = $cdb->get('mailstats')->prop('HTMLEmail') || "no"} #TEMP!!
374     +my $makeHTMLpage = "no";
375     +#if ($makeHTMLemail eq "yes" || $makeHTMLemail eq "both") {$makeHTMLpage = "yes"}
376     +#if ($cdb->get('mailstats')){$makeHTMLpage = $cdb->get('mailstats')->prop('HTMLPage') || "no"}
377     +
378     +
379     +# Init the hashes
380     +my $nhour = floor( $start / 3600 );
381     +my $ncateg;
382     +while ( $nhour < $end / 3600 ) {
383     + $counts{$nhour}=();
384     + $ncateg = 0;
385     + while ( $ncateg < @categs) {
386     + $counts{$nhour}{$categs[$ncateg-1]} = 0;
387     + $ncateg++
388     + }
389     + $nhour++;
390     +}
391     +# and grand totals, percent and display status from db entries, and column widths
392     +$ncateg = 0;
393     +my $colpadding = 0;
394     +while ( $ncateg < @categs) {
395     + $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0;
396     + $counts{$PERCENT}{$categs[$ncateg]} = 0;
397     +
398     + if ($cdb->get('mailstats')){
399     + $display[$ncateg] = lc($cdb->get('mailstats')->prop($categs[$ncateg])) || "auto";
400     + } else {
401     + $display[$ncateg] = 'auto'
402     + }
403     + if ($ncateg == 0) {
404     + $colwidth[$ncateg] = $HourColWidth + $colpadding;
405     + } else {
406     + $colwidth[$ncateg] = length($categs[$ncateg])+1+$colpadding;
407     + }
408     + if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol + $colpadding}
409     + $ncateg++
410     +}
411     +
412     +my $starttai = Time::TAI64::unixtai64n($start);
413     +my $endtai = Time::TAI64::unixtai64n($end);
414     +my $sum_SARules = 0;
415     +
416     +# we remove non valid files
417     +my @ARGV2;
418     +foreach ( map { glob } @ARGV){
419     + push(@ARGV2,($_));
420     +}
421     +@ARGV=@ARGV2;
422     +
423     +my $count = -1; #for loop reduction in debugging mode
424     +
425     +#
426     +#---------------------------------------
427     +# Scan the qpsmtpd log file(s)
428     +#---------------------------------------
429     +
430     +
431     +my $CurrentMailId = "";
432     +
433     +LINE: while (<>) {
434     +
435     + next LINE if !(my($tai,$log) = split(' ',$_,2));
436     +
437     +
438     + #If date specified, only process lines matching date
439     + next LINE if ( $tai lt $starttai );
440     + next LINE if ( $tai gt $endtai );
441     +
442     + #Count lines and skip out if debugging
443     + $count++;
444     + #last LINE if ($opt{debug} && $count >= 100);
445     +
446     +
447     + #Loglines to Saved String for later DB write
448     + if ($savedata) {
449     + my $CurrentLine = $_;
450     + $CurrentLine = /^\@([0-9a-z]*) ([0-9]*) .*$/;
451     + my $l = length($CurrentLine);
452     + if ($l != 0){
453     + if (defined($2)){
454     + if ($2 ne $CurrentMailId) {
455     + print "CL:$CurrentLine*\n" if !defined($1);
456     + $CurrentLogId = $1."-".$2;
457     + $CurrentMailId = $2;
458     + $Sequence = 0;
459     + } else {$Sequence++}
460     + #$CurrentLogId .=":".$Sequence;
461     + $LogLines{$CurrentLogId.":".$Sequence} = $_;
462     + }
463     + }
464     + }
465     +
466     +
467     + # pull out spamasassin rule lists
468     + if ( $_ =~m/spamassassin: pass, Ham,(.*)</ )
469     + #if ( $_ =~m/spamassassin plugin.*: check_spam:.*hits=(.*), required.*tests=(.*)/ )
470     + {
471     + #New version does not seem to have spammassasin tests in logs
472     + #if (exists($2){
473     + #my (@SAtests) = split(',',$2);
474     + #foreach my $SAtest (@SAtests) {
475     + #if (!$SAtest eq "") {
476     + #$found_SARules{$SAtest}{'count'}++;
477     + #$found_SARules{$SAtest}{'totalhits'} += $1;
478     + #$sum_SARules++
479     + #}
480     + #}
481     + #}
482     +
483     + }
484     +
485     +
486     + #Pull out Geoip countries for analysis table
487     + if ( $_ =~m/check_badcountries: GeoIP Country: (.*)/ )
488     + {
489     + $found_countries{$1}++;
490     + $total_countries++;
491     + }
492     +
493     + #Pull out DMARC approvals
494     + if ( $_ =~m/.*$DMARCOkPattern.*/ )
495     + {
496     + $DMARCOkCount++;
497     + }
498     +
499     +
500     + #only select Logterse output
501     + next LINE unless m/logging::logterse:/;
502     +
503     + my $abstime = Time::TAI64::tai2unix($tai);
504     + my $abshour = floor( $abstime / 3600 ); # Hours since the epoch
505     +
506     +
507     + my ($timestamp_part, $log_part) = split('`',$_,2); #bjr 0.6.12
508     + my (@log_items) = split $FS, $log_part;
509     +
510     + my (@timestamp_items) = split(' ',$timestamp_part);
511     +
512     + my $result= "rejected"; #Tag as rejected unti we know otherwise
513     + # we store the more recent recipient domain, for domain statistics
514     + # in fact, we only store the first recipient. Could be sort of headhache
515     + # to obtain precise stats with many recipients on more than one domain !
516     + my $proc = $timestamp_items[1] ; #numeric Id for the email
517     + my $emailnum = $proc; #proc gets modified later...
518     +
519     + if ($emailnum == 23244) {
520     + }
521     +
522     + $totalexamined++;
523     +
524     +
525     + # first spot the fetchmail and local deliveries.
526     +
527     + # Spot from local workstation
528     + $localflag = 0;
529     + $WebMailflag = 0;
530     + if ( $log_items[1] =~ m/$DomainName/ ) { #bjr
531     + $localsendtotal++;
532     + $counts{$abshour}{$CATLOCAL}++;
533     + $localflag = 1;
534     + }
535     +
536     + #Or a remote station
537     + elsif ((!test_for_private_ip($log_items[0])) and (test_for_private_ip($log_items[2])) and ($log_items[5] eq "queued"))
538     + {
539     + #Remote user
540     + $localflag = 1;
541     + $counts{$abshour}{$CATRELAY}++;
542     + }
543     +
544     + elsif (($log_items[2] =~ m/$WebmailIP/) and (!test_for_private_ip($log_items[0]))) {
545     + #Webmail
546     + $localflag = 1;
547     + $WebMailsendtotal++;
548     + $counts{$abshour}{$CATWEBMAIL}++;
549     + $WebMailflag = 1;
550     + }
551     +
552     + # see if from localhost
553     + elsif ( $log_items[1] =~ m/$localhost/ ) {
554     + # but not if it comes from fetchmail
555     + if ( $log_items[3] =~ m/$FETCHMAIL/ ) { }
556     + else {
557     + $localflag = 1;
558     + # might still be from mailman here
559     + if ( $log_items[3] =~ m/$MAILMAN/ ) {
560     + $mailmansendcount++;
561     + $localsendtotal++;
562     + $counts{$abshour}{$CATMAILMAN}++;
563     + $localflag = 1;
564     + }
565     + else {
566     + #Or sent to the DMARC server
567     + #check for email address in $DMARC_Report_emails string
568     + my $logemail = $log_items[4];
569     + if ((index($DMARC_Report_emails,$logemail)>=0) or ($logemail =~ m/$DMARCDomain/)){
570     + $localsendtotal++;
571     + $DMARCSendCount++;
572     + $localflag = 1;
573     + }
574     + else {
575     + if (exists $log_items[8]){
576     + # ignore incoming localhost spoofs
577     + if ( $log_items[8] =~ m/msg denied before queued/ ) { }
578     + else {
579     + #Webmail
580     + $localflag = 1;
581     + $WebMailsendtotal++;
582     + $counts{$abshour}{$CATWEBMAIL}++;
583     + $WebMailflag = 1;
584     + }
585     + }
586     + else {
587     + $localflag = 1;
588     + $WebMailsendtotal++;
589     + $counts{$abshour}{$CATWEBMAIL}++;
590     + $WebMailflag = 1;
591     + }
592     + }
593     + }
594     + }
595     + }
596     +
597     + # try to spot fetchmail emails
598     + if ( $log_items[0] =~ m/$FetchmailIP/ ) {
599     + $localAccepttotal++;
600     + $counts{$abshour}{$CATFETCHMAIL}++;
601     + }
602     + elsif ( $log_items[3] =~ m/$FETCHMAIL/ ) {
603     + $localAccepttotal++;
604     + $counts{$abshour}{$CATFETCHMAIL}++;
605     + }
606     +
607     +# and adjust for recipient field if not set-up by denying plugin - extract from deny msg
608     +
609     + if ( length( $log_items[4] ) == 0 ) {
610     + if ( $log_items[5] eq 'check_goodrcptto' ) {
611     + if ( $log_items[7] gt "invalid recipient" ) {
612     + $log_items[4] =
613     + substr( $log_items[7], 16 ); #Leave only email address
614     +
615     + }
616     + }
617     + }
618     +
619     + # if ( ( $currentrcptdomain{ $proc } || '' ) eq '' ) {
620     + # reduce to lc and process each e,mail if a list, pseperatedy commas
621     + my $recipientmail = lc( $log_items[4] );
622     + if ( $recipientmail =~ m/.*,/ ) {
623     +
624     + #comma - split the line and deal with each domain
625     + # print $recipientmail."\n";
626     + my ($recipients) = split( ',', $recipientmail );
627     + foreach my $recip ($recipients) {
628     + $proc = $proc . $recip;
629     +
630     + # print $proc."\n";
631     + $currentrcptdomain{$proc} = $recip;
632     + add_in_domain($proc);
633     + $recipcount++;
634     + }
635     +
636     + # print "*\n";
637     + #count emails with more than one recipient
638     + # $recipientmail =~ m/(.*),/;
639     + # $currentrcptdomain{ $proc } = $1;
640     + }
641     + else {
642     + $proc = $proc . $recipientmail;
643     + $currentrcptdomain{$proc} = $recipientmail;
644     + add_in_domain($proc);
645     + $recipcount++;
646     + }
647     +
648     + # } else {
649     + # # there more than a recipient for a mail, how many daily ?
650     + # $morethanonercpt++;
651     + # }
652     +
653     +
654     + # then categorise the result
655     +
656     +
657     + if (exists $log_items[5]) {
658     +
659     + if ($log_items[5] eq 'naughty') {
660     + my $rejreason = $log_items[7];
661     + $rejreason = /.*(\(.*\)).*/;
662     + if (!defined($1)){$rejreason = "unknown"}
663     + else {$rejreason = $1}
664     + $found_qpcodes{$log_items[5]."-".$rejreason}++}
665     + else {$found_qpcodes{$log_items[5]}++} ##Count different qpsmtpd result codes
666     +
667     + if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
668     +
669     + elsif ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
670     +
671     + elsif ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
672     +
673     + elsif ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
674     +
675     + elsif ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
676     +
677     + elsif ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
678     +
679     + elsif ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
680     +
681     + elsif ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
682     +
683     + elsif ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
684     +
685     + elsif ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
686     +
687     + elsif ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
688     +
689     + elsif ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
690     +
691     + elsif ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
692     +
693     + elsif ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)}
694     +
695     + elsif ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)}
696     +
697     + elsif ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
698     +
699     + elsif ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
700     +
701     + elsif ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
702     +
703     + elsif ($log_items[5] eq 'check_badcountries') {$MiscDenyCount++;$counts{$abshour}{$CATBADCOUNTRIES}++;mark_domain_rejected($proc)}
704     +
705     + elsif ($log_items[5] eq 'tnef2mime') { } #Not expecting this one.
706     +
707     + elsif ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++;
708     + # and extract the spam score
709     + # if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)")
710     + if ($log_items[8] =~ "Yes, score=(.*) required=([0-9\.]+)")
711     + {$rejectspamavg += $1}
712     + mark_domain_rejected($proc);
713     + }
714     +
715     + elsif (($log_items[5] eq 'virus::clamav') or ($log_items[5] eq 'virus::clamdscan')) { $infectedcount++;$counts{$abshour}{$CATVIRUS}++;
716     + #extract the virus name
717     + if ($log_items[7] =~ "Virus found: (.*)" ) {$found_viruses{$1}++;}
718     + else {$found_viruses{$log_items[7]}++} #Some other message!!
719     + mark_domain_rejected($proc);
720     + }
721     +
722     + elsif ($log_items[5] eq 'queued') { $Accepttotal++;
723     + #extract the spam score
724     + # Remove count for rejectred as it looks as if it might get through!!
725     + $result= "queued";
726     + if ($log_items[8] =~ ".*score=([+-]?\\d+\.?\\d*).* required=([0-9\.]+)") {
727     + $score = trim($1);
728     + if ($score =~ /^[+-]?\d+\.?\d*$/ ) #check its numeric
729     + {
730     + if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score;}
731     + else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score;$result= "spam";}
732     + } else {
733     + print "Unexpected non numeric found in $proc:".$log_items[8]."($score)\n";
734     + }
735     + } else {
736     + # no SA score - treat it as ham
737     + $hamcount++;$counts{$abshour}{$CATHAM}++;
738     + }
739     + if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
740     + $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ;
741     + $currentrcptdomain{ $proc } = '' ;
742     + }
743     + }
744     +
745     +
746     + elsif ($log_items[5] eq 'tls') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
747     +
748     + elsif ($log_items[5] eq 'auth::auth_cvm_unix_local') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
749     +
750     + elsif ($log_items[5] eq 'earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
751     +
752     + elsif ($log_items[5] eq 'uribl') {$RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
753     +
754     + elsif ($log_items[5] eq 'naughty') {
755     + #Naughty plugin seems to span a number of rejection reasons - so we have to use the next but one log_item[7] to identify
756     + if ($log_items[7] =~ m/(karma)/) {
757     + $MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)}
758     + elsif ($log_items[7] =~ m/(dnsbl)/){
759     + $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
760     + elsif ($log_items[7] =~ m/(helo)/){
761     + $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
762     + else {
763     + #Unidentified Naughty rejection
764     + $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]."-".$log_items[7]}++}
765     + }
766     + elsif ($log_items[5] eq 'resolvable_fromhost') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
767     +
768     + elsif ($log_items[5] eq 'loadcheck') {$MiscDenyCount++;$counts{$abshour}{$CATLOAD}++;mark_domain_rejected($proc)}
769     +
770     + elsif ($log_items[5] eq 'karma') {$MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)}
771     +
772     + elsif ($log_items[5] eq 'dmarc') {$MiscDenyCount++;$counts{$abshour}{$CATDMARC}++;mark_domain_rejected($proc)}
773     +
774     + elsif ($log_items[5] eq 'relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
775     +
776     + elsif ($log_items[5] eq 'headers') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
777     +
778     + elsif ($log_items[5] eq 'mailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
779     +
780     + elsif ($log_items[5] eq 'badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
781     +
782     + elsif ($log_items[5] eq 'helo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
783     +
784     + elsif ($log_items[5] eq 'check_smtp_forward') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
785     +
786     + elsif ($log_items[5] eq 'sender_permitted_from') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
787     +
788     + #Treat it as Unconf if not recognised
789     + else {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]}++}
790     + } #Log[5] exists
791     +
792     + #Entry if not local send
793     + if ($localflag == 0) {
794     + if (length($log_items[4]) > 0){
795     + # Need to check here for multiple email addresses
796     + my @emails = split(",",lc($log_items[4]));
797     + if (scalar(@emails) > 1) {
798     + #Just pick the first local address to hang it on.
799     + # TEMP - just go for the first address until I can work out how to spot the 1st "local" one
800     + $usercounts{$emails[0]}{$result}++;
801     + $usercounts{$emails[0]}{"proc"} = $proc;
802     + #Compare with @domains array until we get a local one
803     + my $gotone = $false;
804     + foreach my $email (@emails){
805     + #Extract the domain from the email address
806     + my $fullemail = $email;
807     + $email = s/.*\@(.*)$/$1/;
808     + #and see if it is local
809     + if ($email =~ m/$alldomains/){
810     + $usercounts{lc($fullemail)}{$result}++;
811     + $usercounts{lc($fullemail)}{"proc"} = $proc;
812     + $gotone = $true;
813     + last;
814     + }
815     + }
816     + if (!$gotone) {
817     + $usercounts{'No internal email $proc'}{$result}++;
818     + $usercounts{'No internal email $proc'}{"proc"} = $proc;
819     + }
820     +
821     + } else {
822     + $usercounts{lc($log_items[4])}{$result}++;
823     + $usercounts{lc($log_items[4])}{"proc"} = $proc;
824     + }
825     + }
826     + }
827     + #exit if $emailnum == 15858;
828     +
829     +} #END OF MAIN LOOP
830     +
831     +#total up grand total Columns
832     +$nhour = floor( $start / 3600 );
833     +while ( $nhour < $end / 3600 ) {
834     + $ncateg = 0; #past the where it came from columns
835     + while ( $ncateg < @categs) {
836     + #total columns
837     + $counts{$GRANDTOTAL}{$categs[$ncateg]} += $counts{$nhour}{$categs[$ncateg]};
838     +
839     + # and total rows
840     + if ( $ncateg < $categlen and $ncateg>=$countfromhere) {#skip initial columns of non final reasons
841     + $counts{$nhour}{$categs[@categs-2]} += $counts{$nhour}{$categs[$ncateg]};
842     + }
843     + $ncateg++
844     + }
845     +
846     + $nhour++;
847     +}
848     +
849     +
850     +
851     +#Compute row totals and row percentages
852     +$nhour = floor( $start / 3600 );
853     +while ( $nhour < $end / 3600 ) {
854     + $counts{$nhour}{$categs[@categs-1]} = $counts{$nhour}{$categs[@categs-2]}*100/$totalexamined if $totalexamined;
855     + $nhour++;
856     +
857     +}
858     +
859     +#compute column percentages
860     + $ncateg = 0;
861     + while ( $ncateg < @categs) {
862     + if ($ncateg == @categs-1) {
863     + $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg-1]}*100/$totalexamined if $totalexamined;
864     + } else {
865     + $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg]}*100/$totalexamined if $totalexamined;
866     + }
867     + $ncateg++
868     + }
869     +
870     +#compute sum of row percentages
871     +$nhour = floor( $start / 3600 );
872     +while ( $nhour < $end / 3600 ) {
873     + $counts{$GRANDTOTAL}{$categs[@categs-1]} += $counts{$nhour}{$categs[@categs-1]};
874     + $nhour++;
875     +
876     +}
877     +
878     +my $QueryNoLogTerse = ($totalexamined==0); #might indicate logterse not installed in qpsmtpd plugins
879     +
880     +#Calculate some numbers
881     +
882     +$spamavg = $spamavg / $spamcount if $spamcount;
883     +$rejectspamavg = $rejectspamavg / $above15 if $above15;
884     +$hamavg = $hamavg / $hamcount if $hamcount;
885     +
886     +# RBL etc percent of total SMTP sessions
887     +
888     +my $rblpercent = ( ( $RBLcount / $totalexamined ) * 100 ) if $totalexamined;
889     +my $PatternFilterpercent = ( ( $PatternFilterCount / $totalexamined ) * 100 ) if $totalexamined;
890     +my $Miscpercent = ( ( $MiscDenyCount / $totalexamined ) * 100 ) if $totalexamined;
891     +
892     +#Spam and virus percent of total email downloaded
893     +#Expressed as a % of total examined
894     +my $spampercent = ( ( $spamcount / $totalexamined ) * 100 ) if $totalexamined;
895     +my $hampercent = ( ( $hamcount / $totalexamined ) * 100 ) if $totalexamined;
896     +my $hrsinperiod = ( ( $end - $start ) / 3600 );
897     +my $emailperhour = ( $totalexamined / $hrsinperiod ) if $totalexamined;
898     +my $above15percent = ( $above15 / $totalexamined * 100 ) if $totalexamined;
899     +my $infectedpercent = ( ( $infectedcount / ($totalexamined) ) * 100 ) if $totalexamined;
900     +my $AcceptPercent = ( ( $Accepttotal / ($totalexamined) ) * 100 ) if $totalexamined;
901     +
902     +my $oldfh;
903     +
904     +#Open Sendmail if we are mailing it
905     +if ( $opt{'mail'} and !$disabled ) {
906     + open( SENDMAIL, "|$opt{'sendmail'} -oi -t -odq" )
907     + or die "Can't open sendmail: $!\n";
908     + print SENDMAIL "From: $opt{'from'}\n";
909     + print SENDMAIL "To: $opt{'mail'}\n";
910     + print SENDMAIL "Subject: Spam Filter Statistics from $hostname - ",
911     + strftime( "%F", localtime($start) ), "\n\n";
912     + $oldfh = select SENDMAIL;
913     +}
914     +
915     +my $telapsed = time - $tstart;
916     +
917     +if ( !$disabled ) {
918     +
919     + #Output results
920     +
921     + # NEW - save the print to a variable so that it can be processed into html.
922     + #
923     + #Save current output selection and divert into variable
924     + #
925     + my $output;
926     + my $tablestr="";
927     + open(my $outputFH, '>', \$tablestr) or die; # This shouldn't fail
928     + my $oldFH = select $outputFH;
929     +
930     +
931     + print "SMEServer daily Anti-Virus and Spamfilter statistics from $hostname - ".strftime( "%F", localtime($start))."\n";
932     + print "----------------------------------------------------------------------------------", "\n\n";
933     + print "$0 Version : $opt{'version'}", "\n";
934     + print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n";
935     + print "Period Ending : ", strftime( "%c", localtime($end) ), "\n";
936     + print "Clam Version/DB Count/Last DB update: ",`freshclam -V`;
937     + print "SpamAssassin Version : ",`spamassassin -V`;
938     + printf "Tag level: %3d; Reject level: %-3d $warnnoreject\n", $SATagLevel,$SARejectLevel;
939     + if ($HighLogLevel) {
940     + printf "*Loglevel is set to: ".$LogLevel. " - you only need it set to 6\n";
941     + printf "\tYou can set it this way:\n";
942     + printf "\tconfig setprop qpsmtpd LogLevel 6\n";
943     + printf "\tsignal-event email-update\n";
944     + printf "\tsv t /var/service/qpsmtpd\n";
945     + }
946     + printf "Reporting Period : %-.2f hrs\n", $hrsinperiod;
947     + printf "All SMTP connections accepted:%-8d \n", $totalexamined;
948     + printf "Emails per hour : %-8.1f/hr\n", $emailperhour || 0;
949     + printf "Average spam score (accepted): %-11.2f\n", $spamavg || 0;
950     + printf "Average spam score (rejected): %-11.2f\n", $rejectspamavg || 0;
951     + printf "Average ham score : %-11.2f\n", $hamavg || 0;
952     + printf "Number of DMARC reporting emails sent:\t%-11d (not shown on table)\n", $DMARCSendCount || 0;
953     + if ($hamcount != 0){ printf "Number of emails approved through DMARC:\t%-11d (%-3d%% of Ham count)\n", $DMARCOkCount|| 0,$DMARCOkCount*100/$hamcount || 0;}
954     +
955     + my $smeoptimizerprog = "/usr/local/smeoptimizer/SMEOptimizer.pl";
956     + if (-e $smeoptimizerprog) {
957     + #smeoptimizer installed - get result of status
958     + my @smeoptimizerlines = split(/\n/,`/usr/local/smeoptimizer/SMEOptimizer.pl -status`);
959     + print("SMEOptimizer status:\n");
960     + print("\t".$smeoptimizerlines[6]."\n");
961     + print("\t".$smeoptimizerlines[7]."\n");
962     + print("\t".$smeoptimizerlines[8]."\n");
963     + print("\t".$smeoptimizerlines[9]."\n");
964     + print("\t".$smeoptimizerlines[10]."\n");
965     + }
966     +
967     +
968     + print "\nStatistics by Hour:\n";
969     + #
970     + # start by working out which colunns to show - tag the display array
971     + #
972     + $ncateg = 1; ##skip the first column
973     + $finaldisplay[0] = $true;
974     + while ( $ncateg < $categlen) {
975     + if ($display[$ncateg] eq 'yes') { $finaldisplay[$ncateg] = $true }
976     + elsif ($display[$ncateg] eq 'no') { $finaldisplay[$ncateg] = $false }
977     + else {
978     + $finaldisplay[$ncateg] = ($counts{$GRANDTOTAL}{$categs[$ncateg]} != 0);
979     + if ($finaldisplay[$ncateg]) {
980     + #if it has been non zero and auto, then make it yes for the future.
981     + esmith::ConfigDB->open->get('mailstats')->set_prop($categs[$ncateg],'yes')
982     + }
983     +
984     + }
985     + $ncateg++
986     + }
987     + #make sure total and percentages are shown
988     + $finaldisplay[@categs-2] = $true;
989     + $finaldisplay[@categs-1] = $true;
990     +
991     +
992     + # and put together the print lines
993     +
994     + my $Line1; #Full Line across the page
995     + my $Line2; #Broken Line across the page
996     + my $Titles; #Column headers
997     + my $Values; #Values
998     + my $Totals; #Corresponding totals
999     + my $Percent; # and column percentages
1000     +
1001     + my $hour = floor( $start / 3600 );
1002     + $Line1 = '';
1003     + $Line2 = '';
1004     + $Titles = '';
1005     + $Values = '';
1006     + $Totals = '';
1007     + $Percent = '';
1008     + while ( $hour < $end / 3600 ) {
1009     + if ($hour == floor( $start / 3600 )){
1010     + #Do all the once only things
1011     + $ncateg = 0;
1012     + while ( $ncateg < @categs) {
1013     + if ($finaldisplay[$ncateg]){
1014     + $Line1 .= substr('---------------------',0,$colwidth[$ncateg]);
1015     + $Line2 .= substr('---------------------',0,$colwidth[$ncateg]-1);
1016     + $Line2 .= " ";
1017     + $Titles .= sprintf('%'.($colwidth[$ncateg]-1).'s',$categs[$ncateg])."|";
1018     + if ($ncateg == 0) {
1019     + $Totals .= substr('TOTALS ',0,$colwidth[$ncateg]-2);
1020     + $Percent .= substr('PERCENTAGES ',0,$colwidth[$ncateg]-1);
1021     + } else {
1022     + # identify bottom right group and supress unless db->ShowGranPerc set
1023     + if ($ncateg==@categs-1){
1024     + $Totals .= sprintf('%'.$colwidth[$ncateg].'.1f',$counts{$GRANDTOTAL}{$categs[$ncateg]}).'%';
1025     + } else {
1026     + $Totals .= sprintf('%'.$colwidth[$ncateg].'d',$counts{$GRANDTOTAL}{$categs[$ncateg]});
1027     + }
1028     + $Percent .= sprintf('%'.($colwidth[$ncateg]-1).'.1f',$counts{$PERCENT}{$categs[$ncateg]}).'%';
1029     + }
1030     + }
1031     + $ncateg++
1032     + }
1033     + }
1034     +
1035     + $ncateg = 0;
1036     + while ( $ncateg < @categs) {
1037     + if ($finaldisplay[$ncateg]){
1038     + if ($ncateg == 0) {
1039     + $Values .= strftime( "%F, %H", localtime( $hour * 3600 ) )." "
1040     + } elsif ($ncateg == @categs-1) {
1041     + #percentages in last column
1042     + $Values .= sprintf('%'.($colwidth[$ncateg]-2).'.1f',$counts{$hour}{$categs[$ncateg]})."%";
1043     + } else {
1044     + #body numbers
1045     + $Values .= sprintf('%'.($colwidth[$ncateg]-1).'d',$counts{$hour}{$categs[$ncateg]})." ";
1046     + }
1047     + if (($ncateg == @categs-1)){$Values=$Values."\n"} #&& ($hour == floor($end / 3600)-1)
1048     + }
1049     + $ncateg++
1050     + }
1051     +
1052     + $hour++;
1053     + }
1054     +
1055     + #
1056     + # print it.
1057     + #
1058     +
1059     + print $Line1."\n";
1060     + #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line1."\n";} #These lines mess up the HTML conversion ....
1061     + print $Titles."\n";
1062     + #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line2."\n";} #ditto
1063     + print $Line2."\n";
1064     + print $Values;
1065     + print $Line2."\n";
1066     + print $Totals."\n";
1067     + print $Percent."\n";
1068     + print $Line1."\n";
1069     +
1070     + if ($localAccepttotal>0) {
1071     + print "*Fetchml* means connections from Fetchmail delivering email\n";
1072     + }
1073     + print "*Local* means connections from workstations on local LAN.\n\n";
1074     + print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol";
1075     + print " or email was to non existant address.\n\n";
1076     +
1077     + if ($finaldisplay[$KarmaCateg]){
1078     + print "*Karma* means email was rejected based on the mailserver's previous activities.\n\n";
1079     + }
1080     +
1081     +
1082     + if ($finaldisplay[$BadCountryCateg]){
1083     + $BadCountries = $cdb->get('qpsmtpd')->prop('BadCountries') || "*none*";
1084     + print "*Geoip\.*:Bad Countries mask is:".$BadCountries."\n\n";
1085     + }
1086     +
1087     +
1088     +
1089     + if (scalar keys %unrecog_plugin > 0){
1090     + #Show unrecog plugins found
1091     + print "*Unrecognised plugins found - categorised as Non-Conf\n";
1092     + foreach my $unrec (keys %unrecog_plugin){
1093     + print "\t$unrec\t($unrecog_plugin{$unrec})\n";
1094     + }
1095     + print "\n";
1096     + }
1097     +
1098     + if ($QueryNoLogTerse) {
1099     + print "* - as no records where found, it looks as though you may not have the *logterse* \nplugin running as part of qpsmtpd \n\n";
1100     +# print " to enable it follow the instructions at .............................\n";
1101     + }
1102     +
1103     +
1104     + if ( !$RHSenabled or !$DNSenabled ) {
1105     +
1106     + # comment about RBL not set
1107     + print
1108     +"* - This means that one or more of the possible spam black listing services\n that are available have not been enabled.\n";
1109     + print " You have not enabled:\n";
1110     +
1111     + if ( !$RHSenabled ) {
1112     + print " RHSBL\n";
1113     + }
1114     +
1115     + if ( !$DNSenabled ) {
1116     + print " DNSBL\n";
1117     + }
1118     +
1119     +
1120     + print " To enable these you can use the following commands:\n";
1121     + if ( !$RHSenabled ) {
1122     + print " config setprop qpsmtpd RHSBL enabled\n";
1123     + }
1124     +
1125     + if ( !$DNSenabled ) {
1126     + print " config setprop qpsmtpd DNSBL enabled\n";
1127     + }
1128     +
1129     + # there so much templates to expand... (PS)
1130     + print " Followed by:\n signal-event email-update and\n sv t /var/service/qpsmtpd\n\n";
1131     + }
1132     +
1133     +# if ($Webmailsendtotal > 0) {print "If you have the mailman contrib installed, then the webmail totals might include some mailman emails\n"}
1134     +
1135     + # time to do a 'by recipient domain' report
1136     + print "Incoming mails by recipient domains usage\n";
1137     + print "-----------------------------------------\n";
1138     + print
1139     + "Domains Type Total Denied XferErr Accept \%accept\n";
1140     + print
1141     + "---------------------------- ---------- ------ ------ ------- ------ -------\n";
1142     + my %total = (
1143     + total => 0,
1144     + deny => 0,
1145     + xfer => 0,
1146     + accept => 0,
1147     + );
1148     + foreach my $domain (
1149     + sort {
1150     + join( "\.", reverse( split /\./, $a ) ) cmp
1151     + join( "\.", reverse( split /\./, $b ) )
1152     + } keys %byrcptdomain
1153     + )
1154     + {
1155     + next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
1156     + my $tp = $byrcptdomain{$domain}{'type'} || 'other';
1157     + my $to = $byrcptdomain{$domain}{'total'} || 0;
1158     + my $de = $byrcptdomain{$domain}{'deny'} || 0;
1159     + my $xr = $byrcptdomain{$domain}{'xfer'} || 0;
1160     + my $ac = $byrcptdomain{$domain}{'accept'} || 0;
1161     + printf "%-28s %-10s %6d %6d %7d %6d %6.2f%%\n", $domain, $tp, $to,
1162     + $de, $xr, $ac, $ac * 100 / $to;
1163     + $total{'total'} += $to;
1164     + $total{'deny'} += $de;
1165     + $total{'xfer'} += $xr;
1166     + $total{'accept'} += $ac;
1167     + }
1168     + print
1169     + "---------------------------- ---------- ------ ------- ------ ------ -------\n";
1170     +
1171     + # $total{ 'total' } can be equal to 0, bad for divisions...
1172     + my $perc1 = 0;
1173     + my $perc2 = 0;
1174     +
1175     +
1176     + if ( $total{'total'} != 0 ) {
1177     + $perc1 = $total{'accept'} * 100 / $total{'total'};
1178     + $perc2 = ( ( $total{'total'} + $morethanonercpt ) / $total{'total'} );
1179     + }
1180     + printf
1181     + "Total %6d %6d %7d %6d %6.2f%%\n\n",
1182     + $total{'total'}, $total{'deny'}, $total{'xfer'}, $total{'accept'},
1183     + $perc1;
1184     + printf
1185     + "%d mails were processed for %d Recipients\nThe average recipients by mail is %4.2f\n\n",
1186     + $total{'total'}, ( $total{'total'} + $morethanonercpt ), $perc2;
1187     +
1188     + if ( $infectedcount > 0 ) {
1189     + show_virus_variants();
1190     + }
1191     +
1192     +
1193     + if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();}
1194     +
1195     + if ($enableSARules) {show_SARules_codes();}
1196     +
1197     + if ($enableGeoiptable and (($total_countries > 0) or $finaldisplay[$BadCountryCateg])){show_Geoip_results();}
1198     +
1199     + if ($enablejunkMailList) {List_Junkmail();}
1200     +
1201     + if ($enableblacklist) {show_blacklist_counts();}
1202     +
1203     + show_user_stats();
1204     +
1205     + print "\nReport generated in $telapsed sec.\n";
1206     +
1207     + if ($savedata) { save_data(); }
1208     + else
1209     + { print "No data saved - if you want to save data to a MySQL database, then please use:\n".
1210     + "config setprop mailstats SaveDataToMySQL yes\n";
1211     + }
1212     +
1213     + select $oldFH;
1214     + close $outputFH;
1215     + if ($makeHTMLemail eq "no" or $makeHTMLemail eq "both") {print $tablestr}
1216     + if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" or $makeHTMLpage eq "yes"){
1217     + #Convert text to html and send it
1218     + require CGI;
1219     + require TextToHTML;
1220     + my $cgi = new CGI;
1221     + my $text = $tablestr;
1222     + my %paramhash = (default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>10,tab_width=>20);
1223     + my $conv = new HTML::TextToHTML();
1224     + $conv->args(default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>2,preformat_whitespace_min=>2,
1225     + underline_length_tolerance=>1);
1226     +
1227     + my $html = $cgi->header();
1228     + $html .="<!DOCTYPE html> <html>\n";
1229     + $html .= "<head><title>Mailstats -".strftime( "%F", localtime($start) )."</title>";
1230     + $html .= "<link rel='stylesheet' type='text/css' href='mailstats.css' /></head>\n";
1231     + $html .= "<body>\n";
1232     + $html .= $conv->process_chunk($text);
1233     + $html .= "</body></html>\n";
1234     + if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" ) {print $html}
1235     + #And drop it into a file
1236     + if ($makeHTMLpage eq "yes") {
1237     + my $filename = "mailstats.html";
1238     + open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
1239     + print $fh $html;
1240     + close $fh;
1241     + }
1242     +
1243     + }
1244     +
1245     +
1246     + #Close Sendmail if it was opened
1247     + if ( $opt{'mail'} ) {
1248     + select $oldfh;
1249     + close(SENDMAIL);
1250     + }
1251     +
1252     +} ##report disabled
1253     +
1254     +#All done
1255     +exit 0;
1256     +
1257     +#############################################################################
1258     +# Subroutines ###############################################################
1259     +#############################################################################
1260     +
1261     +
1262     +################################################
1263     +# Determine analysis period (start and end time)
1264     +################################################
1265     +sub analysis_period {
1266     + my $startdate = shift;
1267     + my $enddate = shift;
1268     +
1269     + my $secsininterval = 86400; #daily default
1270     + my $time;
1271     +
1272     + if ($cdb->get('mailstats'))
1273     + {
1274     + my $interval = $cdb->get('mailstats')->prop('Interval') || 'daily'; #"fortnightly"; #"daily";# #; TEMP!!
1275     + if ($interval eq "weekly") {
1276     + $secsininterval = 86400*7;
1277     + } elsif ($interval eq "fortnightly") {
1278     + $secsininterval = 86400*14;
1279     + } elsif ($interval eq "monthly") {
1280     + $secsininterval = 86400*30;
1281     + } elsif ($interval =~m/\d+/) {
1282     + $secsininterval = $interval*3600;
1283     + };
1284     + my $base = $cdb->get('mailstats')->prop('Base') || 'Midnight';
1285     + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
1286     + localtime(time);
1287     + if ($base eq "Midnight"){
1288     + $sec = 0;$min=0;$hour=0;
1289     + } elsif ($base eq "Midday"){
1290     + $sec = 0;$min=0;$hour=12;
1291     + } elsif ($base =~m/\d+/){
1292     + $sec=0;$min=0;$hour=$base;
1293     + };
1294     + #$mday="05"; #$mday="03"; #$mday="16"; #Temp!!
1295     + $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
1296     + }
1297     +
1298     + my $start = str2time( $startdate );
1299     + my $end = $enddate ? str2time( $enddate ) :
1300     + $startdate ? $start + $secsininterval : $time;
1301     + $start = $startdate ? $start : $end - $secsininterval;
1302     + return ( $start > $end ) ? ( $end, $start ) : ( $start, $end );
1303     +}
1304     +
1305     +sub dbg {
1306     + my $msg = shift;
1307     + my $time = scalar localtime;
1308     + $msg = $time.":".$msg."\n";
1309     + if ( $opt{debug} ) {
1310     + print STDERR $msg;
1311     + }
1312     +}
1313     +
1314     +sub List_Junkmail {
1315     +
1316     + #
1317     + # Show how many junkmails in each user's junkmail folder.
1318     + #
1319     + use esmith::AccountsDB;
1320     + my $adb = esmith::AccountsDB->open_ro;
1321     + my $entry;
1322     + foreach my $user ( $adb->users ) {
1323     + my $found = 0;
1324     + my $junkmail_dir =
1325     + "/home/e-smith/files/users/" . $user->key . "/Maildir/.junkmail";
1326     + foreach my $dir (qw(new cur)) {
1327     +
1328     + # Now get the content list for the directory.
1329     + if ( opendir( QDIR, "$junkmail_dir/$dir" ) ) {
1330     + while ( $entry = readdir(QDIR) ) {
1331     + next if $entry =~ /^\./;
1332     + $found++;
1333     + }
1334     + closedir(QDIR);
1335     + }
1336     + }
1337     + if ( $found != 0 ) {
1338     + $junkcount{ $user->key } = $found;
1339     + }
1340     + }
1341     + my $i = keys %junkcount;
1342     + if ( $i > 0 ) {
1343     + print("\nJunk Mails left in folder:\n");
1344     + print("---------------------------\n");
1345     + print("Count\tUser\n");
1346     + print("-------------------------\n");
1347     + foreach my $thisuser (
1348     + sort { $junkcount{$b} <=> $junkcount{$a} }
1349     + keys %junkcount
1350     + )
1351     + {
1352     + printf "%d", $junkcount{$thisuser};
1353     + print "\t" . $thisuser . "\n";
1354     + }
1355     + print("-------------------------\n");
1356     + }
1357     + else {
1358     + print "***No junkmail folders with emails***\n";
1359     + }
1360     +}
1361     +
1362     +sub show_virus_variants
1363     +
1364     +#
1365     +# Show a league table of the different virus types found today
1366     +#
1367     +
1368     +{
1369     + my $line = "------------------------------------------------------------------------\n";
1370     + print("\nVirus Statistics by name:\n");
1371     + print($line);
1372     + foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} }
1373     + keys %found_viruses)
1374     + {
1375     + if (index($virus,"Sanesecurity") !=-1 or index($virus,"UNOFFICIAL") !=-1){
1376     + print "Rejected $found_viruses{$virus}\thttp://sane.mxuptime.com/s.aspx?id=$virus\n";
1377     + } else {
1378     + print "Rejected $found_viruses{$virus}\t$virus\n";
1379     + }
1380     +
1381     + }
1382     + print($line);
1383     +}
1384     +
1385     +sub show_qpsmtpd_codes
1386     +
1387     +#
1388     +# Show a league table of the qpsmtpd result codes found today
1389     +#
1390     +
1391     +{
1392     + my $line = "---------------------------------------------\n";
1393     + print("\nQpsmtpd codes league table:\n");
1394     + print($line);
1395     + print("Count\tPercent\tReason\n");
1396     + print($line);
1397     + foreach my $qpcode (sort { $found_qpcodes{$b} <=> $found_qpcodes{$a} }
1398     + keys %found_qpcodes)
1399     + {
1400     + print "$found_qpcodes{$qpcode}\t".sprintf('%4.1f',$found_qpcodes{$qpcode}*100/$totalexamined)."%\t\t$qpcode\n" if $totalexamined;
1401     + }
1402     + print($line);
1403     +}
1404     +
1405     +sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
1406     +
1407     +sub get_domain
1408     +{ my $url = shift;
1409     + $url =~ s!^\(dnsbl\)\s!!;
1410     + $url =~ s!^.*https?://(?:www\.)?!!i;
1411     + $url =~ s!/.*!!;
1412     + $url =~ s/[\?\#\:].*//;
1413     + $url =~ s/^([\d]{1,3}.){4}//;
1414     + my $domain = trim($url);
1415     + return $domain;
1416     +}
1417     +
1418     +sub show_blacklist_counts
1419     +
1420     +#
1421     +# Show a sorted league table of the blacklist URL counts
1422     +#
1423     +
1424     +{
1425     + my $line = "------------------\n";
1426     + print("\nBlacklist details:\n");
1427     + print($line);
1428     + if ($cdb->get('qpsmtpd')->prop("RHSBL") eq "enabled") {print "RBLLIST:".$cdb->get('qpsmtpd')->prop("RBLList")."\n";}
1429     + if ($cdb->get('qpsmtpd')->prop("URIBL") eq "enabled") {print "UBLLIST:".$cdb->get('qpsmtpd')->prop("UBLList")."\n";}
1430     + if (!$cdb->get('qpsmtpd')->prop("SBLList") eq "") {print "SBLLIST:".$cdb->get('qpsmtpd')->prop("SBLList")."\n";}
1431     + print($line);
1432     + print("Count\tURL\n");
1433     + print($line);
1434     + foreach my $blcode (sort { $blacklistURL{$b} <=> $blacklistURL{$a} }
1435     + keys %blacklistURL)
1436     + {
1437     + print sprintf('%3u',$blacklistURL{$blcode})."\t$blcode\n";
1438     + }
1439     + print($line);
1440     +}
1441     +
1442     +
1443     +sub show_user_stats
1444     +
1445     +#
1446     +# Show a sorted league table of the user counts
1447     +#
1448     +
1449     +{
1450     + #Compute totals for each entry
1451     + my $grandtotals=0;
1452     + my $totalqueued=0;
1453     + my $totalspam=0;
1454     + my $totalrejected=0;
1455     + foreach my $user (keys %usercounts){
1456     + $usercounts{$user}{"queued"} = 0 if !(exists $usercounts{$user}{"queued"});
1457     + $usercounts{$user}{"rejected"} = 0 if !(exists $usercounts{$user}{"rejected"});
1458     + $usercounts{$user}{"spam"} = 0 if !(exists $usercounts{$user}{"spam"});
1459     + $usercounts{$user}{"totals"} = $usercounts{$user}{"queued"}+$usercounts{$user}{"rejected"}+$usercounts{$user}{"spam"};
1460     + $grandtotals += $usercounts{$user}{"totals"};
1461     + $totalspam += $usercounts{$user}{"spam"};
1462     + $totalqueued += $usercounts{$user}{"queued"};
1463     + $totalrejected += $usercounts{$user}{"rejected"};
1464     + }
1465     + my $line = "--------------------------------------------------\n";
1466     + print("\nStatistics by email address received:\n");
1467     + print($line);
1468     + print("Queued\tRejected\tSpam tagged\tEmail Address\n");
1469     + print($line);
1470     + foreach my $user (sort { $usercounts{$b}{"totals"} <=> $usercounts{$a}{"totals"} }
1471     + keys %usercounts)
1472     + {
1473     + print sprintf('%3u',$usercounts{$user}{"queued"})."\t".sprintf('%3u',$usercounts{$user}{"rejected"})."\t\t".sprintf('%3u',$usercounts{$user}{"spam"})."\t\t$user\n";
1474     + }
1475     + print($line);
1476     + print sprintf('%3u',$totalqueued)."\t".sprintf('%3u',$totalrejected)."\t\t".sprintf('%3u',$totalspam)."\n";
1477     + print($line);
1478     +
1479     +
1480     +}
1481     +
1482     +sub show_Geoip_results
1483     +#
1484     +# Show league table of GEoip results
1485     +#
1486     +{
1487     +
1488     + my ($percentthreshold);
1489     + my ($reject);
1490     + my ($percent);
1491     + my ($totalpercent)=0;
1492     + if ($cdb->get('mailstats')){
1493     + $percentthreshold = $cdb->get('mailstats')->prop("GeoipCutoffPercent") || 0.5;
1494     + } else {
1495     + $percentthreshold = 0.5;
1496     + }
1497     + if ($total_countries > 0) {
1498     + my $line = "---------------------------------------------\n";
1499     + print("\nGeoip results: (cutoff at $percentthreshold%) \n");
1500     + print($line);
1501     + print("Country\tPercent\tCount\tRejected?\n");
1502     + print($line);
1503     + foreach my $country (sort { $found_countries{$b} <=> $found_countries{$a} }
1504     + keys %found_countries)
1505     + {
1506     + $percent = $found_countries{$country} * 100 / $total_countries
1507     + if $total_countries;
1508     + $totalpercent = $totalpercent + $percent;
1509     + if (index($BadCountries, $country) != -1) {$reject = "*";} else { $reject = " ";}
1510     + if ( $percent >= $percentthreshold ) {
1511     + print "$country\t\t"
1512     + . sprintf( '%4.1f', $percent )
1513     + . "%\t\t$found_countries{$country}","\t$reject\n"
1514     + if $total_countries;
1515     + }
1516     +
1517     + }
1518     + print($line);
1519     + my ($showtotals);
1520     + if ($cdb->get('mailstats')){
1521     + $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes");
1522     + } else {
1523     + $showtotals = $true;
1524     + }
1525     +
1526     + if ($showtotals){
1527     + print "TOTALS\t\t".sprintf("%4.1f",$totalpercent)."%\t\t$total_countries\n";
1528     + print($line);
1529     + }
1530     + }
1531     +}
1532     +
1533     +sub show_SARules_codes
1534     +
1535     +#
1536     +# Show a league table of the SARules result codes found today
1537     +# suppress any lower than DB mailstats/SARulePercentThreshold
1538     +#
1539     +
1540     +{
1541     + my ($percentthreshold);
1542     + my ($defaultpercentthreshold);
1543     + my ($totalpercent) = 0;
1544     +
1545     + if ($sum_SARules > 0){
1546     +
1547     + if ($totalexamined >0 and $sum_SARules*100/$totalexamined > $SARulethresholdPercent) {
1548     + $defaultpercentthreshold = $maxcutoff
1549     + } else {
1550     + $defaultpercentthreshold = $mincutoff
1551     + }
1552     + if ($cdb->get('mailstats')){
1553     + $percentthreshold = $cdb->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold;
1554     + } else {
1555     + $percentthreshold = $defaultpercentthreshold
1556     + }
1557     + my $line = "---------------------------------------------\n";
1558     + print("\nSpamassassin Rules:(cutoff at ".sprintf('%4.1f',$percentthreshold)."%)\n");
1559     + print($line);
1560     + print("Count\tPercent\tScore\t\t\n");
1561     + print($line);
1562     + foreach my $SARule (sort { $found_SARules{$b}{'count'} <=> $found_SARules{$a}{'count'} }
1563     + keys %found_SARules)
1564     + {
1565     + my $percent = $found_SARules{$SARule}{'count'} * 100 / $totalexamined if $totalexamined;
1566     + my $avehits = $found_SARules{$SARule}{'totalhits'} /
1567     + $found_SARules{$SARule}{'count'}
1568     + if $found_SARules{$SARule}{'count'};
1569     + if ( $percent >= $percentthreshold ) {
1570     + print "$found_SARules{$SARule}{'count'}\t"
1571     + . sprintf( '%4.1f', $percent ) . "%\t"
1572     + . sprintf( '%4.1f', $avehits )
1573     + . "\t$SARule\n"
1574     + if $totalexamined;
1575     + }
1576     + }
1577     + print($line);
1578     + my ($showtotals);
1579     + if ($cdb->get('mailstats')){
1580     + $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes");
1581     + } else {
1582     + $showtotals = $true;
1583     + }
1584     +
1585     + if ($showtotals){
1586     + print "$totalexamined\t(TOTALS)\n";
1587     + print($line);
1588     + }
1589     + print "\n";
1590     + }
1591     +
1592     +
1593     +}
1594     +
1595     +sub mark_domain_rejected
1596     +
1597     +#
1598     +# Tag domain as having a rejected email
1599     +#
1600     +{
1601     +my ($proc) = @_;
1602     +if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
1603     + $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'deny' }++ ;
1604     + $currentrcptdomain{ $proc } = '' ;
1605     + }
1606     +}
1607     +
1608     +sub mark_domain_err
1609     +
1610     + #
1611     + # Tag domain as having an error on email transfer
1612     + #
1613     +{
1614     + my ($proc) = @_;
1615     + if ( ( $currentrcptdomain{$proc} || '' ) ne '' ) {
1616     + $byrcptdomain{ $currentrcptdomain{$proc} }{'xfer'}++;
1617     + $currentrcptdomain{$proc} = '';
1618     + }
1619     +}
1620     +
1621     +sub add_in_domain
1622     +
1623     + #
1624     + # add recipient domain into hash
1625     + #
1626     +{
1627     + my ($proc) = @_;
1628     +
1629     + #split to just domain bit.
1630     + $currentrcptdomain{$proc} =~ s/.*@//;
1631     + $currentrcptdomain{$proc} =~ s/[^\w\-\.]//g;
1632     + $currentrcptdomain{$proc} =~ s/>//g;
1633     + my $NotableDomain = 0;
1634     + if ( defined( $byrcptdomain{ $currentrcptdomain{$proc} }{'type'} ) ) {
1635     + $NotableDomain = 1;
1636     + }
1637     + else {
1638     + foreach (@extdomain) {
1639     + if ( $currentrcptdomain{$proc} =~ m/$_$/ ) {
1640     + $NotableDomain = 1;
1641     + last;
1642     + }
1643     + }
1644     + }
1645     + if ( !$NotableDomain ) {
1646     +
1647     + # check for outgoing email
1648     + if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Outgoing' }
1649     + else { $currentrcptdomain{$proc} = 'Others' }
1650     + }
1651     + else {
1652     + if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Internal' }
1653     + }
1654     + $byrcptdomain{ $currentrcptdomain{$proc} }{'total'}++;
1655     +}
1656     +
1657     +sub save_data
1658     +
1659     + #
1660     + # Save the data to a MySQL database
1661     + #
1662     +{
1663     + use DBI;
1664     + my $tstart = time;
1665     + my $DBname = "mailstats";
1666     + my $host = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBHost') || "localhost";
1667     + my $port = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBPort') || "3306";
1668     + print "Saving data..";
1669     + my $dbh = DBI->connect( "DBI:mysql:database=$DBname;host=$host;port=$port",
1670     + "mailstats", "mailstats" )
1671     + or die "Cannot open mailstats db - has it beeen created?";
1672     +
1673     + my $hour = floor( $start / 3600 );
1674     + my $reportdate = strftime( "%F", localtime( $hour * 3600 ) );
1675     + my $dateid = get_dateid($dbh,$reportdate);
1676     + my $reccount = 0; #count number of records written
1677     + my $servername = esmith::ConfigDB->open_ro->get('SystemName')->value . "."
1678     + . esmith::ConfigDB->open_ro->get('DomainName')->value;
1679     + # now fill in day related stats - must always check for it already there
1680     + # incase the module is run more than once in a day
1681     + my $SAScoresid = check_date_rec($dbh,"SAscores",$dateid,$servername);
1682     + $dbh->do( "UPDATE SAscores SET ".
1683     + "acceptedcount=".$spamcount.
1684     + ",rejectedcount=".$above15.
1685     + ",hamcount=".$hamcount.
1686     + ",acceptedscore=".$spamhits.
1687     + ",rejectedscore=".$rejectspamhits.
1688     + ",hamscore=".$hamhits.
1689     + ",totalsmtp=".$totalexamined.
1690     + ",totalrecip=".$recipcount.
1691     + ",servername='".$servername.
1692     + "' WHERE SAscoresid =".$SAScoresid);
1693     + # Junkmail stats
1694     + # delete if already there
1695     + $dbh->do("DELETE from JunkMailStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
1696     + # and add records
1697     + foreach my $thisuser (keys %junkcount){
1698     + $dbh->do("INSERT INTO JunkMailStats (dateid,user,count,servername) VALUES ('".
1699     + $dateid."','".$thisuser."','".$junkcount{$thisuser}."','".$servername."')");
1700     + $reccount++;
1701     + }
1702     + #SA rules - delete any first
1703     + $dbh->do("DELETE from SARules WHERE dateid = ".$dateid." AND servername='".$servername."'");
1704     + # and add records
1705     + foreach my $thisrule (keys %found_SARules){
1706     + $dbh->do("INSERT INTO SARules (dateid,rule,count,totalhits,servername) VALUES ('".
1707     + $dateid."','".$thisrule."','".$found_SARules{$thisrule}{'count'}."','".
1708     + $found_SARules{$thisrule}{'totalhits'}."','".$servername."')");
1709     + $reccount++;
1710     + }
1711     + #qpsmtpd result codes
1712     + $dbh->do("DELETE from qpsmtpdcodes WHERE dateid = ".$dateid." AND servername='".$servername."'");
1713     + # and add records
1714     + foreach my $thiscode (keys %found_qpcodes){
1715     + $dbh->do("INSERT INTO qpsmtpdcodes (dateid,reason,count,servername) VALUES ('".
1716     + $dateid."','".$thiscode."','".$found_qpcodes{$thiscode}."','".$servername."')");
1717     + $reccount++;
1718     +}
1719     + # virus stats
1720     + $dbh->do("DELETE from VirusStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
1721     + # and add records
1722     + foreach my $thisvirus (keys %found_viruses){
1723     + $dbh->do("INSERT INTO VirusStats (dateid,descr,count,servername) VALUES ('".
1724     + $dateid."','".$thisvirus."','".$found_viruses{$thisvirus}."','".$servername."')");
1725     + $reccount++;
1726     +
1727     + }
1728     + # domain details
1729     + $dbh->do("DELETE from domains WHERE dateid = ".$dateid." AND servername='".$servername."'");
1730     + # and add records
1731     + foreach my $domain (keys %byrcptdomain){
1732     + next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
1733     + $dbh->do("INSERT INTO domains (dateid,domain,type,total,denied,xfererr,accept,servername) VALUES ('".
1734     + $dateid."','".$domain."','".($byrcptdomain{$domain}{'type'}||'other')."','"
1735     + .$byrcptdomain{$domain}{'total'}."','"
1736     + .($byrcptdomain{$domain}{'deny'}||0)."','"
1737     + .($byrcptdomain{$domain}{'xfer'}||0)."','"
1738     + .($byrcptdomain{$domain}{'accept'}||0)."','"
1739     + .$servername
1740     + ."')");
1741     + $reccount++;
1742     +
1743     + }
1744     + # finally - the hourly breakdown
1745     + # need to remember here that the date might change during the 24 hour span
1746     + my $nhour = floor( $start / 3600 );
1747     + my $ncateg;
1748     + while ( $nhour < $end / 3600 ) {
1749     + #see if the time record has been created
1750     + # print strftime("%H",localtime( $nhour * 3600 ) ).":00:00\n";
1751     + my $sth =
1752     + $dbh->prepare( "SELECT timeid FROM time WHERE time = '" . strftime("%H",localtime( $nhour * 3600 ) ).":00:00'");
1753     + $sth->execute();
1754     + if ( $sth->rows == 0 ) {
1755     + #create entry
1756     + $dbh->do( "INSERT INTO time (time) VALUES ('" .strftime("%H",localtime( $nhour * 3600 ) ).":00:00')" );
1757     + # and pick up timeid
1758     + $sth = $dbh->prepare("SELECT last_insert_id() AS timeid FROM time");
1759     + $sth->execute();
1760     + $reccount++;
1761     + }
1762     + my $timerec = $sth->fetchrow_hashref();
1763     + my $timeid = $timerec->{"timeid"};
1764     + $ncateg = 0;
1765     + # and extract date from first column of $count array
1766     + my $currentdate = strftime( "%F", localtime( $hour * 3600 ) );
1767     + # print "$currentdate.\n";
1768     + if ($currentdate ne $reportdate) {
1769     + #same as before?
1770     + $dateid = get_dateid($dbh,$currentdate);
1771     + $reportdate = $currentdate;
1772     + }
1773     + # delete for this date and time
1774     + $dbh->do("DELETE from ColumnStats WHERE dateid = ".$dateid." AND timeid = ".$timeid." AND servername='".$servername."'");
1775     + while ( $ncateg < @categs-1 ) {
1776     + # then add in each entry
1777     + if (($counts{$nhour}{$categs[$ncateg]} || 0) != 0) {
1778     + $dbh->do("INSERT INTO ColumnStats (dateid,timeid,descr,count,servername) VALUES ("
1779     + .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
1780     + .$counts{$nhour}{$categs[$ncateg]}.",'".$servername."')");
1781     + $reccount++;
1782     + }
1783     +
1784     +# print("INSERT INTO ColumnStats (dateid,timeid,descr,count) VALUES ("
1785     +# .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
1786     +# .$counts{$nhour}{$categs[$ncateg]}.")\n");
1787     +
1788     + $ncateg++;
1789     + }
1790     + $nhour++;
1791     + }
1792     + # and write out the log lines saved - only if html wanted
1793     + if ($makeHTMLemail eq 'yes' or $makeHTMLemail eq 'both' or $makeHTMLpage eq 'yes'){
1794     + foreach my $logid (keys %LogLines){
1795     + $reccount++;
1796     + #Extract from keys
1797     + my $extract = $logid;
1798     + $extract =~/^(.*)-(.*):(.*)$/;
1799     + my $Log64n = $1;
1800     + my $LogMailId = $2;
1801     + my $LogSeq = $3;
1802     + my $LogLine = $dbh->quote($LogLines{$logid});
1803     + my $sql = "INSERT INTO LogData (Log64n,MailID,Sequence,LogStr) VALUES ('";
1804     + $sql .= $Log64n."','".$LogMailId."','".$LogSeq."',".$LogLine.")";
1805     + $dbh->do($sql) or die($sql);
1806     + }
1807     + $dbh->disconnect();
1808     + $telapsed = time - $tstart;
1809     + print "Saved $reccount records in $telapsed sec.";
1810     + }
1811     +}
1812     +
1813     +sub check_date_rec
1814     +
1815     + #
1816     + # check that a specific dated rec is there, create if not
1817     + #
1818     +{
1819     + my ( $dbh, $table, $dateid ) = @_;
1820     + my $sth =
1821     + $dbh->prepare(
1822     + "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid'" );
1823     + $sth->execute();
1824     + if ( $sth->rows == 0 ) {
1825     + #create entry
1826     + $dbh->do( "INSERT INTO ".$table." (dateid) VALUES ('" . $dateid . "')" );
1827     + # and pick up recordid
1828     + $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
1829     + $sth->execute();
1830     + }
1831     + my $rec = $sth->fetchrow_hashref();
1832     + $rec->{$table."id"}; #return the id of the reocrd (new or not)
1833     + }
1834     +
1835     + sub check_time_rec
1836     +
1837     + #
1838     + # check that a specific dated amd timed rec is there, create if not
1839     + #
1840     +{
1841     + my ( $dbh, $table, $dateid, $timeid ) = @_;
1842     + my $sth =
1843     + $dbh->prepare(
1844     + "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid' AND timeid = ".$timeid );
1845     + $sth->execute();
1846     + if ( $sth->rows == 0 ) {
1847     + #create entry
1848     + $dbh->do( "INSERT INTO ".$table." (dateid,timeid) VALUES ('" . $dateid . "', '".$timeid."')" );
1849     + # and pick up recordid
1850     + $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
1851     + $sth->execute();
1852     + }
1853     + my $rec = $sth->fetchrow_hashref();
1854     + $rec->{$table."id"}; #return the id of the record (new or not)
1855     + }
1856     +
1857     +sub get_dateid
1858     +
1859     +#
1860     +# Check that date is in db, and return corresponding id
1861     +#
1862     +{
1863     + my ($dbh,$reportdate) = @_;
1864     + my $sth =
1865     + $dbh->prepare( "SELECT dateid FROM date WHERE date = '" . $reportdate."'" );
1866     + $sth->execute();
1867     + if ( $sth->rows == 0 ) {
1868     + #create entry
1869     + $dbh->do( "INSERT INTO date (date) VALUES ('" . $reportdate . "')" );
1870     + # and pick up dateid
1871     + $sth = $dbh->prepare("SELECT last_insert_id() AS dateid FROM date");
1872     + $sth->execute();
1873     + }
1874     + my $daterec = $sth->fetchrow_hashref();
1875     + $daterec->{"dateid"};
1876     + }
1877     +
1878     + sub dump_entries
1879     + {
1880     + my $msg = shift;
1881     + #if ($opt{debug} == 1){exit;}
1882     +}
1883     +
1884     +#sub test_for_private_ip {
1885     + #use NetAddr::IP;
1886     + #my $ip = shift;
1887     + #$ip =~ s/^\D*(([0-9]{1,3}\.){3}[0-9]{1,3}).*/$1/e;
1888     + #print "\nIP:$ip";
1889     + #my $nip = NetAddr::IP->new($ip);
1890     + #if ($nip){
1891     + #if ( $nip->is_rfc1918() ){
1892     + #return 1;
1893     + #} else { return 0}
1894     + #} else { return 0}
1895     +#}
1896     +
1897     +
1898     +sub test_for_private_ip {
1899     + use NetAddr::IP;
1900     + $_ = shift;
1901     + return unless /(\d+\.\d+\.\d+\.\d+)/;
1902     + my $ip = NetAddr::IP->new($1);
1903     + return unless $ip;
1904     + return $ip->is_rfc1918();
1905     +}
1906     +
1907     +
1908     diff -urN smeserver-mailstats-1.1.old/root/usr/bin/spamfilter-stats-7.pl smeserver-mailstats-1.1/root/usr/bin/spamfilter-stats-7.pl
1909     --- smeserver-mailstats-1.1.old/root/usr/bin/spamfilter-stats-7.pl 2020-01-03 09:09:24.568846981 +0000
1910     +++ smeserver-mailstats-1.1/root/usr/bin/spamfilter-stats-7.pl 1970-01-01 01:00:00.000000000 +0100
1911     @@ -1,1963 +0,0 @@
1912     -#!/usr/bin/perl -w
1913     -
1914     -#############################################################################
1915     -#
1916     -# This script provides daily SpamFilter statistics.
1917     -#
1918     -# This script was originally developed
1919     -# by Jesper Knudsen at http://sme.swerts-knudsen.dk
1920     -# and re-written by brian read at bjsystems.co.uk (with some help from the community - thanks guys)
1921     -#
1922     -# bjr - 02sept12 - Add in qpsmtpd failure code auth::auth_cvm_unix_local as per Bug 7089
1923     -# bjr - 10Jun15 - Sort out multiple files as input parameters as per bug 5613
1924     -# - Sort out geoip failure status as per Bug 4262
1925     -# - change final message about the DB (it is created automatically these days by the rpm)
1926     -# bjr - 17Jun15 - Add annotation showing Badcountries being eliminated
1927     -# - correct Spamfilter details extract, as per Bug 8656
1928     -# - Add analysis table of Geoip results
1929     -# bjr - 19Jun15 - Add totals for the League tables
1930     -# bjr and Unnilennium - 08Apr16 - Add in else for unrecognised plugin detection
1931     -# bjr - 08Apr16 - Add in link for SaneSecurity "extra" virus detection
1932     -# bjr - 14Jun16 - make compatible with qpsmtpd 0.96
1933     -# bjr - 16Jun16 - Add code to create an html equivalent of the text email (v0.7)
1934     -# bjr - 04Aug16 - Add code to log and count the blacklist RBL urls that have triggered, this (NFR) is Bugzilla 9717
1935     -# bjr - 04Aug16 - Add code to expand the junkmail table to include daily ham and spam and deleted spam for each user - (NFR bugzilla 9716)
1936     -# bjr - 05Aug16 - Add code to log remote relay incoming emails
1937     -# bjr - 10Oct16 - Add code to show stats for the smeoptimizer package
1938     -# bjr - 16dec16 - Fix dnsbl code to deal with psbl.surriel.com - Bug 9717
1939     -# bjr - 16Dec16 - Change geopip table code to show even if no exclusions found (assuming geoip data found) - Bug 9888
1940     -# bjr - 30Apr17 - Change Categ index code - Bug 9888 again
1941     -#
1942     -#############################################################################
1943     -#
1944     -# SMEServer DB usage
1945     -# ------------------
1946     -#
1947     -# mailstats / Status ("enabled"|"disabled")
1948     -# / <column header> ("yes"|"no"|"auto") - enable, supress or only show if nonzero
1949     -# / QpsmtpdCodes ("enabled"|"disabled")
1950     -# / SARules ("enabled"|"disabled")
1951     -# / GeoipTable ("enabled"|"disabled")
1952     -# / GeoipCutoffPercent (0.5%) - threshold to show Geoip country in league table
1953     -# / JunkMailList ("enabled"|"disabled")
1954     -# / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff
1955     -# / Email (admin) - email to send report
1956     -# / SaveDataToMySQL - save data to MySQL database (default is "no")
1957     -# / ShowLeagueTotals - Show totals row after league tables - (default is "yes")
1958     -# / DBHost - MySQL server hostname (default is "localhost").
1959     -# / DBPort - MySQL server post (default is "3306")
1960     -# / Interval - "daily", "weekly", "fortnightly", "monthly", "99999" - last is number of hours (default is daily)
1961     -# / Base - "Midnight", "Midday", "Now", "99" hour (0-23) (default is midnight)
1962     -# / HTMLEmail - "yes", "no", "both" - default is "No" - Send email in HTML
1963     -# / HTMLPage - "yes" / "no" - default is "yes" if HTMLEmail is "yes" or "both" otherwise "no"
1964     -#
1965     -#############################################################################
1966     -#
1967     -#
1968     -# TODO
1969     -#
1970     -# 1. Delete loglines records from any previous run of same table
1971     -# 2. Add tracking LogId for each cont in the table
1972     -# 3. Use link directory file to generate h1 / h2 tags for title and section headings
1973     -# 4. Ditto for links to underlying data
1974     -#
1975     -
1976     -# internal modules (part of core perl distribution)
1977     -use strict;
1978     -use warnings;
1979     -use Getopt::Long;
1980     -use Pod::Usage;
1981     -use POSIX qw/strftime floor/;
1982     -use Time::Local;
1983     -use Date::Parse;
1984     -use Time::TAI64;
1985     -use esmith::ConfigDB;
1986     -use esmith::DomainsDB;
1987     -use Sys::Hostname;
1988     -use Switch;
1989     -use DBIx::Simple;
1990     -use URI::URL;
1991     -
1992     -#use CGI;
1993     -#use HTML::TextToHTML;
1994     -
1995     -my $hostname = hostname();
1996     -my $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n";
1997     -
1998     -my $true = 1;
1999     -my $false = 0;
2000     -#and see if mailstats are disabled
2001     -my $disabled;
2002     -if ($cdb->get('mailstats')){
2003     - $disabled = !(($cdb->get('mailstats')->prop('Status') || 'enabled') eq 'enabled');
2004     -} else {
2005     - my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled', Email => 'admin' });
2006     - $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n"; #Open up again to pick up new record
2007     - $disabled = $false;
2008     -}
2009     -
2010     -#Configuration section
2011     -my %opt = (
2012     - version => '0.7.12', # please update at each change.
2013     - debug => 0, # guess what ?
2014     - sendmail => '/usr/sbin/sendmail', # Path to sendmail stub
2015     - from => 'spamfilter-stats', # Who is the mail from
2016     - mail => $cdb->get('mailstats')->prop('Email') || 'admin', # mailstats email recipient
2017     - timezone => `date +%z`,
2018     -);
2019     -
2020     -my $FetchmailIP = '127.0.0.200'; #Apparent Ip address of fetchmail deliveries
2021     -my $WebmailIP = '127.0.0.1'; #Apparent Ip of Webmail sender
2022     -my $localhost = 'localhost'; #Apparent sender for webmail
2023     -my $FETCHMAIL = 'FETCHMAIL'; #Sender from fetchmail when Ip address not 127.0.0.200 - when qpsmtpd denies the email
2024     -my $MAILMAN = "bounces"; #sender when mailman sending when orig is localhost
2025     -my $DMARCDomain="dmarc"; #Pattern to recognised DMARC sent emails (this not very reliable, as the email address could be anything)
2026     -my $DMARCOkPattern="dmarc: pass"; #Pattern to use to detect DMARC approval
2027     -my $localIPregexp = ".*((127\.)|(10\.)|(172\.1[6-9]\.)|(172\.2[0-9]\.)|(172\.3[0-1]\.)|(192\.168\.)).*";
2028     -my $MinCol = 6; #Minimum column width
2029     -my $HourColWidth = 16; #Date and time column width
2030     -
2031     -my $SARulethresholdPercent = 10; #If Sa rules less than this of total emails, then cutoff reduced
2032     -my $maxcutoff = 1; #max percent cutoff applied
2033     -my $mincutoff = 0.2; #min percent cutoff applied
2034     -
2035     -my $tstart = time;
2036     -
2037     -#Local variables
2038     -my $YEAR = ( localtime(time) )[5]; # this is years since 1900
2039     -
2040     -my $total = 0;
2041     -my $spamcount = 0;
2042     -my $spamavg = 0;
2043     -my $spamhits = 0;
2044     -my $hamcount = 0;
2045     -my $hamavg = 0;
2046     -my $hamhits = 0;
2047     -my $rejectspamavg = 0;
2048     -my $rejectspamhits= 0;
2049     -
2050     -my $Accepttotal = 0;
2051     -my $localAccepttotal = 0; #Fetchmail connections
2052     -my $localsendtotal = 0; #Connections from local PCs
2053     -my $totalexamined = 0; #total download + RBL etc
2054     -my $WebMailsendtotal = 0; #total from Webmail
2055     -my $mailmansendcount = 0; #total from mailman
2056     -my $DMARCSendCount = 0; #total DMARC reporting emails sent (approx)
2057     -my $DMARCOkCount = 0; #Total emails approved through DMARC
2058     -
2059     -
2060     -
2061     -my %found_viruses = ();
2062     -my %found_qpcodes = ();
2063     -my %found_SARules = ();
2064     -my %junkcount = ();
2065     -my %unrecog_plugin = ();
2066     -my %blacklistURL = (); #Count of use of each balcklist rhsbl
2067     -my %usercounts = (); #Count per received email of sucessful delivery, queued spam and deleted Spam, and rejected
2068     -
2069     -# replaced by...
2070     -my %counts = (); #Hold all counts in 2-D matrix
2071     -my @display = (); #used to switch on and off columns - yes, no or auto for each category
2072     -my @colwidth = (); #width of each column
2073     - #(auto means only if non zero) - populated from possible db entries
2074     -my @finaldisplay = (); #final decision on display or not - true or false
2075     -
2076     -#count column names, used for headings - also used for DB mailstats property names
2077     -my $CATHOUR='Hour';
2078     -my $CATFETCHMAIL='Fetchmail';
2079     -my $CATWEBMAIL='WebMail';
2080     -my $CATMAILMAN='Mailman';
2081     -my $CATLOCAL='Local';
2082     -my $CATRELAY="Relay";
2083     -# border between where it came from and where it ended..
2084     -my $countfromhere = 6; #Temp - Check this not moved!!
2085     -
2086     -my $CATVIRUS='Virus';
2087     -my $CATRBLDNS='RBL/DNS';
2088     -my $CATEXECUT='Execut.';
2089     -my $CATNONCONF='Non.Conf.';
2090     -my $CATBADCOUNTRIES='Geoip.';
2091     -my $CATKARMA="Karma";
2092     -
2093     -my $CATSPAMDEL='Del.Spam';
2094     -my $CATSPAM='Qued.Spam?';
2095     -my $CATHAM='Ham';
2096     -my $CATTOTALS='TOTALS';
2097     -my $CATPERCENT='PERCENT';
2098     -my $CATDMARC="DMARC Rej.";
2099     -my $CATLOAD="Rej.Load";
2100     -my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATRELAY,$CATDMARC,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATBADCOUNTRIES,$CATNONCONF,$CATLOAD,$CATKARMA,$CATSPAMDEL,$CATSPAM,$CATHAM,$CATTOTALS,$CATPERCENT);
2101     -my $GRANDTOTAL = '99'; #subs for count arrays, for grand total
2102     -my $PERCENT = '98'; # for column percentages
2103     -
2104     -my $categlen = @categs-2; #-2 to avoid the total and percent column
2105     -
2106     -#
2107     -# Index for certain columns - check these do not move if we add columns
2108     -#
2109     -#my $BadCountryCateg=9;
2110     -#my $DMARCcateg = 5; #Not used.
2111     -#my $KarmaCateg=$BadCountryCateg+3;
2112     -
2113     -my %categindex;
2114     -@categindex{@categs} = (0..$#categs);
2115     -my $BadCountryCateg=$categindex{$CATBADCOUNTRIES};
2116     -my $DMARCcateg = $categindex{$CATDMARC}; #Not used.
2117     -my $KarmaCateg=$categindex{$CATKARMA};
2118     -
2119     -my $above15 = 0;
2120     -my $RBLcount = 0;
2121     -my $MiscDenyCount = 0;
2122     -my $PatternFilterCount = 0;
2123     -my $noninfectedcount = 0;
2124     -my $okemailcount = 0;
2125     -my $infectedcount = 0;
2126     -my $warnnoreject = " ";
2127     -my $rblnotset = ' ';
2128     -
2129     -my %found_countries = ();
2130     -my $total_countries = 0;
2131     -my $BadCountries = ""; #From the DB
2132     -
2133     -my $FS = "\t"; # field separator used by logterse plugin
2134     -my %log_items = ( "", "", "", "", "", "", "", "" );
2135     -my $score;
2136     -my %timestamp_items = ();
2137     -my $localflag = 0; #indicate if current email is local or not
2138     -my $WebMailflag = 0; #indicate if current mail is send from webmail
2139     -
2140     -# some storage for by recipient domains stats (PS)
2141     -# my bad : I have to deal with multiple simoultaneous connections
2142     -# will play with the process number.
2143     -# my $currentrcptdomain = '' ;
2144     -my %currentrcptdomain ; # temporay store the recipient domain until end of mail processing
2145     -my %byrcptdomain ; # Store 'by domains stats'
2146     -my @extdomain ; # only useful in some MX-Backup case, when any subdomains are allowed
2147     -my $morethanonercpt = 0 ; # count every 'second' recipients for a mail.
2148     -my $recipcount = 0; # count every recipient email address received.
2149     -
2150     -#
2151     -#Load up the emails curreently stored for DMARC reporting - so that we cna spot the reports being sent.
2152     -#Held in an slqite db, created by the DMARC perl lib.
2153     -#
2154     -my $dsn = "dbi:SQLite:dbname=/var/lib/qpsmtpd/dmarc/reports.sqlite"; #Taken from /etc/mail-dmarc.ini
2155     -# doesn't seem to need
2156     -my $user = "";
2157     -my $pass = "";
2158     -my $DMARC_Report_emails = ""; #Flat string of all email addresses
2159     -
2160     - if (my $dbix = DBIx::Simple->connect( $dsn, $user, $pass )){
2161     - my $result = $dbix->query("select rua from report_policy_published;");
2162     - $result->bind(my ($emailaddress));
2163     - while ($result->fetch){
2164     - #print STDERR "$emailaddress";
2165     - #remember email from logterse entry has chevrons round it - so we add them here to guarantee the alighment of the match
2166     - #Remove the mailto:
2167     - $emailaddress =~ s/mailto://g;
2168     - # and map any commas to ><
2169     - $emailaddress =~ s/,/></g;
2170     - $DMARC_Report_emails .= "<".$emailaddress.">\n"
2171     - }
2172     - $dbix->disconnect();
2173     - } else { $DMARC_Report_emails = "None found - DB not opened"}
2174     -
2175     -
2176     -#dbg("DMARC-EMAILS:".$DMARC_Report_emails);
2177     -
2178     -# and setup list of local domains for spotting the local one in a list of email addresses (Remote station processing)
2179     -use esmith::DomainsDB;
2180     -my $d = esmith::DomainsDB->open_ro();
2181     -my @domains = $d->keys();
2182     -my $alldomains = "(";
2183     -foreach my $dom (@domains){$alldomains .= $dom."|"}
2184     -$alldomains .= ")";
2185     -#print $alldomains;
2186     -
2187     -# Saving the Log lines processed
2188     -my %LogLines = (); #Save all the log lines processed for writing to the DB
2189     -my %LogId = (); #Save the Log Ids.
2190     -my $CurrentLogId = "";
2191     -my $Sequence = 0;
2192     -
2193     -
2194     -# store the domain of interest. Every other records are stored in a 'Other' zone
2195     -my $ddb = esmith::DomainsDB->open_ro or die "Couldn't open DomainsDB : $!\n";
2196     -
2197     -foreach my $domain( $ddb->get_all_by_prop( type => "domain" ) ) {
2198     - $byrcptdomain{ $domain->key }{ 'type' }='local';
2199     -}
2200     -$byrcptdomain{ $cdb->get('SystemName')->value . "."
2201     - . $cdb->get('DomainName')->value }{ 'type' } = 'local';
2202     -
2203     -# is this system a MX-Backup ?
2204     -if ($cdb->get('mxbackup')){
2205     - if ( ( $cdb->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) {
2206     - my %MXValues = split( /,/, ( $cdb->get('mxbackup')->prop('name') || '' ) ) ;
2207     - foreach my $data ( keys %MXValues ) {
2208     - $byrcptdomain{ $data }{ 'type' } = "mxbackup-$MXValues{ $data }" ;
2209     - if ( $MXValues{ $data } == 1 ) { # subdomains allowed, must take care of this
2210     - push @extdomain, $data ;
2211     - }
2212     - }
2213     - }
2214     -}
2215     -
2216     -my ( $start, $end ) = analysis_period();
2217     -
2218     -dbg("Time interval:".strftime("%a %b %e %H:%M:%S %Y", localtime($start))."->".strftime("%a %b %e %H:%M:%S %Y", localtime($end))."\n");
2219     -
2220     -#
2221     -# First check current configuration for logging, DNS enable and Max threshold for spamassassin
2222     -#
2223     -
2224     -my $LogLevel = $cdb->get('qpsmtpd')->prop('LogLevel');
2225     -my $HighLogLevel = ( $LogLevel > 6 );
2226     -
2227     -my $RHSenabled =
2228     - ( $cdb->get('qpsmtpd')->prop('RHSBL') eq 'enabled' );
2229     -my $DNSenabled =
2230     - ( $cdb->get('qpsmtpd')->prop('DNSBL') eq 'enabled' );
2231     -my $SARejectLevel =
2232     - $cdb->get('spamassassin')->prop('RejectLevel');
2233     -my $SATagLevel =
2234     - $cdb->get('spamassassin')->prop('TagLevel');
2235     -my $DomainName =
2236     - $cdb->get('DomainName')->value;
2237     -
2238     -# check that logterse is in use
2239     -#my pluginfile = '/var/service/qpsmtpd/config/peers/0';
2240     -
2241     -if ( !$RHSenabled || !$DNSenabled ) {
2242     - $rblnotset = '*';
2243     -}
2244     -
2245     -if ( $SARejectLevel == 0 ) {
2246     -
2247     - $warnnoreject = "(*Warning* 0 = no reject)";
2248     -
2249     -}
2250     -
2251     -# get enable/disable subsections
2252     -my $enableqpsmtpdcodes;
2253     -my $enableSARules;
2254     -my $enableGeoiptable;
2255     -my $enablejunkMailList;
2256     -my $savedata;
2257     -my $enableblacklist; #Enabled according to setting in qpsmtpd
2258     -if ($cdb->get('mailstats')){
2259     - $enableqpsmtpdcodes = ($cdb->get('mailstats')->prop("QpsmtpdCodes") || "enabled") eq "enabled" || $false;
2260     - $enableSARules = ($cdb->get('mailstats')->prop("SARules") || "enabled") eq "enabled" || $false;
2261     - $enablejunkMailList = ($cdb->get('mailstats')->prop("JunkMailList") || "enabled") eq "enabled" || $false;
2262     - $enableGeoiptable = ($cdb->get('mailstats')->prop("Geoiptable") || "enabled") eq "enabled" || $false;
2263     - $savedata = ($cdb->get('mailstats')->prop("SaveDataToMySQL") || "no") eq "yes" || $false;
2264     - } else {
2265     - $enableqpsmtpdcodes = $true;
2266     - $enableSARules = $true;
2267     - $enablejunkMailList = $true;
2268     - $enableGeoiptable = $true;
2269     - $savedata = $false;
2270     - }
2271     - $enableblacklist = ($cdb->get('qpsmtpd')->prop("RHSBL") || "disabled") eq "enabled" || ($cdb->get('qpsmtpd')->prop("URIBL") || "disabled") eq "enabled";
2272     - #$savedata = $false; #TEMP!!
2273     -#if ($savedata){print STDERR "yes"} else {print STDERR "no"}
2274     -
2275     -my $makeHTMLemail = "no";
2276     -#if ($cdb->get('mailstats')){$makeHTMLemail = $cdb->get('mailstats')->prop('HTMLEmail') || "no"} #TEMP!!
2277     -my $makeHTMLpage = "no";
2278     -#if ($makeHTMLemail eq "yes" || $makeHTMLemail eq "both") {$makeHTMLpage = "yes"}
2279     -#if ($cdb->get('mailstats')){$makeHTMLpage = $cdb->get('mailstats')->prop('HTMLPage') || "no"}
2280     -
2281     -
2282     -# Init the hashes
2283     -my $nhour = floor( $start / 3600 );
2284     -my $ncateg;
2285     -while ( $nhour < $end / 3600 ) {
2286     - $counts{$nhour}=();
2287     - $ncateg = 0;
2288     - while ( $ncateg < @categs) {
2289     - $counts{$nhour}{$categs[$ncateg-1]} = 0;
2290     - $ncateg++
2291     - }
2292     - $nhour++;
2293     -}
2294     -# and grand totals, percent and display status from db entries, and column widths
2295     -$ncateg = 0;
2296     -my $colpadding = 0;
2297     -while ( $ncateg < @categs) {
2298     - $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0;
2299     - $counts{$PERCENT}{$categs[$ncateg]} = 0;
2300     -
2301     - if ($cdb->get('mailstats')){
2302     - $display[$ncateg] = lc($cdb->get('mailstats')->prop($categs[$ncateg])) || "auto";
2303     - } else {
2304     - $display[$ncateg] = 'auto'
2305     - }
2306     - if ($ncateg == 0) {
2307     - $colwidth[$ncateg] = $HourColWidth + $colpadding;
2308     - } else {
2309     - $colwidth[$ncateg] = length($categs[$ncateg])+1+$colpadding;
2310     - }
2311     - if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol + $colpadding}
2312     - $ncateg++
2313     -}
2314     -
2315     -my $starttai = Time::TAI64::unixtai64n($start);
2316     -my $endtai = Time::TAI64::unixtai64n($end);
2317     -my $sum_SARules = 0;
2318     -
2319     -# we remove non valid files
2320     -my @ARGV2;
2321     -foreach ( map { glob } @ARGV){
2322     - push(@ARGV2,($_));
2323     -}
2324     -@ARGV=@ARGV2;
2325     -
2326     -my $count = -1; #for loop reduction in debugging mode
2327     -
2328     -#
2329     -#---------------------------------------
2330     -# Scan the qpsmtpd log file(s)
2331     -#---------------------------------------
2332     -
2333     -
2334     -my $CurrentMailId = "";
2335     -
2336     -LINE: while (<>) {
2337     -
2338     - #print STDERR $starttai,$endtai,$_,"\n";
2339     -
2340     -
2341     - next LINE if !(my($tai,$log) = split(' ',$_,2));
2342     - #dbg("TAI:".$tai);
2343     -
2344     - #dbg("REST1:".$log);
2345     -
2346     - #If date specified, only process lines matching date
2347     - next LINE if ( $tai lt $starttai );
2348     - next LINE if ( $tai gt $endtai );
2349     -
2350     - #Count lines and skip out if debugging
2351     - $count++;
2352     - #last LINE if ($opt{debug} && $count >= 100);
2353     - #dbg("REST:".$log);
2354     -
2355     -
2356     - #Loglines to Saved String for later DB write
2357     - if ($savedata) {
2358     - my $CurrentLine = $_;
2359     - $CurrentLine = /^\@([0-9a-z]*) ([0-9]*) .*$/;
2360     - my $l = length($CurrentLine);
2361     - if ($l != 0){
2362     - if (defined($2)){ #print STDERR "Undefined \$2:".$_.":".$count.":".$l;exit}
2363     - if ($2 ne $CurrentMailId) {
2364     - print "CL:$CurrentLine*\n" if !defined($1);
2365     - $CurrentLogId = $1."-".$2;
2366     - $CurrentMailId = $2;
2367     - $Sequence = 0;
2368     - } else {$Sequence++}
2369     - #$CurrentLogId .=":".$Sequence;
2370     - $LogLines{$CurrentLogId.":".$Sequence} = $_;
2371     - }
2372     - }
2373     - #print STDERR $CurrentLogId.":".$LogLines{$CurrentLogId}."\n";
2374     - #exit
2375     - }
2376     -
2377     -
2378     - # pull out spamasassin rule lists
2379     - if ( $_ =~m/spamassassin: pass, Ham,(.*)</ )
2380     - #if ( $_ =~m/spamassassin plugin.*: check_spam:.*hits=(.*), required.*tests=(.*)/ )
2381     - {
2382     - #dbg("SPAM:".$log);
2383     - #New version does not seem to have spammassasin tests in logs
2384     - #if (exists($2){
2385     - #my (@SAtests) = split(',',$2);
2386     - #foreach my $SAtest (@SAtests) {
2387     - #if (!$SAtest eq "") {
2388     - #$found_SARules{$SAtest}{'count'}++;
2389     - #$found_SARules{$SAtest}{'totalhits'} += $1;
2390     - #$sum_SARules++
2391     - #}
2392     - #}
2393     - #}
2394     -
2395     - }
2396     -
2397     -
2398     - #Pull out Geoip countries for analysis table
2399     - if ( $_ =~m/check_badcountries: GeoIP Country: (.*)/ )
2400     - {
2401     - $found_countries{$1}++;
2402     - $total_countries++;
2403     - }
2404     -
2405     - #Pull out DMARC approvals
2406     - if ( $_ =~m/.*$DMARCOkPattern.*/ )
2407     - {
2408     - $DMARCOkCount++;
2409     - }
2410     -
2411     -
2412     - #only select Logterse output
2413     - next LINE unless m/logging::logterse:/;
2414     -
2415     - my $abstime = Time::TAI64::tai2unix($tai);
2416     - my $abshour = floor( $abstime / 3600 ); # Hours since the epoch
2417     -
2418     -
2419     - my ($timestamp_part, $log_part) = split('`',$_,2); #bjr 0.6.12
2420     - my (@log_items) = split $FS, $log_part;
2421     -
2422     - my (@timestamp_items) = split(' ',$timestamp_part);
2423     -
2424     - my $result= "rejected"; #Tag as rejected unti we know otherwise
2425     - # we store the more recent recipient domain, for domain statistics
2426     - # in fact, we only store the first recipient. Could be sort of headhache
2427     - # to obtain precise stats with many recipients on more than one domain !
2428     - my $proc = $timestamp_items[1] ; #numeric Id for the email
2429     - my $emailnum = $proc; #proc gets modified later...
2430     -
2431     - if ($emailnum == 23244) {
2432     - dbg("TM0:".$timestamp_items[0]);
2433     - dbg("TM1:".$timestamp_items[1]);
2434     - dbg("TM2:".$timestamp_items[2]);
2435     - dbg("TM3:".$timestamp_items[3]);
2436     - dbg("LOG0:".$log_items[0]);
2437     - dbg("LOG1:".$log_items[1]);
2438     - dbg("LOG2:".$log_items[2]);
2439     - dbg("LOG3:".$log_items[3]);
2440     - dbg("LOG4:".$log_items[4]);
2441     - dbg("LOG5:".$log_items[5]);
2442     - dbg("LOG6:".$log_items[6]);
2443     - dbg("LOG7:".$log_items[7]);
2444     - dbg("IPregexp:".$localIPregexp);
2445     - if (!test_for_private_ip($log_items[0])) {dbg("Log0 not found");}
2446     - if (test_for_private_ip($log_items[2])){ dbg("Log2 match")}
2447     - if ($log_items[5] eq "queued") {dbg("LOG5 match")}
2448     - }
2449     -
2450     - $totalexamined++;
2451     -
2452     -# dbg("LOG8:".$log_items[8]);
2453     -
2454     - # first spot the fetchmail and local deliveries.
2455     -
2456     - # Spot from local workstation
2457     - $localflag = 0;
2458     - $WebMailflag = 0;
2459     - if ( $log_items[1] =~ m/$DomainName/ ) { #bjr
2460     - #dbg("LOG1-Found:".$log_items[1]);
2461     - $localsendtotal++;
2462     - $counts{$abshour}{$CATLOCAL}++;
2463     - $localflag = 1;
2464     - }
2465     -
2466     - #Or a remote station
2467     - elsif ((!test_for_private_ip($log_items[0])) and (test_for_private_ip($log_items[2])) and ($log_items[5] eq "queued"))
2468     - {
2469     - #Remote user
2470     - $localflag = 1;
2471     - $counts{$abshour}{$CATRELAY}++;
2472     - }
2473     -
2474     - elsif (($log_items[2] =~ m/$WebmailIP/) and (!test_for_private_ip($log_items[0]))) {
2475     - #Webmail
2476     -# if ($emailnum == 19608){
2477     - dbg("WEBMAIL:");
2478     - dbg("TM0:".$timestamp_items[0]);
2479     - dbg("TM1:".$timestamp_items[1]);
2480     - dbg("TM2:".$timestamp_items[2]);
2481     - dbg("TM3:".$timestamp_items[3]);
2482     - dbg("LOG0:".$log_items[0]);
2483     - dbg("LOG1:".$log_items[1]);
2484     - dbg("LOG2:".$log_items[2]);
2485     - dbg("LOG3:".$log_items[3]);
2486     - dbg("LOG4:".$log_items[4]);
2487     - dbg("LOG5:".$log_items[5]);
2488     - dbg("LOG6:".$log_items[6]);
2489     - dbg("LOG7:".$log_items[7]);
2490     - #exit;
2491     -# }
2492     - $localflag = 1;
2493     - $WebMailsendtotal++;
2494     - $counts{$abshour}{$CATWEBMAIL}++;
2495     - $WebMailflag = 1;
2496     - }
2497     -
2498     - # see if from localhost
2499     - elsif ( $log_items[1] =~ m/$localhost/ ) {
2500     - # but not if it comes from fetchmail
2501     - if ( $log_items[3] =~ m/$FETCHMAIL/ ) { }
2502     - else {
2503     - $localflag = 1;
2504     - # might still be from mailman here
2505     - if ( $log_items[3] =~ m/$MAILMAN/ ) {
2506     - $mailmansendcount++;
2507     - $localsendtotal++;
2508     - $counts{$abshour}{$CATMAILMAN}++;
2509     - $localflag = 1;
2510     - }
2511     - else {
2512     - #Or sent to the DMARC server
2513     - #dbg("LOG4:".$log_items[4]);
2514     - #check for email address in $DMARC_Report_emails string
2515     - my $logemail = $log_items[4];
2516     - if ((index($DMARC_Report_emails,$logemail)>=0) or ($logemail =~ m/$DMARCDomain/)){
2517     - $localsendtotal++;
2518     - $DMARCSendCount++;
2519     - $localflag = 1;
2520     - }
2521     - else {
2522     - #print STDERR "no match:.".$logemail;
2523     - if (exists $log_items[8]){
2524     - #dbg("LOG8:".$log_items[8]);
2525     - # ignore incoming localhost spoofs
2526     - if ( $log_items[8] =~ m/msg denied before queued/ ) { }
2527     - else {
2528     - #Webmail
2529     - $localflag = 1;
2530     - $WebMailsendtotal++;
2531     - $counts{$abshour}{$CATWEBMAIL}++;
2532     - $WebMailflag = 1;
2533     - }
2534     - }
2535     - else {
2536     - $localflag = 1;
2537     - $WebMailsendtotal++;
2538     - $counts{$abshour}{$CATWEBMAIL}++;
2539     - $WebMailflag = 1;
2540     - }
2541     - }
2542     - }
2543     - }
2544     - }
2545     -
2546     - # try to spot fetchmail emails
2547     - if ( $log_items[0] =~ m/$FetchmailIP/ ) {
2548     - #dbg("LOG0:".$log_items[0]);
2549     - $localAccepttotal++;
2550     - $counts{$abshour}{$CATFETCHMAIL}++;
2551     - }
2552     - elsif ( $log_items[3] =~ m/$FETCHMAIL/ ) {
2553     - $localAccepttotal++;
2554     - $counts{$abshour}{$CATFETCHMAIL}++;
2555     - }
2556     -
2557     -# and adjust for recipient field if not set-up by denying plugin - extract from deny msg
2558     -
2559     - if ( length( $log_items[4] ) == 0 ) {
2560     - #dbg("LOG7:".$log_items[0]);
2561     - if ( $log_items[5] eq 'check_goodrcptto' ) {
2562     - if ( $log_items[7] gt "invalid recipient" ) {
2563     - $log_items[4] =
2564     - substr( $log_items[7], 18 ); #Leave only email address
2565     - #dbg("LOG4:".$log_items[0]);
2566     -
2567     - }
2568     - }
2569     - }
2570     -
2571     - # if ( ( $currentrcptdomain{ $proc } || '' ) eq '' ) {
2572     - # reduce to lc and process each e,mail if a list, pseperatedy commas
2573     - my $recipientmail = lc( $log_items[4] );
2574     - #dbg("LOG4:".$log_items[0]);
2575     - if ( $recipientmail =~ m/.*,/ ) {
2576     -
2577     - #comma - split the line and deal with each domain
2578     - # print $recipientmail."\n";
2579     - my ($recipients) = split( ',', $recipientmail );
2580     - foreach my $recip ($recipients) {
2581     - $proc = $proc . $recip;
2582     -
2583     - # print $proc."\n";
2584     - $currentrcptdomain{$proc} = $recip;
2585     - add_in_domain($proc);
2586     - $recipcount++;
2587     - }
2588     -
2589     - # print "*\n";
2590     - #count emails with more than one recipient
2591     - # $recipientmail =~ m/(.*),/;
2592     - # $currentrcptdomain{ $proc } = $1;
2593     - }
2594     - else {
2595     - $proc = $proc . $recipientmail;
2596     - $currentrcptdomain{$proc} = $recipientmail;
2597     - add_in_domain($proc);
2598     - $recipcount++;
2599     - }
2600     -
2601     - # } else {
2602     - # # there more than a recipient for a mail, how many daily ?
2603     - # $morethanonercpt++;
2604     - # }
2605     -
2606     -
2607     - # then categorise the result
2608     -
2609     -
2610     - if (exists $log_items[5]) {
2611     -
2612     - if ($log_items[5] eq 'naughty') {
2613     - my $rejreason = $log_items[7];
2614     - $rejreason = /.*(\(.*\)).*/;
2615     - if (!defined($1)){$rejreason = "unknown"}
2616     - else {$rejreason = $1}
2617     - $found_qpcodes{$log_items[5]."-".$rejreason}++}
2618     - else {$found_qpcodes{$log_items[5]}++} ##Count different qpsmtpd result codes
2619     -
2620     - if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2621     -
2622     - elsif ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2623     -
2624     - elsif ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2625     -
2626     - elsif ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2627     -
2628     - elsif ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2629     -
2630     - elsif ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
2631     -
2632     - elsif ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
2633     -
2634     - elsif ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2635     -
2636     - elsif ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2637     -
2638     - elsif ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2639     -
2640     - elsif ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2641     -
2642     - elsif ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2643     -
2644     - elsif ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2645     -
2646     - elsif ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)}
2647     -
2648     - elsif ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc)}
2649     -
2650     - elsif ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2651     -
2652     - elsif ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2653     -
2654     - elsif ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2655     -
2656     - elsif ($log_items[5] eq 'check_badcountries') {$MiscDenyCount++;$counts{$abshour}{$CATBADCOUNTRIES}++;mark_domain_rejected($proc)}
2657     -
2658     - elsif ($log_items[5] eq 'tnef2mime') { } #Not expecting this one.
2659     -
2660     - elsif ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++;
2661     - # and extract the spam score
2662     - # if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)")
2663     - if ($log_items[8] =~ "Yes, score=(.*) required=([0-9\.]+)")
2664     - {$rejectspamavg += $1}
2665     - mark_domain_rejected($proc);
2666     - }
2667     -
2668     - elsif (($log_items[5] eq 'virus::clamav') or ($log_items[5] eq 'virus::clamdscan')) { $infectedcount++;$counts{$abshour}{$CATVIRUS}++;
2669     - #extract the virus name
2670     - if ($log_items[7] =~ "Virus found: (.*)" ) {$found_viruses{$1}++;}
2671     - else {$found_viruses{$log_items[7]}++} #Some other message!!
2672     - #dbg("LOG7:".$log_items[7]);
2673     - mark_domain_rejected($proc);
2674     - }
2675     -
2676     - elsif ($log_items[5] eq 'queued') { $Accepttotal++;
2677     - #extract the spam score
2678     - # Remove count for rejectred as it looks as if it might get through!!
2679     - $result= "queued";
2680     - if ($log_items[8] =~ ".*score=([+-]?\\d+\.?\\d*).* required=([0-9\.]+)") {
2681     - $score = trim($1);
2682     - if ($score =~ /^[+-]?\d+\.?\d*$/ ) #check its numeric
2683     - {
2684     - if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score;}
2685     - else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score;$result= "spam";}
2686     - } else {
2687     - print "Unexpected non numeric found in $proc:".$log_items[8]."($score)\n";
2688     - }
2689     - } else {
2690     - # no SA score - treat it as ham
2691     - $hamcount++;$counts{$abshour}{$CATHAM}++;
2692     - }
2693     - if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
2694     - $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ;
2695     - $currentrcptdomain{ $proc } = '' ;
2696     - }
2697     - }
2698     -
2699     -
2700     - elsif ($log_items[5] eq 'tls') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2701     -
2702     - elsif ($log_items[5] eq 'auth::auth_cvm_unix_local') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2703     -
2704     - elsif ($log_items[5] eq 'earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2705     -
2706     - elsif ($log_items[5] eq 'uribl') {$RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
2707     -
2708     - elsif ($log_items[5] eq 'naughty') {
2709     - #Naughty plugin seems to span a number of rejection reasons - so we have to use the next but one log_item[7] to identify
2710     - if ($log_items[7] =~ m/(karma)/) {
2711     - $MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)}
2712     - elsif ($log_items[7] =~ m/(dnsbl)/){
2713     - $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);$blacklistURL{get_domain($log_items[7])}++}
2714     - elsif ($log_items[7] =~ m/(helo)/){
2715     - $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2716     - else {
2717     - #Unidentified Naughty rejection
2718     - $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]."-".$log_items[7]}++}
2719     - }
2720     - elsif ($log_items[5] eq 'resolvable_fromhost') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2721     -
2722     - elsif ($log_items[5] eq 'loadcheck') {$MiscDenyCount++;$counts{$abshour}{$CATLOAD}++;mark_domain_rejected($proc)}
2723     -
2724     - elsif ($log_items[5] eq 'karma') {$MiscDenyCount++;$counts{$abshour}{$CATKARMA}++;mark_domain_rejected($proc)}
2725     -
2726     - elsif ($log_items[5] eq 'dmarc') {$MiscDenyCount++;$counts{$abshour}{$CATDMARC}++;mark_domain_rejected($proc)}
2727     -
2728     - elsif ($log_items[5] eq 'relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2729     -
2730     - elsif ($log_items[5] eq 'headers') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2731     -
2732     - elsif ($log_items[5] eq 'mailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2733     -
2734     - elsif ($log_items[5] eq 'badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2735     -
2736     - elsif ($log_items[5] eq 'helo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2737     -
2738     - elsif ($log_items[5] eq 'check_smtp_forward') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2739     -
2740     - elsif ($log_items[5] eq 'sender_permitted_from') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc)}
2741     -
2742     - #Treat it as Unconf if not recognised
2743     - else {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);$unrecog_plugin{$log_items[5]}++}
2744     - } #Log[5] exists
2745     -
2746     - #Entry if not local send
2747     - if ($localflag == 0) {
2748     - if (length($log_items[4]) > 0){
2749     - # Need to check here for multiple email addresses
2750     - my @emails = split(",",lc($log_items[4]));
2751     - if (scalar(@emails) > 1) {
2752     - #Just pick the first local address to hang it on.
2753     - # TEMP - just go for the first address until I can work out how to spot the 1st "local" one
2754     - $usercounts{$emails[0]}{$result}++;
2755     - $usercounts{$emails[0]}{"proc"} = $proc;
2756     - #Compare with @domains array until we get a local one
2757     - my $gotone = $false;
2758     - foreach my $email (@emails){
2759     - #Extract the domain from the email address
2760     - my $fullemail = $email;
2761     - $email = s/.*\@(.*)$/$1/;
2762     - #and see if it is local
2763     - if ($email =~ m/$alldomains/){
2764     - $usercounts{lc($fullemail)}{$result}++;
2765     - $usercounts{lc($fullemail)}{"proc"} = $proc;
2766     - $gotone = $true;
2767     - last;
2768     - }
2769     - }
2770     - if (!$gotone) {
2771     - $usercounts{'No internal email $proc'}{$result}++;
2772     - $usercounts{'No internal email $proc'}{"proc"} = $proc;
2773     - }
2774     -
2775     - } else {
2776     - $usercounts{lc($log_items[4])}{$result}++;
2777     - $usercounts{lc($log_items[4])}{"proc"} = $proc;
2778     - }
2779     - }
2780     - }
2781     - #exit if $emailnum == 15858;
2782     -
2783     -} #END OF MAIN LOOP
2784     -
2785     -#total up grand total Columns
2786     -$nhour = floor( $start / 3600 );
2787     -while ( $nhour < $end / 3600 ) {
2788     - $ncateg = 0; #past the where it came from columns
2789     - while ( $ncateg < @categs) {
2790     - #total columns
2791     - $counts{$GRANDTOTAL}{$categs[$ncateg]} += $counts{$nhour}{$categs[$ncateg]};
2792     -
2793     - # and total rows
2794     - if ( $ncateg < $categlen and $ncateg>=$countfromhere) {#skip initial columns of non final reasons
2795     - $counts{$nhour}{$categs[@categs-2]} += $counts{$nhour}{$categs[$ncateg]};
2796     - }
2797     - $ncateg++
2798     - }
2799     -
2800     - $nhour++;
2801     -}
2802     -
2803     -
2804     -
2805     -#Compute row totals and row percentages
2806     -$nhour = floor( $start / 3600 );
2807     -while ( $nhour < $end / 3600 ) {
2808     - $counts{$nhour}{$categs[@categs-1]} = $counts{$nhour}{$categs[@categs-2]}*100/$totalexamined if $totalexamined;
2809     - $nhour++;
2810     -
2811     -}
2812     -
2813     -#compute column percentages
2814     - $ncateg = 0;
2815     - while ( $ncateg < @categs) {
2816     - if ($ncateg == @categs-1) {
2817     - $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg-1]}*100/$totalexamined if $totalexamined;
2818     - } else {
2819     - $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg]}*100/$totalexamined if $totalexamined;
2820     - }
2821     - $ncateg++
2822     - }
2823     -
2824     -#compute sum of row percentages
2825     -$nhour = floor( $start / 3600 );
2826     -while ( $nhour < $end / 3600 ) {
2827     - $counts{$GRANDTOTAL}{$categs[@categs-1]} += $counts{$nhour}{$categs[@categs-1]};
2828     - $nhour++;
2829     -
2830     -}
2831     -
2832     -my $QueryNoLogTerse = ($totalexamined==0); #might indicate logterse not installed in qpsmtpd plugins
2833     -
2834     -#Calculate some numbers
2835     -
2836     -$spamavg = $spamavg / $spamcount if $spamcount;
2837     -$rejectspamavg = $rejectspamavg / $above15 if $above15;
2838     -$hamavg = $hamavg / $hamcount if $hamcount;
2839     -
2840     -# RBL etc percent of total SMTP sessions
2841     -
2842     -my $rblpercent = ( ( $RBLcount / $totalexamined ) * 100 ) if $totalexamined;
2843     -my $PatternFilterpercent = ( ( $PatternFilterCount / $totalexamined ) * 100 ) if $totalexamined;
2844     -my $Miscpercent = ( ( $MiscDenyCount / $totalexamined ) * 100 ) if $totalexamined;
2845     -
2846     -#Spam and virus percent of total email downloaded
2847     -#Expressed as a % of total examined
2848     -my $spampercent = ( ( $spamcount / $totalexamined ) * 100 ) if $totalexamined;
2849     -my $hampercent = ( ( $hamcount / $totalexamined ) * 100 ) if $totalexamined;
2850     -my $hrsinperiod = ( ( $end - $start ) / 3600 );
2851     -my $emailperhour = ( $totalexamined / $hrsinperiod ) if $totalexamined;
2852     -my $above15percent = ( $above15 / $totalexamined * 100 ) if $totalexamined;
2853     -my $infectedpercent = ( ( $infectedcount / ($totalexamined) ) * 100 ) if $totalexamined;
2854     -my $AcceptPercent = ( ( $Accepttotal / ($totalexamined) ) * 100 ) if $totalexamined;
2855     -
2856     -my $oldfh;
2857     -
2858     -#Open Sendmail if we are mailing it
2859     -if ( $opt{'mail'} and !$disabled ) {
2860     - open( SENDMAIL, "|$opt{'sendmail'} -oi -t -odq" )
2861     - or die "Can't open sendmail: $!\n";
2862     - print SENDMAIL "From: $opt{'from'}\n";
2863     - print SENDMAIL "To: $opt{'mail'}\n";
2864     - print SENDMAIL "Subject: Spam Filter Statistics from $hostname - ",
2865     - strftime( "%F", localtime($start) ), "\n\n";
2866     - $oldfh = select SENDMAIL;
2867     -}
2868     -
2869     -my $telapsed = time - $tstart;
2870     -
2871     -if ( !$disabled ) {
2872     -
2873     - #Output results
2874     -
2875     - # NEW - save the print to a variable so that it can be processed into html.
2876     - #
2877     - #Save current output selection and divert into variable
2878     - #
2879     - my $output;
2880     - my $tablestr="";
2881     - open(my $outputFH, '>', \$tablestr) or die; # This shouldn't fail
2882     - my $oldFH = select $outputFH;
2883     -
2884     -
2885     - print "SMEServer daily Anti-Virus and Spamfilter statistics from $hostname - ".strftime( "%F", localtime($start))."\n";
2886     - print "----------------------------------------------------------------------------------", "\n\n";
2887     - print "$0 Version : $opt{'version'}", "\n";
2888     - print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n";
2889     - print "Period Ending : ", strftime( "%c", localtime($end) ), "\n";
2890     - print "Clam Version/DB Count/Last DB update: ",`freshclam -V`;
2891     - print "SpamAssassin Version : ",`spamassassin -V`;
2892     - printf "Tag level: %3d; Reject level: %3d $warnnoreject\n", $SATagLevel,$SARejectLevel;
2893     - if ($HighLogLevel) {
2894     - printf "*Loglevel is set to: ".$LogLevel. " - you only need it set to 6\n";
2895     - printf "\tYou can set it this way:\n";
2896     - printf "\tconfig setprop qpsmtpd LogLevel 6\n";
2897     - printf "\tsignal-event email-update\n";
2898     - printf "\tsv t /var/service/qpsmtpd\n";
2899     - }
2900     - printf "Reporting Period : %.2f hrs\n", $hrsinperiod;
2901     - printf "All SMTP connections accepted:%8d \n", $totalexamined;
2902     - printf "Emails per hour : %8.1f/hr\n", $emailperhour || 0;
2903     - printf "Average spam score (accepted): %11.2f\n", $spamavg || 0;
2904     - printf "Average spam score (rejected): %11.2f\n", $rejectspamavg || 0;
2905     - printf "Average ham score : %11.2f\n", $hamavg || 0;
2906     - printf "Number of DMARC reporting emails sent:\t%11d (not shown on table)\n", $DMARCSendCount || 0;
2907     - if ($hamcount != 0){ printf "Number of emails approved through DMARC:\t%11d (%3d%% of Ham count)\n", $DMARCOkCount|| 0,$DMARCOkCount*100/$hamcount || 0;}
2908     -
2909     - my $smeoptimizerprog = "/usr/local/smeoptimizer/SMEOptimizer.pl";
2910     - if (-e $smeoptimizerprog) {
2911     - #smeoptimizer installed - get result of status
2912     - my @smeoptimizerlines = split(/\n/,`/usr/local/smeoptimizer/SMEOptimizer.pl -status`);
2913     - print("SMEOptimizer status:\n");
2914     - print("\t".$smeoptimizerlines[6]."\n");
2915     - print("\t".$smeoptimizerlines[7]."\n");
2916     - print("\t".$smeoptimizerlines[8]."\n");
2917     - print("\t".$smeoptimizerlines[9]."\n");
2918     - print("\t".$smeoptimizerlines[10]."\n");
2919     - }
2920     -
2921     -
2922     - print "\nStatistics by Hour:\n";
2923     - #
2924     - # start by working out which colunns to show - tag the display array
2925     - #
2926     - $ncateg = 1; ##skip the first column
2927     - $finaldisplay[0] = $true;
2928     - while ( $ncateg < $categlen) {
2929     - if ($display[$ncateg] eq 'yes') { $finaldisplay[$ncateg] = $true }
2930     - elsif ($display[$ncateg] eq 'no') { $finaldisplay[$ncateg] = $false }
2931     - else {
2932     - $finaldisplay[$ncateg] = ($counts{$GRANDTOTAL}{$categs[$ncateg]} != 0);
2933     - if ($finaldisplay[$ncateg]) {
2934     - #if it has been non zero and auto, then make it yes for the future.
2935     - esmith::ConfigDB->open->get('mailstats')->set_prop($categs[$ncateg],'yes')
2936     - }
2937     -
2938     - }
2939     - $ncateg++
2940     - }
2941     - #make sure total and percentages are shown
2942     - $finaldisplay[@categs-2] = $true;
2943     - $finaldisplay[@categs-1] = $true;
2944     -
2945     -
2946     - # and put together the print lines
2947     -
2948     - my $Line1; #Full Line across the page
2949     - my $Line2; #Broken Line across the page
2950     - my $Titles; #Column headers
2951     - my $Values; #Values
2952     - my $Totals; #Corresponding totals
2953     - my $Percent; # and column percentages
2954     -
2955     - my $hour = floor( $start / 3600 );
2956     - $Line1 = '';
2957     - $Line2 = '';
2958     - $Titles = '';
2959     - $Values = '';
2960     - $Totals = '';
2961     - $Percent = '';
2962     - while ( $hour < $end / 3600 ) {
2963     - if ($hour == floor( $start / 3600 )){
2964     - #Do all the once only things
2965     - $ncateg = 0;
2966     - while ( $ncateg < @categs) {
2967     - if ($finaldisplay[$ncateg]){
2968     - $Line1 .= substr('---------------------',0,$colwidth[$ncateg]);
2969     - $Line2 .= substr('---------------------',0,$colwidth[$ncateg]-1);
2970     - $Line2 .= " ";
2971     - $Titles .= sprintf('%'.($colwidth[$ncateg]-1).'s',$categs[$ncateg])."|";
2972     - if ($ncateg == 0) {
2973     - $Totals .= substr('TOTALS ',0,$colwidth[$ncateg]-2);
2974     - $Percent .= substr('PERCENTAGES ',0,$colwidth[$ncateg]-1);
2975     - } else {
2976     - # identify bottom right group and supress unless db->ShowGranPerc set
2977     - if ($ncateg==@categs-1){
2978     - $Totals .= sprintf('%'.$colwidth[$ncateg].'.1f',$counts{$GRANDTOTAL}{$categs[$ncateg]}).'%';
2979     - } else {
2980     - $Totals .= sprintf('%'.$colwidth[$ncateg].'d',$counts{$GRANDTOTAL}{$categs[$ncateg]});
2981     - }
2982     - $Percent .= sprintf('%'.($colwidth[$ncateg]-1).'.1f',$counts{$PERCENT}{$categs[$ncateg]}).'%';
2983     - }
2984     - }
2985     - $ncateg++
2986     - }
2987     - }
2988     -
2989     - $ncateg = 0;
2990     - while ( $ncateg < @categs) {
2991     - if ($finaldisplay[$ncateg]){
2992     - if ($ncateg == 0) {
2993     - $Values .= strftime( "%F, %H", localtime( $hour * 3600 ) )." "
2994     - } elsif ($ncateg == @categs-1) {
2995     - #percentages in last column
2996     - $Values .= sprintf('%'.($colwidth[$ncateg]-2).'.1f',$counts{$hour}{$categs[$ncateg]})."%";
2997     - } else {
2998     - #body numbers
2999     - $Values .= sprintf('%'.($colwidth[$ncateg]-1).'d',$counts{$hour}{$categs[$ncateg]})." ";
3000     - }
3001     - if (($ncateg == @categs-1)){$Values=$Values."\n"} #&& ($hour == floor($end / 3600)-1)
3002     - }
3003     - $ncateg++
3004     - }
3005     -
3006     - $hour++;
3007     - }
3008     -
3009     - #
3010     - # print it.
3011     - #
3012     -
3013     - print $Line1."\n";
3014     - #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line1."\n";} #These lines mess up the HTML conversion ....
3015     - print $Titles."\n";
3016     - #if ($makeHTMLemail eq "no" && $makeHTMLpage eq "no"){print $Line2."\n";} #ditto
3017     - print $Line2."\n";
3018     - print $Values;
3019     - print $Line2."\n";
3020     - print $Totals."\n";
3021     - print $Percent."\n";
3022     - print $Line1."\n";
3023     -
3024     - if ($localAccepttotal>0) {
3025     - print "*Fetchml* means connections from Fetchmail delivering email\n";
3026     - }
3027     - print "*Local* means connections from workstations on local LAN.\n\n";
3028     - print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol";
3029     - print " or email was to non existant address.\n\n";
3030     -
3031     - if ($finaldisplay[$KarmaCateg]){
3032     - print "*Karma* means email was rejected based on the mailserver's previous activities.\n\n";
3033     - }
3034     -
3035     -
3036     - if ($finaldisplay[$BadCountryCateg]){
3037     - $BadCountries = $cdb->get('qpsmtpd')->prop('BadCountries') || "*none*";
3038     - print "*Geoip\.*:Bad Countries mask is:".$BadCountries."\n\n";
3039     - }
3040     -
3041     -
3042     -
3043     - if (scalar keys %unrecog_plugin > 0){
3044     - #Show unrecog plugins found
3045     - print "*Unrecognised plugins found - categorised as Non-Conf\n";
3046     - foreach my $unrec (keys %unrecog_plugin){
3047     - print "\t$unrec\t($unrecog_plugin{$unrec})\n";
3048     - }
3049     - print "\n";
3050     - }
3051     -
3052     - if ($QueryNoLogTerse) {
3053     - print "* - as no records where found, it looks as though you may not have the *logterse* \nplugin running as part of qpsmtpd \n\n";
3054     -# print " to enable it follow the instructions at .............................\n";
3055     - }
3056     -
3057     -
3058     - if ( !$RHSenabled or !$DNSenabled ) {
3059     -
3060     - # comment about RBL not set
3061     - print
3062     -"* - This means that one or more of the possible spam black listing services\n that are available have not been enabled.\n";
3063     - print " You have not enabled:\n";
3064     -
3065     - if ( !$RHSenabled ) {
3066     - print " RHSBL\n";
3067     - }
3068     -
3069     - if ( !$DNSenabled ) {
3070     - print " DNSBL\n";
3071     - }
3072     -
3073     -
3074     - print " To enable these you can use the following commands:\n";
3075     - if ( !$RHSenabled ) {
3076     - print " config setprop qpsmtpd RHSBL enabled\n";
3077     - }
3078     -
3079     - if ( !$DNSenabled ) {
3080     - print " config setprop qpsmtpd DNSBL enabled\n";
3081     - }
3082     -
3083     - # there so much templates to expand... (PS)
3084     - print " Followed by:\n signal-event email-update and\n sv t /var/service/qpsmtpd\n\n";
3085     - }
3086     -
3087     -# if ($Webmailsendtotal > 0) {print "If you have the mailman contrib installed, then the webmail totals might include some mailman emails\n"}
3088     -
3089     - # time to do a 'by recipient domain' report
3090     - print "Incoming mails by recipient domains usage\n";
3091     - print "-----------------------------------------\n";
3092     - print
3093     - "Domains Type Total Denied XferErr Accept \%accept\n";
3094     - print
3095     - "---------------------------- ---------- ------ ------ ------- ------ -------\n";
3096     - my %total = (
3097     - total => 0,
3098     - deny => 0,
3099     - xfer => 0,
3100     - accept => 0,
3101     - );
3102     - foreach my $domain (
3103     - sort {
3104     - join( "\.", reverse( split /\./, $a ) ) cmp
3105     - join( "\.", reverse( split /\./, $b ) )
3106     - } keys %byrcptdomain
3107     - )
3108     - {
3109     - next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
3110     - my $tp = $byrcptdomain{$domain}{'type'} || 'other';
3111     - my $to = $byrcptdomain{$domain}{'total'} || 0;
3112     - my $de = $byrcptdomain{$domain}{'deny'} || 0;
3113     - my $xr = $byrcptdomain{$domain}{'xfer'} || 0;
3114     - my $ac = $byrcptdomain{$domain}{'accept'} || 0;
3115     - printf "%-28s %-10s %6d %6d %7d %6d %6.2f%%\n", $domain, $tp, $to,
3116     - $de, $xr, $ac, $ac * 100 / $to;
3117     - $total{'total'} += $to;
3118     - $total{'deny'} += $de;
3119     - $total{'xfer'} += $xr;
3120     - $total{'accept'} += $ac;
3121     - }
3122     - print
3123     - "---------------------------- ---------- ------ ------- ------ ------ -------\n";
3124     -
3125     - # $total{ 'total' } can be equal to 0, bad for divisions...
3126     - my $perc1 = 0;
3127     - my $perc2 = 0;
3128     -
3129     -
3130     - if ( $total{'total'} != 0 ) {
3131     - $perc1 = $total{'accept'} * 100 / $total{'total'};
3132     - $perc2 = ( ( $total{'total'} + $morethanonercpt ) / $total{'total'} );
3133     - }
3134     - printf
3135     - "Total %6d %6d %7d %6d %6.2f%%\n\n",
3136     - $total{'total'}, $total{'deny'}, $total{'xfer'}, $total{'accept'},
3137     - $perc1;
3138     - printf
3139     - "%d mails were processed for %d Recipients\nThe average recipients by mail is %4.2f\n\n",
3140     - $total{'total'}, ( $total{'total'} + $morethanonercpt ), $perc2;
3141     -
3142     - if ( $infectedcount > 0 ) {
3143     - show_virus_variants();
3144     - }
3145     -
3146     -
3147     - if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();}
3148     -
3149     - if ($enableSARules) {show_SARules_codes();}
3150     -
3151     - if ($enableGeoiptable and (($total_countries > 0) or $finaldisplay[$BadCountryCateg])){show_Geoip_results();}
3152     -
3153     - if ($enablejunkMailList) {List_Junkmail();}
3154     -
3155     - if ($enableblacklist) {show_blacklist_counts();}
3156     -
3157     - show_user_stats();
3158     -
3159     - print "\nReport generated in $telapsed sec.\n";
3160     -
3161     - if ($savedata) { save_data(); }
3162     - else
3163     - { print "No data saved - if you want to save data to a MySQL database, then please use:\n".
3164     - "config setprop mailstats SaveDataToMySQL yes\n";
3165     - }
3166     -
3167     - select $oldFH;
3168     - close $outputFH;
3169     - if ($makeHTMLemail eq "no" or $makeHTMLemail eq "both") {print $tablestr}
3170     - if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" or $makeHTMLpage eq "yes"){
3171     - #Convert text to html and send it
3172     - require CGI;
3173     - require TextToHTML;
3174     - my $cgi = new CGI;
3175     - my $text = $tablestr;
3176     - my %paramhash = (default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>10,tab_width=>20);
3177     - my $conv = new HTML::TextToHTML();
3178     - $conv->args(default_link_dict=>'',make_tables=>1,preformat_trigger_lines=>2,preformat_whitespace_min=>2,
3179     - underline_length_tolerance=>1);
3180     -
3181     - my $html = $cgi->header();
3182     - $html .="<!DOCTYPE html> <html>\n";
3183     - $html .= "<head><title>Mailstats -".strftime( "%F", localtime($start) )."</title>";
3184     - $html .= "<link rel='stylesheet' type='text/css' href='mailstats.css' /></head>\n";
3185     - $html .= "<body>\n";
3186     - $html .= $conv->process_chunk($text);
3187     - $html .= "</body></html>\n";
3188     - if ($makeHTMLemail eq "yes" or $makeHTMLemail eq "both" ) {print $html}
3189     - #And drop it into a file
3190     - if ($makeHTMLpage eq "yes") {
3191     - my $filename = "mailstats.html";
3192     - open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
3193     - print $fh $html;
3194     - close $fh;
3195     - }
3196     -
3197     - }
3198     -
3199     -
3200     - #Close Sendmail if it was opened
3201     - if ( $opt{'mail'} ) {
3202     - select $oldfh;
3203     - close(SENDMAIL);
3204     - }
3205     -
3206     -} ##report disabled
3207     -
3208     -#All done
3209     -exit 0;
3210     -
3211     -#############################################################################
3212     -# Subroutines ###############################################################
3213     -#############################################################################
3214     -
3215     -
3216     -################################################
3217     -# Determine analysis period (start and end time)
3218     -################################################
3219     -sub analysis_period {
3220     - my $startdate = shift;
3221     - my $enddate = shift;
3222     -
3223     - my $secsininterval = 86400; #daily default
3224     - my $time;
3225     -
3226     - if ($cdb->get('mailstats'))
3227     - {
3228     - my $interval = $cdb->get('mailstats')->prop('Interval') || 'daily'; #"fortnightly"; #"daily";# #; TEMP!!
3229     - if ($interval eq "weekly") {
3230     - $secsininterval = 86400*7;
3231     - } elsif ($interval eq "fortnightly") {
3232     - $secsininterval = 86400*14;
3233     - } elsif ($interval eq "monthly") {
3234     - $secsininterval = 86400*30;
3235     - } elsif ($interval =~m/\d+/) {
3236     - $secsininterval = $interval*3600;
3237     - };
3238     - my $base = $cdb->get('mailstats')->prop('Base') || 'Midnight';
3239     - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
3240     - localtime(time);
3241     - if ($base eq "Midnight"){
3242     - $sec = 0;$min=0;$hour=0;
3243     - } elsif ($base eq "Midday"){
3244     - $sec = 0;$min=0;$hour=12;
3245     - } elsif ($base =~m/\d+/){
3246     - $sec=0;$min=0;$hour=$base;
3247     - };
3248     - #$mday="05"; #$mday="03"; #$mday="16"; #Temp!!
3249     - $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
3250     - }
3251     -
3252     - my $start = str2time( $startdate );
3253     - my $end = $enddate ? str2time( $enddate ) :
3254     - $startdate ? $start + $secsininterval : $time;
3255     - $start = $startdate ? $start : $end - $secsininterval;
3256     - return ( $start > $end ) ? ( $end, $start ) : ( $start, $end );
3257     -}
3258     -
3259     -sub dbg {
3260     - my $msg = shift;
3261     - my $time = scalar localtime;
3262     - $msg = $time.":".$msg."\n";
3263     - if ( $opt{debug} ) {
3264     - print STDERR $msg;
3265     - }
3266     -}
3267     -
3268     -sub List_Junkmail {
3269     -
3270     - #
3271     - # Show how many junkmails in each user's junkmail folder.
3272     - #
3273     - use esmith::AccountsDB;
3274     - my $adb = esmith::AccountsDB->open_ro;
3275     - my $entry;
3276     - foreach my $user ( $adb->users ) {
3277     - my $found = 0;
3278     - my $junkmail_dir =
3279     - "/home/e-smith/files/users/" . $user->key . "/Maildir/.junkmail";
3280     - foreach my $dir (qw(new cur)) {
3281     -
3282     - # Now get the content list for the directory.
3283     - if ( opendir( QDIR, "$junkmail_dir/$dir" ) ) {
3284     - while ( $entry = readdir(QDIR) ) {
3285     - next if $entry =~ /^\./;
3286     - $found++;
3287     - }
3288     - closedir(QDIR);
3289     - }
3290     - }
3291     - if ( $found != 0 ) {
3292     - $junkcount{ $user->key } = $found;
3293     - }
3294     - }
3295     - my $i = keys %junkcount;
3296     - if ( $i > 0 ) {
3297     - print("\nJunk Mails left in folder:\n");
3298     - print("---------------------------\n");
3299     - print("Count\tUser\n");
3300     - print("-------------------------\n");
3301     - foreach my $thisuser (
3302     - sort { $junkcount{$b} <=> $junkcount{$a} }
3303     - keys %junkcount
3304     - )
3305     - {
3306     - printf "%d", $junkcount{$thisuser};
3307     - print "\t" . $thisuser . "\n";
3308     - }
3309     - print("-------------------------\n");
3310     - }
3311     - else {
3312     - print "***No junkmail folders with emails***\n";
3313     - }
3314     -}
3315     -
3316     -sub show_virus_variants
3317     -
3318     -#
3319     -# Show a league table of the different virus types found today
3320     -#
3321     -
3322     -{
3323     - my $line = "------------------------------------------------------------------------\n";
3324     - print("\nVirus Statistics by name:\n");
3325     - print($line);
3326     - foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} }
3327     - keys %found_viruses)
3328     - {
3329     - if (index($virus,"Sanesecurity") !=-1 or index($virus,"UNOFFICIAL") !=-1){
3330     - print "Rejected $found_viruses{$virus}\thttp://sane.mxuptime.com/s.aspx?id=$virus\n";
3331     - } else {
3332     - print "Rejected $found_viruses{$virus}\t$virus\n";
3333     - }
3334     -
3335     - }
3336     - print($line);
3337     -}
3338     -
3339     -sub show_qpsmtpd_codes
3340     -
3341     -#
3342     -# Show a league table of the qpsmtpd result codes found today
3343     -#
3344     -
3345     -{
3346     - my $line = "---------------------------------------------\n";
3347     - print("\nQpsmtpd codes league table:\n");
3348     - print($line);
3349     - print("Count\tPercent\tReason\n");
3350     - print($line);
3351     - foreach my $qpcode (sort { $found_qpcodes{$b} <=> $found_qpcodes{$a} }
3352     - keys %found_qpcodes)
3353     - {
3354     - print "$found_qpcodes{$qpcode}\t".sprintf('%4.1f',$found_qpcodes{$qpcode}*100/$totalexamined)."%\t\t$qpcode\n" if $totalexamined;
3355     - }
3356     - print($line);
3357     -}
3358     -
3359     -sub trim { my $s = shift; $s =~ s/^\s+|\s+$//g; return $s };
3360     -
3361     -sub get_domain
3362     -{ my $url = shift;
3363     - $url =~ s!^\(dnsbl\)\s!!;
3364     - $url =~ s!^.*https?://(?:www\.)?!!i;
3365     - $url =~ s!/.*!!;
3366     - $url =~ s/[\?\#\:].*//;
3367     - $url =~ s/^([\d]{1,3}.){4}//;
3368     - my $domain = trim($url);
3369     - return $domain;
3370     -}
3371     -
3372     -sub show_blacklist_counts
3373     -
3374     -#
3375     -# Show a sorted league table of the blacklist URL counts
3376     -#
3377     -
3378     -{
3379     - my $line = "------------------\n";
3380     - print("\nBlacklist details:\n");
3381     - print($line);
3382     - if ($cdb->get('qpsmtpd')->prop("RHSBL") eq "enabled") {print "RBLLIST:".$cdb->get('qpsmtpd')->prop("RBLList")."\n";}
3383     - if ($cdb->get('qpsmtpd')->prop("URIBL") eq "enabled") {print "UBLLIST:".$cdb->get('qpsmtpd')->prop("UBLList")."\n";}
3384     - if (!$cdb->get('qpsmtpd')->prop("SBLList") eq "") {print "SBLLIST:".$cdb->get('qpsmtpd')->prop("SBLList")."\n";}
3385     - print($line);
3386     - print("Count\tURL\n");
3387     - print($line);
3388     - foreach my $blcode (sort { $blacklistURL{$b} <=> $blacklistURL{$a} }
3389     - keys %blacklistURL)
3390     - {
3391     - print sprintf('%3u',$blacklistURL{$blcode})."\t$blcode\n";
3392     - }
3393     - print($line);
3394     -}
3395     -
3396     -
3397     -sub show_user_stats
3398     -
3399     -#
3400     -# Show a sorted league table of the user counts
3401     -#
3402     -
3403     -{
3404     - #Compute totals for each entry
3405     - my $grandtotals=0;
3406     - my $totalqueued=0;
3407     - my $totalspam=0;
3408     - my $totalrejected=0;
3409     - foreach my $user (keys %usercounts){
3410     - $usercounts{$user}{"queued"} = 0 if !(exists $usercounts{$user}{"queued"});
3411     - $usercounts{$user}{"rejected"} = 0 if !(exists $usercounts{$user}{"rejected"});
3412     - $usercounts{$user}{"spam"} = 0 if !(exists $usercounts{$user}{"spam"});
3413     - $usercounts{$user}{"totals"} = $usercounts{$user}{"queued"}+$usercounts{$user}{"rejected"}+$usercounts{$user}{"spam"};
3414     - $grandtotals += $usercounts{$user}{"totals"};
3415     - $totalspam += $usercounts{$user}{"spam"};
3416     - $totalqueued += $usercounts{$user}{"queued"};
3417     - $totalrejected += $usercounts{$user}{"rejected"};
3418     - }
3419     - my $line = "--------------------------------------------------\n";
3420     - print("\nStatistics by email address received:\n");
3421     - print($line);
3422     - print("Queued\tRejected\tSpam tagged\tEmail Address\n");
3423     - print($line);
3424     - foreach my $user (sort { $usercounts{$b}{"totals"} <=> $usercounts{$a}{"totals"} }
3425     - keys %usercounts)
3426     - {
3427     - print sprintf('%3u',$usercounts{$user}{"queued"})."\t".sprintf('%3u',$usercounts{$user}{"rejected"})."\t\t".sprintf('%3u',$usercounts{$user}{"spam"})."\t\t$user\n";
3428     - }
3429     - print($line);
3430     - print sprintf('%3u',$totalqueued)."\t".sprintf('%3u',$totalrejected)."\t\t".sprintf('%3u',$totalspam)."\n";
3431     - print($line);
3432     -
3433     -
3434     -}
3435     -
3436     -sub show_Geoip_results
3437     -#
3438     -# Show league table of GEoip results
3439     -#
3440     -{
3441     -
3442     - my ($percentthreshold);
3443     - my ($reject);
3444     - my ($percent);
3445     - my ($totalpercent)=0;
3446     - if ($cdb->get('mailstats')){
3447     - $percentthreshold = $cdb->get('mailstats')->prop("GeoipCutoffPercent") || 0.5;
3448     - } else {
3449     - $percentthreshold = 0.5;
3450     - }
3451     - if ($total_countries > 0) {
3452     - my $line = "---------------------------------------------\n";
3453     - print("\nGeoip results: (cutoff at $percentthreshold%) \n");
3454     - print($line);
3455     - print("Country\tPercent\tCount\tRejected?\n");
3456     - print($line);
3457     - foreach my $country (sort { $found_countries{$b} <=> $found_countries{$a} }
3458     - keys %found_countries)
3459     - {
3460     - $percent = $found_countries{$country} * 100 / $total_countries
3461     - if $total_countries;
3462     - $totalpercent = $totalpercent + $percent;
3463     - if (index($BadCountries, $country) != -1) {$reject = "*";} else { $reject = " ";}
3464     - if ( $percent >= $percentthreshold ) {
3465     - print "$country\t\t"
3466     - . sprintf( '%4.1f', $percent )
3467     - . "%\t\t$found_countries{$country}","\t$reject\n"
3468     - if $total_countries;
3469     - }
3470     -
3471     - }
3472     - print($line);
3473     - my ($showtotals);
3474     - if ($cdb->get('mailstats')){
3475     - $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes");
3476     - } else {
3477     - $showtotals = $true;
3478     - }
3479     -
3480     - if ($showtotals){
3481     - print "TOTALS\t\t".sprintf("%4.1f",$totalpercent)."%\t\t$total_countries\n";
3482     - print($line);
3483     - }
3484     - }
3485     -}
3486     -
3487     -sub show_SARules_codes
3488     -
3489     -#
3490     -# Show a league table of the SARules result codes found today
3491     -# suppress any lower than DB mailstats/SARulePercentThreshold
3492     -#
3493     -
3494     -{
3495     - my ($percentthreshold);
3496     - my ($defaultpercentthreshold);
3497     - my ($totalpercent) = 0;
3498     -
3499     - if ($sum_SARules > 0){
3500     -
3501     - if ($totalexamined >0 and $sum_SARules*100/$totalexamined > $SARulethresholdPercent) {
3502     - $defaultpercentthreshold = $maxcutoff
3503     - } else {
3504     - $defaultpercentthreshold = $mincutoff
3505     - }
3506     - if ($cdb->get('mailstats')){
3507     - $percentthreshold = $cdb->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold;
3508     - } else {
3509     - $percentthreshold = $defaultpercentthreshold
3510     - }
3511     - my $line = "---------------------------------------------\n";
3512     - print("\nSpamassassin Rules:(cutoff at ".sprintf('%4.1f',$percentthreshold)."%)\n");
3513     - print($line);
3514     - print("Count\tPercent\tScore\t\t\n");
3515     - print($line);
3516     - foreach my $SARule (sort { $found_SARules{$b}{'count'} <=> $found_SARules{$a}{'count'} }
3517     - keys %found_SARules)
3518     - {
3519     - my $percent = $found_SARules{$SARule}{'count'} * 100 / $totalexamined if $totalexamined;
3520     - my $avehits = $found_SARules{$SARule}{'totalhits'} /
3521     - $found_SARules{$SARule}{'count'}
3522     - if $found_SARules{$SARule}{'count'};
3523     - if ( $percent >= $percentthreshold ) {
3524     - print "$found_SARules{$SARule}{'count'}\t"
3525     - . sprintf( '%4.1f', $percent ) . "%\t"
3526     - . sprintf( '%4.1f', $avehits )
3527     - . "\t$SARule\n"
3528     - if $totalexamined;
3529     - }
3530     - }
3531     - print($line);
3532     - my ($showtotals);
3533     - if ($cdb->get('mailstats')){
3534     - $showtotals = ((($cdb->get('mailstats')->prop("ShowLeagueTotals")|| 'yes')) eq "yes");
3535     - } else {
3536     - $showtotals = $true;
3537     - }
3538     -
3539     - if ($showtotals){
3540     - print "$totalexamined\t(TOTALS)\n";
3541     - print($line);
3542     - }
3543     - print "\n";
3544     - }
3545     -
3546     -
3547     -}
3548     -
3549     -sub mark_domain_rejected
3550     -
3551     -#
3552     -# Tag domain as having a rejected email
3553     -#
3554     -{
3555     -my ($proc) = @_;
3556     -if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
3557     - $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'deny' }++ ;
3558     - $currentrcptdomain{ $proc } = '' ;
3559     - }
3560     -}
3561     -
3562     -sub mark_domain_err
3563     -
3564     - #
3565     - # Tag domain as having an error on email transfer
3566     - #
3567     -{
3568     - my ($proc) = @_;
3569     - if ( ( $currentrcptdomain{$proc} || '' ) ne '' ) {
3570     - $byrcptdomain{ $currentrcptdomain{$proc} }{'xfer'}++;
3571     - $currentrcptdomain{$proc} = '';
3572     - }
3573     -}
3574     -
3575     -sub add_in_domain
3576     -
3577     - #
3578     - # add recipient domain into hash
3579     - #
3580     -{
3581     - my ($proc) = @_;
3582     -
3583     - #split to just domain bit.
3584     - $currentrcptdomain{$proc} =~ s/.*@//;
3585     - $currentrcptdomain{$proc} =~ s/[^\w\-\.]//g;
3586     - $currentrcptdomain{$proc} =~ s/>//g;
3587     - my $NotableDomain = 0;
3588     - if ( defined( $byrcptdomain{ $currentrcptdomain{$proc} }{'type'} ) ) {
3589     - $NotableDomain = 1;
3590     - }
3591     - else {
3592     - foreach (@extdomain) {
3593     - if ( $currentrcptdomain{$proc} =~ m/$_$/ ) {
3594     - $NotableDomain = 1;
3595     - last;
3596     - }
3597     - }
3598     - }
3599     - if ( !$NotableDomain ) {
3600     -
3601     - # check for outgoing email
3602     - if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Outgoing' }
3603     - else { $currentrcptdomain{$proc} = 'Others' }
3604     - }
3605     - else {
3606     - if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Internal' }
3607     - }
3608     - $byrcptdomain{ $currentrcptdomain{$proc} }{'total'}++;
3609     -}
3610     -
3611     -sub save_data
3612     -
3613     - #
3614     - # Save the data to a MySQL database
3615     - #
3616     -{
3617     - use DBI;
3618     - my $tstart = time;
3619     - my $DBname = "mailstats";
3620     - my $host = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBHost') || "localhost";
3621     - my $port = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBPort') || "3306";
3622     - print "Saving data..";
3623     - my $dbh = DBI->connect( "DBI:mysql:database=$DBname;host=$host;port=$port",
3624     - "mailstats", "mailstats" )
3625     - or die "Cannot open mailstats db - has it beeen created?";
3626     -
3627     - my $hour = floor( $start / 3600 );
3628     - my $reportdate = strftime( "%F", localtime( $hour * 3600 ) );
3629     - my $dateid = get_dateid($dbh,$reportdate);
3630     - my $reccount = 0; #count number of records written
3631     - my $servername = esmith::ConfigDB->open_ro->get('SystemName')->value . "."
3632     - . esmith::ConfigDB->open_ro->get('DomainName')->value;
3633     - # now fill in day related stats - must always check for it already there
3634     - # incase the module is run more than once in a day
3635     - my $SAScoresid = check_date_rec($dbh,"SAscores",$dateid,$servername);
3636     - $dbh->do( "UPDATE SAscores SET ".
3637     - "acceptedcount=".$spamcount.
3638     - ",rejectedcount=".$above15.
3639     - ",hamcount=".$hamcount.
3640     - ",acceptedscore=".$spamhits.
3641     - ",rejectedscore=".$rejectspamhits.
3642     - ",hamscore=".$hamhits.
3643     - ",totalsmtp=".$totalexamined.
3644     - ",totalrecip=".$recipcount.
3645     - ",servername='".$servername.
3646     - "' WHERE SAscoresid =".$SAScoresid);
3647     - # Junkmail stats
3648     - # delete if already there
3649     - $dbh->do("DELETE from JunkMailStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
3650     - # and add records
3651     - foreach my $thisuser (keys %junkcount){
3652     - $dbh->do("INSERT INTO JunkMailStats (dateid,user,count,servername) VALUES ('".
3653     - $dateid."','".$thisuser."','".$junkcount{$thisuser}."','".$servername."')");
3654     - $reccount++;
3655     - }
3656     - #SA rules - delete any first
3657     - $dbh->do("DELETE from SARules WHERE dateid = ".$dateid." AND servername='".$servername."'");
3658     - # and add records
3659     - foreach my $thisrule (keys %found_SARules){
3660     - $dbh->do("INSERT INTO SARules (dateid,rule,count,totalhits,servername) VALUES ('".
3661     - $dateid."','".$thisrule."','".$found_SARules{$thisrule}{'count'}."','".
3662     - $found_SARules{$thisrule}{'totalhits'}."','".$servername."')");
3663     - $reccount++;
3664     - }
3665     - #qpsmtpd result codes
3666     - $dbh->do("DELETE from qpsmtpdcodes WHERE dateid = ".$dateid." AND servername='".$servername."'");
3667     - # and add records
3668     - foreach my $thiscode (keys %found_qpcodes){
3669     - $dbh->do("INSERT INTO qpsmtpdcodes (dateid,reason,count,servername) VALUES ('".
3670     - $dateid."','".$thiscode."','".$found_qpcodes{$thiscode}."','".$servername."')");
3671     - $reccount++;
3672     -}
3673     - # virus stats
3674     - $dbh->do("DELETE from VirusStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
3675     - # and add records
3676     - foreach my $thisvirus (keys %found_viruses){
3677     - $dbh->do("INSERT INTO VirusStats (dateid,descr,count,servername) VALUES ('".
3678     - $dateid."','".$thisvirus."','".$found_viruses{$thisvirus}."','".$servername."')");
3679     - $reccount++;
3680     -
3681     - }
3682     - # domain details
3683     - $dbh->do("DELETE from domains WHERE dateid = ".$dateid." AND servername='".$servername."'");
3684     - # and add records
3685     - foreach my $domain (keys %byrcptdomain){
3686     - next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
3687     - $dbh->do("INSERT INTO domains (dateid,domain,type,total,denied,xfererr,accept,servername) VALUES ('".
3688     - $dateid."','".$domain."','".($byrcptdomain{$domain}{'type'}||'other')."','"
3689     - .$byrcptdomain{$domain}{'total'}."','"
3690     - .($byrcptdomain{$domain}{'deny'}||0)."','"
3691     - .($byrcptdomain{$domain}{'xfer'}||0)."','"
3692     - .($byrcptdomain{$domain}{'accept'}||0)."','"
3693     - .$servername
3694     - ."')");
3695     - $reccount++;
3696     -
3697     - }
3698     - # finally - the hourly breakdown
3699     - # need to remember here that the date might change during the 24 hour span
3700     - my $nhour = floor( $start / 3600 );
3701     - my $ncateg;
3702     - while ( $nhour < $end / 3600 ) {
3703     - #see if the time record has been created
3704     - # print strftime("%H",localtime( $nhour * 3600 ) ).":00:00\n";
3705     - my $sth =
3706     - $dbh->prepare( "SELECT timeid FROM time WHERE time = '" . strftime("%H",localtime( $nhour * 3600 ) ).":00:00'");
3707     - $sth->execute();
3708     - if ( $sth->rows == 0 ) {
3709     - #create entry
3710     - $dbh->do( "INSERT INTO time (time) VALUES ('" .strftime("%H",localtime( $nhour * 3600 ) ).":00:00')" );
3711     - # and pick up timeid
3712     - $sth = $dbh->prepare("SELECT last_insert_id() AS timeid FROM time");
3713     - $sth->execute();
3714     - $reccount++;
3715     - }
3716     - my $timerec = $sth->fetchrow_hashref();
3717     - my $timeid = $timerec->{"timeid"};
3718     - $ncateg = 0;
3719     - # and extract date from first column of $count array
3720     - my $currentdate = strftime( "%F", localtime( $hour * 3600 ) );
3721     - # print "$currentdate.\n";
3722     - if ($currentdate ne $reportdate) {
3723     - #same as before?
3724     - $dateid = get_dateid($dbh,$currentdate);
3725     - $reportdate = $currentdate;
3726     - }
3727     - # delete for this date and time
3728     - $dbh->do("DELETE from ColumnStats WHERE dateid = ".$dateid." AND timeid = ".$timeid." AND servername='".$servername."'");
3729     - while ( $ncateg < @categs-1 ) {
3730     - # then add in each entry
3731     - if (($counts{$nhour}{$categs[$ncateg]} || 0) != 0) {
3732     - $dbh->do("INSERT INTO ColumnStats (dateid,timeid,descr,count,servername) VALUES ("
3733     - .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
3734     - .$counts{$nhour}{$categs[$ncateg]}.",'".$servername."')");
3735     - $reccount++;
3736     - }
3737     -
3738     -# print("INSERT INTO ColumnStats (dateid,timeid,descr,count) VALUES ("
3739     -# .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
3740     -# .$counts{$nhour}{$categs[$ncateg]}.")\n");
3741     -
3742     - $ncateg++;
3743     - }
3744     - $nhour++;
3745     - }
3746     - # and write out the log lines saved - only if html wanted
3747     - if ($makeHTMLemail eq 'yes' or $makeHTMLemail eq 'both' or $makeHTMLpage eq 'yes'){
3748     - foreach my $logid (keys %LogLines){
3749     - $reccount++;
3750     - #Extract from keys
3751     - my $extract = $logid;
3752     - $extract =~/^(.*)-(.*):(.*)$/;
3753     - my $Log64n = $1;
3754     - my $LogMailId = $2;
3755     - my $LogSeq = $3;
3756     - my $LogLine = $dbh->quote($LogLines{$logid});
3757     - my $sql = "INSERT INTO LogData (Log64n,MailID,Sequence,LogStr) VALUES ('";
3758     - $sql .= $Log64n."','".$LogMailId."','".$LogSeq."',".$LogLine.")";
3759     - $dbh->do($sql) or die($sql);
3760     - }
3761     - $dbh->disconnect();
3762     - $telapsed = time - $tstart;
3763     - print "Saved $reccount records in $telapsed sec.";
3764     - }
3765     -}
3766     -
3767     -sub check_date_rec
3768     -
3769     - #
3770     - # check that a specific dated rec is there, create if not
3771     - #
3772     -{
3773     - my ( $dbh, $table, $dateid ) = @_;
3774     - my $sth =
3775     - $dbh->prepare(
3776     - "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid'" );
3777     - $sth->execute();
3778     - if ( $sth->rows == 0 ) {
3779     - #create entry
3780     - $dbh->do( "INSERT INTO ".$table." (dateid) VALUES ('" . $dateid . "')" );
3781     - # and pick up recordid
3782     - $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
3783     - $sth->execute();
3784     - }
3785     - my $rec = $sth->fetchrow_hashref();
3786     - $rec->{$table."id"}; #return the id of the reocrd (new or not)
3787     - }
3788     -
3789     - sub check_time_rec
3790     -
3791     - #
3792     - # check that a specific dated amd timed rec is there, create if not
3793     - #
3794     -{
3795     - my ( $dbh, $table, $dateid, $timeid ) = @_;
3796     - my $sth =
3797     - $dbh->prepare(
3798     - "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid' AND timeid = ".$timeid );
3799     - $sth->execute();
3800     - if ( $sth->rows == 0 ) {
3801     - #create entry
3802     - $dbh->do( "INSERT INTO ".$table." (dateid,timeid) VALUES ('" . $dateid . "', '".$timeid."')" );
3803     - # and pick up recordid
3804     - $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
3805     - $sth->execute();
3806     - }
3807     - my $rec = $sth->fetchrow_hashref();
3808     - $rec->{$table."id"}; #return the id of the record (new or not)
3809     - }
3810     -
3811     -sub get_dateid
3812     -
3813     -#
3814     -# Check that date is in db, and return corresponding id
3815     -#
3816     -{
3817     - my ($dbh,$reportdate) = @_;
3818     - my $sth =
3819     - $dbh->prepare( "SELECT dateid FROM date WHERE date = '" . $reportdate."'" );
3820     - $sth->execute();
3821     - if ( $sth->rows == 0 ) {
3822     - #create entry
3823     - $dbh->do( "INSERT INTO date (date) VALUES ('" . $reportdate . "')" );
3824     - # and pick up dateid
3825     - $sth = $dbh->prepare("SELECT last_insert_id() AS dateid FROM date");
3826     - $sth->execute();
3827     - }
3828     - my $daterec = $sth->fetchrow_hashref();
3829     - $daterec->{"dateid"};
3830     - }
3831     -
3832     - sub dump_entries
3833     - {
3834     - my $msg = shift;
3835     - #dbg($msg);
3836     - #dbg("TM0:".$timestamp_items[0]);
3837     - #dbg("TM1:".$timestamp_items[1]);
3838     - #dbg("TM2:".$timestamp_items[2]);
3839     - #dbg("TM3:".$timestamp_items[3]);
3840     - #dbg("LOG0:".$log_items[0]);
3841     - #dbg("LOG1:".$log_items[1]);
3842     - #dbg("LOG2:".$log_items[2]);
3843     - #dbg("LOG3:".$log_items[3]);
3844     - #dbg("LOG4:".$log_items[4]);
3845     - #dbg("LOG5:".$log_items[5]);
3846     - #dbg("LOG6:".$log_items[6]);
3847     - #dbg("LOG7:".$log_items[7]);
3848     - #if ($opt{debug} == 1){exit;}
3849     -}
3850     -
3851     -#sub test_for_private_ip {
3852     - #use NetAddr::IP;
3853     - #my $ip = shift;
3854     - #$ip =~ s/^\D*(([0-9]{1,3}\.){3}[0-9]{1,3}).*/$1/e;
3855     - #print "\nIP:$ip";
3856     - #my $nip = NetAddr::IP->new($ip);
3857     - #if ($nip){
3858     - #if ( $nip->is_rfc1918() ){
3859     - #return 1;
3860     - #} else { return 0}
3861     - #} else { return 0}
3862     -#}
3863     -
3864     -
3865     -sub test_for_private_ip {
3866     - use NetAddr::IP;
3867     - $_ = shift;
3868     - return unless /(\d+\.\d+\.\d+\.\d+)/;
3869     - my $ip = NetAddr::IP->new($1);
3870     - return unless $ip;
3871     - return $ip->is_rfc1918();
3872     -}
3873     -
3874     -

admin@koozali.org
ViewVC Help
Powered by ViewVC 1.2.1 RSS 2.0 feed