selftest/selftest.pl

   1 #!/usr/bin/perl
   2 # Bootstrap Samba and run a number of tests against it.
   3 # Copyright (C) 2005-2009 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 Getopt::Long;
 129 use POSIX;
 130 use Cwd qw(abs_path);
 131 use lib "$RealBin";
 132 use Subunit qw(parse_results);
 133 use Subunit::Filter;
 134 use SocketWrapper;
 135
 136 my $opt_help = 0;
 137 my $opt_target = "samba4";
 138 my $opt_quick = 0;
 139 my $opt_socket_wrapper = 0;
 140 my $opt_socket_wrapper_pcap = undef;
 141 my $opt_socket_wrapper_keep_pcap = undef;
 142 my $opt_one = 0;
 143 my @opt_exclude = ();
 144 my @opt_include = ();
 145 my $opt_verbose = 0;
 146 my $opt_image = undef;
 147 my $opt_testenv = 0;
 148 my $ldap = undef;
 149 my $opt_analyse_cmd = undef;
 150 my $opt_resetup_env = undef;
 151 my $opt_bindir = undef;
 152 my $opt_no_lazy_setup = undef;
 153 my $opt_load_list = undef;
 154 my @testlists = ();
 155
 156 my $srcdir = ".";
 157 my $builddir = ".";
 158 my $exeext = "";
 159 my $prefix = "./st";
 160
 161 my @includes = ();
 162 my @excludes = ();
 163
 164 sub find_in_list($$)
 165 {
 166         my ($list, $fullname) = @_;
 167
 168         foreach (@$list) {
 169                 if ($fullname =~ /$$_[0]/) {
 170                          return ($$_[1]) if ($$_[1]);
 171                          return "";
 172                 }
 173         }
 174
 175         return undef;
 176 }
 177
 178 sub skip($)
 179 {
 180         my ($name) = @_;
 181
 182         return find_in_list(\@excludes, $name);
 183 }
 184
 185 sub getlog_env($);
 186
 187 sub setup_pcap($)
 188 {
 189         my ($name) = @_;
 190
 191         return unless ($opt_socket_wrapper_pcap);
 192         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 193
 194         my $fname = $name;
 195         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 196
 197         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 198
 199         SocketWrapper::setup_pcap($pcap_file);
 200
 201         return $pcap_file;
 202 }
 203
 204 sub cleanup_pcap($$)
 205 {
 206         my ($pcap_file, $exitcode) = @_;
 207
 208         return unless ($opt_socket_wrapper_pcap);
 209         return if ($opt_socket_wrapper_keep_pcap);
 210         return unless ($exitcode == 0);
 211         return unless defined($pcap_file);
 212
 213         unlink($pcap_file);
 214 }
 215
 216 # expand strings from %ENV
 217 sub expand_environment_strings($)
 218 {
 219         my $s = shift;
 220         # we use a reverse sort so we do the longer ones first
 221         foreach my $k (sort { $b cmp $a } keys %ENV) {
 222                 $s =~ s/\$$k/$ENV{$k}/g;
 223         }
 224         return $s;
 225 }
 226
 227 sub run_testsuite($$$$$$)
 228 {
 229         my ($envname, $name, $cmd, $i, $totalsuites, $tests_to_run) = @_;
 230         my $pcap_file = setup_pcap($name);
 231
 232         Subunit::start_testsuite($name);
 233         Subunit::progress_push();
 234         Subunit::report_time(time());
 235
 236         open(RESULTS, "$cmd 2>&1|");
 237         my $statistics = {
 238                 TESTS_UNEXPECTED_OK => 0,
 239                 TESTS_EXPECTED_OK => 0,
 240                 TESTS_UNEXPECTED_FAIL => 0,
 241                 TESTS_EXPECTED_FAIL => 0,
 242                 TESTS_ERROR => 0,
 243                 TESTS_SKIP => 0,
 244         };
 245
 246         my $msg_ops = new Subunit::Filter("$name\.", []);
 247
 248         parse_results($msg_ops, $statistics, *RESULTS);
 249
 250         my $ret = 0;
 251
 252         unless (close(RESULTS)) {
 253                 if ($!) {
 254                         Subunit::progress_pop();
 255                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 256                         return 0;
 257                 } else {
 258                         $ret = $?;
 259                 }
 260         }
 261
 262         if ($ret & 127) {
 263                 Subunit::progress_pop();
 264                 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
 265                 return 0;
 266         }
 267         my $envlog = getlog_env($envname);
 268         if ($envlog ne "") {
 269                 print "envlog: $envlog\n";
 270         }
 271
 272         print "command: $cmd\n";
 273         printf "expanded command: %s\n", expand_environment_strings($cmd);
 274
 275         my $exitcode = $ret >> 8;
 276
 277         Subunit::report_time(time());
 278         Subunit::progress_pop();
 279         if ($exitcode == 0) {
 280                 Subunit::end_testsuite($name, "success");
 281         } else {
 282                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 283         }
 284
 285         cleanup_pcap($pcap_file, $exitcode);
 286
 287         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 288                 print "PCAP FILE: $pcap_file\n";
 289         }
 290
 291         if ($exitcode != 0) {
 292                 exit(1) if ($opt_one);
 293         }
 294
 295         return $exitcode;
 296 }
 297
 298 sub ShowHelp()
 299 {
 300         print "Samba test runner
 301 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 302 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 303
 304 Usage: $Script [OPTIONS] TESTNAME-REGEX
 305
 306 Generic options:
 307  --help                     this help page
 308  --target=samba[34]|win|kvm Samba version to target
 309  --testlist=FILE            file to read available tests from
 310
 311 Paths:
 312  --prefix=DIR               prefix to run tests in [st]
 313  --srcdir=DIR               source directory [.]
 314  --builddir=DIR             output directory [.]
 315  --exeext=EXT               executable extention []
 316
 317 Target Specific:
 318  --socket-wrapper-pcap      save traffic to pcap directories
 319  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 320                             failed
 321  --socket-wrapper           enable socket wrapper
 322  --bindir=PATH              path to target binaries
 323
 324 Samba4 Specific:
 325  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 326
 327 Kvm Specific:
 328  --image=PATH               path to KVM image
 329
 330 Behaviour:
 331  --quick                    run quick overall test
 332  --one                      abort when the first test fails
 333  --verbose                  be verbose
 334  --analyse-cmd CMD          command to run after each test
 335 ";
 336         exit(0);
 337 }
 338
 339 my $result = GetOptions (
 340                 'help|h|?' => \$opt_help,
 341                 'target=s' => \$opt_target,
 342                 'prefix=s' => \$prefix,
 343                 'socket-wrapper' => \$opt_socket_wrapper,
 344                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 345                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 346                 'quick' => \$opt_quick,
 347                 'one' => \$opt_one,
 348                 'exclude=s' => \@opt_exclude,
 349                 'include=s' => \@opt_include,
 350                 'srcdir=s' => \$srcdir,
 351                 'builddir=s' => \$builddir,
 352                 'exeext=s' => \$exeext,
 353                 'verbose' => \$opt_verbose,
 354                 'testenv' => \$opt_testenv,
 355                 'ldap:s' => \$ldap,
 356                 'analyse-cmd=s' => \$opt_analyse_cmd,
 357                 'no-lazy-setup' => \$opt_no_lazy_setup,
 358                 'resetup-environment' => \$opt_resetup_env,
 359                 'bindir:s' => \$opt_bindir,
 360                 'image=s' => \$opt_image,
 361                 'testlist=s' => \@testlists,
 362                 'load-list=s' => \$opt_load_list,
 363             );
 364
 365 exit(1) if (not $result);
 366
 367 ShowHelp() if ($opt_help);
 368
 369 # we want unbuffered output
 370 $| = 1;
 371
 372 my @tests = @ARGV;
 373
 374 # quick hack to disable rpc validation when using valgrind - its way too slow
 375 unless (defined($ENV{VALGRIND})) {
 376         $ENV{VALIDATE} = "validate";
 377         $ENV{MALLOC_CHECK_} = 2;
 378 }
 379
 380 # make all our python scripts unbuffered
 381 $ENV{PYTHONUNBUFFERED} = 1;
 382
 383 my $bindir = ($opt_bindir or "$builddir/bin");
 384 my $bindir_abs = abs_path($bindir);
 385
 386 # Backwards compatibility:
 387 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 388         if (defined($ENV{FEDORA_DS_ROOT})) {
 389                 $ldap = "fedora-ds";
 390         } else {
 391                 $ldap = "openldap";
 392         }
 393 }
 394
 395 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 396 if ($ldap) {
 397         # LDAP is slow
 398         $torture_maxtime *= 2;
 399 }
 400
 401 $prefix =~ s+//+/+;
 402 $prefix =~ s+/./+/+;
 403 $prefix =~ s+/$++;
 404
 405 die("using an empty prefix isn't allowed") unless $prefix ne "";
 406
 407 #Ensure we have the test prefix around
 408 mkdir($prefix, 0777) unless -d $prefix;
 409
 410 my $prefix_abs = abs_path($prefix);
 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{EXEEXT} = $exeext;
 425
 426 my $tls_enabled = not $opt_quick;
 427 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 428 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
 429 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
 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/setup", $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);
 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.6/8",
 543                             "127.0.0.7/8",
 544                             "127.0.0.8/8",
 545                             "127.0.0.9/8",
 546                             "127.0.0.10/8",
 547                             "127.0.0.11/8"));
 548
 549 my $conffile = "$prefix_abs/client/client.conf";
 550 $ENV{SMB_CONF_PATH} = $conffile;
 551
 552 sub write_clientconf($$)
 553 {
 554         my ($conffile, $vars) = @_;
 555
 556         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 557
 558         if ( -d "$prefix/client/private" ) {
 559                 unlink <$prefix/client/private/*>;
 560         } else {
 561                 mkdir("$prefix/client/private", 0777);
 562         }
 563
 564         if ( -d "$prefix/client/lockdir" ) {
 565                 unlink <$prefix/client/lockdir/*>;
 566         } else {
 567                 mkdir("$prefix/client/lockdir", 0777);
 568         }
 569
 570         if ( -d "$prefix_abs/client/ncalrpcdir" ) {
 571                 unlink <$prefix/client/ncalrpcdir/*>;
 572         } else {
 573                 mkdir("$prefix/client/ncalrpcdir", 0777);
 574         }
 575
 576         open(CF, ">$conffile");
 577         print CF "[global]\n";
 578         if (defined($ENV{VALGRIND})) {
 579                 print CF "\ticonv:native = true\n";
 580         } else {
 581                 print CF "\ticonv:native = false\n";
 582         }
 583         print CF "\tnetbios name = client\n";
 584         if (defined($vars->{DOMAIN})) {
 585                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 586         }
 587         if (defined($vars->{REALM})) {
 588                 print CF "\trealm = $vars->{REALM}\n";
 589         }
 590         if ($opt_socket_wrapper) {
 591                 print CF "\tinterfaces = $interfaces\n";
 592         }
 593         print CF "
 594         private dir = $prefix_abs/client/private
 595         lock dir = $prefix_abs/client/lockdir
 596         ncalrpc dir = $prefix_abs/client/ncalrpcdir
 597         name resolve order = bcast file
 598         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 599         max xmit = 32K
 600         notify:inotify = false
 601         ldb:nosync = true
 602         system:anonymous = true
 603         client lanman auth = Yes
 604         torture:basedir = $prefix_abs/client
 605 #We don't want to pass our self-tests if the PAC code is wrong
 606         gensec:require_pac = true
 607         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 608         setup directory = ./setup
 609         resolv:host file = $prefix_abs/dns_host_file
 610 ";
 611         close(CF);
 612 }
 613
 614 my @todo = ();
 615
 616 my $testsdir = "$srcdir/selftest";
 617
 618 my %required_envs = ();
 619
 620 sub should_run_test($)
 621 {
 622         my $name = shift;
 623         if ($#tests == -1) {
 624                 return 1;
 625         }
 626         for (my $i=0; $i <= $#tests; $i++) {
 627                 if ($name =~ /$tests[$i]/i) {
 628                         return 1;
 629                 }
 630         }
 631         return 0;
 632 }
 633
 634 sub read_testlist($)
 635 {
 636         my ($filename) = @_;
 637
 638         my @ret = ();
 639         open(IN, $filename) or die("Unable to open $filename: $!");
 640
 641         while (<IN>) {
 642                 if ($_ eq "-- TEST --\n") {
 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                                 $required_envs{$env} = 1;
 651                                 push (@ret, [$name, $env, $cmdline]);
 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 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
 695 if ($opt_load_list) {
 696         $restricted = [];
 697         open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
 698         while (<LOAD_LIST>) {
 699                 chomp;
 700                 push (@$restricted, $_);
 701         }
 702         close(LOAD_LIST);
 703 }
 704
 705 Subunit::progress($#available+1);
 706 Subunit::report_time(time());
 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($skipreason)) {
 715                 Subunit::skip_testsuite($name, $skipreason);
 716         } elsif (defined($restricted)) {
 717                 # Find the testsuite for this test
 718                 my $match = 0;
 719                 foreach my $r (@$restricted) {
 720                         if ($r eq $name) {
 721                                 $individual_tests->{$name} = [];
 722                                 $match = 1;
 723                         }
 724                         if ($r =~ /^$name\.(.*)$/) {
 725                                 push(@{$individual_tests->{$name}}, $1);
 726                                 $match = 1;
 727                         }
 728                 }
 729                 push(@todo, $testsuite) if ($match);
 730         } else {
 731                 push(@todo, $testsuite);
 732         }
 733 }
 734
 735 if ($#todo == -1) {
 736         print STDERR "No tests to run\n";
 737         exit(1);
 738         }
 739
 740 my $suitestotal = $#todo + 1;
 741 my $i = 0;
 742 $| = 1;
 743
 744 my %running_envs = ();
 745
 746 sub get_running_env($)
 747 {
 748         my ($name) = @_;
 749
 750         my $envname = $name;
 751
 752         $envname =~ s/:.*//;
 753
 754         return $running_envs{$envname};
 755 }
 756
 757 my @exported_envvars = (
 758         # domain stuff
 759         "DOMAIN",
 760         "REALM",
 761
 762         # domain controller stuff
 763         "DC_SERVER",
 764         "DC_SERVER_IP",
 765         "DC_NETBIOSNAME",
 766         "DC_NETBIOSALIAS",
 767
 768         # domain controller stuff
 769         "MEMBER_SERVER",
 770         "MEMBER_SERVER_IP",
 771         "MEMBER_NETBIOSNAME",
 772         "MEMBER_NETBIOSALIAS",
 773
 774         # domain controller stuff
 775         "RPC_PROXY_SERVER",
 776         "RPC_PROXY_SERVER_IP",
 777         "RPC_PROXY_NETBIOSNAME",
 778         "RPC_PROXY_NETBIOSALIAS",
 779
 780         # server stuff
 781         "SERVER",
 782         "SERVER_IP",
 783         "NETBIOSNAME",
 784         "NETBIOSALIAS",
 785
 786         # user stuff
 787         "USERNAME",
 788         "PASSWORD",
 789         "DC_USERNAME",
 790         "DC_PASSWORD",
 791
 792         # misc stuff
 793         "KRB5_CONFIG",
 794         "WINBINDD_SOCKET_DIR",
 795         "WINBINDD_PRIV_PIPE_DIR"
 796 );
 797
 798 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 799         my $signame = shift;
 800         teardown_env($_) foreach(keys %running_envs);
 801         die("Received signal $signame");
 802 };
 803
 804 sub setup_env($)
 805 {
 806         my ($name) = @_;
 807
 808         my $testenv_vars = undef;
 809
 810         my $envname = $name;
 811         my $option = $name;
 812
 813         $envname =~ s/:.*//;
 814         $option =~ s/^[^:]*//;
 815         $option =~ s/^://;
 816
 817         $option = "client" if $option eq "";
 818
 819         if ($envname eq "none") {
 820                 $testenv_vars = {};
 821         } elsif (defined(get_running_env($envname))) {
 822                 $testenv_vars = get_running_env($envname);
 823                 if (not $target->check_env($testenv_vars)) {
 824                         $testenv_vars = undef;
 825                 }
 826         } else {
 827                 $testenv_vars = $target->setup_env($envname, $prefix);
 828         }
 829
 830         return undef unless defined($testenv_vars);
 831
 832         $running_envs{$envname} = $testenv_vars;
 833
 834         if ($option eq "local") {
 835                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 836                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 837         } elsif ($option eq "client") {
 838                 SocketWrapper::set_default_iface(6);
 839                 write_clientconf($conffile, $testenv_vars);
 840                 $ENV{SMB_CONF_PATH} = $conffile;
 841         } else {
 842                 die("Unknown option[$option] for envname[$envname]");
 843         }
 844
 845         foreach (@exported_envvars) {
 846                 if (defined($testenv_vars->{$_})) {
 847                         $ENV{$_} = $testenv_vars->{$_};
 848                 } else {
 849                         delete $ENV{$_};
 850                 }
 851         }
 852
 853         return $testenv_vars;
 854 }
 855
 856 sub exported_envvars_str($)
 857 {
 858         my ($testenv_vars) = @_;
 859         my $out = "";
 860
 861         foreach (@exported_envvars) {
 862                 next unless defined($testenv_vars->{$_});
 863                 $out .= $_."=".$testenv_vars->{$_}."\n";
 864         }
 865
 866         return $out;
 867 }
 868
 869 sub getlog_env($)
 870 {
 871         my ($envname) = @_;
 872         return "" if ($envname eq "none");
 873         return $target->getlog_env(get_running_env($envname));
 874 }
 875
 876 sub check_env($)
 877 {
 878         my ($envname) = @_;
 879         return 1 if ($envname eq "none");
 880         return $target->check_env(get_running_env($envname));
 881 }
 882
 883 sub teardown_env($)
 884 {
 885         my ($envname) = @_;
 886         return if ($envname eq "none");
 887         $target->teardown_env(get_running_env($envname));
 888         delete $running_envs{$envname};
 889 }
 890
 891 # This 'global' file needs to be empty when we start
 892 unlink("$prefix_abs/dns_host_file");
 893
 894 if ($opt_no_lazy_setup) {
 895         setup_env($_) foreach (keys %required_envs);
 896 }
 897
 898 if ($opt_testenv) {
 899         my $testenv_name = $ENV{SELFTEST_TESTENV};
 900         $testenv_name = $testenv_default unless defined($testenv_name);
 901
 902         my $testenv_vars = setup_env($testenv_name);
 903
 904         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 905
 906         my $envvarstr = exported_envvars_str($testenv_vars);
 907
 908         my $term = ($ENV{TERMINAL} or "xterm");
 909         system("$term -e 'echo -e \"
 910 Welcome to the Samba4 Test environment '$testenv_name'
 911
 912 This matches the client environment used in make test
 913 server is pid `cat \$PIDDIR/samba.pid`
 914
 915 Some useful environment variables:
 916 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 917 SMB_CONF_PATH=\$SMB_CONF_PATH
 918
 919 $envvarstr
 920 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 921         teardown_env($testenv_name);
 922 } else {
 923         foreach (@todo) {
 924                 $i++;
 925                 my $cmd = $$_[2];
 926                 $cmd =~ s/([\(\)])/\\$1/g;
 927                 my $name = $$_[0];
 928                 my $envname = $$_[1];
 929
 930                 my $envvars = setup_env($envname);
 931                 if (not defined($envvars)) {
 932                         Subunit::skip_testsuite($name,
 933                                 "unable to set up environment $envname");
 934                         next;
 935                 }
 936
 937                 run_testsuite($envname, $name, $cmd, $i, $suitestotal,
 938                                       ($individual_tests and $individual_tests->{$name}));
 939
 940                 if (defined($opt_analyse_cmd)) {
 941                         system("$opt_analyse_cmd \"$name\"");
 942                 }
 943
 944                 teardown_env($envname) if ($opt_resetup_env);
 945         }
 946 }
 947
 948 print "\n";
 949
 950 teardown_env($_) foreach (keys %running_envs);
 951
 952 $target->stop();
 953
 954 my $failed = 0;
 955
 956 # if there were any valgrind failures, show them
 957 foreach (<$prefix/valgrind.log*>) {
 958         next unless (-s $_);
 959         print "VALGRIND FAILURE\n";
 960         $failed++;
 961         system("cat $_");
 962 }
 963 exit 0;