blob: c4a9cfd7e316d7dcf9de1b7919d0b679583a66f6 [file] [log] [blame]
#!/usr/bin/perl -T
# Test regular expression base-string extraction in
# Mail::SpamAssassin::Plugin::BodyRuleBaseExtractor
use lib '.'; use lib 't'; use lib '../lib';
use SATest; sa_t_init("re_base_extraction");
use strict;
use warnings;
my $debug = 0;
my $running_perl56 = ($] < 5.007);
close STDIN; # inhibits noise from sa-compile
use Test::More tests => 128;
use lib '../lib';
# ---------------------------------------------------------------------------
1 and try_extraction ('
body FOO /fooBar/
body FOOI /fooBar/i
body FOODOTSTAR /fooBar.*BAZ/
body FOODOTSTAR2 /fooBar(?:BAZ|blarg)/
', {
base_extract => 1,
bases_must_be_casei => 0,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'fooBar:FOO,[l=0] FOODOTSTAR,[l=1]',
'fooBarBAZ:FOO,[l=0] FOODOTSTAR,[l=1] FOODOTSTAR2,[l=0]',
'fooBarblarg:FOO,[l=0] FOODOTSTAR,[l=1] FOODOTSTAR2,[l=0]',
], [ ]);
# ---------------------------------------------------------------------------
1 and try_extraction ('
body FOO /foobar/
body FOOI /foobar/i
body FOODOTSTAR /foobar.*BAZ/i
body FOODOTSTAR2 /foobar(?:BAZ|blarg)/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'foobar:FOO,[l=1] FOODOTSTAR,[l=1] FOOI,[l=0]',
'foobarbaz:FOO,[l=1] FOODOTSTAR,[l=1] FOODOTSTAR2,[l=0] FOOI,[l=0]',
'foobarblarg:FOO,[l=1] FOODOTSTAR,[l=1] FOODOTSTAR2,[l=0] FOOI,[l=0]',
], [ ]);
# ---------------------------------------------------------------------------
1 and try_extraction ('
body FOO /(?:(?:bbbb)|dddd (?:eeee )?by|aaaa)/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'bbbb:FOO,[l=0]',
'dddd by:FOO,[l=0]',
'dddd eeee by:FOO,[l=0]',
'aaaa:FOO,[l=0]'
], [ ]);
# ---------------------------------------------------------------------------
1 and try_extraction ('
body TEST5 /time to refinance|refinanc\w{1,3}\b.{0,16}\bnow\b/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'refinanc:TEST5,[l=1]',
], [ ]);
# ---------------------------------------------------------------------------
1 and try_extraction ('
body TEST2 /foody* bar/
body TEST3 /foody? bar/
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'food:TEST2,[l=1]',
'food bar:TEST2,[l=1] TEST3,[l=1]',
'foody bar:TEST2,[l=1] TEST3,[l=1]',
], [ ]);
# ---------------------------------------------------------------------------
1 and try_extraction ('
body __SARE_FRAUD_BADTHINGS /(?:all funds will be returned|ass?ylum|assassinate|(?:auto|boat|car|plane|train).{1,7}(?:crash|accident|disaster|wreck)|before they both died|brutal acts|cancer|coup attempt|disease|due to the current|\bexile\b|\bfled|\bflee\b|have been frozen|impeach|\bkilled|land dispute|murder|over-invoice|political crisis|poisoned (?:to death )?by|relocate|since the demise|\bslay\b)/i
body __FRAUD_PTS /\b(?:ass?ass?inat(?:ed|ion)|murder(?:e?d)?|kill(?:ed|ing)\b[^.]{0,99}\b(?:war veterans|rebels?))\b/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'accident:__SARE_FRAUD_BADTHINGS,[l=1]',
'all funds will be returned:__SARE_FRAUD_BADTHINGS,[l=1]',
'asasinated:__FRAUD_PTS,[l=1]',
'asasination:__FRAUD_PTS,[l=1]',
'asassinated:__FRAUD_PTS,[l=1]',
'asassination:__FRAUD_PTS,[l=1]',
'assasinated:__FRAUD_PTS,[l=1]',
'assasination:__FRAUD_PTS,[l=1]',
'assassinate:__SARE_FRAUD_BADTHINGS,[l=1]',
'assassinated:__FRAUD_PTS,[l=1] __SARE_FRAUD_BADTHINGS,[l=1]',
'assassination:__FRAUD_PTS,[l=1]',
'assylum:__SARE_FRAUD_BADTHINGS,[l=1]',
'asylum:__SARE_FRAUD_BADTHINGS,[l=1]',
'before they both died:__SARE_FRAUD_BADTHINGS,[l=1]',
'brutal acts:__SARE_FRAUD_BADTHINGS,[l=1]',
'cancer:__SARE_FRAUD_BADTHINGS,[l=1]',
'coup attempt:__SARE_FRAUD_BADTHINGS,[l=1]',
'crash:__SARE_FRAUD_BADTHINGS,[l=1]',
'disaster:__SARE_FRAUD_BADTHINGS,[l=1]',
'disease:__SARE_FRAUD_BADTHINGS,[l=1]',
'due to the current:__SARE_FRAUD_BADTHINGS,[l=1]',
'exile:__SARE_FRAUD_BADTHINGS,[l=1]',
'fled:__SARE_FRAUD_BADTHINGS,[l=1]',
'flee:__SARE_FRAUD_BADTHINGS,[l=1]',
'have been frozen:__SARE_FRAUD_BADTHINGS,[l=1]',
'impeach:__SARE_FRAUD_BADTHINGS,[l=1]',
'killed:__FRAUD_PTS,[l=1] __SARE_FRAUD_BADTHINGS,[l=1]',
'killing:__FRAUD_PTS,[l=1]',
'land dispute:__SARE_FRAUD_BADTHINGS,[l=1]',
'murder:__FRAUD_PTS,[l=1] __SARE_FRAUD_BADTHINGS,[l=1]',
'over-invoice:__SARE_FRAUD_BADTHINGS,[l=1]',
'plane:__SARE_FRAUD_BADTHINGS,[l=1]',
'poisoned by:__SARE_FRAUD_BADTHINGS,[l=1]',
'poisoned to death by:__SARE_FRAUD_BADTHINGS,[l=1]',
'political crisis:__SARE_FRAUD_BADTHINGS,[l=1]',
'relocate:__SARE_FRAUD_BADTHINGS,[l=1]',
'since the demise:__SARE_FRAUD_BADTHINGS,[l=1]',
'slay:__SARE_FRAUD_BADTHINGS,[l=1]',
'train:__SARE_FRAUD_BADTHINGS,[l=1]',
'war veterans:__FRAUD_PTS,[l=1]',
'wreck:__SARE_FRAUD_BADTHINGS,[l=1]',
], [ ]);
# ---------------------------------------------------------------------------
# skip this one for perl 5.6.*; it does not truncate the long strings in the
# same place as 5.8.* and 5.9.*, although they still work fine
($running_perl56) and ok(1);
($running_perl56) and ok(1);
($running_perl56) and ok(1);
($running_perl56) and ok(1);
(!$running_perl56) and try_extraction ('
body VIRUS_WARNING345 /(This message contained attachments that have been blocked by Guinevere|This is an automatic message from the Guinevere Internet Antivirus Scanner)\./
body VIRUS_WARNING345I /(This message contained attachments that have been blocked by Guinevere|This is an automatic message from the Guinevere Internet Antivirus Scanner)\./i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'this is an automatic message from the guinevere internet ant:VIRUS_WARNING345,[l=1] VIRUS_WARNING345I,[l=0]',
'this message contained attachments that have been blocked by:VIRUS_WARNING345,[l=1] VIRUS_WARNING345I,[l=0]'
], [ ]);
# ---------------------------------------------------------------------------
# also not suitable for perl 5.6.x
($running_perl56) and ok(1);
($running_perl56) and ok(1);
($running_perl56) and ok(1);
(!$running_perl56) and try_extraction ('
body FOO /foobar\x{e2}\x{82}\x{ac}baz/
', {
base_extract => 1,
bases_must_be_casei => 0,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'foobar:FOO,[l=0]',
], [ ]);
# ---------------------------------------------------------------------------
try_extraction ('
body FOO /(?:Viagra|Valium|Xanax|Soma|Cialis){2}/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
# TODO: it would be great if these were correctly recognised as non-lossy
'cialis:FOO,[l=1]',
'soma:FOO,[l=1]',
'valium:FOO,[l=1]',
'viagra:FOO,[l=1]',
'xanax:FOO,[l=1]'
], [ ]);
# ---------------------------------------------------------------------------
try_extraction ('
body FOO /\brecords (?:[a-z_,-]+ )+?(?:feature|(?:a|re)ward)/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'records :FOO,[l=1]'
], [ ]);
# ---------------------------------------------------------------------------
try_extraction ('
body EXCUSE_REMOVE /to .{0,20}(?:mailings|offers)/i
body TEST2 /foody* bar/
body TEST1A /fo(?:oish|o) bar/
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'foo bar:TEST1A,[l=1]',
'food:TEST2,[l=1]',
'fooish bar:TEST1A,[l=1]',
'mailings:EXCUSE_REMOVE,[l=1]',
'offers:EXCUSE_REMOVE,[l=1]',
], [ ]);
# ---------------------------------------------------------------------------
try_extraction ('
body EXCUSE_REMOVE /to .{0,20}(?:mail(ings|food)|o(ffer|blarg)s)/i
body TEST2 /foody* bar/
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'food:TEST2,[l=1]',
'mailfood:EXCUSE_REMOVE,[l=1] TEST2,[l=1]',
'mailings:EXCUSE_REMOVE,[l=1]',
'oblargs:EXCUSE_REMOVE,[l=1]',
'offers:EXCUSE_REMOVE,[l=1]',
], [ ]);
# ---------------------------------------------------------------------------
try_extraction ('
body FOO /foo bar/
body EXCUSE_REMOVE /to be removed from.{0,20}(?:mailings|offers)/i
body KAM_STOCKTIP15 /(?:Nano Superlattice Technology|NSLT)/is
body TEST1 /foo(?:ish)? bar/
body TEST1A /fo(?:oish|o) bar/
body TEST1B /fo(?:oish|o)? bar/
body TEST2 /foody* bar/
body TEST3 /foody? bar/
body TEST4 /A(?i:ct) N(?i:ow)/
body TEST5 /time to refinance|refinanc\w{1,3}\b.{0,16}\bnow\b/i
body TEST6 /(?:Current|Target)(?: Price)?:\s+\$(?:O\.|\d\.O)/
body TEST7 /(?!credit)[ck\xc7\xe7@]\W?r\W?[e3\xc8\xc9\xca\xcb\xe8\xe9\xea\xeb\xa4]\W?[d\xd0]\W?[il|!1y?\xcc\xcd\xce\xcf\xec\xed\xee\xef]\W?t/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 1
}, [
'fo bar:TEST1B,[l=1]',
'foo bar:FOO,[l=1] TEST1,[l=1] TEST1A,[l=1] TEST1B,[l=1]',
'to be removed from:EXCUSE_REMOVE,[l=1]',
'nslt:KAM_STOCKTIP15,[l=1]',
'nano superlattice technology:KAM_STOCKTIP15,[l=1]',
'fooish bar:TEST1,[l=1] TEST1A,[l=1] TEST1B,[l=1]',
'act now:TEST4,[l=1]',
'food:TEST2,[l=1]',
'food bar:TEST2,[l=1] TEST3,[l=1]',
'foody bar:TEST2,[l=1] TEST3,[l=1]',
'refinanc:TEST5,[l=1]',
'target::TEST6,[l=1]',
'target price::TEST6,[l=1]',
'current::TEST6,[l=1]',
'current price::TEST6,[l=1]',
], [
# we do not want to see these
'!credit:TEST7,[l=1]',
]);
# ---------------------------------------------------------------------------
try_extraction ('
body FOO /foo bar/
body EXCUSE_REMOVE /to be removed from.{0,20}(?:mailings|offers)/i
body KAM_STOCKTIP15 /(?:Nano Superlattice Technology|NSLT)/is
# this should not result in a match on "foo bar" since we are not
# splitting alts in this test
body TEST1 /fo(?:oish|o)? b(a|b)r/
body TEST2 /fo(?:oish|o) b(a|b)r/
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 0
}, [
'foo bar:FOO,[l=1]',
'to be removed from:EXCUSE_REMOVE,[l=1]',
],[
'foo bar:FOO TEST1,[l=1]',
'foo bar:FOO TEST2,[l=1]',
'nano superlattice technology:KAM_STOCKTIP15,[l=1]',
'fooish bar:TEST1,[l=1]',
'fooish bar:TEST2,[l=1]',
]);
# ---------------------------------------------------------------------------
try_extraction ('
body TEST3 /toniospam/i
', {
base_extract => 1,
bases_must_be_casei => 1,
bases_can_use_alternations => 0,
bases_can_use_quantifiers => 0,
bases_can_use_char_classes => 0,
bases_split_out_alternations => 0
}, [
'toniospam:TEST3,[l=0]',
],[
]);
#############################################################################
use Mail::SpamAssassin;
sub try_extraction {
my ($rules, $params, $output, $notoutput) = @_;
my $sa = Mail::SpamAssassin->new({
rules_filename => $localrules,
site_rules_filename => $siterules,
userprefs_filename => $userrules,
local_tests_only => 1,
debug => $debug,
dont_copy_prefs => 1,
base_quiet => 1,
});
ok($sa);
# remove all rules and plugins; we want just our stuff
untaint_system("rm -f $siterules/*.pre");
untaint_system("rm -f $siterules/*.pm");
# keep 20_aux_tlds.cf to suppress RB warnings
rename("$localrules/20_aux_tlds.cf", "$localrules/20_aux_tlds.cf.tmp");
untaint_system("rm -f $localrules/*.cf");
rename("$localrules/20_aux_tlds.cf.tmp", "$localrules/20_aux_tlds.cf");
{ # suppress unnecessary warning:
# "Filehandle STDIN reopened as STDOUT only for output"
# See https://rt.perl.org/rt3/Public/Bug/Display.html?id=23838
no warnings 'io';
open (OUT, ">$localrules/99_test.cf")
or die "failed to write rule";
}
print OUT "
use_bayes 0 # disable bayes loading
loadplugin Mail::SpamAssassin::Plugin::Check
loadplugin Mail::SpamAssassin::Plugin::BodyRuleBaseExtractor
".$rules;
close OUT;
my ($k, $v);
while (($k, $v) = each %{$params}) { $sa->{$k}=$v; }
$sa->init();
ok ($sa->lint_rules() == 0) or warn "lint failed: $rules";
my $conf = $sa->{conf};
my $ruletype = "body_0";
foreach my $key1 (sort keys %{$conf->{base_orig}->{$ruletype}}) {
print "INPUT: $key1 $conf->{base_orig}->{$ruletype}->{$key1}\n";
}
my %found;
foreach my $key (sort keys %{$conf->{base_string}->{$ruletype}}) {
my $str = "$key:$conf->{base_string}->{$ruletype}->{$key}";
print "BASES: '$str'\n";
$found{$str} = 1;
}
# $output ||= [];
foreach my $line (@{$output}) {
ok($found{$line}) or warn "failed to find '$line'";
}
$notoutput ||= [];
foreach my $line (@{$notoutput}) {
ok(!$found{$line}) or warn "found '$line' but didn't want to";
}
}