#!/usr/bin/perl # detect use of dollar-ampersand somewhere in the perl interpreter; # once it is used once, it slows down every regexp match thereafter. BEGIN { if (-e 't/test_dir') { # if we are running "t/rule_tests.t", kluge around ... chdir 't'; } if (-e 'test_dir') { # running from test directory, not .. unshift(@INC, '../blib/lib'); unshift(@INC, '../lib'); } } my $prefix = '.'; if (-e 'test_dir') { # running from test directory, not .. $prefix = '..'; } use lib '.'; use lib 't'; use SATest; sa_t_init("saw_ampersand"); use Test; use Carp qw(croak); our $RUN_THIS_TEST; use constant HAS_MODULE => eval { require Devel::SawAmpersand; }; BEGIN { $RUN_THIS_TEST = conf_bool('run_saw_ampersand_test') && HAS_MODULE; plan tests => (!$RUN_THIS_TEST ? 0 : 41) }; print "NOTE: this test requires 'run_saw_ampersand_test' set to 'y'.\n"; exit unless $RUN_THIS_TEST; # --------------------------------------------------------------------------- use strict; require Mail::SpamAssassin; require Devel::SawAmpersand; # 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 (, ) #*/ { 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 () { s/^loadplugin/###loadplugin/g; print OUT; } close IN; close OUT; } 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 }; 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::WhiteListSubject 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 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 DK rule plugins\n"; $plugins .= q{ loadplugin Mail::SpamAssassin::Plugin::DomainKeys }; write_plugin_pre($plugins); tryone (0, ""); 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 system "perl -pi.bak -e 's/^###loadplugin/loadplugin/g' ". " log/localrules.tmp/*.pre log/test_rules_copy/*.pre"; ($? >> 8 != 0) and die "perl failed"; tryone (0, ""); ok 1; exit; # --------------------------------------------------------------------------- sub write_plugin_pre { my $cftext = shift; open OUT, ">log/localrules.tmp/test.pre"; print OUT $cftext; close OUT or die; } 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, "parse(\*IN); close IN; 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(); }