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 $tmpdir_abs = abs_path("$prefix/tmp");
 403 mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;
 404
 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.11/8",
 537                             "127.0.0.12/8",
 538                             "127.0.0.13/8",
 539                             "127.0.0.14/8",
 540                             "127.0.0.15/8",
 541                             "127.0.0.16/8"));
 542
 543 my $clientdir = "$prefix_abs/client";
 544
 545 my $conffile = "$clientdir/client.conf";
 546 $ENV{SMB_CONF_PATH} = $conffile;
 547
 548 sub write_clientconf($$$)
 549 {
 550         my ($conffile, $clientdir, $vars) = @_;
 551
 552         mkdir("$clientdir", 0777) unless -d "$clientdir";
 553
 554         if ( -d "$clientdir/private" ) {
 555                 unlink <$clientdir/private/*>;
 556         } else {
 557                 mkdir("$clientdir/private", 0777);
 558         }
 559
 560         if ( -d "$clientdir/lockdir" ) {
 561                 unlink <$clientdir/lockdir/*>;
 562         } else {
 563                 mkdir("$clientdir/lockdir", 0777);
 564         }
 565
 566         if ( -d "$clientdir/ncalrpcdir" ) {
 567                 unlink <$clientdir/ncalrpcdir/*>;
 568         } else {
 569                 mkdir("$clientdir/ncalrpcdir", 0777);
 570         }
 571
 572         open(CF, ">$conffile");
 573         print CF "[global]\n";
 574         if (defined($ENV{VALGRIND})) {
 575                 print CF "\ticonv:native = true\n";
 576         } else {
 577                 print CF "\ticonv:native = false\n";
 578         }
 579         print CF "\tnetbios name = client\n";
 580         if (defined($vars->{DOMAIN})) {
 581                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 582         }
 583         if (defined($vars->{REALM})) {
 584                 print CF "\trealm = $vars->{REALM}\n";
 585         }
 586         if ($opt_socket_wrapper) {
 587                 print CF "\tinterfaces = $interfaces\n";
 588         }
 589         print CF "
 590         private dir = $clientdir/private
 591         lock dir = $clientdir/lockdir
 592         ncalrpc dir = $clientdir/ncalrpcdir
 593         name resolve order = bcast file
 594         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 595         max xmit = 32K
 596         notify:inotify = false
 597         ldb:nosync = true
 598         system:anonymous = true
 599         client lanman auth = Yes
 600         log level = 1
 601         torture:basedir = $clientdir
 602 #We don't want to pass our self-tests if the PAC code is wrong
 603         gensec:require_pac = true
 604         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 605         setup directory = ./setup
 606         resolv:host file = $prefix_abs/dns_host_file
 607 #We don't want to run 'speed' tests for very long
 608         torture:timelimit = 1
 609 ";
 610         close(CF);
 611 }
 612
 613 my @todo = ();
 614
 615 my $testsdir = "$srcdir/selftest";
 616
 617 sub should_run_test($)
 618 {
 619         my $name = shift;
 620         if ($#tests == -1) {
 621                 return 1;
 622         }
 623         for (my $i=0; $i <= $#tests; $i++) {
 624                 if ($name =~ /$tests[$i]/i) {
 625                         return 1;
 626                 }
 627         }
 628         return 0;
 629 }
 630
 631 sub read_testlist($)
 632 {
 633         my ($filename) = @_;
 634
 635         my @ret = ();
 636         open(IN, $filename) or die("Unable to open $filename: $!");
 637
 638         while (<IN>) {
 639                 if (/-- TEST(-LOADLIST|-IDLIST|) --\n/) {
 640                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 641                         my $supports_idlist = (defined($1) and $1 eq "-IDLIST");
 642                         my $name = <IN>;
 643                         $name =~ s/\n//g;
 644                         my $env = <IN>;
 645                         $env =~ s/\n//g;
 646                         my $cmdline = <IN>;
 647                         $cmdline =~ s/\n//g;
 648                         if (should_run_test($name) == 1) {
 649                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist, $supports_idlist]);
 650                         }
 651                 } else {
 652                         print;
 653                 }
 654         }
 655         close(IN) or die("Error creating recipe");
 656         return @ret;
 657 }
 658
 659 if ($#testlists == -1) {
 660         die("No testlists specified");
 661 }
 662
 663 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 664 $ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
 665 if ($opt_socket_wrapper) {
 666         $ENV{SELFTEST_INTERFACES} = $interfaces;
 667 } else {
 668         $ENV{SELFTEST_INTERFACES} = "";
 669 }
 670 if ($opt_verbose) {
 671         $ENV{SELFTEST_VERBOSE} = "1";
 672 } else {
 673         $ENV{SELFTEST_VERBOSE} = "";
 674 }
 675 if ($opt_quick) {
 676         $ENV{SELFTEST_QUICK} = "1";
 677 } else {
 678         $ENV{SELFTEST_QUICK} = "";
 679 }
 680 $ENV{SELFTEST_TARGET} = $opt_target;
 681 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 682
 683 my @available = ();
 684 foreach my $fn (@testlists) {
 685         foreach (read_testlist($fn)) {
 686                 my $name = $$_[0];
 687                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 688                 push (@available, $_);
 689         }
 690 }
 691
 692 my $restricted = undef;
 693 my $restricted_used = {};
 694
 695 if ($opt_load_list) {
 696         $restricted = [];
 697         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 698         while (<LOAD_LIST>) {
 699                 chomp;
 700                 push (@$restricted, $_);
 701         }
 702         close(LOAD_LIST);
 703 }
 704
 705 my $individual_tests = undef;
 706 $individual_tests = {};
 707
 708 foreach my $testsuite (@available) {
 709         my $name = $$testsuite[0];
 710         my $skipreason = skip($name);
 711         if (defined($restricted)) {
 712                 # Find the testsuite for this test
 713                 my $match = undef;
 714                 foreach my $r (@$restricted) {
 715                         if ($r eq $name) {
 716                                 $individual_tests->{$name} = [];
 717                                 $match = $r;
 718                                 $restricted_used->{$r} = 1;
 719                         } elsif (substr($r, 0, length($name)+1) eq "$name.") {
 720                                 push(@{$individual_tests->{$name}}, $r);
 721                                 $match = $r;
 722                                 $restricted_used->{$r} = 1;
 723                         }
 724                 }
 725                 if ($match) {
 726                         if (defined($skipreason)) {
 727                                         Subunit::skip_testsuite($name, $skipreason);
 728                         } else {
 729                                 push(@todo, $testsuite);
 730                         }
 731                 }
 732         } elsif (defined($skipreason)) {
 733                 Subunit::skip_testsuite($name, $skipreason);
 734         } else {
 735                 push(@todo, $testsuite);
 736         }
 737 }
 738
 739 if (defined($restricted)) {
 740         foreach (@$restricted) {
 741                 unless (defined($restricted_used->{$_})) {
 742                         print "No test or testsuite found matching $_\n";
 743                 }
 744         }
 745 } elsif ($#todo == -1) {
 746         print STDERR "No tests to run\n";
 747         exit(1);
 748 }
 749
 750 my $suitestotal = $#todo + 1;
 751
 752 Subunit::progress($suitestotal);
 753 Subunit::report_time(time());
 754
 755 my $i = 0;
 756 $| = 1;
 757
 758 my %running_envs = ();
 759
 760 sub get_running_env($)
 761 {
 762         my ($name) = @_;
 763
 764         my $envname = $name;
 765
 766         $envname =~ s/:.*//;
 767
 768         return $running_envs{$envname};
 769 }
 770
 771 my @exported_envvars = (
 772         # domain stuff
 773         "DOMAIN",
 774         "REALM",
 775
 776         # domain controller stuff
 777         "DC_SERVER",
 778         "DC_SERVER_IP",
 779         "DC_NETBIOSNAME",
 780         "DC_NETBIOSALIAS",
 781
 782         # domain member
 783         "MEMBER_SERVER",
 784         "MEMBER_SERVER_IP",
 785         "MEMBER_NETBIOSNAME",
 786         "MEMBER_NETBIOSALIAS",
 787
 788         # rpc proxy controller stuff
 789         "RPC_PROXY_SERVER",
 790         "RPC_PROXY_SERVER_IP",
 791         "RPC_PROXY_NETBIOSNAME",
 792         "RPC_PROXY_NETBIOSALIAS",
 793
 794         # domain controller stuff for Vampired DC
 795         "VAMPIRE_DC_SERVER",
 796         "VAMPIRE_DC_SERVER_IP",
 797         "VAMPIRE_DC_NETBIOSNAME",
 798         "VAMPIRE_DC_NETBIOSALIAS",
 799
 800         # server stuff
 801         "SERVER",
 802         "SERVER_IP",
 803         "NETBIOSNAME",
 804         "NETBIOSALIAS",
 805
 806         # user stuff
 807         "USERNAME",
 808         "USERID",
 809         "PASSWORD",
 810         "DC_USERNAME",
 811         "DC_PASSWORD",
 812
 813         # misc stuff
 814         "KRB5_CONFIG",
 815         "WINBINDD_SOCKET_DIR",
 816         "WINBINDD_PRIV_PIPE_DIR",
 817         "LOCAL_PATH"
 818 );
 819
 820 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 821         my $signame = shift;
 822         teardown_env($_) foreach(keys %running_envs);
 823         die("Received signal $signame");
 824 };
 825
 826 sub setup_env($$)
 827 {
 828         my ($name, $prefix) = @_;
 829
 830         my $testenv_vars = undef;
 831
 832         my $envname = $name;
 833         my $option = $name;
 834
 835         $envname =~ s/:.*//;
 836         $option =~ s/^[^:]*//;
 837         $option =~ s/^://;
 838
 839         $option = "client" if $option eq "";
 840
 841         if ($envname eq "none") {
 842                 $testenv_vars = {};
 843         } elsif (defined(get_running_env($envname))) {
 844                 $testenv_vars = get_running_env($envname);
 845                 if (not $target->check_env($testenv_vars)) {
 846                         print $target->getlog_env($testenv_vars);
 847                         $testenv_vars = undef;
 848                 }
 849         } else {
 850                 $testenv_vars = $target->setup_env($envname, $prefix);
 851         }
 852
 853         return undef unless defined($testenv_vars);
 854
 855         $running_envs{$envname} = $testenv_vars;
 856
 857         if ($option eq "local") {
 858                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 859                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 860         } elsif ($option eq "client") {
 861                 SocketWrapper::set_default_iface(11);
 862                 write_clientconf($conffile, $clientdir, $testenv_vars);
 863                 $ENV{SMB_CONF_PATH} = $conffile;
 864         } else {
 865                 die("Unknown option[$option] for envname[$envname]");
 866         }
 867
 868         foreach (@exported_envvars) {
 869                 if (defined($testenv_vars->{$_})) {
 870                         $ENV{$_} = $testenv_vars->{$_};
 871                 } else {
 872                         delete $ENV{$_};
 873                 }
 874         }
 875
 876         return $testenv_vars;
 877 }
 878
 879 sub exported_envvars_str($)
 880 {
 881         my ($testenv_vars) = @_;
 882         my $out = "";
 883
 884         foreach (@exported_envvars) {
 885                 next unless defined($testenv_vars->{$_});
 886                 $out .= $_."=".$testenv_vars->{$_}."\n";
 887         }
 888
 889         return $out;
 890 }
 891
 892 sub getlog_env($)
 893 {
 894         my ($envname) = @_;
 895         return "" if ($envname eq "none");
 896         return $target->getlog_env(get_running_env($envname));
 897 }
 898
 899 sub check_env($)
 900 {
 901         my ($envname) = @_;
 902         return 1 if ($envname eq "none");
 903         return $target->check_env(get_running_env($envname));
 904 }
 905
 906 sub teardown_env($)
 907 {
 908         my ($envname) = @_;
 909         return if ($envname eq "none");
 910         $target->teardown_env(get_running_env($envname));
 911         delete $running_envs{$envname};
 912 }
 913
 914 # This 'global' file needs to be empty when we start
 915 unlink("$prefix_abs/dns_host_file");
 916
 917 if ($opt_testenv) {
 918         my $testenv_name = $ENV{SELFTEST_TESTENV};
 919         $testenv_name = $testenv_default unless defined($testenv_name);
 920
 921         my $testenv_vars = setup_env($testenv_name, $prefix);
 922
 923         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 924
 925         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 926         $ENV{ENVNAME} = $testenv_name;
 927
 928         my $envvarstr = exported_envvars_str($testenv_vars);
 929
 930         my $term = ($ENV{TERMINAL} or "xterm -e");
 931         system("$term 'echo -e \"
 932 Welcome to the Samba4 Test environment '$testenv_name'
 933
 934 This matches the client environment used in make test
 935 server is pid `cat \$PIDDIR/samba.pid`
 936
 937 Some useful environment variables:
 938 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 939 SMB_CONF_PATH=\$SMB_CONF_PATH
 940
 941 $envvarstr
 942 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 943         teardown_env($testenv_name);
 944 } else {
 945         foreach (@todo) {
 946                 $i++;
 947                 my $cmd = $$_[2];
 948                 my $name = $$_[0];
 949                 my $envname = $$_[1];
 950
 951                 my $envvars = setup_env($envname, $prefix);
 952                 if (not defined($envvars)) {
 953                         Subunit::start_testsuite($name);
 954                         Subunit::end_testsuite($name, "error",
 955                                 "unable to set up environment $envname");
 956                         next;
 957                 }
 958
 959                 # Generate a file with the individual tests to run, if the
 960                 # test runner for this test suite supports it.
 961                 if ($individual_tests and $individual_tests->{$name}) {
 962                         if ($$_[3]) {
 963                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
 964                                 foreach my $test (@{$individual_tests->{$name}}) {
 965                                         print $fh substr($test, length($name)+1) . "\n";
 966                                 }
 967                                 $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
 968                         } elsif ($$_[4]) {
 969                                 $cmd =~ s/\s+[^\s]+\s*$//;
 970                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
 971                         }
 972                 }
 973
 974                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
 975
 976                 teardown_env($envname) if ($opt_resetup_env);
 977         }
 978 }
 979
 980 print "\n";
 981
 982 teardown_env($_) foreach (keys %running_envs);
 983
 984 my $failed = 0;
 985
 986 # if there were any valgrind failures, show them
 987 foreach (<$prefix/valgrind.log*>) {
 988         next unless (-s $_);
 989         print "VALGRIND FAILURE\n";
 990         $failed++;
 991         system("cat $_");
 992 }
 993 exit 0;