selftest.pl 28.4 KB
Newer Older
1 2
#!/usr/bin/perl
# Bootstrap Samba and run a number of tests against it.
3
# Copyright (C) 2005-2010 Jelmer Vernooij <jelmer@samba.org>
4
# Copyright (C) 2007-2009 Stefan Metzmacher <metze@samba.org>
5 6 7 8 9 10 11 12 13 14 15 16 17

# 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/>.
18

19 20 21 22
use strict;

use FindBin qw($RealBin $Script);
use File::Spec;
23
use File::Temp qw(tempfile);
24
use Getopt::Long;
25
use POSIX;
26
use Cwd qw(abs_path);
27
use lib "$RealBin";
28
use Subunit;
29
use SocketWrapper;
30
use target::Samba;
31
use Time::HiRes qw(time);
32

33 34
eval {
require Time::HiRes;
35
Time::HiRes->import("time");
36
};
37 38
if ($@) {
	print "You don't have Time::Hires installed !\n";
39 40
}

41
my $opt_help = 0;
42
my $opt_target = "samba";
43 44 45
my $opt_quick = 0;
my $opt_socket_wrapper = 0;
my $opt_socket_wrapper_pcap = undef;
46
my $opt_socket_wrapper_keep_pcap = undef;
47
my $opt_random_order = 0;
48
my $opt_one = 0;
49 50
my @opt_exclude = ();
my @opt_include = ();
51 52
my @opt_exclude_env = ();
my @opt_include_env = ();
53
my $opt_testenv = 0;
54
my $opt_list = 0;
55
my $opt_mitkrb5 = 0;
56
my $ldap = undef;
57
my $opt_resetup_env = undef;
58
my $opt_load_list = undef;
59
my $opt_libnss_wrapper_so_path = "";
60
my $opt_libresolv_wrapper_so_path = "";
61
my $opt_libsocket_wrapper_so_path = "";
62
my $opt_libuid_wrapper_so_path = "";
63
my $opt_libasan_so_path = "";
64
my $opt_use_dns_faking = 0;
65
my @testlists = ();
66

67
my $srcdir = ".";
68
my $bindir = "./bin";
69
my $prefix = "./st";
70

71 72
my @includes = ();
my @excludes = ();
73

74
sub find_in_list($$)
75
{
76
	my ($list, $fullname) = @_;
77

78 79 80
	foreach (@$list) {
		if ($fullname =~ /$$_[0]/) {
			 return ($$_[1]) if ($$_[1]);
81
			 return "";
82
		}
83
	}
84

85
	return undef;
86 87
}

88
sub skip
89
{
90 91 92 93 94 95
	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";
	}
96

97 98 99 100 101 102
	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";
	}

103
	return find_in_list(\@excludes, $name);
104 105
}

106 107
sub getlog_env($);

108
sub setup_pcap($)
109
{
110
	my ($name) = @_;
111 112 113 114

	return unless ($opt_socket_wrapper_pcap);
	return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});

115
	my $fname = $name;
116 117
	$fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;

118
	my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
119

120 121 122
	SocketWrapper::setup_pcap($pcap_file);

	return $pcap_file;
123 124
}

125
sub cleanup_pcap($$)
126
{
127
	my ($pcap_file, $exitcode) = @_;
128 129 130

	return unless ($opt_socket_wrapper_pcap);
	return if ($opt_socket_wrapper_keep_pcap);
131
	return unless ($exitcode == 0);
132
	return unless defined($pcap_file);
133

134
	unlink($pcap_file);
135 136
}

137 138 139 140 141 142 143 144 145 146 147
# 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;
}

148
sub run_testsuite($$$$$)
149
{
150
	my ($envname, $name, $cmd, $i, $totalsuites) = @_;
151
	my $pcap_file = setup_pcap($name);
152

153
	Subunit::start_testsuite($name);
154
	Subunit::progress_push();
155
	Subunit::report_time();
156
	system($cmd);
157
	Subunit::report_time();
158
	Subunit::progress_pop();
159

160
	if ($? == -1) {
161 162
		print "command: $cmd\n";
		printf "expanded command: %s\n", expand_environment_strings($cmd);
163
		Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
164
		exit(1);
165
	} elsif ($? & 127) {
166 167
		print "command: $cmd\n";
		printf "expanded command: %s\n", expand_environment_strings($cmd);
168 169
		Subunit::end_testsuite($name, "error",
			sprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
170
		exit(1);
171
	}
172 173 174

	my $exitcode = $? >> 8;

175
	my $envlog = getlog_env($envname);
176
	if ($envlog ne "") {
177
		print "envlog: $envlog\n";
178
	}
179

180
	print "command: $cmd\n";
181
	printf "expanded command: %s\n", expand_environment_strings($cmd);
182

183
	if ($exitcode == 0) {
184
		Subunit::end_testsuite($name, "success");
185
	} else {
186
		Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
187
	}
188

189
	cleanup_pcap($pcap_file, $exitcode);
190

191
	if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
192
		print "PCAP FILE: $pcap_file\n";
193
	}
194

195
	if ($exitcode != 0) {
196
		exit(1) if ($opt_one);
197
	}
198

199
	return $exitcode;
200 201
}

