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) && not defined($testenv_vars->{target})) {
 886                         $testenv_vars->{target} = $target;
 887                 }
 888                 if (not defined($testenv_vars)) {
 889                         warn("$opt_target can't provide environment '$envname'");
 890                 }
 891         }
 892
 893
 894         return undef unless defined($testenv_vars);
 895
 896         $running_envs{$envname} = $testenv_vars;
 897
 898         if ($option eq "local") {
 899                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 900                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 901         } elsif ($option eq "client") {
 902                 SocketWrapper::set_default_iface(11);
 903                 write_clientconf($conffile, $clientdir, $testenv_vars);
 904                 $ENV{SMB_CONF_PATH} = $conffile;
 905         } else {
 906                 die("Unknown option[$option] for envname[$envname]");
 907         }
 908
 909         foreach (@exported_envvars) {
 910                 if (defined($testenv_vars->{$_})) {
 911                         $ENV{$_} = $testenv_vars->{$_};
 912                 } else {
 913                         delete $ENV{$_};
 914                 }
 915         }
 916
 917         return $testenv_vars;
 918 }
 919
 920 sub exported_envvars_str($)
 921 {
 922         my ($testenv_vars) = @_;
 923         my $out = "";
 924
 925         foreach (@exported_envvars) {
 926                 next unless defined($testenv_vars->{$_});
 927                 $out .= $_."=".$testenv_vars->{$_}."\n";
 928         }
 929
 930         return $out;
 931 }
 932
 933 sub getlog_env($)
 934 {
 935         my ($envname) = @_;
 936         return "" if ($envname eq "none");
 937         my $env = get_running_env($envname);
 938         return $env->{target}->getlog_env($env);
 939 }
 940
 941 sub check_env($)
 942 {
 943         my ($envname) = @_;
 944         return 1 if ($envname eq "none");
 945         my $env = get_running_env($envname);
 946         return $env->{target}->check_env($env);
 947 }
 948
 949 sub teardown_env($)
 950 {
 951         my ($envname) = @_;
 952         return if ($envname eq "none");
 953         my $env = get_running_env($envname);
 954         $env->{target}->teardown_env($env);
 955         delete $running_envs{$envname};
 956 }
 957
 958 # This 'global' file needs to be empty when we start
 959 unlink("$prefix_abs/dns_host_file");
 960
 961 if ($opt_testenv) {
 962         my $testenv_name = $ENV{SELFTEST_TESTENV};
 963         $testenv_name = $testenv_default unless defined($testenv_name);
 964
 965         my $testenv_vars = setup_env($testenv_name, $prefix);
 966
 967         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 968
 969         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 970         $ENV{ENVNAME} = $testenv_name;
 971
 972         my $envvarstr = exported_envvars_str($testenv_vars);
 973
 974         my $term = ($ENV{TERMINAL} or "xterm -e");
 975         system("$term 'echo -e \"
 976 Welcome to the Samba4 Test environment '$testenv_name'
 977
 978 This matches the client environment used in make test
 979 server is pid `cat \$PIDDIR/samba.pid`
 980
 981 Some useful environment variables:
 982 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 983 SMB_CONF_PATH=\$SMB_CONF_PATH
 984
 985 $envvarstr
 986 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 987         teardown_env($testenv_name);
 988 } elsif ($opt_list) {
 989         foreach (@todo) {
 990                 my $cmd = $$_[2];
 991                 my $name = $$_[0];
 992                 my $envname = $$_[1];
 993
 994                 unless($cmd =~ /\$LISTOPT/) {
 995                         warn("Unable to list tests in $name");
 996                         next;
 997                 }
 998
 999                 $cmd =~ s/\$LISTOPT/--list/g;
1000
1001                 system($cmd);
1002
1003                 if ($? == -1) {
1004                         die("Unable to run $cmd: $!");
1005                 } elsif ($? & 127) {
1006                         die(snprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
1007                 }
1008
1009                 my $exitcode = $? >> 8;
1010                 if ($exitcode != 0) {
1011                         die("$cmd exited with exit code $exitcode");
1012                 }
1013         }
1014 } else {
1015         foreach (@todo) {
1016                 $i++;
1017                 my $cmd = $$_[2];
1018                 my $name = $$_[0];
1019                 my $envname = $$_[1];
1020
1021                 my $envvars = setup_env($envname, $prefix);
1022                 if (not defined($envvars)) {
1023                         Subunit::start_testsuite($name);
1024                         Subunit::end_testsuite($name, "error",
1025                                 "unable to set up environment $envname - exiting");
1026                         next;
1027                 }
1028
1029                 # Generate a file with the individual tests to run, if the
1030                 # test runner for this test suite supports it.
1031                 if ($individual_tests and $individual_tests->{$name}) {
1032                         if ($$_[3]) {
1033                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
1034                                 foreach my $test (@{$individual_tests->{$name}}) {
1035                                         print $fh substr($test, length($name)+1) . "\n";
1036                                 }
1037                                 $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
1038                         } elsif ($$_[4]) {
1039                                 $cmd =~ s/\s+[^\s]+\s*$//;
1040                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
1041                         }
1042                 }
1043
1044                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
1045
1046                 teardown_env($envname) if ($opt_resetup_env);
1047         }
1048 }
1049
1050 print "\n";
1051
1052 teardown_env($_) foreach (keys %running_envs);
1053
1054 my $failed = 0;
1055
1056 # if there were any valgrind failures, show them
1057 foreach (<$prefix/valgrind.log*>) {
1058         next unless (-s $_);
1059         print "VALGRIND FAILURE\n";
1060         $failed++;
1061         system("cat $_");
1062 }
1063 exit 0;