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