blob: 01bebedda4b00636b266461a623bbff9a159c6ab [file] [log] [blame]
#!/usr/bin/perl -T
# detect use of dollar-ampersand somewhere in the perl interpreter;
# once it is used once, it slows down every regexp match thereafter.
# Starting with perl 5.17.7, this entire test becomes irrelevant:
# perldelta 5.17.7:
#
# Core Enhancements
# $&, $` and $' are no longer slow '
#
# These three infamous variables have been redeemed and no longer slow
# down your program when used. Hence, the /p regular expression flag
# now does nothing.
use lib '../t'; use lib 't';
use SATest;
sa_t_init("saw_ampersand");
use Test::More;
plan skip_all => "This test is unnecessary as of perl 5.17.7" if ($] >= 5.017007);
plan skip_all => "This test requires Devel::SawAmpersand" unless (eval { require Devel::SawAmpersand; 1} );
plan tests => 41;
use Carp qw(croak);
# ---------------------------------------------------------------------------
use strict;
require Mail::SpamAssassin;
# it is important to order these from least-plugin-code-run to most.
print "\ntrying local-tests-only with default plugins\n";
tryone (1, "");
print "\ntrying net with only local rule plugins\n";
# kill all 'loadplugin' lines
foreach my $file
(<$siterules/*.pre>, <$localrules/*.pre>) #*/
{
$file = untaint_var($file);
rename $file, "$file.bak" or die "rename $file failed";
open IN, "<$file.bak" or die "cannot read $file.bak: $!";
open OUT, ">$file" or die "cannot write $file: $!";
while (<IN>) {
s/^loadplugin/###loadplugin/g;
print OUT;
}
close IN or die "error closing $file.bak: $!";
close OUT or die "error closing $file: $!";
}
my $plugins = q{
loadplugin Mail::SpamAssassin::Plugin::Check
loadplugin Mail::SpamAssassin::Plugin::HTTPSMismatch
loadplugin Mail::SpamAssassin::Plugin::URIDetail
loadplugin Mail::SpamAssassin::Plugin::Bayes
loadplugin Mail::SpamAssassin::Plugin::BodyEval
loadplugin Mail::SpamAssassin::Plugin::DNSEval
loadplugin Mail::SpamAssassin::Plugin::HTMLEval
loadplugin Mail::SpamAssassin::Plugin::HeaderEval
loadplugin Mail::SpamAssassin::Plugin::MIMEEval
loadplugin Mail::SpamAssassin::Plugin::RelayEval
loadplugin Mail::SpamAssassin::Plugin::URIEval
loadplugin Mail::SpamAssassin::Plugin::WLBLEval
loadplugin Mail::SpamAssassin::Plugin::VBounce
loadplugin Mail::SpamAssassin::Plugin::ReplaceTags
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with more local rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::SpamCop
loadplugin Mail::SpamAssassin::Plugin::AntiVirus
loadplugin Mail::SpamAssassin::Plugin::TextCat
loadplugin Mail::SpamAssassin::Plugin::AccessDB
loadplugin Mail::SpamAssassin::Plugin::WelcomeListSubject
loadplugin Mail::SpamAssassin::Plugin::MIMEHeader
loadplugin Mail::SpamAssassin::Plugin::ReplaceTags
loadplugin Mail::SpamAssassin::Plugin::Shortcircuit
loadplugin Mail::SpamAssassin::Plugin::Rule2XSBody
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with even more local rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::ASN
loadplugin Mail::SpamAssassin::Plugin::AWL
loadplugin Mail::SpamAssassin::Plugin::AskDNS
loadplugin Mail::SpamAssassin::Plugin::AuthRes
loadplugin Mail::SpamAssassin::Plugin::AutoLearnThreshold
loadplugin Mail::SpamAssassin::Plugin::BodyRuleBaseExtractor
loadplugin Mail::SpamAssassin::Plugin::Check
loadplugin Mail::SpamAssassin::Plugin::DecodeShortURLs
loadplugin Mail::SpamAssassin::Plugin::ExtractText
loadplugin Mail::SpamAssassin::Plugin::FreeMail
loadplugin Mail::SpamAssassin::Plugin::FromNameSpoof
loadplugin Mail::SpamAssassin::Plugin::HashBL
loadplugin Mail::SpamAssassin::Plugin::ImageInfo
loadplugin Mail::SpamAssassin::Plugin::OLEVBMacro
loadplugin Mail::SpamAssassin::Plugin::OneLineBodyRuleType
loadplugin Mail::SpamAssassin::Plugin::P595Body
loadplugin Mail::SpamAssassin::Plugin::PhishTag
loadplugin Mail::SpamAssassin::Plugin::Phishing
loadplugin Mail::SpamAssassin::Plugin::RelayCountry
loadplugin Mail::SpamAssassin::Plugin::RelayEval
loadplugin Mail::SpamAssassin::Plugin::ResourceLimits
loadplugin Mail::SpamAssassin::Plugin::Reuse
loadplugin Mail::SpamAssassin::Plugin::SPF
loadplugin Mail::SpamAssassin::Plugin::Test
loadplugin Mail::SpamAssassin::Plugin::URIDNSBL
loadplugin Mail::SpamAssassin::Plugin::URILocalBL
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with DCC rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::DCC
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with Razor2 rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::Razor2
};
write_plugin_pre($plugins);
tryone (0, "
score RAZOR2_CHECK 0
score RAZOR2_CF_RANGE_51_100 0
score RAZOR2_CF_RANGE_E4_51_100 0
score RAZOR2_CF_RANGE_E8_51_100 0
");
print "\ntrying net with Razor2 rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::Razor2
};
write_plugin_pre($plugins);
tryone (0, "
score RAZOR2_CHECK 1
score RAZOR2_CF_RANGE_51_100 1
score RAZOR2_CF_RANGE_E4_51_100 1
score RAZOR2_CF_RANGE_E8_51_100 1
");
print "\ntrying net with DKIM rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::DKIM
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with Pyzor rule plugins\n";
$plugins .= q{
loadplugin Mail::SpamAssassin::Plugin::Pyzor
};
write_plugin_pre($plugins);
tryone (0, "");
print "\ntrying net with all default non-local rule plugins\n";
# TODO: unportable
untaint_system "perl -pi.bak -e 's/^###loadplugin/loadplugin/g' ".
" $siterules/*.pre $localrules/*.pre";
($? >> 8 != 0) and die "perl failed";
tryone (0, "");
ok 1;
exit;
# ---------------------------------------------------------------------------
sub write_plugin_pre {
my $cftext = shift;
open OUT, ">$siterules/test.pre"
or die "cannot create $siterules/test.pre: $!";
print OUT $cftext
or die "error writing to $siterules/test.pre: $!";
close OUT
or die "cannot close $siterules/test.pre: $!";
}
sub tryone {
my ($ltests, $cftext) = @_;
print " SawAmpersand test using local_tests_only=>$ltests,\n".
" post_config_text=>'$cftext'\n\n";
# note: do not use debug, that uses dollar-ampersand in rule debug output
# (hit_rule_plugin_code() in lib/Mail/SpamAssassin/Plugin/Check.pm)
my $sa = create_saobj({
'dont_copy_prefs' => 1,
# 'debug' => 1,
'local_tests_only' => $ltests,
'post_config_text' => $cftext,
});
$sa->init(1);
ok($sa);
open (IN, "<data/spam/009") or die "cannot open data/spam/009: $!";
my $mail = $sa->parse(\*IN,0);
close IN or die "error closing data/spam/009: $!";
my $status = $sa->check($mail);
my $rewritten = $status->rewrite_mail();
my $msg = $status->{msg};
ok $rewritten =~ /message\/rfc822; x-spam-type=original/;
ok $rewritten =~ /X-Spam-Flag: YES/;
print "saw ampersand?\n";
ok (!Devel::SawAmpersand::sawampersand());
# Devel::SawAmpersand::sawampersand() and croak("\$"."\& is in effect! dying");
$mail->finish();
$status->finish();
}