/usr/share/perl5/Mail/SpamAssassin/Plugin/OneLineBodyRuleType.pm is in spamassassin 3.4.0-1ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | =head1 NAME
Mail::SpamAssassin::Plugin::OneLineBodyRuleType - spamassassin body test plugin
=cut
package Mail::SpamAssassin::Plugin::OneLineBodyRuleType;
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Util qw(untaint_var);
use Mail::SpamAssassin::Constants qw(:sa);
use strict;
use warnings;
use re 'taint';
use vars qw(@ISA); @ISA = qw();
# constructor
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = {};
bless ($self, $class);
return $self;
}
###########################################################################
sub check_rules_at_priority {
my ($self, $params) = @_;
my $pms = $params->{permsgstatus};
my $checkobj = $params->{checkobj};
my $priority = $params->{priority};
Mail::SpamAssassin::Plugin::Check::do_one_line_body_tests($checkobj,
$pms, $priority);
}
sub check_start {
my ($self, $params) = @_;
my $pms = $params->{permsgstatus};
my $conf = $pms->{conf};
# this method runs before the body ruleset is compiled, but after
# finish_tests(). perfect spot to remove rules from the body
# set and add to another set...
my $test_set = $conf->{body_tests};
foreach my $pri (keys %{$test_set})
{
foreach my $rulename (keys %{$test_set->{$pri}})
{
if ($conf->{generate_body_one_line_sub}->{$rulename}) {
# add the rule to the one-liner set
$conf->{one_line_body_tests}->{$pri} ||= { };
$conf->{one_line_body_tests}->{$pri}->{$rulename} =
$test_set->{$pri}->{$rulename};
}
if ($conf->{skip_body_rules}->{$rulename}) {
# remove from the body set
delete $test_set->{$pri}->{$rulename};
}
}
}
}
###########################################################################
1;
# inject this method into the Check plugin's namespace
# TODO: we need a better way to define new ruletypes via plugin
package Mail::SpamAssassin::Plugin::Check;
sub do_one_line_body_tests {
my ($self, $pms, $priority) = @_;
# TODO: should have a consttype for plugin-defined "alien" rule types,
# probably something like TYPE_ALIEN_TESTS. it's only used as a key
# for {user_rules_of_type}, so that should be fine
$self->run_generic_tests ($pms, $priority,
consttype => $Mail::SpamAssassin::Conf::TYPE_BODY_TESTS,
type => 'one_line_body',
testhash => $pms->{conf}->{one_line_body_tests},
args => [ ],
loop_body => sub
{
my ($self, $pms, $conf, $rulename, $pat, %opts) = @_;
$pat = untaint_var($pat);
my $sub;
if (($conf->{tflags}->{$rulename}||'') =~ /\bmultiple\b/)
{
# avoid [perl #86784] bug (fixed in 5.13.x), access the arg through ref
$sub = '
my $lref = \$_[1];
pos $$lref = 0;
'.$self->hash_line_for_rule($pms, $rulename).'
while ($$lref =~ '.$pat.'g) {
my $self = $_[0];
$self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "one_line_body");
'. $self->hit_rule_plugin_code($pms, $rulename, "one_line_body",
"return 1") . '
}
';
} else {
$sub = '
'.$self->hash_line_for_rule($pms, $rulename).'
if ($_[1] =~ '.$pat.') {
my $self = $_[0];
$self->got_hit(q{'.$rulename.'}, "BODY: ", ruletype => "one_line_body");
'. $self->hit_rule_plugin_code($pms, $rulename, "one_line_body", "return 1") . '
}
';
}
return if ($opts{doing_user_rules} &&
!$self->is_user_rule_sub($rulename.'_one_line_body_test'));
$self->add_temporary_method ($rulename.'_one_line_body_test', '{'.$sub.'}');
},
pre_loop_body => sub
{
my ($self, $pms, $conf, %opts) = @_;
$self->add_evalstr($pms, '
my $bodytext = $self->get_decoded_stripped_body_text_array();
$self->{main}->call_plugins("run_body_fast_scan", {
permsgstatus => $self, ruletype => "body",
priority => '.$opts{priority}.', lines => $bodytext
});
');
});
}
###########################################################################
1;
|