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