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] [--bindir=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<--bindir=DIR>
  48
  49 Built binaries 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_binary_mapping = "";
 160 my $opt_load_list = undef;
 161 my @testlists = ();
 162
 163 my $srcdir = ".";
 164 my $bindir = "./bin";
 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  --bindir=DIR               binaries directory [./bin]
 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
 318 Samba4 Specific:
 319  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 320
 321 Kvm Specific:
 322  --image=PATH               path to KVM image
 323
 324 Behaviour:
 325  --quick                    run quick overall test
 326  --one                      abort when the first test fails
 327  --verbose                  be verbose
 328  --testenv                  run a shell in the requested test environment
 329  --list                     list available tests
 330 ";
 331         exit(0);
 332 }
 333
 334 my $result = GetOptions (
 335                 'help|h|?' => \$opt_help,
 336                 'target=s' => \$opt_target,
 337                 'prefix=s' => \$prefix,
 338                 'socket-wrapper' => \$opt_socket_wrapper,
 339                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 340                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 341                 'quick' => \$opt_quick,
 342                 'one' => \$opt_one,
 343                 'exclude=s' => \@opt_exclude,
 344                 'include=s' => \@opt_include,
 345                 'srcdir=s' => \$srcdir,
 346                 'bindir=s' => \$bindir,
 347                 'exeext=s' => \$exeext,
 348                 'verbose' => \$opt_verbose,
 349                 'testenv' => \$opt_testenv,
 350                 'list' => \$opt_list,
 351                 'ldap:s' => \$ldap,
 352                 'resetup-environment' => \$opt_resetup_env,
 353                 'image=s' => \$opt_image,
 354                 'testlist=s' => \@testlists,
 355                 'load-list=s' => \$opt_load_list,
 356                 'binary-mapping=s' => \$opt_binary_mapping
 357             );
 358
 359 exit(1) if (not $result);
 360
 361 ShowHelp() if ($opt_help);
 362
 363 die("--list and --testenv are mutually exclusive") if ($opt_list and $opt_testenv);
 364
 365 # we want unbuffered output
 366 $| = 1;
 367
 368 my @tests = @ARGV;
 369
 370 # quick hack to disable rpc validation when using valgrind - its way too slow
 371 unless (defined($ENV{VALGRIND})) {
 372         $ENV{VALIDATE} = "validate";
 373         $ENV{MALLOC_CHECK_} = 2;
 374 }
 375
 376 # make all our python scripts unbuffered
 377 $ENV{PYTHONUNBUFFERED} = 1;
 378
 379 my $bindir_abs = abs_path($bindir);
 380
 381 # Backwards compatibility:
 382 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 383         if (defined($ENV{FEDORA_DS_ROOT})) {
 384                 $ldap = "fedora-ds";
 385         } else {
 386                 $ldap = "openldap";
 387         }
 388 }
 389
 390 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 391 if ($ldap) {
 392         # LDAP is slow
 393         $torture_maxtime *= 2;
 394 }
 395
 396 $prefix =~ s+//+/+;
 397 $prefix =~ s+/./+/+;
 398 $prefix =~ s+/$++;
 399
 400 die("using an empty prefix isn't allowed") unless $prefix ne "";
 401
 402 #Ensure we have the test prefix around
 403 mkdir($prefix, 0777) unless -d $prefix;
 404
 405 my $prefix_abs = abs_path($prefix);
 406 my $tmpdir_abs = abs_path("$prefix/tmp");
 407 mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;
 408
 409 my $srcdir_abs = abs_path($srcdir);
 410
 411 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 412 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 413
 414 $ENV{PREFIX} = $prefix;
 415 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 416 $ENV{PREFIX_ABS} = $prefix_abs;
 417 $ENV{SRCDIR} = $srcdir;
 418 $ENV{SRCDIR_ABS} = $srcdir_abs;
 419 $ENV{BINDIR} = $bindir_abs;
 420 $ENV{EXEEXT} = $exeext;
 421
 422 my $tls_enabled = not $opt_quick;
 423 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 424
 425 sub prefix_pathvar($$)
 426 {
 427         my ($name, $newpath) = @_;
 428         if (defined($ENV{$name})) {
 429                 $ENV{$name} = "$newpath:$ENV{$name}";
 430         } else {
 431                 $ENV{$name} = $newpath;
 432         }
 433 }
 434 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 435 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 436
 437 if ($opt_socket_wrapper_keep_pcap) {
 438         # Socket wrapper keep pcap implies socket wrapper pcap
 439         $opt_socket_wrapper_pcap = 1;
 440 }
 441
 442 if ($opt_socket_wrapper_pcap) {
 443         # Socket wrapper pcap implies socket wrapper
 444         $opt_socket_wrapper = 1;
 445 }
 446
 447 my $socket_wrapper_dir;
 448 if ($opt_socket_wrapper) {
 449         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 450         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 451 } else {
 452          unless ($< == 0) {
 453                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 454          }
 455 }
 456
 457 my $target;
 458 my $testenv_default = "none";
 459
 460 my %binary_mapping = {};
 461 if ($opt_binary_mapping) {
 462     my @binmapping_list = split(/,/, $opt_binary_mapping);
 463     foreach my $mapping (@binmapping_list) {
 464         my ($bin, $map) = split(/\:/, $mapping);
 465         $binary_mapping{$bin} = $map;
 466     }
 467 }
 468
 469 $ENV{BINARY_MAPPING} = $opt_binary_mapping;
 470
 471 sub bindir_path($$) {
 472         my ($self, $path) = @_;
 473
 474         if (defined($self->{binary_mapping}->{$path})) {
 475             $path = $self->{binary_mapping}->{$path};
 476         }
 477
 478         my $valpath = "$self->{bindir}/$path$self->{exeext}";
 479
 480         return $valpath if (-f $valpath);
 481         return $path;
 482 }
 483
 484 # After this many seconds, the server will self-terminate.  All tests
 485 # must terminate in this time, and testenv will only stay alive this
 486 # long
 487
 488 my $server_maxtime = 7500;
 489 if (defined($ENV{SMBD_MAXTIME}) and $ENV{SMBD_MAXTIME} ne "") {
 490     $server_maxtime = $ENV{SMBD_MAXTIME};
 491 }
 492
 493 if ($opt_target eq "samba") {
 494         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 495                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 496         }
 497         $testenv_default = "all";
 498         require target::Samba;
 499         $target = new Samba($bindir, \%binary_mapping, \&bindir_path, $ldap, $srcdir, $exeext, $server_maxtime);
 500 } elsif ($opt_target eq "samba4") {
 501         $testenv_default = "all";
 502         require target::Samba4;
 503         $target = new Samba4($bindir, \%binary_mapping, \&bindir_path, $ldap, $srcdir, $exeext, $server_maxtime);
 504 } elsif ($opt_target eq "samba3") {
 505         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 506                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 507         }
 508         $testenv_default = "member";
 509         require target::Samba3;
 510         $target = new Samba3($bindir, \%binary_mapping, \&bindir_path, $srcdir_abs, $exeext, $server_maxtime);
 511 } elsif ($opt_target eq "win") {
 512         die("Windows tests will not run with socket wrapper enabled.")
 513                 if ($opt_socket_wrapper);
 514         $testenv_default = "dc";
 515         require target::Windows;
 516         $target = new Windows();
 517 } elsif ($opt_target eq "kvm") {
 518         die("Kvm tests will not run with socket wrapper enabled.")
 519                 if ($opt_socket_wrapper);
 520         require target::Kvm;
 521         die("No image specified") unless ($opt_image);
 522         $target = new Kvm($opt_image, undef);
 523 }
 524
 525 #
 526 # Start a Virtual Distributed Ethernet Switch
 527 # Returns the pid of the switch.
 528 #
 529 sub start_vde_switch($)
 530 {
 531         my ($path) = @_;
 532
 533         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 534
 535         open(PID, "$path/vde.pid");
 536         <PID> =~ /([0-9]+)/;
 537         my $pid = $1;
 538         close(PID);
 539
 540         return $pid;
 541 }
 542
 543 # Stop a Virtual Distributed Ethernet Switch
 544 sub stop_vde_switch($)
 545 {
 546         my ($pid) = @_;
 547         kill 9, $pid;
 548 }
 549
 550 sub read_test_regexes($)
 551 {
 552         my ($name) = @_;
 553         my @ret = ();
 554         open(LF, "<$name") or die("unable to read $name: $!");
 555         while (<LF>) {
 556                 chomp;
 557                 next if (/^#/);
 558                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 559                         push (@ret, [$1, $4]);
 560                 } else {
 561                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 562                         push (@ret, [$_, undef]);
 563                 }
 564         }
 565         close(LF);
 566         return @ret;
 567 }
 568
 569 foreach (@opt_exclude) {
 570         push (@excludes, read_test_regexes($_));
 571 }
 572
 573 foreach (@opt_include) {
 574         push (@includes, read_test_regexes($_));
 575 }
 576
 577 my $interfaces = join(',', ("127.0.0.11/8",
 578                             "127.0.0.12/8",
 579                             "127.0.0.13/8",
 580                             "127.0.0.14/8",
 581                             "127.0.0.15/8",
 582                             "127.0.0.16/8"));
 583
 584 my $clientdir = "$prefix_abs/client";
 585
 586 my $conffile = "$clientdir/client.conf";
 587 $ENV{SMB_CONF_PATH} = $conffile;
 588
 589 sub write_clientconf($$$)
 590 {
 591         my ($conffile, $clientdir, $vars) = @_;
 592
 593         mkdir("$clientdir", 0777) unless -d "$clientdir";
 594
 595         if ( -d "$clientdir/private" ) {
 596                 unlink <$clientdir/private/*>;
 597         } else {
 598                 mkdir("$clientdir/private", 0777);
 599         }
 600
 601         if ( -d "$clientdir/lockdir" ) {
 602                 unlink <$clientdir/lockdir/*>;
 603         } else {
 604                 mkdir("$clientdir/lockdir", 0777);
 605         }
 606
 607         if ( -d "$clientdir/ncalrpcdir" ) {
 608                 unlink <$clientdir/ncalrpcdir/*>;
 609         } else {
 610                 mkdir("$clientdir/ncalrpcdir", 0777);
 611         }
 612
 613         open(CF, ">$conffile");
 614         print CF "[global]\n";
 615         if (defined($ENV{VALGRIND})) {
 616                 print CF "\ticonv:native = true\n";
 617         } else {
 618                 print CF "\ticonv:native = false\n";
 619         }
 620         print CF "\tnetbios name = client\n";
 621         if (defined($vars->{DOMAIN})) {
 622                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 623         }
 624         if (defined($vars->{REALM})) {
 625                 print CF "\trealm = $vars->{REALM}\n";
 626         }
 627         if ($opt_socket_wrapper) {
 628                 print CF "\tinterfaces = $interfaces\n";
 629         }
 630         print CF "
 631         private dir = $clientdir/private
 632         lock dir = $clientdir/lockdir
 633         ncalrpc dir = $clientdir/ncalrpcdir
 634         name resolve order = file bcast
 635         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 636         max xmit = 32K
 637         notify:inotify = false
 638         ldb:nosync = true
 639         system:anonymous = true
 640         client lanman auth = Yes
 641         log level = 1
 642         torture:basedir = $clientdir
 643 #We don't want to pass our self-tests if the PAC code is wrong
 644         gensec:require_pac = true
 645         resolv:host file = $prefix_abs/dns_host_file
 646 #We don't want to run 'speed' tests for very long
 647         torture:timelimit = 1
 648 ";
 649         close(CF);
 650 }
 651
 652 my @todo = ();
 653
 654 sub should_run_test($)
 655 {
 656         my $name = shift;
 657         if ($#tests == -1) {
 658                 return 1;
 659         }
 660         for (my $i=0; $i <= $#tests; $i++) {
 661                 if ($name =~ /$tests[$i]/i) {
 662                         return 1;
 663                 }
 664         }
 665         return 0;
 666 }
 667
 668 sub read_testlist($)
 669 {
 670         my ($filename) = @_;
 671
 672         my @ret = ();
 673         open(IN, $filename) or die("Unable to open $filename: $!");
 674
 675         while (<IN>) {
 676                 if (/-- TEST(-LOADLIST|-IDLIST|) --\n/) {
 677                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 678                         my $supports_idlist = (defined($1) and $1 eq "-IDLIST");
 679                         my $name = <IN>;
 680                         $name =~ s/\n//g;
 681                         my $env = <IN>;
 682                         $env =~ s/\n//g;
 683                         my $cmdline = <IN>;
 684                         $cmdline =~ s/\n//g;
 685                         if (should_run_test($name) == 1) {
 686                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist, $supports_idlist]);
 687                         }
 688                 } else {
 689                         print;
 690                 }
 691         }
 692         close(IN) or die("Error creating recipe");
 693         return @ret;
 694 }
 695
 696 if ($#testlists == -1) {
 697         die("No testlists specified");
 698 }
 699
 700 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 701 $ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
 702 $ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
 703 if ($opt_socket_wrapper) {
 704         $ENV{SELFTEST_INTERFACES} = $interfaces;
 705 } else {
 706         $ENV{SELFTEST_INTERFACES} = "";
 707 }
 708 if ($opt_verbose) {
 709         $ENV{SELFTEST_VERBOSE} = "1";
 710 } else {
 711         $ENV{SELFTEST_VERBOSE} = "";
 712 }
 713 if ($opt_quick) {
 714         $ENV{SELFTEST_QUICK} = "1";
 715 } else {
 716         $ENV{SELFTEST_QUICK} = "";
 717 }
 718 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 719
 720 my @available = ();
 721 foreach my $fn (@testlists) {
 722         foreach (read_testlist($fn)) {
 723                 my $name = $$_[0];
 724                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 725                 push (@available, $_);
 726         }
 727 }
 728
 729 my $restricted = undef;
 730 my $restricted_used = {};
 731
 732 if ($opt_load_list) {
 733         $restricted = [];
 734         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 735         while (<LOAD_LIST>) {
 736                 chomp;
 737                 push (@$restricted, $_);
 738         }
 739         close(LOAD_LIST);
 740 }
 741
 742 my $individual_tests = undef;
 743 $individual_tests = {};
 744
 745 foreach my $testsuite (@available) {
 746         my $name = $$testsuite[0];
 747         my $skipreason = skip($name);
 748         if (defined($restricted)) {
 749                 # Find the testsuite for this test
 750                 my $match = undef;
 751                 foreach my $r (@$restricted) {
 752                         if ($r eq $name) {
 753                                 $individual_tests->{$name} = [];
 754                                 $match = $r;
 755                                 $restricted_used->{$r} = 1;
 756                         } elsif (substr($r, 0, length($name)+1) eq "$name.") {
 757                                 push(@{$individual_tests->{$name}}, $r);
 758                                 $match = $r;
 759                                 $restricted_used->{$r} = 1;
 760                         }
 761                 }
 762                 if ($match) {
 763                         if (defined($skipreason)) {
 764                                         Subunit::skip_testsuite($name, $skipreason);
 765                         } else {
 766                                 push(@todo, $testsuite);
 767                         }
 768                 }
 769         } elsif (defined($skipreason)) {
 770                 Subunit::skip_testsuite($name, $skipreason);
 771         } else {
 772                 push(@todo, $testsuite);
 773         }
 774 }
 775
 776 if (defined($restricted)) {
 777         foreach (@$restricted) {
 778                 unless (defined($restricted_used->{$_})) {
 779                         print "No test or testsuite found matching $_\n";
 780                 }
 781         }
 782 } elsif ($#todo == -1) {
 783         print STDERR "No tests to run\n";
 784         exit(1);
 785 }
 786
 787 my $suitestotal = $#todo + 1;
 788
 789 Subunit::progress($suitestotal);
 790 Subunit::report_time(time());
 791
 792 my $i = 0;
 793 $| = 1;
 794
 795 my %running_envs = ();
 796
 797 sub get_running_env($)
 798 {
 799         my ($name) = @_;
 800
 801         my $envname = $name;
 802
 803         $envname =~ s/:.*//;
 804
 805         return $running_envs{$envname};
 806 }
 807
 808 my @exported_envvars = (
 809         # domain stuff
 810         "DOMAIN",
 811         "REALM",
 812
 813         # domain controller stuff
 814         "DC_SERVER",
 815         "DC_SERVER_IP",
 816         "DC_NETBIOSNAME",
 817         "DC_NETBIOSALIAS",
 818
 819         # domain member
 820         "MEMBER_SERVER",
 821         "MEMBER_SERVER_IP",
 822         "MEMBER_NETBIOSNAME",
 823         "MEMBER_NETBIOSALIAS",
 824
 825         # rpc proxy controller stuff
 826         "RPC_PROXY_SERVER",
 827         "RPC_PROXY_SERVER_IP",
 828         "RPC_PROXY_NETBIOSNAME",
 829         "RPC_PROXY_NETBIOSALIAS",
 830
 831         # domain controller stuff for Vampired DC
 832         "VAMPIRE_DC_SERVER",
 833         "VAMPIRE_DC_SERVER_IP",
 834         "VAMPIRE_DC_NETBIOSNAME",
 835         "VAMPIRE_DC_NETBIOSALIAS",
 836
 837         # server stuff
 838         "SERVER",
 839         "SERVER_IP",
 840         "NETBIOSNAME",
 841         "NETBIOSALIAS",
 842
 843         # user stuff
 844         "USERNAME",
 845         "USERID",
 846         "PASSWORD",
 847         "DC_USERNAME",
 848         "DC_PASSWORD",
 849
 850         # misc stuff
 851         "KRB5_CONFIG",
 852         "WINBINDD_SOCKET_DIR",
 853         "WINBINDD_PRIV_PIPE_DIR",
 854         "NMBD_SOCKET_DIR",
 855         "LOCAL_PATH"
 856 );
 857
 858 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 859         my $signame = shift;
 860         teardown_env($_) foreach(keys %running_envs);
 861         die("Received signal $signame");
 862 };
 863
 864 sub setup_env($$)
 865 {
 866         my ($name, $prefix) = @_;
 867
 868         my $testenv_vars = undef;
 869
 870         my $envname = $name;
 871         my $option = $name;
 872
 873         $envname =~ s/:.*//;
 874         $option =~ s/^[^:]*//;
 875         $option =~ s/^://;
 876
 877         $option = "client" if $option eq "";
 878
 879         if ($envname eq "none") {
 880                 $testenv_vars = {};
 881         } elsif (defined(get_running_env($envname))) {
 882                 $testenv_vars = get_running_env($envname);
 883                 if (not $testenv_vars->{target}->check_env($testenv_vars)) {
 884                         print $testenv_vars->{target}->getlog_env($testenv_vars);
 885                         $testenv_vars = undef;
 886                 }
 887         } else {
 888                 $testenv_vars = $target->setup_env($envname, $prefix);
 889                 if (defined($testenv_vars) && not defined($testenv_vars->{target})) {
 890                         $testenv_vars->{target} = $target;
 891                 }
 892                 if (not defined($testenv_vars)) {
 893                         warn("$opt_target can't provide environment '$envname'");
 894                 }
 895         }
 896
 897
 898         return undef unless defined($testenv_vars);
 899
 900         $running_envs{$envname} = $testenv_vars;
 901
 902         if ($option eq "local") {
 903                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 904                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 905         } elsif ($option eq "client") {
 906                 SocketWrapper::set_default_iface(11);
 907                 write_clientconf($conffile, $clientdir, $testenv_vars);
 908                 $ENV{SMB_CONF_PATH} = $conffile;
 909         } else {
 910                 die("Unknown option[$option] for envname[$envname]");
 911         }
 912
 913         foreach (@exported_envvars) {
 914                 if (defined($testenv_vars->{$_})) {
 915                         $ENV{$_} = $testenv_vars->{$_};
 916                 } else {
 917                         delete $ENV{$_};
 918                 }
 919         }
 920
 921         return $testenv_vars;
 922 }
 923
 924 sub exported_envvars_str($)
 925 {
 926         my ($testenv_vars) = @_;
 927         my $out = "";
 928
 929         foreach (@exported_envvars) {
 930                 next unless defined($testenv_vars->{$_});
 931                 $out .= $_."=".$testenv_vars->{$_}."\n";
 932         }
 933
 934         return $out;
 935 }
 936
 937 sub getlog_env($)
 938 {
 939         my ($envname) = @_;
 940         return "" if ($envname eq "none");
 941         my $env = get_running_env($envname);
 942         return $env->{target}->getlog_env($env);
 943 }
 944
 945 sub check_env($)
 946 {
 947         my ($envname) = @_;
 948         return 1 if ($envname eq "none");
 949         my $env = get_running_env($envname);
 950         return $env->{target}->check_env($env);
 951 }
 952
 953 sub teardown_env($)
 954 {
 955         my ($envname) = @_;
 956         return if ($envname eq "none");
 957         my $env = get_running_env($envname);
 958         $env->{target}->teardown_env($env);
 959         delete $running_envs{$envname};
 960 }
 961
 962 # This 'global' file needs to be empty when we start
 963 unlink("$prefix_abs/dns_host_file");
 964
 965 if ($opt_testenv) {
 966         my $testenv_name = $ENV{SELFTEST_TESTENV};
 967         $testenv_name = $testenv_default unless defined($testenv_name);
 968
 969         my $testenv_vars = setup_env($testenv_name, $prefix);
 970
 971         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 972
 973         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 974         $ENV{ENVNAME} = $testenv_name;
 975
 976         my $envvarstr = exported_envvars_str($testenv_vars);
 977
 978         my $term = ($ENV{TERMINAL} or "xterm -e");
 979         system("$term 'echo -e \"
 980 Welcome to the Samba4 Test environment '$testenv_name'
 981
 982 This matches the client environment used in make test
 983 server is pid `cat \$PIDDIR/samba.pid`
 984
 985 Some useful environment variables:
 986 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 987 SMB_CONF_PATH=\$SMB_CONF_PATH
 988
 989 $envvarstr
 990 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 991         teardown_env($testenv_name);
 992 } elsif ($opt_list) {
 993         foreach (@todo) {
 994                 my $cmd = $$_[2];
 995                 my $name = $$_[0];
 996                 my $envname = $$_[1];
 997
 998                 unless($cmd =~ /\$LISTOPT/) {
 999                         warn("Unable to list tests in $name");
1000                         next;
1001                 }
1002
1003                 $cmd =~ s/\$LISTOPT/--list/g;
1004
1005                 system($cmd);
1006
1007                 if ($? == -1) {
1008                         die("Unable to run $cmd: $!");
1009                 } elsif ($? & 127) {
1010                         die(snprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
1011                 }
1012
1013                 my $exitcode = $? >> 8;
1014                 if ($exitcode != 0) {
1015                         die("$cmd exited with exit code $exitcode");
1016                 }
1017         }
1018 } else {
1019         foreach (@todo) {
1020                 $i++;
1021                 my $cmd = $$_[2];
1022                 my $name = $$_[0];
1023                 my $envname = $$_[1];
1024
1025                 my $envvars = setup_env($envname, $prefix);
1026                 if (not defined($envvars)) {
1027                         Subunit::start_testsuite($name);
1028                         Subunit::end_testsuite($name, "error",
1029                                 "unable to set up environment $envname - exiting");
1030                         next;
1031                 }
1032
1033                 # Generate a file with the individual tests to run, if the
1034                 # test runner for this test suite supports it.
1035                 if ($individual_tests and $individual_tests->{$name}) {
1036                         if ($$_[3]) {
1037                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
1038                                 foreach my $test (@{$individual_tests->{$name}}) {
1039                                         print $fh substr($test, length($name)+1) . "\n";
1040                                 }
1041                                 $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
1042                         } elsif ($$_[4]) {
1043                                 $cmd =~ s/\s+[^\s]+\s*$//;
1044                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
1045                         }
1046                 }
1047
1048                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
1049
1050                 teardown_env($envname) if ($opt_resetup_env);
1051         }
1052 }
1053
1054 print "\n";
1055
1056 teardown_env($_) foreach (keys %running_envs);
1057
1058 my $failed = 0;
1059
1060 # if there were any valgrind failures, show them
1061 foreach (<$prefix/valgrind.log*>) {
1062         next unless (-s $_);
1063         print "VALGRIND FAILURE\n";
1064         $failed++;
1065         system("cat $_");
1066 }
1067 exit 0;