in t/SATest.pm [119:330]
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};
$perl_path =~ s|/[^/]*$|/$^X|;
}
$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";
$scr_pref_args = "-p $userrules";
$salearn_cf_args = "-C $localrules";
$salearn_pref_args = "-p $userrules";
$scr_test_args = "";
$salearn_test_args = "";
$set_user_prefs = 0;
$default_cf_lines = "
ifplugin Mail::SpamAssassin::Plugin::Bayes
bayes_path ./$userstate/bayes
endif
ifplugin Mail::SpamAssassin::Plugin::AWL
auto_welcomelist_path ./$userstate/auto-welcomelist
endif
";
read_config();
# if running as root, ensure "nobody" can write to it too
if ($> == 0) {
$tmp_dir_mode = 0777;
umask 022; # ensure correct permissions on files and dirs created here
# Bug 5529 initial fix: For now don't run a test as root if it has a problem resuting from setuid nobody
# FIXME: Eventually we can actually test setuid nobody and accessing ./log to make this test more fine grained
# and we can create an accessible temp dir that some of the tests can use. But for now just skip those tests.
$SKIP_SETUID_NOBODY_TESTS = 1;
} else {
$tmp_dir_mode = 0755;
}
$NO_SPAMC_EXE = $TEST_DOES_NOT_RUN_SPAMC_OR_D ||
($RUNNING_ON_WINDOWS &&
!$ENV{'SPAMC_SCRIPT'} &&
!(-e "../spamc/spamc.exe"));
$SKIP_SPAMC_TESTS = ($NO_SPAMC_EXE ||
($RUNNING_ON_WINDOWS && !$ENV{'SPAMD_HOST'}));
$SSL_AVAILABLE = (!$TEST_DOES_NOT_RUN_SPAMC_OR_D) &&
(!$SKIP_SPAMC_TESTS) && # no SSL test if no spamc
(!$SKIP_SPAMD_TESTS) && # or if no local spamd
(untaint_cmd("$spamc -V") =~ /with SSL support/) &&
(untaint_cmd("$spamd --version") =~ /with SSL support/);
for (<../rules/*.pm>, <../rules/*.pre>, <../rules/languages>) {
my $file = untaint_var($_);
$base = basename $file;
copy ($file, "$siterules/$base")
or warn "cannot copy $file to $siterules/$base: $!";
}
for (<../rules/*.cf>) {
my $file = untaint_var($_);
$base = basename $file;
copy ($file, "$localrules/$base")
or warn "cannot copy $file to $localrules/$base: $!";
}
copy ("data/01_test_rules.pre", "$localrules/01_test_rules.pre")
or warn "cannot copy data/01_test_rules.cf to $localrules/01_test_rules.pre: $!";
copy ("data/01_test_rules.cf", "$localrules/01_test_rules.cf")
or warn "cannot copy data/01_test_rules.cf to $localrules/01_test_rules.cf: $!";
open (PREFS, ">>$localrules/99_test_default.cf")
or die "cannot append to $localrules/99_test_default.cf: $!";
print PREFS $default_cf_lines
or die "error writing to $localrules/99_test_default.cf: $!";
close PREFS
or die "error closing $localrules/99_test_default.cf: $!";
$home = $ENV{'HOME'};
$home ||= $ENV{'WINDIR'} if (defined $ENV{'WINDIR'});
$cwd = getcwd;
$ENV{'TEST_DIR'} = $cwd;
$testname = $tname;
$spamd_run_as_user = ($RUNNING_ON_WINDOWS || ($> == 0)) ? "nobody" : (getpwuid($>))[0] ;
}