202 203 204 205
sub ShowHelp()
{
	print "Samba test runner
Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
206
Copyright (C) Stefan Metzmacher <metze\@samba.org>
207

208
Usage: $Script [OPTIONS] TESTNAME-REGEX [TESTNAME-REGEX...]
209 210

Generic options:
211
 --help                     this help page
212 213
 --target=samba[3]|win      Samba version to target
 --testlist=FILE            file to read available tests from
214 215
 --exclude=FILE             Exclude tests listed in the file
 --include=FILE             Include tests listed in the file
216 217
 --exclude-env=ENV          Exclude tests for the specified environment
 --include-env=ENV          Include tests for the specified environment
218 219 220 221

Paths:
 --prefix=DIR               prefix to run tests in [st]
 --srcdir=DIR               source directory [.]
222
 --bindir=DIR               binaries directory [./bin]
223

224
Preload cwrap:
225
 --nss_wrapper_so_path=FILE the nss_wrapper library to preload
226
 --resolv_wrapper_so_path=FILE the resolv_wrapper library to preload
227
 --socket_wrapper_so_path=FILE the socket_wrapper library to preload
228
 --uid_wrapper_so_path=FILE the uid_wrapper library to preload
229
 --asan_so_path=FILE the asan library to preload
230

231 232 233 234
DNS:
  --use-dns-faking          Fake DNS entries rather than talking to our
                            DNS implementation.

235
Target Specific:
236
 --socket-wrapper-pcap      save traffic to pcap directories
237 238
 --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that 
                            failed
239
 --socket-wrapper           enable socket wrapper
240 241

Samba4 Specific:
242
 --ldap=openldap|fedora-ds  back samba onto specified ldap server
243 244

Behaviour:
245
 --quick                    run quick overall test
246
 --one                      abort when the first test fails
247
 --testenv                  run a shell in the requested test environment
248
 --list                     list available tests
249 250 251 252 253
";
	exit(0);
}

my $result = GetOptions (
254
		'help|h|?' => \$opt_help,
255 256
		'target=s' => \$opt_target,
		'prefix=s' => \$prefix,
257
		'socket-wrapper' => \$opt_socket_wrapper,
258 259
		'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
		'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
260
		'quick' => \$opt_quick,
261
		'one' => \$opt_one,
262 263
		'exclude=s' => \@opt_exclude,
		'include=s' => \@opt_include,
264 265
		'exclude-env=s' => \@opt_exclude_env,
		'include-env=s' => \@opt_include_env,
266
		'srcdir=s' => \$srcdir,
267
		'bindir=s' => \$bindir,
268
		'testenv' => \$opt_testenv,
269
		'list' => \$opt_list,
270
		'mitkrb5' => \$opt_mitkrb5,
271
		'ldap:s' => \$ldap,
272
		'resetup-environment' => \$opt_resetup_env,
273
		'testlist=s' => \@testlists,
274
		'random-order' => \$opt_random_order,
275
		'load-list=s' => \$opt_load_list,
276
		'nss_wrapper_so_path=s' => \$opt_libnss_wrapper_so_path,
277
		'resolv_wrapper_so_path=s' => \$opt_libresolv_wrapper_so_path,
278
		'socket_wrapper_so_path=s' => \$opt_libsocket_wrapper_so_path,
279
		'uid_wrapper_so_path=s' => \$opt_libuid_wrapper_so_path,
280
		'asan_so_path=s' => \$opt_libasan_so_path,
281
		'use-dns-faking' => \$opt_use_dns_faking
282 283
	    );

284
exit(1) if (not $result);
285 286

ShowHelp() if ($opt_help);
287

288 289
die("--list and --testenv are mutually exclusive") if ($opt_list and $opt_testenv);

290 291 292
# we want unbuffered output
$| = 1;

293
my @tests = @ARGV;
294

