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