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
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
Mail::SpamAssassin::PerMsgLearner - per-message status (spam or not-spam) |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $spamtest = new Mail::SpamAssassin ({ |
25
|
|
|
|
|
|
|
'rules_filename' => '/etc/spamassassin.rules', |
26
|
|
|
|
|
|
|
'userprefs_filename' => $ENV{HOME}.'/.spamassassin/user_prefs' |
27
|
|
|
|
|
|
|
}); |
28
|
|
|
|
|
|
|
my $mail = $spamtest->parse(); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $status = $spamtest->learn($mail,$id,$isspam,$forget); |
31
|
|
|
|
|
|
|
my $didlearn = $status->did_learn(); |
32
|
|
|
|
|
|
|
$status->finish(); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
The Mail::SpamAssassin C<learn()> method returns an object of this |
38
|
|
|
|
|
|
|
class. This object encapsulates all the per-message state for |
39
|
|
|
|
|
|
|
the learning process. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 METHODS |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=over 4 |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=cut |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
package Mail::SpamAssassin::PerMsgLearner; |
48
|
|
|
|
|
|
|
|
49
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
50
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
51
|
|
|
|
|
|
|
# use bytes; |
52
|
1
|
|
|
1
|
|
5
|
use re 'taint'; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
57
|
|
53
|
|
|
|
|
|
|
|
54
|
1
|
|
|
1
|
|
6
|
use Mail::SpamAssassin; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
19
|
|
55
|
1
|
|
|
1
|
|
3
|
use Mail::SpamAssassin::PerMsgStatus; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
26
|
|
56
|
1
|
|
|
1
|
|
6
|
use Mail::SpamAssassin::Bayes; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
57
|
1
|
|
|
1
|
|
5
|
use Mail::SpamAssassin::Logger; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
454
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
our @ISA = qw(); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
########################################################################### |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub new { |
64
|
2
|
|
|
2
|
0
|
5
|
my $class = shift; |
65
|
2
|
|
33
|
|
|
8
|
$class = ref($class) || $class; |
66
|
2
|
|
|
|
|
4
|
my ($main, $msg) = @_; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $self = { |
69
|
|
|
|
|
|
|
'main' => $main, |
70
|
|
|
|
|
|
|
'msg' => $msg, |
71
|
|
|
|
|
|
|
'learned' => 0, |
72
|
|
|
|
|
|
|
'master_deadline' => $msg->{master_deadline}, # dflt inherited from msg |
73
|
2
|
|
|
|
|
9
|
}; |
74
|
|
|
|
|
|
|
|
75
|
2
|
|
|
|
|
5
|
$self->{conf} = $self->{main}->{conf}; |
76
|
|
|
|
|
|
|
|
77
|
2
|
|
|
|
|
5
|
$self->{bayes_scanner} = $self->{main}->{bayes_scanner}; |
78
|
|
|
|
|
|
|
|
79
|
2
|
|
|
|
|
2
|
bless ($self, $class); |
80
|
2
|
|
|
|
|
5
|
$self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
########################################################################### |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# $status->learn_spam($id) |
86
|
|
|
|
|
|
|
# |
87
|
|
|
|
|
|
|
# Learn the message as spam. |
88
|
|
|
|
|
|
|
# |
89
|
|
|
|
|
|
|
# C<$id> is an optional message-identification string, used internally |
90
|
|
|
|
|
|
|
# to tag the message. If it is C<undef>, one will be generated. |
91
|
|
|
|
|
|
|
# It should be unique to that message. |
92
|
|
|
|
|
|
|
# |
93
|
|
|
|
|
|
|
# This is a semi-private API; callers should use |
94
|
|
|
|
|
|
|
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub learn_spam { |
97
|
0
|
|
|
0
|
0
|
0
|
my ($self, $id) = @_; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# bug 4096 |
100
|
|
|
|
|
|
|
# if ($self->{main}->{learn_with_whitelist}) { |
101
|
|
|
|
|
|
|
# $self->{main}->add_all_addresses_to_blacklist ($self->{msg}); |
102
|
|
|
|
|
|
|
# } |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# use the real message-id here instead of mass-check's idea of an "id", |
105
|
|
|
|
|
|
|
# as we may deliver the msg into another mbox format but later need |
106
|
|
|
|
|
|
|
# to forget it's training. |
107
|
0
|
|
|
|
|
0
|
$self->{learned} = $self->{bayes_scanner}->learn (1, $self->{msg}, $id); |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
########################################################################### |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# $status->learn_ham($id) |
113
|
|
|
|
|
|
|
# |
114
|
|
|
|
|
|
|
# Learn the message as ham. |
115
|
|
|
|
|
|
|
# |
116
|
|
|
|
|
|
|
# C<$id> is an optional message-identification string, used internally |
117
|
|
|
|
|
|
|
# to tag the message. If it is C<undef>, one will be generated. |
118
|
|
|
|
|
|
|
# It should be unique to that message. |
119
|
|
|
|
|
|
|
# |
120
|
|
|
|
|
|
|
# This is a semi-private API; callers should use |
121
|
|
|
|
|
|
|
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
sub learn_ham { |
124
|
2
|
|
|
2
|
0
|
3
|
my ($self, $id) = @_; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# bug 4096 |
127
|
|
|
|
|
|
|
# if ($self->{main}->{learn_with_whitelist}) { |
128
|
|
|
|
|
|
|
# $self->{main}->add_all_addresses_to_whitelist ($self->{msg}); |
129
|
|
|
|
|
|
|
# } |
130
|
|
|
|
|
|
|
|
131
|
2
|
|
|
|
|
14
|
$self->{learned} = $self->{bayes_scanner}->learn (0, $self->{msg}, $id); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
########################################################################### |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# $status->forget($id) |
137
|
|
|
|
|
|
|
# |
138
|
|
|
|
|
|
|
# Forget about a previously-learned message. |
139
|
|
|
|
|
|
|
# |
140
|
|
|
|
|
|
|
# C<$id> is an optional message-identification string, used internally |
141
|
|
|
|
|
|
|
# to tag the message. If it is C<undef>, one will be generated. |
142
|
|
|
|
|
|
|
# It should be unique to that message. |
143
|
|
|
|
|
|
|
# |
144
|
|
|
|
|
|
|
# This is a semi-private API; callers should use |
145
|
|
|
|
|
|
|
# C<$spamtest-E<gt>learn($mail,$id,$isspam,$forget)> instead. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
sub forget { |
148
|
0
|
|
|
0
|
0
|
0
|
my ($self, $id) = @_; |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# bug 4096 |
151
|
|
|
|
|
|
|
# if ($self->{main}->{learn_with_whitelist}) { |
152
|
|
|
|
|
|
|
# $self->{main}->remove_all_addresses_from_whitelist ($self->{msg}); |
153
|
|
|
|
|
|
|
# } |
154
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
0
|
$self->{learned} = $self->{bayes_scanner}->forget ($self->{msg}, $id); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
########################################################################### |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item $didlearn = $status->did_learn() |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Returns C<1> if the message was learned from or forgotten successfully. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=cut |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub did_learn { |
167
|
2
|
|
|
2
|
1
|
5
|
my ($self) = @_; |
168
|
2
|
|
|
|
|
6
|
return ($self->{learned}); |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
########################################################################### |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=item $status->finish() |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Finish with the object. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=cut |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub finish { |
180
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
181
|
2
|
|
|
|
|
2
|
%{$self} = (); |
|
2
|
|
|
|
|
4
|
|
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
########################################################################### |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
1; |
187
|
|
|
|
|
|
|
__END__ |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
=back |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 SEE ALSO |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
C<Mail::SpamAssassin> |
194
|
|
|
|
|
|
|
C<spamassassin> |
195
|
|
|
|
|
|
|
|