295 296 297
# quick hack to disable rpc validation when using valgrind - its way too slow
unless (defined($ENV{VALGRIND})) {
	$ENV{VALIDATE} = "validate";
298
	$ENV{MALLOC_CHECK_} = 3;
299 300
}

301 302 303
# make all our python scripts unbuffered
$ENV{PYTHONUNBUFFERED} = 1;

304 305 306
# do not depend on the users setup
$ENV{TZ} = "UTC";

307
my $bindir_abs = abs_path($bindir);
308 309 310

# Backwards compatibility:
if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
311
	if (defined($ENV{FEDORA_DS_ROOT})) {
312
		$ldap = "fedora-ds";
313 314 315
	} else {
		$ldap = "openldap";
	}
316 317 318 319 320 321 322
}

my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
if ($ldap) {
	# LDAP is slow
	$torture_maxtime *= 2;
}
323 324

$prefix =~ s+//+/+;
325 326 327
$prefix =~ s+/./+/+;
$prefix =~ s+/$++;

328 329
die("using an empty prefix isn't allowed") unless $prefix ne "";

330 331 332 333 334 335
# 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.
336
umask 0077;
337 338
mkdir($prefix, 0700) unless -d $prefix;
chmod 0700, $prefix;
339 340
# We need to have no umask limitations for the tests.
umask 0000;
341

342
my $prefix_abs = abs_path($prefix);
343 344 345
my $tmpdir_abs = abs_path("$prefix/tmp");
mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;

346 347 348 349 350
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 "/";

351 352
$ENV{SAMBA_SELFTEST} = "1";

353
$ENV{PREFIX} = $prefix;
354
$ENV{PREFIX_ABS} = $prefix_abs;
355
$ENV{SRCDIR} = $srcdir;
356
$ENV{SRCDIR_ABS} = $srcdir_abs;
357
$ENV{GNUPGHOME} = "$srcdir_abs/selftest/gnupg";
358
$ENV{BINDIR} = $bindir_abs;
359

360
my $tls_enabled = not $opt_quick;
361
$ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
362

363 364 365 366 367 368 369 370
sub prefix_pathvar($$)
{
	my ($name, $newpath) = @_;
	if (defined($ENV{$name})) {
		$ENV{$name} = "$newpath:$ENV{$name}";
	} else {
		$ENV{$name} = $newpath;
	}
371
}
372 373
prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
374

375 376 377 378
if ($opt_socket_wrapper_keep_pcap) {
	# Socket wrapper keep pcap implies socket wrapper pcap
	$opt_socket_wrapper_pcap = 1;
}
379

380 381 382 383
if ($opt_socket_wrapper_pcap) {
	# Socket wrapper pcap implies socket wrapper
	$opt_socket_wrapper = 1;
}
384

385 386
my $ld_preload = $ENV{LD_PRELOAD};

387 388 389 390 391 392 393 394
if ($opt_libasan_so_path) {
	if ($ld_preload) {
		$ld_preload = "$ld_preload:$opt_libasan_so_path";
	} else {
		$ld_preload = "$opt_libasan_so_path";
	}
}

395 396 397 398 399 400 401 402
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";
	}
}

403 404 405 406 407 408 409 410
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";
	}
}

411 412 413 414 415 416 417 418
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";
	}
}

419 420 421 422 423 424 425 426 427 428 429
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";
	}
}

$ENV{LD_PRELOAD} = $ld_preload;
print "LD_PRELOAD=$ENV{LD_PRELOAD}\n";

430 431 432
# Enable uid_wrapper globally
$ENV{UID_WRAPPER} = 1;

433 434 435 436 437 438
# 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;

439
my $socket_wrapper_dir;
440
if ($opt_socket_wrapper) {
441
	$socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
442
	print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
443
} elsif (not $opt_list) {
444
	 unless ($< == 0) {
445
		 warn("not using socket wrapper, but also not running as root. Will not be able to listen on proper ports");
446
	 }
447 448
}

449
if ($opt_use_dns_faking) {
450
	print "DNS: Faking nameserver\n";
451 452 453
	$ENV{SAMBA_DNS_FAKING} = 1;
}

454
my $target;
455
my $testenv_default = "none";
456

457 458 459 460
if ($opt_mitkrb5 == 1) {
	$ENV{MITKRB5} = $opt_mitkrb5;
}

461 462 463 464
# After this many seconds, the server will self-terminate.  All tests
# must terminate in this time, and testenv will only stay alive this
# long

