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 = "all";
 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         # domain controller stuff
 733         "MEMBER_SERVER",
 734         "MEMBER_SERVER_IP",
 735         "MEMBER_NETBIOSNAME",
 736         "MEMBER_NETBIOSALIAS",
 737
 738         # domain controller stuff
 739         "RPC_PROXY_SERVER",
 740         "RPC_PROXY_SERVER_IP",
 741         "RPC_PROXY_NETBIOSNAME",
 742         "RPC_PROXY_NETBIOSALIAS",
 743
 744         # server stuff
 745         "SERVER",
 746         "SERVER_IP",
 747         "NETBIOSNAME",
 748         "NETBIOSALIAS",
 749
 750         # user stuff
 751         "USERNAME",
 752         "PASSWORD",
 753         "DC_USERNAME",
 754         "DC_PASSWORD",
 755
 756         # misc stuff
 757         "KRB5_CONFIG",
 758         "WINBINDD_SOCKET_DIR",
 759         "WINBINDD_PRIV_PIPE_DIR"
 760 );
 761
 762 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 763         my $signame = shift;
 764         teardown_env($_) foreach(keys %running_envs);
 765         die("Received signal $signame");
 766 };
 767
 768 sub setup_env($)
 769 {
 770         my ($name) = @_;
 771
 772         my $testenv_vars = undef;
 773
 774         my $envname = $name;
 775         my $option = $name;
 776
 777         $envname =~ s/:.*//;
 778         $option =~ s/^[^:]*//;
 779         $option =~ s/^://;
 780
 781         $option = "client" if $option eq "";
 782
 783         if ($envname eq "none") {
 784                 $testenv_vars = {};
 785         } elsif (defined(get_running_env($envname))) {
 786                 $testenv_vars = get_running_env($envname);
 787                 if (not $target->check_env($testenv_vars)) {
 788                         $testenv_vars = undef;
 789                 }
 790         } else {
 791                 $testenv_vars = $target->setup_env($envname, $prefix);
 792         }
 793
 794         return undef unless defined($testenv_vars);
 795
 796         $running_envs{$envname} = $testenv_vars;
 797
 798         if ($option eq "local") {
 799                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 800                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 801         } elsif ($option eq "client") {
 802                 SocketWrapper::set_default_iface(6);
 803                 write_clientconf($conffile, $testenv_vars);
 804                 $ENV{SMB_CONF_PATH} = $conffile;
 805         } else {
 806                 die("Unknown option[$option] for envname[$envname]");
 807         }
 808
 809         foreach (@exported_envvars) {
 810                 if (defined($testenv_vars->{$_})) {
 811                         $ENV{$_} = $testenv_vars->{$_};
 812                 } else {
 813                         delete $ENV{$_};
 814                 }
 815         }
 816
 817         return $testenv_vars;
 818 }
 819
 820 sub exported_envvars_str($)
 821 {
 822         my ($testenv_vars) = @_;
 823         my $out = "";
 824
 825         foreach (@exported_envvars) {
 826                 next unless defined($testenv_vars->{$_});
 827                 $out .= $_."=".$testenv_vars->{$_}."\n";
 828         }
 829
 830         return $out;
 831 }
 832
 833 sub getlog_env($)
 834 {
 835         my ($envname) = @_;
 836         return "" if ($envname eq "none");
 837         return $target->getlog_env(get_running_env($envname));
 838 }
 839
 840 sub check_env($)
 841 {
 842         my ($envname) = @_;
 843         return 1 if ($envname eq "none");
 844         return $target->check_env(get_running_env($envname));
 845 }
 846
 847 sub teardown_env($)
 848 {
 849         my ($envname) = @_;
 850         return if ($envname eq "none");
 851         $target->teardown_env(get_running_env($envname));
 852         delete $running_envs{$envname};
 853 }
 854
 855 if ($opt_no_lazy_setup) {
 856         setup_env($_) foreach (keys %required_envs);
 857 }
 858
 859 if ($opt_testenv) {
 860         my $testenv_name = $ENV{SELFTEST_TESTENV};
 861         $testenv_name = $testenv_default unless defined($testenv_name);
 862
 863         my $testenv_vars = setup_env($testenv_name);
 864
 865         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 866
 867         my $envvarstr = exported_envvars_str($testenv_vars);
 868
 869         my $term = ($ENV{TERMINAL} or "xterm");
 870         system("$term -e 'echo -e \"
 871 Welcome to the Samba4 Test environment '$testenv_name'
 872
 873 This matches the client environment used in make test
 874 server is pid `cat \$PIDDIR/samba.pid`
 875
 876 Some useful environment variables:
 877 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 878 SMB_CONF_PATH=\$SMB_CONF_PATH
 879
 880 $envvarstr
 881 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 882         teardown_env($testenv_name);
 883 } else {
 884         foreach (@todo) {
 885                 $i++;
 886                 my $cmd = $$_[2];
 887                 $cmd =~ s/([\(\)])/\\$1/g;
 888                 my $name = $$_[0];
 889                 my $envname = $$_[1];
 890
 891                 my $envvars = setup_env($envname);
 892                 if (not defined($envvars)) {
 893                         Subunit::skip_testsuite($name,
 894                                 "unable to set up environment $envname");
 895                         next;
 896                 }
 897
 898                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
 899
 900                 if (defined($opt_analyse_cmd)) {
 901                         system("$opt_analyse_cmd \"$name\"");
 902                 }
 903
 904                 teardown_env($envname) if ($opt_resetup_env);
 905         }
 906 }
 907
 908 print "\n";
 909
 910 teardown_env($_) foreach (keys %running_envs);
 911
 912 $target->stop();
 913
 914 my $failed = 0;
 915
 916 # if there were any valgrind failures, show them
 917 foreach (<$prefix/valgrind.log*>) {
 918         next unless (-s $_);
 919         print "VALGRIND FAILURE\n";
 920         $failed++;
 921         system("cat $_");
 922 }
 923 exit 0;