1
0
mirror of https://github.com/samba-team/samba.git synced 2024-12-27 03:21:53 +03:00
samba-mirror/selftest/selftest.pl
Joseph Sutton 2ff55b3da7 selftest: Catch error codes from failing testsuites
Testsuites declared with functions such as plantestsuite() are not run
directly, but are piped through filter-subunit. The overall exit code of
the executed test command is that returned by the last command in the
pipeline (that is, filter-subunit), and thus the actual testsuite return
code is lost.

A real consequence of this is that an error in setUpClass() in a Python
testsuite causes the whole testsuite to be skipped silently.

The --fail-on-empty option partially addressed this, but didn't help if
the testsuite contained multiple test classes, only one of which
contained an error.

We now use bash with the pipefail option, which makes the return code of
the last failing command into the return code of the entire pipeline.
That means that we properly fail if a testsuite returns a non-zero exit
code, but doesn't otherwise exhibit any failures in its output.

This doesn't help for cases where a testsuite has other failing tests
that become xfails due to knownfail entries. In that case, the overall
'testsuite-failure' will be turned into 'testsuite-xfail' by
filter-subunit and the silent failures will remain unheeded. Still, this
is better than the existing situation.

Signed-off-by: Joseph Sutton <josephsutton@catalyst.net.nz>
Reviewed-by: Andreas Schneider <asn@samba.org>

Autobuild-User(master): Andreas Schneider <asn@cryptomilk.org>
Autobuild-Date(master): Wed Apr 12 14:57:55 UTC 2023 on atb-devel-224
2023-04-12 14:57:55 +00:00

1035 lines
27 KiB
Perl
Executable File