465 466 467 468 469
my $server_maxtime;
if ($opt_testenv) {
    # 1 year should be enough :-)
    $server_maxtime = 365 * 24 * 60 * 60;
} else {
470 471
    # make test should run under 5 hours
    $server_maxtime = 5 * 60 * 60;
472 473
}

474 475 476 477
if (defined($ENV{SMBD_MAXTIME}) and $ENV{SMBD_MAXTIME} ne "") {
    $server_maxtime = $ENV{SMBD_MAXTIME};
}

478
$target = new Samba($bindir, $ldap, $srcdir, $server_maxtime);
479 480
unless ($opt_list) {
	if ($opt_target eq "samba") {
481
		$testenv_default = "ad_dc";
482
	} elsif ($opt_target eq "samba3") {
483
		$testenv_default = "nt4_member";
484
	}
485 486
}

487 488 489 490 491 492
sub read_test_regexes($)
{
	my ($name) = @_;
	my @ret = ();
	open(LF, "<$name") or die("unable to read $name: $!");
	while (<LF>) { 
493
		chomp; 
494
		next if (/^#/);
495 496
		if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
			push (@ret, [$1, $4]);
497
		} else {
498
			s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
499 500 501 502 503 504 505
			push (@ret, [$_, undef]); 
		}
	}
	close(LF);
	return @ret;
}

506 507 508 509 510 511
foreach (@opt_exclude) {
	push (@excludes, read_test_regexes($_));
}

foreach (@opt_include) {
	push (@includes, read_test_regexes($_));
512 513
}

514 515 516 517 518 519
my $interfaces = join(',', ("127.0.0.11/8",
			    "127.0.0.12/8",
			    "127.0.0.13/8",
			    "127.0.0.14/8",
			    "127.0.0.15/8",
			    "127.0.0.16/8"));
520

521 522 523
my $clientdir = "$prefix_abs/client";

my $conffile = "$clientdir/client.conf";
524
$ENV{SMB_CONF_PATH} = $conffile;
525

