selftest/selftest.pl

   1 #!/usr/bin/perl
   2 # Bootstrap Samba and run a number of tests against it.
   3 # Copyright (C) 2005-2010 Jelmer Vernooij <jelmer@samba.org>
   4 # Copyright (C) 2007-2009 Stefan Metzmacher <metze@samba.org>
   5
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 =pod
  20
  21 =head1 NAME
  22
  23 selftest - Samba test runner
  24
  25 =head1 SYNOPSIS
  26
  27 selftest --help
  28
  29 selftest [--srcdir=DIR] [--builddir=DIR] [--exeext=EXT][--target=samba4|samba3|win|kvm] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--testlist=FILE] [TESTS]
  30
  31 =head1 DESCRIPTION
  32
  33 A simple test runner. TESTS is a regular expression with tests to run.
  34
  35 =head1 OPTIONS
  36
  37 =over 4
  38
  39 =item I<--help>
  40
  41 Show list of available options.
  42
  43 =item I<--srcdir=DIR>
  44
  45 Source directory.
  46
  47 =item I<--builddir=DIR>
  48
  49 Build directory.
  50
  51 =item I<--exeext=EXT>
  52
  53 Executable extention
  54
  55 =item I<--prefix=DIR>
  56
  57 Change directory to run tests in. Default is 'st'.
  58
  59 =item I<--target samba4|samba3|win|kvm>
  60
  61 Specify test target against which to run. Default is 'samba4'.
  62
  63 =item I<--quick>
  64
  65 Run only a limited number of tests. Intended to run in about 30 seconds on
  66 moderately recent systems.
  67
  68 =item I<--socket-wrapper>
  69
  70 Use socket wrapper library for communication with server. Only works
  71 when the server is running locally.
  72
  73 Will prevent TCP and UDP ports being opened on the local host but
  74 (transparently) redirects these calls to use unix domain sockets.
  75
  76 =item I<--exclude>
  77
  78 Specify a file containing a list of tests that should be skipped. Possible
  79 candidates are tests that segfault the server, flip or don't end.
  80
  81 =item I<--include>
  82
  83 Specify a file containing a list of tests that should be run. Same format
  84 as the --exclude flag.
  85
  86 Not includes specified means all tests will be run.
  87
  88 =item I<--one>
  89
  90 Abort as soon as one test fails.
  91
  92 =item I<--testlist>
  93
  94 Load a list of tests from the specified location.
  95
  96 =back
  97
  98 =head1 ENVIRONMENT
  99
 100 =over 4
 101
 102 =item I<SMBD_VALGRIND>
 103
 104 =item I<TORTURE_MAXTIME>
 105
 106 =item I<VALGRIND>
 107
 108 =item I<TLS_ENABLED>
 109
 110 =item I<srcdir>
 111
 112 =back
 113
 114 =head1 LICENSE
 115
 116 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
 117
 118 =head1 AUTHOR
 119
 120 Jelmer Vernooij
 121
 122 =cut
 123
 124 use strict;
 125
 126 use FindBin qw($RealBin $Script);
 127 use File::Spec;
 128 use File::Temp qw(tempfile);
 129 use Getopt::Long;
 130 use POSIX;
 131 use Cwd qw(abs_path);
 132 use lib "$RealBin";
 133 use Subunit;
 134 use SocketWrapper;
 135
 136 eval {
 137 require Time::HiRes;
 138 Time::HiRes->import("time");
 139 };
 140 if ($@) {
 141         print "You don't have Time::Hires installed !\n";
 142 }
 143
 144 my $opt_help = 0;
 145 my $opt_target = "samba4";
 146 my $opt_quick = 0;
 147 my $opt_socket_wrapper = 0;
 148 my $opt_socket_wrapper_pcap = undef;
 149 my $opt_socket_wrapper_keep_pcap = undef;
 150 my $opt_one = 0;
 151 my @opt_exclude = ();
 152 my @opt_include = ();
 153 my $opt_verbose = 0;
 154 my $opt_image = undef;
 155 my $opt_testenv = 0;
 156 my $opt_list = 0;
 157 my $ldap = undef;
 158 my $opt_resetup_env = undef;
 159 my $opt_bindir = undef;
 160 my $opt_load_list = undef;
 161 my @testlists = ();
 162
 163 my $srcdir = ".";
 164 my $builddir = ".";
 165 my $exeext = "";
 166 my $prefix = "./st";
 167
 168 my @includes = ();
 169 my @excludes = ();
 170
 171 sub pipe_handler {
 172         my $sig = shift @_;
 173         print STDERR "Exiting early because of SIGPIPE.\n";
 174         exit(1);
 175 }
 176
 177 $SIG{PIPE} = \&pipe_handler;
 178
 179 sub find_in_list($$)
 180 {
 181         my ($list, $fullname) = @_;
 182
 183         foreach (@$list) {
 184                 if ($fullname =~ /$$_[0]/) {
 185                          return ($$_[1]) if ($$_[1]);
 186                          return "";
 187                 }
 188         }
 189
 190         return undef;
 191 }
 192
 193 sub skip($)
 194 {
 195         my ($name) = @_;
 196
 197         return find_in_list(\@excludes, $name);
 198 }
 199
 200 sub getlog_env($);
 201
 202 sub setup_pcap($)
 203 {
 204         my ($name) = @_;
 205
 206         return unless ($opt_socket_wrapper_pcap);
 207         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 208
 209         my $fname = $name;
 210         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 211
 212         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 213
 214         SocketWrapper::setup_pcap($pcap_file);
 215
 216         return $pcap_file;
 217 }
 218
 219 sub cleanup_pcap($$)
 220 {
 221         my ($pcap_file, $exitcode) = @_;
 222
 223         return unless ($opt_socket_wrapper_pcap);
 224         return if ($opt_socket_wrapper_keep_pcap);
 225         return unless ($exitcode == 0);
 226         return unless defined($pcap_file);
 227
 228         unlink($pcap_file);
 229 }
 230
 231 # expand strings from %ENV
 232 sub expand_environment_strings($)
 233 {
 234         my $s = shift;
 235         # we use a reverse sort so we do the longer ones first
 236         foreach my $k (sort { $b cmp $a } keys %ENV) {
 237                 $s =~ s/\$$k/$ENV{$k}/g;
 238         }
 239         return $s;
 240 }
 241
 242 sub run_testsuite($$$$$)
 243 {
 244         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 245         my $pcap_file = setup_pcap($name);
 246
 247         Subunit::start_testsuite($name);
 248         Subunit::progress_push();
 249         Subunit::report_time(time());
 250         system($cmd);
 251         Subunit::report_time(time());
 252         Subunit::progress_pop();
 253
 254         if ($? == -1) {
 255                 Subunit::progress_pop();
 256                 Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 257                 exit(1);
 258         } elsif ($? & 127) {
 259                 Subunit::end_testsuite($name, "error",
 260                         sprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
 261                 exit(1);
 262         }
 263
 264         my $exitcode = $? >> 8;
 265
 266         my $envlog = getlog_env($envname);
 267         if ($envlog ne "") {
 268                 print "envlog: $envlog\n";
 269         }
 270
 271         print "command: $cmd\n";
 272         printf "expanded command: %s\n", expand_environment_strings($cmd);
 273
 274         if ($exitcode == 0) {
 275                 Subunit::end_testsuite($name, "success");
 276         } else {
 277                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 278         }
 279
 280         cleanup_pcap($pcap_file, $exitcode);
 281
 282         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 283                 print "PCAP FILE: $pcap_file\n";
 284         }
 285
 286         if ($exitcode != 0) {
 287                 exit(1) if ($opt_one);
 288         }
 289
 290         return $exitcode;
 291 }
 292
 293 sub ShowHelp()
 294 {
 295         print "Samba test runner
 296 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 297 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 298
 299 Usage: $Script [OPTIONS] TESTNAME-REGEX
 300
 301 Generic options:
 302  --help                     this help page
 303  --target=samba[34]|win|kvm Samba version to target
 304  --testlist=FILE            file to read available tests from
 305
 306 Paths:
 307  --prefix=DIR               prefix to run tests in [st]
 308  --srcdir=DIR               source directory [.]
 309  --builddir=DIR             output directory [.]
 310  --exeext=EXT               executable extention []
 311
 312 Target Specific:
 313  --socket-wrapper-pcap      save traffic to pcap directories
 314  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 315                             failed
 316  --socket-wrapper           enable socket wrapper
 317  --bindir=PATH              path to target binaries
 318
 319 Samba4 Specific:
 320  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 321
 322 Kvm Specific:
 323  --image=PATH               path to KVM image
 324
 325 Behaviour:
 326  --quick                    run quick overall test
 327  --one                      abort when the first test fails
 328  --verbose                  be verbose
 329  --testenv                  run a shell in the requested test environment
 330  --list                     list available tests
 331 ";
 332         exit(0);
 333 }
 334
 335 my $result = GetOptions (
 336                 'help|h|?' => \$opt_help,
 337                 'target=s' => \$opt_target,
 338                 'prefix=s' => \$prefix,
 339                 'socket-wrapper' => \$opt_socket_wrapper,
 340                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 341                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 342                 'quick' => \$opt_quick,
 343                 'one' => \$opt_one,
 344                 'exclude=s' => \@opt_exclude,
 345                 'include=s' => \@opt_include,
 346                 'srcdir=s' => \$srcdir,
 347                 'builddir=s' => \$builddir,
 348                 'exeext=s' => \$exeext,
 349                 'verbose' => \$opt_verbose,
 350                 'testenv' => \$opt_testenv,
 351                 'list' => \$opt_list,
 352                 'ldap:s' => \$ldap,
 353                 'resetup-environment' => \$opt_resetup_env,
 354                 'bindir:s' => \$opt_bindir,
 355                 'image=s' => \$opt_image,
 356                 'testlist=s' => \@testlists,
 357                 'load-list=s' => \$opt_load_list,
 358             );
 359
 360 exit(1) if (not $result);
 361
 362 ShowHelp() if ($opt_help);
 363
 364 die("--list and --testenv are mutually exclusive") if ($opt_list and $opt_testenv);
 365
 366 # we want unbuffered output
 367 $| = 1;
 368
 369 my @tests = @ARGV;
 370
 371 # quick hack to disable rpc validation when using valgrind - its way too slow
 372 unless (defined($ENV{VALGRIND})) {
 373         $ENV{VALIDATE} = "validate";
 374         $ENV{MALLOC_CHECK_} = 2;
 375 }
 376
 377 # make all our python scripts unbuffered
 378 $ENV{PYTHONUNBUFFERED} = 1;
 379
 380 my $bindir = ($opt_bindir or "$builddir/bin");
 381 my $bindir_abs = abs_path($bindir);
 382
 383 # Backwards compatibility:
 384 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 385         if (defined($ENV{FEDORA_DS_ROOT})) {
 386                 $ldap = "fedora-ds";
 387         } else {
 388                 $ldap = "openldap";
 389         }
 390 }
 391
 392 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 393 if ($ldap) {
 394         # LDAP is slow
 395         $torture_maxtime *= 2;
 396 }
 397
 398 $prefix =~ s+//+/+;
 399 $prefix =~ s+/./+/+;
 400 $prefix =~ s+/$++;
 401
 402 die("using an empty prefix isn't allowed") unless $prefix ne "";
 403
 404 #Ensure we have the test prefix around
 405 mkdir($prefix, 0777) unless -d $prefix;
 406
 407 my $prefix_abs = abs_path($prefix);
 408 my $tmpdir_abs = abs_path("$prefix/tmp");
 409 mkdir($tmpdir_abs, 0777) unless -d $tmpdir_abs;
 410
 411 my $srcdir_abs = abs_path($srcdir);
 412 my $builddir_abs = abs_path($builddir);
 413
 414 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 415 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 416
 417 $ENV{PREFIX} = $prefix;
 418 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 419 $ENV{PREFIX_ABS} = $prefix_abs;
 420 $ENV{SRCDIR} = $srcdir;
 421 $ENV{SRCDIR_ABS} = $srcdir_abs;
 422 $ENV{BUILDDIR} = $builddir;
 423 $ENV{BUILDDIR_ABS} = $builddir_abs;
 424 $ENV{BINDIR} = $bindir_abs;
 425 $ENV{EXEEXT} = $exeext;
 426
 427 my $tls_enabled = not $opt_quick;
 428 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 429
 430 sub prefix_pathvar($$)
 431 {
 432         my ($name, $newpath) = @_;
 433         if (defined($ENV{$name})) {
 434                 $ENV{$name} = "$newpath:$ENV{$name}";
 435         } else {
 436                 $ENV{$name} = $newpath;
 437         }
 438 }
 439 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 440 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 441
 442 if ($opt_socket_wrapper_keep_pcap) {
 443         # Socket wrapper keep pcap implies socket wrapper pcap
 444         $opt_socket_wrapper_pcap = 1;
 445 }
 446
 447 if ($opt_socket_wrapper_pcap) {
 448         # Socket wrapper pcap implies socket wrapper
 449         $opt_socket_wrapper = 1;
 450 }
 451
 452 my $socket_wrapper_dir;
 453 if ($opt_socket_wrapper) {
 454         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
 455         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 456 } else {
 457          unless ($< == 0) {
 458                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 459          }
 460 }
 461
 462 my $target;
 463 my $testenv_default = "none";
 464
 465 if ($opt_target eq "samba4") {
 466         $testenv_default = "all";
 467         require target::Samba4;
 468         $target = new Samba4($bindir, $ldap, $srcdir, $exeext);
 469 } elsif ($opt_target eq "samba3") {
 470         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 471                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 472         }
 473         $testenv_default = "member";
 474         require target::Samba3;
 475         $target = new Samba3($bindir, $srcdir_abs);
 476 } elsif ($opt_target eq "win") {
 477         die("Windows tests will not run with socket wrapper enabled.")
 478                 if ($opt_socket_wrapper);
 479         $testenv_default = "dc";
 480         require target::Windows;
 481         $target = new Windows();
 482 } elsif ($opt_target eq "kvm") {
 483         die("Kvm tests will not run with socket wrapper enabled.")
 484                 if ($opt_socket_wrapper);
 485         require target::Kvm;
 486         die("No image specified") unless ($opt_image);
 487         $target = new Kvm($opt_image, undef);
 488 }
 489
 490 #
 491 # Start a Virtual Distributed Ethernet Switch
 492 # Returns the pid of the switch.
 493 #
 494 sub start_vde_switch($)
 495 {
 496         my ($path) = @_;
 497
 498         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 499
 500         open(PID, "$path/vde.pid");
 501         <PID> =~ /([0-9]+)/;
 502         my $pid = $1;
 503         close(PID);
 504
 505         return $pid;
 506 }
 507
 508 # Stop a Virtual Distributed Ethernet Switch
 509 sub stop_vde_switch($)
 510 {
 511         my ($pid) = @_;
 512         kill 9, $pid;
 513 }
 514
 515 sub read_test_regexes($)
 516 {
 517         my ($name) = @_;
 518         my @ret = ();
 519         open(LF, "<$name") or die("unable to read $name: $!");
 520         while (<LF>) {
 521                 chomp;
 522                 next if (/^#/);
 523                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 524                         push (@ret, [$1, $4]);
 525                 } else {
 526                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 527                         push (@ret, [$_, undef]);
 528                 }
 529         }
 530         close(LF);
 531         return @ret;
 532 }
 533
 534 foreach (@opt_exclude) {
 535         push (@excludes, read_test_regexes($_));
 536 }
 537
 538 foreach (@opt_include) {
 539         push (@includes, read_test_regexes($_));
 540 }
 541
 542 my $interfaces = join(',', ("127.0.0.11/8",
 543                             "127.0.0.12/8",
 544                             "127.0.0.13/8",
 545                             "127.0.0.14/8",
 546                             "127.0.0.15/8",
 547                             "127.0.0.16/8"));
 548
 549 my $clientdir = "$prefix_abs/client";
 550
 551 my $conffile = "$clientdir/client.conf";
 552 $ENV{SMB_CONF_PATH} = $conffile;
 553
 554 sub write_clientconf($$$)
 555 {
 556         my ($conffile, $clientdir, $vars) = @_;
 557
 558         mkdir("$clientdir", 0777) unless -d "$clientdir";
 559
 560         if ( -d "$clientdir/private" ) {
 561                 unlink <$clientdir/private/*>;
 562         } else {
 563                 mkdir("$clientdir/private", 0777);
 564         }
 565
 566         if ( -d "$clientdir/lockdir" ) {
 567                 unlink <$clientdir/lockdir/*>;
 568         } else {
 569                 mkdir("$clientdir/lockdir", 0777);
 570         }
 571
 572         if ( -d "$clientdir/ncalrpcdir" ) {
 573                 unlink <$clientdir/ncalrpcdir/*>;
 574         } else {
 575                 mkdir("$clientdir/ncalrpcdir", 0777);
 576         }
 577
 578         open(CF, ">$conffile");
 579         print CF "[global]\n";
 580         if (defined($ENV{VALGRIND})) {
 581                 print CF "\ticonv:native = true\n";
 582         } else {
 583                 print CF "\ticonv:native = false\n";
 584         }
 585         print CF "\tnetbios name = client\n";
 586         if (defined($vars->{DOMAIN})) {
 587                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 588         }
 589         if (defined($vars->{REALM})) {
 590                 print CF "\trealm = $vars->{REALM}\n";
 591         }
 592         if ($opt_socket_wrapper) {
 593                 print CF "\tinterfaces = $interfaces\n";
 594         }
 595         print CF "
 596         private dir = $clientdir/private
 597         lock dir = $clientdir/lockdir
 598         ncalrpc dir = $clientdir/ncalrpcdir
 599         name resolve order = bcast file
 600         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 601         max xmit = 32K
 602         notify:inotify = false
 603         ldb:nosync = true
 604         system:anonymous = true
 605         client lanman auth = Yes
 606         log level = 1
 607         torture:basedir = $clientdir
 608 #We don't want to pass our self-tests if the PAC code is wrong
 609         gensec:require_pac = true
 610         resolv:host file = $prefix_abs/dns_host_file
 611 #We don't want to run 'speed' tests for very long
 612         torture:timelimit = 1
 613 ";
 614         close(CF);
 615 }
 616
 617 my @todo = ();
 618
 619 sub should_run_test($)
 620 {
 621         my $name = shift;
 622         if ($#tests == -1) {
 623                 return 1;
 624         }
 625         for (my $i=0; $i <= $#tests; $i++) {
 626                 if ($name =~ /$tests[$i]/i) {
 627                         return 1;
 628                 }
 629         }
 630         return 0;
 631 }
 632
 633 sub read_testlist($)
 634 {
 635         my ($filename) = @_;
 636
 637         my @ret = ();
 638         open(IN, $filename) or die("Unable to open $filename: $!");
 639
 640         while (<IN>) {
 641                 if (/-- TEST(-LOADLIST|-IDLIST|) --\n/) {
 642                         my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
 643                         my $supports_idlist = (defined($1) and $1 eq "-IDLIST");
 644                         my $name = <IN>;
 645                         $name =~ s/\n//g;
 646                         my $env = <IN>;
 647                         $env =~ s/\n//g;
 648                         my $cmdline = <IN>;
 649                         $cmdline =~ s/\n//g;
 650                         if (should_run_test($name) == 1) {
 651                                 push (@ret, [$name, $env, $cmdline, $supports_loadlist, $supports_idlist]);
 652                         }
 653                 } else {
 654                         print;
 655                 }
 656         }
 657         close(IN) or die("Error creating recipe");
 658         return @ret;
 659 }
 660
 661 if ($#testlists == -1) {
 662         die("No testlists specified");
 663 }
 664
 665 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 666 $ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
 667 $ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
 668 if ($opt_socket_wrapper) {
 669         $ENV{SELFTEST_INTERFACES} = $interfaces;
 670 } else {
 671         $ENV{SELFTEST_INTERFACES} = "";
 672 }
 673 if ($opt_verbose) {
 674         $ENV{SELFTEST_VERBOSE} = "1";
 675 } else {
 676         $ENV{SELFTEST_VERBOSE} = "";
 677 }
 678 if ($opt_quick) {
 679         $ENV{SELFTEST_QUICK} = "1";
 680 } else {
 681         $ENV{SELFTEST_QUICK} = "";
 682 }
 683 $ENV{SELFTEST_TARGET} = $opt_target;
 684 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 685
 686 my @available = ();
 687 foreach my $fn (@testlists) {
 688         foreach (read_testlist($fn)) {
 689                 my $name = $$_[0];
 690                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 691                 push (@available, $_);
 692         }
 693 }
 694
 695 my $restricted = undef;
 696 my $restricted_used = {};
 697
 698 if ($opt_load_list) {
 699         $restricted = [];
 700         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 701         while (<LOAD_LIST>) {
 702                 chomp;
 703                 push (@$restricted, $_);
 704         }
 705         close(LOAD_LIST);
 706 }
 707
 708 my $individual_tests = undef;
 709 $individual_tests = {};
 710
 711 foreach my $testsuite (@available) {
 712         my $name = $$testsuite[0];
 713         my $skipreason = skip($name);
 714         if (defined($restricted)) {
 715                 # Find the testsuite for this test
 716                 my $match = undef;
 717                 foreach my $r (@$restricted) {
 718                         if ($r eq $name) {
 719                                 $individual_tests->{$name} = [];
 720                                 $match = $r;
 721                                 $restricted_used->{$r} = 1;
 722                         } elsif (substr($r, 0, length($name)+1) eq "$name.") {
 723                                 push(@{$individual_tests->{$name}}, $r);
 724                                 $match = $r;
 725                                 $restricted_used->{$r} = 1;
 726                         }
 727                 }
 728                 if ($match) {
 729                         if (defined($skipreason)) {
 730                                         Subunit::skip_testsuite($name, $skipreason);
 731                         } else {
 732                                 push(@todo, $testsuite);
 733                         }
 734                 }
 735         } elsif (defined($skipreason)) {
 736                 Subunit::skip_testsuite($name, $skipreason);
 737         } else {
 738                 push(@todo, $testsuite);
 739         }
 740 }
 741
 742 if (defined($restricted)) {
 743         foreach (@$restricted) {
 744                 unless (defined($restricted_used->{$_})) {
 745                         print "No test or testsuite found matching $_\n";
 746                 }
 747         }
 748 } elsif ($#todo == -1) {
 749         print STDERR "No tests to run\n";
 750         exit(1);
 751 }
 752
 753 my $suitestotal = $#todo + 1;
 754
 755 Subunit::progress($suitestotal);
 756 Subunit::report_time(time());
 757
 758 my $i = 0;
 759 $| = 1;
 760
 761 my %running_envs = ();
 762
 763 sub get_running_env($)
 764 {
 765         my ($name) = @_;
 766
 767         my $envname = $name;
 768
 769         $envname =~ s/:.*//;
 770
 771         return $running_envs{$envname};
 772 }
 773
 774 my @exported_envvars = (
 775         # domain stuff
 776         "DOMAIN",
 777         "REALM",
 778
 779         # domain controller stuff
 780         "DC_SERVER",
 781         "DC_SERVER_IP",
 782         "DC_NETBIOSNAME",
 783         "DC_NETBIOSALIAS",
 784
 785         # domain member
 786         "MEMBER_SERVER",
 787         "MEMBER_SERVER_IP",
 788         "MEMBER_NETBIOSNAME",
 789         "MEMBER_NETBIOSALIAS",
 790
 791         # rpc proxy controller stuff
 792         "RPC_PROXY_SERVER",
 793         "RPC_PROXY_SERVER_IP",
 794         "RPC_PROXY_NETBIOSNAME",
 795         "RPC_PROXY_NETBIOSALIAS",
 796
 797         # domain controller stuff for Vampired DC
 798         "VAMPIRE_DC_SERVER",
 799         "VAMPIRE_DC_SERVER_IP",
 800         "VAMPIRE_DC_NETBIOSNAME",
 801         "VAMPIRE_DC_NETBIOSALIAS",
 802
 803         # server stuff
 804         "SERVER",
 805         "SERVER_IP",
 806         "NETBIOSNAME",
 807         "NETBIOSALIAS",
 808
 809         # user stuff
 810         "USERNAME",
 811         "USERID",
 812         "PASSWORD",
 813         "DC_USERNAME",
 814         "DC_PASSWORD",
 815
 816         # misc stuff
 817         "KRB5_CONFIG",
 818         "WINBINDD_SOCKET_DIR",
 819         "WINBINDD_PRIV_PIPE_DIR",
 820         "NMBD_SOCKET_DIR",
 821         "LOCAL_PATH"
 822 );
 823
 824 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 825         my $signame = shift;
 826         teardown_env($_) foreach(keys %running_envs);
 827         die("Received signal $signame");
 828 };
 829
 830 sub setup_env($$)
 831 {
 832         my ($name, $prefix) = @_;
 833
 834         my $testenv_vars = undef;
 835
 836         my $envname = $name;
 837         my $option = $name;
 838
 839         $envname =~ s/:.*//;
 840         $option =~ s/^[^:]*//;
 841         $option =~ s/^://;
 842
 843         $option = "client" if $option eq "";
 844
 845         if ($envname eq "none") {
 846                 $testenv_vars = {};
 847         } elsif (defined(get_running_env($envname))) {
 848                 $testenv_vars = get_running_env($envname);
 849                 if (not $testenv_vars->{target}->check_env($testenv_vars)) {
 850                         print $testenv_vars->{target}->getlog_env($testenv_vars);
 851                         $testenv_vars = undef;
 852                 }
 853         } else {
 854                 $testenv_vars = $target->setup_env($envname, $prefix);
 855                 if (defined($testenv_vars) && not defined($testenv_vars->{target})) {
 856                        $testenv_vars->{target} = $target;
 857                 }
 858         }
 859
 860         return undef unless defined($testenv_vars);
 861
 862         $running_envs{$envname} = $testenv_vars;
 863
 864         if ($option eq "local") {
 865                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 866                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 867         } elsif ($option eq "client") {
 868                 SocketWrapper::set_default_iface(11);
 869                 write_clientconf($conffile, $clientdir, $testenv_vars);
 870                 $ENV{SMB_CONF_PATH} = $conffile;
 871         } else {
 872                 die("Unknown option[$option] for envname[$envname]");
 873         }
 874
 875         foreach (@exported_envvars) {
 876                 if (defined($testenv_vars->{$_})) {
 877                         $ENV{$_} = $testenv_vars->{$_};
 878                 } else {
 879                         delete $ENV{$_};
 880                 }
 881         }
 882
 883         return $testenv_vars;
 884 }
 885
 886 sub exported_envvars_str($)
 887 {
 888         my ($testenv_vars) = @_;
 889         my $out = "";
 890
 891         foreach (@exported_envvars) {
 892                 next unless defined($testenv_vars->{$_});
 893                 $out .= $_."=".$testenv_vars->{$_}."\n";
 894         }
 895
 896         return $out;
 897 }
 898
 899 sub getlog_env($)
 900 {
 901         my ($envname) = @_;
 902         return "" if ($envname eq "none");
 903         my $env = get_running_env($envname);
 904         return $env->{target}->getlog_env($env);
 905 }
 906
 907 sub check_env($)
 908 {
 909         my ($envname) = @_;
 910         return 1 if ($envname eq "none");
 911         my $env = get_running_env($envname);
 912         return $env->{target}->check_env($env);
 913 }
 914
 915 sub teardown_env($)
 916 {
 917         my ($envname) = @_;
 918         return if ($envname eq "none");
 919         my $env = get_running_env($envname);
 920         $env->{target}->teardown_env($env);
 921         delete $running_envs{$envname};
 922 }
 923
 924 # This 'global' file needs to be empty when we start
 925 unlink("$prefix_abs/dns_host_file");
 926
 927 if ($opt_testenv) {
 928         my $testenv_name = $ENV{SELFTEST_TESTENV};
 929         $testenv_name = $testenv_default unless defined($testenv_name);
 930
 931         my $testenv_vars = setup_env($testenv_name, $prefix);
 932
 933         die("Unable to setup environment $testenv_name") unless ($testenv_vars);
 934
 935         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 936         $ENV{ENVNAME} = $testenv_name;
 937
 938         my $envvarstr = exported_envvars_str($testenv_vars);
 939
 940         my $term = ($ENV{TERMINAL} or "xterm -e");
 941         system("$term 'echo -e \"
 942 Welcome to the Samba4 Test environment '$testenv_name'
 943
 944 This matches the client environment used in make test
 945 server is pid `cat \$PIDDIR/samba.pid`
 946
 947 Some useful environment variables:
 948 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 949 SMB_CONF_PATH=\$SMB_CONF_PATH
 950
 951 $envvarstr
 952 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 953         teardown_env($testenv_name);
 954 } elsif ($opt_list) {
 955         foreach (@todo) {
 956                 my $cmd = $$_[2];
 957                 my $name = $$_[0];
 958                 my $envname = $$_[1];
 959
 960                 unless($cmd =~ /\$LISTOPT/) {
 961                         warn("Unable to list tests in $name");
 962                         next;
 963                 }
 964
 965                 $cmd =~ s/\$LISTOPT/--list/g;
 966
 967                 system($cmd);
 968
 969                 if ($? == -1) {
 970                         die("Unable to run $cmd: $!");
 971                 } elsif ($? & 127) {
 972                         die(snprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127),  ($? & 128) ? 'with' : 'without'));
 973                 }
 974
 975                 my $exitcode = $? >> 8;
 976                 if ($exitcode != 0) {
 977                         die("$cmd exited with exit code $exitcode");
 978                 }
 979         }
 980 } else {
 981         foreach (@todo) {
 982                 $i++;
 983                 my $cmd = $$_[2];
 984                 my $name = $$_[0];
 985                 my $envname = $$_[1];
 986
 987                 my $envvars = setup_env($envname, $prefix);
 988                 if (not defined($envvars)) {
 989                         Subunit::start_testsuite($name);
 990                         Subunit::end_testsuite($name, "error",
 991                                 "unable to set up environment $envname - exiting");
 992                         next;
 993                 }
 994
 995                 # Generate a file with the individual tests to run, if the
 996                 # test runner for this test suite supports it.
 997                 if ($individual_tests and $individual_tests->{$name}) {
 998                         if ($$_[3]) {
 999                                 my ($fh, $listid_file) = tempfile(UNLINK => 0);
1000                                 foreach my $test (@{$individual_tests->{$name}}) {
1001                                         print $fh substr($test, length($name)+1) . "\n";
1002                                 }
1003                                 $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
1004                         } elsif ($$_[4]) {
1005                                 $cmd =~ s/\s+[^\s]+\s*$//;
1006                                 $cmd .= " " . join(' ', @{$individual_tests->{$name}});
1007                         }
1008                 }
1009
1010                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
1011
1012                 teardown_env($envname) if ($opt_resetup_env);
1013         }
1014 }
1015
1016 print "\n";
1017
1018 teardown_env($_) foreach (keys %running_envs);
1019
1020 my $failed = 0;
1021
1022 # if there were any valgrind failures, show them
1023 foreach (<$prefix/valgrind.log*>) {
1024         next unless (-s $_);
1025         print "VALGRIND FAILURE\n";
1026         $failed++;
1027         system("cat $_");
1028 }
1029 exit 0;