File Coverage

blib/lib/Mail/SpamAssassin/DBBasedAddrList.pm
Criterion Covered Total %
statement 72 90 80.0
branch 6 18 33.3
condition 9 14 64.2
subroutine 12 13 92.3
pod 6 6 100.0
total 105 141 74.4


line stmt bran cond sub pod time code
1             # <@LICENSE>
2             # Licensed to the Apache Software Foundation (ASF) under one or more
3             # contributor license agreements. See the NOTICE file distributed with
4             # this work for additional information regarding copyright ownership.
5             # The ASF licenses this file to you under the Apache License, Version 2.0
6             # (the "License"); you may not use this file except in compliance with
7             # the License. You may obtain a copy of the License at:
8             #
9             # http://www.apache.org/licenses/LICENSE-2.0
10             #
11             # Unless required by applicable law or agreed to in writing, software
12             # distributed under the License is distributed on an "AS IS" BASIS,
13             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14             # See the License for the specific language governing permissions and
15             # limitations under the License.
16             # </@LICENSE>
17              
18             package Mail::SpamAssassin::DBBasedAddrList;
19              
20 5     5   34 use strict;
  5         10  
  5         187  
21 5     5   27 use warnings;
  5         9  
  5         201  
22             # use bytes;
23 5     5   31 use re 'taint';
  5         11  
  5         254  
24 5     5   37 use Fcntl;
  5         14  
  5         1524  
25              
26 5     5   1739 use Mail::SpamAssassin::PersistentAddrList;
  5         12  
  5         188  
27 5     5   40 use Mail::SpamAssassin::Util qw(untaint_var);
  5         9  
  5         251  
28 5     5   37 use Mail::SpamAssassin::Logger;
  5         10  
  5         4754  
