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