our
@ISA
=
qw(Mail::SpamAssassin::Plugin)
;
sub
new {
my
$class
=
shift
;
my
$mailsaobject
=
shift
;
$class
=
ref
(
$class
) ||
$class
;
my
$self
=
$class
->SUPER::new(
$mailsaobject
);
bless
(
$self
,
$class
);
$self
->register_eval_rule(
"check_uri_detail"
);
$self
->set_config(
$mailsaobject
->{conf});
return
$self
;
}
sub
set_config {
my
(
$self
,
$conf
) =
@_
;
my
@cmds
;
my
$pluginobj
=
$self
;
push
(
@cmds
, {
setting
=>
'uri_detail'
,
is_priv
=> 1,
code
=>
sub
{
my
(
$self
,
$key
,
$value
,
$line
) =
@_
;
if
(
$value
!~ /^(\S+)\s+(.+)$/) {
return
$Mail::SpamAssassin::Conf::INVALID_VALUE
;
}
my
$name
= $1;
my
$def
= $2;
my
$added_criteria
= 0;
while
(
$def
=~ m{\b(\w+)\b\s*([\=\!]\~)\s*((?:/.*?/|m(\W).*?\4)[imsx]*)(?=\s|$)}g) {
my
$target
= $1;
my
$op
= $2;
my
$pattern
= $3;
if
(
$target
!~ /^(?:raw|type|cleaned|text|domain|host)$/) {
return
$Mail::SpamAssassin::Conf::INVALID_VALUE
;
}
my
(
$rec
,
$err
) = compile_regexp(
$pattern
, 1);
if
(!
$rec
) {
dbg(
"config: uri_detail invalid regexp '$pattern': $err"
);
return
$Mail::SpamAssassin::Conf::INVALID_VALUE
;
}
dbg(
"config: uri_detail adding ($target $op /$rec/) to $name"
);
$conf
->{parser}->{conf}->{uri_detail}->{
$name
}->{
$target
} =
[
$op
,
$rec
];
$added_criteria
= 1;
}
if
(
$added_criteria
) {
dbg(
"config: uri_detail added $name\n"
);
$conf
->{parser}->add_test(
$name
,
'check_uri_detail()'
,
$Mail::SpamAssassin::Conf::TYPE_BODY_EVALS
);
}
else
{
warn
"config: failed to add invalid rule $name"
;
return
$Mail::SpamAssassin::Conf::INVALID_VALUE
;
}
}
});
$conf
->{parser}->register_commands(\
@cmds
);
}
sub
check_uri_detail {
my
(
$self
,
$permsg
) =
@_
;
my
$test
=
$permsg
->{current_rule_name};
my
$rule
=
$permsg
->{conf}->{uri_detail}->{
$test
};
my
%uri_detail
= %{
$permsg
->get_uri_detail_list() };
while
(
my
(
$raw
,
$info
) =
each
%uri_detail
) {
dbg(
"uri: running uri_detail $test: $raw"
);
if
(
exists
$rule
->{raw}) {
my
(
$op
,
$patt
) = @{
$rule
->{raw}};
if
( (
$op
eq
'=~'
&&
$raw
=~
$patt
) ||
(
$op
eq
'!~'
&&
$raw
!~
$patt
) ) {
dbg(
"uri: raw matched: '%s' %s /%s/"
,
$raw
,
$op
,
$patt
);
}
else
{
next
;
}
}
if
(
exists
$rule
->{type}) {
next
unless
$info
->{types};
my
(
$op
,
$patt
) = @{
$rule
->{type}};
my
$match
;
for
my
$text
(
keys
%{
$info
->{types} }) {
if
( (
$op
eq
'=~'
&&
$text
=~
$patt
) ||
(
$op
eq
'!~'
&&
$text
!~
$patt
) ) {
$match
=
$text
;
last
}
}
next
unless
defined
$match
;
dbg(
"uri: type matched: '%s' %s /%s/"
,
$match
,
$op
,
$patt
);
}
if
(
exists
$rule
->{cleaned}) {
next
unless
$info
->{cleaned};
my
(
$op
,
$patt
) = @{
$rule
->{cleaned}};
my
$match
;
for
my
$text
(@{
$info
->{cleaned} }) {
if
( (
$op
eq
'=~'
&&
$text
=~
$patt
) ||
(
$op
eq
'!~'
&&
$text
!~
$patt
) ) {
$match
=
$text
;
last
}
}
next
unless
defined
$match
;
dbg(
"uri: cleaned matched: '%s' %s /%s/"
,
$match
,
$op
,
$patt
);
}
if
(
exists
$rule
->{text}) {
next
unless
$info
->{anchor_text};
my
(
$op
,
$patt
) = @{
$rule
->{text}};
my
$match
;
for
my
$text
(@{
$info
->{anchor_text} }) {
if
( (
$op
eq
'=~'
&&
$text
=~
$patt
) ||
(
$op
eq
'!~'
&&
$text
!~
$patt
) ) {
$match
=
$text
;
last
}
}
next
unless
defined
$match
;
dbg(
"uri: text matched: '%s' %s /%s/"
,
$match
,
$op
,
$patt
);
}
if
(
exists
$rule
->{domain}) {
next
unless
$info
->{domains};
my
(
$op
,
$patt
) = @{
$rule
->{domain}};
my
$match
;
for
my
$text
(
keys
%{
$info
->{domains} }) {
if
( (
$op
eq
'=~'
&&
$text
=~
$patt
) ||
(
$op
eq
'!~'
&&
$text
!~
$patt
) ) {
$match
=
$text
;
last
}
}
next
unless
defined
$match
;
dbg(
"uri: domain matched: '%s' %s /%s/"
,
$match
,
$op
,
$patt
);
}
if
(
exists
$rule
->{host}) {
next
unless
$info
->{hosts};
my
(
$op
,
$patt
) = @{
$rule
->{host}};
my
$match
;
for
my
$text
(
keys
%{
$info
->{hosts} }) {
if
( (
$op
eq
'=~'
&&
$text
=~
$patt
) ||
(
$op
eq
'!~'
&&
$text
!~
$patt
) ) {
$match
=
$text
;
last
}
}
next
unless
defined
$match
;
dbg(
"uri: host matched: '%s' %s /%s/"
,
$match
,
$op
,
$patt
);
}
dbg(
"uri: all criteria for $test met - HIT"
);
return
1;
}
return
0;
}
sub
has_host_key { 1 }
1;