#!/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();
}
