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 qw(parse_results);
 134 use Subunit::Filter;
 135 use SocketWrapper;
 136
 137 eval {
 138 require Time::HiRes;
 139 };
 140 unless ($@) {
 141         use Time::HiRes qw(time);
 142 }
 143
 144 my $opt_help = 0;
 145 my $opt_target = "samba4";
 146 my $opt_quick = 0;
 147 my $opt_socket_wrapper = 0;
 148 my $opt_socket_wrapper_pcap = undef;
 149 my $opt_socket_wrapper_keep_pcap = undef;
 150 my $opt_one = 0;
 151 my @opt_exclude = ();
 152 my @opt_include = ();
 153 my $opt_verbose = 0;
 154 my $opt_image = undef;
 155 my $opt_testenv = 0;
 156 my $ldap = undef;
 157 my $opt_analyse_cmd = undef;
 158 my $opt_resetup_env = undef;
 159 my $opt_bindir = undef;
 160 my $opt_no_lazy_setup = undef;
 161 my $opt_load_list = undef;
 162 my @testlists = ();
 163
 164 my $srcdir = ".";
 165 my $builddir = ".";
 166 my $exeext = "";
 167 my $prefix = "./st";
 168
 169 my @includes = ();
 170 my @excludes = ();
 171
 172 sub find_in_list($$)
 173 {
 174         my ($list, $fullname) = @_;
 175
 176         foreach (@$list) {
 177                 if ($fullname =~ /$$_[0]/) {
 178                          return ($$_[1]) if ($$_[1]);
 179                          return "";
 180                 }
 181         }
 182
 183         return undef;
 184 }
 185
 186 sub skip($)
 187 {
 188         my ($name) = @_;
 189
 190         return find_in_list(\@excludes, $name);
 191 }
 192
 193 sub getlog_env($);
 194
 195 sub setup_pcap($)
 196 {
 197         my ($name) = @_;
 198
 199         return unless ($opt_socket_wrapper_pcap);
 200         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 201
 202         my $fname = $name;
 203         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 204
 205         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 206
 207         SocketWrapper::setup_pcap($pcap_file);
 208
 209         return $pcap_file;
 210 }
 211
 212 sub cleanup_pcap($$)
 213 {
 214         my ($pcap_file, $exitcode) = @_;
 215
 216         return unless ($opt_socket_wrapper_pcap);
 217         return if ($opt_socket_wrapper_keep_pcap);
 218         return unless ($exitcode == 0);
 219         return unless defined($pcap_file);
 220
 221         unlink($pcap_file);
 222 }
 223
 224 # expand strings from %ENV
 225 sub expand_environment_strings($)
 226 {
 227         my $s = shift;
 228         # we use a reverse sort so we do the longer ones first
 229         foreach my $k (sort { $b cmp $a } keys %ENV) {
 230                 $s =~ s/\$$k/$ENV{$k}/g;
 231         }
 232         return $s;
 233 }
 234
 235 sub run_testsuite($$$$$)
 236 {
 237         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 238         my $pcap_file = setup_pcap($name);
 239
 240         Subunit::start_testsuite($name);
 241         Subunit::progress_push();
 242         Subunit::report_time(time());
 243
 244         open(RESULTS, "$cmd 2>&1|");
 245
 246         my $msg_ops = new Subunit::Filter("$name\.");
 247
 248         parse_results($msg_ops, *RESULTS);
 249
 250         my $ret = 0;
 251
 252         unless (close(RESULTS)) {
 253                 if ($!) {
 254                         Subunit::progress_pop();
 255                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 256                         return 0;
 257                 } else {
 258                         $ret = $?;
 259                 }
 260         }
 261
 262         if ($ret & 127) {
 263                 Subunit::progress_pop();
 264                 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
 265                 return 0;
 266         }
 267         my $envlog = getlog_env($envname);
 268         if ($envlog ne "") {
 269                 print "envlog: $envlog\n";
 270         }
 271
 272         print "command: $cmd\n";
 273         printf "expanded command: %s\n", expand_environment_strings($cmd);
 274
 275         my $exitcode = $ret >> 8;
 276
 277         Subunit::report_time(time());
 278         Subunit::progress_pop();
 279         if ($exitcode == 0) {
 280                 Subunit::end_testsuite($name, "success");
 281         } else {
 282                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 283         }
 284
 285         cleanup_pcap($pcap_file, $exitcode);
 286
 287         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 288                 print "PCAP FILE: $pcap_file\n";
 289         }
 290
 291         if ($exitcode != 0) {
 292                 exit(1) if ($opt_one);
 293         }
 294
 295         return $exitcode;
 296 }
 297
 298 sub ShowHelp()
 299 {
 300         print "Samba test runner
 301 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 302 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 303
 304 Usage: $Script [OPTIONS] TESTNAME-REGEX
 305
 306 Generic options:
 307  --help                     this help page
 308  --target=samba[34]|win|kvm Samba version to target
 309  --testlist=FILE            file to read available tests from
 310
 311 Paths:
 312  --prefix=DIR               prefix to run tests in [st]
 313  --srcdir=DIR               source directory [.]
 314  --builddir=DIR             output directory [.]
 315  --exeext=EXT               executable extention []
 316
 317 Target Specific:
 318  --socket-wrapper-pcap      save traffic to pcap directories
 319  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 320                             failed
 321  --socket-wrapper           enable socket wrapper
 322  --bindir=PATH              path to target binaries
 323
 324 Samba4 Specific:
 325  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 326
 327 Kvm Specific:
 328  --image=PATH               path to KVM image
 329
 330 Behaviour:
 331  --quick                    run quick overall test
 332  --one                      abort when the first test fails
 333  --verbose                  be verbose
 334  --analyse-cmd CMD          command to run after each test
 335 ";
 336         exit(0);
 337 }
 338
 339 my $result = GetOptions (
 340                 'help|h|?' => \$opt_help,
 341                 'target=s' => \$opt_target,
 342                 'prefix=s' => \$prefix,
 343                 'socket-wrapper' => \$opt_socket_wrapper,
 344                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 345                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 346                 'quick' => \$opt_quick,
 347                 'one' => \$opt_one,
 348                 'exclude=s' => \@opt_exclude,
 349                 'include=s' => \@opt_include,
 350                 'srcdir=s' => \$srcdir,
 351                 'builddir=s' => \$builddir,
 352                 'exeext=s' => \$exeext,
 353                 'verbose' => \$opt_verbose,
 354                 'testenv' => \$opt_testenv,
 355                 'ldap:s' => \$ldap,
 356                 'analyse-cmd=s' => \$opt_analyse_cmd,
 357                 'no-lazy-setup' => \$opt_no_lazy_setup,
 358                 'resetup-environment' => \$opt_resetup_env,
 359                 'bindir:s' => \$opt_bindir,
 360                 'image=s' => \$opt_image,
 361                 'testlist=s' => \@testlists,
 362                 'load-list=s' => \$opt_load_list,
 363             );
 364
 365 exit(1) if (not $result);
 366
 367 ShowHelp() if ($opt_help);
 368
 369 # we want unbuffered output
 370 $| = 1;
 371
 372 my @tests = @ARGV;
 373
 374 # quick hack to disable rpc validation when using valgrind - its way too slow
 375 unless (defined($ENV{VALGRIND})) {
 376         $ENV{VALIDATE} = "validate";
 377         $ENV{MALLOC_CHECK_} = 2;
 378 }
 379
 380 # make all our python scripts unbuffered
 381 $ENV{PYTHONUNBUFFERED} = 1;
 382
 383 my $bindir = ($opt_bindir or "$builddir/bin");
 384 my $bindir_abs = abs_path($bindir);
 385
 386 # Backwards compatibility:
 387 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 388         if (defined($ENV{FEDORA_DS_ROOT})) {
 389                 $ldap = "fedora-ds";
 390         } else {
 391                 $ldap = "openldap";
 392         }
 393 }
 394
 395 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 396 if ($ldap) {
 397         # LDAP is slow
 398         $torture_maxtime *= 2;
 399 }
 400
 401 $prefix =~ s+//+/+;
 402 $prefix =~ s+/./+/+;
 403 $prefix =~ s+/$++;
 404
 405 die("using an empty prefix isn't allowed") unless $prefix ne "";
 406
 407 #Ensure we have the test prefix around
 408 mkdir($prefix, 0777) unless -d $prefix;
 409
 410 my $prefix_abs = abs_path($prefix);
 411 my $srcdir_abs = abs_path($srcdir);
 412 my $builddir_abs = abs_path($builddir);
 413
 414 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 415 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 416
 417 $ENV{PREFIX} = $prefix;
 418 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 419 $ENV{PREFIX_ABS} = $prefix_abs;
 420 $ENV{SRCDIR} = $srcdir;
 421 $ENV{SRCDIR_ABS} = $srcdir_abs;
 422 $ENV{BUILDDIR} = $builddir;
 423 $ENV{BUILDDIR_ABS} = $builddir_abs;
 424 $ENV{EXEEXT} = $exeext;
 425
 426 my $tls_enabled = not $opt_quick;
 427 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 428 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
 429 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
 430 sub prefix_pathvar($$)
 431 {
 432         my ($name, $newpath) = @_;
 433         if (defined($ENV{$name})) {
 434                 $ENV{$name} = "$newpath:$ENV{$name}";
 435         } else {
 436                 $ENV{$name} = $newpath;
 437         }
 438 }
 439 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 440 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 441
 442 if ($opt_socket_wrapper_keep_pcap) {
 443         # Socket wrapper keep pcap implies socket wrapper pcap
 444         $opt_socket_wrapper_pcap = 1;
 445 }
 446
 447 if ($opt_socket_wrapper_pcap) {
 448         # Socket wrapper pcap implies socket wrapper
 449         $opt_socket_wrapper = 1;
 450 }
 451
 452 my $socket_wrapper_dir;
 453 if ($opt_socket_wrapper) {
 454         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 455         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 456 } else {
 457          unless ($< == 0) {
 458                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 459          }
 460 }
 461
 462 my $target;
 463 my $testenv_default = "none";
 464
 465 if ($opt_target eq "samba4") {
 466         $testenv_default = "all";
 467         require target::Samba4;
 468         $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
 469 } elsif ($opt_target eq "samba3") {
 470         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 471                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 472         }
 473         $testenv_default = "member";
 474         require target::Samba3;
 475         $target = new Samba3($bindir);
 476 } elsif ($opt_target eq "win") {
 477         die("Windows tests will not run with socket wrapper enabled.")
 478                 if ($opt_socket_wrapper);
 479         $testenv_default = "dc";
 480         require target::Windows;
 481         $target = new Windows();
 482 } elsif ($opt_target eq "kvm") {
 483         die("Kvm tests will not run with socket wrapper enabled.")
 484                 if ($opt_socket_wrapper);
 485         require target::Kvm;
 486         die("No image specified") unless ($opt_image);
 487         $target = new Kvm($opt_image, undef);
 488 }
 489
 490 #
 491 # Start a Virtual Distributed Ethernet Switch
 492 # Returns the pid of the switch.
 493 #
 494 sub start_vde_switch($)
 495 {
 496         my ($path) = @_;
 497
 498         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 499
 500         open(PID, "$path/vde.pid");
 501         <PID> =~ /([0-9]+)/;
 502         my $pid = $1;
 503         close(PID);
 504
 505         return $pid;
 506 }
 507
 508 # Stop a Virtual Distributed Ethernet Switch
 509 sub stop_vde_switch($)
 510 {
 511         my ($pid) = @_;
 512         kill 9, $pid;
 513 }
 514
 515 sub read_test_regexes($)
 516 {
 517         my ($name) = @_;
 518         my @ret = ();
 519         open(LF, "<$name") or die("unable to read $name: $!");
 520         while (<LF>) {
 521                 chomp;
 522                 next if (/^#/);
 523                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 524                         push (@ret, [$1, $4]);
 525                 } else {
 526                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 527                         push (@ret, [$_, undef]);
 528                 }
 529         }
 530         close(LF);
 531         return @ret;
 532 }
 533
 534 foreach (@opt_exclude) {
 535         push (@excludes, read_test_regexes($_));
 536 }
 537
 538 foreach (@opt_include) {
 539         push (@includes, read_test_regexes($_));
 540 }
 541
 542 my $interfaces = join(',', ("127.0.0.11/8",
 543                             "127.0.0.12/8",
 544                             "127.0.0.13/8",
 545                             "127.0.0.14/8",
 546                             "127.0.0.15/8",
 547                             "127.0.0.16/8"));
 548
 549 my $conffile = "$prefix_abs/client/client.conf";
 550 $ENV{SMB_CONF_PATH} = $conffile;
 551
 552 sub write_clientconf($$)
 553 {
 554         my ($conffile, $vars) = @_;
 555
 556         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 557
 558         if ( -d "$prefix/client/private" ) {
 559                 unlink <$prefix/client/private/*>;
 560         } else {
 561                 mkdir("$prefix/client/private", 0777);
 562         }
 563
 564         if ( -d "$prefix/client/lockdir" ) {
 565                 unlink <$prefix/client/lockdir/*>;
 566         } else {
 567                 mkdir("$prefix/client/lockdir", 0777);
 568         }
 569
 570         if ( -d "$prefix_abs/client/ncalrpcdir" ) {
 571                 unlink <$prefix/client/ncalrpcdir/*>;
 572         } else {
 573                 mkdir("$prefix/client/ncalrpcdir", 0777);
 574         }
 575
 576         open(CF, ">$conffile");
 577         print CF "[global]\n";
 578         if (defined($ENV{VALGRIND})) {
 579                 print CF "\ticonv:native = true\n";
 580         } else {
 581                 print CF "\ticonv:native = false\n";
 582         }
 583         print CF "\tnetbios name = client\n";
 584         if (defined($vars->{DOMAIN})) {
 585                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 586         }
 587         if (defined($vars->{REALM})) {
 588                 print CF "\trealm = $vars->{REALM}\n";
 589         }
 590         if ($opt_socket_wrapper) {
 591                 print CF "\tinterfaces = $interfaces\n";
 592         }
 593         print CF "
 594         private dir = $prefix_abs/client/private
 595         lock dir = $prefix_abs/client/lockdir
 596         ncalrpc dir = $prefix_abs/client/ncalrpcdir
 597         name resolve order = bcast file
 598         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 599         max xmit = 32K
 600         notify:inotify = false
 601         ldb:nosync = true
 602         system:anonymous = true
 603         client lanman auth = Yes
 604         log level = 1
 605         torture:basedir = $prefix_abs/client
 606 #We don't want to pass our self-tests if the PAC code is wrong
 607         gensec:require_pac = true
 608         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 609         setup directory = ./setup
 610         resolv:host file = $prefix_abs/dns_host_file
 611 ";
 612         close(CF);
 613 }
 614
 615 my @todo = ();
 616
 617 my $testsdir = "$srcdir/selftest";
 618
 619 my %required_envs = ();
 620
 621 sub should_run_test($)
 622 {
 623         my $name = shift;
 624         if ($#tests == -1) {
 625                 return 1;
 626         }
 627         for (my $i=0; $i <= $#tests; $i++) {
 628                 if ($name =~ /$tests[$i]/i) {
 629                         return 1;
 630                 }
 631         }
 632         return 0;
 633 }
 634
 635 sub read_testlist($)
 636 {
 637         my ($filename) = @_;
 638
 639         my @ret = ();
 640         open(IN, $filename) or die("Unable to open $filename: $!");
 641
 642         while (<IN>) {
 643                 if (/-- TEST(-LOADLIST)? --\n/) {
 644                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 645                         my $name = <IN>;
 646                         $name =~ s/\n//g;
 647                         my $env = <IN>;
 648                         $env =~ s/\n//g;
 649                         my $cmdline = <IN>;
 650                         $cmdline =~ s/\n//g;
 651                         if (should_run_test($name) == 1) {
 652                                 $required_envs{$env} = 1;
 653                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist]);
 654                         }
 655                 } else {
 656                         print;
 657                 }
 658         }
 659         close(IN) or die("Error creating recipe");
 660         return @ret;
 661 }
 662
 663 if ($#testlists == -1) {
 664         die("No testlists specified");
 665 }
 666
 667 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 668 if ($opt_socket_wrapper) {
 669         $ENV{SELFTEST_INTERFACES} = $interfaces;
 670 } else {
 671         $ENV{SELFTEST_INTERFACES} = "";
 672 }
 673 if ($opt_verbose) {
 674         $ENV{SELFTEST_VERBOSE} = "1";
 675 } else {
 676         $ENV{SELFTEST_VERBOSE} = "";
 677 }
 678 if ($opt_quick) {
 679         $ENV{SELFTEST_QUICK} = "1";
 680 } else {
 681         $ENV{SELFTEST_QUICK} = "";
 682 }
 683 $ENV{SELFTEST_TARGET} = $opt_target;
 684 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 685
 686 my @available = ();
 687 foreach my $fn (@testlists) {
 688         foreach (read_testlist($fn)) {
 689                 my $name = $$_[0];
 690                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 691                 push (@available, $_);
 692         }
 693 }
 694
 695 my $restricted = undef;
 696 my $restricted_used = {};
 697
 698 if ($opt_load_list) {
 699         $restricted = [];
 700         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 701         while (<LOAD_LIST>) {
 702                 chomp;
 703                 push (@$restricted, $_);
 704         }
 705         close(LOAD_LIST);
 706 }
 707
 708 Subunit::progress($#available+1);
 709 Subunit::report_time(time());
 710
 711 my $individual_tests = undef;
 712 $individual_tests = {};
 713
 714 foreach my $testsuite (@available) {
 715         my $name = $$testsuite[0];
 716         my $skipreason = skip($name);
 717         if (defined($skipreason)) {
 718                 Subunit::skip_testsuite($name, $skipreason);
 719         } elsif (defined($restricted)) {
 720                 # Find the testsuite for this test
 721                 my $match = undef;
 722                 foreach my $r (@$restricted) {
 723                         if ($r eq $name) {
 724                                 $individual_tests->{$name} = [];
 725                                 $match = $r;
 726                                 $restricted_used->{$r} = 1;
 727                         } elsif (substr($r, $name, length($name)+1) eq "$name.") {
 728                                 push(@{$individual_tests->{$name}}, $1);
 729                                 $match = $r;
 730                                 $restricted_used->{$r} = 1;
 731                         }
 732                 }
 733                 push(@todo, $testsuite) if ($match);
 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 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) = @_;
 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, $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_no_lazy_setup) {
 914         setup_env($_) foreach (keys %required_envs);
 915 }
 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);
 922
 923         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 924
 925         my $envvarstr = exported_envvars_str($testenv_vars);
 926
 927         my $term = ($ENV{TERMINAL} or "xterm");
 928         system("$term -e 'echo -e \"
 929 Welcome to the Samba4 Test environment '$testenv_name'
 930
 931 This matches the client environment used in make test
 932 server is pid `cat \$PIDDIR/samba.pid`
 933
 934 Some useful environment variables:
 935 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 936 SMB_CONF_PATH=\$SMB_CONF_PATH
 937
 938 $envvarstr
 939 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 940         teardown_env($testenv_name);
 941 } else {
 942         foreach (@todo) {
 943                 $i++;
 944                 my $cmd = $$_[2];
 945                 $cmd =~ s/([\(\)])/\\$1/g;
 946                 my $name = $$_[0];
 947                 my $envname = $$_[1];
 948
 949                 my $envvars = setup_env($envname);
 950                 if (not defined($envvars)) {
 951                         Subunit::skip_testsuite($name,
 952                                 "unable to set up environment $envname");
 953                         next;
 954                 }
 955
 956                 # Generate a file with the individual tests to run, if the
 957                 # test runner for this test suite supports it.
 958                 if ($$_[3] and $individual_tests and $individual_tests->{$name}) {
 959                         my ($fh, $listid_file) = tempfile(UNLINK => 0);
 960                         foreach (@{$individual_tests->{$name}}) {
 961                                 print $fh "$_\n";
 962                         }
 963                         $cmd .= " --load-list=$listid_file";
 964                 }
 965
 966                 run_testsuite($envname, $name, $cmd, $i, $suitestotal,
 967                                       );
 968
 969                 if (defined($opt_analyse_cmd)) {
 970                         system("$opt_analyse_cmd \"$name\"");
 971                 }
 972
 973                 teardown_env($envname) if ($opt_resetup_env);
 974         }
 975 }
 976
 977 print "\n";
 978
 979 teardown_env($_) foreach (keys %running_envs);
 980
 981 my $failed = 0;
 982
 983 # if there were any valgrind failures, show them
 984 foreach (<$prefix/valgrind.log*>) {
 985         next unless (-s $_);
 986         print "VALGRIND FAILURE\n";
 987         $failed++;
 988         system("cat $_");
 989 }
 990 exit 0;