| #!/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 " ", <t.rules/*>; |
| 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("", <CF>); |
| 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(); |
| } |
| |
| # --------------------------------------------------------------------------- |
| |