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