← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:04 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/Check.pm
StatementsExecuted 35 statements in 15.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11152µs64µsMail::SpamAssassin::Plugin::Check::::BEGIN@17Mail::SpamAssassin::Plugin::Check::BEGIN@17
11136µs60µsMail::SpamAssassin::Plugin::Check::::newMail::SpamAssassin::Plugin::Check::new
11130µs88µsMail::SpamAssassin::Plugin::Check::::BEGIN@1328Mail::SpamAssassin::Plugin::Check::BEGIN@1328
11130µs170µsMail::SpamAssassin::Plugin::Check::::BEGIN@25Mail::SpamAssassin::Plugin::Check::BEGIN@25
11128µs817µsMail::SpamAssassin::Plugin::Check::::BEGIN@27Mail::SpamAssassin::Plugin::Check::BEGIN@27
11127µs409µsMail::SpamAssassin::Plugin::Check::::BEGIN@21Mail::SpamAssassin::Plugin::Check::BEGIN@21
11126µs91µsMail::SpamAssassin::Plugin::Check::::BEGIN@1167Mail::SpamAssassin::Plugin::Check::BEGIN@1167
11126µs83µsMail::SpamAssassin::Plugin::Check::::BEGIN@408Mail::SpamAssassin::Plugin::Check::BEGIN@408
11124µs60µsMail::SpamAssassin::Plugin::Check::::BEGIN@18Mail::SpamAssassin::Plugin::Check::BEGIN@18
11123µs87µsMail::SpamAssassin::Plugin::Check::::BEGIN@19Mail::SpamAssassin::Plugin::Check::BEGIN@19
11123µs195µsMail::SpamAssassin::Plugin::Check::::BEGIN@24Mail::SpamAssassin::Plugin::Check::BEGIN@24
11122µs149µsMail::SpamAssassin::Plugin::Check::::BEGIN@29Mail::SpamAssassin::Plugin::Check::BEGIN@29
11114µs14µsMail::SpamAssassin::Plugin::Check::::BEGIN@23Mail::SpamAssassin::Plugin::Check::BEGIN@23
11113µs13µsMail::SpamAssassin::Plugin::Check::::BEGIN@26Mail::SpamAssassin::Plugin::Check::BEGIN@26
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:1047]Mail::SpamAssassin::Plugin::Check::__ANON__[:1047]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:1067]Mail::SpamAssassin::Plugin::Check::__ANON__[:1067]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:1087]Mail::SpamAssassin::Plugin::Check::__ANON__[:1087]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:1169]Mail::SpamAssassin::Plugin::Check::__ANON__[:1169]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:1330]Mail::SpamAssassin::Plugin::Check::__ANON__[:1330]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:410]Mail::SpamAssassin::Plugin::Check::__ANON__[:410]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:578]Mail::SpamAssassin::Plugin::Check::__ANON__[:578]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:586]Mail::SpamAssassin::Plugin::Check::__ANON__[:586]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:649]Mail::SpamAssassin::Plugin::Check::__ANON__[:649]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:731]Mail::SpamAssassin::Plugin::Check::__ANON__[:731]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:739]Mail::SpamAssassin::Plugin::Check::__ANON__[:739]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:807]Mail::SpamAssassin::Plugin::Check::__ANON__[:807]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:890]Mail::SpamAssassin::Plugin::Check::__ANON__[:890]
0000s0sMail::SpamAssassin::Plugin::Check::::__ANON__[:967]Mail::SpamAssassin::Plugin::Check::__ANON__[:967]
0000s0sMail::SpamAssassin::Plugin::Check::::add_evalstrMail::SpamAssassin::Plugin::Check::add_evalstr
0000s0sMail::SpamAssassin::Plugin::Check::::add_evalstr2Mail::SpamAssassin::Plugin::Check::add_evalstr2
0000s0sMail::SpamAssassin::Plugin::Check::::add_evalstr_corkedMail::SpamAssassin::Plugin::Check::add_evalstr_corked
0000s0sMail::SpamAssassin::Plugin::Check::::add_temporary_methodMail::SpamAssassin::Plugin::Check::add_temporary_method
0000s0sMail::SpamAssassin::Plugin::Check::::begin_evalstr_chunkMail::SpamAssassin::Plugin::Check::begin_evalstr_chunk
0000s0sMail::SpamAssassin::Plugin::Check::::check_mainMail::SpamAssassin::Plugin::Check::check_main
0000s0sMail::SpamAssassin::Plugin::Check::::do_body_eval_testsMail::SpamAssassin::Plugin::Check::do_body_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_body_testsMail::SpamAssassin::Plugin::Check::do_body_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_full_eval_testsMail::SpamAssassin::Plugin::Check::do_full_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_full_testsMail::SpamAssassin::Plugin::Check::do_full_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_head_eval_testsMail::SpamAssassin::Plugin::Check::do_head_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_head_testsMail::SpamAssassin::Plugin::Check::do_head_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_meta_testsMail::SpamAssassin::Plugin::Check::do_meta_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_rawbody_eval_testsMail::SpamAssassin::Plugin::Check::do_rawbody_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_rawbody_testsMail::SpamAssassin::Plugin::Check::do_rawbody_tests
0000s0sMail::SpamAssassin::Plugin::Check::::do_uri_testsMail::SpamAssassin::Plugin::Check::do_uri_tests
0000s0sMail::SpamAssassin::Plugin::Check::::end_evalstr_chunkMail::SpamAssassin::Plugin::Check::end_evalstr_chunk
0000s0sMail::SpamAssassin::Plugin::Check::::finish_testsMail::SpamAssassin::Plugin::Check::finish_tests
0000s0sMail::SpamAssassin::Plugin::Check::::flush_evalstrMail::SpamAssassin::Plugin::Check::flush_evalstr
0000s0sMail::SpamAssassin::Plugin::Check::::free_ruleset_sourceMail::SpamAssassin::Plugin::Check::free_ruleset_source
0000s0sMail::SpamAssassin::Plugin::Check::::hash_line_for_ruleMail::SpamAssassin::Plugin::Check::hash_line_for_rule
0000s0sMail::SpamAssassin::Plugin::Check::::hit_rule_plugin_codeMail::SpamAssassin::Plugin::Check::hit_rule_plugin_code
0000s0sMail::SpamAssassin::Plugin::Check::::is_user_rule_subMail::SpamAssassin::Plugin::Check::is_user_rule_sub
0000s0sMail::SpamAssassin::Plugin::Check::::pop_evalstr_prefixMail::SpamAssassin::Plugin::Check::pop_evalstr_prefix
0000s0sMail::SpamAssassin::Plugin::Check::::push_evalstr_prefixMail::SpamAssassin::Plugin::Check::push_evalstr_prefix
0000s0sMail::SpamAssassin::Plugin::Check::::ran_rule_plugin_codeMail::SpamAssassin::Plugin::Check::ran_rule_plugin_code
0000s0sMail::SpamAssassin::Plugin::Check::::run_eval_testsMail::SpamAssassin::Plugin::Check::run_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::run_generic_testsMail::SpamAssassin::Plugin::Check::run_generic_tests
0000s0sMail::SpamAssassin::Plugin::Check::::run_rbl_eval_testsMail::SpamAssassin::Plugin::Check::run_rbl_eval_tests
0000s0sMail::SpamAssassin::Plugin::Check::::start_rules_plugin_codeMail::SpamAssassin::Plugin::Check::start_rules_plugin_code
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1=head1 NAME
2
3Mail::SpamAssassin::Plugin::Check - primary message check functionality
4
5=head1 SYNOPSIS
6
7loadplugin Mail::SpamAssassin::Plugin::Check
8
9=head1 DESCRIPTION
10
11This plugin provides the primary message check functionality.
12
13=cut
14
15package Mail::SpamAssassin::Plugin::Check;
16
17271µs275µs
# spent 64µs (52+11) within Mail::SpamAssassin::Plugin::Check::BEGIN@17 which was called: # once (52µs+11µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 17
use strict;
# spent 64µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@17 # spent 11µs making 1 call to strict::import
18273µs297µs
# spent 60µs (24+36) within Mail::SpamAssassin::Plugin::Check::BEGIN@18 which was called: # once (24µs+36µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 18
use warnings;
# spent 60µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@18 # spent 36µs making 1 call to warnings::import
19266µs2150µs
# spent 87µs (23+64) within Mail::SpamAssassin::Plugin::Check::BEGIN@19 which was called: # once (23µs+64µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 19
use re 'taint';
# spent 87µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@19 # spent 64µs making 1 call to re::import
20
21277µs2790µs
# spent 409µs (27+382) within Mail::SpamAssassin::Plugin::Check::BEGIN@21 which was called: # once (27µs+382µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 21
use Time::HiRes qw(time);
# spent 409µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@21 # spent 382µs making 1 call to Time::HiRes::import
22
23272µs114µs
# spent 14µs within Mail::SpamAssassin::Plugin::Check::BEGIN@23 which was called: # once (14µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 23
use Mail::SpamAssassin::Plugin;
# spent 14µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@23
24262µs2366µs
# spent 195µs (23+172) within Mail::SpamAssassin::Plugin::Check::BEGIN@24 which was called: # once (23µs+172µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 24
use Mail::SpamAssassin::Logger;
# spent 195µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@24 # spent 172µs making 1 call to Exporter::import
25282µs2309µs
# spent 170µs (30+140) within Mail::SpamAssassin::Plugin::Check::BEGIN@25 which was called: # once (30µs+140µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 25
use Mail::SpamAssassin::Util qw(untaint_var);
# spent 170µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@25 # spent 140µs making 1 call to Exporter::import
26265µs113µs
# spent 13µs within Mail::SpamAssassin::Plugin::Check::BEGIN@26 which was called: # once (13µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 26
use Mail::SpamAssassin::Timeout;
# spent 13µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@26
27291µs21.61ms
# spent 817µs (28+789) within Mail::SpamAssassin::Plugin::Check::BEGIN@27 which was called: # once (28µs+789µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 27
use Mail::SpamAssassin::Constants qw(:sa);
# spent 817µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@27 # spent 789µs making 1 call to Exporter::import
28
2923.51ms2276µs
# spent 149µs (22+127) within Mail::SpamAssassin::Plugin::Check::BEGIN@29 which was called: # once (22µs+127µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 29
use vars qw(@ISA @TEMPORARY_METHODS);
# spent 149µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@29 # spent 128µs making 1 call to vars::import
30123µs@ISA = qw(Mail::SpamAssassin::Plugin);
31
32# methods defined by the compiled ruleset; deleted in finish_tests()
3312µs@TEMPORARY_METHODS = ();
34
35# constructor
36
# spent 60µs (36+24) within Mail::SpamAssassin::Plugin::Check::new which was called: # once (36µs+24µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 83)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
3713µs my $class = shift;
3812µs my $mailsaobject = shift;
39
4012µs $class = ref($class) || $class;
41113µs124µs my $self = $class->SUPER::new($mailsaobject);
# spent 24µs making 1 call to Mail::SpamAssassin::Plugin::new
4212µs bless ($self, $class);
43
44110µs return $self;
45}
46
47###########################################################################
48
49sub check_main {
50 my ($self, $args) = @_;
51
52 my $pms = $args->{permsgstatus};
53
54 my $suppl_attrib = $pms->{msg}->{suppl_attrib};
55 if (ref $suppl_attrib && ref $suppl_attrib->{rule_hits}) {
56 my @caller_rule_hits = @{$suppl_attrib->{rule_hits}};
57 dbg("check: adding caller rule hits, %d rules", scalar(@caller_rule_hits));
58 for my $caller_rule_hit (@caller_rule_hits) {
59 next if ref $caller_rule_hit ne 'HASH';
60 my($rulename, $area, $score, $defscore, $value,
61 $ruletype, $tflags, $description) =
62 @$caller_rule_hit{qw(rule area score defscore value
63 ruletype tflags descr)};
64 $pms->got_hit($rulename, $area,
65 !defined $score ? () : (score => $score),
66 !defined $defscore ? () : (defscore => $defscore),
67 !defined $value ? () : (value => $value),
68 !defined $tflags ? () : (tflags => $tflags),
69 !defined $description ? () : (description => $description),
70 ruletype => $ruletype);
71 }
72 }
73
74 # bug 4353:
75 # Do this before the RBL tests are kicked off. The metadata parsing
76 # will figure out the (un)trusted relays and such, which are used in the
77 # rbl calls.
78 $pms->extract_message_metadata();
79
80 # Here, we launch all the DNS RBL queries and let them run while we
81 # inspect the message
82 $self->run_rbl_eval_tests($pms);
83 my $needs_dnsbl_harvest_p = 1; # harvest needs to be run
84
85 my $decoded = $pms->get_decoded_stripped_body_text_array();
86 my $bodytext = $pms->get_decoded_body_text_array();
87 my $fulltext = $pms->{msg}->get_pristine();
88 my $master_deadline = $pms->{master_deadline};
89 dbg("check: check_main, time limit in %.3f s",
90 $master_deadline - time) if $master_deadline;
91
92 my @uris = $pms->get_uri_list();
93
94 foreach my $priority (sort { $a <=> $b } keys %{$pms->{conf}->{priorities}}) {
95 # no need to run if there are no priorities at this level. This can
96 # happen in Conf.pm when we switch a rule from one priority to another
97 next unless ($pms->{conf}->{priorities}->{$priority} > 0);
98
99 if ($pms->{deadline_exceeded}) {
100 last;
101 } elsif ($master_deadline && time > $master_deadline) {
102 info("check: exceeded time limit, skipping further tests");
103 $pms->{deadline_exceeded} = 1;
104 last;
105 } elsif ($self->{main}->call_plugins("have_shortcircuited",
106 { permsgstatus => $pms })) {
107 # if shortcircuiting is hit, we skip all other priorities...
108 last;
109 }
110
111 my $timer = $self->{main}->time_method("tests_pri_".$priority);
112 dbg("check: running tests for priority: $priority");
113
114 # only harvest the dnsbl queries once priority HARVEST_DNSBL_PRIORITY
115 # has been reached and then only run once
116 #
117 # TODO: is this block still needed here? is HARVEST_DNSBL_PRIORITY used?
118 #
119 if ($priority >= HARVEST_DNSBL_PRIORITY
120 && $needs_dnsbl_harvest_p
121 && !$self->{main}->call_plugins("have_shortcircuited",
122 { permsgstatus => $pms }))
123 {
124 # harvest the DNS results
125 $pms->harvest_dnsbl_queries();
126 $needs_dnsbl_harvest_p = 0;
127
128 # finish the DNS results
129 $pms->rbl_finish();
130 $self->{main}->call_plugins("check_post_dnsbl", { permsgstatus => $pms });
131 $pms->{resolver}->finish_socket() if $pms->{resolver};
132 }
133
134 $pms->harvest_completed_queries();
135 # allow other, plugin-defined rule types to be called here
136 $self->{main}->call_plugins ("check_rules_at_priority",
137 { permsgstatus => $pms, priority => $priority, checkobj => $self });
138
139 # do head tests
140 $self->do_head_tests($pms, $priority);
141 $pms->harvest_completed_queries();
142 last if $pms->{deadline_exceeded};
143
144 $self->do_head_eval_tests($pms, $priority);
145 $pms->harvest_completed_queries();
146 last if $pms->{deadline_exceeded};
147
148 $self->do_body_tests($pms, $priority, $decoded);
149 $pms->harvest_completed_queries();
150 last if $pms->{deadline_exceeded};
151
152 $self->do_uri_tests($pms, $priority, @uris);
153 $pms->harvest_completed_queries();
154 last if $pms->{deadline_exceeded};
155
156 $self->do_body_eval_tests($pms, $priority, $decoded);
157 $pms->harvest_completed_queries();
158 last if $pms->{deadline_exceeded};
159
160 $self->do_rawbody_tests($pms, $priority, $bodytext);
161 $pms->harvest_completed_queries();
162 last if $pms->{deadline_exceeded};
163
164 $self->do_rawbody_eval_tests($pms, $priority, $bodytext);
165 $pms->harvest_completed_queries();
166 last if $pms->{deadline_exceeded};
167
168 $self->do_full_tests($pms, $priority, \$fulltext);
169 $pms->harvest_completed_queries();
170 last if $pms->{deadline_exceeded};
171
172 $self->do_full_eval_tests($pms, $priority, \$fulltext);
173 $pms->harvest_completed_queries();
174 last if $pms->{deadline_exceeded};
175
176 $self->do_meta_tests($pms, $priority);
177 $pms->harvest_completed_queries();
178 last if $pms->{deadline_exceeded};
179
180 # we may need to call this more often than once through the loop, but
181 # it needs to be done at least once, either at the beginning or the end.
182 $self->{main}->call_plugins ("check_tick", { permsgstatus => $pms });
183 $pms->harvest_completed_queries();
184 last if $pms->{deadline_exceeded};
185 }
186
187 # sanity check, it is possible that no rules >= HARVEST_DNSBL_PRIORITY ran so the harvest
188 # may not have run yet. Check, and if so, go ahead and harvest here.
189 if ($needs_dnsbl_harvest_p) {
190 if (!$self->{main}->call_plugins("have_shortcircuited",
191 { permsgstatus => $pms }))
192 {
193 # harvest the DNS results
194 $pms->harvest_dnsbl_queries();
195 }
196
197 # finish the DNS results
198 $pms->rbl_finish();
199 $self->{main}->call_plugins ("check_post_dnsbl", { permsgstatus => $pms });
200 $pms->{resolver}->finish_socket() if $pms->{resolver};
201 }
202
203 if ($pms->{deadline_exceeded}) {
204 $pms->got_hit('TIME_LIMIT_EXCEEDED', '', defscore => 0.001,
205 description => 'Exceeded time limit / deadline');
206 }
207
208 # finished running rules
209 delete $pms->{current_rule_name};
210 undef $decoded;
211 undef $bodytext;
212 undef $fulltext;
213
214 if ($pms->{deadline_exceeded}) {
215 # dbg("check: exceeded time limit, skipping auto-learning");
216 } elsif ($master_deadline && time > $master_deadline) {
217 info("check: exceeded time limit, skipping auto-learning");
218 $pms->{deadline_exceeded} = 1;
219 } else {
220 # auto-learning
221 $pms->learn();
222 $self->{main}->call_plugins ("check_post_learn", { permsgstatus => $pms });
223 }
224
225 # track user_rules recompilations; each scanned message is 1 tick on this counter
226 if ($self->{done_user_rules}) {
227 my $counters = $pms->{conf}->{want_rebuild_for_type};
228 foreach my $type (keys %{$self->{done_user_rules}}) {
229 if ($counters->{$type} > 0) {
230 $counters->{$type}--;
231 }
232 dbg("rules: user rules done; ticking want_rebuild counter for type $type to ".
233 $counters->{$type});
234 }
235 }
236
237 return 1;
238}
239
240sub finish_tests {
241 my ($self, $params) = @_;
242
243 foreach my $method (@TEMPORARY_METHODS) {
244 undef &{$method};
245 }
246 @TEMPORARY_METHODS = (); # clear for next time
247}
248
249###########################################################################
250
251sub run_rbl_eval_tests {
252 my ($self, $pms) = @_;
253 my ($rulename, $pat, @args);
254
255 # XXX - possible speed up, moving this check out of the subroutine into Check->new()
256 if ($self->{main}->{local_tests_only}) {
257 dbg("rules: local tests only, ignoring RBL eval");
258 return 0;
259 }
260
261 while (my ($rulename, $test) = each %{$pms->{conf}->{rbl_evals}}) {
262 my $score = $pms->{conf}->{scores}->{$rulename};
263 next unless $score;
264
265 %{$pms->{test_log_msgs}} = (); # clear test state
266
267 my ($function, @args) = @{$test};
268
269 my $result;
270 eval {
271 $result = $pms->$function($rulename, @args); 1;
272 } or do {
273 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
274 die "rules: $eval_stat\n" if $eval_stat =~ /__alarm__ignore__/;
275 warn "rules: failed to run $rulename RBL test, skipping:\n".
276 "\t($eval_stat)\n";
277 $pms->{rule_errors}++;
278 next;
279 };
280 }
281}
282
283###########################################################################
284
285sub run_generic_tests {
286 my ($self, $pms, $priority, %opts) = @_;
287
288 my $master_deadline = $pms->{master_deadline};
289 if ($pms->{deadline_exceeded}) {
290 return;
291 } elsif ($master_deadline && time > $master_deadline) {
292 info("check: (run_generic) exceeded time limit, skipping further tests");
293 $pms->{deadline_exceeded} = 1;
294 return;
295 } elsif ($self->{main}->call_plugins("have_shortcircuited",
296 { permsgstatus => $pms })) {
297 return;
298 }
299
300 my $ruletype = $opts{type};
301 dbg("rules: running $ruletype tests; score so far=".$pms->{score});
302 %{$pms->{test_log_msgs}} = (); # clear test state
303
304 my $conf = $pms->{conf};
305 my $doing_user_rules = $conf->{want_rebuild_for_type}->{$opts{consttype}};
306 if ($doing_user_rules) { $self->{done_user_rules}->{$opts{consttype}}++; }
307
308 # clean up priority value so it can be used in a subroutine name
309 my $clean_priority;
310 ($clean_priority = $priority) =~ s/-/neg/;
311 my $package_name = __PACKAGE__;
312 my $methodname = $package_name."::_".$ruletype."_tests_".$clean_priority;
313
314 if (!defined &{$methodname} || $doing_user_rules) {
315
316 # use %nopts for named parameter-passing; it's more friendly
317 # to future-proof subclassing, since new parameters can be added without
318 # breaking third-party subclassed implementations of this plugin.
319 my %nopts = (
320 ruletype => $ruletype,
321 doing_user_rules => $doing_user_rules,
322 priority => $priority,
323 clean_priority => $clean_priority
324 );
325
326 # build up the eval string...
327 $self->{evalstr_methodname} = $methodname;
328 $self->{evalstr_chunk_current_methodname} = undef;
329 $self->{evalstr_chunk_methodnames} = [];
330 $self->{evalstr_chunk_prefix} = []; # stack (array) of source code sections
331 $self->{evalstr} = ''; $self->{evalstr_l} = 0;
332 $self->{evalstr2} = '';
333 $self->begin_evalstr_chunk($pms);
334
335 $self->push_evalstr_prefix($pms, '
336 # start_rules_plugin_code '.$ruletype.' '.$priority.'
337 my $scoresptr = $self->{conf}->{scores};
338 ');
339 if (defined $opts{pre_loop_body}) {
340 $opts{pre_loop_body}->($self, $pms, $conf, %nopts);
341 }
342 $self->add_evalstr($pms,
343 $self->start_rules_plugin_code($ruletype, $priority) );
344 while (my($rulename, $test) = each %{$opts{testhash}->{$priority}}) {
345 $opts{loop_body}->($self, $pms, $conf, $rulename, $test, %nopts);
346 }
347 if (defined $opts{post_loop_body}) {
348 $opts{post_loop_body}->($self, $pms, $conf, %nopts);
349 }
350
351 # dbg("rules: generated matching code:\n".$self->{evalstr});
352
353 $self->flush_evalstr($pms, 'run_generic_tests');
354 $self->free_ruleset_source($pms, $ruletype, $priority);
355
356 # clear out a previous version of this method
357 undef &{$methodname};
358
359 # generate the loop that goes through each line...
360 my $evalstr = <<"EOT";
361 {
362 package $package_name;
363
364 $self->{evalstr2}
365
366 sub $methodname {
367EOT
368
369 for my $chunk_methodname (@{$self->{evalstr_chunk_methodnames}}) {
370 $evalstr .= " $chunk_methodname(\@_);\n";
371 }
372
373 $evalstr .= <<"EOT";
374 }
375
376 1;
377 }
378EOT
379
380 delete $self->{evalstr}; # free up some RAM before we eval()
381 delete $self->{evalstr2};
382 delete $self->{evalstr_methodname};
383 delete $self->{evalstr_chunk_current_methodname};
384 delete $self->{evalstr_chunk_methodnames};
385 delete $self->{evalstr_chunk_prefix};
386
387 dbg("rules: run_generic_tests - compiling eval code: %s, priority %s",
388 $ruletype, $priority);
389 # dbg("rules: eval code to compile: %s", $evalstr);
390 my $eval_result;
391 { my $timer = $self->{main}->time_method('compile_gen');
392 $eval_result = eval($evalstr);
393 }
394 if (!$eval_result) {
395 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
396 warn "rules: failed to compile $ruletype tests, skipping:\n".
397 "\t($eval_stat)\n";
398 $pms->{rule_errors}++;
399 return;
400 }
401 dbg("rules: compiled $ruletype tests");
402 }
403
404#run_compiled_method:
405# dbg("rules: run_generic_tests - calling %s", $methodname);
406 my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });
407 my $err = $t->run(sub {
40828.39ms2139µs
# spent 83µs (26+57) within Mail::SpamAssassin::Plugin::Check::BEGIN@408 which was called: # once (26µs+57µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 408
no strict "refs";
# spent 83µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@408 # spent 57µs making 1 call to strict::unimport
409 $methodname->($pms, @{$opts{args}});
410 });
411 if ($t->timed_out() && $master_deadline && time > $master_deadline) {
412 info("check: exceeded time limit in $methodname, skipping further tests");
413 $pms->{deadline_exceeded} = 1;
414 }
415}
416
417sub begin_evalstr_chunk {
418 my ($self, $pms) = @_;
419 my $n = 0;
420 if ($self->{evalstr_chunk_methodnames}) {
421 $n = scalar(@{$self->{evalstr_chunk_methodnames}});
422 }
423 my $chunk_methodname = sprintf("%s_%d", $self->{evalstr_methodname}, $n+1);
424# dbg("rules: begin_evalstr_chunk %s", $chunk_methodname);
425 undef &{$chunk_methodname};
426 my $package_name = __PACKAGE__;
427 my $evalstr = <<"EOT";
428package $package_name;
429sub $chunk_methodname {
430 my \$self = shift;
431 my \$hits = 0;
432EOT
433 $evalstr .= ' '.$_ for @{$self->{evalstr_chunk_prefix}};
434 $self->{evalstr} = $evalstr;
435 $self->{evalstr_l} = length($evalstr);
436 $self->{evalstr_chunk_current_methodname} = $chunk_methodname;
437}
438
439sub end_evalstr_chunk {
440 my ($self, $pms) = @_;
441# dbg("rules: end_evalstr_chunk");
442 my $evalstr = "}; 1;\n";
443 $self->{evalstr} .= $evalstr;
444 $self->{evalstr_l} += length($evalstr);
445}
446
447sub flush_evalstr {
448 my ($self, $pms, $caller_name) = @_;
449 my $chunk_methodname = $self->{evalstr_chunk_current_methodname};
450 $self->end_evalstr_chunk($pms);
451 dbg("rules: flush_evalstr (%s) compiling %d chars of %s",
452 $caller_name, $self->{evalstr_l}, $chunk_methodname);
453# dbg("rules: eval code(2): %s", $self->{evalstr});
454 my $eval_result;
455 { my $timer = $self->{main}->time_method('compile_gen');
456 $eval_result = eval($self->{evalstr});
457 }
458 if (!$eval_result) {
459 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
460 warn "rules: failed to compile $chunk_methodname, skipping:\n".
461 "\t($eval_stat)\n";
462 $pms->{rule_errors}++;
463 } else {
464 push(@{$self->{evalstr_chunk_methodnames}}, $chunk_methodname);
465 }
466 $self->{evalstr} = ''; $self->{evalstr_l} = 0;
467 $self->begin_evalstr_chunk($pms);
468}
469
470sub push_evalstr_prefix {
471 my ($self, $pms, $str) = @_;
472 $self->add_evalstr_corked($pms, $str); # must not flush!
473 push(@{$self->{evalstr_chunk_prefix}}, $str);
474# dbg("rules: push_evalstr_prefix (%d) - <%s>",
475# scalar(@{$self->{evalstr_chunk_prefix}}), $str);
476}
477
478sub pop_evalstr_prefix {
479 my ($self) = @_;
480 pop(@{$self->{evalstr_chunk_prefix}});
481# dbg("rules: pop_evalstr_prefix (%d)",
482# scalar(@{$self->{evalstr_chunk_prefix}}));
483}
484
485sub add_evalstr {
486 my ($self, $pms, $str) = @_;
487 if (defined $str && $str ne '') {
488 my $new_code_l = length($str);
489 # dbg("rules: add_evalstr %d - <%s>", $new_code_l, $str);
490 $self->{evalstr} .= $str;
491 $self->{evalstr_l} += $new_code_l;
492 if ($self->{evalstr_l} > 60000) {
493 $self->flush_evalstr($pms, 'add_evalstr');
494 }
495 }
496}
497
498# similar to add_evalstr, but avoids flushing on size
499sub add_evalstr_corked {
500 my ($self, $pms, $str) = @_;
501 if (defined $str) {
502 my $new_code_l = length($str);
503 $self->{evalstr} .= $str;
504 $self->{evalstr_l} += $new_code_l;
505 }
506}
507
508sub add_evalstr2 {
509 my ($self, $str) = @_;
510 $self->{evalstr2} .= $str;
511}
512
513sub add_temporary_method {
514 my ($self, $methodname, $methodbody) = @_;
515 $self->add_evalstr2 (' sub '.$methodname.' { '.$methodbody.' } ');
516 push (@TEMPORARY_METHODS, $methodname);
517}
518
519###########################################################################
520
521sub do_meta_tests {
522 my ($self, $pms, $priority) = @_;
523 my (%rule_deps, %meta, $rulename);
524
525 $self->run_generic_tests ($pms, $priority,
526 consttype => $Mail::SpamAssassin::Conf::TYPE_META_TESTS,
527 type => 'meta',
528 testhash => $pms->{conf}->{meta_tests},
529 args => [ ],
530 loop_body => sub
531 {
532 my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
533 $rule = untaint_var($rule); # presumably checked
534
535 # Lex the rule into tokens using a rather simple RE method ...
536 my $lexer = ARITH_EXPRESSION_LEXER;
537 my @tokens = ($rule =~ m/$lexer/g);
538
539 # Set the rule blank to start
540 $meta{$rulename} = "";
541
542 # List dependencies that are meta tests in the same priority band
543 $rule_deps{$rulename} = [ ];
544
545 # Go through each token in the meta rule
546 foreach my $token (@tokens) {
547
548 # Numbers can't be rule names
549 # if ($token =~ /^(?:\W+|[+-]?\d+(?:\.\d+)?)$/) {
550 if ($token !~ /^[A-Za-z_][A-Za-z0-9_]*\z/s) { # faster
551 $meta{$rulename} .= "$token ";
552 }
553 else { # token is a rule name
554 # the " || 0" formulation is to avoid "use of uninitialized value"
555 # warnings; this is better than adding a 0 to a hash for every
556 # rule referred to in a meta...
557 $meta{$rulename} .= "(\$h->{'$token'} || 0) ";
558
559 if (!exists $conf->{scores}->{$token}) {
560 dbg("rules: meta test $rulename has undefined dependency '$token'");
561 }
562 elsif ($conf->{scores}->{$token} == 0) {
563 # bug 5040: net rules in a non-net scoreset
564 # there are some cases where this is expected; don't warn
565 # in those cases.
566 unless ((($conf->get_score_set()) & 1) == 0 &&
567 ($conf->{tflags}->{$token}||'') =~ /\bnet\b/)
568 {
569 info("rules: meta test $rulename has dependency '$token' with a zero score");
570 }
571 }
572
573 # If the token is another meta rule, add it as a dependency
574 push (@{ $rule_deps{$rulename} }, $token)
575 if (exists $conf->{meta_tests}->{$opts{priority}}->{$token});
576 }
577 }
578 },
579 pre_loop_body => sub
580 {
581 my ($self, $pms, $conf, %opts) = @_;
582 $self->push_evalstr_prefix($pms, '
583 my $r;
584 my $h = $self->{tests_already_hit};
585 ');
586 },
587 post_loop_body => sub
588 {
589 my ($self, $pms, $conf, %opts) = @_;
590
591 # Sort by length of dependencies list. It's more likely we'll get
592 # the dependencies worked out this way.
593 my @metas = sort { @{ $rule_deps{$a} } <=> @{ $rule_deps{$b} } }
594 keys %{$conf->{meta_tests}->{$opts{priority}}};
595
596 my $count;
597 my $tflags = $conf->{tflags};
598
599 # Now go ahead and setup the eval string
600 do {
601 $count = $#metas;
602 my %metas = map { $_ => 1 } @metas; # keep a small cache for fast lookups
603
604 # Go through each meta rule we haven't done yet
605 for (my $i = 0 ; $i <= $#metas ; $i++) {
606
607 # If we depend on meta rules that haven't run yet, skip it
608 next if (grep( $metas{$_}, @{ $rule_deps{ $metas[$i] } }));
609
610 # If we depend on network tests, call ensure_rules_are_complete()
611 # to block until they are
612 if (!defined $conf->{meta_dependencies}->{ $metas[$i] }) {
613 warn "no meta_dependencies defined for $metas[$i]";
614 }
615 my $alldeps = join ' ', grep {
616 ($tflags->{$_}||'') =~ /\bnet\b/
617 } split (' ', $conf->{meta_dependencies}->{ $metas[$i] } );
618
619 if ($alldeps ne '') {
620 $self->add_evalstr($pms, '
621 $self->ensure_rules_are_complete(q{'.$metas[$i].'}, qw{'.$alldeps.'});
622 ');
623 }
624
625 # Add this meta rule to the eval line
626 $self->add_evalstr($pms, '
627 $r = '.$meta{$metas[$i]}.';
628 if ($r) { $self->got_hit(q#'.$metas[$i].'#, "", ruletype => "meta", value => $r); }
629 ');
630
631 splice @metas, $i--, 1; # remove this rule from our list
632 }
633 } while ($#metas != $count && $#metas > -1); # run until we can't go anymore
634
635 # If there are any rules left, we can't solve the dependencies so complain
636 my %metas = map { $_ => 1 } @metas; # keep a small cache for fast lookups
637 foreach my $rulename_t (@metas) {
638 $pms->{rule_errors}++; # flag to --lint that there was an error ...
639 my $msg =
640 "rules: excluding meta test $rulename_t, unsolved meta dependencies: " .
641 join(", ", grep($metas{$_}, @{ $rule_deps{$rulename_t} }));
642 if ($self->{main}->{lint_rules}) {
643 warn $msg."\n";
644 }
645 else {
646 info($msg);
647 }
648 }
649 }
650 );
651}
652
653###########################################################################
654
655sub do_head_tests {
656 my ($self, $pms, $priority) = @_;
657 # hash to hold the rules, "header\tdefault value" => rulename
658 my %ordered;
659 my %testcode; # tuples: [op_type, op, arg]
660 # op_type: 1=infix, 0:prefix/function
661 # op: operator, e.g. '=~', '!~', or a function like 'defined'
662 # arg: additional argument like a regexp for a patt matching op
663
664 $self->run_generic_tests ($pms, $priority,
665 consttype => $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS,
666 type => 'head',
667 testhash => $pms->{conf}->{head_tests},
668 args => [ ],
669 loop_body => sub
670 {
671 my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
672 my $def;
673 $rule = untaint_var($rule); # presumably checked
674 my ($hdrname, $op, $op_infix, $pat);
675 if ($rule =~ /^\s* (\S+) \s* ([=!]~) \s* (\S .*? \S) \s*$/x) {
676 ($hdrname, $op, $pat) = ($1,$2,$3); # e.g.: Subject =~ /patt/
677 $op_infix = 1;
678 if (!defined $pat) {
679 warn "rules: invalid rule: $rulename\n";
680 $pms->{rule_errors}++;
681 next;
682 }
683 if ($pat =~ s/\s+\[if-unset:\s+(.+)\]\s*$//) { $def = $1 }
684 } elsif ($rule =~ /^\s* (\S+) \s* \( \s* (\S+) \s* \) \s*$/x) {
685 # implements exists:name_of_header (and similar function or prefix ops)
686 ($hdrname, $op) = ($2,$1); # e.g.: !defined(Subject)
687 $op_infix = 0;
688 } else {
689 warn "rules: unrecognized rule: $rulename\n";
690 $pms->{rule_errors}++;
691 next;
692 }
693
694 push(@{ $ordered{$hdrname . (!defined $def ? '' : "\t".$def)} },
695 $rulename);
696
697 next if ($opts{doing_user_rules} &&
698 !$self->is_user_rule_sub($rulename.'_head_test'));
699
700 # caller can set this member of the Mail::SpamAssassin object to
701 # override this; useful for profiling rule runtimes, although I think
702 # the HitFreqsRuleTiming.pm plugin is probably better nowadays anyway
703 if ($self->{main}->{use_rule_subs}) {
704 my $matching_string_unavailable = 0;
705 my $expr;
706 if ($op =~ /^!?[A-Za-z_]+$/) { # function or its negation
707 $expr = $op . '($text)';
708 $matching_string_unavailable = 1;
709 } else { # infix operator
710 $expr = '$text ' . $op . ' ' . $pat;
711 if ($op eq '=~' || $op eq '!~') {
712 $expr .= 'g';
713 } else {
714 $matching_string_unavailable = 1;
715 }
716 }
717 $self->add_temporary_method ($rulename.'_head_test', '{
718 my($self,$text) = @_;
719 '.$self->hash_line_for_rule($pms, $rulename).'
720 while ('.$expr.') {
721 $self->got_hit(q{'.$rulename.'}, "", ruletype => "header");
722 '. $self->hit_rule_plugin_code($pms, $rulename, "header", "last",
723 $matching_string_unavailable) . '
724 }
725 }');
726 }
727 else {
728 # store for use below
729 $testcode{$rulename} = [$op_infix, $op, $pat];
730 }
731 },
732 pre_loop_body => sub
733 {
734 my ($self, $pms, $conf, %opts) = @_;
735 $self->push_evalstr_prefix($pms, '
736 no warnings q(uninitialized);
737 my $hval;
738 ');
739 },
740 post_loop_body => sub
741 {
742 my ($self, $pms, $conf, %opts) = @_;
743 # setup the function to run the rules
744 while(my($k,$v) = each %ordered) {
745 my($hdrname, $def) = split(/\t/, $k, 2);
746 $self->push_evalstr_prefix($pms, '
747 $hval = $self->get(q{'.$hdrname.'}, ' .
748 (!defined($def) ? 'undef' : 'q{'.$def.'}') . ');
749 ');
750 foreach my $rulename (@{$v}) {
751 if ($self->{main}->{use_rule_subs}) {
752 $self->add_evalstr($pms, '
753 if ($scoresptr->{q{'.$rulename.'}}) {
754 '.$rulename.'_head_test($self, $hval);
755 '.$self->ran_rule_plugin_code($rulename, "header").'
756 }
757 ');
758 }
759 else {
760 my $tc_ref = $testcode{$rulename};
761 my ($op_infix, $op, $pat);
762 ($op_infix, $op, $pat) = @$tc_ref if defined $tc_ref;
763
764 my $posline = '';
765 my $ifwhile = 'if';
766 my $hitdone = '';
767 my $matchg = '';
768 my $whlimit = '';
769
770 my $matching_string_unavailable = 0;
771 my $expr;
772 if (!$op_infix) { # function or its negation
773 $expr = $op . '($hval)';
774 $matching_string_unavailable = 1;
775 }
776 else { # infix operator
777 if (! ($op eq '=~' || $op eq '!~') ) { # not a pattern matching op.
778 $matching_string_unavailable = 1;
779 } elsif ( ($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/ ) {
780 $posline = 'pos $hval = 0; $hits = 0;';
781 $ifwhile = 'while';
782 $hitdone = 'last';
783 $matchg = 'g';
784 my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
785 $max = untaint_var($max);
786 $whlimit = ' && $hits++ < '.$max if $max;
787 }
788 $expr = '$hval ' . $op . ' ' . $pat . $matchg;
789 }
790
791 $self->add_evalstr($pms, '
792 if ($scoresptr->{q{'.$rulename.'}}) {
793 '.$posline.'
794 '.$self->hash_line_for_rule($pms, $rulename).'
795 '.$ifwhile.' ('.$expr.$whlimit.') {
796 $self->got_hit(q{'.$rulename.'}, "", ruletype => "header");
797 '.$self->hit_rule_plugin_code($pms, $rulename, "header", $hitdone,
798 $matching_string_unavailable).'
799 }
800 '.$self->ran_rule_plugin_code($rulename, "header").'
801 }
802 ');
803 }
804 }
805 $self->pop_evalstr_prefix();
806 }
807 }
808 );
809}
810
811###########################################################################
812
813sub do_body_tests {
814 my ($self, $pms, $priority, $textary) = @_;
815 my $loopid = 0;
816
817 $self->run_generic_tests ($pms, $priority,
818 consttype => $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS,
819 type => 'body',
820 testhash => $pms->{conf}->{body_tests},
821 args => [ @$textary ],
822 loop_body => sub
823 {
824 my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
825 $pat = untaint_var($pat); # presumably checked
826 my $sub = '';
827 if (would_log('dbg', 'rules-all') == 2) {
828 $sub .= '
829 dbg("rules-all: running body rule %s", q{'.$rulename.'});
830 ';
831 }
832 if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
833 {
834 # support multiple matches
835 $loopid++;
836 my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
837 $max = untaint_var($max);
838 $sub .= '
839 $hits = 0;
840 body_'.$loopid.': foreach my $l (@_) {
841 pos $l = 0;
842 '.$self->hash_line_for_rule($pms, $rulename).'
843 while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') {
844 $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body");
845 '. $self->hit_rule_plugin_code($pms, $rulename, 'body',
846 "last body_".$loopid) . '
847 }
848 '. ($max? 'last body_'.$loopid.' if $hits > '. $max .';':'') .'
849 }
850 ';
851 }
852 else {
853 # omitting the "pos" call, "body_loopid" label, use of while()
854 # instead of if() etc., shaves off 8 perl OPs.
855 $sub .= '
856 foreach my $l (@_) {
857 '.$self->hash_line_for_rule($pms, $rulename).'
858 if ($l =~ '.$pat.') {
859 $self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body");
860 '. $self->hit_rule_plugin_code($pms, $rulename, "body", "last") .'
861 }
862 }
863 ';
864 }
865
866 if ($self->{main}->{use_rule_subs}) {
867 $self->add_evalstr($pms, '
868 if ($scoresptr->{q{'.$rulename.'}}) {
869 '.$rulename.'_body_test($self,@_);
870 '.$self->ran_rule_plugin_code($rulename, "body").'
871 }
872 ');
873 }
874 else {
875 $self->add_evalstr($pms, '
876 if ($scoresptr->{q{'.$rulename.'}}) {
877 '.$sub.'
878 '.$self->ran_rule_plugin_code($rulename, "body").'
879 }
880 ');
881 }
882
883 next if ($opts{doing_user_rules} &&
884 !$self->is_user_rule_sub($rulename.'_body_test'));
885
886 if ($self->{main}->{use_rule_subs}) {
887 $self->add_temporary_method ($rulename.'_body_test',
888 '{ my $self = shift; '.$sub.' }');
889 }
890 }
891 );
892}
893
894###########################################################################
895
896sub do_uri_tests {
897 my ($self, $pms, $priority, @uris) = @_;
898 my $loopid = 0;
899 $self->run_generic_tests ($pms, $priority,
900 consttype => $Mail::SpamAssassin::Conf::TYPE_URI_TESTS,
901 type => 'uri',
902 testhash => $pms->{conf}->{uri_tests},
903 args => [ @uris ],
904 loop_body => sub
905 {
906 my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
907 $pat = untaint_var($pat); # presumably checked
908 my $sub = '';
909 if (would_log('dbg', 'rules-all') == 2) {
910 $sub .= '
911 dbg("rules-all: running uri rule %s", q{'.$rulename.'});
912 ';
913 }
914 if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/) {
915 $loopid++;
916 my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
917 $max = untaint_var($max);
918 $sub .= '
919 $hits = 0;
920 uri_'.$loopid.': foreach my $l (@_) {
921 pos $l = 0;
922 '.$self->hash_line_for_rule($pms, $rulename).'
923 while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') {
924 $self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
925 '. $self->hit_rule_plugin_code($pms, $rulename, "uri",
926 "last uri_".$loopid) . '
927 }
928 '. ($max? 'last uri_'.$loopid.' if $hits > '. $max .';':'') .'
929 }
930 ';
931 } else {
932 $sub .= '
933 foreach my $l (@_) {
934 '.$self->hash_line_for_rule($pms, $rulename).'
935 if ($l =~ '.$pat.') {
936 $self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
937 '. $self->hit_rule_plugin_code($pms, $rulename, "uri", "last") .'
938 }
939 }
940 ';
941 }
942
943 if ($self->{main}->{use_rule_subs}) {
944 $self->add_evalstr($pms, '
945 if ($scoresptr->{q{'.$rulename.'}}) {
946 '.$rulename.'_uri_test($self, @_);
947 '.$self->ran_rule_plugin_code($rulename, "uri").'
948 }
949 ');
950 }
951 else {
952 $self->add_evalstr($pms, '
953 if ($scoresptr->{q{'.$rulename.'}}) {
954 '.$sub.'
955 '.$self->ran_rule_plugin_code($rulename, "uri").'
956 }
957 ');
958 }
959
960 next if ($opts{doing_user_rules} &&
961 !$self->is_user_rule_sub($rulename.'_uri_test'));
962
963 if ($self->{main}->{use_rule_subs}) {
964 $self->add_temporary_method ($rulename.'_uri_test',
965 '{ my $self = shift; '.$sub.' }');
966 }
967 }
968 );
969}
970
971###########################################################################
972
973sub do_rawbody_tests {
974 my ($self, $pms, $priority, $textary) = @_;
975 my $loopid = 0;
976 $self->run_generic_tests ($pms, $priority,
977 consttype => $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS,
978 type => 'rawbody',
979 testhash => $pms->{conf}->{rawbody_tests},
980 args => [ @$textary ],
981 loop_body => sub
982 {
983 my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
984 $pat = untaint_var($pat); # presumably checked
985 my $sub = '';
986 if (would_log('dbg', 'rules-all') == 2) {
987 $sub .= '
988 dbg("rules-all: running rawbody rule %s", q{'.$rulename.'});
989 ';
990 }
991 if (($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
992 {
993 # support multiple matches
994 $loopid++;
995 my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
996 $max = untaint_var($max);
997 $sub .= '
998 $hits = 0;
999 rawbody_'.$loopid.': foreach my $l (@_) {
1000 pos $l = 0;
1001 '.$self->hash_line_for_rule($pms, $rulename).'
1002 while ($l =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') {
1003 $self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
1004 '. $self->hit_rule_plugin_code($pms, $rulename, "rawbody",
1005 "last rawbody_".$loopid) . '
1006 }
1007 '. ($max? 'last rawbody_'.$loopid.' if $hits > '. $max .';':'') .'
1008 }
1009 ';
1010 }
1011 else {
1012 $sub .= '
1013 foreach my $l (@_) {
1014 '.$self->hash_line_for_rule($pms, $rulename).'
1015 if ($l =~ '.$pat.') {
1016 $self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
1017 '. $self->hit_rule_plugin_code($pms, $rulename, "rawbody", "last") . '
1018 }
1019 }
1020 ';
1021 }
1022
1023 if ($self->{main}->{use_rule_subs}) {
1024 $self->add_evalstr($pms, '
1025 if ($scoresptr->{q{'.$rulename.'}}) {
1026 '.$rulename.'_rawbody_test($self, @_);
1027 '.$self->ran_rule_plugin_code($rulename, "rawbody").'
1028 }
1029 ');
1030 }
1031 else {
1032 $self->add_evalstr($pms, '
1033 if ($scoresptr->{q{'.$rulename.'}}) {
1034 '.$sub.'
1035 '.$self->ran_rule_plugin_code($rulename, "rawbody").'
1036 }
1037 ');
1038 }
1039
1040 next if ($opts{doing_user_rules} &&
1041 !$self->is_user_rule_sub($rulename.'_rawbody_test'));
1042
1043 if ($self->{main}->{use_rule_subs}) {
1044 $self->add_temporary_method ($rulename.'_rawbody_test',
1045 '{ my $self = shift; '.$sub.' }');
1046 }
1047 }
1048 );
1049}
1050
1051###########################################################################
1052
1053sub do_full_tests {
1054 my ($self, $pms, $priority, $fullmsgref) = @_;
1055 my $loopid = 0;
1056 $self->run_generic_tests ($pms, $priority,
1057 consttype => $Mail::SpamAssassin::Conf::TYPE_FULL_TESTS,
1058 type => 'full',
1059 testhash => $pms->{conf}->{full_tests},
1060 args => [ $fullmsgref ],
1061 pre_loop_body => sub
1062 {
1063 my ($self, $pms, $conf, %opts) = @_;
1064 $self->push_evalstr_prefix($pms, '
1065 my $fullmsgref = shift;
1066 ');
1067 },
1068 loop_body => sub
1069 {
1070 my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
1071 $pat = untaint_var($pat); # presumably checked
1072 my ($max) = ($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmaxhits=(\d+)\b/;
1073 $max = untaint_var($max);
1074 $self->add_evalstr($pms, '
1075 if ($scoresptr->{q{'.$rulename.'}}) {
1076 pos $$fullmsgref = 0;
1077 '.$self->hash_line_for_rule($pms, $rulename).'
1078 dbg("rules-all: running full rule %s", q{'.$rulename.'});
1079 $hits = 0;
1080 while ($$fullmsgref =~ '.$pat.'g'. ($max? ' && $hits++ < '.$max:'') .') {
1081 $self->got_hit(q{'.$rulename.'}, "FULL: ", ruletype => "full");
1082 '. $self->hit_rule_plugin_code($pms, $rulename, "full", "last") . '
1083 }
1084 '.$self->ran_rule_plugin_code($rulename, "full").'
1085 }
1086 ');
1087 }
1088 );
1089}
1090
1091###########################################################################
1092
1093sub do_head_eval_tests {
1094 my ($self, $pms, $priority) = @_;
1095 return unless (defined($pms->{conf}->{head_evals}->{$priority}));
1096 dbg("rules: running head_eval tests; score so far=".$pms->{score});
1097 $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS,
1098 $pms->{conf}->{head_evals}->{$priority}, '', $priority);
1099}
1100
1101sub do_body_eval_tests {
1102 my ($self, $pms, $priority, $bodystring) = @_;
1103 return unless (defined($pms->{conf}->{body_evals}->{$priority}));
1104 dbg("rules: running body_eval tests; score so far=".$pms->{score});
1105 $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS,
1106 $pms->{conf}->{body_evals}->{$priority}, 'BODY: ',
1107 $priority, $bodystring);
1108}
1109
1110sub do_rawbody_eval_tests {
1111 my ($self, $pms, $priority, $bodystring) = @_;
1112 return unless (defined($pms->{conf}->{rawbody_evals}->{$priority}));
1113 dbg("rules: running rawbody_eval tests; score so far=".$pms->{score});
1114 $self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_RAWBODY_EVALS,
1115 $pms->{conf}->{rawbody_evals}->{$priority}, 'RAW: ',
1116 $priority, $bodystring);
1117}
1118
1119sub do_full_eval_tests {
1120 my ($self, $pms, $priority, $fullmsgref) = @_;
1121 return unless (defined($pms->{conf}->{full_evals}->{$priority}));
1122 dbg("rules: running full_eval tests; score so far=".$pms->{score});
1123 $self->run_eval_tests($pms, $Mail::SpamAssassin::Conf::TYPE_FULL_EVALS,
1124 $pms->{conf}->{full_evals}->{$priority}, '',
1125 $priority, $fullmsgref);
1126}
1127
1128sub run_eval_tests {
1129 my ($self, $pms, $testtype, $evalhash, $prepend2desc, $priority, @extraevalargs) = @_;
1130
1131 my $master_deadline = $pms->{master_deadline};
1132 if ($pms->{deadline_exceeded}) {
1133 return;
1134 } elsif ($master_deadline && time > $master_deadline) {
1135 info("check: (run_eval) exceeded time limit, skipping further tests");
1136 $pms->{deadline_exceeded} = 1;
1137 return;
1138 } elsif ($self->{main}->call_plugins("have_shortcircuited",
1139 { permsgstatus => $pms })) {
1140 return;
1141 }
1142
1143 my $conf = $pms->{conf};
1144 my $doing_user_rules = $conf->{want_rebuild_for_type}->{$testtype};
1145 if ($doing_user_rules) { $self->{done_user_rules}->{$testtype}++; }
1146
1147 # clean up priority value so it can be used in a subroutine name
1148 my $clean_priority;
1149 ($clean_priority = $priority) =~ s/-/neg/;
1150 my $scoreset = $conf->get_score_set();
1151 my $package_name = __PACKAGE__;
1152
1153 my $methodname = '_eval_tests'.
1154 '_type'.$testtype .
1155 '_pri'.$clean_priority .
1156 '_set'.$scoreset;
1157
1158 # Some of the rules are scoreset specific, so we need additional
1159 # subroutines to handle those
1160 if (defined &{"${package_name}::${methodname}"}
1161 && !$doing_user_rules)
1162 {
1163 my $method = "${package_name}::${methodname}";
1164 # dbg("rules: run_eval_tests - calling previously compiled %s", $method);
1165 my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });
1166 my $err = $t->run(sub {
116721.14ms2156µs
# spent 91µs (26+65) within Mail::SpamAssassin::Plugin::Check::BEGIN@1167 which was called: # once (26µs+65µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1167
no strict "refs";
# spent 91µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@1167 # spent 65µs making 1 call to strict::unimport
1168 &{$method}($pms,@extraevalargs);
1169 });
1170 if ($t->timed_out() && $master_deadline && time > $master_deadline) {
1171 info("check: exceeded time limit in $method, skipping further tests");
1172 $pms->{deadline_exceeded} = 1;
1173 }
1174 return;
1175 }
1176
1177 # look these up once in advance to save repeated lookups in loop below
1178 my $tflagsref = $conf->{tflags};
1179 my $eval_pluginsref = $conf->{eval_plugins};
1180 my $have_start_rules = $self->{main}->have_plugin("start_rules");
1181 my $have_ran_rule = $self->{main}->have_plugin("ran_rule");
1182
1183 # the buffer for the evaluated code
1184 my $evalstr = q{ };
1185 $evalstr .= q{ my $function; };
1186
1187 # conditionally include the dbg in the eval str
1188 my $dbgstr = q{ };
1189 if (would_log('dbg')) {
1190 $dbgstr = q{
1191 dbg("rules: ran eval rule $rulename ======> got hit ($result)");
1192 };
1193 }
1194
1195 while (my ($rulename, $test) = each %{$evalhash}) {
1196 if ($tflagsref->{$rulename}) {
1197 # If the rule is a net rule, and we are in a non-net scoreset, skip it.
1198 if ($tflagsref->{$rulename} =~ /\bnet\b/) {
1199 next if (($scoreset & 1) == 0);
1200 }
1201 # If the rule is a bayes rule, and we are in a non-bayes scoreset, skip it.
1202 if ($tflagsref->{$rulename} =~ /\blearn\b/) {
1203 next if (($scoreset & 2) == 0);
1204 }
1205 }
1206
1207 $test = untaint_var($test); # presumably checked
1208 my ($function, $argstr) = ($test,'');
1209 if ($test =~ s/^([^,]+)(,.*)$//gs) {
1210 ($function, $argstr) = ($1,$2);
1211 }
1212
1213 if (!$function) {
1214 warn "rules: error: no function defined for $rulename";
1215 next;
1216 }
1217
1218 $evalstr .= '
1219 if ($scoresptr->{q#'.$rulename.'#}) {
1220 $rulename = q#'.$rulename.'#;
1221 %{$self->{test_log_msgs}} = ();
1222 ';
1223
1224 # only need to set current_rule_name for plugin evals
1225 if ($eval_pluginsref->{$function}) {
1226 # let plugins get the name of the rule that is currently being run,
1227 # and ensure their eval functions exist
1228 $evalstr .= '
1229
1230 $self->{current_rule_name} = $rulename;
1231 $self->register_plugin_eval_glue(q#'.$function.'#);
1232
1233 ';
1234 }
1235
1236 # this stuff is quite slow, and totally superfluous if
1237 # no plugin is loaded for those hooks
1238 if ($have_start_rules) {
1239 # XXX - should we use helper function here?
1240 $evalstr .= '
1241
1242 $self->{main}->call_plugins("start_rules", {
1243 permsgstatus => $self,
1244 ruletype => "eval",
1245 priority => '.$priority.'
1246 });
1247
1248 ';
1249 }
1250
1251 $evalstr .= '
1252
1253 eval {
1254 $result = $self->' . $function . ' (@extraevalargs '. $argstr .' ); 1;
1255 } or do {
1256 $result = 0;
1257 die "rules: $@\n" if $@ =~ /__alarm__ignore__/;
1258 $self->handle_eval_rule_errors($rulename);
1259 };
1260
1261 ';
1262
1263 if ($have_ran_rule) {
1264 # XXX - should we use helper function here?
1265 $evalstr .= '
1266
1267 $self->{main}->call_plugins("ran_rule", {
1268 permsgstatus => $self, ruletype => "eval", rulename => $rulename
1269 });
1270
1271 ';
1272 }
1273
1274 $evalstr .= '
1275
1276 if ($result) {
1277 $self->got_hit($rulename, $prepend2desc, ruletype => "eval", value => $result);
1278 '.$dbgstr.'
1279 }
1280 }
1281 ';
1282 }
1283
1284 # don't free the eval ruleset here -- we need it in the compiled code!
1285
1286 # nothing done in the loop, that means no rules
1287 return unless ($evalstr);
1288
1289 $evalstr = <<"EOT";
1290{
1291 package $package_name;
1292
1293 sub ${methodname} {
1294 my (\$self, \@extraevalargs) = \@_;
1295
1296 my \$scoresptr = \$self->{conf}->{scores};
1297 my \$prepend2desc = q#$prepend2desc#;
1298 my \$rulename;
1299 my \$result;
1300
1301 $evalstr
1302 }
1303
1304 1;
1305}
1306EOT
1307
1308 undef &{$methodname};
1309
1310 dbg("rules: run_eval_tests - compiling eval code: %s, priority %s",
1311 $testtype, $priority);
1312# dbg("rules: eval code(3): %s", $evalstr);
1313 my $eval_result;
1314 { my $timer = $self->{main}->time_method('compile_eval');
1315 $eval_result = eval($evalstr);
1316 }
1317 if (!$eval_result) {
1318 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
1319 warn "rules: failed to compile eval tests, skipping some: $eval_stat\n";
1320 $self->{rule_errors}++;
1321 }
1322 else {
1323 my $method = "${package_name}::${methodname}";
1324 push (@TEMPORARY_METHODS, $methodname);
1325 # dbg("rules: run_eval_tests - calling the just compiled %s", $method);
1326 my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });
1327 my $err = $t->run(sub {
132821.41ms2146µs
# spent 88µs (30+58) within Mail::SpamAssassin::Plugin::Check::BEGIN@1328 which was called: # once (30µs+58µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1328
no strict "refs";
# spent 88µs making 1 call to Mail::SpamAssassin::Plugin::Check::BEGIN@1328 # spent 58µs making 1 call to strict::unimport
1329 &{$method}($pms,@extraevalargs);
1330 });
1331 if ($t->timed_out() && $master_deadline && time > $master_deadline) {
1332 info("check: exceeded time limit in $method, skipping further tests");
1333 $pms->{deadline_exceeded} = 1;
1334 }
1335 }
1336}
1337
1338###########################################################################
1339# Helper Functions
1340
1341sub hash_line_for_rule {
1342 my ($self, $pms, $rulename) = @_;
1343 # using tainted subr. argument may taint the whole expression, avoid
1344 my $u = untaint_var($pms->{conf}->{source_file}->{$rulename});
1345 return sprintf("\n#line 1 \"%s, rule %s,\"", $u, $rulename);
1346# return sprintf("\n#line 1 \"%s, rule %s,\"", $u, $rulename) .
1347# "\ndbg(\"rules: will run %s\", q(".$rulename."));\n";
1348}
1349
1350sub is_user_rule_sub {
1351 my ($self, $subname) = @_;
1352 my $package_name = __PACKAGE__;
1353 return 0 if (eval 'defined &'.$package_name.'::'.$subname);
1354 1;
1355}
1356
1357sub start_rules_plugin_code {
1358 my ($self, $ruletype, $pri) = @_;
1359
1360 my $evalstr = '';
1361 if ($self->{main}->have_plugin("start_rules")) {
1362 $evalstr .= '
1363
1364 $self->{main}->call_plugins ("start_rules", { permsgstatus => $self,
1365 ruletype => \''.$ruletype.'\',
1366 priority => '.$pri.' });
1367
1368 ';
1369 }
1370
1371 return $evalstr;
1372}
1373
1374sub hit_rule_plugin_code {
1375 my ($self, $pms, $rulename, $ruletype, $loop_break_directive,
1376 $matching_string_unavailable) = @_;
1377
1378 # note: keep this in 'single quotes' to avoid the $ & performance hit,
1379 # unless specifically requested by the caller. Also split the
1380 # two chars, just to be paranoid and ensure that a buggy perl interp
1381 # doesn't impose that hit anyway (just in case)
1382 my $match;
1383 if ($matching_string_unavailable) {
1384 $match = '"<YES>"'; # nothing better to report, $& is not set by this rule
1385 } else {
1386 # simple, but suffers from 'user data interpreted as a boolean', Bug 6360
1387 $match = '($' . '&' . '|| "negative match")';
1388 }
1389
1390 my $debug_code = '';
1391 if (exists($pms->{should_log_rule_hits})) {
1392 $debug_code = '
1393 dbg("rules: ran '.$ruletype.' rule '.$rulename.' ======> got hit: \"" . '.
1394 $match.' . "\"");
1395 ';
1396 }
1397
1398 my $save_hits_code = '';
1399 if ($pms->{save_pattern_hits}) {
1400 $save_hits_code = '
1401 $self->{pattern_hits}->{q{'.$rulename.'}} = '.$match.';
1402 ';
1403 }
1404
1405 # if we're not running "tflags multiple", break out of the matching
1406 # loop this way
1407 my $multiple_code = '';
1408 if (($pms->{conf}->{tflags}->{$rulename}||'') !~ /\bmultiple\b/) {
1409 $multiple_code = $loop_break_directive.';';
1410 }
1411
1412 return $debug_code.$save_hits_code.$multiple_code;
1413}
1414
1415sub ran_rule_plugin_code {
1416 my ($self, $rulename, $ruletype) = @_;
1417
1418 return '' unless $self->{main}->have_plugin("ran_rule");
1419
1420 # The $self here looks odd, but since we are inserting this into eval'd code it
1421 # needs to be $self which in that case is actually the PerMsgStatus object
1422 return '
1423 $self->{main}->call_plugins ("ran_rule", { permsgstatus => $self, rulename => \''.$rulename.'\', ruletype => \''.$ruletype.'\' });
1424 ';
1425}
1426
1427sub free_ruleset_source {
1428 my ($self, $pms, $type, $pri) = @_;
1429
1430 # we can't do this, if we may need to recompile them again later
1431 return if $pms->{conf}->{allow_user_rules};
1432
1433 # remove now-compiled rulesets
1434 if (exists $pms->{conf}->{$type.'_tests'}->{$pri}) {
1435 delete $pms->{conf}->{$type.'_tests'}->{$pri};
1436 }
1437}
1438
1439###########################################################################
1440
1441112µs1;
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.