root/trunk/hldfilter/statsgen.pl

Revision 32, 9.2 KB (checked in by wombat, 9 years ago)

Fixed checkuser bug
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl
2
3###########################################################################
4#      Copyright Dan Cardamore <wombat@hld.ca>
5#      This program is licensed under the Gnu GPL.  Since this is free
6#      software, the author assumes no liability for it and the damages
7#      that it may cause.
8#
9#      Please read the README file.  For install instructions, please visit
10#      http://www.hld.ca/opensource/hldfilter
11#
12###########################################################################
13#       $rcs = ' $Id: statsgen.pl,v 3.1 2001/06/01 17:35:32 wombat Exp $ ' ;
14###########################################################################
15use strict;
16use Mail::Audit;                # this is for filtering mail
17use Mail::Sender;               # this is for sending my gpg key
18use Date::Manip;                # this is for logging the date
19use GD::Graph::pie;             # for image manipulation
20use GD::Graph::bars;
21use Carp;
22############################################################################
23
24use vars (
25          '%rc',
26          '@stats',
27          '@spamstats',
28          '@ignore',
29          '%hashstats',
30          '%hashspamstats',
31          '$spamCount',
32          '$normalCount',
33          '$rblCount',
34          '$checkuserCount',
35          '%folderCount',
36          '%monthStats',
37          '%hourlyStats',
38          '$VERSION'
39         );
40
41my $VERSION = "2.4";
42my $uid = $>;
43my $home = (getpwuid ($uid))[7];
44my $configDir = $home . "/.hldfilter";
45my $logfile = $configDir . "/log";
46
47sub error($)  {
48    my $error = shift;
49    $error = "ERROR: $error";
50    confess ($error);
51  }
52
53sub getConfig {
54  open (RC, "<$configDir/hldfilter.rc") or &error($!);
55  flock (RC, 2);
56  while (<RC>) {
57    chomp;
58    s/#.*//;                    # no comments
59    s/^\s+//;                   # no leading white
60    s/\s+$//;                   # no trailing white
61    next unless length;         # anything left?
62    my ($var, $value) = split(/\s*=\s*/, $_, 2);
63    $rc{$var} = $value;
64  }
65  flock (*RC, 8);
66  close(*RC);
67
68  open (IGNORE, "<$configDir/stats.ignore") or &error($!);
69  flock (IGNORE, 2);
70  @ignore = <IGNORE>;
71  flock (IGNORE, 8);
72  close (IGNORE);
73  chomp @ignore;
74
75  return 1;
76}
77
78sub collectStats {
79  open (STATS, "<$rc{'statsdir'}/stats.dat") or error($!);
80  flock (STATS, 2);
81  my @statsdat = <STATS>;
82  flock (STATS, 8);
83  close (STATS);
84  chomp @statsdat;
85
86
87  foreach my $line (@statsdat) {
88    my ($from, $date, $type, $folder) = split /~:~/,$line;
89    if ($type eq "spam") {
90      $hashspamstats{$from}++;
91      $spamCount++;
92    } elsif ($type eq "normal") {
93      $hashstats{$from}++;
94      $normalCount++;
95    } elsif ($type eq "rbl") {
96      $hashspamstats{$from}++;
97      $rblCount++;
98    } elsif ($type eq "checkuser") {
99      $hashspamstats{$from}++;
100      $checkuserCount++;
101    }
102
103                                # Do stats for folder now
104    if (defined $folder) {
105      $folderCount{$folder}++;
106    }
107    my $day = int UnixDate($date, "%d");
108    my $month = UnixDate($date, "%m");
109    my $year = UnixDate($date, "%Y");
110    my $thismonth = UnixDate("today", "%m");
111    my $thisyear = UnixDate("today", "%Y");
112
113    $monthStats{$day}++ if (($month eq $thismonth) and ($year eq $thisyear));
114    my $hour = int UnixDate($date, "%H");
115    $hourlyStats{$hour}++;
116  }
117
118  foreach my $from (keys %hashspamstats) {
119    push @spamstats, "$from~:~$hashspamstats{$from}";
120  }
121  @spamstats = map { $_->[0] }
122    sort { $b->[1] <=> $a->[1] }
123      map { [split /~:~/, $_ ] }
124        @spamstats;
125
126  foreach my $from (keys %hashstats) {
127    push @stats, "$from~:~$hashstats{$from}";
128  }
129  @stats = map { $_->[0] }
130    sort { $b->[1] <=> $a->[1] }
131      map { [split /~:~/, $_ ] }
132        @stats;
133}
134
135sub emailTypeGraph {
136  my @data = (
137              ["Normal", "Spam", "RBL", "CheckUser"],
138              [$normalCount, $spamCount, $rblCount, $checkuserCount],
139             );
140
141  my $graph = GD::Graph::pie->new(400,300);
142
143
144  $graph->set(
145              title => 'Email Types',
146              label => undef,
147              axislabelclr => 'black',
148              pie_height => 36,
149              transparent => 1,
150              shadowclr => 'black',
151              shadow_depth => 5,
152              dclrs => [ qw(green red orange yellow) ]
153             );
154
155  my $gd = $graph->plot(\@data);
156
157  open (IMG, ">$rc{'statsdir'}/emailTypePie.png") or error ($!);
158  binmode IMG;
159  print IMG $gd->png;
160  close (IMG);
161
162  return "<img src=\"emailTypePie.png\" border=0><br>\n";
163}
164
165sub MonthlyGraph {
166  my $today = &ParseDate("today");
167  my $month = UnixDate($today, "%m");
168  my $year = UnixDate($today, "%Y");
169  my $daysinMonth = &Date_DaysInMonth($month, $year);
170
171  my @dayNames = (1 .. $daysinMonth);
172  my @days;
173  for (my $i = 1; $i <= $daysinMonth; $i++) {
174    push @days, $monthStats{$i};
175  }
176  my @data = (
177              [@dayNames],
178              [@days]
179             );
180  my $graph = GD::Graph::bars->new(750,300);
181
182  $graph->set(
183              title => 'Traffic For this Month Only',
184              label => undef,
185              axislabelclr => 'black',
186              transparent => 1,
187              shadowclr => 'black',
188              shadow_depth => 5,
189              cycle_clrs => 1,
190             );
191
192  my $gd = $graph->plot(\@data);
193
194  open (IMG, ">$rc{'statsdir'}/MonthTraffic.png") or error ($!);
195  binmode IMG;
196  print IMG $gd->png;
197  close (IMG);
198
199  return "<img src=\"MonthTraffic.png\" border=0><br>\n";
200
201}
202
203sub HourlyGraph  {
204  my $today = &ParseDate("today");
205
206  my @hourNames = (0 .. 23);
207  my @hours;
208  for (my $i = 0; $i <= 23; $i++) {
209    push @hours, $hourlyStats{$i};
210  }
211  my @data = (
212              [@hourNames],
213              [@hours]
214             );
215  my $graph = GD::Graph::bars->new(750,300);
216
217  $graph->set(
218              title => 'Traffic For Hours in the Day',
219              label => undef,
220              axislabelclr => 'black',
221              transparent => 1,
222              shadowclr => 'black',
223              shadow_depth => 5,
224              cycle_clrs => 1,
225             );
226
227  my $gd = $graph->plot(\@data);
228
229  open (IMG, ">$rc{'statsdir'}/HourlyTraffic.png") or error ($!);
230  binmode IMG;
231  print IMG $gd->png;
232  close (IMG);
233
234  return "<img src=\"HourlyTraffic.png\" border=0><br>\n";
235
236}
237
238sub folderTrafficGraph  {
239  my @folderNames = keys %folderCount;
240  my @folderCounts;
241
242  if (not defined $folderNames[0]) {
243    return "<br>No Folder Data<br>\n";
244  }
245  foreach my $i (@folderNames) {
246    push @folderCounts, $folderCount{$i};
247  }
248  my @data = (
249              [@folderNames],
250              [@folderCounts]
251             );
252
253  my $graph = GD::Graph::bars->new(750,300);
254
255
256  $graph->set(
257              title => 'Folder Traffic',
258              label => undef,
259              axislabelclr => 'black',
260              transparent => 1,
261              shadowclr => 'black',
262              shadow_depth => 5,
263              cycle_clrs => 1,
264             );
265
266  my $gd = $graph->plot(\@data);
267
268  open (IMG, ">$rc{'statsdir'}/folderTraffic.png") or error ($!);
269  binmode IMG;
270  print IMG $gd->png;
271  close (IMG);
272
273  return "<img src=\"folderTraffic.png\" border=0><br>\n";
274}
275
276sub removeIgnored {
277  for (my $i = 0; $i <= $#spamstats; $i++) {
278    my ($from, $count) = split /~:~/, $spamstats[$i];
279                       
280    my $ignoreFlag = undef;
281    foreach my $test (@ignore) {
282      if ($from eq $test) {
283        splice @spamstats, $i, 1;
284        $i--;
285        last;
286      }
287    }
288  }
289
290       
291  for (my $i = 0; $i <= $#stats; $i++) {
292    my ($from, $count) = split /~:~/, $stats[$i];
293                       
294    my $ignoreFlag = undef;
295    foreach my $test (@ignore) {
296      if ($from eq $test) {
297        splice @stats, $i, 1;
298        $i--;
299        last;
300      }
301    }
302  }
303}
304
305sub writeStats {
306  my $today = ParseDate("today");
307  $today = UnixDate($today, "%H:%M %D");
308
309  open (STATS, ">$rc{'statsdir'}/stats.shtml") or error($!);
310  flock (STATS, 2);
311
312  print STATS "<center>\n";
313
314  print STATS emailTypeGraph();
315  print STATS "<hr width=50%>";
316  print STATS folderTrafficGraph();
317  print STATS "<hr width=50%>";
318  print STATS MonthlyGraph();
319  print STATS "<hr width=50%>";         
320  print STATS HourlyGraph();
321  print STATS "<hr width=50%>";         
322
323  unless ($rc{'Stats_HideSpammersEmail'} eq "yes") {
324    print STATS "<table border=2 width=100%>\n";
325    print STATS "<tr><td bgcolor=#477979 colspan=2 align=center><font color=white>Spammers" .
326      "Blocked</font></td></tr>\n";
327    print STATS "<tr><td bgcolor=#477979 align=center><font color=white>From</font></td>";
328    print STATS "<td bgcolor=#477979 align=center><font color=white>Count</font></td></tr>\n";
329
330    my $max = 1;
331    foreach my $line (@spamstats) {
332      my ($from, $count) = split /~:~/, $line;
333      print STATS "<tr><td>$from</td><td>$hashspamstats{$from}</td></tr>\n";
334      last if (($rc{'TopSpammersCount'} ne "0" ) and ($max == $rc{'TopSpammersCount'}));
335      $max++;
336    }
337    print STATS "</table>\n";
338  }
339
340  unless ($rc{'Stats_HideAcceptedEmail'} eq "yes") {
341    print STATS "<table border=2 width=100%>\n";
342    print STATS "<tr><td bgcolor=#477979 colspan=2 align=center><font color=white>Accepted Mail" .
343      "</font></td></tr>\n";
344    print STATS "<tr><td bgcolor=#477979 align=center><font color=white>From</font></td>";
345    print STATS "<td bgcolor=#477979 align=center><font color=white>Count</font></td></tr>\n";
346
347    my $max = 1;
348    foreach my $line (@stats) {
349      my ($from, $count) = split /~:~/, $line;
350      my $maskFrom = $from;
351      $maskFrom =~ s/@/ <b>at<\/b> /;
352      print STATS "<tr><td>$maskFrom</td><td>$hashstats{$from}</td></tr>\n";
353      last if (($rc{'TopAcceptedCount'} ne "0" ) and ($max == $rc{'TopAcceptedCount'}));
354      $max++;
355    }
356    print STATS "</table>\n";
357  }
358               
359  print STATS "</center>\n";
360               
361  print STATS "<hr>\n";
362  print STATS "This page was last updated on $today by" .
363    "<a href=\"http://www.hld.ca/opensource/hldfilter\">HLDFilter $VERSION</a>\n";
364
365  flock (STATS, 8);
366  close (STATS);
367}
368
369
370###########
371#  Start  #
372###########
373
374&getConfig;
375&collectStats;
376&removeIgnored;
377&writeStats;
378
Note: See TracBrowser for help on using the browser.