From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

package main;
require v5.14.0;
use Cwd;
use Config;
use File::Temp qw(tempdir);
use Test::More ();
use POSIX qw(WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG);
use vars qw($RUNNING_ON_WINDOWS
$SKIP_SETUID_NOBODY_TESTS $SKIP_DNSBL_TESTS
$have_inet4 $have_inet6
$workdir $siterules $localrules $userrules $userstate
$keep_workdir $mainpid);
my $sa_code_dir;
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw($have_inet4 $have_inet6);
$RUNNING_ON_WINDOWS = ($^O =~ /^(mswin|dos|os2)/oi);
$SKIP_SETUID_NOBODY_TESTS = 0;
$SKIP_DNSBL_TESTS = 0;
$have_inet4 = eval {
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 {
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 = $_;
$pathdir =~ s/\\*\z//;
my $abspathdir = File::Spec->canonpath(Cwd::realpath($pathdir)) if (-d $pathdir);
if (defined $abspathdir) {
$abspathdir =~ /^(.*)\z/s;
$abspathdir = $1; # untaint it
}
((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"; }
File::Spec->rel2abs($sa_code_dir) =~ /^(.*)\z/s;
$sa_code_dir = $1;
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;
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;
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';
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 = $_;
my $canonpathdir = File::Spec->canonpath(Cwd::realpath($pathdir)) if ((-d $pathdir) and File::Spec->file_name_is_absolute($pathdir));
if (defined $canonpathdir) {
$canonpathdir =~ /^(.*)\z/s;
$canonpathdir = $1; # untaint it
}
((defined $canonpathdir))?($canonpathdir):()
}
@pathdirs);
$perl_cmd .= " -I$inc_opts" if ($inc_opts);
$scr = $ENV{'SPAMASSASSIN_SCRIPT'};
$scr ||= "$perl_cmd ../spamassassin.raw";
$salearn = $ENV{'SALEARN_SCRIPT'};
$salearn ||= "$perl_cmd ../sa-learn.raw";
$saawl = $ENV{'SAAWL_SCRIPT'};
$saawl ||= "$perl_cmd ../sa-awl";
(-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
# }
# if (defined $workdir) {
# if (!$keep_workdir) {
# rmtree($workdir);
# }
# }
##########
### Test return here but keep some code that comes after to be compiled
return if $tname;
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";
}
1;