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

Contents 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.3 - (show annotations) (download)
Tue Nov 25 16:20:25 2008 UTC (15 years, 5 months ago) by slords
Branch: MAIN
CVS Tags: smeserver-mailstats-0_0_3-15_el4_sme, smeserver-mailstats-0_0_3-14_el4_sme, HEAD
Changes since 1.2: +0 -0 lines
Restore

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