=head1 NAME
Mail::SpamAssassin::Plugin::Check
=head1 SYNOPSIS
loadplugin Mail::SpamAssassin::Plugin::Check
=head1 DESCRIPTION
This plugin provides the primary message check functionality.
=cut
package Mail::SpamAssassin::Plugin::Check;
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Util;
use Mail::SpamAssassin::Constants qw(:sa);
use strict;
use warnings;
use vars qw(@ISA @TEMPORARY_METHODS);
@ISA = qw(Mail::SpamAssassin::Plugin);
@TEMPORARY_METHODS = ();
sub new {
my $class = shift;
my $mailsaobject = shift;
$class = ref($class) || $class;
my $self = $class->SUPER::new($mailsaobject);
bless ($self, $class);
return $self;
}
sub check_main {
my ($self, $args) = @_;
my $pms = $args->{permsgstatus};
$pms->extract_message_metadata();
$self->run_rbl_eval_tests($pms);
my $needs_dnsbl_harvest_p = 1;
my $decoded = $pms->get_decoded_stripped_body_text_array();
my $bodytext = $pms->get_decoded_body_text_array();
my $fulltext = $pms->{msg}->get_pristine();
my @uris = $pms->get_uri_list();
foreach my $priority (sort { $a <=> $b } keys %{$pms->{conf}->{priorities}}) {
next unless ($pms->{conf}->{priorities}->{$priority} > 0);
last if $self->{main}->call_plugins("have_shortcircuited", { permsgstatus => $pms });
dbg("check: running tests for priority: $priority");
if ($priority >= HARVEST_DNSBL_PRIORITY
&& $needs_dnsbl_harvest_p
&& !$self->{main}->call_plugins("have_shortcircuited",
{ permsgstatus => $pms }))
{
$pms->harvest_dnsbl_queries();
$needs_dnsbl_harvest_p = 0;
$pms->rbl_finish();
$self->{main}->call_plugins("check_post_dnsbl", { permsgstatus => $pms });
$pms->{resolver}->finish_socket() if $pms->{resolver};
}
$self->{main}->call_plugins ("check_rules_at_priority",
{ permsgstatus => $pms, priority => $priority, checkobj => $self });
$self->do_head_tests($pms, $priority);
$self->do_head_eval_tests($pms, $priority);
$self->do_body_tests($pms, $priority, $decoded);
$self->do_uri_tests($pms, $priority, @uris);
$self->do_body_eval_tests($pms, $priority, $decoded);
$self->do_rawbody_tests($pms, $priority, $bodytext);
$self->do_rawbody_eval_tests($pms, $priority, $bodytext);
$self->do_full_tests($pms, $priority, \$fulltext);
$self->do_full_eval_tests($pms, $priority, \$fulltext);
$self->do_meta_tests($pms, $priority);
$self->{main}->call_plugins ("check_tick", { permsgstatus => $pms });
}
if ($needs_dnsbl_harvest_p) {
if (!$self->{main}->call_plugins("have_shortcircuited",
{ permsgstatus => $pms }))
{
$pms->harvest_dnsbl_queries();
}
$pms->rbl_finish();
$self->{main}->call_plugins ("check_post_dnsbl", { permsgstatus => $pms });
$pms->{resolver}->finish_socket() if $pms->{resolver};
}
delete $pms->{current_rule_name};
undef $decoded;
undef $bodytext;
undef $fulltext;
$pms->learn();
$self->{main}->call_plugins ("check_post_learn", { permsgstatus => $pms });
return 1;
}
sub finish_tests {
my ($self, $params) = @_;
foreach my $method (@TEMPORARY_METHODS) {
undef &{$method};
}
@TEMPORARY_METHODS = (); }
sub run_rbl_eval_tests {
my ($self, $pms) = @_;
my ($rulename, $pat, @args);
if ($self->{main}->{local_tests_only}) {
dbg("rules: local tests only, ignoring RBL eval");
return 0;
}
while (my ($rulename, $test) = each %{$pms->{conf}->{rbl_evals}}) {
my $score = $pms->{conf}->{scores}->{$rulename};
next unless $score;
$pms->{test_log_msgs} = ();
my ($function, @args) = @{$test};
my $result;
eval {
$result = $pms->$function($rulename, @args);
};
if ($@) {
warn "rules: failed to run $rulename RBL test, skipping:\n" . "\t($@)\n";
$pms->{rule_errors}++;
next;
}
}
}
sub run_generic_tests {
my ($self, $pms, $priority, %opts) = @_;
return if $self->{main}->call_plugins("have_shortcircuited",
{ permsgstatus => $pms });
my $ruletype = $opts{type};
dbg("rules: running ".$ruletype." tests; score so far=".$pms->{score});
$pms->{test_log_msgs} = ();
my $conf = $pms->{conf};
my $doing_user_rules = $conf->{user_rules_to_compile}->{$opts{consttype}};
my $clean_priority;
($clean_priority = $priority) =~ s/-/neg/;
my $package_name = __PACKAGE__;
my $methodname = $package_name."::_".$ruletype."_tests_".$clean_priority;
if (defined &{$methodname} && !$doing_user_rules) {
no strict "refs";
run_compiled_method:
$methodname->($pms, @{$opts{args}});
use strict "refs";
return;
}
$self->{evalstr} = $self->start_rules_plugin_code($ruletype, $priority);
$self->{evalstr2} = '';
my %nopts = (
ruletype => $ruletype,
doing_user_rules => $doing_user_rules,
priority => $priority,
clean_priority => $clean_priority
);
if (defined $opts{pre_loop_body}) {
$opts{pre_loop_body}->($self, $pms, $conf, %nopts);
}
while (my($rulename, $test) = each %{$opts{testhash}->{$priority}}) {
$opts{loop_body}->($self, $pms, $conf, $rulename, $test, %nopts);
}
if (defined $opts{post_loop_body}) {
$opts{post_loop_body}->($self, $pms, $conf, %nopts);
}
undef &{$methodname};
$self->free_ruleset_source($pms, $ruletype, $priority);
my $evalstr = $self->{evalstr};
$evalstr = <<"EOT";
{
package $package_name;
$self->{evalstr2}
sub $methodname {
my \$self = shift;
$evalstr;
}
1;
}
EOT
delete $self->{evalstr};
delete $self->{evalstr2};
eval $evalstr;
if ($@) {
warn("rules: failed to compile $ruletype tests, skipping:\n\t($@)\n");
$pms->{rule_errors}++;
}
else {
dbg("rules: compiled ".$ruletype." tests");
goto run_compiled_method;
}
}
sub add_evalstr {
my ($self, $str) = @_;
$self->{evalstr} .= $str;
}
sub add_evalstr2 {
my ($self, $str) = @_;
$self->{evalstr2} .= $str;
}
sub add_temporary_method {
my ($self, $methodname, $methodbody) = @_;
$self->add_evalstr2 (' sub '.$methodname.' { '.$methodbody.' } ');
push (@TEMPORARY_METHODS, $methodname);
}
sub do_meta_tests {
my ($self, $pms, $priority) = @_;
my (%rule_deps, %meta, $rulename);
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_META_TESTS,
type => 'meta',
testhash => $pms->{conf}->{meta_tests},
args => [ ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
my $token;
my $lexer = ARITH_EXPRESSION_LEXER;
my @tokens = ($rule =~ m/$lexer/g);
$meta{$rulename} = "";
$rule_deps{$rulename} = [ ];
foreach $token (@tokens) {
if ($token =~ /^(?:\W+|[+-]?\d+(?:\.\d+)?)$/) {
$meta{$rulename} .= "$token ";
}
else {
$meta{$rulename} .= "(\$h->{'$token'} || 0) ";
if (!exists $conf->{scores}->{$token}) {
dbg("rules: meta test $rulename has undefined dependency '$token'");
}
elsif ($conf->{scores}->{$token} == 0) {
unless ((($conf->get_score_set()) & 1) == 0 &&
($conf->{tflags}->{$token}||'') =~ /\bnet\b/)
{
info("rules: meta test $rulename has dependency '$token' with a zero score");
}
}
push (@{ $rule_deps{$rulename} }, $token)
if (exists $conf->{meta_tests}->{$opts{priority}}->{$token});
}
}
},
pre_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
$self->add_evalstr ('
my $r;
my $h = $self->{tests_already_hit};
');
},
post_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
my @metas = sort { @{ $rule_deps{$a} } <=> @{ $rule_deps{$b} } }
keys %{$conf->{meta_tests}->{$opts{priority}}};
my $count;
my $tflags = $conf->{tflags};
do {
$count = $ my %metas = map { $_ => 1 } @metas;
for (my $i = 0 ; $i <= $
next if (grep( $metas{$_}, @{ $rule_deps{ $metas[$i] } }));
my $alldeps = join ' ', grep {
($tflags->{$_}||'') =~ /\bnet\b/
} split (' ', $conf->{meta_dependencies}->{ $metas[$i] } );
if ($alldeps ne '') {
$self->add_evalstr ('
$self->ensure_rules_are_complete(q{'.$metas[$i].'}, qw{'.$alldeps.'});
');
}
$self->add_evalstr ('
$r = '.$meta{$metas[$i]}.';
if ($r) { $self->got_hit(q#'.$metas[$i].'#, "", ruletype => "meta", value => $r); }
');
splice @metas, $i--, 1; }
} while ($
my %metas = map { $_ => 1 } @metas; foreach $rulename (@metas) {
$pms->{rule_errors}++; my $msg =
"rules: excluding meta test $rulename, unsolved meta dependencies: " .
join(", ", grep($metas{$_}, @{ $rule_deps{$rulename} }));
if ($self->{main}->{lint_rules}) {
warn $msg."\n";
}
else {
info($msg);
}
}
}
);
}
sub do_head_tests {
my ($self, $pms, $priority) = @_;
my %ordered = ();
my %testcode = ();
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_HEAD_TESTS,
type => 'head',
testhash => $pms->{conf}->{head_tests},
args => [ ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $rule, %opts) = @_;
my $def = '';
my ($hdrname, $testtype, $pat) =
$rule =~ /^\s*(\S+)\s*(\=|\!)\~\s*(\S.*?\S)\s*$/;
if (!defined $pat) {
warn "rules: invalid rule: $rulename\n";
$pms->{rule_errors}++;
next;
}
if ($pat =~ s/\s+\[if-unset:\s+(.+)\]\s*$//) { $def = $1; }
$hdrname =~ s/ $def =~ s/
push(@{$ordered{"$hdrname\t$def"}}, $rulename);
next if ($opts{doing_user_rules} &&
!$self->is_user_rule_sub($rulename.'_head_test'));
if ($self->{main}->{use_rule_subs}) {
$self->add_temporary_method ($rulename.'_head_test', '{
my($self,$text) = @_;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($text '.$testtype.'~ '.$pat.'g) {
$self->got_hit(q#'.$rulename.'#, "", ruletype => "header");
'. $self->hit_rule_plugin_code($pms, $rulename, "header", "last") . '
}
}');
}
else {
$testcode{$rulename} = $testtype.'~ '.$pat;
}
},
pre_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
$self->add_evalstr ('
my $hval;
');
},
post_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
while(my($k,$v) = each %ordered) {
my($hdrname, $def) = split(/\t/, $k, 2);
$self->add_evalstr ('
$hval = $self->get(q#'.$hdrname.'#, q#'.$def.'#);
');
foreach my $rulename (@{$v}) {
if ($self->{main}->{use_rule_subs}) {
$self->add_evalstr ('
if ($scoresptr->{q#'.$rulename.'#}) {
'.$rulename.'_head_test($self, $hval);
'.$self->ran_rule_plugin_code($rulename, "header").'
}
');
}
else {
my $testcode = $testcode{$rulename};
my $posline = '';
my $ifwhile = 'if';
my $hitdone = '';
my $matchg = '';
if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
{
$posline = 'pos $hval = 0;';
$ifwhile = 'while';
$hitdone = 'last';
$matchg = 'g';
}
$self->add_evalstr ('
if ($scoresptr->{q#'.$rulename.'#}) {
'.$posline.'
'.$self->hash_line_for_rule($pms, $rulename).'
'.$ifwhile.' ($hval '.$testcode.$matchg.') {
$self->got_hit(q#'.$rulename.'#, "", ruletype => "header");
'.$self->hit_rule_plugin_code($pms, $rulename, "header", $hitdone).'
}
'.$self->ran_rule_plugin_code($rulename, "header").'
}
');
}
}
}
}
);
}
sub do_body_tests {
my ($self, $pms, $priority, $textary) = @_;
my $loopid = 0;
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS,
type => 'body',
testhash => $pms->{conf}->{body_tests},
args => [ @$textary ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
my $sub;
if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
{
$loopid++;
$sub = '
body_'.$loopid.': foreach my $l (@_) {
pos $l = 0;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($l =~ '.$pat.'g) {
$self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body");
'. $self->hit_rule_plugin_code($pms, $rulename, 'body',
"last body_".$loopid) . '
}
}
';
}
else {
$sub = '
foreach my $l (@_) {
'.$self->hash_line_for_rule($pms, $rulename).'
if ($l =~ '.$pat.') {
$self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "body");
'. $self->hit_rule_plugin_code($pms, $rulename, "body", "last") .'
}
}
';
}
if ($self->{main}->{use_rule_subs}) {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$rulename.'_body_test($self,@_);
'.$self->ran_rule_plugin_code($rulename, "body").'
}
');
}
else {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$sub.'
'.$self->ran_rule_plugin_code($rulename, "body").'
}
');
}
next if ($opts{doing_user_rules} &&
!$self->is_user_rule_sub($rulename.'_body_test'));
if ($self->{main}->{use_rule_subs}) {
$self->add_temporary_method ($rulename.'_body_test',
'{ my $self = shift; '.$sub.' }');
}
}
);
}
sub do_uri_tests {
my ($self, $pms, $priority, @uris) = @_;
my $loopid = 0;
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_URI_TESTS,
type => 'uri',
testhash => $pms->{conf}->{uri_tests},
args => [ @uris ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
my $sub;
if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/) {
$loopid++;
$sub = '
uri_'.$loopid.': foreach my $l (@_) {
pos $l = 0;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($l =~ '.$pat.'g) {
$self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
'. $self->hit_rule_plugin_code($pms, $rulename, "uri",
"last uri_".$loopid) . '
}
}
';
} else {
$sub = '
foreach my $l (@_) {
'.$self->hash_line_for_rule($pms, $rulename).'
if ($l =~ '.$pat.') {
$self->got_hit(q{'.$rulename.'}, "URI: ", ruletype => "uri");
'. $self->hit_rule_plugin_code($pms, $rulename, "uri", "last") .'
}
}
';
}
if ($self->{main}->{use_rule_subs}) {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$rulename.'_uri_test($self, @_);
'.$self->ran_rule_plugin_code($rulename, "uri").'
}
');
}
else {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$sub.'
'.$self->ran_rule_plugin_code($rulename, "uri").'
}
');
}
next if ($opts{doing_user_rules} &&
!$self->is_user_rule_sub($rulename.'_uri_test'));
if ($self->{main}->{use_rule_subs}) {
$self->add_temporary_method ($rulename.'_uri_test',
'{ my $self = shift; '.$sub.' }');
}
}
);
}
sub do_rawbody_tests {
my ($self, $pms, $priority, $textary) = @_;
my $loopid = 0;
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_RAWBODY_TESTS,
type => 'rawbody',
testhash => $pms->{conf}->{rawbody_tests},
args => [ @$textary ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
my $sub;
if (($pms->{conf}->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
{
$loopid++;
$sub = '
rawbody_'.$loopid.': foreach my $l (@_) {
pos $l = 0;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($l =~ '.$pat.'g) {
$self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
'. $self->hit_rule_plugin_code($pms, $rulename, "rawbody",
"last rawbody_".$loopid) . '
}
}
';
}
else {
$sub = '
foreach my $l (@_) {
'.$self->hash_line_for_rule($pms, $rulename).'
if ($l =~ '.$pat.') {
$self->got_hit(q{'.$rulename.'}, "RAW: ", ruletype => "rawbody");
'. $self->hit_rule_plugin_code($pms, $rulename, "rawbody", "last") . '
}
}
';
}
if ($self->{main}->{use_rule_subs}) {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$rulename.'_rawbody_test($self, @_);
'.$self->ran_rule_plugin_code($rulename, "rawbody").'
}
');
}
else {
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
'.$sub.'
'.$self->ran_rule_plugin_code($rulename, "rawbody").'
}
');
}
next if ($opts{doing_user_rules} &&
!$self->is_user_rule_sub($rulename.'_rawbody_test'));
if ($self->{main}->{use_rule_subs}) {
$self->add_temporary_method ($rulename.'_rawbody_test',
'{ my $self = shift; '.$sub.' }');
}
}
);
}
sub do_full_tests {
my ($self, $pms, $priority, $fullmsgref) = @_;
my $loopid = 0;
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_FULL_TESTS,
type => 'full',
testhash => $pms->{conf}->{full_tests},
args => [ $fullmsgref ],
pre_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
$self->add_evalstr ('
my $fullmsgref = shift;
');
},
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
$self->add_evalstr ('
if ($scoresptr->{q{'.$rulename.'}}) {
pos $$fullmsgref = 0;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($$fullmsgref =~ '.$pat.'g) {
$self->got_hit(q{'.$rulename.'}, "FULL: ", ruletype => "full");
'. $self->hit_rule_plugin_code($pms, $rulename, "full", "last") . '
}
'.$self->ran_rule_plugin_code($rulename, "full").'
}
');
}
);
}
sub do_head_eval_tests {
my ($self, $pms, $priority) = @_;
return unless (defined($pms->{conf}->{head_evals}->{$priority}));
$self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_HEAD_EVALS,
$pms->{conf}->{head_evals}->{$priority}, '', $priority);
}
sub do_body_eval_tests {
my ($self, $pms, $priority, $bodystring) = @_;
return unless (defined($pms->{conf}->{body_evals}->{$priority}));
$self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS,
$pms->{conf}->{body_evals}->{$priority}, 'BODY: ',
$priority, $bodystring);
}
sub do_rawbody_eval_tests {
my ($self, $pms, $priority, $bodystring) = @_;
return unless (defined($pms->{conf}->{rawbody_evals}->{$priority}));
$self->run_eval_tests ($pms, $Mail::SpamAssassin::Conf::TYPE_RAWBODY_EVALS,
$pms->{conf}->{rawbody_evals}->{$priority}, 'RAW: ',
$priority, $bodystring);
}
sub do_full_eval_tests {
my ($self, $pms, $priority, $fullmsgref) = @_;
return unless (defined($pms->{conf}->{full_evals}->{$priority}));
$self->run_eval_tests($pms, $Mail::SpamAssassin::Conf::TYPE_FULL_EVALS,
$pms->{conf}->{full_evals}->{$priority}, '',
$priority, $fullmsgref);
}
sub run_eval_tests {
my ($self, $pms, $testtype, $evalhash, $prepend2desc, $priority, @extraevalargs) = @_;
return if $self->{main}->call_plugins("have_shortcircuited",
{ permsgstatus => $pms });
my $conf = $pms->{conf};
my $doing_user_rules = $conf->{user_rules_to_compile}->{$testtype};
my $clean_priority;
($clean_priority = $priority) =~ s/-/neg/;
my $scoreset = $conf->get_score_set();
my $package_name = __PACKAGE__;
my $methodname = '_eval_tests'.
'_type'.$testtype .
'_pri'.$clean_priority .
'_set'.$scoreset;
if (defined &{"${package_name}::${methodname}"}
&& !$doing_user_rules)
{
no strict "refs";
&{"${package_name}::${methodname}"}($pms,@extraevalargs);
use strict "refs";
return;
}
my $tflagsref = $conf->{tflags};
my $eval_pluginsref = $conf->{eval_plugins};
my $have_start_rules = $self->{main}->have_plugin("start_rules");
my $have_ran_rule = $self->{main}->have_plugin("ran_rule");
my $evalstr = q{ };
$evalstr .= q{ my $function; };
my $dbgstr = q{ };
if (would_log('dbg')) {
$dbgstr = q{
dbg("rules: ran eval rule $rulename ======> got hit ($result)");
};
}
while (my ($rulename, $test) = each %{$evalhash}) {
if ($tflagsref->{$rulename}) {
if ($tflagsref->{$rulename} =~ /\bnet\b/) {
next if (($scoreset & 1) == 0);
}
if ($tflagsref->{$rulename} =~ /\blearn\b/) {
next if (($scoreset & 2) == 0);
}
}
my ($function, $argstr) = ($test,'');
if ($test =~ s/^([^,]+)(,.*)$//gs) {
($function, $argstr) = ($1,$2);
}
if (!$function) {
warn "rules: error: no function defined for $rulename";
next;
}
$evalstr .= '
$rulename = q#'.$rulename.'#;
$self->{test_log_msgs} = ();
';
if ($eval_pluginsref->{$function}) {
$evalstr .= '
$self->{current_rule_name} = $rulename;
$self->register_plugin_eval_glue(q#'.$function.'#);
';
}
if ($have_start_rules) {
$evalstr .= '
$self->{main}->call_plugins("start_rules", {
permsgstatus => $self,
ruletype => "eval",
priority => '.$priority.'
});
';
}
$evalstr .= '
eval {
$result = $self->' . $function . ' (@extraevalargs '. $argstr .' );
};
if ($@) { $self->handle_eval_rule_errors($rulename); }
';
if ($have_ran_rule) {
$evalstr .= '
$self->{main}->call_plugins("ran_rule", {
permsgstatus => $self, ruletype => "eval", rulename => $rulename
});
';
}
$evalstr .= '
if ($result) {
$self->got_hit($rulename, $prepend2desc, ruletype => "eval", value => $result);
'.$dbgstr.'
}
';
}
return unless ($evalstr);
$evalstr = <<"EOT";
{
package $package_name;
sub ${methodname} {
my (\$self, \@extraevalargs) = \@_;
my \$prepend2desc = q my \$rulename;
my \$result;
$evalstr
}
1;
}
EOT
eval $evalstr;
if ($@) {
warn "rules: failed to compile eval tests, skipping some: $@\n";
$self->{rule_errors}++;
}
else {
my $method = "${package_name}::${methodname}";
push (@TEMPORARY_METHODS, $methodname);
no strict "refs";
&{$method}($pms,@extraevalargs);
use strict "refs";
}
}
sub hash_line_for_rule {
my ($self, $pms, $rulename) = @_;
return "\n".'#line 1 "'.
$pms->{conf}->{source_file}->{$rulename}.
', rule '.$rulename.',"';
}
sub is_user_rule_sub {
my ($self, $subname) = @_;
my $package_name = __PACKAGE__;
return 0 if (eval 'defined &'.$package_name.'::'.$subname);
1;
}
sub start_rules_plugin_code {
my ($self, $ruletype, $pri) = @_;
my $evalstr = '
# start_rules_plugin_code '.$ruletype.' '.$pri.'
my $scoresptr = $self->{conf}->{scores};
';
if ($self->{main}->have_plugin("start_rules")) {
$evalstr .= '
$self->{main}->call_plugins ("start_rules", { permsgstatus => $self,
ruletype => \''.$ruletype.'\',
priority => '.$pri.' });
';
}
return $evalstr;
}
sub hit_rule_plugin_code {
my ($self, $pms, $rulename, $ruletype, $loop_break_directive) = @_;
my $match = '($' . '&' . '|| "negative match")';
my $debug_code = '';
if (exists($pms->{should_log_rule_hits})) {
$debug_code = '
dbg("rules: ran '.$ruletype.' rule '.$rulename.' ======> got hit: \"" . '.
$match.' . "\"");
';
}
my $save_hits_code = '';
if ($pms->{save_pattern_hits}) {
$save_hits_code = '
$self->{pattern_hits}->{q{'.$rulename.'}} = '.$match.';
';
}
my $multiple_code = '';
if (($pms->{conf}->{tflags}->{$rulename}||'') !~ /\bmultiple\b/) {
$multiple_code = $loop_break_directive.';';
}
return $debug_code.$save_hits_code.$multiple_code;
}
sub ran_rule_plugin_code {
my ($self, $rulename, $ruletype) = @_;
return '' unless $self->{main}->have_plugin("ran_rule");
return '
$self->{main}->call_plugins ("ran_rule", { permsgstatus => $self, rulename => \''.$rulename.'\', ruletype => \''.$ruletype.'\' });
';
}
sub free_ruleset_source {
my ($self, $pms, $type, $pri) = @_;
return if $pms->{conf}->{allow_user_rules};
if (exists $pms->{conf}->{$type.'_tests'}->{$pri}) {
delete $pms->{conf}->{$type.'_tests'}->{$pri};
}
}
1;