source/selftest/selftest.pl

   1 #!/usr/bin/perl
   2 # Bootstrap Samba and run a number of tests against it.
   3 # Copyright (C) 2005-2007 Jelmer Vernooij <jelmer@samba.org>
   4 # Published under the GNU GPL, v3 or later.
   5
   6 =pod
   7
   8 =head1 NAME
   9
  10 selftest - Samba test runner
  11
  12 =head1 SYNOPSIS
  13
  14 selftest --help
  15
  16 selftest [--srcdir=DIR] [--builddir=DIR] [--target=samba4|samba3|win] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--immediate] [--testlist=FILE] [TESTS]
  17
  18 =head1 DESCRIPTION
  19
  20 A simple test runner. TESTS is a regular expression with tests to run.
  21
  22 =head1 OPTIONS
  23
  24 =over 4
  25
  26 =item I<--help>
  27
  28 Show list of available options.
  29
  30 =item I<--srcdir=DIR>
  31
  32 Source directory.
  33
  34 =item I<--builddir=DIR>
  35
  36 Build directory.
  37
  38 =item I<--prefix=DIR>
  39
  40 Change directory to run tests in. Default is 'st'.
  41
  42 =item I<--immediate>
  43
  44 Show errors as soon as they happen rather than at the end of the test run.
  45
  46 =item I<--target samba4|samba3|win>
  47
  48 Specify test target against which to run. Default is 'samba4'.
  49
  50 =item I<--quick>
  51
  52 Run only a limited number of tests. Intended to run in about 30 seconds on
  53 moderately recent systems.
  54
  55 =item I<--socket-wrapper>
  56
  57 Use socket wrapper library for communication with server. Only works
  58 when the server is running locally.
  59
  60 Will prevent TCP and UDP ports being opened on the local host but
  61 (transparently) redirects these calls to use unix domain sockets.
  62
  63 =item I<--expected-failures>
  64
  65 Specify a file containing a list of tests that are expected to fail. Failures for
  66 these tests will be counted as successes, successes will be counted as failures.
  67
  68 The format for the file is, one entry per line:
  69
  70 TESTSUITE-NAME.TEST-NAME
  71
  72 The reason for a test can also be specified, by adding a hash sign (#) and the reason
  73 after the test name.
  74
  75 =item I<--exclude>
  76
  77 Specify a file containing a list of tests that should be skipped. Possible
  78 candidates are tests that segfault the server, flip or don't end. The format of this file is the same as
  79 for the --expected-failures flag.
  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 SocketWrapper;
 134
 135 my $opt_help = 0;
 136 my $opt_target = "samba4";
 137 my $opt_quick = 0;
 138 my $opt_socket_wrapper = 0;
 139 my $opt_socket_wrapper_pcap = undef;
 140 my $opt_socket_wrapper_keep_pcap = undef;
 141 my $opt_one = 0;
 142 my $opt_immediate = 0;
 143 my $opt_expected_failures = undef;
 144 my @opt_exclude = ();
 145 my @opt_include = ();
 146 my $opt_verbose = 0;
 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_format = "plain";
 154 my @testlists = ();
 155
 156 my $srcdir = ".";
 157 my $builddir = ".";
 158 my $prefix = "./st";
 159
 160 my @expected_failures = ();
 161 my @includes = ();
 162 my @excludes = ();
 163
 164 my $statistics = {
 165         SUITES_FAIL => 0,
 166
 167         TESTS_UNEXPECTED_OK => 0,
 168         TESTS_EXPECTED_OK => 0,
 169         TESTS_UNEXPECTED_FAIL => 0,
 170         TESTS_EXPECTED_FAIL => 0,
 171         TESTS_ERROR => 0,
 172         TESTS_SKIP => 0,
 173 };
 174
 175 sub find_in_list($$)
 176 {
 177         my ($list, $fullname) = @_;
 178
 179         foreach (@$list) {
 180                 if ($fullname =~ /$$_[0]/) {
 181                          return ($$_[1]) if ($$_[1]);
 182                          return "NO REASON SPECIFIED";
 183                 }
 184         }
 185
 186         return undef;
 187 }
 188
 189 sub expecting_failure($)
 190 {
 191         my ($name) = @_;
 192         return find_in_list(\@expected_failures, $name);
 193 }
 194
 195 sub skip($)
 196 {
 197         my ($name) = @_;
 198
 199         return find_in_list(\@excludes, $name);
 200 }
 201
 202 sub getlog_env($);
 203
 204 sub setup_pcap($)
 205 {
 206         my ($state, $name) = @_;
 207
 208         return unless ($opt_socket_wrapper_pcap);
 209         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 210
 211         my $fname = $name;
 212         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 213
 214         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 215
 216         SocketWrapper::setup_pcap($pcap_file);
 217
 218         return $pcap_file;
 219 }
 220
 221 sub cleanup_pcap($$$)
 222 {
 223         my ($pcap_file, $expected_ret, $ret) = @_;
 224
 225         return unless ($opt_socket_wrapper_pcap);
 226         return if ($opt_socket_wrapper_keep_pcap);
 227         return unless ($expected_ret == $ret);
 228         return unless defined($pcap_file);
 229
 230         unlink($pcap_file);
 231 }
 232
 233 sub run_testsuite($$$$$$)
 234 {
 235         my ($envname, $name, $cmd, $i, $totalsuites, $msg_ops) = @_;
 236         my $pcap_file = setup_pcap($name);
 237
 238         $msg_ops->start_test([], $name);
 239
 240         open(RESULT, "$cmd 2>&1|");
 241         my $expected_ret = parse_results(
 242                 $msg_ops, $statistics, *RESULT, \&expecting_failure, [$name]);
 243
 244         my $envlog = getlog_env($envname);
 245         $msg_ops->output_msg("ENVLOG: $envlog\n") if ($envlog ne "");
 246
 247         $msg_ops->output_msg("CMD: $cmd\n");
 248
 249         my $ret = close(RESULT);
 250         $ret = 0 unless $ret == 1;
 251
 252         if ($ret == 1) {
 253                 $msg_ops->end_test([], $name, "success", $expected_ret != $ret, undef);
 254         } else {
 255                 $msg_ops->end_test([], $name, "failure", $expected_ret != $ret,
 256                                                "Returned $ret");
 257         }
 258
 259         cleanup_pcap($pcap_file, $expected_ret, $ret);
 260
 261         if (not $opt_socket_wrapper_keep_pcap and
 262                 defined($pcap_file)) {
 263                 $msg_ops->output_msg("PCAP FILE: $pcap_file\n");
 264         }
 265
 266         if ($ret != $expected_ret) {
 267                 $statistics->{SUITES_FAIL}++;
 268                 exit(1) if ($opt_one);
 269         }
 270
 271         return ($ret == $expected_ret);
 272 }
 273
 274 sub ShowHelp()
 275 {
 276         print "Samba test runner
 277 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 278
 279 Usage: $Script [OPTIONS] PREFIX
 280
 281 Generic options:
 282  --help                     this help page
 283  --target=samba4|samba3|win Samba version to target
 284  --testlist=FILE                        file to read available tests from
 285
 286 Paths:
 287  --prefix=DIR               prefix to run tests in [st]
 288  --srcdir=DIR               source directory [.]
 289  --builddir=DIR             output directory [.]
 290
 291 Target Specific:
 292  --socket-wrapper-pcap          save traffic to pcap directories
 293  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 294                             failed
 295  --socket-wrapper           enable socket wrapper
 296  --expected-failures=FILE   specify list of tests that is guaranteed to fail
 297
 298 Samba4 Specific:
 299  --ldap=openldap|fedora-ds     back smbd onto specified ldap server
 300
 301 Samba3 Specific:
 302  --bindir=PATH              path to binaries
 303
 304 Behaviour:
 305  --quick                    run quick overall test
 306  --one                      abort when the first test fails
 307  --immediate                print test output for failed tests during run
 308  --verbose                  be verbose
 309  --analyse-cmd CMD          command to run after each test
 310 ";
 311         exit(0);
 312 }
 313
 314 my $result = GetOptions (
 315                 'help|h|?' => \$opt_help,
 316                 'target=s' => \$opt_target,
 317                 'prefix=s' => \$prefix,
 318                 'socket-wrapper' => \$opt_socket_wrapper,
 319                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 320                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 321                 'quick' => \$opt_quick,
 322                 'one' => \$opt_one,
 323                 'immediate' => \$opt_immediate,
 324                 'expected-failures=s' => \$opt_expected_failures,
 325                 'exclude=s' => \@opt_exclude,
 326                 'include=s' => \@opt_include,
 327                 'srcdir=s' => \$srcdir,
 328                 'builddir=s' => \$builddir,
 329                 'verbose' => \$opt_verbose,
 330                 'testenv' => \$opt_testenv,
 331                 'ldap:s' => \$ldap,
 332                 'analyse-cmd=s' => \$opt_analyse_cmd,
 333                 'no-lazy-setup' => \$opt_no_lazy_setup,
 334                 'resetup-environment' => \$opt_resetup_env,
 335                 'bindir:s' => \$opt_bindir,
 336                 'format=s' => \$opt_format,
 337                 'testlist=s' => \@testlists
 338             );
 339
 340 exit(1) if (not $result);
 341
 342 ShowHelp() if ($opt_help);
 343
 344 my $tests = shift;
 345
 346 # quick hack to disable rpc validation when using valgrind - its way too slow
 347 unless (defined($ENV{VALGRIND})) {
 348         $ENV{VALIDATE} = "validate";
 349         $ENV{MALLOC_CHECK_} = 2;
 350 }
 351
 352 my $old_pwd = "$RealBin/..";
 353
 354 # Backwards compatibility:
 355 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 356         if (defined($ENV{FEDORA_DS_ROOT})) {
 357                 $ldap = "fedora-ds";
 358         } else {
 359                 $ldap = "openldap";
 360         }
 361 }
 362
 363 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 364 if ($ldap) {
 365         # LDAP is slow
 366         $torture_maxtime *= 2;
 367 }
 368
 369 $prefix =~ s+//+/+;
 370 $prefix =~ s+/./+/+;
 371 $prefix =~ s+/$++;
 372
 373 die("using an empty prefix isn't allowed") unless $prefix ne "";
 374
 375 #Ensure we have the test prefix around
 376 mkdir($prefix, 0777) unless -d $prefix;
 377
 378 my $prefix_abs = abs_path($prefix);
 379 my $srcdir_abs = abs_path($srcdir);
 380
 381 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 382 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 383
 384 $ENV{PREFIX} = $prefix;
 385 $ENV{PREFIX_ABS} = $prefix_abs;
 386 $ENV{SRCDIR} = $srcdir;
 387 $ENV{SRCDIR_ABS} = $srcdir_abs;
 388
 389 if (defined($ENV{RUN_FROM_BUILD_FARM}) and
 390         ($ENV{RUN_FROM_BUILD_FARM} eq "yes")) {
 391         $opt_format = "buildfarm";
 392 }
 393
 394 my $tls_enabled = not $opt_quick;
 395 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 396 $ENV{LDB_MODULES_PATH} = "$old_pwd/bin/modules/ldb";
 397 $ENV{LD_SAMBA_MODULE_PATH} = "$old_pwd/bin/modules";
 398 if (defined($ENV{PKG_CONFIG_PATH})) {
 399         $ENV{PKG_CONFIG_PATH} = "$old_pwd/bin/pkgconfig:$ENV{PKG_CONFIG_PATH}";
 400 } else {
 401         $ENV{PKG_CONFIG_PATH} = "$old_pwd/bin/pkgconfig";
 402 }
 403 # Required for smbscript:
 404 $ENV{PATH} = "$old_pwd/bin:$old_pwd:$ENV{PATH}";
 405
 406 if ($opt_socket_wrapper_keep_pcap) {
 407         # Socket wrapper keep pcap implies socket wrapper pcap
 408         $opt_socket_wrapper_pcap = 1;
 409 }
 410
 411 if ($opt_socket_wrapper_pcap) {
 412         # Socket wrapper pcap implies socket wrapper
 413         $opt_socket_wrapper = 1;
 414 }
 415
 416 my $socket_wrapper_dir;
 417 if ($opt_socket_wrapper) {
 418         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
 419         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 420 } else {
 421         warn("Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports") unless $< == 0;
 422 }
 423
 424 my $target;
 425 my $testenv_default = "none";
 426
 427 if ($opt_target eq "samba4") {
 428         $testenv_default = "member";
 429         use target::Samba4;
 430         $target = new Samba4($opt_bindir or "$srcdir/bin", $ldap, "$srcdir/setup");
 431 } elsif ($opt_target eq "samba3") {
 432         if ($opt_socket_wrapper and `$opt_bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 433                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 434         }
 435         $testenv_default = "dc";
 436         use target::Samba3;
 437         $target = new Samba3($opt_bindir);
 438 } elsif ($opt_target eq "win") {
 439         die("Windows tests will not run with socket wrapper enabled.")
 440                 if ($opt_socket_wrapper);
 441         $testenv_default = "dc";
 442         use target::Windows;
 443         $target = new Windows();
 444 }
 445
 446 sub read_test_regexes($)
 447 {
 448         my ($name) = @_;
 449         my @ret = ();
 450         open(LF, "<$name") or die("unable to read $name: $!");
 451         while (<LF>) {
 452                 chomp;
 453                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 454                         push (@ret, [$1, $4]);
 455                 } else {
 456                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 457                         push (@ret, [$_, undef]);
 458                 }
 459         }
 460         close(LF);
 461         return @ret;
 462 }
 463
 464 if (defined($opt_expected_failures)) {
 465         @expected_failures = read_test_regexes($opt_expected_failures);
 466 }
 467
 468 foreach (@opt_exclude) {
 469         push (@excludes, read_test_regexes($_));
 470 }
 471
 472 if ($opt_quick) {
 473         push (@includes, read_test_regexes("samba4-quick"));
 474 }
 475
 476 foreach (@opt_include) {
 477         push (@includes, read_test_regexes($_));
 478 }
 479
 480 my $interfaces = join(',', ("127.0.0.6/8",
 481                             "127.0.0.7/8",
 482                             "127.0.0.8/8",
 483                             "127.0.0.9/8",
 484                             "127.0.0.10/8",
 485                             "127.0.0.11/8"));
 486
 487 my $conffile = "$prefix_abs/client/client.conf";
 488
 489 sub write_clientconf($$)
 490 {
 491         my ($conffile, $vars) = @_;
 492
 493         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 494
 495         if ( -d "$prefix/client/private" ) {
 496                 unlink <$prefix/client/private/*>;
 497         } else {
 498                 mkdir("$prefix/client/private", 0777);
 499         }
 500
 501         open(CF, ">$conffile");
 502         print CF "[global]\n";
 503         if (defined($ENV{VALGRIND})) {
 504                 print CF "\ticonv:native = true\n";
 505         } else {
 506                 print CF "\ticonv:native = false\n";
 507         }
 508         print CF "\tnetbios name = client\n";
 509         if (defined($vars->{DOMAIN})) {
 510                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 511         }
 512         if (defined($vars->{REALM})) {
 513                 print CF "\trealm = $vars->{REALM}\n";
 514         }
 515         if (defined($vars->{NCALRPCDIR})) {
 516                 print CF "\tncalrpc dir = $vars->{NCALRPCDIR}\n";
 517         }
 518         if (defined($vars->{PIDDIR})) {
 519                 print CF "\tpid directory = $vars->{PIDDIR}\n";
 520         }
 521         if (defined($vars->{WINBINDD_SOCKET_DIR})) {
 522                 print CF "\twinbindd socket directory = $vars->{WINBINDD_SOCKET_DIR}\n";
 523         }
 524         print CF "
 525         private dir = $prefix_abs/client/private
 526         js include = $srcdir_abs/scripting/libjs
 527         name resolve order = bcast
 528         interfaces = $interfaces
 529         panic action = $srcdir_abs/script/gdb_backtrace \%PID\% \%PROG\%
 530         max xmit = 32K
 531         notify:inotify = false
 532         ldb:nosync = true
 533         system:anonymous = true
 534         torture:basedir = $prefix_abs/client
 535 #We don't want to pass our self-tests if the PAC code is wrong
 536         gensec:require_pac = true
 537         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 538 ";
 539         close(CF);
 540 }
 541
 542 my @torture_options = ();
 543 push (@torture_options, "--configfile=$conffile");
 544 # ensure any one smbtorture call doesn't run too long
 545 push (@torture_options, "--maximum-runtime=$torture_maxtime");
 546 push (@torture_options, "--target=$opt_target");
 547 push (@torture_options, "--basedir=$prefix_abs");
 548 push (@torture_options, "--option=torture:progress=no") if ($opt_format eq "buildfarm");
 549 push (@torture_options, "--format=subunit");
 550 push (@torture_options, "--option=torture:quick=yes") if ($opt_quick);
 551
 552 $ENV{TORTURE_OPTIONS} = join(' ', @torture_options);
 553 print "OPTIONS $ENV{TORTURE_OPTIONS}\n";
 554
 555 my @todo = ();
 556
 557 my $testsdir = "$srcdir/selftest";
 558 $ENV{SMB_CONF_PATH} = "$conffile";
 559 $ENV{CONFIGURATION} = "--configfile=$conffile";
 560
 561 my %required_envs = ();
 562
 563 sub read_testlist($)
 564 {
 565         my ($filename) = @_;
 566
 567         my @ret = ();
 568         open(IN, $filename) or die("Unable to open $filename: $!");
 569
 570         while (<IN>) {
 571                 if ($_ eq "-- TEST --\n") {
 572                         my $name = <IN>;
 573                         $name =~ s/\n//g;
 574                         my $env = <IN>;
 575                         $env =~ s/\n//g;
 576                         my $cmdline = <IN>;
 577                         $cmdline =~ s/\n//g;
 578                         if (not defined($tests) or $name =~ /$tests/) {
 579                                 $required_envs{$env} = 1;
 580                                 push (@ret, [$name, $env, $cmdline]);
 581                         }
 582                 } else {
 583                         print;
 584                 }
 585         }
 586         close(IN) or die("Error creating recipe");
 587         return @ret;
 588 }
 589
 590 if ($#testlists == -1) {
 591         die("No testlists specified");
 592 }
 593
 594 my @available = ();
 595 foreach my $fn (@testlists) {
 596         foreach (read_testlist($fn)) {
 597                 my $name = $$_[0];
 598                 next if (@includes and not find_in_list(\@includes, $name));
 599                 push (@available, $_);
 600         }
 601 }
 602
 603 my $msg_ops;
 604 if ($opt_format eq "buildfarm") {
 605         require output::buildfarm;
 606         $msg_ops = new output::buildfarm($statistics);
 607 } elsif ($opt_format eq "plain") {
 608         require output::plain;
 609         $msg_ops = new output::plain("$prefix/summary", $opt_verbose, $opt_immediate, $statistics, $#available+1);
 610 } elsif ($opt_format eq "html") {
 611         require output::html;
 612         mkdir("test-results", 0777);
 613         $msg_ops = new output::html("test-results", $statistics);
 614 } else {
 615         die("Invalid output format '$opt_format'");
 616 }
 617
 618
 619 foreach (@available) {
 620         my $name = $$_[0];
 621         my $skipreason = skip($name);
 622         if ($skipreason) {
 623                 $msg_ops->skip_testsuite($name, $skipreason);
 624         } else {
 625                 push(@todo, $_);
 626         }
 627 }
 628
 629 if ($#todo == -1) {
 630         print STDERR "No tests to run\n";
 631         exit(1);
 632         }
 633
 634 my $suitestotal = $#todo + 1;
 635 my $i = 0;
 636 $| = 1;
 637
 638 my %running_envs = ();
 639
 640 my @exported_envvars = (
 641         # domain stuff
 642         "DOMAIN",
 643         "REALM",
 644
 645         # domain controller stuff
 646         "DC_SERVER",
 647         "DC_SERVER_IP",
 648         "DC_NETBIOSNAME",
 649         "DC_NETBIOSALIAS",
 650
 651         # server stuff
 652         "SERVER",
 653         "SERVER_IP",
 654         "NETBIOSNAME",
 655         "NETBIOSALIAS",
 656
 657         # user stuff
 658         "USERNAME",
 659         "PASSWORD",
 660         "DC_USERNAME",
 661         "DC_PASSWORD",
 662
 663         # misc stuff
 664         "KRB5_CONFIG",
 665         "WINBINDD_SOCKET_DIR",
 666         "WINBINDD_PRIV_PIPE_DIR"
 667 );
 668
 669 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 670         my $signame = shift;
 671         teardown_env($_) foreach(keys %running_envs);
 672         die("Received signal $signame");
 673 };
 674
 675 sub setup_env($)
 676 {
 677         my ($envname) = @_;
 678
 679         my $testenv_vars;
 680         if ($envname eq "none") {
 681                 $testenv_vars = {};
 682         } elsif (defined($running_envs{$envname})) {
 683                 $testenv_vars = $running_envs{$envname};
 684                 if (not $target->check_env($testenv_vars)) {
 685                         $testenv_vars = undef;
 686                 }
 687         } else {
 688                 $testenv_vars = $target->setup_env($envname, $prefix);
 689         }
 690
 691         return undef unless defined($testenv_vars);
 692
 693         $running_envs{$envname} = $testenv_vars;
 694
 695         SocketWrapper::set_default_iface(6);
 696         write_clientconf($conffile, $testenv_vars);
 697
 698         foreach (@exported_envvars) {
 699                 if (defined($testenv_vars->{$_})) {
 700                         $ENV{$_} = $testenv_vars->{$_};
 701                 } else {
 702                         delete $ENV{$_};
 703                 }
 704         }
 705
 706         return $testenv_vars;
 707 }
 708
 709 sub exported_envvars_str($)
 710 {
 711         my ($testenv_vars) = @_;
 712         my $out = "";
 713
 714         foreach (@exported_envvars) {
 715                 next unless defined($testenv_vars->{$_});
 716                 $out .= $_."=".$testenv_vars->{$_}."\n";
 717         }
 718
 719         return $out;
 720 }
 721
 722 sub getlog_env($)
 723 {
 724         my ($envname) = @_;
 725         return "" if ($envname eq "none");
 726         return $target->getlog_env($running_envs{$envname});
 727 }
 728
 729 sub check_env($)
 730 {
 731         my ($envname) = @_;
 732         return 1 if ($envname eq "none");
 733         return $target->check_env($running_envs{$envname});
 734 }
 735
 736 sub teardown_env($)
 737 {
 738         my ($envname) = @_;
 739         return if ($envname eq "none");
 740         $target->teardown_env($running_envs{$envname});
 741         delete $running_envs{$envname};
 742 }
 743
 744 if ($opt_no_lazy_setup) {
 745         setup_env($_) foreach (keys %required_envs);
 746 }
 747
 748 if ($opt_testenv) {
 749         my $testenv_name = $ENV{SELFTEST_TESTENV};
 750         $testenv_name = $testenv_default unless defined($testenv_name);
 751
 752         my $testenv_vars = setup_env($testenv_name);
 753
 754         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 755
 756         my $envvarstr = exported_envvars_str($testenv_vars);
 757
 758         my $term = ($ENV{TERM} or "xterm");
 759         system("$term -e 'echo -e \"
 760 Welcome to the Samba4 Test environment '$testenv_name'
 761
 762 This matches the client environment used in make test
 763 smbd is pid `cat \$PIDDIR/smbd.pid`
 764
 765 Some useful environment variables:
 766 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 767 CONFIGURATION=\$CONFIGURATION
 768
 769 $envvarstr
 770 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 771         teardown_env($testenv_name);
 772 } else {
 773         foreach (@todo) {
 774                 $i++;
 775                 my $cmd = $$_[2];
 776                 $cmd =~ s/([\(\)])/\\$1/g;
 777                 my $name = $$_[0];
 778                 my $envname = $$_[1];
 779
 780                 my $envvars = setup_env($envname);
 781                 if (not defined($envvars)) {
 782                         $msg_ops->skip_testsuite($name, "unable to set up environment $envname");
 783                         next;
 784                 }
 785
 786                 run_testsuite($envname, $name, $cmd, $i, $suitestotal,
 787                               $msg_ops);
 788
 789                 if (defined($opt_analyse_cmd)) {
 790                         system("$opt_analyse_cmd \"$name\"");
 791                 }
 792
 793                 teardown_env($envname) if ($opt_resetup_env);
 794         }
 795 }
 796
 797 print "\n";
 798
 799 teardown_env($_) foreach (keys %running_envs);
 800
 801 $target->stop();
 802
 803 $msg_ops->summary();
 804
 805 my $failed = 0;
 806
 807 # if there were any valgrind failures, show them
 808 foreach (<$prefix/valgrind.log*>) {
 809         next unless (-s $_);
 810         system("grep DWARF2.CFI.reader $_ > /dev/null");
 811         if ($? >> 8 == 0) {
 812             print "VALGRIND FAILURE\n";
 813             $failed++;
 814             system("cat $_");
 815         }
 816 }
 817
 818 if ($opt_format eq "buildfarm") {
 819         print "TEST STATUS: $statistics->{SUITES_FAIL}\n";
 820 }
 821
 822 exit $statistics->{SUITES_FAIL};