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
;
BEGIN {
use
vars
qw(@ISA @EXPORT @EXPORT_OK)
;
@ISA
=
qw(Exporter)
;
@EXPORT
=
qw($have_inet4 $have_inet6 $spamdhost $spamdport)
;
$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
{
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
;
};
if
(!
$RUNNING_ON_WINDOWS
) {
$ENV
{
'PATH'
} =
'/bin:/usr/bin:/usr/local/bin'
;
delete
@ENV
{
qw(IFS CDPATH ENV BASH_ENV)
};
}
else
{
my
@pathdirs
=
split
(
';'
,
$ENV
{
'PATH'
});
$ENV
{
'PATH'
} =
join
(
';'
,
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;
}
((
defined
$abspathdir
) and (
lc
$pathdir
eq
lc
$abspathdir
))?(
$abspathdir
):()
}
@pathdirs
);
}
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"
;
}
}
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'
,
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;
}
((
defined
$canonpathdir
))?(
$canonpathdir
):()
}
@pathdirs
);
$perl_cmd
.=
" -I$inc_opts"
if
(
$inc_opts
);
$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
;
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"
);
-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"
);
if
(!
$RUNNING_ON_WINDOWS
) {
untaint_system(
"chacl -B log 2>/dev/null || setfacl -b log 2>/dev/null"
);
}
if
(
defined
$workdir
) {
if
(!
$keep_workdir
) {
rmtree(
$workdir
);
}
}
$workdir
= tempdir(
"$tname.XXXXXX"
,
DIR
=>
"log"
);
die
"FATAL: failed to create workdir: $!"
unless
-d
$workdir
;
chmod
(0755,
$workdir
);
$keep_workdir
= 0;
$siterules
=
"$workdir/siterules"
;
$localrules
=
"$workdir/localrules"
;
$userrules
=
"$workdir/user.cf"
;
$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
= "
bayes_path ./
$userstate
/bayes
auto_welcomelist_path ./
$userstate
/auto-welcomelist
";
read_config();
if
($> == 0) {
$tmp_dir_mode
= 0777;
umask
022;
$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
) &&
(!
$SKIP_SPAMD_TESTS
) &&
(untaint_cmd(
"$spamc -V"
) =~ /
with
SSL support/) &&
(untaint_cmd(
"$spamd --version"
) =~ /
with
SSL support/);
for
$tainted
(<../rules/*.pm>, <../rules/*.pre>, <../rules/languages>) {
$tainted
=~ /(.*)/;
my
$file
= $1;
$base
= basename
$file
;
copy (
$file
,
"$siterules/$base"
)
or
warn
"cannot copy $file to $siterules/$base: $!"
;
}
for
$tainted
(<../rules/*.cf>) {
$tainted
=~ /(.*)/;
my
$file
= $1;
$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] ;
}
sub
probably_unused_spamd_port {
return
0
if
$SKIP_SPAMD_TESTS
;
my
$port
;
my
@nstat
;
if
(!
open
(NSTAT,
"netstat -a -n 2>&1 |"
)) {
}
else
{
@nstat
=
grep
(/^\s
*tcp
/i, <NSTAT>);
close
(NSTAT);
}
for
(1..20) {
$port
= 40000 +
int
(
rand
(65500-40000));
last
unless
(
getservbyport
(
$port
,
"tcp"
) ||
grep
(/[:.]
$port
\s/,
@nstat
));
}
return
$port
;
}
sub
read_config {
return
if
defined
(
$already_read_config
);
$already_read_config
= 1;
my
$prefix
=
''
;
if
(-f
't/test_dir'
) {
$prefix
=
"t/"
; }
if
(!
open
(CF,
"<${prefix}config"
)) {
if
(!
open
(CF,
"<${prefix}config.dist"
)) {
die
"cannot open test suite configuration file 'config.dist': $!"
;
}
}
while
(<CF>) {
s/
/^([^=]+)=(.*)$/ or
next
;
$conf
{$1} = $2;
}
if
(
defined
$ARGV
[0] &&
$ARGV
[0] eq
'--override'
) {
shift
@ARGV
;
my
$k
=
shift
@ARGV
;
my
$v
=
shift
@ARGV
;
@k
=
split
(/:/,
$k
);
@v
=
split
(/:/,
$v
);
if
(
scalar
(
@k
) !=
scalar
(
@v
)) {
print
"Error: The number of override arguments for variables and values did not match\n!"
;
exit
;
}
else
{
print
"\nProcessing Overrides:\n\n"
;
}
for
(
my
$i
= 0;
$i
<
scalar
(
@k
);
$i
++) {
$conf
{
$k
[
$i
]} =
$v
[
$i
];
print
"Overriding $k[$i] with value $v[$i]\n"
;
}
}
close
CF;
}
sub
untaint_var {
local
($1);
$_
[0] =~ /^(.*)\z/s;
return
$1;
}
sub
untaint_system {
my
@args
;
push
@args
, untaint_var(
$_
)
foreach
(
@_
);
return
system
(
@args
);
}
sub
untaint_cmd {
if
(
open
(CMD, untaint_var(
$_
[0]).
"|"
)) {
my
$stdout
=
do
{
local
($/); <CMD> };
close
CMD;
return
$stdout
;
}
else
{
return
""
;
}
}
END {
if
(
defined
$workdir
&& !
$keep_workdir
&& $$ ==
$mainpid
) {
rmtree(
$workdir
);
}
}
1;