29              
30             our @ISA = qw(Mail::SpamAssassin::PersistentAddrList);
31              
32             ###########################################################################
33              
34             sub new {
35 6     6 1 20 my $class = shift;
36 6   33     39 $class = ref($class) || $class;
37 6         39 my $self = $class->SUPER::new(@_);
38 6         28 $self->{class} = $class;
39 6         16 bless ($self, $class);
40 6         103 $self;
41             }
42              
43             ###########################################################################
44              
45             sub new_checker {
46 6     6 1 14 my ($factory, $main) = @_;
47 6         14 my $class = $factory->{class};
48              
49 6         29 my $self = {
50             'main' => $main,
51             'accum' => { },
52             'is_locked' => 0,
53             'locked_file' => ''
54             };
55              
56 6         29 my @order = split (' ', $main->{conf}->{auto_whitelist_db_modules});
57 6         27 untaint_var(\@order);
58 6         27 my $dbm_module = Mail::SpamAssassin::Util::first_available_module (@order);
59 6 50       22 if (!$dbm_module) {
60             die "auto-whitelist: cannot find a usable DB package from auto_whitelist_db_modules: " .
61 0         0 $main->{conf}->{auto_whitelist_db_modules}."\n";
62             }
63              
64 6         70 my $umask = umask ~ (oct($main->{conf}->{auto_whitelist_file_mode}));
65              
66             # if undef then don't worry -- empty hash!
67 6 50       43 if (defined($main->{conf}->{auto_whitelist_path})) {
68 6         42 my $path = $main->sed_path($main->{conf}->{auto_whitelist_path});
69 6         17 my ($mod1, $mod2);
70              
71 6 50       58 if ($main->{locker}->safe_lock
72             ($path, 30, $main->{conf}->{auto_whitelist_file_mode}))
73             {
74 6         17 $self->{locked_file} = $path;
75 6         17 $self->{is_locked} = 1;
76 6         16 ($mod1, $mod2) = ('R/W', O_RDWR | O_CREAT);
77             }
78             else {
79 0         0 $self->{is_locked} = 0;
80 0         0 ($mod1, $mod2) = ('R/O', O_RDONLY);
81             }
82              
83 6         37 dbg("auto-whitelist: tie-ing to DB file of type $dbm_module $mod1 in $path");
84              
85 6 50 33     39 ($self->{is_locked} && $dbm_module eq 'DB_File') and
86             Mail::SpamAssassin::Util::avoid_db_file_locking_bug($path);
87              
88 6 50       10 if (! tie %{ $self->{accum} }, $dbm_module, $path, $mod2,
  6         517  
89             oct($main->{conf}->{auto_whitelist_file_mode}) & 0666)
90             {
91 0         0 my $err = $!; # might get overwritten later
92 0 0       0 if ($self->{is_locked}) {
93 0         0 $self->{main}->{locker}->safe_unlock($self->{locked_file});
94 0         0 $self->{is_locked} = 0;
95             }
96 0         0 die "auto-whitelist: cannot open auto_whitelist_path $path: $err\n";
97             }
98             }
99 6         42 umask $umask;
100              
101 6         30 bless ($self, $class);
102 6         38 return $self;
103             }
104              
105             ###########################################################################
106              
107             sub finish {
108 6     6 1 13 my $self = shift;
109 6         23 dbg("auto-whitelist: DB addr list: untie-ing and unlocking");
110 6         10 untie %{$self->{accum}};
  6         149  
111 6 50       36 if ($self->{is_locked}) {
112 6         25 dbg("auto-whitelist: DB addr list: file locked, breaking lock");
113 6         54 $self->{main}->{locker}->safe_unlock ($self->{locked_file});
114 6         20 $self->{is_locked} = 0;
115             }
116             # TODO: untrap signals to unlock the db file here
117             }
118              
119             ###########################################################################
120              
121             sub get_addr_entry {
122 7     7 1 27 my ($self, $addr, $signedby) = @_;
123              
124 7         33 my $entry = {
125             addr => $addr,
126             };
127              
128 7   100     176 $entry->{count} = $self->{accum}->{$addr} || 0;
129 7   100     82 $entry->{totscore} = $self->{accum}->{$addr.'|totscore'} || 0;
130              
131 7         60 dbg("auto-whitelist: db-based $addr scores ".$entry->{count}.'/'.$entry->{totscore});
132 7         34 return $entry;
133             }
134              
135             ###########################################################################
136              
137             sub add_score {
138 5     5 1 14 my($self, $entry, $score) = @_;
139              
140 5   100     25 $entry->{count} ||= 0;
141 5   50     16 $entry->{addr} ||= '';
142              
143 5         19 $entry->{count}++;
144 5         20 $entry->{totscore} += $score;
145              
146 5         28 dbg("auto-whitelist: add_score: new count: ".$entry->{count}.", new totscore: ".$entry->{totscore});
147              
148 5         144 $self->{accum}->{$entry->{addr}} = $entry->{count};
149 5         98 $self->{accum}->{$entry->{addr}.'|totscore'} = $entry->{totscore};
150 5         29 return $entry;
151             }
152              
153             ###########################################################################
154              
155             sub remove_entry {
156 0     0 1   my ($self, $entry) = @_;
157              
158 0           my $addr = $entry->{addr};
159 0           delete $self->{accum}->{$addr};
160 0           delete $self->{accum}->{$addr.'|totscore'};
161              
162 0 0         if ($addr =~ /^(.*)\|ip=none$/) {
163             # it doesn't have an IP attached.
164             # try to delete any per-IP entries for this addr as well.
165             # could be slow...
166 0           my $mailaddr = $1;
167              
168 0           while (my ($key, $value) = each %{$self->{accum}}) {
  0            
169             # regex will catch both key and key|totscore entries and delete them
170 0 0         if ($key =~ /^\Q${mailaddr}\E\|/) {
171 0           delete $self->{accum}->{$key};
172             }
173             }
174             }
175             }
176              
177             ###########################################################################
178              
179             1;