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