selftest/selftest.pl

   1 #!/usr/bin/perl
   2 # 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 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 =pod
  20
  21 =head1 NAME
  22
  23 selftest - Samba test runner
  24
  25 =head1 SYNOPSIS
  26
  27 selftest --help
  28
  29 selftest [--srcdir=DIR] [--bindir=DIR] [--target=samba|samba3|win] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--testlist=FILE] [TESTS]
  30
  31 =head1 DESCRIPTION
  32
  33 A simple test runner. TESTS is a regular expression with tests to run.
  34
  35 =head1 OPTIONS
  36
  37 =over 4
  38
  39 =item I<--help>
  40
  41 Show list of available options.
  42
  43 =item I<--srcdir=DIR>
  44
  45 Source directory.
  46
  47 =item I<--bindir=DIR>
  48
  49 Built binaries directory.
  50
  51 =item I<--prefix=DIR>
  52
  53 Change directory to run tests in. Default is 'st'.
  54
  55 =item I<--target samba|samba3|win>
  56
  57 Specify test target against which to run. Default is 'samba4'.
  58
  59 =item I<--quick>
  60
  61 Run only a limited number of tests. Intended to run in about 30 seconds on
  62 moderately recent systems.
  63
  64 =item I<--socket-wrapper>
  65
  66 Use socket wrapper library for communication with server. Only works
  67 when the server is running locally.
  68
  69 Will prevent TCP and UDP ports being opened on the local host but
  70 (transparently) redirects these calls to use unix domain sockets.
  71
  72 =item I<--exclude>
  73
  74 Specify a file containing a list of tests that should be skipped. Possible
  75 candidates are tests that segfault the server, flip or don't end.
  76
  77 =item I<--include>
  78
  79 Specify a file containing a list of tests that should be run. Same format
  80 as the --exclude flag.
  81
  82 Not includes specified means all tests will be run.
  83
  84 =item I<--one>
  85
  86 Abort as soon as one test fails.
  87
  88 =item I<--testlist>
  89
  90 Load a list of tests from the specified location.
  91
  92 =back
  93
  94 =head1 ENVIRONMENT
  95
  96 =over 4
  97
  98 =item I<SMBD_VALGRIND>
  99
 100 =item I<TORTURE_MAXTIME>
 101
 102 =item I<VALGRIND>
 103
 104 =item I<TLS_ENABLED>
 105
 106 =item I<srcdir>
 107
 108 =back
 109
 110 =head1 LICENSE
 111
 112 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
 113
 114 =head1 AUTHOR
 115
 116 Jelmer Vernooij
 117
 118 =cut
 119
 120 use strict;
 121
 122 use FindBin qw($RealBin $Script);
 123 use File::Spec;
 124 use File::Temp qw(tempfile);
 125 use Getopt::Long;
 126 use POSIX;
 127 use Cwd qw(abs_path);
 128 use lib "$RealBin";
 129 use Subunit;
 130 use SocketWrapper;
 131
 132 eval {
 133 require Time::HiRes;
 134 Time::HiRes->import("time");
 135 };
 136 if ($@) {
 137         print "You don't have Time::Hires installed !\n";
 138 }
 139
 140 my $opt_help = 0;
 141 my $opt_target = "samba";
 142 my $opt_quick = 0;
 143 my $opt_socket_wrapper = 0;
 144 my $opt_socket_wrapper_pcap = undef;
 145 my $opt_socket_wrapper_keep_pcap = undef;
 146 my $opt_one = 0;
 147 my @opt_exclude = ();
 148 my @opt_include = ();
 149 my $opt_verbose = 0;
 150 my $opt_testenv = 0;
 151 my $opt_list = 0;
 152 my $ldap = undef;
 153 my $opt_resetup_env = undef;
 154 my $opt_binary_mapping = "";
 155 my $opt_load_list = undef;
 156 my @testlists = ();
 157
 158 my $srcdir = ".";
 159 my $bindir = "./bin";
 160 my $prefix = "./st";
 161
 162 my @includes = ();
 163 my @excludes = ();
 164
 165 sub pipe_handler {
 166         my $sig = shift @_;
 167         print STDERR "Exiting early because of SIGPIPE.\n";
 168         exit(1);
 169 }
 170
 171 $SIG{PIPE} = \&pipe_handler;
 172
 173 sub find_in_list($$)
 174 {
 175         my ($list, $fullname) = @_;
 176
 177         foreach (@$list) {
 178                 if ($fullname =~ /$$_[0]/) {
 179                          return ($$_[1]) if ($$_[1]);
 180                          return "";
 181                 }
 182         }
 183
 184         return undef;
 185 }
 186
 187 sub skip($)
 188 {
 189         my ($name) = @_;
 190
 191         return find_in_list(\@excludes, $name);
 192 }
 193
 194 sub getlog_env($);
 195
 196 sub setup_pcap($)
 197 {
 198         my ($name) = @_;
 199
 200         return unless ($opt_socket_wrapper_pcap);
 201         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 202
 203         my $fname = $name;
 204         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 205
 206         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 207
 208         SocketWrapper::setup_pcap($pcap_file);
 209
 210         return $pcap_file;
 211 }
 212
 213 sub cleanup_pcap($$)
 214 {
 215         my ($pcap_file, $exitcode) = @_;
 216
 217         return unless ($opt_socket_wrapper_pcap);
 218         return if ($opt_socket_wrapper_keep_pcap);
 219         return unless ($exitcode == 0);
 220         return unless defined($pcap_file);
 221
 222         unlink($pcap_file);
 223 }
 224
 225 # expand strings from %ENV
 226 sub expand_environment_strings($)
 227 {
 228         my $s = shift;
 229         # we use a reverse sort so we do the longer ones first
 230         foreach my $k (sort { $b cmp $a } keys %ENV) {
 231                 $s =~ s/\$$k/$ENV{$k}/g;
 232         }
 233         return $s;
 234 }
 235
 236 sub run_testsuite($$$$$)
 237 {
 238         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 239         my $pcap_file = setup_pcap($name);
 240
 241         Subunit::start_testsuite($name);
 242         Subunit::progress_push();
 243         Subunit::report_time(time());
 244         system($cmd);
 245         Subunit::report_time(time());
 246         Subunit::progress_pop();
 247
 248         if ($? == -1) {
 249                 Subunit::progress_pop();
 250                 Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 251                 exit(1);
 252         } elsif ($? & 127) {
 253                 Subunit::end_testsuite($name, "error",
 254                         sprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
 255                 exit(1);
 256         }
 257
 258         my $exitcode = $? >> 8;
 259
 260         my $envlog = getlog_env($envname);
 261         if ($envlog ne "") {
 262                 print "envlog: $envlog\n";
 263         }
 264
 265         print "command: $cmd\n";
 266         printf "expanded command: %s\n", expand_environment_strings($cmd);
 267
 268         if ($exitcode == 0) {
 269                 Subunit::end_testsuite($name, "success");
 270         } else {
 271                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 272         }
 273
 274         cleanup_pcap($pcap_file, $exitcode);
 275
 276         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 277                 print "PCAP FILE: $pcap_file\n";
 278         }
 279
 280         if ($exitcode != 0) {
 281                 exit(1) if ($opt_one);
 282         }
 283
 284         return $exitcode;
 285 }
 286
 287 sub ShowHelp()
 288 {
 289         print "Samba test runner
 290 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 291 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 292
 293 Usage: $Script [OPTIONS] TESTNAME-REGEX
 294
 295 Generic options:
 296  --help                     this help page
 297  --target=samba[3]|win      Samba version to target
 298  --testlist=FILE            file to read available tests from
 299
 300 Paths:
 301  --prefix=DIR               prefix to run tests in [st]
 302  --srcdir=DIR               source directory [.]
 303  --bindir=DIR               binaries directory [./bin]
 304
 305 Target Specific:
 306  --socket-wrapper-pcap      save traffic to pcap directories
 307  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 308                             failed
 309  --socket-wrapper           enable socket wrapper
 310
 311 Samba4 Specific:
 312  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 313
 314 Behaviour:
 315  --quick                    run quick overall test
 316  --one                      abort when the first test fails
 317  --verbose                  be verbose
 318  --testenv                  run a shell in the requested test environment
 319  --list                     list available tests
 320 ";
 321         exit(0);
 322 }
 323
 324 my $result = GetOptions (
 325                 'help|h|?' => \$opt_help,
 326                 'target=s' => \$opt_target,
 327                 'prefix=s' => \$prefix,
 328                 'socket-wrapper' => \$opt_socket_wrapper,
 329                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 330                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 331                 'quick' => \$opt_quick,
 332                 'one' => \$opt_one,
 333                 'exclude=s' => \@opt_exclude,
 334                 'include=s' => \@opt_include,
 335                 'srcdir=s' => \$srcdir,
 336                 'bindir=s' => \$bindir,
 337                 'verbose' => \$opt_verbose,
 338                 'testenv' => \$opt_testenv,
 339                 'list' => \$opt_list,
 340                 'ldap:s' => \$ldap,
 341                 'resetup-environment' => \$opt_resetup_env,
 342                 'testlist=s' => \@testlists,
 343                 'load-list=s' => \$opt_load_list,
 344                 'binary-mapping=s' => \$opt_binary_mapping
 345             );
 346
 347 exit(1) if (not $result);
 348
 349 ShowHelp() if ($opt_help);
 350
 351 die("--list and --testenv are mutually exclusive") if ($opt_list and $opt_testenv);
 352
 353 # we want unbuffered output
 354 $| = 1;
 355
 356 my @tests = @ARGV;
 357
 358 # quick hack to disable rpc validation when using valgrind - its way too slow
 359 unless (defined($ENV{VALGRIND})) {
 360         $ENV{VALIDATE} = "validate";
 361         $ENV{MALLOC_CHECK_} = 2;
 362 }
 363
 364 # make all our python scripts unbuffered
 365 $ENV{PYTHONUNBUFFERED} = 1;
 366
 367 my $bindir_abs = abs_path($bindir);
 368
 369 # Backwards compatibility:
 370 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 371         if (defined($ENV{FEDORA_DS_ROOT})) {
 372                 $ldap = "fedora-ds";
 373         } else {
 374                 $ldap = "openldap";
 375         }
 376 }
 377
 378 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 379 if ($ldap) {
 380         # LDAP is slow
 381         $torture_maxtime *= 2;
 382 }
 383
 384 $prefix =~ s+//+/+;
 385 $prefix =~ s+/./+/+;
 386 $prefix =~ s+/$++;
 387
 388 die("using an empty prefix isn't allowed") unless $prefix ne "";
 389
 390 # Ensure we have the test prefix around.
 391 #
 392 # We need restrictive
 393 # permissions on this as some subdirectories in this tree will have
 394 # wider permissions (ie 0777) and this would allow other users on the
 395 # host to subvert the test process.
 396 mkdir($prefix, 0700) unless -d $prefix;
 397 chmod 0700, $prefix;
 398
 399 my $prefix_abs = abs_path($prefix);
 400 my $tmpdir_abs = abs_path("$prefix/tmp");
 401 mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;
 402
 403 my $srcdir_abs = abs_path($srcdir);
 404
 405 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 406 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 407
 408 $ENV{PREFIX} = $prefix;
 409 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 410 $ENV{PREFIX_ABS} = $prefix_abs;
 411 $ENV{SRCDIR} = $srcdir;
 412 $ENV{SRCDIR_ABS} = $srcdir_abs;
 413 $ENV{BINDIR} = $bindir_abs;
 414
 415 my $tls_enabled = not $opt_quick;
 416 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 417
 418 sub prefix_pathvar($$)
 419 {
 420         my ($name, $newpath) = @_;
 421         if (defined($ENV{$name})) {
 422                 $ENV{$name} = "$newpath:$ENV{$name}";
 423         } else {
 424                 $ENV{$name} = $newpath;
 425         }
 426 }
 427 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 428 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 429
 430 if ($opt_socket_wrapper_keep_pcap) {
 431         # Socket wrapper keep pcap implies socket wrapper pcap
 432         $opt_socket_wrapper_pcap = 1;
 433 }
 434
 435 if ($opt_socket_wrapper_pcap) {
 436         # Socket wrapper pcap implies socket wrapper
 437         $opt_socket_wrapper = 1;
 438 }
 439
 440 my $socket_wrapper_dir;
 441 if ($opt_socket_wrapper) {
 442         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 443         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 444 } elsif (not $opt_list) {
 445          unless ($< == 0) {
 446                  warn("not using socket wrapper, but also not running as root. Will not be able to listen on proper ports");
 447          }
 448 }
 449
 450 my $target;
 451 my $testenv_default = "none";
 452
 453 my %binary_mapping = ();
 454 if ($opt_binary_mapping) {
 455     my @binmapping_list = split(/,/, $opt_binary_mapping);
 456     foreach my $mapping (@binmapping_list) {
 457         my ($bin, $map) = split(/\:/, $mapping);
 458         $binary_mapping{$bin} = $map;
 459     }
 460 }
 461
 462 $ENV{BINARY_MAPPING} = $opt_binary_mapping;
 463
 464 # After this many seconds, the server will self-terminate.  All tests
 465 # must terminate in this time, and testenv will only stay alive this
 466 # long
 467
 468 my $server_maxtime = 7500;
 469 if (defined($ENV{SMBD_MAXTIME}) and $ENV{SMBD_MAXTIME} ne "") {
 470     $server_maxtime = $ENV{SMBD_MAXTIME};
 471 }
 472
 473 unless ($opt_list) {
 474         if ($opt_target eq "samba") {
 475                 if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 476                         die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 477                 }
 478                 $testenv_default = "dc";
 479                 require target::Samba;
 480                 $target = new Samba($bindir, \%binary_mapping, $ldap, $srcdir, $server_maxtime);
 481         } elsif ($opt_target eq "samba3") {
 482                 if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 483                         die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 484                 }
 485                 $testenv_default = "member";
 486                 require target::Samba3;
 487                 $target = new Samba3($bindir, \%binary_mapping, $srcdir_abs, $server_maxtime);
 488         } elsif ($opt_target eq "win") {
 489                 die("Windows tests will not run with socket wrapper enabled.")
 490                         if ($opt_socket_wrapper);
 491                 $testenv_default = "dc";
 492                 require target::Windows;
 493                 $target = new Windows();
 494         }
 495 }
 496
 497 #
 498 # Start a Virtual Distributed Ethernet Switch
 499 # Returns the pid of the switch.
 500 #
 501 sub start_vde_switch($)
 502 {
 503         my ($path) = @_;
 504
 505         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 506
 507         open(PID, "$path/vde.pid");
 508         <PID> =~ /([0-9]+)/;
 509         my $pid = $1;
 510         close(PID);
 511
 512         return $pid;
 513 }
 514
 515 # Stop a Virtual Distributed Ethernet Switch
 516 sub stop_vde_switch($)
 517 {
 518         my ($pid) = @_;
 519         kill 9, $pid;
 520 }
 521
 522 sub read_test_regexes($)
 523 {
 524         my ($name) = @_;
 525         my @ret = ();
 526         open(LF, "<$name") or die("unable to read $name: $!");
 527         while (<LF>) {
 528                 chomp;
 529                 next if (/^#/);
 530                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 531                         push (@ret, [$1, $4]);
 532                 } else {
 533                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 534                         push (@ret, [$_, undef]);
 535                 }
 536         }
 537         close(LF);
 538         return @ret;
 539 }
 540
 541 foreach (@opt_exclude) {
 542         push (@excludes, read_test_regexes($_));
 543 }
 544
 545 foreach (@opt_include) {
 546         push (@includes, read_test_regexes($_));
 547 }
 548
 549 my $interfaces = join(',', ("127.0.0.11/8",
 550                             "127.0.0.12/8",
 551                             "127.0.0.13/8",
 552                             "127.0.0.14/8",
 553                             "127.0.0.15/8",
 554                             "127.0.0.16/8"));
 555
 556 my $clientdir = "$prefix_abs/client";
 557
 558 my $conffile = "$clientdir/client.conf";
 559 $ENV{SMB_CONF_PATH} = $conffile;
 560
 561 sub write_clientconf($$$)
 562 {
 563         my ($conffile, $clientdir, $vars) = @_;
 564
 565         mkdir("$clientdir", 0777) unless -d "$clientdir";
 566
 567         if ( -d "$clientdir/private" ) {
 568                 unlink <$clientdir/private/*>;
 569         } else {
 570                 mkdir("$clientdir/private", 0777);
 571         }
 572
 573         if ( -d "$clientdir/lockdir" ) {
 574                 unlink <$clientdir/lockdir/*>;
 575         } else {
 576                 mkdir("$clientdir/lockdir", 0777);
 577         }
 578
 579         if ( -d "$clientdir/statedir" ) {
 580                 unlink <$clientdir/statedir/*>;
 581         } else {
 582                 mkdir("$clientdir/statedir", 0777);
 583         }
 584
 585         if ( -d "$clientdir/cachedir" ) {
 586                 unlink <$clientdir/cachedir/*>;
 587         } else {
 588                 mkdir("$clientdir/cachedir", 0777);
 589         }
 590
 591         # this is ugly, but the ncalrpcdir needs exactly 0755
 592         # otherwise tests fail.
 593         my $mask = umask;
 594         umask 0022;
 595         if ( -d "$clientdir/ncalrpcdir/np" ) {
 596                 unlink <$clientdir/ncalrpcdir/np/*>;
 597                 rmdir "$clientdir/ncalrpcdir/np";
 598         }
 599         if ( -d "$clientdir/ncalrpcdir" ) {
 600                 unlink <$clientdir/ncalrpcdir/*>;
 601                 rmdir "$clientdir/ncalrpcdir";
 602         }
 603         mkdir("$clientdir/ncalrpcdir", 0755);
 604         umask $mask;
 605
 606         open(CF, ">$conffile");
 607         print CF "[global]\n";
 608         print CF "\tnetbios name = client\n";
 609         if (defined($vars->{DOMAIN})) {
 610                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 611         }
 612         if (defined($vars->{REALM})) {
 613                 print CF "\trealm = $vars->{REALM}\n";
 614         }
 615         if ($opt_socket_wrapper) {
 616                 print CF "\tinterfaces = $interfaces\n";
 617         }
 618         print CF "
 619         private dir = $clientdir/private
 620         lock dir = $clientdir/lockdir
 621         state directory = $clientdir/statedir
 622         cache directory = $clientdir/cachedir
 623         ncalrpc dir = $clientdir/ncalrpcdir
 624         name resolve order = file bcast
 625         panic action = $RealBin/gdb_backtrace \%d
 626         max xmit = 32K
 627         notify:inotify = false
 628         ldb:nosync = true
 629         system:anonymous = true
 630         client lanman auth = Yes
 631         log level = 1
 632         torture:basedir = $clientdir
 633 #We don't want to pass our self-tests if the PAC code is wrong
 634         gensec:require_pac = true
 635         resolv:host file = $prefix_abs/dns_host_file
 636 #We don't want to run 'speed' tests for very long
 637         torture:timelimit = 1
 638 ";
 639         close(CF);
 640 }
 641
 642 my @todo = ();
 643
 644 sub should_run_test($)
 645 {
 646         my $name = shift;
 647         if ($#tests == -1) {
 648                 return 1;
 649         }
 650         for (my $i=0; $i <= $#tests; $i++) {
 651                 if ($name =~ /$tests[$i]/i) {
 652                         return 1;
 653                 }
 654         }
 655         return 0;
 656 }
 657
 658 sub read_testlist($)
 659 {
 660         my ($filename) = @_;
 661
 662         my @ret = ();
 663         open(IN, $filename) or die("Unable to open $filename: $!");
 664
 665         while (<IN>) {
 666                 if (/-- TEST(-LOADLIST|-IDLIST|) --\n/) {
 667                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 668                         my $supports_idlist = (defined($1) and $1 eq "-IDLIST");
 669                         my $name = <IN>;
 670                         $name =~ s/\n//g;
 671                         my $env = <IN>;
 672                         $env =~ s/\n//g;
 673                         my $cmdline = <IN>;
 674                         $cmdline =~ s/\n//g;
 675                         if (should_run_test($name) == 1) {
 676                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist, $supports_idlist]);
 677                         }
 678                 } else {
 679                         print;
 680                 }
 681         }
 682         close(IN) or die("Error creating recipe");
 683         return @ret;
 684 }
 685
 686 if ($#testlists == -1) {
 687         die("No testlists specified");
 688 }
 689
 690 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 691 $ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
 692 $ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
 693 if ($opt_socket_wrapper) {
 694         $ENV{SELFTEST_INTERFACES} = $interfaces;
 695 } else {
 696         $ENV{SELFTEST_INTERFACES} = "";
 697 }
 698 if ($opt_verbose) {
 699         $ENV{SELFTEST_VERBOSE} = "1";
 700 } else {
 701         $ENV{SELFTEST_VERBOSE} = "";
 702 }
 703 if ($opt_quick) {
 704         $ENV{SELFTEST_QUICK} = "1";
 705 } else {
 706         $ENV{SELFTEST_QUICK} = "";
 707 }
 708 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 709
 710 my @available = ();
 711 foreach my $fn (@testlists) {
 712         foreach (read_testlist($fn)) {
 713                 my $name = $$_[0];
 714                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 715                 push (@available, $_);
 716         }
 717 }
 718
 719 my $restricted = undef;
 720 my $restricted_used = {};
 721
 722 if ($opt_load_list) {
 723         $restricted = [];
 724         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 725         while (<LOAD_LIST>) {
 726                 chomp;
 727                 push (@$restricted, $_);
 728         }
 729         close(LOAD_LIST);
 730 }
 731
 732 my $individual_tests = undef;
 733 $individual_tests = {};
 734
 735 foreach my $testsuite (@available) {
 736         my $name = $$testsuite[0];
 737         my $skipreason = skip($name);
 738         if (defined($restricted)) {
 739                 # Find the testsuite for this test
 740                 my $match = undef;
 741                 foreach my $r (@$restricted) {
 742                         if ($r eq $name) {
 743                                 $individual_tests->{$name} = [];
 744                                 $match = $r;
 745                                 $restricted_used->{$r} = 1;
 746                         } elsif (substr($r, 0, length($name)+1) eq "$name.") {
 747                                 push(@{$individual_tests->{$name}}, $r);
 748                                 $match = $r;
 749                                 $restricted_used->{$r} = 1;
 750                         }
 751                 }
 752                 if ($match) {
 753                         if (defined($skipreason)) {
 754                                 if (not $opt_list) {
 755                                         Subunit::skip_testsuite($name, $skipreason);
 756                                 }
 757                         } else {
 758                                 push(@todo, $testsuite);
 759                         }
 760                 }
 761         } elsif (defined($skipreason)) {
 762                 if (not $opt_list) {
 763                         Subunit::skip_testsuite($name, $skipreason);
 764                 }
 765         } else {
 766                 push(@todo, $testsuite);
 767         }
 768 }
 769
 770 if (defined($restricted)) {
 771         foreach (@$restricted) {
 772                 unless (defined($restricted_used->{$_})) {
 773                         print "No test or testsuite found matching $_\n";
 774                 }
 775         }
 776 } elsif ($#todo == -1) {
 777         print STDERR "No tests to run\n";
 778         exit(1);
 779 }
 780
 781 my $suitestotal = $#todo + 1;
 782
 783 unless ($opt_list) {
 784         Subunit::progress($suitestotal);
 785         Subunit::report_time(time());
 786 }
 787
 788 my $i = 0;
 789 $| = 1;
 790
 791 my %running_envs = ();
 792
 793 sub get_running_env($)
 794 {
 795         my ($name) = @_;
 796
 797         my $envname = $name;
 798
 799         $envname =~ s/:.*//;
 800
 801         return $running_envs{$envname};
 802 }
 803
 804 my @exported_envvars = (
 805         # domain stuff
 806         "DOMAIN",
 807         "REALM",
 808
 809         # domain controller stuff
 810         "DC_SERVER",
 811         "DC_SERVER_IP",
 812         "DC_NETBIOSNAME",
 813         "DC_NETBIOSALIAS",
 814
 815         # domain member
 816         "MEMBER_SERVER",
 817         "MEMBER_SERVER_IP",
 818         "MEMBER_NETBIOSNAME",
 819         "MEMBER_NETBIOSALIAS",
 820
 821         # rpc proxy controller stuff
 822         "RPC_PROXY_SERVER",
 823         "RPC_PROXY_SERVER_IP",
 824         "RPC_PROXY_NETBIOSNAME",
 825         "RPC_PROXY_NETBIOSALIAS",
 826
 827         # domain controller stuff for Vampired DC
 828         "VAMPIRE_DC_SERVER",
 829         "VAMPIRE_DC_SERVER_IP",
 830         "VAMPIRE_DC_NETBIOSNAME",
 831         "VAMPIRE_DC_NETBIOSALIAS",
 832
 833         # server stuff
 834         "SERVER",
 835         "SERVER_IP",
 836         "NETBIOSNAME",
 837         "NETBIOSALIAS",
 838
 839         # user stuff
 840         "USERNAME",
 841         "USERID",
 842         "PASSWORD",
 843         "DC_USERNAME",
 844         "DC_PASSWORD",
 845
 846         # misc stuff
 847         "KRB5_CONFIG",
 848         "WINBINDD_SOCKET_DIR",
 849         "WINBINDD_PRIV_PIPE_DIR",
 850         "NMBD_SOCKET_DIR",
 851         "LOCAL_PATH"
 852 );
 853
 854 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 855         my $signame = shift;
 856         teardown_env($_) foreach(keys %running_envs);
 857         die("Received signal $signame");
 858 };
 859
 860 sub setup_env($$)
 861 {
 862         my ($name, $prefix) = @_;
 863
 864         my $testenv_vars = undef;
 865
 866         my $envname = $name;
 867         my $option = $name;
 868
 869         $envname =~ s/:.*//;
 870         $option =~ s/^[^:]*//;
 871         $option =~ s/^://;
 872
 873         $option = "client" if $option eq "";
 874
 875         if ($envname eq "none") {
 876                 $testenv_vars = {};
 877         } elsif (defined(get_running_env($envname))) {
 878                 $testenv_vars = get_running_env($envname);
 879                 if (not $testenv_vars->{target}->check_env($testenv_vars)) {
 880                         print $testenv_vars->{target}->getlog_env($testenv_vars);
 881                         $testenv_vars = undef;
 882                 }
 883         } else {
 884                 $testenv_vars = $target->setup_env($envname, $prefix);
 885                 if (defined($testenv_vars) and $testenv_vars eq "UNKNOWN") {
 886                     return $testenv_vars;
 887                 } elsif (defined($testenv_vars) && not defined($testenv_vars->{target})) {
 888                         $testenv_vars->{target} = $target;
 889                 }
 890                 if (not defined($testenv_vars)) {
 891                         warn("$opt_target can't start up known environment '$envname'");
 892                 }
 893         }
 894
 895
 896         return undef unless defined($testenv_vars);
 897
 898         $running_envs{$envname} = $testenv_vars;
 899
 900         if ($option eq "local") {
 901                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 902                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 903         } elsif ($option eq "client") {
 904                 SocketWrapper::set_default_iface(11);
 905                 write_clientconf($conffile, $clientdir, $testenv_vars);
 906                 $ENV{SMB_CONF_PATH} = $conffile;
 907         } else {
 908                 die("Unknown option[$option] for envname[$envname]");
 909         }
 910
 911         foreach (@exported_envvars) {
 912                 if (defined($testenv_vars->{$_})) {
 913                         $ENV{$_} = $testenv_vars->{$_};
 914                 } else {
 915                         delete $ENV{$_};
 916                 }
 917         }
 918
 919         return $testenv_vars;
 920 }
 921
 922 sub exported_envvars_str($)
 923 {
 924         my ($testenv_vars) = @_;
 925         my $out = "";
 926
 927         foreach (@exported_envvars) {
 928                 next unless defined($testenv_vars->{$_});
 929                 $out .= $_."=".$testenv_vars->{$_}."\n";
 930         }
 931
 932         return $out;
 933 }
 934
 935 sub getlog_env($)
 936 {
 937         my ($envname) = @_;
 938         return "" if ($envname eq "none");
 939         my $env = get_running_env($envname);
 940         return $env->{target}->getlog_env($env);
 941 }
 942
 943 sub check_env($)
 944 {
 945         my ($envname) = @_;
 946         return 1 if ($envname eq "none");
 947         my $env = get_running_env($envname);
 948         return $env->{target}->check_env($env);
 949 }
 950
 951 sub teardown_env($)
 952 {
 953         my ($envname) = @_;
 954         return if ($envname eq "none");
 955         my $env = get_running_env($envname);
 956         $env->{target}->teardown_env($env);
 957         delete $running_envs{$envname};
 958 }
 959
 960 # This 'global' file needs to be empty when we start
 961 unlink("$prefix_abs/dns_host_file");
 962
 963 if ($opt_testenv) {
 964         my $testenv_name = $ENV{SELFTEST_TESTENV};
 965         $testenv_name = $testenv_default unless defined($testenv_name);
 966
 967         my $testenv_vars = setup_env($testenv_name, $prefix);
 968
 969         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 970
 971         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 972         $ENV{ENVNAME} = $testenv_name;
 973
 974         my $envvarstr = exported_envvars_str($testenv_vars);
 975
 976         my $term = ($ENV{TERMINAL} or "xterm -e");
 977         system("$term 'echo -e \"
 978 Welcome to the Samba4 Test environment '$testenv_name'
 979
 980 This matches the client environment used in make test
 981 server is pid `cat \$PIDDIR/samba.pid`
 982
 983 Some useful environment variables:
 984 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 985 SMB_CONF_PATH=\$SMB_CONF_PATH
 986
 987 $envvarstr
 988 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 989         teardown_env($testenv_name);
 990 } elsif ($opt_list) {
 991         foreach (@todo) {
 992                 my $cmd = $$_[2];
 993                 my $name = $$_[0];
 994                 my $envname = $$_[1];
 995
 996                 unless($cmd =~ /\$LISTOPT/) {
 997                         warn("Unable to list tests in $name");
 998                         next;
 999                 }
1000
1001                 $cmd =~ s/\$LISTOPT/--list/g;
1002
1003                 system($cmd);
1004
1005                 if ($? == -1) {
1006                         die("Unable to run $cmd: $!");
1007                 } elsif ($? & 127) {
1008                         die(snprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
1009                 }
1010
1011                 my $exitcode = $? >> 8;
1012                 if ($exitcode != 0) {
1013                         die("$cmd exited with exit code $exitcode");
1014                 }
1015         }
1016 } else {
1017         foreach (@todo) {
1018                 $i++;
1019                 my $cmd = $$_[2];
1020                 my $name = $$_[0];
1021                 my $envname = $$_[1];
1022
1023                 my $envvars = setup_env($envname, $prefix);
1024                 if (not defined($envvars)) {
1025                         Subunit::start_testsuite($name);
1026                         Subunit::end_testsuite($name, "error",
1027                                 "unable to set up environment $envname - exiting");
1028                         next;
1029                 } elsif ($envvars eq "UNKNOWN") {
1030                         Subunit::start_testsuite($name);
1031                         Subunit::end_testsuite($name, "skip",
1032                                 "environment $envname is unknown in this test backend - skipping");
1033                         next;
1034                 }
1035
1036                 # Generate a file with the individual tests to run, if the
1037                 # test runner for this test suite supports it.
1038                 if ($individual_tests and $individual_tests->{$name}) {
1039                         if ($$_[3]) {
1040                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
1041                                 foreach my $test (@{$individual_tests->{$name}}) {
1042                                         print $fh substr($test, length($name)+1) . "\n";
1043                                 }
1044                                 $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
1045                         } elsif ($$_[4]) {
1046                                 $cmd =~ s/\s+[^\s]+\s*$//;
1047                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
1048                         }
1049                 }
1050
1051                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
1052
1053                 teardown_env($envname) if ($opt_resetup_env);
1054         }
1055 }
1056
1057 print "\n";
1058
1059 teardown_env($_) foreach (keys %running_envs);
1060
1061 my $failed = 0;
1062
1063 # if there were any valgrind failures, show them
1064 foreach (<$prefix/valgrind.log*>) {
1065         next unless (-s $_);
1066         print "VALGRIND FAILURE\n";
1067         $failed++;
1068         system("cat $_");
1069 }
1070 exit 0;