view release on metacpan or  search on metacpan

t/SATest.pm  view on Meta::CPAN

# common functionality for tests.
# imported into main for ease of use.
package main;

require v5.14.0;

# use strict;
# use warnings;
# use re 'taint';

use Cwd;
use Config;
use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use File::Temp qw(tempdir);

use Test::Builder ();
use Test::More    ();

use POSIX qw(WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG);

use vars qw($RUNNING_ON_WINDOWS $SSL_AVAILABLE
            $SKIP_SPAMD_TESTS $SKIP_SPAMC_TESTS $NO_SPAMC_EXE
            $SKIP_SETUID_NOBODY_TESTS $SKIP_DNSBL_TESTS
            $have_inet4 $have_inet6 $spamdhost $spamdport
            $workdir $siterules $localrules $userrules $userstate
            $keep_workdir $mainpid $spamd_pidfile);

my $sa_code_dir;

# Simple version of untaint_var for internal use. Used in BEGIN block so define first
sub untaint_var {
    local($1);
    $_[0] =~ /^(.*)\z/s;
    return $1;
}

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK);
  @ISA = qw(Exporter);

  @EXPORT = qw($have_inet4 $have_inet6 $spamdhost $spamdport);

  # No spamd test in Windows unless env override says user figured out a way
  # If you want to know why these are vars and no constants, read this thread:
  #   <http://www.mail-archive.com/dev%40perl.apache.org/msg05466.html>
  #  -- mss, 2004-01-13
  $RUNNING_ON_WINDOWS = ($^O =~ /^(mswin|dos|os2)/oi);
  $SKIP_SPAMD_TESTS =
        $RUNNING_ON_WINDOWS ||
        ( $ENV{'SPAMD_HOST'} && !($ENV{'SPAMD_HOST'} eq '127.0.0.1' ||
                                  $ENV{'SPAMD_HOST'} eq '::1' ||
                                  $ENV{'SPAMD_HOST'} eq 'localhost') );
  $SKIP_SETUID_NOBODY_TESTS = 0;
  $SKIP_DNSBL_TESTS = 0;

  $have_inet4 = eval {
    require IO::Socket::INET;
    my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', Proto => 'udp');
    $sock->close or die "error closing inet socket: $!"  if $sock;
    $sock ? 1 : undef;
  };

  $have_inet6 = eval {
    require IO::Socket::INET6;
    my $sock = IO::Socket::INET6->new(LocalAddr => '::1', Proto => 'udp');
    $sock->close or die "error closing inet6 socket: $!"  if $sock;
    $sock ? 1 : undef;
  };

  # Clean PATH so taint doesn't complain
  if (!$RUNNING_ON_WINDOWS) {
    $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
    # Remove tainted envs, at least ENV used in FreeBSD
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  } else {
    # Windows might need non-system directories in PATH to run a Perl installation
    # The best we can do is clean out obviously bad stuff such as relative paths or \..\
    my @pathdirs = split(';', $ENV{'PATH'});
    $ENV{'PATH'} =
      join(';', # filter for only dirs that are canonical absolute paths that exist
        map {
              my $pathdir = untaint_var($_); # untaint to avoid bug 8089
              $pathdir =~ s/\\*\z//;
              my $abspathdir = Cwd::realpath($pathdir) if (File::Spec->file_name_is_absolute($pathdir) and (-d $pathdir));
              if (defined $abspathdir) {
                $abspathdir  = untaint_var($abspathdir);
              }
              # Fix slashes to correctly compare path
              $pathdir =~ s;\\;/;g;
              ((defined $abspathdir) and (lc $pathdir eq lc $abspathdir))?($abspathdir):()
            }
          @pathdirs);
  }
  
  # Fix INC to point to absolute path of built SA
  if (-e 't/test_dir') { $sa_code_dir = 'blib/lib'; }
  elsif (-e 'test_dir') { $sa_code_dir = '../blib/lib'; }
  else { die "FATAL: not in or below test directory?\n"; }
  $sa_code_dir = untaint_var(File::Spec->rel2abs($sa_code_dir));
  if (not -d $sa_code_dir) {
    die "FATAL: not in expected directory relative to built code tree?\n";
  }
}

# use is run at compile time, but after the variable has been computed in the BEGIN block
use lib $sa_code_dir;

