#!/usr/bin/perl use strict; use warnings; sub usage { die " usage: t.rules/run [options] [file_or_dir ...] options: --verbose Verbose output --tests=BOUNCE_MESSAGE,FOO,BAR Select tests to run, instead of selecting from the specified files/dirs "; } use Test::More qw(no_plan); use Getopt::Long; Getopt::Long::Configure( qw(bundling no_getopt_compat permute no_auto_abbrev no_ignore_case) ); my %opt = ( ); GetOptions( 'tests|t=s' => \$opt{'tests'}, 'verbose|v' => \$opt{'verbose'}, 'debug|D' => \$opt{'debug'}, ) or usage(); my $spamtest; my $lastconfigtext = ''; my $configtext = ''; use lib 'lib'; use lib 'blib/lib'; use Mail::SpamAssassin; create_spamtest(); my $verbose = $opt{'verbose'}; $opt{'tests'} ||= join " ", ; my $testsfailed = 0; $| = 1; if (@ARGV) { foreach my $f (@ARGV) { if (-d $f) { # recurse down 1 level $f =~ s/\/+$//; foreach my $subf (<$f/*>) { test_msg($subf); } } else { # files directly test_msg($f); } } } else { main(); } $spamtest->finish(); exit $testsfailed; # --------------------------------------------------------------------------- sub main { foreach my $rule (split(/[\s,]/, $opt{'tests'})) { $rule =~ s/^t.rules\///; chomp $rule; my $ruledir="t.rules/$rule"; next unless -d $ruledir; warn "\nRunning tests for $rule:\n" if $verbose; foreach my $f (<$ruledir/*>) { (-f $f) and test_msg($f); } } } # --------------------------------------------------------------------------- sub test_msg { my ($f) = @_; return if ($f =~ /\.cf$/i); $f =~ s,//+,/,gs; # multiple slashes are ok ($f =~ /\/([^\/]+)\/[^\/]+$/) or warn "cannot find rule in '$f'"; my $rule = $1; # if the filename starts with "fp", we want a _miss_ for the named rule my $want_hit = 1; if ($f =~ /\/fp/i) { $want_hit = 0; } $configtext = ''; if (-f "$f.cf") { open (CF, "<$f.cf") or warn "cannot open $f.cf"; $configtext = join("", ); close CF; } recreate_spamtest_if_config_differs(); open (STDIN, "<$f") or warn "cannot open $f"; my $mail = $spamtest->parse(); my $status = $spamtest->check($mail); my $testsline = $status->get_names_of_tests_hit().",".$status->get_names_of_subtests_hit(); $mail->finish(); $status->finish(); close STDIN; if ($testsline =~ /(?:[ ,]|^)\Q$rule\E(?:[ ,]|$)/) { if ($want_hit) { mypass($rule, $f, "$testsline"); } else { myfail($rule, $f, "want=n got=y: $testsline"); } } else { if ($want_hit) { myfail($rule, $f, "want=y got=n: $testsline"); } else { mypass($rule, $f, "$testsline"); } } } # --------------------------------------------------------------------------- sub myfail { my ($rule, $f, $err) = @_; ok 0, "$f for $rule: $err"; $testsfailed++; } sub mypass { my ($rule, $f, $err) = @_; if (!$verbose) { ok 1, $f; } else { ok 1, "$f for $rule: $err"; } } # --------------------------------------------------------------------------- sub create_spamtest { $spamtest->finish() if $spamtest; $spamtest = new Mail::SpamAssassin( { rules_filename => 'rules', site_rules_filename => 'rules/local.cf', userprefs_filename => '', local_tests_only => 1, debug => $opt{debug}, dont_copy_prefs => 1, post_config_text => "use_learner 0\nuse_auto_whitelist 0\n".$configtext, require_rules => 1, } ); $spamtest->init(1); } sub recreate_spamtest_if_config_differs { if ($configtext eq $lastconfigtext) { return; } $lastconfigtext = $configtext; create_spamtest(); } # ---------------------------------------------------------------------------