526
sub write_clientconf($$$)
527
{
528
	my ($conffile, $clientdir, $vars) = @_;
529

530
	mkdir("$clientdir", 0777) unless -d "$clientdir";
531

532 533
	if ( -d "$clientdir/private" ) {
	        unlink <$clientdir/private/*>;
534
	} else {
535
	        mkdir("$clientdir/private", 0777);
536 537
	}

538 539 540 541 542 543
	if ( -d "$clientdir/bind-dns" ) {
	        unlink <$clientdir/bind-dns/*>;
	} else {
	        mkdir("$clientdir/bind-dns", 0777);
	}

544 545
	if ( -d "$clientdir/lockdir" ) {
	        unlink <$clientdir/lockdir/*>;
546
	} else {
547
	        mkdir("$clientdir/lockdir", 0777);
548 549
	}

550 551 552 553 554 555 556 557 558 559 560 561
	if ( -d "$clientdir/statedir" ) {
	        unlink <$clientdir/statedir/*>;
	} else {
	        mkdir("$clientdir/statedir", 0777);
	}

	if ( -d "$clientdir/cachedir" ) {
	        unlink <$clientdir/cachedir/*>;
	} else {
	        mkdir("$clientdir/cachedir", 0777);
	}

562 563 564 565 566 567
	# this is ugly, but the ncalrpcdir needs exactly 0755
	# otherwise tests fail.
	my $mask = umask;
	umask 0022;
	if ( -d "$clientdir/ncalrpcdir/np" ) {
	        unlink <$clientdir/ncalrpcdir/np/*>;
568
		rmdir "$clientdir/ncalrpcdir/np";
569
	}
570 571
	if ( -d "$clientdir/ncalrpcdir" ) {
	        unlink <$clientdir/ncalrpcdir/*>;
572
		rmdir "$clientdir/ncalrpcdir";
573
	}
574 575
	mkdir("$clientdir/ncalrpcdir", 0755);
	umask $mask;
576

577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612
	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";

	if ( -d "$clientdir/pkinit" ) {
	        unlink <$clientdir/pkinit/*>;
	} else {
	        mkdir("$clientdir/pkinit", 0700);
	}

	# 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;

613 614
	open(CF, ">$conffile");
	print CF "[global]\n";
615
	print CF "\tnetbios name = client\n";
616 617 618 619 620 621
	if (defined($vars->{DOMAIN})) {
		print CF "\tworkgroup = $vars->{DOMAIN}\n";
	}
	if (defined($vars->{REALM})) {
		print CF "\trealm = $vars->{REALM}\n";
	}
622 623 624
	if ($opt_socket_wrapper) {
		print CF "\tinterfaces = $interfaces\n";
	}
625
	print CF "
626
	private dir = $clientdir/private
627
	binddns dir = $clientdir/bind-dns
628
	lock dir = $clientdir/lockdir
629 630
	state directory = $clientdir/statedir
	cache directory = $clientdir/cachedir
631
	ncalrpc dir = $clientdir/ncalrpcdir
632
	panic action = $RealBin/gdb_backtrace \%d
633 634 635 636
	max xmit = 32K
	notify:inotify = false
	ldb:nosync = true
	system:anonymous = true
637
	client lanman auth = Yes
638
	log level = 1
639
	torture:basedir = $clientdir
640
#We don't want to pass our self-tests if the PAC code is wrong
641
	gensec:require_pac = true
642 643
#We don't want to run 'speed' tests for very long
        torture:timelimit = 1
644
        winbind separator = /
645 646
	tls cafile = ${cacert}
	tls crlfile = ${cacrl_pem}
647
	tls verify peer = no_check
648
	include system krb5 conf = no
649
";
650 651 652
	close(CF);
}

653
my @todo = ();
654

655 656 657 658 659 660 661 662 663 664 665 666 667 668
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;
}

669 670 671 672 673 674 675 676
sub read_testlist($)
{
	my ($filename) = @_;

	my @ret = ();
	open(IN, $filename) or die("Unable to open $filename: $!");

	while (<IN>) {
677
		if (/-- TEST(-LOADLIST|) --\n/) {
678
			my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
679 680 681 682
			my $name = <IN>;
			$name =~ s/\n//g;
			my $env = <IN>;
			$env =~ s/\n//g;
683 684 685 686 687
			my $loadlist;
			if ($supports_loadlist) {
				$loadlist = <IN>;
				$loadlist =~ s/\n//g;
			}
688 689
			my $cmdline = <IN>;
			$cmdline =~ s/\n//g;
690
			if (should_run_test($name) == 1) {
691
				push (@ret, [$name, $env, $cmdline, $loadlist]);
692 693 694 695 696
			}
		} else {
			print;
		}
	}
697
	close(IN) or die("Error creating recipe from $filename");
698 699 700
	return @ret;
}

701 702
if ($#testlists == -1) {
	die("No testlists specified");
703
}
704

705
$ENV{SELFTEST_PREFIX} = "$prefix_abs";
706
$ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
707
$ENV{TMPDIR} = "$tmpdir_abs";
708
$ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
709 710 711 712 713 714 715 716 717 718 719 720
if ($opt_socket_wrapper) {
	$ENV{SELFTEST_INTERFACES} = $interfaces;
} else {
	$ENV{SELFTEST_INTERFACES} = "";
}
if ($opt_quick) {
	$ENV{SELFTEST_QUICK} = "1";
} else {
	$ENV{SELFTEST_QUICK} = "";
}
$ENV{SELFTEST_MAXTIME} = $torture_maxtime;

721 722 723
my $selftest_krbt_ccache_path = "$tmpdir_abs/selftest.krb5_ccache";
$ENV{KRB5CCNAME} = "FILE:${selftest_krbt_ccache_path}.global";

724 725 726 727
my @available = ();
foreach my $fn (@testlists) {
	foreach (read_testlist($fn)) {
		my $name = $$_[0];
728
		next if (@includes and not defined(find_in_list(\@includes, $name)));
729 730 731 732
		push (@available, $_);
	}
}

733
my $restricted = undef;
734
my $restricted_used = {};
735 736 737 738

if ($opt_load_list) {
	$restricted = [];
	open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
739 740
	while (<LOAD_LIST>) {
		chomp;
741 742 743 744 745 746 747 748 749 750
		push (@$restricted, $_);
	}
	close(LOAD_LIST);
}

my $individual_tests = undef;
$individual_tests = {};

foreach my $testsuite (@available) {
	my $name = $$testsuite[0];
751
	my $skipreason = skip(@$testsuite);
752
	if (defined($restricted)) {
753
		# Find the testsuite for this test
754
		my $match = undef;
755 756 757
		foreach my $r (@$restricted) {
			if ($r eq $name) {
				$individual_tests->{$name} = [];
758 759
				$match = $r;
				$restricted_used->{$r} = 1;
760
			} elsif (substr($r, 0, length($name)+1) eq "$name.") {
761
				push(@{$individual_tests->{$name}}, $r);
762 763
				$match = $r;
				$restricted_used->{$r} = 1;
764 765
			}
		}
766 767
		if ($match) {
			if (defined($skipreason)) {
768
				if (not $opt_list) {
769
					Subunit::skip_testsuite($name, $skipreason);
770
				}
771 772 773 774 775
			} else {
				push(@todo, $testsuite);
			}
		}
	} elsif (defined($skipreason)) {
776 777 778
		if (not $opt_list) {
			Subunit::skip_testsuite($name, $skipreason);
		}
779
	} else {
780
		push(@todo, $testsuite);
781
	}
782 783
}

784 785
if (defined($restricted)) {
	foreach (@$restricted) {
786
		unless (defined($restricted_used->{$_})) {
787 788 789 790
			print "No test or testsuite found matching $_\n";
		}
	}
} elsif ($#todo == -1) {
791 792
	print STDERR "No tests to run\n";
	exit(1);
793
}
794

795
my $suitestotal = $#todo + 1;
796

797 798
unless ($opt_list) {
	Subunit::progress($suitestotal);
799
	Subunit::report_time();
800
}
801

802 803 804
my $i = 0;
$| = 1;

805
my %running_envs = ();
806

807 808 809 810 811 812 813 814 815 816 817
sub get_running_env($)
{
	my ($name) = @_;

	my $envname = $name;

	$envname =~ s/:.*//;

	return $running_envs{$envname};
}

818 819 820 821
my @exported_envvars = (
	# domain stuff
	"DOMAIN",
	"REALM",
822
	"DOMSID",
823

824 825 826 827 828 829 830 831 832
	# stuff related to a trusted domain
	"TRUST_SERVER",
	"TRUST_SERVER_IP",
	"TRUST_SERVER_IPV6",
	"TRUST_NETBIOSNAME",
	"TRUST_USERNAME",
	"TRUST_PASSWORD",
	"TRUST_DOMAIN",
	"TRUST_REALM",
833
	"TRUST_DOMSID",
834

835 836 837
	# domain controller stuff
	"DC_SERVER",
	"DC_SERVER_IP",
838
	"DC_SERVER_IPV6",
839 840 841
	"DC_NETBIOSNAME",
	"DC_NETBIOSALIAS",

842
	# domain member
843 844
	"MEMBER_SERVER",
	"MEMBER_SERVER_IP",
845
	"MEMBER_SERVER_IPV6",
846 847 848
	"MEMBER_NETBIOSNAME",
	"MEMBER_NETBIOSALIAS",

849
	# rpc proxy controller stuff
850 851
	"RPC_PROXY_SERVER",
	"RPC_PROXY_SERVER_IP",
852
	"RPC_PROXY_SERVER_IPV6",
853 854 855
	"RPC_PROXY_NETBIOSNAME",
	"RPC_PROXY_NETBIOSALIAS",

856 857 858
	# domain controller stuff for Vampired DC
	"VAMPIRE_DC_SERVER",
	"VAMPIRE_DC_SERVER_IP",
859
	"VAMPIRE_DC_SERVER_IPV6",
860 861 862
	"VAMPIRE_DC_NETBIOSNAME",
	"VAMPIRE_DC_NETBIOSALIAS",

863 864 865 866 867 868
	# domain controller stuff for RODC
	"RODC_DC_SERVER",
	"RODC_DC_SERVER_IP",
	"RODC_DC_SERVER_IPV6",
	"RODC_DC_NETBIOSNAME",

869 870 871 872 873 874 875
	# domain controller stuff for FL 2000 Vampired DC
	"VAMPIRE_2000_DC_SERVER",
	"VAMPIRE_2000_DC_SERVER_IP",
	"VAMPIRE_2000_DC_SERVER_IPV6",
	"VAMPIRE_2000_DC_NETBIOSNAME",
	"VAMPIRE_2000_DC_NETBIOSALIAS",

876 877
	"PROMOTED_DC_SERVER",
	"PROMOTED_DC_SERVER_IP",
878
	"PROMOTED_DC_SERVER_IPV6",
879 880 881
	"PROMOTED_DC_NETBIOSNAME",
	"PROMOTED_DC_NETBIOSALIAS",

882 883
	# server stuff
	"SERVER",
884
	"SERVER_IP",
885
	"SERVER_IPV6",
886
	"NETBIOSNAME",
887
	"NETBIOSALIAS",
888
	"SAMSID",
889 890 891

	# user stuff
	"USERNAME",
892
	"USERID",
893
	"PASSWORD",
894 895
	"DC_USERNAME",
	"DC_PASSWORD",
896

897 898 899 900
	# UID/GID for rfc2307 mapping tests
	"UID_RFC2307TEST",
	"GID_RFC2307TEST",

901
	# misc stuff
902
	"KRB5_CONFIG",
903
	"KRB5CCNAME",
904
	"SELFTEST_WINBINDD_SOCKET_DIR",
905
	"NMBD_SOCKET_DIR",
906
	"LOCAL_PATH",
907 908
	"DNS_FORWARDER1",
	"DNS_FORWARDER2",
909
	"RESOLV_CONF",
910
	"UNACCEPTABLE_PASSWORD",
911
	"LOCK_DIR",
912
	"SMBD_TEST_LOG",
913

914 915 916 917
	# nss_wrapper
	"NSS_WRAPPER_PASSWD",
	"NSS_WRAPPER_GROUP",
	"NSS_WRAPPER_HOSTS",
918
	"NSS_WRAPPER_HOSTNAME",
919 920
	"NSS_WRAPPER_MODULE_SO_PATH",
	"NSS_WRAPPER_MODULE_FN_PREFIX",
921

922 923
	# resolv_wrapper
	"RESOLV_WRAPPER_CONF",
924
	"RESOLV_WRAPPER_HOSTS",
925 926
);

927 928
sub sighandler($)
{
929
	my $signame = shift;
930 931 932 933 934 935 936

	$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";
937
	teardown_env($_) foreach(keys %running_envs);
938 939 940
	system("pstree -p $$");
	print "$0: PID[$$]: Exiting...\n";
	exit(1);
941 942
};

943 944
$SIG{INT} = $SIG{QUIT} = $SIG{TERM} = $SIG{PIPE} = \&sighandler;

945
sub setup_env($$)
946
{
947
	my ($name, $prefix) = @_;
948 949 950 951 952 953 954

	my $testenv_vars = undef;

	my $envname = $name;
	my $option = $name;

	$envname =~ s/:.*//;
955 956
	$option =~ s/^[^:]*//;
	$option =~ s/^://;
957 958

	$option = "client" if $option eq "";
959

960 961 962 963 964 965 966 967 968 969 970 971 972
	# 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
	foreach (@exported_envvars) {
		unless ($_ == "NSS_WRAPPER_HOSTS" ||
		        $_ == "RESOLV_WRAPPER_HOSTS")
		{
			delete $ENV{$_};
		}
	}
	delete $ENV{SOCKET_WRAPPER_DEFAULT_IFACE};
	delete $ENV{SMB_CONF_PATH};

973 974
	$ENV{KRB5CCNAME} = "FILE:${selftest_krbt_ccache_path}.${envname}/ignore";

975
	if (defined(get_running_env($envname))) {
976
		$testenv_vars = get_running_env($envname);
977 978
		if (not $testenv_vars->{target}->check_env($testenv_vars)) {
			print $testenv_vars->{target}->getlog_env($testenv_vars);
979 980
			$testenv_vars = undef;
		}
981
	} else {
982
		$testenv_vars = $target->setup_env($envname, $prefix);
983 984 985
		if (defined($testenv_vars) and $testenv_vars eq "UNKNOWN") {
		    return $testenv_vars;
		} elsif (defined($testenv_vars) && not defined($testenv_vars->{target})) {
986 987 988
		        $testenv_vars->{target} = $target;
		}
		if (not defined($testenv_vars)) {
989
			warn("$opt_target can't start up known environment '$envname'");
990
		}
991
	}
992 993 994

	return undef unless defined($testenv_vars);

995 996
	$running_envs{$envname} = $testenv_vars;

997 998 999 1000
	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") {
1001
		SocketWrapper::set_default_iface(11);
1002
		write_clientconf($conffile, $clientdir, $testenv_vars);
1003 1004 1005 1006
		$ENV{SMB_CONF_PATH} = $conffile;
	} else {
		die("Unknown option[$option] for envname[$envname]");
	}
1007 1008

	foreach (@exported_envvars) {
1009 1010 1011 1012 1013 1014 1015
		if (defined($testenv_vars->{$_})) {
			$ENV{$_} = $testenv_vars->{$_};
		} else {
			delete $ENV{$_};
		}
	}

1016 1017 1018
	my $krb5_ccache_path = "${selftest_krbt_ccache_path}.${envname}.${option}";
	unlink($krb5_ccache_path);
	$ENV{KRB5CCNAME} = "FILE:${krb5_ccache_path}";
1019 1020 1021
	return $testenv_vars;
}