#!/usr/bin/perl
# Bootstrap Samba and run a number of tests against it.
# Copyright (C) 2005-2010 Jelmer Vernooij <jelmer@samba.org>
# Copyright (C) 2007-2009 Stefan Metzmacher <metze@samba.org>
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use FindBin qw($RealBin $Script);
use File::Spec;
use File::Temp qw(tempfile);
use File::Path qw(remove_tree);
use Getopt::Long;
use POSIX;
use Cwd qw(abs_path);
use lib "$RealBin";
use Subunit;
use SocketWrapper;
use target::Samba;
use Time::HiRes qw(time);
eval {
require Time::HiRes;
Time::HiRes->import("time");
};
if ($@) {
print "You don't have Time::Hires installed !\n";
}
my $opt_help = 0;
my $opt_target = "samba";
my $opt_quick = 0;
my $opt_socket_wrapper = 0;
my $opt_socket_wrapper_pcap = undef;
my $opt_socket_wrapper_keep_pcap = undef;
my $opt_random_order = 0;
my $opt_one = 0;
my @opt_exclude = ();
my @opt_include = ();
my @opt_exclude_env = ();
my @opt_include_env = ();
my $opt_testenv = 0;
my $opt_list = 0;
my $opt_mitkrb5 = 0;
my $opt_default_ldb_backend = "mdb";
my $opt_resetup_env = undef;
my $opt_load_list = undef;
my $opt_libnss_wrapper_so_path = "";
my $opt_libresolv_wrapper_so_path = "";
my $opt_libsocket_wrapper_so_path = "";
my $opt_libuid_wrapper_so_path = "";
my $opt_libasan_so_path = "";
my $opt_libcrypt_so_path = "";
my $opt_use_dns_faking = 0;
my @testlists = ();
my $srcdir = ".";
my $bindir = "./bin";
my $prefix = "./st";
my @includes = ();
my @excludes = ();
sub find_in_list($$)
{
my ($list, $fullname) = @_;
foreach (@$list) {
if ($fullname =~ /$$_[0]/) {
return ($$_[1]) if ($$_[1]);
return "";
}
}
return undef;
}
sub skip
{
my ($name, $envname) = @_;
my ($env_basename, $env_localpart) = split(/:/, $envname);
if ($opt_target eq "samba3" && $Samba::ENV_NEEDS_AD_DC{$env_basename}) {
return "environment $envname is disabled as this build does not include an AD DC";
}
if (@opt_include_env && !(grep {$_ eq $env_basename} @opt_include_env)) {
return "environment $envname is disabled (via --include-env command line option) in this test run - skipping";
} elsif (@opt_exclude_env && grep {$_ eq $env_basename} @opt_exclude_env) {
return "environment $envname is disabled (via --exclude-env command line option) in this test run - skipping";
}
return find_in_list(\@excludes, $name);
}
sub getlog_env($);
# expand strings from %ENV
sub expand_environment_strings($)
{
my $s = shift;
# we use a reverse sort so we do the longer ones first
foreach my $k (sort { $b cmp $a } keys %ENV) {
$s =~ s/\$$k/$ENV{$k}/g;
}
return $s;
}
my $target;
sub run_testsuite($$$$$)
{
my ($envname, $name, $cmd, $i, $totalsuites) = @_;
my $pcap_file = $target->setup_pcap($name);
Subunit::start_testsuite($name);
Subunit::progress_push();
Subunit::report_time();
# Enable pipefail so that we catch failing testsuites that are part of a
# pipeline (typically, piped through filter-subunit). This won't catch
# any testsuite failures that are turned into testsuite-xfails by
# filter-subunit.
system("bash", "-o", "pipefail", "-c", $cmd);
Subunit::report_time();
Subunit::progress_pop();
if ($? == -1) {
print "command: $cmd\n";
printf "expanded command: %s\n", expand_environment_strings($cmd);
Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
exit(1);
} elsif ($? & 127) {
print "command: $cmd\n";
printf "expanded command: %s\n", expand_environment_strings($cmd);
Subunit::end_testsuite($name, "error",
sprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127), ($? & 128) ? 'with' : 'without'));
exit(1);
}
my $exitcode = $? >> 8;
my $envlog = getlog_env($envname);
if ($envlog ne "") {
print "envlog: $envlog\n";
}
print "command: $cmd\n";
printf "expanded command: %s\n", expand_environment_strings($cmd);
if ($exitcode == 0) {
Subunit::end_testsuite($name, "success");
} else {
Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
}
$target->cleanup_pcap($pcap_file, $exitcode);
if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
print "PCAP FILE: $pcap_file\n";
}
if ($exitcode != 0) {
exit(1) if ($opt_one);
}
return $exitcode;
}
sub ShowHelp()
{
print "Samba test runner
Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
Copyright (C) Stefan Metzmacher <metze\@samba.org>
Usage: $Script [OPTIONS] TESTNAME-REGEX [TESTNAME-REGEX...]
Generic options:
--help this help page
--target=samba[3]|win Samba version to target
--testlist=FILE file to read available tests from
--exclude=FILE Exclude tests listed in the file
--include=FILE Include tests listed in the file
--exclude-env=ENV Exclude tests for the specified environment
--include-env=ENV Include tests for the specified environment
Paths:
--prefix=DIR prefix to run tests in [st]
--srcdir=DIR source directory [.]
--bindir=DIR binaries directory [./bin]
Preload cwrap:
--nss_wrapper_so_path=FILE the nss_wrapper library to preload
--resolv_wrapper_so_path=FILE the resolv_wrapper library to preload
--socket_wrapper_so_path=FILE the socket_wrapper library to preload
--uid_wrapper_so_path=FILE the uid_wrapper library to preload
--asan_so_path=FILE the asan library to preload
DNS:
--use-dns-faking Fake DNS entries rather than talking to our
DNS implementation.
Target Specific:
--socket-wrapper-pcap save traffic to pcap directories
--socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
failed
--socket-wrapper enable socket wrapper
Behaviour:
--quick run quick overall test
--one abort when the first test fails
--testenv run a shell in the requested test environment
--list list available tests
";
exit(0);
}
my $result = GetOptions (
'help|h|?' => \$opt_help,
'target=s' => \$opt_target,
'prefix=s' => \$prefix,
'socket-wrapper' => \$opt_socket_wrapper,
'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
'quick' => \$opt_quick,
'one' => \$opt_one,
'exclude=s' => \@opt_exclude,
'include=s' => \@opt_include,
'exclude-env=s' => \@opt_exclude_env,
'include-env=s' => \@opt_include_env,
'srcdir=s' => \$srcdir,
'bindir=s' => \$bindir,
'testenv' => \$opt_testenv,
'list' => \$opt_list,
'mitkrb5' => \$opt_mitkrb5,
'default-ldb-backend=s' => \$opt_default_ldb_backend,
'resetup-environment' => \$opt_resetup_env,
'testlist=s' => \@testlists,
'random-order' => \$opt_random_order,
'load-list=s' => \$opt_load_list,
'nss_wrapper_so_path=s' => \$opt_libnss_wrapper_so_path,
'resolv_wrapper_so_path=s' => \$opt_libresolv_wrapper_so_path,
'socket_wrapper_so_path=s' => \$opt_libsocket_wrapper_so_path,
'uid_wrapper_so_path=s' => \$opt_libuid_wrapper_so_path,
'asan_so_path=s' => \$opt_libasan_so_path,
'crypt_so_path=s' => \$opt_libcrypt_so_path,
'use-dns-faking' => \$opt_use_dns_faking
);
exit(1) if (not $result);
ShowHelp() if ($opt_help);
die("--list and --testenv are mutually exclusive") if ($opt_list and $opt_testenv);
# we want unbuffered output
$| = 1;
my @tests = @ARGV;
# quick hack to disable rpc validation when using valgrind - its way too slow
unless (defined($ENV{VALGRIND})) {
$ENV{VALIDATE} = "validate";
$ENV{MALLOC_CHECK_} = 3;
}
# make all our python scripts unbuffered
$ENV{PYTHONUNBUFFERED} = 1;
$ENV{SAMBA_DEPRECATED_SUPPRESS} = 1;
# do not depend on the users setup
# see also bootstrap/config.py
$ENV{TZ} = "UTC";
$ENV{LC_ALL} = $ENV{LANG} = "en_US.utf8";
my $bindir_abs = abs_path($bindir);
my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
$prefix =~ s+//+/+;
$prefix =~ s+/\./+/+;
$prefix =~ s+/$++;
die("using an empty prefix isn't allowed") unless $prefix ne "";
# Ensure we have the test prefix around.
#
# We need restrictive
# permissions on this as some subdirectories in this tree will have
# wider permissions (ie 0777) and this would allow other users on the
# host to subvert the test process.
umask 0077;
mkdir($prefix, 0700) unless -d $prefix;
chmod 0700, $prefix;
# We need to have no umask limitations for the tests.
umask 0000;
my $prefix_abs = abs_path($prefix);
my $tmpdir_abs = abs_path("$prefix/tmp");
mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;
my $srcdir_abs = abs_path($srcdir);
die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
$ENV{SAMBA_SELFTEST} = "1";
$ENV{PREFIX} = $prefix;
$ENV{PREFIX_ABS} = $prefix_abs;
$ENV{SRCDIR} = $srcdir;
$ENV{SRCDIR_ABS} = $srcdir_abs;
$ENV{BINDIR} = $bindir_abs;
my $tls_enabled = not $opt_quick;
$ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
sub prefix_pathvar($$)
{
my ($name, $newpath) = @_;
if (defined($ENV{$name})) {
$ENV{$name} = "$newpath:$ENV{$name}";
} else {
$ENV{$name} = $newpath;
}
}
prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
if ($opt_socket_wrapper_keep_pcap) {
# Socket wrapper keep pcap implies socket wrapper pcap
$opt_socket_wrapper_pcap = 1;
}
if ($opt_socket_wrapper_pcap) {
# Socket wrapper pcap implies socket wrapper
$opt_socket_wrapper = 1;
}
my $ld_preload = $ENV{LD_PRELOAD};
if ($opt_libasan_so_path) {
if ($ld_preload) {
if ($opt_libcrypt_so_path) {
$ld_preload = "$opt_libasan_so_path:$opt_libcrypt_so_path:$ld_preload";
} else {
$ld_preload = "$opt_libasan_so_path:$ld_preload";
}
} else {
if ($opt_libcrypt_so_path) {
$ld_preload = "$opt_libasan_so_path:$opt_libcrypt_so_path";
} else {
$ld_preload = "$opt_libasan_so_path";
}
}
}
if ($opt_libnss_wrapper_so_path) {
if ($ld_preload) {
$ld_preload = "$ld_preload:$opt_libnss_wrapper_so_path";
} else {
$ld_preload = "$opt_libnss_wrapper_so_path";
}
}
if ($opt_libresolv_wrapper_so_path) {
if ($ld_preload) {
$ld_preload = "$ld_preload:$opt_libresolv_wrapper_so_path";
} else {
$ld_preload = "$opt_libresolv_wrapper_so_path";
}
}
if ($opt_libsocket_wrapper_so_path) {
if ($ld_preload) {
$ld_preload = "$ld_preload:$opt_libsocket_wrapper_so_path";
} else {
$ld_preload = "$opt_libsocket_wrapper_so_path";
}
}
if ($opt_libuid_wrapper_so_path) {
if ($ld_preload) {
$ld_preload = "$ld_preload:$opt_libuid_wrapper_so_path";
} else {
$ld_preload = "$opt_libuid_wrapper_so_path";
}
}
if (defined($ENV{USE_NAMESPACES})) {
print "Using linux containerization for selftest testenv(s)...\n";
# Create a common bridge to connect up the testenv namespaces. We give
# it the client's IP address, as this is where the tests will run from
my $ipv4_addr = Samba::get_ipv4_addr("client");
my $ipv6_addr = Samba::get_ipv6_addr("client");
system "$ENV{SRCDIR_ABS}/selftest/ns/create_bridge.sh selftest0 $ipv4_addr $ipv6_addr";
}
$ENV{LD_PRELOAD} = $ld_preload;
print "LD_PRELOAD=$ENV{LD_PRELOAD}\n";
# Enable uid_wrapper globally
$ENV{UID_WRAPPER} = 1;
# We are already hitting the limit, so double it.
$ENV{NSS_WRAPPER_MAX_HOSTENTS} = 200;
# Disable RTLD_DEEPBIND hack for Samba bind dlz module
#
# This is needed in order to allow the ldb_*ldap module
# to work with a preloaded socket wrapper.
$ENV{LDB_MODULES_DISABLE_DEEPBIND} = 1;
my $socket_wrapper_dir;
if ($opt_socket_wrapper) {
$socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
} elsif (not $opt_list) {
unless ($< == 0) {
warn("not using socket wrapper, but also not running as root. Will not be able to listen on proper ports");
}
}
if ($opt_use_dns_faking) {
print "DNS: Faking nameserver\n";
$ENV{SAMBA_DNS_FAKING} = 1;
}
my $testenv_default = "none";
if ($opt_mitkrb5 == 1) {
$ENV{MITKRB5} = $opt_mitkrb5;
$ENV{KRB5RCACHETYPE} = "none";
}
# After this many seconds, the server will self-terminate. All tests
# must terminate in this time, and testenv will only stay alive this
# long
my $server_maxtime;
if ($opt_testenv) {
# 1 year should be enough :-)
$server_maxtime = 365 * 24 * 60 * 60;
} else {
# make test should run under 5 hours
$server_maxtime = 5 * 60 * 60;
}
if (defined($ENV{SMBD_MAXTIME}) and $ENV{SMBD_MAXTIME} ne "") {
$server_maxtime = $ENV{SMBD_MAXTIME};
}
$target = new Samba($bindir, $srcdir, $server_maxtime,
$opt_socket_wrapper_pcap,
$opt_socket_wrapper_keep_pcap,
$opt_default_ldb_backend);
unless ($opt_list) {
if ($opt_target eq "samba") {
$testenv_default = "ad_dc";
} elsif ($opt_target eq "samba3") {
$testenv_default = "nt4_member";
}
}
sub read_test_regexes($)
{
my ($name) = @_;
my @ret = ();
open(LF, "<$name") or die("unable to read $name: $!");
while (<LF>) {
chomp;
next if (/^#/);
if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
push (@ret, [$1, $4]);
} else {
s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
push (@ret, [$_, undef]);
}
}
close(LF);
return @ret;
}
foreach (@opt_exclude) {
push (@excludes, read_test_regexes($_));
}
foreach (@opt_include) {
push (@includes, read_test_regexes($_));
}
# We give the selftest client 6 different IPv4 addresses to use. Most tests
# only use the first (.11) IP. Note that winsreplication.c is one test that
# uses the other IPs (search for iface_list_count()).
$ENV{SOCKET_WRAPPER_IPV4_NETWORK} = "10.53.57.0";
my $interfaces = Samba::get_interfaces_config("client", 6);
my $clientdir = "$prefix_abs/client";
my $conffile = "$clientdir/client.conf";
$ENV{SMB_CONF_PATH} = $conffile;
sub write_clientconf($$$)
{
my ($conffile, $clientdir, $vars) = @_;
mkdir("$clientdir", 0777) unless -d "$clientdir";
my @subdirs = (
{ name => "private", mask => 0777 },
{ name => "bind-dns", mask => 0777 },
{ name => "lockdir", mask => 0777 },
{ name => "statedir", mask => 0777 },
{ name => "cachedir", mask => 0777 },
{ name => "pkinit", mask => 0700 },
{ name => "pid", mask => 0777 },
# the ncalrpcdir needs exactly 0755 otherwise tests fail.
{ name => "ncalrpcdir", mask => 0755, umask => 0022 },
);
foreach my $sub (@subdirs) {
my $dir = "$clientdir/$sub->{name}";
remove_tree($dir);
my $mask = umask;
if (defined($sub->{umask})) {
umask $sub->{umask};
}
mkdir($dir, $sub->{mask});
umask $mask;
}
my $cadir = "$ENV{SRCDIR_ABS}/selftest/manage-ca/CA-samba.example.com";
my $cacert = "$cadir/Public/CA-samba.example.com-cert.pem";
my $cacrl_pem = "$cadir/Public/CA-samba.example.com-crl.pem";
my $ca_users_dir = "$cadir/Users";
my $client_loglevel = $ENV{CLIENT_LOG_LEVEL} || 1;
# each user has a USER-${USER_PRINCIPAL_NAME}-cert.pem and
# USER-${USER_PRINCIPAL_NAME}-private-key.pem symlink
# We make a copy here and make the certificated easily
# accessable in the client environment.
my $mask = umask;
umask 0077;
opendir USERS, "${ca_users_dir}" or die "Could not open dir '${ca_users_dir}': $!";
for my $d (readdir USERS) {
my $user_dir = "${ca_users_dir}/${d}";
next if ${d} =~ /^\./;
next if (! -d "${user_dir}");
opendir USER, "${user_dir}" or die "Could not open dir '${user_dir}': $!";
for my $l (readdir USER) {
my $user_link = "${user_dir}/${l}";
next if ${l} =~ /^\./;
next if (! -l "${user_link}");
my $dest = "${clientdir}/pkinit/${l}";
Samba::copy_file_content(${user_link}, ${dest});
}
closedir USER;
}
closedir USERS;
umask $mask;
open(CF, ">$conffile");
print CF "[global]\n";
print CF "\tnetbios name = client\n";
if (defined($vars->{DOMAIN})) {
print CF "\tworkgroup = $vars->{DOMAIN}\n";
}
if (defined($vars->{REALM})) {
print CF "\trealm = $vars->{REALM}\n";
}
if ($opt_socket_wrapper) {
print CF "\tinterfaces = $interfaces\n";
}
print CF "
private dir = $clientdir/private
binddns dir = $clientdir/bind-dns
lock dir = $clientdir/lockdir
state directory = $clientdir/statedir
cache directory = $clientdir/cachedir
ncalrpc dir = $clientdir/ncalrpcdir
pid directory = $clientdir/pid
panic action = $RealBin/gdb_backtrace \%d
max xmit = 32K
notify:inotify = false
ldb:nosync = true
system:anonymous = true
client lanman auth = Yes
client min protocol = CORE
log level = $client_loglevel
torture:basedir = $clientdir
#We don't want to run 'speed' tests for very long
torture:timelimit = 1
winbind separator = /
tls cafile = ${cacert}
tls crlfile = ${cacrl_pem}
tls verify peer = no_check
include system krb5 conf = no
elasticsearch:mappings = $srcdir_abs/source3/rpc_server/mdssvc/elasticsearch_mappings.json
";
close(CF);
}
my @todo = ();
sub should_run_test($)
{
my $name = shift;
if ($#tests == -1) {
return 1;
}
for (my $i=0; $i <= $#tests; $i++) {
if ($name =~ /$tests[$i]/i) {
return 1;
}
}
return 0;
}
sub read_testlist($)
{
my ($filename) = @_;
my @ret = ();
open(IN, $filename) or die("Unable to open $filename: $!");
while (<IN>) {
if (/-- TEST(-LOADLIST|) --\n/) {
my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
my $name = <IN>;
$name =~ s/\n//g;
my $env = <IN>;
$env =~ s/\n//g;
my $loadlist;
if ($supports_loadlist) {
$loadlist = <IN>;
$loadlist =~ s/\n//g;
}
my $cmdline = <IN>;
$cmdline =~ s/\n//g;
if (should_run_test($name) == 1) {
push (@ret, [$name, $env, $cmdline, $loadlist]);
}
} else {
print;
}
}
close(IN) or die("Error creating recipe from $filename");
return @ret;
}
if ($#testlists == -1) {
die("No testlists specified");
}
$ENV{SELFTEST_PREFIX} = "$prefix_abs";
$ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
$ENV{TMPDIR} = "$tmpdir_abs";
$ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
if ($opt_quick) {
$ENV{SELFTEST_QUICK} = "1";
} else {
$ENV{SELFTEST_QUICK} = "";
}
$ENV{SELFTEST_MAXTIME} = $torture_maxtime;
my $selftest_resolv_conf_path = "$tmpdir_abs/selftest.resolv.conf";
$ENV{RESOLV_CONF} = "${selftest_resolv_conf_path}.global";
my $selftest_krbt_ccache_path = "$tmpdir_abs/selftest.krb5_ccache";
$ENV{KRB5CCNAME} = "FILE:${selftest_krbt_ccache_path}.global";
my $selftest_gnupghome_path = "$tmpdir_abs/selftest.no.gnupg";
$ENV{GNUPGHOME} = "${selftest_gnupghome_path}.global";
my @available = ();
foreach my $fn (@testlists) {
foreach (read_testlist($fn)) {
my $name = $$_[0];
next if (@includes and not defined(find_in_list(\@includes, $name)));
push (@available, $_);
}
}
my $restricted = undef;
my $restricted_used = {};
if ($opt_load_list) {
$restricted = [];
open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
while (<LOAD_LIST>) {
chomp;
push (@$restricted, $_);
}
close(LOAD_LIST);
}
my $individual_tests = undef;
$individual_tests = {};
foreach my $testsuite (@available) {
my $name = $$testsuite[0];
my $skipreason = skip(@$testsuite);
if (defined($restricted)) {
# Find the testsuite for this test
my $match = undef;
foreach my $r (@$restricted) {
if ($r eq $name) {
$individual_tests->{$name} = [];
$match = $r;
$restricted_used->{$r} = 1;
} elsif (substr($r, 0, length($name)+1) eq "$name.") {
push(@{$individual_tests->{$name}}, $r);
$match = $r;
$restricted_used->{$r} = 1;
}
}
if ($match) {
if (defined($skipreason)) {
if (not $opt_list) {
Subunit::skip_testsuite($name, $skipreason);
}
} else {
push(@todo, $testsuite);
}
}
} elsif (defined($skipreason)) {
if (not $opt_list) {
Subunit::skip_testsuite($name, $skipreason);
}
} else {
push(@todo, $testsuite);
}
}
if (defined($restricted)) {
foreach (@$restricted) {
unless (defined($restricted_used->{$_})) {
print "No test or testsuite found matching $_\n";
}
}
} elsif ($#todo == -1) {
print STDERR "No tests to run\n";
exit(1);
}
my $suitestotal = $#todo + 1;
unless ($opt_list) {
Subunit::progress($suitestotal);
Subunit::report_time();
}
my $i = 0;
$| = 1;
my %running_envs = ();
sub get_running_env($)
{
my ($name) = @_;
my $envname = $name;
$envname =~ s/:.*//;
return $running_envs{$envname};
}
sub sighandler($)
{
my $signame = shift;
$SIG{INT} = $SIG{QUIT} = $SIG{TERM} = 'DEFAULT';
$SIG{PIPE} = 'IGNORE';
open(STDOUT, ">&STDERR") or die "can't dup STDOUT to STDERR: $!";
print "$0: PID[$$]: Got SIG${signame} teardown environments.\n";
teardown_env($_) foreach(keys %running_envs);
system("pstree -p $$");
print "$0: PID[$$]: Exiting...\n";
exit(1);
};
$SIG{INT} = $SIG{QUIT} = $SIG{TERM} = $SIG{PIPE} = \&sighandler;
sub setup_env($$)
{
my ($name, $prefix) = @_;
my $testenv_vars = undef;
my $envname = $name;
my $option = $name;
$envname =~ s/:.*//;
$option =~ s/^[^:]*//;
$option =~ s/^://;
$option = "client" if $option eq "";
# Initially clear out the environment for the provision, so previous envs'
# variables don't leak in. Provisioning steps must explicitly set their
# necessary variables when calling out to other executables
Samba::clear_exported_envvars();
delete $ENV{SOCKET_WRAPPER_DEFAULT_IFACE};
delete $ENV{SMB_CONF_PATH};
$ENV{RESOLV_CONF} = "${selftest_resolv_conf_path}.${envname}/ignore";
$ENV{KRB5CCNAME} = "FILE:${selftest_krbt_ccache_path}.${envname}/ignore";
$ENV{GNUPGHOME} = "${selftest_gnupghome_path}.${envname}/ignore";
if (defined(get_running_env($envname))) {
$testenv_vars = get_running_env($envname);
if (not $testenv_vars->{target}->check_env($testenv_vars)) {
print $testenv_vars->{target}->getlog_env($testenv_vars);
$testenv_vars = undef;
}
} else {
$testenv_vars = $target->setup_env($envname, $prefix);
if (not defined($testenv_vars)) {
my $msg = "$opt_target can't start up known environment '$envname'";
if ($opt_one) {
die($msg);
}
warn $msg;
return;
}
if (ref $testenv_vars ne "HASH") {
return $testenv_vars;
}
if (defined($testenv_vars->{target})) {
$testenv_vars->{target} = $target;
}
}
return undef unless defined($testenv_vars);
$running_envs{$envname} = $testenv_vars;
if ($option eq "local") {
SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
$ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
} elsif ($option eq "client") {
SocketWrapper::set_default_iface(11);
write_clientconf($conffile, $clientdir, $testenv_vars);
$ENV{SMB_CONF_PATH} = $conffile;
} else {
die("Unknown option[$option] for envname[$envname]");
}
# export the environment variables for the testenv (SERVER, SERVER_IP, etc)
Samba::export_envvars($testenv_vars);
my $krb5_ccache_path = "${selftest_krbt_ccache_path}.${envname}.${option}";
unlink($krb5_ccache_path);
$ENV{KRB5CCNAME} = "FILE:${krb5_ccache_path}";
return $testenv_vars;
}
sub getlog_env($)
{
my ($envname) = @_;
return "" if ($envname eq "none");
my $env = get_running_env($envname);
return $env->{target}->getlog_env($env);
}
sub check_env($)
{
my ($envname) = @_;
my $env = get_running_env($envname);
return $env->{target}->check_env($env);
}
sub teardown_env($)
{
my ($envname) = @_;
return if ($envname eq "none");
print STDERR "teardown_env($envname)\n";
my $env = get_running_env($envname);
$env->{target}->teardown_env($env);
delete $running_envs{$envname};
}
# This 'global' file needs to be empty when we start
unlink("$prefix_abs/dns_host_file");
unlink("$prefix_abs/hosts");
if ($opt_random_order) {
require List::Util;
my @newtodo = List::Util::shuffle(@todo);
@todo = @newtodo;
}
if ($opt_testenv) {
my $testenv_name = $ENV{SELFTEST_TESTENV};
$testenv_name = $testenv_default unless defined($testenv_name);
my $testenv_vars = setup_env($testenv_name, $prefix);
if (not $testenv_vars or $testenv_vars eq "UNKNOWN") {
die("Unable to setup environment $testenv_name");
}
$ENV{PIDDIR} = $testenv_vars->{PIDDIR};
$ENV{ENVNAME} = $testenv_name;
my $envvarstr = Samba::exported_envvars_str($testenv_vars);
my @term_args = ("echo -e \"
Welcome to the Samba4 Test environment '$testenv_name'
This matches the client environment used in make test
server is pid `cat \$PIDDIR/samba.pid`
Some useful environment variables:
TORTURE_OPTIONS=\$TORTURE_OPTIONS
SMB_CONF_PATH=\$SMB_CONF_PATH
$envvarstr
\" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash");
my @term = ();
if ($ENV{TERMINAL}) {
@term = ($ENV{TERMINAL});
# override the default terminal args (if specified)
if (defined($ENV{TERMINAL_ARGS})) {
@term_args = split(/ /, $ENV{TERMINAL_ARGS});
}
} else {
@term = ("xterm", "-e");
unshift(@term_args, ("bash", "-c"));
}
system(@term, @term_args);
teardown_env($testenv_name);
} elsif ($opt_list) {
foreach (@todo) {
my $name = $$_[0];
my $envname = $$_[1];
my $cmd = $$_[2];
my $listcmd = $$_[3];
unless (defined($listcmd)) {
warn("Unable to list tests in $name");
# Rather than ignoring this testsuite altogether, just pretend the entire testsuite is
# a single "test".
print "$name\n";
next;
}
system($listcmd);
if ($? == -1) {
die("Unable to run $listcmd: $!");
} elsif ($? & 127) {
die(sprintf("%s died with signal %d, %s coredump\n", $listcmd, ($? & 127), ($? & 128) ? 'with' : 'without'));
}
my $exitcode = $? >> 8;
if ($exitcode != 0) {
die("$cmd exited with exit code $exitcode");
}
}
} else {
foreach (@todo) {
$i++;
my $cmd = $$_[2];
my $name = $$_[0];
my $envname = $$_[1];
my $envvars = setup_env($envname, $prefix);
if (not defined($envvars)) {
Subunit::start_testsuite($name);
Subunit::end_testsuite($name, "error",
"unable to set up environment $envname - exiting");
next;
} elsif ($envvars eq "UNKNOWN") {
Subunit::start_testsuite($name);
Subunit::end_testsuite($name, "error",
"environment $envname is unknown - exiting");
next;
}
# Generate a file with the individual tests to run, if the
# test runner for this test suite supports it.
if ($individual_tests and $individual_tests->{$name}) {
if ($$_[3]) {
my ($fh, $listid_file) = tempfile(UNLINK => 0);
foreach my $test (@{$individual_tests->{$name}}) {
print $fh substr($test, length($name)+1) . "\n";
}
$cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
} else {
warn("Unable to run individual tests in $name, it does not support --loadlist.");
}
}
run_testsuite($envname, $name, $cmd, $i, $suitestotal);
teardown_env($envname) if ($opt_resetup_env);
}
}
print "\n";
teardown_env($_) foreach (keys %running_envs);
my $failed = 0;
# if there were any valgrind failures, show them
foreach (<$prefix/valgrind.log*>) {
next unless (-s $_);
print "VALGRIND FAILURE\n";
$failed++;
system("cat $_");
}
exit 0;