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 file
 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         resolv:host file = $prefix_abs/dns_host_file
 604 ";
 605         close(CF);
 606 }
 607
 608 my @todo = ();
 609
 610 my $testsdir = "$srcdir/selftest";
 611
 612 my %required_envs = ();
 613
 614 sub should_run_test($)
 615 {
 616         my $name = shift;
 617         if ($#tests == -1) {
 618                 return 1;
 619         }
 620         for (my $i=0; $i <= $#tests; $i++) {
 621                 if ($name =~ /$tests[$i]/i) {
 622                         return 1;
 623                 }
 624         }
 625         return 0;
 626 }
 627
 628 sub read_testlist($)
 629 {
 630         my ($filename) = @_;
 631
 632         my @ret = ();
 633         open(IN, $filename) or die("Unable to open $filename: $!");
 634
 635         while (<IN>) {
 636                 if ($_ eq "-- TEST --\n") {
 637                         my $name = <IN>;
 638                         $name =~ s/\n//g;
 639                         my $env = <IN>;
 640                         $env =~ s/\n//g;
 641                         my $cmdline = <IN>;
 642                         $cmdline =~ s/\n//g;
 643                         if (should_run_test($name) == 1) {
 644                                 $required_envs{$env} = 1;
 645                                 push (@ret, [$name, $env, $cmdline]);
 646                         }
 647                 } else {
 648                         print;
 649                 }
 650         }
 651         close(IN) or die("Error creating recipe");
 652         return @ret;
 653 }
 654
 655 if ($#testlists == -1) {
 656         die("No testlists specified");
 657 }
 658
 659 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 660 if ($opt_socket_wrapper) {
 661         $ENV{SELFTEST_INTERFACES} = $interfaces;
 662 } else {
 663         $ENV{SELFTEST_INTERFACES} = "";
 664 }
 665 if ($opt_verbose) {
 666         $ENV{SELFTEST_VERBOSE} = "1";
 667 } else {
 668         $ENV{SELFTEST_VERBOSE} = "";
 669 }
 670 if ($opt_quick) {
 671         $ENV{SELFTEST_QUICK} = "1";
 672 } else {
 673         $ENV{SELFTEST_QUICK} = "";
 674 }
 675 $ENV{SELFTEST_TARGET} = $opt_target;
 676 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 677
 678 my @available = ();
 679 foreach my $fn (@testlists) {
 680         foreach (read_testlist($fn)) {
 681                 my $name = $$_[0];
 682                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 683                 push (@available, $_);
 684         }
 685 }
 686
 687 Subunit::testsuite_count($#available+1);
 688 Subunit::report_time(time());
 689
 690 foreach (@available) {
 691         my $name = $$_[0];
 692         my $skipreason = skip($name);
 693         if (defined($skipreason)) {
 694                 Subunit::skip_testsuite($name, $skipreason);
 695         } else {
 696                 push(@todo, $_);
 697         }
 698 }
 699
 700 if ($#todo == -1) {
 701         print STDERR "No tests to run\n";
 702         exit(1);
 703         }
 704
 705 my $suitestotal = $#todo + 1;
 706 my $i = 0;
 707 $| = 1;
 708
 709 my %running_envs = ();
 710
 711 sub get_running_env($)
 712 {
 713         my ($name) = @_;
 714
 715         my $envname = $name;
 716
 717         $envname =~ s/:.*//;
 718
 719         return $running_envs{$envname};
 720 }
 721
 722 my @exported_envvars = (
 723         # domain stuff
 724         "DOMAIN",
 725         "REALM",
 726
 727         # domain controller stuff
 728         "DC_SERVER",
 729         "DC_SERVER_IP",
 730         "DC_NETBIOSNAME",
 731         "DC_NETBIOSALIAS",
 732
 733         # domain controller stuff
 734         "MEMBER_SERVER",
 735         "MEMBER_SERVER_IP",
 736         "MEMBER_NETBIOSNAME",
 737         "MEMBER_NETBIOSALIAS",
 738
 739         # domain controller stuff
 740         "RPC_PROXY_SERVER",
 741         "RPC_PROXY_SERVER_IP",
 742         "RPC_PROXY_NETBIOSNAME",
 743         "RPC_PROXY_NETBIOSALIAS",
 744
 745         # server stuff
 746         "SERVER",
 747         "SERVER_IP",
 748         "NETBIOSNAME",
 749         "NETBIOSALIAS",
 750
 751         # user stuff
 752         "USERNAME",
 753         "PASSWORD",
 754         "DC_USERNAME",
 755         "DC_PASSWORD",
 756
 757         # misc stuff
 758         "KRB5_CONFIG",
 759         "WINBINDD_SOCKET_DIR",
 760         "WINBINDD_PRIV_PIPE_DIR"
 761 );
 762
 763 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 764         my $signame = shift;
 765         teardown_env($_) foreach(keys %running_envs);
 766         die("Received signal $signame");
 767 };
 768
 769 sub setup_env($)
 770 {
 771         my ($name) = @_;
 772
 773         my $testenv_vars = undef;
 774
 775         my $envname = $name;
 776         my $option = $name;
 777
 778         $envname =~ s/:.*//;
 779         $option =~ s/^[^:]*//;
 780         $option =~ s/^://;
 781
 782         $option = "client" if $option eq "";
 783
 784         if ($envname eq "none") {
 785                 $testenv_vars = {};
 786         } elsif (defined(get_running_env($envname))) {
 787                 $testenv_vars = get_running_env($envname);
 788                 if (not $target->check_env($testenv_vars)) {
 789                         $testenv_vars = undef;
 790                 }
 791         } else {
 792                 $testenv_vars = $target->setup_env($envname, $prefix);
 793         }
 794
 795         return undef unless defined($testenv_vars);
 796
 797         $running_envs{$envname} = $testenv_vars;
 798
 799         if ($option eq "local") {
 800                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 801                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 802         } elsif ($option eq "client") {
 803                 SocketWrapper::set_default_iface(6);
 804                 write_clientconf($conffile, $testenv_vars);
 805                 $ENV{SMB_CONF_PATH} = $conffile;
 806         } else {
 807                 die("Unknown option[$option] for envname[$envname]");
 808         }
 809
 810         foreach (@exported_envvars) {
 811                 if (defined($testenv_vars->{$_})) {
 812                         $ENV{$_} = $testenv_vars->{$_};
 813                 } else {
 814                         delete $ENV{$_};
 815                 }
 816         }
 817
 818         return $testenv_vars;
 819 }
 820
 821 sub exported_envvars_str($)
 822 {
 823         my ($testenv_vars) = @_;
 824         my $out = "";
 825
 826         foreach (@exported_envvars) {
 827                 next unless defined($testenv_vars->{$_});
 828                 $out .= $_."=".$testenv_vars->{$_}."\n";
 829         }
 830
 831         return $out;
 832 }
 833
 834 sub getlog_env($)
 835 {
 836         my ($envname) = @_;
 837         return "" if ($envname eq "none");
 838         return $target->getlog_env(get_running_env($envname));
 839 }
 840
 841 sub check_env($)
 842 {
 843         my ($envname) = @_;
 844         return 1 if ($envname eq "none");
 845         return $target->check_env(get_running_env($envname));
 846 }
 847
 848 sub teardown_env($)
 849 {
 850         my ($envname) = @_;
 851         return if ($envname eq "none");
 852         $target->teardown_env(get_running_env($envname));
 853         delete $running_envs{$envname};
 854 }
 855
 856 # This 'global' file needs to be empty when we start
 857 unlink("$prefix_abs/dns_host_file");
 858
 859 if ($opt_no_lazy_setup) {
 860         setup_env($_) foreach (keys %required_envs);
 861 }
 862
 863 if ($opt_testenv) {
 864         my $testenv_name = $ENV{SELFTEST_TESTENV};
 865         $testenv_name = $testenv_default unless defined($testenv_name);
 866
 867         my $testenv_vars = setup_env($testenv_name);
 868
 869         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 870
 871         my $envvarstr = exported_envvars_str($testenv_vars);
 872
 873         my $term = ($ENV{TERMINAL} or "xterm");
 874         system("$term -e 'echo -e \"
 875 Welcome to the Samba4 Test environment '$testenv_name'
 876
 877 This matches the client environment used in make test
 878 server is pid `cat \$PIDDIR/samba.pid`
 879
 880 Some useful environment variables:
 881 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 882 SMB_CONF_PATH=\$SMB_CONF_PATH
 883
 884 $envvarstr
 885 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 886         teardown_env($testenv_name);
 887 } else {
 888         foreach (@todo) {
 889                 $i++;
 890                 my $cmd = $$_[2];
 891                 $cmd =~ s/([\(\)])/\\$1/g;
 892                 my $name = $$_[0];
 893                 my $envname = $$_[1];
 894
 895                 my $envvars = setup_env($envname);
 896                 if (not defined($envvars)) {
 897                         Subunit::skip_testsuite($name,
 898                                 "unable to set up environment $envname");
 899                         next;
 900                 }
 901
 902                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
 903
 904                 if (defined($opt_analyse_cmd)) {
 905                         system("$opt_analyse_cmd \"$name\"");
 906                 }
 907
 908                 teardown_env($envname) if ($opt_resetup_env);
 909         }
 910 }
 911
 912 print "\n";
 913
 914 teardown_env($_) foreach (keys %running_envs);
 915
 916 $target->stop();
 917
 918 my $failed = 0;
 919
 920 # if there were any valgrind failures, show them
 921 foreach (<$prefix/valgrind.log*>) {
 922         next unless (-s $_);
 923         print "VALGRIND FAILURE\n";
 924         $failed++;
 925         system("cat $_");
 926 }
 927 exit 0;