1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034
sub exported_envvars_str($)
{
	my ($testenv_vars) = @_;
	my $out = "";

	foreach (@exported_envvars) {
		next unless defined($testenv_vars->{$_});
		$out .= $_."=".$testenv_vars->{$_}."\n";
	}

	return $out;
}

1035 1036 1037 1038
sub getlog_env($)
{
	my ($envname) = @_;
	return "" if ($envname eq "none");
1039 1040
	my $env = get_running_env($envname);
	return $env->{target}->getlog_env($env);
1041 1042
}

1043 1044 1045
sub check_env($)
{
	my ($envname) = @_;
1046 1047
	my $env = get_running_env($envname);
	return $env->{target}->check_env($env);
1048 1049
}

1050 1051 1052
sub teardown_env($)
{
	my ($envname) = @_;
1053
	return if ($envname eq "none");
1054
	print STDERR "teardown_env($envname)\n";
1055 1056
	my $env = get_running_env($envname);
	$env->{target}->teardown_env($env);
1057 1058
	delete $running_envs{$envname};
}
1059

1060 1061
# This 'global' file needs to be empty when we start
unlink("$prefix_abs/dns_host_file");
1062
unlink("$prefix_abs/hosts");
1063

1064 1065 1066 1067 1068 1069
if ($opt_random_order) {
	require List::Util;
	my @newtodo = List::Util::shuffle(@todo);
	@todo = @newtodo;
}