# Set up for testing. Exports (as global vars):
# out: $home: $HOME env variable
# out: $cwd: here
# out: $scr: spamassassin script
# in: if --override appears at start of command line, next 2 args are used to set
# an environment variable to control test behaviour.
#
sub sa_t_init {
  my $tname = shift;
  $mainpid = $$;

  if ($config{PERL_PATH}) {
    $perl_path = $config{PERL_PATH};
  }
  elsif ($^X =~ m|^/|) {
    $perl_path = $^X;
  }
  else {
    $perl_path = $Config{perlpath};

t/SATest.pm  view on Meta::CPAN

  $perl_cmd  = $perl_path;

  # propagate $PERL5OPT; seems to be necessary, at least for the common idiom of
  # "PERL5OPT=-MFoo::Bar ./test.t"
  if ($ENV{'PERL5OPT'}) {
    my $o = $ENV{'PERL5OPT'};
    if ($o =~ /(Devel::Cover)/) {
      warn "# setting TEST_PERL_TAINT=no to avoid lack of taint-safety in $1\n";
      $ENV{'TEST_PERL_TAINT'} = 'no';
    }
    $perl_cmd .= " \"$o\"";
  }

  $perl_cmd .= " -T" if !defined($ENV{'TEST_PERL_TAINT'}) or $ENV{'TEST_PERL_TAINT'} ne 'no';
  $perl_cmd .= " -w" if !defined($ENV{'TEST_PERL_WARN'})  or $ENV{'TEST_PERL_WARN'}  ne 'no';

  # Copy directories in PERL5LIB into -I options in perl_cmd because -T suppresses use of PERL5LIB in call to ./spamassassin
  # If PERL5LIB is empty copy @INC instead because on some platforms like FreeBSD MakeMaker clears PER5LIB and sets @INC
  # Filter out relative paths, and canonicalize so no symlinks or /../ will be left in untainted result as a nod to security
  # Since this is only used to run tests, the security considerations are not as strict as with more general situations.
  my @pathdirs = @INC;
  if ($ENV{'PERL5LIB'}) {
    @pathdirs = split($Config{path_sep}, $ENV{'PERL5LIB'});
  }
  my $inc_opts =
    join(' -I', # filter for only dirs that are absolute paths that exist, then canonicalize them
      map {
            my $pathdir = untaint_var($_);  # untaint to avoid bug 8089
            my $canonpathdir = Cwd::realpath($pathdir) if (File::Spec->file_name_is_absolute($pathdir) and (-d $pathdir));
            if (defined $canonpathdir) {
               $canonpathdir = untaint_var($canonpathdir);
            }
            ((defined $canonpathdir))?($canonpathdir):()
          }
         @pathdirs);
  $perl_cmd .= " -I$inc_opts" if ($inc_opts);
  
  # To work in Windows, the perl scripts have to be launched by $perl_cmd and
  # the ones that are exe files have to be directly called in the command lines
  
  $scr = $ENV{'SPAMASSASSIN_SCRIPT'};
  $scr ||= "$perl_cmd ../spamassassin.raw";

  $spamd = $ENV{'SPAMD_SCRIPT'};
  $spamd ||= "$perl_cmd ../spamd/spamd.raw";

  $spamc = $ENV{'SPAMC_SCRIPT'};
  $spamc ||= "../spamc/spamc";

  $salearn = $ENV{'SALEARN_SCRIPT'};
  $salearn ||= "$perl_cmd ../sa-learn.raw";

  $saawl = $ENV{'SAAWL_SCRIPT'};
  $saawl ||= "$perl_cmd ../sa-awl";

  $sacheckspamd = $ENV{'SACHECKSPAMD_SCRIPT'};
  $sacheckspamd ||= "$perl_cmd ../sa-check_spamd";

  $spamdlocalhost = $ENV{'SPAMD_LOCALHOST'};
  if (!$spamdlocalhost) {
    $spamdlocalhost = $have_inet4 || !$have_inet6 ? '127.0.0.1' : '::1';
  }
  $spamdhost = $ENV{'SPAMD_HOST'};
  $spamdhost ||= $spamdlocalhost;

  # optimisation -- don't setup spamd test parameters unless we're
  # not skipping all spamd tests and this particular test is called
  # called "spamd_something" or "spamc_foo"
  # We still run spamc tests when there is an external SPAMD_HOST, but don't have to set up the spamd parameters for it
  if ($tname !~ /spam[cd]/) {
    $TEST_DOES_NOT_RUN_SPAMC_OR_D = 1;
  } else {
    $spamdport = $ENV{'SPAMD_PORT'};
    $spamdport ||= probably_unused_spamd_port();
  }

  (-f "t/test_dir") && chdir("t");        # run from ..
  -f "test_dir"  or die "FATAL: not in test directory?\n";

  mkdir ("log", 0755);
  -d "log" or die "FATAL: failed to create log dir\n";
  chmod (0755, "log"); # set in case log already exists with wrong permissions

  if (!$RUNNING_ON_WINDOWS) {
    untaint_system("chacl -B log 2>/dev/null || setfacl -b log 2>/dev/null"); # remove acls that confuse test
  }

  # clean old workdir if sa_t_init called multiple times
  if (defined $workdir) {
    if (!$keep_workdir) {
      rmtree($workdir);
    }
  }

  # individual work directory to make parallel tests possible
  $workdir = tempdir("$tname.XXXXXX", DIR => "log");
  die "FATAL: failed to create workdir: $!" unless -d $workdir;
  chmod (0755, $workdir); # sometimes tempdir() ignores umask
  $keep_workdir = 0;
  # $siterules contains all stock *.pre files
  $siterules = "$workdir/siterules";
  # $localrules contains all stock *.cf files
  $localrules = "$workdir/localrules";
  # $userrules contains user rules
  $userrules = "$workdir/user.cf";
  # user_state directory
  $userstate = "$workdir/user_state";

  mkdir($siterules) or die "FATAL: failed to create $siterules\n";
  mkdir($localrules) or die "FATAL: failed to create $localrules\n";
  open(OUT, ">$userrules") or die "FATAL: failed to create $userrules\n";
  close(OUT);
  mkdir($userstate) or die "FATAL: failed to create $userstate\n";

  $spamd_pidfile = "$workdir/spamd.pid";
  $spamd_cf_args = "-C $localrules";
  $spamd_localrules_args = " --siteconfigpath $siterules";
  $scr_localrules_args =   " --siteconfigpath $siterules";
  $salearn_localrules_args =   " --siteconfigpath $siterules";

  $scr_cf_args = "-C $localrules";