/[smecontribs]/rpms/smeserver-mailstats/contribs7/smeserver-mailstats-0.0.3-bjrupdate01.patch
ViewVC logotype

Annotation of /rpms/smeserver-mailstats/contribs7/smeserver-mailstats-0.0.3-bjrupdate01.patch

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


Revision 1.1 - (hide annotations) (download)
Tue Apr 1 08:48:09 2008 UTC (16 years, 8 months ago) by brianread
Branch: MAIN
CVS Tags: smeserver-mailstats-0_0_3-11_el4_sme, smeserver-mailstats-0_0_3-10_el4_sme, smeserver-mailstats-0_0_3-13_el4_sme, smeserver-mailstats-0_0_3-12_el4_sme, smeserver-mailstats-0_0_3-4_el4_sme, smeserver-mailstats-0_0_3-7_el4_sme, smeserver-mailstats-0_0_3-3_el4_sme, smeserver-mailstats-0_0_3-6_el4_sme, smeserver-mailstats-0_0_3-9_el4_sme, smeserver-mailstats-0_0_3-5_el4_sme, smeserver-mailstats-0_0_3-8_el4_sme
merge cb changes with bjr changes

1 brianread 1.1 --- smeserver-mailstats-0.0.3/root/etc/cron.d/mailstats.cron.bjrupdate01 2007-04-11 21:48:30.000000000 +0100
2     +++ smeserver-mailstats-0.0.3/root/etc/cron.d/mailstats.cron 2008-03-25 17:03:39.000000000 +0000
3     @@ -5,5 +5,5 @@
4     #| | | +-----------Month of Year (1-12)
5     #| | | | +-------Day of Week (0=Sun,6=Sat)
6     #v v v v v
7     -0 0 * * * root perl /usr/bin/spamfilter-stats-7.pl /var/log/qpsmtpd/*.s /var/log/qpsmtpd/current
8     +0 0 * * * root perl /usr/bin/spamfilter-stats-7.pl /var/log/qpsmtpd/@* /var/log/qpsmtpd/current
9    
10     --- smeserver-mailstats-0.0.3/root/usr/bin/spamfilter-stats-7.pl.bjrupdate01 2008-02-15 18:25:53.000000000 +0000
11     +++ smeserver-mailstats-0.0.3/root/usr/bin/spamfilter-stats-7.pl 2008-03-09 11:04:01.000000000 +0000
12     @@ -1,1090 +1,1540 @@
13     -#!/usr/bin/perl -w
14     -
15     -#############################################################################
16     -#
17     -# This script provides daily SpamFilter statistics and deletes all users
18     -# junkmails. Configuration of the script is done by the Spam Filter
19     -# Server-Manager module
20     -#
21     -# April 2006 - no longer controlled by server manager, and does not delete files
22     -#
23     -# This script has been developed
24     -# by Jesper Knudsen at http://sme.swerts-knudsen.dk
25     -#
26     -# Revision History:
27     -#
28     -# August 13, 2003: Initial version
29     -# August 25, 2004: fixed problem when hostname had no-ASCII chars
30     -# March 23, 2006 Revised for sme7 RM
31     -# March 27, 2006 ditto BJR (http://www.abandonmicrosoft.co.uk)
32     -# - Merged Clamav and SA stats
33     -# - Moved all analysis to qsmtpd log
34     -# - Removed parameterised interval (for simplicity - not sure of format anyway)
35     -# - add in archived log files for people who have high turnover
36     -# - Alter labels to be more accurate
37     -# - Detect deleted spam (over threshold) without using spam score
38     -# - Detect RBL rejections
39     -# - Detect pattern (executible) rejections
40     -# - Look for the DENY labels - add in Miscellaneous category
41     -# April 6, 2006 - check qpsmtp log level and also DNS enable properties
42     -# - Average spam scores for under and over threshold seperatly
43     -# - Log tag and Reject levels
44     -# - TBD - check that RBL DENY are being detected (I have no date to check this)
45     -# April 7, 2007 - re-written by Charlie Brady totally in Perl
46     -# April 16, 2006 - move warnings to report
47     -# - Spot fetchmail deliveries
48     -# - Spot Internal connections from client PCs
49     -# - TBD check that RBL DENY are being detected (I have no data to check this)
50     -# April 30, 2006 - Pascal Schirrmann Start Time and End Time to noon - should be a param
51     -# so the script can be run at any time in the day.
52     -# - adds 'by recipients domains' stats Useful for MX-Backup or multi domains hosts
53     -# - Add a 'recipients per mail' stat. Useful : until now the sums are correct :-)
54     -# - Correct some messages about rbl who can led to wrong entry in the config database
55     -# ( and without expected results, of course !)
56     -# - improve a regexp in the SPAM detection
57     -# May 1, 2006 - BJR - Fix situation where mxbackup prop is not defined
58     -# - fix a spelling and minor format of domain report
59     -# May 9, 2006 - bjr - Make RBL percentage a percentage of total connections (else it >100%)
60     -# May 9, 2006 - ps - some 'sanity check' in the 'per domains part of the stats (to avoid / 0)
61     -# May 12, 2006 - ps - some cleanup in the 'per domains' stats
62     -# - Add a version number, logged in the mail
63     -# June 20, 2006 - bjr - Minor change to RBL instructions, and adjust domain table format
64     -# Feb 19, 2007 - bjr - Adjust table lines oin a couple of places
65     -# - bjr - and add documentation details about percentages etc
66     -# - bjr - Alter misc to "non conforming" anmd accumulated these hourly
67     -# - bjr - Express change over tag count to exclude spam rejected over threshold
68     -# - bjr - Change "processsed" to "fully downloaded"
69     -# - bjr - Change percentages so that they are all a percetnage of the total emails received
70     -# 0.6.1 - bjr - Change to use output from the logterse qpsmtpd plugin
71     -# 0.6.2 - bjr - Fix fetchmail tests
72     -# 0.6.3 - bjr - adjust for log-items change in order
73     -# 0.6.4&5 - bjr - Adjust table formatting
74     -# 0.6.6 - bjr - Take outgoing emails out of "others", add "Outgoing" and "Internal"
75     -# 0.6.7 - bjr - Fix missing plugins/wrong names. pull invalid recipient out of deny msg for goodrcptto
76     -# 0.6.8 - bjr - catch a few more plugin name failures
77     -# 0.6.9 - bjr - Catch webmail and mailman
78     -# 0.6.10 - bjr - Refine Webmail identification
79     -# 0.6.11 - bjr - Fix Webmail identification
80     -# 0.6.12 - bjr - split logterse line a bit more carefully (multiple sent to addresss with space and comma confuse it)
81     -# 0.6.13 - bjr - add totals and percentages to bottom of the table
82     -# - Generalise counts so that columns can be brought in and out
83     -# - control columns with Db entries
84     -# 0.6.14 - bjr - Add in league tables of qpsmtpd codes and SA rules
85     -# - Add in loglevel check
86     -# - parameterise email address for report
87     -# 0.6.15 - bjr - fix columns included in totals
88     -# - sort out domains when more that one email address in recipient field
89     -# 0.6.16 - cb - fix date range bug (http://bugs.contribs.org/show_bug.cgi?id=3366)
90     -# 0.6.17 - cb - avoid numerous re-openings of config db
91     -# 0.6.18 - cb - tidy up options configuration section
92     -# 0.6.19 - cb - rename parse_args => analysis_period, and simplify
93     -#
94     -# TODO
95     -# ----
96     -#
97     -# Sort junkmail counts largest to smallest
98     -# Html output to ibay (ibay name as command line param or db entry)
99     -# get "XferErr" column working on domains list (or remove column)
100     -# sort out multiple emails recipients, count each one, and log multiple counts
101     -#
102     -#
103     -#
104     -#############################################################################
105     -#
106     -# SMEServer DB usage
107     -# ------------------
108     -#
109     -# mailstats / Status ("enabled"|"disabled")
110     -# / <column header> ("yes"|"no"|"auto") - enable, supress or only show if nonzero
111     -# / QpsmtpdCodes ("enabled"|"disabled")
112     -# / SARules ("enabled"|"disabled")
113     -# / JunkMailList ("enabled"|"disabled")
114     -# / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff
115     -# / Email (admin) - email to send report
116     -#
117     -#
118     -#
119     -#
120     -#############################################################################
121     -
122     -
123     -# internal modules (part of core perl distribution)
124     -use strict;
125     -use warnings;
126     -use Getopt::Long;
127     -use Pod::Usage;
128     -use POSIX qw/strftime floor/;
129     -use Time::Local;
130     -use Date::Manip;
131     -use Time::TAI64;
132     -use esmith::ConfigDB;
133     -use esmith::DomainsDB;
134     -use Sys::Hostname;
135     -use Switch;
136     -
137     -my $hostname = hostname();
138     -my $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n";
139     -
140     -#Configuration section
141     -my %opt = (
142     - version => '0.6.19', # please update at each change.
143     - debug => 0, # guess what ?
144     - sendmail => '/usr/sbin/sendmail', # Path to sendmail stub
145     - from => 'spamfilter-stats', # Who is the mail from
146     - mail => # mailstats email recipient
147     - $cdb->get('mailstats')->prop('Email') || 'admin',
148     - timezone => `date +%z`,
149     -);
150     -
151     -Date_Init("TZ=$opt{'timezone'}");
152     -
153     -my $FetchmailIP = '127.0.0.200'; #Apparent Ip address of fetchmail deliveries
154     -my $WebmailIP = '127.0.0.1'; #Apparent Ip of Webmail sender
155     -my $localhost = 'localhost'; #Apparent sender for webmail
156     -my $FETCHMAIL = 'FETCHMAIL'; #Sender from fetchmail when Ip address not 127.0.0.200 - when qpsmtpd denies the email
157     -my $MAILMAN = "bounces"; #sender when mailman sending when orig is localhost
158     -
159     -my $MinCol = 8; #Minimum column width
160     -my $HourColWidth = 16; #Date and time column width
161     -
162     -my $SARulethresholdPercent = 10; #If Sa rules less than this of total emails, then cutoff reduced
163     -my $maxcutoff = 1; #max percent cutoff applied
164     -my $mincutoff = 0.2; #min percent cutoff applied
165     -
166     -my $true = 1;
167     -my $false = 0;
168     -
169     -my $tstart = time;
170     -
171     -#Local variables
172     -my $YEAR = ( localtime(time) )[5]; # this is years since 1900
173     -
174     -my $total = 0;
175     -my $spamcount = 0;
176     -my $spamavg = 0;
177     -my $hamcount = 0;
178     -my $hamavg = 0;
179     -my $rejectspamavg = 0;
180     -
181     -my $Accepttotal = 0;
182     -my $localAccepttotal = 0; #Fetchmail connections
183     -my $localsendtotal = 0; #Connections from local PCs
184     -my $totalexamined = 0; #total download + RBL etc
185     -my $WebMailsendtotal = 0; #total from Webmail
186     -my $mailmansendcount = 0; #total from mailman
187     -
188     -my %found_viruses = ();
189     -my %found_qpcodes = ();
190     -my %found_SARules = ();
191     -
192     -# replaced by...
193     -my %counts = (); #Hold all counts in 2-D matrix
194     -my @display = (); #used to switch on and off columns - yes, no or auto for each category
195     -my @colwidth = (); #width of each column
196     - #(auto means only if non zero) - populated from possible db entries
197     -my @finaldisplay = (); #final decision on display or not - true or false
198     -my $disabled;
199     -
200     -#count column names, used for headings - also used for DB mailstats property names
201     -my $CATHOUR='Hour';
202     -my $CATFETCHMAIL='Fetchmail';
203     -my $CATWEBMAIL='WebMail';
204     -my $CATMAILMAN='Mailman';
205     -my $CATLOCAL='Local';
206     -# border between where it came from and where it ended..
207     -my $countfromhere = 5;
208     -
209     -my $CATVIRUS='Virus';
210     -my $CATRBLDNS='RBL/DNS';
211     -my $CATEXECUT='Execut.';
212     -my $CATNONCONF='Non.Conf.';
213     -my $CATSPAMDEL='Del.Spam';
214     -my $CATSPAM='Qued.Spam?';
215     -my $CATHAM='Ham';
216     -my $CATTOTALS='TOTALS';
217     -my $CATPERCENT='PERCENT';
218     -my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATNONCONF,$CATSPAMDEL,$CATSPAM,$CATHAM,$CATTOTALS,$CATPERCENT);
219     -my $GRANDTOTAL = '99'; #subs for count arrays, for grand total
220     -my $PERCENT = '98'; # for column percentages
221     -
222     -my $categlen = @categs-2; #-2 to avoid the total and percent column
223     -
224     -my $above15 = 0;
225     -my $RBLcount = 0;
226     -my $MiscDenyCount = 0;
227     -my $PatternFilterCount = 0;
228     -my $noninfectedcount = 0;
229     -my $okemailcount = 0;
230     -my $infectedcount = 0;
231     -my $warnnoreject = " ";
232     -my $rblnotset = ' ';
233     -
234     -my $FS = "\t"; # field separator used by logterse plugin
235     -my %log_items = ();
236     -my $score;
237     -my %timestamp_items = ();
238     -my $localflag = 0; #indicate if current email is local or not
239     -my $WebMailflag = 0; #indicate if current mail is send from webmail
240     -
241     -# some storage for by recipient domains stats (PS)
242     -# my bad : I have to deal with multiple simoultaneous connections
243     -# will play with the process number.
244     -# my $currentrcptdomain = '' ;
245     -my %currentrcptdomain ; # temporay store the recipient domain until end of mail processing
246     -my %byrcptdomain ; # Store 'by domains stats'
247     -my @extdomain ; # only useful in some MX-Backup case, when any subdomains are allowed
248     -my $morethanonercpt = 0 ; # count every 'second' recipients for a mail.
249     -
250     -# store the domain of interest. Every other records are stored in a 'Other' zone
251     -my $ddb = esmith::DomainsDB->open_ro or die "Couldn't open DomainsDB : $!\n";
252     -
253     -foreach my $domain( $ddb->get_all_by_prop( type => "domain" ) ) {
254     - $byrcptdomain{ $domain->key }{ 'type' }='local';
255     -}
256     -$byrcptdomain{ $cdb->get('SystemName')->value . "."
257     - . $cdb->get('DomainName')->value }{ 'type' } = 'local';
258     -
259     -# is this system a MX-Backup ?
260     -if ($cdb->get('mxbackup')){
261     - if ( ( $cdb->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) {
262     - my %MXValues = split( /,/, ( $cdb->get('mxbackup')->prop('name') || '' ) ) ;
263     - foreach my $data ( keys %MXValues ) {
264     - $byrcptdomain{ $data }{ 'type' } = "mxbackup-$MXValues{ $data }" ;
265     - if ( $MXValues{ $data } == 1 ) { # subdomains allowed, must take care of this
266     - push @extdomain, $data ;
267     - }
268     - }
269     - }
270     -}
271     -
272     -my ( $start, $end ) = analysis_period();
273     -
274     -#
275     -# First check current configuration for logging, DNS enable and Max threshold for spamassassin
276     -#
277     -
278     -my $LogLevel = $cdb->get('qpsmtpd')->prop('LogLevel');
279     -my $HighLogLevel = ( $LogLevel > 6 );
280     -
281     -my $RHSenabled =
282     - ( $cdb->get('qpsmtpd')->prop('RHSBL') eq 'enabled' );
283     -my $DNSenabled =
284     - ( $cdb->get('qpsmtpd')->prop('DNSBL') eq 'enabled' );
285     -my $SARejectLevel =
286     - $cdb->get('spamassassin')->prop('RejectLevel');
287     -my $SATagLevel =
288     - $cdb->get('spamassassin')->prop('TagLevel');
289     -my $DomainName =
290     - $cdb->get('DomainName')->value;
291     -
292     -# check that logterse is in use
293     -#my pluginfile = '/var/service/qpsmtpd/config/peers/0';
294     -
295     -#and see if mailstats are disabled
296     -if ($cdb->get('mailstats')){
297     - $disabled = !(($cdb->get('mailstats')->prop('Status') || 'enabled') eq 'enabled');
298     -} else {
299     - my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled' });
300     - $disabled = $false;
301     -}
302     -
303     -
304     -if ( !$RHSenabled || !$DNSenabled ) {
305     - $rblnotset = '*';
306     -}
307     -
308     -if ( $SARejectLevel == 0 ) {
309     -
310     - $warnnoreject = "(*Warning* 0 = no reject)";
311     -
312     -}
313     -
314     -#
315     -#---------------------------------------
316     -# Scan the qpsmtpd log file
317     -#---------------------------------------
318     -
319     -
320     -# Init the hashes
321     -my $nhour = floor( $start / 3600 );
322     -my $ncateg;
323     -while ( $nhour < $end / 3600 ) {
324     - $counts{$nhour}=();
325     - $ncateg = 0;
326     - while ( $ncateg < @categs) {
327     - $counts{$nhour}{$categs[$ncateg-1]} = 0;
328     - $ncateg++
329     - }
330     - $nhour++;
331     -}
332     -# and grand totals and display status from db entries, and column widths
333     -$ncateg = 0;
334     -while ( $ncateg < @categs) {
335     - $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0;
336     - if ($cdb->get('mailstats')){
337     - $display[$ncateg] = lc($cdb->get('mailstats')->prop($categs[$ncateg])) || "auto";
338     - } else {
339     - $display[$ncateg] = 'auto'
340     - }
341     - if ($ncateg == 0) {
342     - $colwidth[$ncateg] = $HourColWidth
343     - } else {
344     - $colwidth[$ncateg] = length($categs[$ncateg])+1
345     - }
346     - if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol}
347     - $ncateg++
348     -}
349     -
350     -my $starttai = Time::TAI64::unixtai64n($start);
351     -my $endtai = Time::TAI64::unixtai64n($end);
352     -my $sum_SARules = 0;
353     -
354     -LINE: while (<>) {
355     - my($tai,$log) = split(' ',$_,2);
356     -
357     -
358     - #If date specified, only process lines matching date
359     - next LINE if ( $tai lt $starttai );
360     - last if ( $tai gt $endtai );
361     -
362     - # pull out spamasassin rule lists
363     - if ($_ =~ m/spamassassin plugin: check_spam:.*tests=(.*)/) {
364     - my ($SAtests) = split(',',$1);
365     - foreach my $SAtest ($SAtests) {
366     - if (!$SAtest eq "") {
367     - $found_SARules{$SAtest}++;
368     - $sum_SARules++
369     - }
370     - }
371     -
372     - }
373     - #only select Logterse output
374     - next LINE unless m/terse plugin/;
375     -
376     -
377     - my $abstime = Time::TAI64::tai2unix($tai);
378     - my $abshour = floor( $abstime / 3600 ); # Hours since the epoch
379     -
380     -
381     - my ($timestamp_part, $log_part) = split('`',$_,2); #bjr 0.6.12
382     - my (@log_items) = split $FS, $log_part;
383     -
384     - my (@timestamp_items) = split(' ',$timestamp_part);
385     -
386     - # we store the more recent recipient domain, for domain statistics
387     - # in fact, we only store the first recipient. Could be sort of headhache
388     - # to obtain precise stats with many recipients on more than one domain !
389     - my $proc = $timestamp_items[1] ; #numeric Id for the email
390     -
391     - $totalexamined++;
392     -
393     - # first spot the fetchmail and local deliveries.
394     -
395     - # print '<'.$log_items[1].'><'.$log_items[5].'><'.$log_items[8].">\n";
396     -
397     - # Spot from local workstation
398     - $localflag = 0;
399     - $WebMailflag=0;
400     - if ($log_items[1] =~ m/.*$DomainName.*/) {$localsendtotal++;$counts{$abshour}{$CATLOCAL}++;$localflag=1}
401     - # see if from localhost
402     - elsif ($log_items[1] =~ m/.*$localhost.*/){
403     - # but not if it comes from fetchmail
404     -# print $log_items[3]."\n";
405     - if ($log_items[3] =~ m/.*$FETCHMAIL.*/){}
406     - else {
407     - # might still be from mailman here
408     -# print "got webmail\n";
409     - if ($log_items[3] =~ m/.*$MAILMAN.*/){$mailmansendcount++;$localsendtotal++;$counts{$abshour}{$CATMAILMAN}++;$localflag=1}
410     - else {
411     - # eliminate incoming localhost spoofs
412     - if ($log_items[8] =~ m/.*msg denied before queued.*/){}
413     - else {$localflag = 1;$WebMailsendtotal++;$counts{$abshour}{$CATWEBMAIL}++;$WebMailflag=1}
414     - }
415     - }
416     - }
417     -
418     - # try to spot fetchmail emails
419     - if ($log_items[0] =~ m/.*$FetchmailIP.*/) {$localAccepttotal++;$counts{$abshour}{$CATFETCHMAIL}++}
420     - elsif ($log_items[3] =~ m/.*$FETCHMAIL.*/) {$localAccepttotal++;$counts{$abshour}{$CATFETCHMAIL}++}
421     -
422     -
423     - # and adjust for recipient field if not set-up by denying plugin - extract from deny msg
424     -
425     - if (length($log_items[4])==0) {
426     - if ($log_items[5] eq 'check_goodrcptto') {
427     - if ($log_items[7] gt "invalid recipient") {
428     - $log_items[4] = substr($log_items[7],18) #Leave only email address
429     - }
430     - }
431     - }
432     -
433     - if ( ( $currentrcptdomain{ $proc } || '' ) eq '' ) {
434     - # reduce to lc and only take first email address in a list
435     - my $recipientmail = lc($log_items[4]);
436     - if ($recipientmail =~ m/.*,/) {
437     - #comma
438     - $recipientmail =~ m/(.*),/;
439     - $currentrcptdomain{ $proc } = $1;
440     - } else {
441     - $currentrcptdomain{ $proc } = lc($log_items[4])
442     - }
443     - #split to just domain bit.
444     - $currentrcptdomain{ $proc } =~ s/.*@//;
445     - $currentrcptdomain{ $proc } =~ s/[^\w\-\.]//g ;
446     - $currentrcptdomain{ $proc } =~ s/>//g ;
447     -
448     -# print $currentrcptdomain{ $proc }."\n";
449     -
450     - my $NotableDomain = 0 ;
451     - if ( defined ( $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'type' } ) ) {
452     - $NotableDomain = 1 ;
453     - } else {
454     - foreach ( @extdomain ) {
455     - if ( $currentrcptdomain{ $proc } =~ m/$_$/ ) {
456     - $NotableDomain = 1 ;
457     - last ;
458     - }
459     - }
460     - }
461     - if ( !$NotableDomain ) {
462     - # check for outgoing email
463     - if ($localflag==1) {$currentrcptdomain{ $proc } = 'Outgoing'}
464     - else {$currentrcptdomain{ $proc } = 'Others'}
465     - } else {
466     - if ($localflag==1) {$currentrcptdomain{ $proc } = 'Internal'}
467     - }
468     - $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'total' }++ ;
469     - } else {
470     - # there more than a recipient for a mail, how many daily ?
471     - $morethanonercpt++;
472     - }
473     -
474     - # then categorise the result
475     -
476     -
477     - if (exists $log_items[5]) {
478     -
479     - $found_qpcodes{$log_items[5]}++; ##Count different qpsmtpd result codes
480     -
481     - #Check for badly formed lines (from earlier testing)
482     -
483     - if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
484     -
485     - if ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
486     -
487     - if ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
488     -
489     - if ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
490     -
491     - if ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
492     -
493     - if ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
494     -
495     - if ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
496     -
497     - if ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
498     -
499     - if ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
500     -
501     - if ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
502     -
503     - if ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
504     -
505     - if ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
506     -
507     - if ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
508     -
509     - if ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}
510     -
511     - if ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}
512     -
513     - if ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
514     -
515     - if ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
516     -
517     - if ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
518     -
519     - if ($log_items[5] eq 'tnef2mime') { next LINE} #Not expecting this one.
520     -
521     - if ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++;
522     - # and extract the spam score
523     - if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)") {$rejectspamavg += $1}
524     - mark_domain_rejected($proc);
525     - next LINE
526     - }
527     -
528     - if ($log_items[5] eq 'virus::clamav') { $infectedcount++;$counts{$abshour}{$CATVIRUS}++;
529     - #extract the virus name
530     - if ($log_items[7] =~ "Virus Found: (.*)" ) {$found_viruses{$1}++;}
531     - mark_domain_rejected($proc);
532     - next LINE
533     - }
534     -
535     - if ($log_items[5] eq 'queued') { $Accepttotal++;
536     - #extract the spam score
537     - if ($log_items[8] =~ ".*hits=(.*) required=([0-9\.]+)") {
538     - $score = $1;
539     -# print $log_items[8]."<".$score.">\n";
540     - if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score}
541     - else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score}
542     - } else {
543     - # no SA score - so it must be ham
544     - $hamcount++;$counts{$abshour}{$CATHAM}++;
545     - }
546     - if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
547     - $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ;
548     - $currentrcptdomain{ $proc } = '' ;
549     - }
550     - next LINE
551     - }
552     -
553     - print $log_items[5]."\n"; #Not detected
554     -
555     - }
556     -
557     -} #END OF MAIN LOOP
558     -
559     -#total up grand total Columns
560     -$nhour = floor( $start / 3600 );
561     -while ( $nhour < $end / 3600 ) {
562     - $ncateg = 0; #past the where it came from columns
563     - while ( $ncateg < @categs) {
564     - #total columns
565     - $counts{$GRANDTOTAL}{$categs[$ncateg]} += $counts{$nhour}{$categs[$ncateg]};
566     -
567     - # and total rows
568     - if ( $ncateg < $categlen && $ncateg>=$countfromhere) {#skip initial columns of non final reasons
569     - $counts{$nhour}{$categs[@categs-2]} += $counts{$nhour}{$categs[$ncateg]};
570     - }
571     - $ncateg++
572     - }
573     -
574     - $nhour++;
575     -}
576     -
577     -
578     -
579     -#Compute row totals and row percentages
580     -$nhour = floor( $start / 3600 );
581     -while ( $nhour < $end / 3600 ) {
582     - $counts{$nhour}{$categs[@categs-1]} = $counts{$nhour}{$categs[@categs-2]}*100/$totalexamined if $totalexamined;
583     - $nhour++;
584     -
585     -}
586     -
587     -#compute column percentages
588     - $ncateg = 0;
589     - while ( $ncateg < @categs) {
590     - if ($ncateg == @categs-1) {
591     - $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg-1]}*100/$totalexamined if $totalexamined;
592     - } else {
593     - $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg]}*100/$totalexamined if $totalexamined;
594     - }
595     - $ncateg++
596     - }
597     -
598     -#compute sum of row percentages
599     -$nhour = floor( $start / 3600 );
600     -while ( $nhour < $end / 3600 ) {
601     - $counts{$GRANDTOTAL}{$categs[@categs-1]} += $counts{$nhour}{$categs[@categs-1]};
602     - $nhour++;
603     -
604     -}
605     -
606     -my $QueryNoLogTerse = ($totalexamined==0); #might indicate logterse not installed in qpsmtpd plugins
607     -
608     -#Calculate some numbers
609     -
610     -$spamavg = $spamavg / $spamcount if $spamcount;
611     -$rejectspamavg = $rejectspamavg / $above15 if $above15;
612     -$hamavg = $hamavg / $hamcount if $hamcount;
613     -
614     -# RBL etc percent of total SMTP sessions
615     -
616     -my $rblpercent = ( ( $RBLcount / $totalexamined ) * 100 ) if $totalexamined;
617     -my $PatternFilterpercent = ( ( $PatternFilterCount / $totalexamined ) * 100 ) if $totalexamined;
618     -my $Miscpercent = ( ( $MiscDenyCount / $totalexamined ) * 100 ) if $totalexamined;
619     -
620     -#Spam and virus percent of total email downloaded
621     -#Expressed as a % of total examined
622     -my $spampercent = ( ( $spamcount / $totalexamined ) * 100 ) if $totalexamined;
623     -my $hampercent = ( ( $hamcount / $totalexamined ) * 100 ) if $totalexamined;
624     -my $hrsinperiod = ( ( $end - $start ) / 3600 );
625     -my $emailperhour = ( $totalexamined / $hrsinperiod ) if $totalexamined;
626     -my $above15percent = ( $above15 / $totalexamined * 100 ) if $totalexamined;
627     -my $infectedpercent = ( ( $infectedcount / ($totalexamined) ) * 100 ) if $totalexamined;
628     -my $AcceptPercent = ( ( $Accepttotal / ($totalexamined) ) * 100 ) if $totalexamined;
629     -
630     -my $oldfh;
631     -
632     -#Open Sendmail if we are mailing it
633     -if ( $opt{'mail'} && !$disabled ) {
634     - open( SENDMAIL, "|$opt{'sendmail'} -oi -t -odq" )
635     - or die "Can't open sendmail: $!\n";
636     - print SENDMAIL "From: $opt{'from'}\n";
637     - print SENDMAIL "To: $opt{'mail'}\n";
638     - print SENDMAIL "Subject: Spam Filter Statistics from $hostname - ",
639     - strftime( "%F", localtime($start) ), "\n\n";
640     - $oldfh = select SENDMAIL;
641     -}
642     -
643     -my $telapsed = time - $tstart;
644     -
645     -if ( !$disabled ) {
646     -
647     - #Output results
648     - print "SMEServer daily Anti-Virus and Spamfilter statistics", "\n";
649     - print "----------------------------------------------------", "\n\n";
650     -
651     - print "$0 Version : $opt{'version'}", "\n\n";
652     - print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n";
653     - print "Period Ending : ", strftime( "%c", localtime($end) ), "\n";
654     - print "\n";
655     -
656     - print "Clam Version : ", `freshclam -V`;
657     - print "SpamAssassin Version : ", `spamassassin -V`;
658     - printf "Tag level: %3d; Reject level: %3d $warnnoreject\n", $SATagLevel,
659     - $SARejectLevel;
660     - if ($HighLogLevel) {
661     - printf "*Loglevel is set to: ".$LogLevel. " - you only need it set to 6\n";
662     - printf "\tYou can set it this way:\n";
663     - printf "\tconfig setprop qpsmtpd LogLevel 6\n";
664     - printf "\tsignal-event email-update\n";
665     - printf "\tsv t /var/service/qpsmtpd\n\n";
666     - }
667     - print "\n";
668     - printf "Reporting Period : %.2f hrs\n", $hrsinperiod;
669     - print "----------------------------\n";
670     - print "\n";
671     -
672     - printf "All SMTP connections accepted:%8d \n", $totalexamined;
673     -#
674     -# if ($localAccepttotal>0) {
675     -# printf "Connections from Fetchmail : %8d \n",
676     -# $localAccepttotal;
677     -# }
678     -#
679     -# if ($WebMailsendtotal>0) {
680     -# printf "Emails sent from WebMail : %8d \n",
681     -# $WebMailsendtotal;
682     -# }
683     -#
684     -# if ($mailmansendcount > 0) {
685     -# printf "Emails sent from Mailman : %8d \n",
686     -# $mailmansendcount;
687     -# }
688     -#
689     -# printf "SMTP from local workstations : %8d \n\n", $localsendtotal;
690     -#
691     -#
692     -# printf "RBL rejected : %8d (%6.2f%%)\n", $RBLcount,
693     -# $rblpercent || 0;
694     -# printf "Pattern filter rejected : %8d (%6.2f%%)\n",
695     -# $PatternFilterCount, $PatternFilterpercent || 0;
696     -# printf "Rejected due to non conformance : %8d (%6.2f%%)\n", $MiscDenyCount,
697     -# $Miscpercent || 0;
698     -#
699     -# printf "Infected by Virus : %8d (%6.2f%%)\n", $infectedcount,
700     -# $infectedpercent || 0;
701     -#
702     -# printf "Spam rejected (over reject level): %8d (%6.2f%%)\n", $above15,
703     -# $above15percent || 0;
704     -# printf "Spam detected (over tag level) : %8d (%6.2f%%)\n", $spamcount,
705     -# $spampercent || 0;
706     -# printf "Ham detected (under tag level) : %8d (%6.2f%%)\n", $hamcount,
707     -# $hampercent || 0;
708     -# print " --------------------\n";
709     -# printf "Total emails accepted : %8d (%6.2f%%)\n", $Accepttotal,
710     -# $AcceptPercent || 0;
711     -
712     -
713     - printf "Emails per hour : %8.1f/hr\n", $emailperhour || 0;
714     - print "\n";
715     - printf "Average spam score (accepted): %11.2f\n", $spamavg || 0;
716     - printf "Average spam score (rejected): %11.2f\n", $rejectspamavg || 0;
717     - printf "Average ham score : %11.2f\n", $hamavg || 0;
718     - print "\n";
719     - print "Statistics by Hour\n";
720     -
721     - #
722     - # start by working out which colunns to show - tag the display array
723     - #
724     - $ncateg = 1; ##skip the first column
725     - $finaldisplay[0] = $true;
726     - while ( $ncateg < $categlen) {
727     - if ($display[$ncateg] eq 'yes') { $finaldisplay[$ncateg] = $true }
728     - elsif ($display[$ncateg] eq 'no') { $finaldisplay[$ncateg] = $false }
729     - else {
730     - $finaldisplay[$ncateg] = ($counts{$GRANDTOTAL}{$categs[$ncateg]} != 0);
731     - if ($finaldisplay[$ncateg]) {
732     - #if it has been non zero and auto, then make it yes for the future.
733     - esmith::ConfigDB->open->get('mailstats')->set_prop($categs[$ncateg],'yes')
734     - }
735     -
736     - }
737     - $ncateg++
738     - }
739     - #make sure total and percentages are shown
740     - $finaldisplay[@categs-2] = $true;
741     - $finaldisplay[@categs-1] = $true;
742     -
743     -
744     - # and put together the print lines
745     - #
746     - my $Line1; #Full Line across the page
747     - my $Line2; #Broken Line across the page
748     - my $Titles; #Column headers
749     - my $Values; #Values
750     - my $Totals; #Corresponding totals
751     - my $Percent; # and column percentages
752     -
753     - my $hour = floor( $start / 3600 );
754     - $Line1 = '';
755     - $Line2 = '';
756     - $Titles = '';
757     - $Values = '';
758     - $Totals = '';
759     - $Percent = '';
760     - while ( $hour < $end / 3600 ) {
761     - if ($hour == floor( $start / 3600 )){
762     - #Do all the once only things
763     - $ncateg = 0;
764     - while ( $ncateg < @categs) {
765     - if ($finaldisplay[$ncateg]){
766     - $Line1 .= substr('---------------------',0,$colwidth[$ncateg]);
767     - $Line2 .= substr('---------------------',0,$colwidth[$ncateg]-1);
768     - $Line2 .= " ";
769     - $Titles .= sprintf('%'.($colwidth[$ncateg]-1).'s',$categs[$ncateg])." ";
770     - if ($ncateg == 0) {
771     - $Totals .= substr('TOTALS ',0,$colwidth[$ncateg]-2);
772     - $Percent .= substr('PERCENTAGES ',0,$colwidth[$ncateg]-1);
773     - } else {
774     - # identify bottom right group and supress unless db->ShowGranPerc set
775     - if ($ncateg==@categs-1){
776     - $Totals .= sprintf('%'.$colwidth[$ncateg].'.1f',$counts{$GRANDTOTAL}{$categs[$ncateg]}).'%';
777     - } else {
778     - $Totals .= sprintf('%'.$colwidth[$ncateg].'d',$counts{$GRANDTOTAL}{$categs[$ncateg]});
779     - }
780     - $Percent .= sprintf('%'.($colwidth[$ncateg]-1).'.1f',$counts{$PERCENT}{$categs[$ncateg]}).'%';
781     - }
782     - }
783     - $ncateg++
784     - }
785     - }
786     -
787     - $ncateg = 0;
788     - while ( $ncateg < @categs) {
789     - if ($finaldisplay[$ncateg]){
790     - if ($ncateg == 0) {
791     - $Values .= strftime( "%F, %H", localtime( $hour * 3600 ) )." "
792     - } elsif ($ncateg == @categs-1) {
793     - #percentages in last column
794     - $Values .= sprintf('%'.($colwidth[$ncateg]-2).'.1f',$counts{$hour}{$categs[$ncateg]})."%";
795     - } else {
796     - #body numbers
797     - $Values .= sprintf('%'.($colwidth[$ncateg]-1).'d',$counts{$hour}{$categs[$ncateg]})." ";
798     - }
799     - if (($ncateg == @categs-1)){$Values=$Values."\n"} #&& ($hour == floor($end / 3600)-1)
800     - }
801     - $ncateg++
802     - }
803     -
804     - $hour++;
805     - }
806     -
807     - # print it.
808     - print $Line1."\n";
809     - print $Titles."\n";
810     - print $Line2."\n";
811     - print $Values."\n";
812     - print $Line2."\n";
813     - print $Totals."\n";
814     - print $Percent."\n";
815     - print $Line1."\n";
816     -
817     -
818     - if ($localAccepttotal>0) {
819     - print "*Fetchml* means connections from Fetchmail delivering email\n";
820     - }
821     - print "*Local* means connections from workstations on local LAN.\n";
822     - print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol.\n";
823     - print " or email was to non existant address.\n";
824     - print "\n";
825     -
826     - if ($QueryNoLogTerse) {
827     - print "* - as no records where found, it looks as though you may not have the *logterse* \nplugin running as part of qpsmtpd \n";
828     -# print " to enable it follow the instructions at .............................\n";
829     - }
830     -
831     -
832     - if ( !$RHSenabled || !$DNSenabled ) {
833     -
834     - # comment about RBL not set
835     - print
836     -"* - This means that one or more of the possible spam black listing services\n that are available have not been enabled.\n";
837     - print " You have not enabled:\n";
838     -
839     - if ( !$RHSenabled ) {
840     - print " RHSBL\n";
841     - }
842     -
843     - if ( !$DNSenabled ) {
844     - print " DNSBL\n";
845     - }
846     -
847     -
848     - print " To enable these you can use the following commands:\n";
849     - if ( !$RHSenabled ) {
850     - print " config setprop qpsmtpd RHSBL enabled\n";
851     - }
852     -
853     - if ( !$DNSenabled ) {
854     - print " config setprop qpsmtpd DNSBL enabled\n";
855     - }
856     -
857     - # there so much templates to expand... (PS)
858     - print " Followed by:\n signal-event email-update and\n sv t /var/service/qpsmtpd\n\n";
859     - }
860     -
861     -# if ($Webmailsendtotal > 0) {print "If you have the mailman contrib installed, then the webmail totals might include some mailman emails\n"}
862     -
863     - # time to do a 'by recipient domain' report
864     - print "\nIncoming mails by recipient domains usage\n";
865     - print "-----------------------------------------\n";
866     - print
867     - "Domains Type Total Denied XferErr Accept \%accept\n";
868     - print
869     - "---------------------------- ---------- ------ ------ ------- ------ -------\n";
870     - my %total = (
871     - total => 0,
872     - deny => 0,
873     - xfer => 0,
874     - accept => 0,
875     - );
876     - foreach my $domain (
877     - sort {
878     - join( "\.", reverse( split /\./, $a ) ) cmp
879     - join( "\.", reverse( split /\./, $b ) )
880     - } keys %byrcptdomain
881     - )
882     - {
883     - next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
884     - my $tp = $byrcptdomain{$domain}{'type'} || 'other';
885     - my $to = $byrcptdomain{$domain}{'total'} || 0;
886     - my $de = $byrcptdomain{$domain}{'deny'} || 0;
887     - my $xr = $byrcptdomain{$domain}{'xfer'} || 0;
888     - my $ac = $byrcptdomain{$domain}{'accept'} || 0;
889     - printf "%-28s %-10s %6d %6d %7d %6d %6.2f%%\n", $domain, $tp, $to,
890     - $de, $xr, $ac, $ac * 100 / $to;
891     - $total{'total'} += $to;
892     - $total{'deny'} += $de;
893     - $total{'xfer'} += $xr;
894     - $total{'accept'} += $ac;
895     - }
896     - print
897     - "---------------------------- ---------- ------ ------- ------ ------ -------\n";
898     -
899     - # $total{ 'total' } can be equal to 0, bad for divisions...
900     - my $perc1 = 0;
901     - my $perc2 = 0;
902     -
903     -
904     - if ( $total{'total'} != 0 ) {
905     - $perc1 = $total{'accept'} * 100 / $total{'total'};
906     - $perc2 = ( ( $total{'total'} + $morethanonercpt ) / $total{'total'} );
907     - }
908     - printf
909     - "Total %6d %6d %7d %6d %6.2f%%\n\n",
910     - $total{'total'}, $total{'deny'}, $total{'xfer'}, $total{'accept'},
911     - $perc1;
912     - printf
913     - "%d mails were processed for %d Recipients\nThe average recipients by mail is %4.2f\n\n",
914     - $total{'total'}, ( $total{'total'} + $morethanonercpt ), $perc2;
915     -
916     - if ( $infectedcount > 0 ) {
917     - show_virus_variants();
918     - }
919     -
920     - # get enable/disable subsections
921     - my $enableqpsmtpdcodes;
922     - my $enableSARules;
923     - my $enablejunkMailList;
924     - if ($cdb->get('mailstats')){
925     - $enableqpsmtpdcodes = $cdb->get('mailstats')->prop("QpsmtpdCodes") || "enabled" eq "enabled" || $true;
926     - $enableSARules = $cdb->get('mailstats')->prop("SARules") || "enabled" eq "enabled" || $true;
927     - $enablejunkMailList = $cdb->get('mailstats')->prop("JunkMailList") || "enabled" eq "enabled" || $true;
928     - } else {
929     - $enableqpsmtpdcodes = $true;
930     - $enableSARules = $true;
931     - $enablejunkMailList = $true;
932     - }
933     -
934     - if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();}
935     -
936     - if ($enableSARules) {show_SARules_codes();}
937     -
938     - if ($enablejunkMailList) {List_Junkmail();}
939     -
940     - print "\nDone. Report generated in $telapsed sec.\n\n";
941     -
942     - #Close Senmdmail if it was opened
943     - if ( $opt{'mail'} ) {
944     - select $oldfh;
945     - close(SENDMAIL);
946     - }
947     -
948     -} ##report disabled
949     -
950     -#All done
951     -exit 0;
952     -
953     -#############################################################################
954     -# Subroutines ###############################################################
955     -#############################################################################
956     -
957     -
958     -################################################
959     -# Determine analysis period (start and end time)
960     -################################################
961     -sub analysis_period {
962     - my $startdate = shift;
963     - my $enddate = shift;
964     -
965     - my $secsinday = 86400;
966     - my $time = 0;
967     -
968     - my $start = UnixDate( $startdate, "%s" );
969     - my $end = $enddate ? UnixDate( $enddate, "%s" ) :
970     - $startdate ? $start + $secsinday : time;
971     - $start = $startdate ? $start : $end - $secsinday;
972     -
973     - return ( $start > $end ) ? ( $end, $start ) : ( $start, $end );
974     -}
975     -
976     -sub dbg {
977     - my $msg = shift;
978     -
979     - if ( $opt{debug} ) {
980     - print STDERR $msg;
981     - }
982     -}
983     -
984     -sub List_Junkmail {
985     -
986     - #
987     - # Show how many junkmails in each user's junkmail folder.
988     - #
989     - use esmith::AccountsDB;
990     - my $adb = esmith::AccountsDB->open_ro;
991     - my $entry;
992     - foreach my $user ($adb->users) {
993     - my $found = 0;
994     - my $junkmail_dir = "/home/e-smith/files/users/" .
995     - $user->key . "/Maildir/.junkmail";
996     -# print $user->key;
997     - foreach my $dir (qw(new cur)) {
998     - # Now get the content list for the directory.
999     - if (opendir( QDIR, "$junkmail_dir/$dir" )) {
1000     - while ($entry=readdir(QDIR) ) {
1001     - next if $entry =~ /^\./;
1002     - $found++;
1003     - }
1004     -
1005     - closedir(QDIR);
1006     - }
1007     - }
1008     - if ( !$disabled ) {
1009     - printf "User \"%s\" ", $user->key;
1010     - printf "- %d email(s) left in junkmail folder\n", $found;
1011     - }
1012     - }
1013     -}
1014     -
1015     -sub show_virus_variants
1016     -
1017     -#
1018     -# Show a league table of the different virus types found today
1019     -#
1020     -
1021     -{
1022     -
1023     - print("Virus Statistics by name:\n");
1024     - print("---------------------------------------------\n");
1025     - foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} }
1026     - keys %found_viruses)
1027     - {
1028     - print "Rejected $found_viruses{$virus}\t$virus\n";
1029     - }
1030     - print("---------------------------------------------\n\n");
1031     -}
1032     -
1033     -sub show_qpsmtpd_codes
1034     -
1035     -#
1036     -# Show a league table of the qpsmtpd result codes found today
1037     -#
1038     -
1039     -{
1040     -
1041     - print("Qpsmtpd codes league table:\n");
1042     - print("---------------------------------------------\n");
1043     - print("Count\tPercent\tReason\t\n");
1044     - print("---------------------------------------------\n");
1045     - foreach my $qpcode (sort { $found_qpcodes{$b} <=> $found_qpcodes{$a} }
1046     - keys %found_qpcodes)
1047     - {
1048     - print "$found_qpcodes{$qpcode}\t".sprintf('%4.1f',$found_qpcodes{$qpcode}*100/$totalexamined)."%\t$qpcode\n" if $totalexamined;
1049     - }
1050     - print("---------------------------------------------\n\n");
1051     -}
1052     -
1053     -sub show_SARules_codes
1054     -
1055     -#
1056     -# Show a league table of the SARules result codes found today
1057     -# suppress any lower than DB mailstats/SARulePercentThreshold
1058     -#
1059     -
1060     -{
1061     -
1062     - my ($percentthreshold);
1063     - my ($defaultpercentthreshold);
1064     -
1065     - if ($totalexamined >0 && $sum_SARules*100/$totalexamined > $SARulethresholdPercent) {
1066     - $defaultpercentthreshold = $maxcutoff
1067     - } else {
1068     - $defaultpercentthreshold = $mincutoff
1069     - }
1070     - if ($cdb->get('mailstats')){
1071     - $percentthreshold = $cdb->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold;
1072     - } else {
1073     - $percentthreshold = $defaultpercentthreshold
1074     - }
1075     - print("Spamassassin Rules:\n");
1076     - print("---------------------------------------------\n");
1077     - print("Count\tPercent\tRule\t\n");
1078     - print("---------------------------------------------\n");
1079     - foreach my $SARule (sort { $found_SARules{$b} <=> $found_SARules{$a} }
1080     - keys %found_SARules)
1081     - {
1082     - my $percent = $found_SARules{$SARule}*100/$totalexamined if $totalexamined;
1083     - if ($percent > $percentthreshold) {
1084     - print "$found_SARules{$SARule}\t".sprintf('%4.1f',$percent)."%\t$SARule\n" if $totalexamined;
1085     - }
1086     - }
1087     - print("---------------------------------------------\n\n");
1088     -}
1089     -
1090     -
1091     -sub mark_domain_rejected
1092     -
1093     -#
1094     -# Tag domain as having a rejected email
1095     -#
1096     -{
1097     -my ($proc) = @_;
1098     -if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
1099     - $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'deny' }++ ;
1100     - $currentrcptdomain{ $proc } = '' ;
1101     - }
1102     -}
1103     +#!/usr/bin/perl -w
1104     +
1105     +#############################################################################
1106     +#
1107     +# This script provides daily SpamFilter statistics and deletes all users
1108     +# junkmails. Configuration of the script is done by the Spam Filter
1109     +# Server-Manager module
1110     +#
1111     +# April 2006 - no longer controlled by server manager, and does not delete files
1112     +#
1113     +# This script has been developed
1114     +# by Jesper Knudsen at http://sme.swerts-knudsen.dk
1115     +#
1116     +# Revision History:
1117     +#
1118     +# August 13, 2003: Initial version
1119     +# August 25, 2004: fixed problem when hostname had no-ASCII chars
1120     +# March 23, 2006 Revised for sme7 RM
1121     +# March 27, 2006 ditto BJR (http://www.abandonmicrosoft.co.uk)
1122     +# - Merged Clamav and SA stats
1123     +# - Moved all analysis to qsmtpd log
1124     +# - Removed parameterised interval (for simplicity - not sure of format anyway)
1125     +# - add in archived log files for people who have high turnover
1126     +# - Alter labels to be more accurate
1127     +# - Detect deleted spam (over threshold) without using spam score
1128     +# - Detect RBL rejections
1129     +# - Detect pattern (executible) rejections
1130     +# - Look for the DENY labels - add in Miscellaneous category
1131     +# April 6, 2006 - check qpsmtp log level and also DNS enable properties
1132     +# - Average spam scores for under and over threshold seperatly
1133     +# - Log tag and Reject levels
1134     +# - TBD - check that RBL DENY are being detected (I have no date to check this)
1135     +# April 7, 2007 - re-written by Charlie Brady totally in Perl
1136     +# April 16, 2006 - move warnings to report
1137     +# - Spot fetchmail deliveries
1138     +# - Spot Internal connections from client PCs
1139     +# - TBD check that RBL DENY are being detected (I have no data to check this)
1140     +# April 30, 2006 - Pascal Schirrmann Start Time and End Time to noon - should be a param
1141     +# so the script can be run at any time in the day.
1142     +# - adds 'by recipients domains' stats Useful for MX-Backup or multi domains hosts
1143     +# - Add a 'recipients per mail' stat. Useful : until now the sums are correct :-)
1144     +# - Correct some messages about rbl who can led to wrong entry in the config database
1145     +# ( and without expected results, of course !)
1146     +# - improve a regexp in the SPAM detection
1147     +# May 1, 2006 - BJR - Fix situation where mxbackup prop is not defined
1148     +# - fix a spelling and minor format of domain report
1149     +# May 9, 2006 - bjr - Make RBL percentage a percentage of total connections (else it >100%)
1150     +# May 9, 2006 - ps - some 'sanity check' in the 'per domains part of the stats (to avoid / 0)
1151     +# May 12, 2006 - ps - some cleanup in the 'per domains' stats
1152     +# - Add a version number, logged in the mail
1153     +# June 20, 2006 - bjr - Minor change to RBL instructions, and adjust domain table format
1154     +# Feb 19, 2007 - bjr - Adjust table lines oin a couple of places
1155     +# - bjr - and add documentation details about percentages etc
1156     +# - bjr - Alter misc to "non conforming" anmd accumulated these hourly
1157     +# - bjr - Express change over tag count to exclude spam rejected over threshold
1158     +# - bjr - Change "processsed" to "fully downloaded"
1159     +# - bjr - Change percentages so that they are all a percetnage of the total emails received
1160     +# 0.6.1 - bjr - Change to use output from the logterse qpsmtpd plugin
1161     +# 0.6.2 - bjr - Fix fetchmail tests
1162     +# 0.6.3 - bjr - adjust for log-items change in order
1163     +# 0.6.4&5 - bjr - Adjust table formatting
1164     +# 0.6.6 - bjr - Take outgoing emails out of "others", add "Outgoing" and "Internal"
1165     +# 0.6.7 - bjr - Fix missing plugins/wrong names. pull invalid recipient out of deny msg for goodrcptto
1166     +# 0.6.8 - bjr - catch a few more plugin name failures
1167     +# 0.6.9 - bjr - Catch webmail and mailman
1168     +# 0.6.10 - bjr - Refine Webmail identification
1169     +# 0.6.11 - bjr - Fix Webmail identification
1170     +# 0.6.12 - bjr - split logterse line a bit more carefully (multiple sent to addresss with space and comma confuse it)
1171     +# 0.6.13 - bjr - add totals and percentages to bottom of the table
1172     +# - Generalise counts so that columns can be brought in and out
1173     +# - control columns with Db entries
1174     +# 0.6.14 - bjr - Add in league tables of qpsmtpd codes and SA rules
1175     +# - Add in loglevel check
1176     +# - parameterise email address for report
1177     +# 0.6.15 - bjr - fix columns included in totals
1178     +# - sort out domains when more that one email address in recipient field
1179     +# 0.6.16 - cb - fix date range bug (http://bugs.contribs.org/show_bug.cgi?id=3366)
1180     +# 0.6.17 - cb - avoid numerous re-openings of config db
1181     +# 0.6.18 - cb - tidy up options configuration section
1182     +# 0.6.19 - cb - rename parse_args => analysis_period, and simplify
1183     +# 0.6.20 - bjr - Retofit bjr fixes since file edited by charlie - Details
1184     +# - Add Average SA Scores to SA league table,
1185     +# - sort junkmail counts, sorted out xfererr for domains
1186     +# - Fixed multiple recipients for single emails
1187     +# - Fix Report suppression code for qpsmtpd codes etc
1188     +# - Added code to save stats to MySQL DB (defaulted to off)
1189     +# - Fixed interval so that it analyzes Midnight to midnight
1190     +# - Allow varied interval for report
1191     +#
1192     +# TODO
1193     +# ----
1194     +#
1195     +# sort out multiple emails recipients, count each one, and log multiple counts
1196     +#
1197     +#
1198     +#
1199     +#############################################################################
1200     +#
1201     +# SMEServer DB usage
1202     +# ------------------
1203     +#
1204     +# mailstats / Status ("enabled"|"disabled")
1205     +# / <column header> ("yes"|"no"|"auto") - enable, supress or only show if nonzero
1206     +# / QpsmtpdCodes ("enabled"|"disabled")
1207     +# / SARules ("enabled"|"disabled")
1208     +# / JunkMailList ("enabled"|"disabled")
1209     +# / SARulePercentThreshold (0.5) - threshold of SArules percentage for report cutoff
1210     +# / Email (admin) - email to send report
1211     +# / SaveDataToMySQL - save data to MySQL database (default is "no")
1212     +# / DBHost - MySQL server hostname (default is "localhost").
1213     +# / DBPort - MySQL server post (default is "3306")
1214     +# / Interval - "day", "week", "fortnight", "month", "99999" - last is number of seconds
1215     +# / Base - "Midnight", "Midday", "Now", "99" hour (0-23)
1216     +#
1217     +#############################################################################
1218     +#
1219     +# Table structure for MySQL table for saving data
1220     +#
1221     +# Database : `mailstats`
1222     +#
1223     +
1224     +# --------------------------------------------------------
1225     +
1226     +#
1227     +# Table structure for table `ColumnStats`
1228     +#
1229     +#
1230     +#CREATE TABLE `ColumnStats` (
1231     +# `ColumnStatsid` int(11) NOT NULL auto_increment,
1232     +# `dateid` int(11) NOT NULL default '0',
1233     +# `timeid` int(11) NOT NULL default '0',
1234     +# `descr` varchar(20) NOT NULL default '',
1235     +# `count` bigint(20) NOT NULL default '0',
1236     +# `servername` varchar(30) NOT NULL default '',
1237     +# PRIMARY KEY (`ColumnStatsid`)
1238     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1239     +
1240     +# --------------------------------------------------------
1241     +
1242     +#
1243     +# Table structure for table `JunkMailStats`
1244     +#
1245     +
1246     +#CREATE TABLE `JunkMailStats` (
1247     +# `JunkMailstatsid` int(11) NOT NULL auto_increment,
1248     +# `dateid` int(11) NOT NULL default '0',
1249     +# `user` varchar(12) NOT NULL default '',
1250     +# `count` bigint(20) NOT NULL default '0',
1251     +# `servername` varchar(30) default NULL,
1252     +# PRIMARY KEY (`JunkMailstatsid`)
1253     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1254     +#
1255     +# --------------------------------------------------------
1256     +
1257     +#
1258     +# Table structure for table `SARules`
1259     +#
1260     +
1261     +#CREATE TABLE `SARules` (
1262     +# `SARulesid` int(11) NOT NULL auto_increment,
1263     +# `dateid` int(11) NOT NULL default '0',
1264     +# `rule` varchar(50) NOT NULL default '',
1265     +# `count` bigint(20) NOT NULL default '0',
1266     +# `totalhits` bigint(20) NOT NULL default '0',
1267     +# `servername` varchar(30) NOT NULL default '',
1268     +# PRIMARY KEY (`SARulesid`)
1269     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1270     +
1271     +# --------------------------------------------------------
1272     +
1273     +#
1274     +# Table structure for table `SAscores`
1275     +#
1276     +
1277     +#CREATE TABLE `SAscores` (
1278     +# `SAscoresid` int(11) NOT NULL auto_increment,
1279     +# `dateid` int(11) NOT NULL default '0',
1280     +# `acceptedcount` bigint(20) NOT NULL default '0',
1281     +# `rejectedcount` bigint(20) NOT NULL default '0',
1282     +# `hamcount` bigint(20) NOT NULL default '0',
1283     +# `acceptedscore` decimal(20,2) NOT NULL default '0.00',
1284     +# `rejectedscore` decimal(20,2) NOT NULL default '0.00',
1285     +# `hamscore` decimal(20,2) NOT NULL default '0.00',
1286     +# `totalsmtp` bigint(20) NOT NULL default '0',
1287     +# `totalrecip` bigint(20) NOT NULL default '0',
1288     +# `servername` varchar(30) NOT NULL default '',
1289     +# PRIMARY KEY (`SAscoresid`)
1290     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1291     +
1292     +# --------------------------------------------------------
1293     +
1294     +#
1295     +# Table structure for table `VirusStats`
1296     +#
1297     +
1298     +#CREATE TABLE `VirusStats` (
1299     +# `VirusStatsid` int(11) NOT NULL auto_increment,
1300     +# `dateid` int(11) NOT NULL default '0',
1301     +# `descr` varchar(40) NOT NULL default '',
1302     +# `count` bigint(20) NOT NULL default '0',
1303     +# `servername` varchar(30) NOT NULL default '',
1304     +# PRIMARY KEY (`VirusStatsid`)
1305     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1306     +#
1307     +# --------------------------------------------------------
1308     +
1309     +#
1310     +# Table structure for table `date`
1311     +#
1312     +
1313     +#CREATE TABLE `date` (
1314     +# `dateid` int(11) NOT NULL auto_increment,
1315     +# `date` date NOT NULL default '0000-00-00',
1316     +# PRIMARY KEY (`dateid`)
1317     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1318     +#
1319     +# --------------------------------------------------------
1320     +
1321     +#
1322     +# Table structure for table `domains`
1323     +#
1324     +
1325     +#CREATE TABLE `domains` (
1326     +# `domainsid` int(11) NOT NULL auto_increment,
1327     +# `dateid` int(11) NOT NULL default '0',
1328     +# `domain` varchar(40) NOT NULL default '',
1329     +# `type` varchar(10) NOT NULL default '',
1330     +# `total` bigint(20) NOT NULL default '0',
1331     +# `denied` bigint(20) NOT NULL default '0',
1332     +# `xfererr` bigint(20) NOT NULL default '0',
1333     +# `accept` bigint(20) NOT NULL default '0',
1334     +# `servername` varchar(30) NOT NULL default '',
1335     +# PRIMARY KEY (`domainsid`)
1336     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1337     +
1338     +# --------------------------------------------------------
1339     +
1340     +#
1341     +# Table structure for table `qpsmtpdcodes`
1342     +#
1343     +
1344     +#CREATE TABLE `qpsmtpdcodes` (
1345     +# `qpsmtpdcodesid` int(11) NOT NULL auto_increment,
1346     +# `dateid` int(11) NOT NULL default '0',
1347     +# `reason` varchar(40) NOT NULL default '',
1348     +# `count` bigint(20) NOT NULL default '0',
1349     +# `servername` varchar(30) NOT NULL default '',
1350     +# PRIMARY KEY (`qpsmtpdcodesid`)
1351     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1352     +
1353     +# --------------------------------------------------------
1354     +
1355     +#
1356     +# Table structure for table `time`
1357     +#
1358     +
1359     +#CREATE TABLE `time` (
1360     +# `timeid` int(11) NOT NULL auto_increment,
1361     +# `time` time NOT NULL default '00:00:00',
1362     +# PRIMARY KEY (`timeid`)
1363     +#) ENGINE=MyISAM DEFAULT CHARSET=latin1;
1364     +#
1365     +#############################################################################
1366     +
1367     +# internal modules (part of core perl distribution)
1368     +use strict;
1369     +use warnings;
1370     +use Getopt::Long;
1371     +use Pod::Usage;
1372     +use POSIX qw/strftime floor/;
1373     +use Time::Local;
1374     +use Date::Manip;
1375     +use Time::TAI64;
1376     +use esmith::ConfigDB;
1377     +use esmith::DomainsDB;
1378     +use Sys::Hostname;
1379     +use Switch;
1380     +
1381     +my $hostname = hostname();
1382     +my $cdb = esmith::ConfigDB->open_ro or die "Couldn't open ConfigDB : $!\n";
1383     +
1384     +#Configuration section
1385     +my %opt = (
1386     + version => '0.6.20', # please update at each change.
1387     + debug => 0, # guess what ?
1388     + sendmail => '/usr/sbin/sendmail', # Path to sendmail stub
1389     + from => 'spamfilter-stats', # Who is the mail from
1390     + mail => # mailstats email recipient
1391     + $cdb->get('mailstats')->prop('Email') || 'admin',
1392     + timezone => `date +%z`,
1393     +);
1394     +
1395     +Date_Init("TZ=$opt{'timezone'}");
1396     +
1397     +my $FetchmailIP = '127.0.0.200'; #Apparent Ip address of fetchmail deliveries
1398     +my $WebmailIP = '127.0.0.1'; #Apparent Ip of Webmail sender
1399     +my $localhost = 'localhost'; #Apparent sender for webmail
1400     +my $FETCHMAIL = 'FETCHMAIL'; #Sender from fetchmail when Ip address not 127.0.0.200 - when qpsmtpd denies the email
1401     +my $MAILMAN = "bounces"; #sender when mailman sending when orig is localhost
1402     +
1403     +my $MinCol = 8; #Minimum column width
1404     +my $HourColWidth = 16; #Date and time column width
1405     +
1406     +my $SARulethresholdPercent = 10; #If Sa rules less than this of total emails, then cutoff reduced
1407     +my $maxcutoff = 1; #max percent cutoff applied
1408     +my $mincutoff = 0.2; #min percent cutoff applied
1409     +
1410     +my $true = 1;
1411     +my $false = 0;
1412     +
1413     +my $tstart = time;
1414     +
1415     +#Local variables
1416     +my $YEAR = ( localtime(time) )[5]; # this is years since 1900
1417     +
1418     +my $total = 0;
1419     +my $spamcount = 0;
1420     +my $spamavg = 0;
1421     +my $spamhits = 0;
1422     +my $hamcount = 0;
1423     +my $hamavg = 0;
1424     +my $hamhits = 0;
1425     +my $rejectspamavg = 0;
1426     +my $rejectspamhits= 0;
1427     +
1428     +my $Accepttotal = 0;
1429     +my $localAccepttotal = 0; #Fetchmail connections
1430     +my $localsendtotal = 0; #Connections from local PCs
1431     +my $totalexamined = 0; #total download + RBL etc
1432     +my $WebMailsendtotal = 0; #total from Webmail
1433     +my $mailmansendcount = 0; #total from mailman
1434     +
1435     +my %found_viruses = ();
1436     +my %found_qpcodes = ();
1437     +my %found_SARules = ();
1438     +my %junkcount = ();
1439     +
1440     +# replaced by...
1441     +my %counts = (); #Hold all counts in 2-D matrix
1442     +my @display = (); #used to switch on and off columns - yes, no or auto for each category
1443     +my @colwidth = (); #width of each column
1444     + #(auto means only if non zero) - populated from possible db entries
1445     +my @finaldisplay = (); #final decision on display or not - true or false
1446     +my $disabled;
1447     +
1448     +#count column names, used for headings - also used for DB mailstats property names
1449     +my $CATHOUR='Hour';
1450     +my $CATFETCHMAIL='Fetchmail';
1451     +my $CATWEBMAIL='WebMail';
1452     +my $CATMAILMAN='Mailman';
1453     +my $CATLOCAL='Local';
1454     +# border between where it came from and where it ended..
1455     +my $countfromhere = 5;
1456     +
1457     +my $CATVIRUS='Virus';
1458     +my $CATRBLDNS='RBL/DNS';
1459     +my $CATEXECUT='Execut.';
1460     +my $CATNONCONF='Non.Conf.';
1461     +my $CATSPAMDEL='Del.Spam';
1462     +my $CATSPAM='Qued.Spam?';
1463     +my $CATHAM='Ham';
1464     +my $CATTOTALS='TOTALS';
1465     +my $CATPERCENT='PERCENT';
1466     +my @categs = ($CATHOUR,$CATFETCHMAIL,$CATWEBMAIL,$CATMAILMAN,$CATLOCAL,$CATVIRUS,$CATRBLDNS,$CATEXECUT,$CATNONCONF,$CATSPAMDEL,$CATSPAM,$CATHAM,$CATTOTALS,$CATPERCENT);
1467     +my $GRANDTOTAL = '99'; #subs for count arrays, for grand total
1468     +my $PERCENT = '98'; # for column percentages
1469     +
1470     +my $categlen = @categs-2; #-2 to avoid the total and percent column
1471     +
1472     +my $above15 = 0;
1473     +my $RBLcount = 0;
1474     +my $MiscDenyCount = 0;
1475     +my $PatternFilterCount = 0;
1476     +my $noninfectedcount = 0;
1477     +my $okemailcount = 0;
1478     +my $infectedcount = 0;
1479     +my $warnnoreject = " ";
1480     +my $rblnotset = ' ';
1481     +
1482     +my $FS = "\t"; # field separator used by logterse plugin
1483     +my %log_items = ( "", "", "", "", "", "", "", "" );
1484     +my $score;
1485     +my %timestamp_items = ();
1486     +my $localflag = 0; #indicate if current email is local or not
1487     +my $WebMailflag = 0; #indicate if current mail is send from webmail
1488     +
1489     +# some storage for by recipient domains stats (PS)
1490     +# my bad : I have to deal with multiple simoultaneous connections
1491     +# will play with the process number.
1492     +# my $currentrcptdomain = '' ;
1493     +my %currentrcptdomain ; # temporay store the recipient domain until end of mail processing
1494     +my %byrcptdomain ; # Store 'by domains stats'
1495     +my @extdomain ; # only useful in some MX-Backup case, when any subdomains are allowed
1496     +my $morethanonercpt = 0 ; # count every 'second' recipients for a mail.
1497     +my $recipcount = 0; # count every recipient email address received.
1498     +
1499     +
1500     +# store the domain of interest. Every other records are stored in a 'Other' zone
1501     +my $ddb = esmith::DomainsDB->open_ro or die "Couldn't open DomainsDB : $!\n";
1502     +
1503     +foreach my $domain( $ddb->get_all_by_prop( type => "domain" ) ) {
1504     + $byrcptdomain{ $domain->key }{ 'type' }='local';
1505     +}
1506     +$byrcptdomain{ $cdb->get('SystemName')->value . "."
1507     + . $cdb->get('DomainName')->value }{ 'type' } = 'local';
1508     +
1509     +# is this system a MX-Backup ?
1510     +if ($cdb->get('mxbackup')){
1511     + if ( ( $cdb->get('mxbackup')->prop('status') || 'disabled' ) eq 'enabled' ) {
1512     + my %MXValues = split( /,/, ( $cdb->get('mxbackup')->prop('name') || '' ) ) ;
1513     + foreach my $data ( keys %MXValues ) {
1514     + $byrcptdomain{ $data }{ 'type' } = "mxbackup-$MXValues{ $data }" ;
1515     + if ( $MXValues{ $data } == 1 ) { # subdomains allowed, must take care of this
1516     + push @extdomain, $data ;
1517     + }
1518     + }
1519     + }
1520     +}
1521     +
1522     +my ( $start, $end ) = analysis_period();
1523     +
1524     +#
1525     +# First check current configuration for logging, DNS enable and Max threshold for spamassassin
1526     +#
1527     +
1528     +my $LogLevel = $cdb->get('qpsmtpd')->prop('LogLevel');
1529     +my $HighLogLevel = ( $LogLevel > 6 );
1530     +
1531     +my $RHSenabled =
1532     + ( $cdb->get('qpsmtpd')->prop('RHSBL') eq 'enabled' );
1533     +my $DNSenabled =
1534     + ( $cdb->get('qpsmtpd')->prop('DNSBL') eq 'enabled' );
1535     +my $SARejectLevel =
1536     + $cdb->get('spamassassin')->prop('RejectLevel');
1537     +my $SATagLevel =
1538     + $cdb->get('spamassassin')->prop('TagLevel');
1539     +my $DomainName =
1540     + $cdb->get('DomainName')->value;
1541     +
1542     +# check that logterse is in use
1543     +#my pluginfile = '/var/service/qpsmtpd/config/peers/0';
1544     +
1545     +#and see if mailstats are disabled
1546     +if ($cdb->get('mailstats')){
1547     + $disabled = !(($cdb->get('mailstats')->prop('Status') || 'enabled') eq 'enabled');
1548     +} else {
1549     + my $db = esmith::ConfigDB->open; my $record = $db->new_record('mailstats', { type => 'report', Status => 'enabled' });
1550     + $disabled = $false;
1551     +}
1552     +
1553     +
1554     +if ( !$RHSenabled || !$DNSenabled ) {
1555     + $rblnotset = '*';
1556     +}
1557     +
1558     +if ( $SARejectLevel == 0 ) {
1559     +
1560     + $warnnoreject = "(*Warning* 0 = no reject)";
1561     +
1562     +}
1563     +
1564     +#
1565     +#---------------------------------------
1566     +# Scan the qpsmtpd log file
1567     +#---------------------------------------
1568     +
1569     +
1570     +# Init the hashes
1571     +my $nhour = floor( $start / 3600 );
1572     +my $ncateg;
1573     +while ( $nhour < $end / 3600 ) {
1574     + $counts{$nhour}=();
1575     + $ncateg = 0;
1576     + while ( $ncateg < @categs) {
1577     + $counts{$nhour}{$categs[$ncateg-1]} = 0;
1578     + $ncateg++
1579     + }
1580     + $nhour++;
1581     +}
1582     +# and grand totals and display status from db entries, and column widths
1583     +$ncateg = 0;
1584     +while ( $ncateg < @categs) {
1585     + $counts{$GRANDTOTAL}{$categs[$ncateg]} = 0;
1586     + if ($cdb->get('mailstats')){
1587     + $display[$ncateg] = lc($cdb->get('mailstats')->prop($categs[$ncateg])) || "auto";
1588     + } else {
1589     + $display[$ncateg] = 'auto'
1590     + }
1591     + if ($ncateg == 0) {
1592     + $colwidth[$ncateg] = $HourColWidth
1593     + } else {
1594     + $colwidth[$ncateg] = length($categs[$ncateg])+1
1595     + }
1596     + if ($colwidth[$ncateg] < $MinCol) {$colwidth[$ncateg] = $MinCol}
1597     + $ncateg++
1598     +}
1599     +
1600     +my $starttai = Time::TAI64::unixtai64n($start);
1601     +my $endtai = Time::TAI64::unixtai64n($end);
1602     +my $sum_SARules = 0;
1603     +
1604     +LINE: while (<>) {
1605     + my($tai,$log) = split(' ',$_,2);
1606     +
1607     +
1608     + #If date specified, only process lines matching date
1609     + next LINE if ( $tai lt $starttai );
1610     + last if ( $tai gt $endtai );
1611     +
1612     + # pull out spamasassin rule lists
1613     + if ( $_ =~m/spamassassin plugin: check_spam:.*hits=(.*), required.*tests=(.*)/ )
1614     + {
1615     + my ($SAtests) = split(',',$2);
1616     + foreach my $SAtest ($SAtests) {
1617     + if (!$SAtest eq "") {
1618     + $found_SARules{$SAtest}{'count'}++;
1619     + $found_SARules{$SAtest}{'totalhits'} += $1;
1620     + $sum_SARules++
1621     + }
1622     + }
1623     +
1624     + }
1625     + #only select Logterse output
1626     + next LINE unless m/terse plugin/;
1627     +
1628     +
1629     + my $abstime = Time::TAI64::tai2unix($tai);
1630     + my $abshour = floor( $abstime / 3600 ); # Hours since the epoch
1631     +
1632     +
1633     + my ($timestamp_part, $log_part) = split('`',$_,2); #bjr 0.6.12
1634     + my (@log_items) = split $FS, $log_part;
1635     +
1636     + my (@timestamp_items) = split(' ',$timestamp_part);
1637     +
1638     + # we store the more recent recipient domain, for domain statistics
1639     + # in fact, we only store the first recipient. Could be sort of headhache
1640     + # to obtain precise stats with many recipients on more than one domain !
1641     + my $proc = $timestamp_items[1] ; #numeric Id for the email
1642     +
1643     + $totalexamined++;
1644     +
1645     + # first spot the fetchmail and local deliveries.
1646     +
1647     + # Spot from local workstation
1648     + $localflag = 0;
1649     + $WebMailflag = 0;
1650     + if ( $log_items[1] =~ m/.*$DomainName.*/ ) {
1651     + $localsendtotal++;
1652     + $counts{$abshour}{$CATLOCAL}++;
1653     + $localflag = 1;
1654     + }
1655     +
1656     + # see if from localhost
1657     + elsif ( $log_items[1] =~ m/.*$localhost.*/ ) {
1658     +
1659     + # but not if it comes from fetchmail
1660     + if ( $log_items[3] =~ m/.*$FETCHMAIL.*/ ) { }
1661     + else {
1662     +
1663     + # might still be from mailman here
1664     + if ( $log_items[3] =~ m/.*$MAILMAN.*/ ) {
1665     + $mailmansendcount++;
1666     + $localsendtotal++;
1667     + $counts{$abshour}{$CATMAILMAN}++;
1668     + $localflag = 1;
1669     + }
1670     + else {
1671     +
1672     + # eliminate incoming localhost spoofs
1673     + if ( $log_items[8] =~ m/.*msg denied before queued.*/ ) { }
1674     + else {
1675     + $localflag = 1;
1676     + $WebMailsendtotal++;
1677     + $counts{$abshour}{$CATWEBMAIL}++;
1678     + $WebMailflag = 1;
1679     + }
1680     + }
1681     + }
1682     + }
1683     +
1684     + # try to spot fetchmail emails
1685     + if ( $log_items[0] =~ m/.*$FetchmailIP.*/ ) {
1686     + $localAccepttotal++;
1687     + $counts{$abshour}{$CATFETCHMAIL}++;
1688     + }
1689     + elsif ( $log_items[3] =~ m/.*$FETCHMAIL.*/ ) {
1690     + $localAccepttotal++;
1691     + $counts{$abshour}{$CATFETCHMAIL}++;
1692     + }
1693     +
1694     +# and adjust for recipient field if not set-up by denying plugin - extract from deny msg
1695     +
1696     + if ( length( $log_items[4] ) == 0 ) {
1697     + if ( $log_items[5] eq 'check_goodrcptto' ) {
1698     + if ( $log_items[7] gt "invalid recipient" ) {
1699     + $log_items[4] =
1700     + substr( $log_items[7], 18 ) #Leave only email address
1701     + }
1702     + }
1703     + }
1704     +
1705     + # if ( ( $currentrcptdomain{ $proc } || '' ) eq '' ) {
1706     + # reduce to lc and process each e,mail if a list, pseperatedy commas
1707     + my $recipientmail = lc( $log_items[4] );
1708     + if ( $recipientmail =~ m/.*,/ ) {
1709     +
1710     + #comma - split the line and deal with each domain
1711     + # print $recipientmail."\n";
1712     + my ($recipients) = split( ',', $recipientmail );
1713     + foreach my $recip ($recipients) {
1714     + $proc = $proc . $recip;
1715     +
1716     + # print $proc."\n";
1717     + $currentrcptdomain{$proc} = $recip;
1718     + add_in_domain($proc);
1719     + $recipcount++;
1720     + }
1721     +
1722     + # print "*\n";
1723     + #count emails with more than one recipient
1724     + # $recipientmail =~ m/(.*),/;
1725     + # $currentrcptdomain{ $proc } = $1;
1726     + }
1727     + else {
1728     + $proc = $proc . $recipientmail;
1729     + $currentrcptdomain{$proc} = $recipientmail;
1730     + add_in_domain($proc);
1731     + $recipcount++;
1732     + }
1733     +
1734     + # } else {
1735     + # # there more than a recipient for a mail, how many daily ?
1736     + # $morethanonercpt++;
1737     + # }
1738     +
1739     +
1740     + # then categorise the result
1741     +
1742     +
1743     + if (exists $log_items[5]) {
1744     +
1745     + $found_qpcodes{$log_items[5]}++; ##Count different qpsmtpd result codes
1746     +
1747     + #Check for badly formed lines (from earlier testing)
1748     +
1749     + if ($log_items[5] eq 'check_earlytalker') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1750     +
1751     + if ($log_items[5] eq 'check_relay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1752     +
1753     + if ($log_items[5] eq 'check_norelay') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1754     +
1755     + if ($log_items[5] eq 'require_resolvable_fromhost') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1756     +
1757     + if ($log_items[5] eq 'check_basicheaders') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1758     +
1759     + if ($log_items[5] eq 'rhsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
1760     +
1761     + if ($log_items[5] eq 'dnsbl') { $RBLcount++;$counts{$abshour}{$CATRBLDNS}++;mark_domain_rejected($proc);next LINE}
1762     +
1763     + if ($log_items[5] eq 'check_badmailfrom') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1764     +
1765     + if ($log_items[5] eq 'check_badrcptto_patterns') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1766     +
1767     + if ($log_items[5] eq 'check_badrcptto') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1768     +
1769     + if ($log_items[5] eq 'check_spamhelo') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1770     +
1771     + if ($log_items[5] eq 'check_goodrcptto extn') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1772     +
1773     + if ($log_items[5] eq 'rcpt_ok') { $MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1774     +
1775     + if ($log_items[5] eq 'pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}
1776     +
1777     + if ($log_items[5] eq 'virus::pattern_filter') { $PatternFilterCount++;$counts{$abshour}{$CATEXECUT}++;mark_domain_rejected($proc);next LINE}
1778     +
1779     + if ($log_items[5] eq 'check_goodrcptto') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1780     +
1781     + if ($log_items[5] eq 'check_smtp_forward') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1782     +
1783     + if ($log_items[5] eq 'count_unrecognized_commands') {$MiscDenyCount++;$counts{$abshour}{$CATNONCONF}++;mark_domain_rejected($proc);next LINE}
1784     +
1785     + if ($log_items[5] eq 'tnef2mime') { next LINE} #Not expecting this one.
1786     +
1787     + if ($log_items[5] eq 'spamassassin') { $above15++;$counts{$abshour}{$CATSPAMDEL}++;
1788     + # and extract the spam score
1789     + if ($log_items[8] =~ "Yes, hits=(.*) required=([0-9\.]+)") {$rejectspamavg += $1}
1790     + mark_domain_rejected($proc);
1791     + next LINE
1792     + }
1793     +
1794     + if ($log_items[5] eq 'virus::clamav') { $infectedcount++;$counts{$abshour}{$CATVIRUS}++;
1795     + #extract the virus name
1796     + if ($log_items[7] =~ "Virus Found: (.*)" ) {$found_viruses{$1}++;}
1797     + mark_domain_rejected($proc);
1798     + next LINE
1799     + }
1800     +
1801     + if ($log_items[5] eq 'queued') { $Accepttotal++;
1802     + #extract the spam score
1803     + if ($log_items[8] =~ ".*hits=(.*) required=([0-9\.]+)") {
1804     + $score = $1;
1805     +# print $log_items[8]."<".$score.">\n";
1806     + if ($score < $SATagLevel) { $hamcount++;$counts{$abshour}{$CATHAM}++;$hamavg += $score}
1807     + else {$spamcount++;$counts{$abshour}{$CATSPAM}++;$spamavg += $score}
1808     + } else {
1809     + # no SA score - so it must be ham
1810     + $hamcount++;$counts{$abshour}{$CATHAM}++;
1811     + }
1812     + if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
1813     + $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'accept' }++ ;
1814     + $currentrcptdomain{ $proc } = '' ;
1815     + }
1816     + next LINE
1817     + }
1818     +
1819     + print $log_items[5]."\n"; #Not detected
1820     +
1821     + }
1822     +
1823     +} #END OF MAIN LOOP
1824     +
1825     +#total up grand total Columns
1826     +$nhour = floor( $start / 3600 );
1827     +while ( $nhour < $end / 3600 ) {
1828     + $ncateg = 0; #past the where it came from columns
1829     + while ( $ncateg < @categs) {
1830     + #total columns
1831     + $counts{$GRANDTOTAL}{$categs[$ncateg]} += $counts{$nhour}{$categs[$ncateg]};
1832     +
1833     + # and total rows
1834     + if ( $ncateg < $categlen && $ncateg>=$countfromhere) {#skip initial columns of non final reasons
1835     + $counts{$nhour}{$categs[@categs-2]} += $counts{$nhour}{$categs[$ncateg]};
1836     + }
1837     + $ncateg++
1838     + }
1839     +
1840     + $nhour++;
1841     +}
1842     +
1843     +
1844     +
1845     +#Compute row totals and row percentages
1846     +$nhour = floor( $start / 3600 );
1847     +while ( $nhour < $end / 3600 ) {
1848     + $counts{$nhour}{$categs[@categs-1]} = $counts{$nhour}{$categs[@categs-2]}*100/$totalexamined if $totalexamined;
1849     + $nhour++;
1850     +
1851     +}
1852     +
1853     +#compute column percentages
1854     + $ncateg = 0;
1855     + while ( $ncateg < @categs) {
1856     + if ($ncateg == @categs-1) {
1857     + $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg-1]}*100/$totalexamined if $totalexamined;
1858     + } else {
1859     + $counts{$PERCENT}{$categs[$ncateg]} = $counts{$GRANDTOTAL}{$categs[$ncateg]}*100/$totalexamined if $totalexamined;
1860     + }
1861     + $ncateg++
1862     + }
1863     +
1864     +#compute sum of row percentages
1865     +$nhour = floor( $start / 3600 );
1866     +while ( $nhour < $end / 3600 ) {
1867     + $counts{$GRANDTOTAL}{$categs[@categs-1]} += $counts{$nhour}{$categs[@categs-1]};
1868     + $nhour++;
1869     +
1870     +}
1871     +
1872     +my $QueryNoLogTerse = ($totalexamined==0); #might indicate logterse not installed in qpsmtpd plugins
1873     +
1874     +#Calculate some numbers
1875     +
1876     +$spamavg = $spamavg / $spamcount if $spamcount;
1877     +$rejectspamavg = $rejectspamavg / $above15 if $above15;
1878     +$hamavg = $hamavg / $hamcount if $hamcount;
1879     +
1880     +# RBL etc percent of total SMTP sessions
1881     +
1882     +my $rblpercent = ( ( $RBLcount / $totalexamined ) * 100 ) if $totalexamined;
1883     +my $PatternFilterpercent = ( ( $PatternFilterCount / $totalexamined ) * 100 ) if $totalexamined;
1884     +my $Miscpercent = ( ( $MiscDenyCount / $totalexamined ) * 100 ) if $totalexamined;
1885     +
1886     +#Spam and virus percent of total email downloaded
1887     +#Expressed as a % of total examined
1888     +my $spampercent = ( ( $spamcount / $totalexamined ) * 100 ) if $totalexamined;
1889     +my $hampercent = ( ( $hamcount / $totalexamined ) * 100 ) if $totalexamined;
1890     +my $hrsinperiod = ( ( $end - $start ) / 3600 );
1891     +my $emailperhour = ( $totalexamined / $hrsinperiod ) if $totalexamined;
1892     +my $above15percent = ( $above15 / $totalexamined * 100 ) if $totalexamined;
1893     +my $infectedpercent = ( ( $infectedcount / ($totalexamined) ) * 100 ) if $totalexamined;
1894     +my $AcceptPercent = ( ( $Accepttotal / ($totalexamined) ) * 100 ) if $totalexamined;
1895     +
1896     +my $oldfh;
1897     +
1898     +#Open Sendmail if we are mailing it
1899     +if ( $opt{'mail'} && !$disabled ) {
1900     + open( SENDMAIL, "|$opt{'sendmail'} -oi -t -odq" )
1901     + or die "Can't open sendmail: $!\n";
1902     + print SENDMAIL "From: $opt{'from'}\n";
1903     + print SENDMAIL "To: $opt{'mail'}\n";
1904     + print SENDMAIL "Subject: Spam Filter Statistics from $hostname - ",
1905     + strftime( "%F", localtime($start) ), "\n\n";
1906     + $oldfh = select SENDMAIL;
1907     +}
1908     +
1909     +my $telapsed = time - $tstart;
1910     +
1911     +if ( !$disabled ) {
1912     +
1913     + #Output results
1914     + print "SMEServer daily Anti-Virus and Spamfilter statistics", "\n";
1915     + print "----------------------------------------------------", "\n\n";
1916     +
1917     + print "$0 Version : $opt{'version'}", "\n\n";
1918     + print "Period Beginning : ", strftime( "%c", localtime($start) ), "\n";
1919     + print "Period Ending : ", strftime( "%c", localtime($end) ), "\n";
1920     + print "\n";
1921     +
1922     + print "Clam Version : ", `freshclam -V`;
1923     + print "SpamAssassin Version : ", `spamassassin -V`;
1924     + printf "Tag level: %3d; Reject level: %3d $warnnoreject\n", $SATagLevel,
1925     + $SARejectLevel;
1926     + if ($HighLogLevel) {
1927     + printf "*Loglevel is set to: ".$LogLevel. " - you only need it set to 6\n";
1928     + printf "\tYou can set it this way:\n";
1929     + printf "\tconfig setprop qpsmtpd LogLevel 6\n";
1930     + printf "\tsignal-event email-update\n";
1931     + printf "\tsv t /var/service/qpsmtpd\n\n";
1932     + }
1933     + print "\n";
1934     + printf "Reporting Period : %.2f hrs\n", $hrsinperiod;
1935     + print "----------------------------\n";
1936     + print "\n";
1937     +
1938     + printf "All SMTP connections accepted:%8d \n", $totalexamined;
1939     +
1940     + printf "Emails per hour : %8.1f/hr\n", $emailperhour || 0;
1941     + print "\n";
1942     + printf "Average spam score (accepted): %11.2f\n", $spamavg || 0;
1943     + printf "Average spam score (rejected): %11.2f\n", $rejectspamavg || 0;
1944     + printf "Average ham score : %11.2f\n", $hamavg || 0;
1945     + print "\n";
1946     + print "Statistics by Hour\n";
1947     +
1948     + #
1949     + # start by working out which colunns to show - tag the display array
1950     + #
1951     + $ncateg = 1; ##skip the first column
1952     + $finaldisplay[0] = $true;
1953     + while ( $ncateg < $categlen) {
1954     + if ($display[$ncateg] eq 'yes') { $finaldisplay[$ncateg] = $true }
1955     + elsif ($display[$ncateg] eq 'no') { $finaldisplay[$ncateg] = $false }
1956     + else {
1957     + $finaldisplay[$ncateg] = ($counts{$GRANDTOTAL}{$categs[$ncateg]} != 0);
1958     + if ($finaldisplay[$ncateg]) {
1959     + #if it has been non zero and auto, then make it yes for the future.
1960     + esmith::ConfigDB->open->get('mailstats')->set_prop($categs[$ncateg],'yes')
1961     + }
1962     +
1963     + }
1964     + $ncateg++
1965     + }
1966     + #make sure total and percentages are shown
1967     + $finaldisplay[@categs-2] = $true;
1968     + $finaldisplay[@categs-1] = $true;
1969     +
1970     +
1971     + # and put together the print lines
1972     + #
1973     + my $Line1; #Full Line across the page
1974     + my $Line2; #Broken Line across the page
1975     + my $Titles; #Column headers
1976     + my $Values; #Values
1977     + my $Totals; #Corresponding totals
1978     + my $Percent; # and column percentages
1979     +
1980     + my $hour = floor( $start / 3600 );
1981     + $Line1 = '';
1982     + $Line2 = '';
1983     + $Titles = '';
1984     + $Values = '';
1985     + $Totals = '';
1986     + $Percent = '';
1987     + while ( $hour < $end / 3600 ) {
1988     + if ($hour == floor( $start / 3600 )){
1989     + #Do all the once only things
1990     + $ncateg = 0;
1991     + while ( $ncateg < @categs) {
1992     + if ($finaldisplay[$ncateg]){
1993     + $Line1 .= substr('---------------------',0,$colwidth[$ncateg]);
1994     + $Line2 .= substr('---------------------',0,$colwidth[$ncateg]-1);
1995     + $Line2 .= " ";
1996     + $Titles .= sprintf('%'.($colwidth[$ncateg]-1).'s',$categs[$ncateg])." ";
1997     + if ($ncateg == 0) {
1998     + $Totals .= substr('TOTALS ',0,$colwidth[$ncateg]-2);
1999     + $Percent .= substr('PERCENTAGES ',0,$colwidth[$ncateg]-1);
2000     + } else {
2001     + # identify bottom right group and supress unless db->ShowGranPerc set
2002     + if ($ncateg==@categs-1){
2003     + $Totals .= sprintf('%'.$colwidth[$ncateg].'.1f',$counts{$GRANDTOTAL}{$categs[$ncateg]}).'%';
2004     + } else {
2005     + $Totals .= sprintf('%'.$colwidth[$ncateg].'d',$counts{$GRANDTOTAL}{$categs[$ncateg]});
2006     + }
2007     + $Percent .= sprintf('%'.($colwidth[$ncateg]-1).'.1f',$counts{$PERCENT}{$categs[$ncateg]}).'%';
2008     + }
2009     + }
2010     + $ncateg++
2011     + }
2012     + }
2013     +
2014     + $ncateg = 0;
2015     + while ( $ncateg < @categs) {
2016     + if ($finaldisplay[$ncateg]){
2017     + if ($ncateg == 0) {
2018     + $Values .= strftime( "%F, %H", localtime( $hour * 3600 ) )." "
2019     + } elsif ($ncateg == @categs-1) {
2020     + #percentages in last column
2021     + $Values .= sprintf('%'.($colwidth[$ncateg]-2).'.1f',$counts{$hour}{$categs[$ncateg]})."%";
2022     + } else {
2023     + #body numbers
2024     + $Values .= sprintf('%'.($colwidth[$ncateg]-1).'d',$counts{$hour}{$categs[$ncateg]})." ";
2025     + }
2026     + if (($ncateg == @categs-1)){$Values=$Values."\n"} #&& ($hour == floor($end / 3600)-1)
2027     + }
2028     + $ncateg++
2029     + }
2030     +
2031     + $hour++;
2032     + }
2033     +
2034     + # print it.
2035     + print $Line1."\n";
2036     + print $Titles."\n";
2037     + print $Line2."\n";
2038     + print $Values."\n";
2039     + print $Line2."\n";
2040     + print $Totals."\n";
2041     + print $Percent."\n";
2042     + print $Line1."\n";
2043     +
2044     +
2045     + if ($localAccepttotal>0) {
2046     + print "*Fetchml* means connections from Fetchmail delivering email\n";
2047     + }
2048     + print "*Local* means connections from workstations on local LAN.\n";
2049     + print "*Non\.Conf\.* means sending mailserver did not conform to correct protocol.\n";
2050     + print " or email was to non existant address.\n";
2051     + print "\n";
2052     +
2053     + if ($QueryNoLogTerse) {
2054     + print "* - as no records where found, it looks as though you may not have the *logterse* \nplugin running as part of qpsmtpd \n";
2055     +# print " to enable it follow the instructions at .............................\n";
2056     + }
2057     +
2058     +
2059     + if ( !$RHSenabled || !$DNSenabled ) {
2060     +
2061     + # comment about RBL not set
2062     + print
2063     +"* - This means that one or more of the possible spam black listing services\n that are available have not been enabled.\n";
2064     + print " You have not enabled:\n";
2065     +
2066     + if ( !$RHSenabled ) {
2067     + print " RHSBL\n";
2068     + }
2069     +
2070     + if ( !$DNSenabled ) {
2071     + print " DNSBL\n";
2072     + }
2073     +
2074     +
2075     + print " To enable these you can use the following commands:\n";
2076     + if ( !$RHSenabled ) {
2077     + print " config setprop qpsmtpd RHSBL enabled\n";
2078     + }
2079     +
2080     + if ( !$DNSenabled ) {
2081     + print " config setprop qpsmtpd DNSBL enabled\n";
2082     + }
2083     +
2084     + # there so much templates to expand... (PS)
2085     + print " Followed by:\n signal-event email-update and\n sv t /var/service/qpsmtpd\n\n";
2086     + }
2087     +
2088     +# if ($Webmailsendtotal > 0) {print "If you have the mailman contrib installed, then the webmail totals might include some mailman emails\n"}
2089     +
2090     + # time to do a 'by recipient domain' report
2091     + print "\nIncoming mails by recipient domains usage\n";
2092     + print "-----------------------------------------\n";
2093     + print
2094     + "Domains Type Total Denied XferErr Accept \%accept\n";
2095     + print
2096     + "---------------------------- ---------- ------ ------ ------- ------ -------\n";
2097     + my %total = (
2098     + total => 0,
2099     + deny => 0,
2100     + xfer => 0,
2101     + accept => 0,
2102     + );
2103     + foreach my $domain (
2104     + sort {
2105     + join( "\.", reverse( split /\./, $a ) ) cmp
2106     + join( "\.", reverse( split /\./, $b ) )
2107     + } keys %byrcptdomain
2108     + )
2109     + {
2110     + next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
2111     + my $tp = $byrcptdomain{$domain}{'type'} || 'other';
2112     + my $to = $byrcptdomain{$domain}{'total'} || 0;
2113     + my $de = $byrcptdomain{$domain}{'deny'} || 0;
2114     + my $xr = $byrcptdomain{$domain}{'xfer'} || 0;
2115     + my $ac = $byrcptdomain{$domain}{'accept'} || 0;
2116     + printf "%-28s %-10s %6d %6d %7d %6d %6.2f%%\n", $domain, $tp, $to,
2117     + $de, $xr, $ac, $ac * 100 / $to;
2118     + $total{'total'} += $to;
2119     + $total{'deny'} += $de;
2120     + $total{'xfer'} += $xr;
2121     + $total{'accept'} += $ac;
2122     + }
2123     + print
2124     + "---------------------------- ---------- ------ ------- ------ ------ -------\n";
2125     +
2126     + # $total{ 'total' } can be equal to 0, bad for divisions...
2127     + my $perc1 = 0;
2128     + my $perc2 = 0;
2129     +
2130     +
2131     + if ( $total{'total'} != 0 ) {
2132     + $perc1 = $total{'accept'} * 100 / $total{'total'};
2133     + $perc2 = ( ( $total{'total'} + $morethanonercpt ) / $total{'total'} );
2134     + }
2135     + printf
2136     + "Total %6d %6d %7d %6d %6.2f%%\n\n",
2137     + $total{'total'}, $total{'deny'}, $total{'xfer'}, $total{'accept'},
2138     + $perc1;
2139     + printf
2140     + "%d mails were processed for %d Recipients\nThe average recipients by mail is %4.2f\n\n",
2141     + $total{'total'}, ( $total{'total'} + $morethanonercpt ), $perc2;
2142     +
2143     + if ( $infectedcount > 0 ) {
2144     + show_virus_variants();
2145     + }
2146     +
2147     + # get enable/disable subsections
2148     + my $enableqpsmtpdcodes;
2149     + my $enableSARules;
2150     + my $enablejunkMailList;
2151     + my $savedata;
2152     + if ($cdb->get('mailstats')){
2153     + $enableqpsmtpdcodes = ($cdb->get('mailstats')->prop("QpsmtpdCodes") || "enabled") eq "enabled" || $true;
2154     + $enableSARules = ($cdb->get('mailstats')->prop("SARules") || "enabled" eq "enabled") || $true;
2155     + $enablejunkMailList = ($cdb->get('mailstats')->prop("JunkMailList") || "enabled") eq "enabled" || $true;
2156     + $savedata = ($cdb->get('mailstats')->prop("SaveDataToMySQL") || "no") eq "yes" || $false;
2157     + } else {
2158     + $enableqpsmtpdcodes = $true;
2159     + $enableSARules = $true;
2160     + $enablejunkMailList = $true;
2161     + $savedata = $false;
2162     + }
2163     +
2164     + if ($enableqpsmtpdcodes) {show_qpsmtpd_codes();}
2165     +
2166     + if ($enableSARules) {show_SARules_codes();}
2167     +
2168     + if ($enablejunkMailList) {List_Junkmail();}
2169     +
2170     + print "\nDone. Report generated in $telapsed sec.\n\n";
2171     +
2172     + if ($savedata) { save_data(); }
2173     + else
2174     + { print "No data saved - if you want to save data to a MySQL database, then please use:\n".
2175     + "config setprop mailstats SaveDataToMySQL yes\n";
2176     + }
2177     +
2178     +
2179     + #Close Senmdmail if it was opened
2180     + if ( $opt{'mail'} ) {
2181     + select $oldfh;
2182     + close(SENDMAIL);
2183     + }
2184     +
2185     +} ##report disabled
2186     +
2187     +#All done
2188     +exit 0;
2189     +
2190     +#############################################################################
2191     +# Subroutines ###############################################################
2192     +#############################################################################
2193     +
2194     +
2195     +################################################
2196     +# Determine analysis period (start and end time)
2197     +################################################
2198     +sub analysis_period {
2199     + my $startdate = shift;
2200     + my $enddate = shift;
2201     +
2202     + my $secsininterval = 86400; #daily default
2203     + my $time;
2204     +
2205     + if ($cdb->get('mailstats'))
2206     + {
2207     + my $interval = $cdb->get('mailstats')->prop('Interval') || 'daily';
2208     + if ($interval eq "weekly") {
2209     + $secsininterval = 86400*7;
2210     + } elsif ($interval eq "fortnightly") {
2211     + $secsininterval = 86400*14;
2212     + } elsif ($interval eq "monthly") {
2213     + $secsininterval = 86400;
2214     + } elsif ($interval =~m/\d+/) {
2215     + $secsininterval = $interval*3600;
2216     + };
2217     + my $base = $cdb->get('mailstats')->prop('Base') || 'Midnight';
2218     + my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
2219     + localtime(time);
2220     + if ($base eq "Midnight"){
2221     + $sec = 0;$min=0;$hour=0;
2222     + } elsif ($base eq "Midday"){
2223     + $sec = 0;$min=0;$hour=12;
2224     + } elsif ($base =~m/\d+/){
2225     + $sec=0;$min=0;$hour=$base;
2226     + };
2227     + $time = timelocal($sec,$min,$hour,$mday,$mon,$year)
2228     + }
2229     + my $start = UnixDate( $startdate, "%s" );
2230     + my $end = $enddate ? UnixDate( $enddate, "%s" ) :
2231     + $startdate ? $start + $secsininterval : $time;
2232     + $start = $startdate ? $start : $end - $secsininterval;
2233     + return ( $start > $end ) ? ( $end, $start ) : ( $start, $end );
2234     +}
2235     +
2236     +sub dbg {
2237     + my $msg = shift;
2238     +
2239     + if ( $opt{debug} ) {
2240     + print STDERR $msg;
2241     + }
2242     +}
2243     +
2244     +sub List_Junkmail {
2245     +
2246     + #
2247     + # Show how many junkmails in each user's junkmail folder.
2248     + #
2249     + use esmith::AccountsDB;
2250     + my $adb = esmith::AccountsDB->open_ro;
2251     + my $entry;
2252     + foreach my $user ( $adb->users ) {
2253     + my $found = 0;
2254     + my $junkmail_dir =
2255     + "/home/e-smith/files/users/" . $user->key . "/Maildir/.junkmail";
2256     + foreach my $dir (qw(new cur)) {
2257     +
2258     + # Now get the content list for the directory.
2259     + if ( opendir( QDIR, "$junkmail_dir/$dir" ) ) {
2260     + while ( $entry = readdir(QDIR) ) {
2261     + next if $entry =~ /^\./;
2262     + $found++;
2263     + }
2264     + closedir(QDIR);
2265     + }
2266     + }
2267     + if ( $found != 0 ) {
2268     + $junkcount{ $user->key } = $found;
2269     + }
2270     + }
2271     + my $i = keys %junkcount;
2272     + if ( $i > 0 ) {
2273     + print("Junk Mails left in folder:\n");
2274     + print("-------------------------\n");
2275     + print("Count\tUser\n");
2276     + print("-------------------------\n");
2277     + foreach my $thisuser (
2278     + sort { $junkcount{$b} <=> $junkcount{$a} }
2279     + keys %junkcount
2280     + )
2281     + {
2282     + printf "%d", $junkcount{$thisuser};
2283     + print "\t" . $thisuser . "\n";
2284     + }
2285     + print("-------------------------\n");
2286     + }
2287     + else {
2288     + print "***No junkmail folders with emails***\n";
2289     + }
2290     +}
2291     +
2292     +sub show_virus_variants
2293     +
2294     +#
2295     +# Show a league table of the different virus types found today
2296     +#
2297     +
2298     +{
2299     +
2300     + print("Virus Statistics by name:\n");
2301     + print("---------------------------------------------\n");
2302     + foreach my $virus (sort { $found_viruses{$b} <=> $found_viruses{$a} }
2303     + keys %found_viruses)
2304     + {
2305     + print "Rejected $found_viruses{$virus}\t$virus\n";
2306     + }
2307     + print("---------------------------------------------\n\n");
2308     +}
2309     +
2310     +sub show_qpsmtpd_codes
2311     +
2312     +#
2313     +# Show a league table of the qpsmtpd result codes found today
2314     +#
2315     +
2316     +{
2317     +
2318     + print("Qpsmtpd codes league table:\n");
2319     + print("---------------------------------------------\n");
2320     + print("Count\tPercent\tReason\t\n");
2321     + print("---------------------------------------------\n");
2322     + foreach my $qpcode (sort { $found_qpcodes{$b} <=> $found_qpcodes{$a} }
2323     + keys %found_qpcodes)
2324     + {
2325     + print "$found_qpcodes{$qpcode}\t".sprintf('%4.1f',$found_qpcodes{$qpcode}*100/$totalexamined)."%\t$qpcode\n" if $totalexamined;
2326     + }
2327     + print("---------------------------------------------\n\n");
2328     +}
2329     +
2330     +sub show_SARules_codes
2331     +
2332     +#
2333     +# Show a league table of the SARules result codes found today
2334     +# suppress any lower than DB mailstats/SARulePercentThreshold
2335     +#
2336     +
2337     +{
2338     +
2339     + my ($percentthreshold);
2340     + my ($defaultpercentthreshold);
2341     +
2342     + if ($totalexamined >0 && $sum_SARules*100/$totalexamined > $SARulethresholdPercent) {
2343     + $defaultpercentthreshold = $maxcutoff
2344     + } else {
2345     + $defaultpercentthreshold = $mincutoff
2346     + }
2347     + if ($cdb->get('mailstats')){
2348     + $percentthreshold = $cdb->get('mailstats')->prop("SARulePercentThreshold") || $defaultpercentthreshold;
2349     + } else {
2350     + $percentthreshold = $defaultpercentthreshold
2351     + }
2352     + print("Spamassassin Rules:\n");
2353     + print("---------------------------------------------\n");
2354     + print("Count\tPercent\tRule\t\n");
2355     + print("---------------------------------------------\n");
2356     + foreach my $SARule (sort { $found_SARules{$b}{'count'} <=> $found_SARules{$a}{'count'} }
2357     + keys %found_SARules)
2358     + {
2359     + my $percent = $found_SARules{$SARule}{'count'} * 100 / $totalexamined
2360     + if $totalexamined;
2361     + my $avehits = $found_SARules{$SARule}{'totalhits'} /
2362     + $found_SARules{$SARule}{'count'}
2363     + if $found_SARules{$SARule}{'count'};
2364     + if ( $percent > $percentthreshold ) {
2365     + print "$found_SARules{$SARule}{'count'}\t"
2366     + . sprintf( '%4.1f', $percent ) . "%\t"
2367     + . sprintf( '%4.1f', $avehits )
2368     + . "\t$SARule\n"
2369     + if $totalexamined;
2370     + }
2371     + }
2372     + print("---------------------------------------------\n\n");
2373     +
2374     +
2375     +}
2376     +
2377     +sub mark_domain_rejected
2378     +
2379     +#
2380     +# Tag domain as having a rejected email
2381     +#
2382     +{
2383     +my ($proc) = @_;
2384     +if ( ( $currentrcptdomain{ $proc } || '' ) ne '' ) {
2385     + $byrcptdomain{ $currentrcptdomain{ $proc } }{ 'deny' }++ ;
2386     + $currentrcptdomain{ $proc } = '' ;
2387     + }
2388     +}
2389     +
2390     +sub mark_domain_err
2391     +
2392     + #
2393     + # Tag domain as having an error on email transfer
2394     + #
2395     +{
2396     + my ($proc) = @_;
2397     + if ( ( $currentrcptdomain{$proc} || '' ) ne '' ) {
2398     + $byrcptdomain{ $currentrcptdomain{$proc} }{'xfer'}++;
2399     + $currentrcptdomain{$proc} = '';
2400     + }
2401     +}
2402     +
2403     +sub add_in_domain
2404     +
2405     + #
2406     + # add recipient domain into hash
2407     + #
2408     +{
2409     + my ($proc) = @_;
2410     +
2411     + #split to just domain bit.
2412     + $currentrcptdomain{$proc} =~ s/.*@//;
2413     + $currentrcptdomain{$proc} =~ s/[^\w\-\.]//g;
2414     + $currentrcptdomain{$proc} =~ s/>//g;
2415     + my $NotableDomain = 0;
2416     + if ( defined( $byrcptdomain{ $currentrcptdomain{$proc} }{'type'} ) ) {
2417     + $NotableDomain = 1;
2418     + }
2419     + else {
2420     + foreach (@extdomain) {
2421     + if ( $currentrcptdomain{$proc} =~ m/$_$/ ) {
2422     + $NotableDomain = 1;
2423     + last;
2424     + }
2425     + }
2426     + }
2427     + if ( !$NotableDomain ) {
2428     +
2429     + # check for outgoing email
2430     + if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Outgoing' }
2431     + else { $currentrcptdomain{$proc} = 'Others' }
2432     + }
2433     + else {
2434     + if ( $localflag == 1 ) { $currentrcptdomain{$proc} = 'Internal' }
2435     + }
2436     + $byrcptdomain{ $currentrcptdomain{$proc} }{'total'}++;
2437     +}
2438     +
2439     +sub save_data
2440     +
2441     + #
2442     + # Save the data to a MySQL database
2443     + #
2444     +{
2445     + use DBI;
2446     + my $tstart = time;
2447     + my $DBname = "mailstats";
2448     + my $host = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBHost') || "localhost";
2449     + my $port = esmith::ConfigDB->open_ro->get('mailstats')->prop('DBPort') || "3306";
2450     + print "Saving data..";
2451     + my $dbh = DBI->connect( "DBI:mysql:database=$DBname;host=$host;port=$port",
2452     + "mailstats", "mailstats" )
2453     + or die "Cannot open db";
2454     +
2455     + my $hour = floor( $start / 3600 );
2456     + my $reportdate = strftime( "%F", localtime( $hour * 3600 ) );
2457     + my $dateid = get_dateid($dbh,$reportdate);
2458     + my $reccount = 0; #count number of records written
2459     + my $servername = esmith::ConfigDB->open_ro->get('SystemName')->value . "."
2460     + . esmith::ConfigDB->open_ro->get('DomainName')->value;
2461     + # now fill in day related stats - must always check for it already there
2462     + # incase the module is run more than once in a day
2463     + my $SAScoresid = check_date_rec($dbh,"SAscores",$dateid,$servername);
2464     + $dbh->do( "UPDATE SAscores SET ".
2465     + "acceptedcount=".$spamcount.
2466     + ",rejectedcount=".$above15.
2467     + ",hamcount=".$hamcount.
2468     + ",acceptedscore=".$spamhits.
2469     + ",rejectedscore=".$rejectspamhits.
2470     + ",hamscore=".$hamhits.
2471     + ",totalsmtp=".$totalexamined.
2472     + ",totalrecip=".$recipcount.
2473     + ",servername='".$servername.
2474     + "' WHERE SAscoresid =".$SAScoresid);
2475     + # Junkmail stats
2476     + # delete if already there
2477     + $dbh->do("DELETE from JunkMailStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
2478     + # and add records
2479     + foreach my $thisuser (keys %junkcount){
2480     + $dbh->do("INSERT INTO JunkMailStats (dateid,user,count,servername) VALUES ('".
2481     + $dateid."','".$thisuser."','".$junkcount{$thisuser}."','".$servername."')");
2482     + $reccount++;
2483     + }
2484     + #SA rules - delete any first
2485     + $dbh->do("DELETE from SARules WHERE dateid = ".$dateid." AND servername='".$servername."'");
2486     + # and add records
2487     + foreach my $thisrule (keys %found_SARules){
2488     + $dbh->do("INSERT INTO SARules (dateid,rule,count,totalhits,servername) VALUES ('".
2489     + $dateid."','".$thisrule."','".$found_SARules{$thisrule}{'count'}."','".
2490     + $found_SARules{$thisrule}{'totalhits'}."','".$servername."')");
2491     + $reccount++;
2492     + }
2493     + #qpsmtpd result codes
2494     + $dbh->do("DELETE from qpsmtpdcodes WHERE dateid = ".$dateid." AND servername='".$servername."'");
2495     + # and add records
2496     + foreach my $thiscode (keys %found_qpcodes){
2497     + $dbh->do("INSERT INTO qpsmtpdcodes (dateid,reason,count,servername) VALUES ('".
2498     + $dateid."','".$thiscode."','".$found_qpcodes{$thiscode}."','".$servername."')");
2499     + $reccount++;
2500     +}
2501     + # virus stats
2502     + $dbh->do("DELETE from VirusStats WHERE dateid = ".$dateid." AND servername='".$servername."'");
2503     + # and add records
2504     + foreach my $thisvirus (keys %found_viruses){
2505     + $dbh->do("INSERT INTO VirusStats (dateid,descr,count,servername) VALUES ('".
2506     + $dateid."','".$thisvirus."','".$found_viruses{$thisvirus}."','".$servername."')");
2507     + $reccount++;
2508     +
2509     + }
2510     + # domain details
2511     + $dbh->do("DELETE from domains WHERE dateid = ".$dateid." AND servername='".$servername."'");
2512     + # and add records
2513     + foreach my $domain (keys %byrcptdomain){
2514     + next if ( ( $byrcptdomain{$domain}{'total'} || 0 ) == 0 );
2515     + $dbh->do("INSERT INTO domains (dateid,domain,type,total,denied,xfererr,accept,servername) VALUES ('".
2516     + $dateid."','".$domain."','".($byrcptdomain{$domain}{'type'}||'other')."','"
2517     + .$byrcptdomain{$domain}{'total'}."','"
2518     + .($byrcptdomain{$domain}{'deny'}||0)."','"
2519     + .($byrcptdomain{$domain}{'xfer'}||0)."','"
2520     + .($byrcptdomain{$domain}{'accept'}||0)."','"
2521     + .$servername
2522     + ."')");
2523     + $reccount++;
2524     +
2525     + }
2526     + # finally - the hourly breakdown
2527     + # need to remember here that the date might change during the 24 hour span
2528     + my $nhour = floor( $start / 3600 );
2529     + my $ncateg;
2530     + while ( $nhour < $end / 3600 ) {
2531     + #see if the time record has been created
2532     + # print strftime("%H",localtime( $nhour * 3600 ) ).":00:00\n";
2533     + my $sth =
2534     + $dbh->prepare( "SELECT timeid FROM time WHERE time = '" . strftime("%H",localtime( $nhour * 3600 ) ).":00:00'");
2535     + $sth->execute();
2536     + if ( $sth->rows == 0 ) {
2537     + #create entry
2538     + $dbh->do( "INSERT INTO time (time) VALUES ('" .strftime("%H",localtime( $nhour * 3600 ) ).":00:00')" );
2539     + # and pick up timeid
2540     + $sth = $dbh->prepare("SELECT last_insert_id() AS timeid FROM time");
2541     + $sth->execute();
2542     + $reccount++;
2543     + }
2544     + my $timerec = $sth->fetchrow_hashref();
2545     + my $timeid = $timerec->{"timeid"};
2546     + $ncateg = 0;
2547     + # and extract date from first column of $count array
2548     + my $currentdate = strftime( "%F", localtime( $hour * 3600 ) );
2549     + # print "$currentdate.\n";
2550     + if ($currentdate ne $reportdate) {
2551     + #same as before?
2552     + $dateid = get_dateid($dbh,$currentdate);
2553     + $reportdate = $currentdate;
2554     + }
2555     + # delete for this date and time
2556     + $dbh->do("DELETE from ColumnStats WHERE dateid = ".$dateid." AND timeid = ".$timeid." AND servername='".$servername."'");
2557     + while ( $ncateg < @categs-1 ) {
2558     + # then add in each entry
2559     + if (($counts{$nhour}{$categs[$ncateg]} || 0) != 0) {
2560     + $dbh->do("INSERT INTO ColumnStats (dateid,timeid,descr,count,servername) VALUES ("
2561     + .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
2562     + .$counts{$nhour}{$categs[$ncateg]}.",'".$servername."')");
2563     + $reccount++;
2564     + }
2565     +
2566     +# print("INSERT INTO ColumnStats (dateid,timeid,descr,count) VALUES ("
2567     +# .$dateid.",".$timeid.",'".$categs[$ncateg]."',"
2568     +# .$counts{$nhour}{$categs[$ncateg]}.")\n");
2569     +
2570     + $ncateg++;
2571     + }
2572     + $nhour++;
2573     + }
2574     + $dbh->disconnect();
2575     + my $telapsed = time - $tstart;
2576     + print "Saved $reccount records in $telapsed sec.";
2577     +}
2578     +
2579     +sub check_date_rec
2580     +
2581     + #
2582     + # check that a specific dated rec is there, create if not
2583     + #
2584     +{
2585     + my ( $dbh, $table, $dateid ) = @_;
2586     + my $sth =
2587     + $dbh->prepare(
2588     + "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid'" );
2589     + $sth->execute();
2590     + if ( $sth->rows == 0 ) {
2591     + #create entry
2592     + $dbh->do( "INSERT INTO ".$table." (dateid) VALUES ('" . $dateid . "')" );
2593     + # and pick up recordid
2594     + $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
2595     + $sth->execute();
2596     + }
2597     + my $rec = $sth->fetchrow_hashref();
2598     + $rec->{$table."id"}; #return the id of the reocrd (new or not)
2599     + }
2600     +
2601     + sub check_time_rec
2602     +
2603     + #
2604     + # check that a specific dated amd timed rec is there, create if not
2605     + #
2606     +{
2607     + my ( $dbh, $table, $dateid, $timeid ) = @_;
2608     + my $sth =
2609     + $dbh->prepare(
2610     + "SELECT " . $table . "id FROM ".$table." WHERE dateid = '$dateid' AND timeid = ".$timeid );
2611     + $sth->execute();
2612     + if ( $sth->rows == 0 ) {
2613     + #create entry
2614     + $dbh->do( "INSERT INTO ".$table." (dateid,timeid) VALUES ('" . $dateid . "', '".$timeid."')" );
2615     + # and pick up recordid
2616     + $sth = $dbh->prepare("SELECT last_insert_id() AS ".$table."id FROM ".$table);
2617     + $sth->execute();
2618     + }
2619     + my $rec = $sth->fetchrow_hashref();
2620     + $rec->{$table."id"}; #return the id of the record (new or not)
2621     + }
2622     +
2623     +sub get_dateid
2624     +
2625     +#
2626     +# Check that date is in db, and return corresponding id
2627     +#
2628     +{
2629     + my ($dbh,$reportdate) = @_;
2630     + my $sth =
2631     + $dbh->prepare( "SELECT dateid FROM date WHERE date = '" . $reportdate."'" );
2632     + $sth->execute();
2633     + if ( $sth->rows == 0 ) {
2634     + #create entry
2635     + $dbh->do( "INSERT INTO date (date) VALUES ('" . $reportdate . "')" );
2636     + # and pick up dateid
2637     + $sth = $dbh->prepare("SELECT last_insert_id() AS dateid FROM date");
2638     + $sth->execute();
2639     + }
2640     + my $daterec = $sth->fetchrow_hashref();
2641     + $daterec->{"dateid"};
2642     + }

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