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 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_analyse_cmd = undef;
 157 my $opt_resetup_env = undef;
 158 my $opt_bindir = undef;
 159 my $opt_load_list = undef;
 160 my @testlists = ();
 161
 162 my $srcdir = ".";
 163 my $builddir = ".";
 164 my $exeext = "";
 165 my $prefix = "./st";
 166
 167 my @includes = ();
 168 my @excludes = ();
 169
 170 sub find_in_list($$)
 171 {
 172         my ($list, $fullname) = @_;
 173
 174         foreach (@$list) {
 175                 if ($fullname =~ /$$_[0]/) {
 176                          return ($$_[1]) if ($$_[1]);
 177                          return "";
 178                 }
 179         }
 180
 181         return undef;
 182 }
 183
 184 sub skip($)
 185 {
 186         my ($name) = @_;
 187
 188         return find_in_list(\@excludes, $name);
 189 }
 190
 191 sub getlog_env($);
 192
 193 sub setup_pcap($)
 194 {
 195         my ($name) = @_;
 196
 197         return unless ($opt_socket_wrapper_pcap);
 198         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 199
 200         my $fname = $name;
 201         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 202
 203         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 204
 205         SocketWrapper::setup_pcap($pcap_file);
 206
 207         return $pcap_file;
 208 }
 209
 210 sub cleanup_pcap($$)
 211 {
 212         my ($pcap_file, $exitcode) = @_;
 213
 214         return unless ($opt_socket_wrapper_pcap);
 215         return if ($opt_socket_wrapper_keep_pcap);
 216         return unless ($exitcode == 0);
 217         return unless defined($pcap_file);
 218
 219         unlink($pcap_file);
 220 }
 221
 222 # expand strings from %ENV
 223 sub expand_environment_strings($)
 224 {
 225         my $s = shift;
 226         # we use a reverse sort so we do the longer ones first
 227         foreach my $k (sort { $b cmp $a } keys %ENV) {
 228                 $s =~ s/\$$k/$ENV{$k}/g;
 229         }
 230         return $s;
 231 }
 232
 233 sub run_testsuite($$$$$)
 234 {
 235         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 236         my $pcap_file = setup_pcap($name);
 237
 238         Subunit::start_testsuite($name);
 239         Subunit::progress_push();
 240         Subunit::report_time(time());
 241
 242         open(RESULTS, "$cmd 2>&1|");
 243
 244         Subunit::filter_add_prefix("$name\.", *RESULTS);
 245
 246         my $ret = 0;
 247
 248         unless (close(RESULTS)) {
 249                 if ($!) {
 250                         Subunit::progress_pop();
 251                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 252                         return 0;
 253                 } else {
 254                         $ret = $?;
 255                 }
 256         }
 257
 258         if ($ret & 127) {
 259                 Subunit::progress_pop();
 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         Subunit::progress_pop();
 275         if ($exitcode == 0) {
 276                 Subunit::end_testsuite($name, "success");
 277         } else {
 278                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 279         }
 280
 281         cleanup_pcap($pcap_file, $exitcode);
 282
 283         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 284                 print "PCAP FILE: $pcap_file\n";
 285         }
 286
 287         if ($exitcode != 0) {
 288                 exit(1) if ($opt_one);
 289         }
 290
 291         return $exitcode;
 292 }
 293
 294 sub ShowHelp()
 295 {
 296         print "Samba test runner
 297 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 298 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 299
 300 Usage: $Script [OPTIONS] TESTNAME-REGEX
 301
 302 Generic options:
 303  --help                     this help page
 304  --target=samba[34]|win|kvm Samba version to target
 305  --testlist=FILE            file to read available tests from
 306
 307 Paths:
 308  --prefix=DIR               prefix to run tests in [st]
 309  --srcdir=DIR               source directory [.]
 310  --builddir=DIR             output directory [.]
 311  --exeext=EXT               executable extention []
 312
 313 Target Specific:
 314  --socket-wrapper-pcap      save traffic to pcap directories
 315  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 316                             failed
 317  --socket-wrapper           enable socket wrapper
 318  --bindir=PATH              path to target binaries
 319
 320 Samba4 Specific:
 321  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 322
 323 Kvm Specific:
 324  --image=PATH               path to KVM image
 325
 326 Behaviour:
 327  --quick                    run quick overall test
 328  --one                      abort when the first test fails
 329  --verbose                  be verbose
 330  --analyse-cmd CMD          command to run after each test
 331 ";
 332         exit(0);
 333 }
 334
 335 my $result = GetOptions (
 336                 'help|h|?' => \$opt_help,
 337                 'target=s' => \$opt_target,
 338                 'prefix=s' => \$prefix,
 339                 'socket-wrapper' => \$opt_socket_wrapper,
 340                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 341                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 342                 'quick' => \$opt_quick,
 343                 'one' => \$opt_one,
 344                 'exclude=s' => \@opt_exclude,
 345                 'include=s' => \@opt_include,
 346                 'srcdir=s' => \$srcdir,
 347                 'builddir=s' => \$builddir,
 348                 'exeext=s' => \$exeext,
 349                 'verbose' => \$opt_verbose,
 350                 'testenv' => \$opt_testenv,
 351                 'ldap:s' => \$ldap,
 352                 'analyse-cmd=s' => \$opt_analyse_cmd,
 353                 'resetup-environment' => \$opt_resetup_env,
 354                 'bindir:s' => \$opt_bindir,
 355                 'image=s' => \$opt_image,
 356                 'testlist=s' => \@testlists,
 357                 'load-list=s' => \$opt_load_list,
 358             );
 359
 360 exit(1) if (not $result);
 361
 362 ShowHelp() if ($opt_help);
 363
 364 # we want unbuffered output
 365 $| = 1;
 366
 367 my @tests = @ARGV;
 368
 369 # quick hack to disable rpc validation when using valgrind - its way too slow
 370 unless (defined($ENV{VALGRIND})) {
 371         $ENV{VALIDATE} = "validate";
 372         $ENV{MALLOC_CHECK_} = 2;
 373 }
 374
 375 # make all our python scripts unbuffered
 376 $ENV{PYTHONUNBUFFERED} = 1;
 377
 378 my $bindir = ($opt_bindir or "$builddir/bin");
 379 my $bindir_abs = abs_path($bindir);
 380
 381 # Backwards compatibility:
 382 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 383         if (defined($ENV{FEDORA_DS_ROOT})) {
 384                 $ldap = "fedora-ds";
 385         } else {
 386                 $ldap = "openldap";
 387         }
 388 }
 389
 390 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 391 if ($ldap) {
 392         # LDAP is slow
 393         $torture_maxtime *= 2;
 394 }
 395
 396 $prefix =~ s+//+/+;
 397 $prefix =~ s+/./+/+;
 398 $prefix =~ s+/$++;
 399
 400 die("using an empty prefix isn't allowed") unless $prefix ne "";
 401
 402 #Ensure we have the test prefix around
 403 mkdir($prefix, 0777) unless -d $prefix;
 404
 405 my $prefix_abs = abs_path($prefix);
 406 my $srcdir_abs = abs_path($srcdir);
 407 my $builddir_abs = abs_path($builddir);
 408
 409 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 410 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 411
 412 $ENV{PREFIX} = $prefix;
 413 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 414 $ENV{PREFIX_ABS} = $prefix_abs;
 415 $ENV{SRCDIR} = $srcdir;
 416 $ENV{SRCDIR_ABS} = $srcdir_abs;
 417 $ENV{BUILDDIR} = $builddir;
 418 $ENV{BUILDDIR_ABS} = $builddir_abs;
 419 $ENV{EXEEXT} = $exeext;
 420
 421 my $tls_enabled = not $opt_quick;
 422 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 423 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
 424 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
 425 sub prefix_pathvar($$)
 426 {
 427         my ($name, $newpath) = @_;
 428         if (defined($ENV{$name})) {
 429                 $ENV{$name} = "$newpath:$ENV{$name}";
 430         } else {
 431                 $ENV{$name} = $newpath;
 432         }
 433 }
 434 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 435 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 436
 437 if ($opt_socket_wrapper_keep_pcap) {
 438         # Socket wrapper keep pcap implies socket wrapper pcap
 439         $opt_socket_wrapper_pcap = 1;
 440 }
 441
 442 if ($opt_socket_wrapper_pcap) {
 443         # Socket wrapper pcap implies socket wrapper
 444         $opt_socket_wrapper = 1;
 445 }
 446
 447 my $socket_wrapper_dir;
 448 if ($opt_socket_wrapper) {
 449         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 450         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 451 } else {
 452          unless ($< == 0) {
 453                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 454          }
 455 }
 456
 457 my $target;
 458 my $testenv_default = "none";
 459
 460 if ($opt_target eq "samba4") {
 461         $testenv_default = "all";
 462         require target::Samba4;
 463         $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
 464 } elsif ($opt_target eq "samba3") {
 465         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 466                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 467         }
 468         $testenv_default = "member";
 469         require target::Samba3;
 470         $target = new Samba3($bindir);
 471 } elsif ($opt_target eq "win") {
 472         die("Windows tests will not run with socket wrapper enabled.")
 473                 if ($opt_socket_wrapper);
 474         $testenv_default = "dc";
 475         require target::Windows;
 476         $target = new Windows();
 477 } elsif ($opt_target eq "kvm") {
 478         die("Kvm tests will not run with socket wrapper enabled.")
 479                 if ($opt_socket_wrapper);
 480         require target::Kvm;
 481         die("No image specified") unless ($opt_image);
 482         $target = new Kvm($opt_image, undef);
 483 }
 484
 485 #
 486 # Start a Virtual Distributed Ethernet Switch
 487 # Returns the pid of the switch.
 488 #
 489 sub start_vde_switch($)
 490 {
 491         my ($path) = @_;
 492
 493         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 494
 495         open(PID, "$path/vde.pid");
 496         <PID> =~ /([0-9]+)/;
 497         my $pid = $1;
 498         close(PID);
 499
 500         return $pid;
 501 }
 502
 503 # Stop a Virtual Distributed Ethernet Switch
 504 sub stop_vde_switch($)
 505 {
 506         my ($pid) = @_;
 507         kill 9, $pid;
 508 }
 509
 510 sub read_test_regexes($)
 511 {
 512         my ($name) = @_;
 513         my @ret = ();
 514         open(LF, "<$name") or die("unable to read $name: $!");
 515         while (<LF>) {
 516                 chomp;
 517                 next if (/^#/);
 518                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 519                         push (@ret, [$1, $4]);
 520                 } else {
 521                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 522                         push (@ret, [$_, undef]);
 523                 }
 524         }
 525         close(LF);
 526         return @ret;
 527 }
 528
 529 foreach (@opt_exclude) {
 530         push (@excludes, read_test_regexes($_));
 531 }
 532
 533 foreach (@opt_include) {
 534         push (@includes, read_test_regexes($_));
 535 }
 536
 537 my $interfaces = join(',', ("127.0.0.11/8",
 538                             "127.0.0.12/8",
 539                             "127.0.0.13/8",
 540                             "127.0.0.14/8",
 541                             "127.0.0.15/8",
 542                             "127.0.0.16/8"));
 543
 544 my $conffile = "$prefix_abs/client/client.conf";
 545 $ENV{SMB_CONF_PATH} = $conffile;
 546
 547 sub write_clientconf($$)
 548 {
 549         my ($conffile, $vars) = @_;
 550
 551         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 552
 553         if ( -d "$prefix/client/private" ) {
 554                 unlink <$prefix/client/private/*>;
 555         } else {
 556                 mkdir("$prefix/client/private", 0777);
 557         }
 558
 559         if ( -d "$prefix/client/lockdir" ) {
 560                 unlink <$prefix/client/lockdir/*>;
 561         } else {
 562                 mkdir("$prefix/client/lockdir", 0777);
 563         }
 564
 565         if ( -d "$prefix_abs/client/ncalrpcdir" ) {
 566                 unlink <$prefix/client/ncalrpcdir/*>;
 567         } else {
 568                 mkdir("$prefix/client/ncalrpcdir", 0777);
 569         }
 570
 571         open(CF, ">$conffile");
 572         print CF "[global]\n";
 573         if (defined($ENV{VALGRIND})) {
 574                 print CF "\ticonv:native = true\n";
 575         } else {
 576                 print CF "\ticonv:native = false\n";
 577         }
 578         print CF "\tnetbios name = client\n";
 579         if (defined($vars->{DOMAIN})) {
 580                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 581         }
 582         if (defined($vars->{REALM})) {
 583                 print CF "\trealm = $vars->{REALM}\n";
 584         }
 585         if ($opt_socket_wrapper) {
 586                 print CF "\tinterfaces = $interfaces\n";
 587         }
 588         print CF "
 589         private dir = $prefix_abs/client/private
 590         lock dir = $prefix_abs/client/lockdir
 591         ncalrpc dir = $prefix_abs/client/ncalrpcdir
 592         name resolve order = bcast file
 593         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 594         max xmit = 32K
 595         notify:inotify = false
 596         ldb:nosync = true
 597         system:anonymous = true
 598         client lanman auth = Yes
 599         log level = 1
 600         torture:basedir = $prefix_abs/client
 601 #We don't want to pass our self-tests if the PAC code is wrong
 602         gensec:require_pac = true
 603         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 604         setup directory = ./setup
 605         resolv:host file = $prefix_abs/dns_host_file
 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 Subunit::progress($#available+1);
 702 Subunit::report_time(time());
 703
 704 my $individual_tests = undef;
 705 $individual_tests = {};
 706
 707 foreach my $testsuite (@available) {
 708         my $name = $$testsuite[0];
 709         my $skipreason = skip($name);
 710         if (defined($skipreason)) {
 711                 Subunit::skip_testsuite($name, $skipreason);
 712         } elsif (defined($restricted)) {
 713                 # Find the testsuite for this test
 714                 my $match = undef;
 715                 foreach my $r (@$restricted) {
 716                         if ($r eq $name) {
 717                                 $individual_tests->{$name} = [];
 718                                 $match = $r;
 719                                 $restricted_used->{$r} = 1;
 720                         } elsif (substr($r, 0, length($name)+1) eq "$name.") {
 721                                 push(@{$individual_tests->{$name}}, substr($r, length($name)+1));
 722                                 $match = $r;
 723                                 $restricted_used->{$r} = 1;
 724                         }
 725                 }
 726                 push(@todo, $testsuite) if ($match);
 727         } else {
 728                 push(@todo, $testsuite);
 729         }
 730 }
 731
 732 if (defined($restricted)) {
 733         foreach (@$restricted) {
 734                 unless (defined($restricted_used->{$_})) {
 735                         print "No test or testsuite found matching $_\n";
 736                 }
 737         }
 738 } elsif ($#todo == -1) {
 739         print STDERR "No tests to run\n";
 740         exit(1);
 741 }
 742
 743 my $suitestotal = $#todo + 1;
 744 my $i = 0;
 745 $| = 1;
 746
 747 my %running_envs = ();
 748
 749 sub get_running_env($)
 750 {
 751         my ($name) = @_;
 752
 753         my $envname = $name;
 754
 755         $envname =~ s/:.*//;
 756
 757         return $running_envs{$envname};
 758 }
 759
 760 my @exported_envvars = (
 761         # domain stuff
 762         "DOMAIN",
 763         "REALM",
 764
 765         # domain controller stuff
 766         "DC_SERVER",
 767         "DC_SERVER_IP",
 768         "DC_NETBIOSNAME",
 769         "DC_NETBIOSALIAS",
 770
 771         # domain member
 772         "MEMBER_SERVER",
 773         "MEMBER_SERVER_IP",
 774         "MEMBER_NETBIOSNAME",
 775         "MEMBER_NETBIOSALIAS",
 776
 777         # rpc proxy controller stuff
 778         "RPC_PROXY_SERVER",
 779         "RPC_PROXY_SERVER_IP",
 780         "RPC_PROXY_NETBIOSNAME",
 781         "RPC_PROXY_NETBIOSALIAS",
 782
 783         # domain controller stuff for Vampired DC
 784         "VAMPIRE_DC_SERVER",
 785         "VAMPIRE_DC_SERVER_IP",
 786         "VAMPIRE_DC_NETBIOSNAME",
 787         "VAMPIRE_DC_NETBIOSALIAS",
 788
 789         # server stuff
 790         "SERVER",
 791         "SERVER_IP",
 792         "NETBIOSNAME",
 793         "NETBIOSALIAS",
 794
 795         # user stuff
 796         "USERNAME",
 797         "USERID",
 798         "PASSWORD",
 799         "DC_USERNAME",
 800         "DC_PASSWORD",
 801
 802         # misc stuff
 803         "KRB5_CONFIG",
 804         "WINBINDD_SOCKET_DIR",
 805         "WINBINDD_PRIV_PIPE_DIR",
 806         "LOCAL_PATH"
 807 );
 808
 809 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 810         my $signame = shift;
 811         teardown_env($_) foreach(keys %running_envs);
 812         die("Received signal $signame");
 813 };
 814
 815 sub setup_env($)
 816 {
 817         my ($name) = @_;
 818
 819         my $testenv_vars = undef;
 820
 821         my $envname = $name;
 822         my $option = $name;
 823
 824         $envname =~ s/:.*//;
 825         $option =~ s/^[^:]*//;
 826         $option =~ s/^://;
 827
 828         $option = "client" if $option eq "";
 829
 830         if ($envname eq "none") {
 831                 $testenv_vars = {};
 832         } elsif (defined(get_running_env($envname))) {
 833                 $testenv_vars = get_running_env($envname);
 834                 if (not $target->check_env($testenv_vars)) {
 835                         print $target->getlog_env($testenv_vars);
 836                         $testenv_vars = undef;
 837                 }
 838         } else {
 839                 $testenv_vars = $target->setup_env($envname, $prefix);
 840         }
 841
 842         return undef unless defined($testenv_vars);
 843
 844         $running_envs{$envname} = $testenv_vars;
 845
 846         if ($option eq "local") {
 847                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 848                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 849         } elsif ($option eq "client") {
 850                 SocketWrapper::set_default_iface(11);
 851                 write_clientconf($conffile, $testenv_vars);
 852                 $ENV{SMB_CONF_PATH} = $conffile;
 853         } else {
 854                 die("Unknown option[$option] for envname[$envname]");
 855         }
 856
 857         foreach (@exported_envvars) {
 858                 if (defined($testenv_vars->{$_})) {
 859                         $ENV{$_} = $testenv_vars->{$_};
 860                 } else {
 861                         delete $ENV{$_};
 862                 }
 863         }
 864
 865         return $testenv_vars;
 866 }
 867
 868 sub exported_envvars_str($)
 869 {
 870         my ($testenv_vars) = @_;
 871         my $out = "";
 872
 873         foreach (@exported_envvars) {
 874                 next unless defined($testenv_vars->{$_});
 875                 $out .= $_."=".$testenv_vars->{$_}."\n";
 876         }
 877
 878         return $out;
 879 }
 880
 881 sub getlog_env($)
 882 {
 883         my ($envname) = @_;
 884         return "" if ($envname eq "none");
 885         return $target->getlog_env(get_running_env($envname));
 886 }
 887
 888 sub check_env($)
 889 {
 890         my ($envname) = @_;
 891         return 1 if ($envname eq "none");
 892         return $target->check_env(get_running_env($envname));
 893 }
 894
 895 sub teardown_env($)
 896 {
 897         my ($envname) = @_;
 898         return if ($envname eq "none");
 899         $target->teardown_env(get_running_env($envname));
 900         delete $running_envs{$envname};
 901 }
 902
 903 # This 'global' file needs to be empty when we start
 904 unlink("$prefix_abs/dns_host_file");
 905
 906 if ($opt_testenv) {
 907         my $testenv_name = $ENV{SELFTEST_TESTENV};
 908         $testenv_name = $testenv_default unless defined($testenv_name);
 909
 910         my $testenv_vars = setup_env($testenv_name);
 911
 912         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 913
 914         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 915
 916         my $envvarstr = exported_envvars_str($testenv_vars);
 917
 918         my $term = ($ENV{TERMINAL} or "xterm");
 919         system("$term -e 'echo -e \"
 920 Welcome to the Samba4 Test environment '$testenv_name'
 921
 922 This matches the client environment used in make test
 923 server is pid `cat \$PIDDIR/samba.pid`
 924
 925 Some useful environment variables:
 926 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 927 SMB_CONF_PATH=\$SMB_CONF_PATH
 928
 929 $envvarstr
 930 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 931         teardown_env($testenv_name);
 932 } else {
 933         foreach (@todo) {
 934                 $i++;
 935                 my $cmd = $$_[2];
 936                 $cmd =~ s/([\(\)])/\\$1/g;
 937                 my $name = $$_[0];
 938                 my $envname = $$_[1];
 939
 940                 my $envvars = setup_env($envname);
 941                 if (not defined($envvars)) {
 942                         Subunit::start_testsuite($name);
 943                         Subunit::end_testsuite($name, "error",
 944                                 "unable to set up environment $envname");
 945                         next;
 946                 }
 947
 948                 # Generate a file with the individual tests to run, if the
 949                 # test runner for this test suite supports it.
 950                 if ($individual_tests and $individual_tests->{$name}) {
 951                         if ($$_[3]) {
 952                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
 953                                 foreach my $test (@{$individual_tests->{$name}}) {
 954                                         print $fh "$test\n";
 955                                 }
 956                                 $cmd .= " --load-list=$listid_file";
 957                         } elsif ($$_[4]) {
 958                                 $cmd =~ s/\s+[^\s]+\s*$//;
 959                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
 960                         }
 961                 }
 962
 963                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
 964
 965                 if (defined($opt_analyse_cmd)) {
 966                         system("$opt_analyse_cmd \"$name\"");
 967                 }
 968
 969                 teardown_env($envname) if ($opt_resetup_env);
 970         }
 971 }
 972
 973 print "\n";
 974
 975 teardown_env($_) foreach (keys %running_envs);
 976
 977 my $failed = 0;
 978
 979 # if there were any valgrind failures, show them
 980 foreach (<$prefix/valgrind.log*>) {
 981         next unless (-s $_);
 982         print "VALGRIND FAILURE\n";
 983         $failed++;
 984         system("cat $_");
 985 }
 986 exit 0;