selftest/selftest.pl

   1 #!/usr/bin/perl
   2 # Bootstrap Samba and run a number of tests against it.
   3 # Copyright (C) 2005-2009 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] [--builddir=DIR] [--exeext=EXT][--target=samba4|samba3|win|kvm] [--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<--builddir=DIR>
  48
  49 Build 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 samba4|samba3|win|kvm>
  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 qw(parse_results);
 134 use Subunit::Filter;
 135 use SocketWrapper;
 136
 137 my $opt_help = 0;
 138 my $opt_target = "samba4";
 139 my $opt_quick = 0;
 140 my $opt_socket_wrapper = 0;
 141 my $opt_socket_wrapper_pcap = undef;
 142 my $opt_socket_wrapper_keep_pcap = undef;
 143 my $opt_one = 0;
 144 my @opt_exclude = ();
 145 my @opt_include = ();
 146 my $opt_verbose = 0;
 147 my $opt_image = undef;
 148 my $opt_testenv = 0;
 149 my $ldap = undef;
 150 my $opt_analyse_cmd = undef;
 151 my $opt_resetup_env = undef;
 152 my $opt_bindir = undef;
 153 my $opt_no_lazy_setup = undef;
 154 my $opt_load_list = undef;
 155 my @testlists = ();
 156
 157 my $srcdir = ".";
 158 my $builddir = ".";
 159 my $exeext = "";
 160 my $prefix = "./st";
 161
 162 my @includes = ();
 163 my @excludes = ();
 164
 165 sub find_in_list($$)
 166 {
 167         my ($list, $fullname) = @_;
 168
 169         foreach (@$list) {
 170                 if ($fullname =~ /$$_[0]/) {
 171                          return ($$_[1]) if ($$_[1]);
 172                          return "";
 173                 }
 174         }
 175
 176         return undef;
 177 }
 178
 179 sub skip($)
 180 {
 181         my ($name) = @_;
 182
 183         return find_in_list(\@excludes, $name);
 184 }
 185
 186 sub getlog_env($);
 187
 188 sub setup_pcap($)
 189 {
 190         my ($name) = @_;
 191
 192         return unless ($opt_socket_wrapper_pcap);
 193         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 194
 195         my $fname = $name;
 196         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 197
 198         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 199
 200         SocketWrapper::setup_pcap($pcap_file);
 201
 202         return $pcap_file;
 203 }
 204
 205 sub cleanup_pcap($$)
 206 {
 207         my ($pcap_file, $exitcode) = @_;
 208
 209         return unless ($opt_socket_wrapper_pcap);
 210         return if ($opt_socket_wrapper_keep_pcap);
 211         return unless ($exitcode == 0);
 212         return unless defined($pcap_file);
 213
 214         unlink($pcap_file);
 215 }
 216
 217 # expand strings from %ENV
 218 sub expand_environment_strings($)
 219 {
 220         my $s = shift;
 221         # we use a reverse sort so we do the longer ones first
 222         foreach my $k (sort { $b cmp $a } keys %ENV) {
 223                 $s =~ s/\$$k/$ENV{$k}/g;
 224         }
 225         return $s;
 226 }
 227
 228 sub run_testsuite($$$$$)
 229 {
 230         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 231         my $pcap_file = setup_pcap($name);
 232
 233         Subunit::start_testsuite($name);
 234         Subunit::progress_push();
 235         Subunit::report_time(time());
 236
 237         open(RESULTS, "$cmd 2>&1|");
 238         my $statistics = {
 239                 TESTS_UNEXPECTED_OK => 0,
 240                 TESTS_EXPECTED_OK => 0,
 241                 TESTS_UNEXPECTED_FAIL => 0,
 242                 TESTS_EXPECTED_FAIL => 0,
 243                 TESTS_ERROR => 0,
 244                 TESTS_SKIP => 0,
 245         };
 246
 247         my $msg_ops = new Subunit::Filter("$name\.", []);
 248
 249         parse_results($msg_ops, $statistics, *RESULTS);
 250
 251         my $ret = 0;
 252
 253         unless (close(RESULTS)) {
 254                 if ($!) {
 255                         Subunit::progress_pop();
 256                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 257                         return 0;
 258                 } else {
 259                         $ret = $?;
 260                 }
 261         }
 262
 263         if ($ret & 127) {
 264                 Subunit::progress_pop();
 265                 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
 266                 return 0;
 267         }
 268         my $envlog = getlog_env($envname);
 269         if ($envlog ne "") {
 270                 print "envlog: $envlog\n";
 271         }
 272
 273         print "command: $cmd\n";
 274         printf "expanded command: %s\n", expand_environment_strings($cmd);
 275
 276         my $exitcode = $ret >> 8;
 277
 278         Subunit::report_time(time());
 279         Subunit::progress_pop();
 280         if ($exitcode == 0) {
 281                 Subunit::end_testsuite($name, "success");
 282         } else {
 283                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 284         }
 285
 286         cleanup_pcap($pcap_file, $exitcode);
 287
 288         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 289                 print "PCAP FILE: $pcap_file\n";
 290         }
 291
 292         if ($exitcode != 0) {
 293                 exit(1) if ($opt_one);
 294         }
 295
 296         return $exitcode;
 297 }
 298
 299 sub ShowHelp()
 300 {
 301         print "Samba test runner
 302 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 303 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 304
 305 Usage: $Script [OPTIONS] TESTNAME-REGEX
 306
 307 Generic options:
 308  --help                     this help page
 309  --target=samba[34]|win|kvm Samba version to target
 310  --testlist=FILE            file to read available tests from
 311
 312 Paths:
 313  --prefix=DIR               prefix to run tests in [st]
 314  --srcdir=DIR               source directory [.]
 315  --builddir=DIR             output directory [.]
 316  --exeext=EXT               executable extention []
 317
 318 Target Specific:
 319  --socket-wrapper-pcap      save traffic to pcap directories
 320  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 321                             failed
 322  --socket-wrapper           enable socket wrapper
 323  --bindir=PATH              path to target binaries
 324
 325 Samba4 Specific:
 326  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 327
 328 Kvm Specific:
 329  --image=PATH               path to KVM image
 330
 331 Behaviour:
 332  --quick                    run quick overall test
 333  --one                      abort when the first test fails
 334  --verbose                  be verbose
 335  --analyse-cmd CMD          command to run after each test
 336 ";
 337         exit(0);
 338 }
 339
 340 my $result = GetOptions (
 341                 'help|h|?' => \$opt_help,
 342                 'target=s' => \$opt_target,
 343                 'prefix=s' => \$prefix,
 344                 'socket-wrapper' => \$opt_socket_wrapper,
 345                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 346                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 347                 'quick' => \$opt_quick,
 348                 'one' => \$opt_one,
 349                 'exclude=s' => \@opt_exclude,
 350                 'include=s' => \@opt_include,
 351                 'srcdir=s' => \$srcdir,
 352                 'builddir=s' => \$builddir,
 353                 'exeext=s' => \$exeext,
 354                 'verbose' => \$opt_verbose,
 355                 'testenv' => \$opt_testenv,
 356                 'ldap:s' => \$ldap,
 357                 'analyse-cmd=s' => \$opt_analyse_cmd,
 358                 'no-lazy-setup' => \$opt_no_lazy_setup,
 359                 'resetup-environment' => \$opt_resetup_env,
 360                 'bindir:s' => \$opt_bindir,
 361                 'image=s' => \$opt_image,
 362                 'testlist=s' => \@testlists,
 363                 'load-list=s' => \$opt_load_list,
 364             );
 365
 366 exit(1) if (not $result);
 367
 368 ShowHelp() if ($opt_help);
 369
 370 # we want unbuffered output
 371 $| = 1;
 372
 373 my @tests = @ARGV;
 374
 375 # quick hack to disable rpc validation when using valgrind - its way too slow
 376 unless (defined($ENV{VALGRIND})) {
 377         $ENV{VALIDATE} = "validate";
 378         $ENV{MALLOC_CHECK_} = 2;
 379 }
 380
 381 # make all our python scripts unbuffered
 382 $ENV{PYTHONUNBUFFERED} = 1;
 383
 384 my $bindir = ($opt_bindir or "$builddir/bin");
 385 my $bindir_abs = abs_path($bindir);
 386
 387 # Backwards compatibility:
 388 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 389         if (defined($ENV{FEDORA_DS_ROOT})) {
 390                 $ldap = "fedora-ds";
 391         } else {
 392                 $ldap = "openldap";
 393         }
 394 }
 395
 396 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 397 if ($ldap) {
 398         # LDAP is slow
 399         $torture_maxtime *= 2;
 400 }
 401
 402 $prefix =~ s+//+/+;
 403 $prefix =~ s+/./+/+;
 404 $prefix =~ s+/$++;
 405
 406 die("using an empty prefix isn't allowed") unless $prefix ne "";
 407
 408 #Ensure we have the test prefix around
 409 mkdir($prefix, 0777) unless -d $prefix;
 410
 411 my $prefix_abs = abs_path($prefix);
 412 my $srcdir_abs = abs_path($srcdir);
 413 my $builddir_abs = abs_path($builddir);
 414
 415 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 416 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 417
 418 $ENV{PREFIX} = $prefix;
 419 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 420 $ENV{PREFIX_ABS} = $prefix_abs;
 421 $ENV{SRCDIR} = $srcdir;
 422 $ENV{SRCDIR_ABS} = $srcdir_abs;
 423 $ENV{BUILDDIR} = $builddir;
 424 $ENV{BUILDDIR_ABS} = $builddir_abs;
 425 $ENV{EXEEXT} = $exeext;
 426
 427 my $tls_enabled = not $opt_quick;
 428 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 429 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
 430 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
 431 sub prefix_pathvar($$)
 432 {
 433         my ($name, $newpath) = @_;
 434         if (defined($ENV{$name})) {
 435                 $ENV{$name} = "$newpath:$ENV{$name}";
 436         } else {
 437                 $ENV{$name} = $newpath;
 438         }
 439 }
 440 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 441 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 442
 443 if ($opt_socket_wrapper_keep_pcap) {
 444         # Socket wrapper keep pcap implies socket wrapper pcap
 445         $opt_socket_wrapper_pcap = 1;
 446 }
 447
 448 if ($opt_socket_wrapper_pcap) {
 449         # Socket wrapper pcap implies socket wrapper
 450         $opt_socket_wrapper = 1;
 451 }
 452
 453 my $socket_wrapper_dir;
 454 if ($opt_socket_wrapper) {
 455         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 456         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 457 } else {
 458          unless ($< == 0) {
 459                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 460          }
 461 }
 462
 463 my $target;
 464 my $testenv_default = "none";
 465
 466 if ($opt_target eq "samba4") {
 467         $testenv_default = "all";
 468         require target::Samba4;
 469         $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
 470 } elsif ($opt_target eq "samba3") {
 471         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 472                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 473         }
 474         $testenv_default = "member";
 475         require target::Samba3;
 476         $target = new Samba3($bindir);
 477 } elsif ($opt_target eq "win") {
 478         die("Windows tests will not run with socket wrapper enabled.")
 479                 if ($opt_socket_wrapper);
 480         $testenv_default = "dc";
 481         require target::Windows;
 482         $target = new Windows();
 483 } elsif ($opt_target eq "kvm") {
 484         die("Kvm tests will not run with socket wrapper enabled.")
 485                 if ($opt_socket_wrapper);
 486         require target::Kvm;
 487         die("No image specified") unless ($opt_image);
 488         $target = new Kvm($opt_image, undef);
 489 }
 490
 491 #
 492 # Start a Virtual Distributed Ethernet Switch
 493 # Returns the pid of the switch.
 494 #
 495 sub start_vde_switch($)
 496 {
 497         my ($path) = @_;
 498
 499         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 500
 501         open(PID, "$path/vde.pid");
 502         <PID> =~ /([0-9]+)/;
 503         my $pid = $1;
 504         close(PID);
 505
 506         return $pid;
 507 }
 508
 509 # Stop a Virtual Distributed Ethernet Switch
 510 sub stop_vde_switch($)
 511 {
 512         my ($pid) = @_;
 513         kill 9, $pid;
 514 }
 515
 516 sub read_test_regexes($)
 517 {
 518         my ($name) = @_;
 519         my @ret = ();
 520         open(LF, "<$name") or die("unable to read $name: $!");
 521         while (<LF>) {
 522                 chomp;
 523                 next if (/^#/);
 524                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 525                         push (@ret, [$1, $4]);
 526                 } else {
 527                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 528                         push (@ret, [$_, undef]);
 529                 }
 530         }
 531         close(LF);
 532         return @ret;
 533 }
 534
 535 foreach (@opt_exclude) {
 536         push (@excludes, read_test_regexes($_));
 537 }
 538
 539 foreach (@opt_include) {
 540         push (@includes, read_test_regexes($_));
 541 }
 542
 543 my $interfaces = join(',', ("127.0.0.11/8",
 544                             "127.0.0.12/8",
 545                             "127.0.0.13/8",
 546                             "127.0.0.14/8",
 547                             "127.0.0.15/8",
 548                             "127.0.0.16/8"));
 549
 550 my $conffile = "$prefix_abs/client/client.conf";
 551 $ENV{SMB_CONF_PATH} = $conffile;
 552
 553 sub write_clientconf($$)
 554 {
 555         my ($conffile, $vars) = @_;
 556
 557         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 558
 559         if ( -d "$prefix/client/private" ) {
 560                 unlink <$prefix/client/private/*>;
 561         } else {
 562                 mkdir("$prefix/client/private", 0777);
 563         }
 564
 565         if ( -d "$prefix/client/lockdir" ) {
 566                 unlink <$prefix/client/lockdir/*>;
 567         } else {
 568                 mkdir("$prefix/client/lockdir", 0777);
 569         }
 570
 571         if ( -d "$prefix_abs/client/ncalrpcdir" ) {
 572                 unlink <$prefix/client/ncalrpcdir/*>;
 573         } else {
 574                 mkdir("$prefix/client/ncalrpcdir", 0777);
 575         }
 576
 577         open(CF, ">$conffile");
 578         print CF "[global]\n";
 579         if (defined($ENV{VALGRIND})) {
 580                 print CF "\ticonv:native = true\n";
 581         } else {
 582                 print CF "\ticonv:native = false\n";
 583         }
 584         print CF "\tnetbios name = client\n";
 585         if (defined($vars->{DOMAIN})) {
 586                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 587         }
 588         if (defined($vars->{REALM})) {
 589                 print CF "\trealm = $vars->{REALM}\n";
 590         }
 591         if ($opt_socket_wrapper) {
 592                 print CF "\tinterfaces = $interfaces\n";
 593         }
 594         print CF "
 595         private dir = $prefix_abs/client/private
 596         lock dir = $prefix_abs/client/lockdir
 597         ncalrpc dir = $prefix_abs/client/ncalrpcdir
 598         name resolve order = bcast file
 599         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 600         max xmit = 32K
 601         notify:inotify = false
 602         ldb:nosync = true
 603         system:anonymous = true
 604         client lanman auth = Yes
 605         log level = 1
 606         torture:basedir = $prefix_abs/client
 607 #We don't want to pass our self-tests if the PAC code is wrong
 608         gensec:require_pac = true
 609         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 610         setup directory = ./setup
 611         resolv:host file = $prefix_abs/dns_host_file
 612 ";
 613         close(CF);
 614 }
 615
 616 my @todo = ();
 617
 618 my $testsdir = "$srcdir/selftest";
 619
 620 my %required_envs = ();
 621
 622 sub should_run_test($)
 623 {
 624         my $name = shift;
 625         if ($#tests == -1) {
 626                 return 1;
 627         }
 628         for (my $i=0; $i <= $#tests; $i++) {
 629                 if ($name =~ /$tests[$i]/i) {
 630                         return 1;
 631                 }
 632         }
 633         return 0;
 634 }
 635
 636 sub read_testlist($)
 637 {
 638         my ($filename) = @_;
 639
 640         my @ret = ();
 641         open(IN, $filename) or die("Unable to open $filename: $!");
 642
 643         while (<IN>) {
 644                 if (/-- TEST(-LOADLIST)? --\n/) {
 645                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 646                         my $name = <IN>;
 647                         $name =~ s/\n//g;
 648                         my $env = <IN>;
 649                         $env =~ s/\n//g;
 650                         my $cmdline = <IN>;
 651                         $cmdline =~ s/\n//g;
 652                         if (should_run_test($name) == 1) {
 653                                 $required_envs{$env} = 1;
 654                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist]);
 655                         }
 656                 } else {
 657                         print;
 658                 }
 659         }
 660         close(IN) or die("Error creating recipe");
 661         return @ret;
 662 }
 663
 664 if ($#testlists == -1) {
 665         die("No testlists specified");
 666 }
 667
 668 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 669 if ($opt_socket_wrapper) {
 670         $ENV{SELFTEST_INTERFACES} = $interfaces;
 671 } else {
 672         $ENV{SELFTEST_INTERFACES} = "";
 673 }
 674 if ($opt_verbose) {
 675         $ENV{SELFTEST_VERBOSE} = "1";
 676 } else {
 677         $ENV{SELFTEST_VERBOSE} = "";
 678 }
 679 if ($opt_quick) {
 680         $ENV{SELFTEST_QUICK} = "1";
 681 } else {
 682         $ENV{SELFTEST_QUICK} = "";
 683 }
 684 $ENV{SELFTEST_TARGET} = $opt_target;
 685 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 686
 687 my @available = ();
 688 foreach my $fn (@testlists) {
 689         foreach (read_testlist($fn)) {
 690                 my $name = $$_[0];
 691                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 692                 push (@available, $_);
 693         }
 694 }
 695
 696 my $restricted = undef;
 697 my $restricted_used = {};
 698
 699 if ($opt_load_list) {
 700         $restricted = [];
 701         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 702         while (<LOAD_LIST>) {
 703                 chomp;
 704                 push (@$restricted, $_);
 705         }
 706         close(LOAD_LIST);
 707 }
 708
 709 Subunit::progress($#available+1);
 710 Subunit::report_time(time());
 711
 712 my $individual_tests = undef;
 713 $individual_tests = {};
 714
 715 foreach my $testsuite (@available) {
 716         my $name = $$testsuite[0];
 717         my $skipreason = skip($name);
 718         if (defined($skipreason)) {
 719                 Subunit::skip_testsuite($name, $skipreason);
 720         } elsif (defined($restricted)) {
 721                 # Find the testsuite for this test
 722                 my $match = undef;
 723                 foreach my $r (@$restricted) {
 724                         if ($r eq $name) {
 725                                 $individual_tests->{$name} = [];
 726                                 $match = $r;
 727                                 $restricted_used->{$r} = 1;
 728                         } elsif (substr($r, $name, length($name)+1) eq "$name.") {
 729                                 push(@{$individual_tests->{$name}}, $1);
 730                                 $match = $r;
 731                                 $restricted_used->{$r} = 1;
 732                         }
 733                 }
 734                 push(@todo, $testsuite) if ($match);
 735         } else {
 736                 push(@todo, $testsuite);
 737         }
 738 }
 739
 740 if (defined($restricted)) {
 741         foreach (@$restricted) {
 742                 unless (defined($restricted_used->{$_})) {
 743                         print "No test or testsuite found matching $_\n";
 744                 }
 745         }
 746 } elsif ($#todo == -1) {
 747         print STDERR "No tests to run\n";
 748         exit(1);
 749 }
 750
 751 my $suitestotal = $#todo + 1;
 752 my $i = 0;
 753 $| = 1;
 754
 755 my %running_envs = ();
 756
 757 sub get_running_env($)
 758 {
 759         my ($name) = @_;
 760
 761         my $envname = $name;
 762
 763         $envname =~ s/:.*//;
 764
 765         return $running_envs{$envname};
 766 }
 767
 768 my @exported_envvars = (
 769         # domain stuff
 770         "DOMAIN",
 771         "REALM",
 772
 773         # domain controller stuff
 774         "DC_SERVER",
 775         "DC_SERVER_IP",
 776         "DC_NETBIOSNAME",
 777         "DC_NETBIOSALIAS",
 778
 779         # domain member
 780         "MEMBER_SERVER",
 781         "MEMBER_SERVER_IP",
 782         "MEMBER_NETBIOSNAME",
 783         "MEMBER_NETBIOSALIAS",
 784
 785         # rpc proxy controller stuff
 786         "RPC_PROXY_SERVER",
 787         "RPC_PROXY_SERVER_IP",
 788         "RPC_PROXY_NETBIOSNAME",
 789         "RPC_PROXY_NETBIOSALIAS",
 790
 791         # domain controller stuff for Vampired DC
 792         "VAMPIRE_DC_SERVER",
 793         "VAMPIRE_DC_SERVER_IP",
 794         "VAMPIRE_DC_NETBIOSNAME",
 795         "VAMPIRE_DC_NETBIOSALIAS",
 796
 797         # server stuff
 798         "SERVER",
 799         "SERVER_IP",
 800         "NETBIOSNAME",
 801         "NETBIOSALIAS",
 802
 803         # user stuff
 804         "USERNAME",
 805         "USERID",
 806         "PASSWORD",
 807         "DC_USERNAME",
 808         "DC_PASSWORD",
 809
 810         # misc stuff
 811         "KRB5_CONFIG",
 812         "WINBINDD_SOCKET_DIR",
 813         "WINBINDD_PRIV_PIPE_DIR",
 814         "LOCAL_PATH"
 815 );
 816
 817 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 818         my $signame = shift;
 819         teardown_env($_) foreach(keys %running_envs);
 820         die("Received signal $signame");
 821 };
 822
 823 sub setup_env($)
 824 {
 825         my ($name) = @_;
 826
 827         my $testenv_vars = undef;
 828
 829         my $envname = $name;
 830         my $option = $name;
 831
 832         $envname =~ s/:.*//;
 833         $option =~ s/^[^:]*//;
 834         $option =~ s/^://;
 835
 836         $option = "client" if $option eq "";
 837
 838         if ($envname eq "none") {
 839                 $testenv_vars = {};
 840         } elsif (defined(get_running_env($envname))) {
 841                 $testenv_vars = get_running_env($envname);
 842                 if (not $target->check_env($testenv_vars)) {
 843                         print $target->getlog_env($testenv_vars);
 844                         $testenv_vars = undef;
 845                 }
 846         } else {
 847                 $testenv_vars = $target->setup_env($envname, $prefix);
 848         }
 849
 850         return undef unless defined($testenv_vars);
 851
 852         $running_envs{$envname} = $testenv_vars;
 853
 854         if ($option eq "local") {
 855                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 856                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 857         } elsif ($option eq "client") {
 858                 SocketWrapper::set_default_iface(11);
 859                 write_clientconf($conffile, $testenv_vars);
 860                 $ENV{SMB_CONF_PATH} = $conffile;
 861         } else {
 862                 die("Unknown option[$option] for envname[$envname]");
 863         }
 864
 865         foreach (@exported_envvars) {
 866                 if (defined($testenv_vars->{$_})) {
 867                         $ENV{$_} = $testenv_vars->{$_};
 868                 } else {
 869                         delete $ENV{$_};
 870                 }
 871         }
 872
 873         return $testenv_vars;
 874 }
 875
 876 sub exported_envvars_str($)
 877 {
 878         my ($testenv_vars) = @_;
 879         my $out = "";
 880
 881         foreach (@exported_envvars) {
 882                 next unless defined($testenv_vars->{$_});
 883                 $out .= $_."=".$testenv_vars->{$_}."\n";
 884         }
 885
 886         return $out;
 887 }
 888
 889 sub getlog_env($)
 890 {
 891         my ($envname) = @_;
 892         return "" if ($envname eq "none");
 893         return $target->getlog_env(get_running_env($envname));
 894 }
 895
 896 sub check_env($)
 897 {
 898         my ($envname) = @_;
 899         return 1 if ($envname eq "none");
 900         return $target->check_env(get_running_env($envname));
 901 }
 902
 903 sub teardown_env($)
 904 {
 905         my ($envname) = @_;
 906         return if ($envname eq "none");
 907         $target->teardown_env(get_running_env($envname));
 908         delete $running_envs{$envname};
 909 }
 910
 911 # This 'global' file needs to be empty when we start
 912 unlink("$prefix_abs/dns_host_file");
 913
 914 if ($opt_no_lazy_setup) {
 915         setup_env($_) foreach (keys %required_envs);
 916 }
 917
 918 if ($opt_testenv) {
 919         my $testenv_name = $ENV{SELFTEST_TESTENV};
 920         $testenv_name = $testenv_default unless defined($testenv_name);
 921
 922         my $testenv_vars = setup_env($testenv_name);
 923
 924         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 925
 926         my $envvarstr = exported_envvars_str($testenv_vars);
 927
 928         my $term = ($ENV{TERMINAL} or "xterm");
 929         system("$term -e 'echo -e \"
 930 Welcome to the Samba4 Test environment '$testenv_name'
 931
 932 This matches the client environment used in make test
 933 server is pid `cat \$PIDDIR/samba.pid`
 934
 935 Some useful environment variables:
 936 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 937 SMB_CONF_PATH=\$SMB_CONF_PATH
 938
 939 $envvarstr
 940 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 941         teardown_env($testenv_name);
 942 } else {
 943         foreach (@todo) {
 944                 $i++;
 945                 my $cmd = $$_[2];
 946                 $cmd =~ s/([\(\)])/\\$1/g;
 947                 my $name = $$_[0];
 948                 my $envname = $$_[1];
 949
 950                 my $envvars = setup_env($envname);
 951                 if (not defined($envvars)) {
 952                         Subunit::skip_testsuite($name,
 953                                 "unable to set up environment $envname");
 954                         next;
 955                 }
 956
 957                 # Generate a file with the individual tests to run, if the
 958                 # test runner for this test suite supports it.
 959                 if ($$_[3] and $individual_tests and $individual_tests->{$name}) {
 960                         my ($fh, $listid_file) = tempfile(UNLINK => 0);
 961                         foreach (@{$individual_tests->{$name}}) {
 962                                 print $fh "$_\n";
 963                         }
 964                         $cmd .= " --load-list=$listid_file";
 965                 }
 966
 967                 run_testsuite($envname, $name, $cmd, $i, $suitestotal,
 968                                       );
 969
 970                 if (defined($opt_analyse_cmd)) {
 971                         system("$opt_analyse_cmd \"$name\"");
 972                 }
 973
 974                 teardown_env($envname) if ($opt_resetup_env);
 975         }
 976 }
 977
 978 print "\n";
 979
 980 teardown_env($_) foreach (keys %running_envs);
 981
 982 my $failed = 0;
 983
 984 # if there were any valgrind failures, show them
 985 foreach (<$prefix/valgrind.log*>) {
 986         next unless (-s $_);
 987         print "VALGRIND FAILURE\n";
 988         $failed++;
 989         system("cat $_");
 990 }
 991 exit 0;