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