selftest/selftest.pl

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