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