1070
if ($opt_testenv) {
1071
	my $testenv_name = $ENV{SELFTEST_TESTENV};
1072
	$testenv_name = $testenv_default unless defined($testenv_name);
1073

1074
	my $testenv_vars = setup_env($testenv_name, $prefix);
1075

1076 1077 1078
	if (not $testenv_vars or $testenv_vars eq "UNKNOWN") {
		die("Unable to setup environment $testenv_name");
	}
1079

1080
	$ENV{PIDDIR} = $testenv_vars->{PIDDIR};
1081
	$ENV{ENVNAME} = $testenv_name;
1082 1083 1084

	my $envvarstr = exported_envvars_str($testenv_vars);

1085
	my @term_args = ("echo -e \"
1086 1087
Welcome to the Samba4 Test environment '$testenv_name'

1088
This matches the client environment used in make test
Jelmer Vernooij's avatar
Jelmer Vernooij committed
1089
server is pid `cat \$PIDDIR/samba.pid`
1090 1091 1092

Some useful environment variables:
TORTURE_OPTIONS=\$TORTURE_OPTIONS
1093
SMB_CONF_PATH=\$SMB_CONF_PATH
1094 1095

$envvarstr
1096
\" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash");
1097 1098 1099 1100 1101 1102 1103
	my @term = ();
	if ($ENV{TERMINAL}) {
	    @term = ($ENV{TERMINAL});
	} else {
	    @term = ("xterm", "-e");
	    unshift(@term_args, ("bash", "-c"));
	}
1104 1105 1106

	system(@term, @term_args);

1107
	teardown_env($testenv_name);
1108 1109 1110 1111
} elsif ($opt_list) {
	foreach (@todo) {
		my $name = $$_[0];
		my $envname = $$_[1];
1112 1113
		my $cmd = $$_[2];
		my $listcmd = $$_[3];
1114

1115
		unless (defined($listcmd)) {
1116
			warn("Unable to list tests in $name");
1117 1118 1119
			# Rather than ignoring this testsuite altogether, just pretend the entire testsuite is
			# a single "test".
			print "$name\n";
1120 1121 1122
			next;
		}

1123
		system($listcmd);
1124 1125

		if ($? == -1) {
1126
			die("Unable to run $listcmd: $!");
1127
		} elsif ($? & 127) {
1128
			die(sprintf("%s died with signal %d, %s coredump\n", $listcmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
1129 1130 1131 1132 1133 1134
		}

		my $exitcode = $? >> 8;
		if ($exitcode != 0) {
			die("$cmd exited with exit code $exitcode");
		}
1135
	}
1136 1137 1138
} else {
	foreach (@todo) {
		$i++;
1139
		my $cmd = $$_[2];
1140
		my $name = $$_[0];
1141
		my $envname = $$_[1];
1142
		my $envvars = setup_env($envname, $prefix);
1143

1144
		if (not defined($envvars)) {
1145 1146
			Subunit::start_testsuite($name);
			Subunit::end_testsuite($name, "error",
1147
				"unable to set up environment $envname - exiting");
1148
			next;
1149 1150
		} elsif ($envvars eq "UNKNOWN") {
			Subunit::start_testsuite($name);