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 @testlists = ();
 154
 155 my $srcdir = ".";
 156 my $builddir = ".";
 157 my $exeext = "";
 158 my $prefix = "./st";
 159
 160 my @includes = ();
 161 my @excludes = ();
 162
 163 sub find_in_list($$)
 164 {
 165         my ($list, $fullname) = @_;
 166
 167         foreach (@$list) {
 168                 if ($fullname =~ /$$_[0]/) {
 169                          return ($$_[1]) if ($$_[1]);
 170                          return "";
 171                 }
 172         }
 173
 174         return undef;
 175 }
 176
 177 sub skip($)
 178 {
 179         my ($name) = @_;
 180
 181         return find_in_list(\@excludes, $name);
 182 }
 183
 184 sub getlog_env($);
 185
 186 sub setup_pcap($)
 187 {
 188         my ($name) = @_;
 189
 190         return unless ($opt_socket_wrapper_pcap);
 191         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
 192
 193         my $fname = $name;
 194         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
 195
 196         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
 197
 198         SocketWrapper::setup_pcap($pcap_file);
 199
 200         return $pcap_file;
 201 }
 202
 203 sub cleanup_pcap($$)
 204 {
 205         my ($pcap_file, $exitcode) = @_;
 206
 207         return unless ($opt_socket_wrapper_pcap);
 208         return if ($opt_socket_wrapper_keep_pcap);
 209         return unless ($exitcode == 0);
 210         return unless defined($pcap_file);
 211
 212         unlink($pcap_file);
 213 }
 214
 215 sub run_testsuite($$$$$)
 216 {
 217         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
 218         my $pcap_file = setup_pcap($name);
 219
 220         Subunit::report_time(time());
 221         Subunit::start_testsuite($name);
 222
 223         open(RESULTS, "$cmd 2>&1|");
 224         my $statistics = {
 225                 SUITES_FAIL => 0,
 226
 227                 TESTS_UNEXPECTED_OK => 0,
 228                 TESTS_EXPECTED_OK => 0,
 229                 TESTS_UNEXPECTED_FAIL => 0,
 230                 TESTS_EXPECTED_FAIL => 0,
 231                 TESTS_ERROR => 0,
 232                 TESTS_SKIP => 0,
 233         };
 234
 235         my $msg_ops = new Subunit::Filter("$name\.", []);
 236
 237         parse_results($msg_ops, $statistics, *RESULTS);
 238
 239         my $ret = 0;
 240
 241         unless (close(RESULTS)) {
 242                 if ($!) {
 243                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
 244                         return 0;
 245                 } else {
 246                         $ret = $?;
 247                 }
 248         }
 249
 250         if ($ret & 127) {
 251                 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
 252                 return 0;
 253         }
 254         my $envlog = getlog_env($envname);
 255         if ($envlog ne "") {
 256                 print "envlog: $envlog\n";
 257         }
 258
 259         print "command: $cmd\n";
 260
 261         my $exitcode = $ret >> 8;
 262
 263         Subunit::report_time(time());
 264         if ($exitcode == 0) {
 265                 Subunit::end_testsuite($name, "success");
 266         } else {
 267                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
 268         }
 269
 270         cleanup_pcap($pcap_file, $exitcode);
 271
 272         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
 273                 print "PCAP FILE: $pcap_file\n";
 274         }
 275
 276         if ($exitcode != 0) {
 277                 exit(1) if ($opt_one);
 278         }
 279
 280         return $exitcode;
 281 }
 282
 283 sub ShowHelp()
 284 {
 285         print "Samba test runner
 286 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 287 Copyright (C) Stefan Metzmacher <metze\@samba.org>
 288
 289 Usage: $Script [OPTIONS] TESTNAME-REGEX
 290
 291 Generic options:
 292  --help                     this help page
 293  --target=samba[34]|win|kvm Samba version to target
 294  --testlist=FILE            file to read available tests from
 295
 296 Paths:
 297  --prefix=DIR               prefix to run tests in [st]
 298  --srcdir=DIR               source directory [.]
 299  --builddir=DIR             output directory [.]
 300  --exeext=EXT               executable extention []
 301
 302 Target Specific:
 303  --socket-wrapper-pcap      save traffic to pcap directories
 304  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that
 305                             failed
 306  --socket-wrapper           enable socket wrapper
 307  --bindir=PATH              path to target binaries
 308
 309 Samba4 Specific:
 310  --ldap=openldap|fedora-ds  back samba onto specified ldap server
 311
 312 Kvm Specific:
 313  --image=PATH               path to KVM image
 314
 315 Behaviour:
 316  --quick                    run quick overall test
 317  --one                      abort when the first test fails
 318  --verbose                  be verbose
 319  --analyse-cmd CMD          command to run after each test
 320 ";
 321         exit(0);
 322 }
 323
 324 my $result = GetOptions (
 325                 'help|h|?' => \$opt_help,
 326                 'target=s' => \$opt_target,
 327                 'prefix=s' => \$prefix,
 328                 'socket-wrapper' => \$opt_socket_wrapper,
 329                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
 330                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
 331                 'quick' => \$opt_quick,
 332                 'one' => \$opt_one,
 333                 'exclude=s' => \@opt_exclude,
 334                 'include=s' => \@opt_include,
 335                 'srcdir=s' => \$srcdir,
 336                 'builddir=s' => \$builddir,
 337                 'exeext=s' => \$exeext,
 338                 'verbose' => \$opt_verbose,
 339                 'testenv' => \$opt_testenv,
 340                 'ldap:s' => \$ldap,
 341                 'analyse-cmd=s' => \$opt_analyse_cmd,
 342                 'no-lazy-setup' => \$opt_no_lazy_setup,
 343                 'resetup-environment' => \$opt_resetup_env,
 344                 'bindir:s' => \$opt_bindir,
 345                 'image=s' => \$opt_image,
 346                 'testlist=s' => \@testlists
 347             );
 348
 349 exit(1) if (not $result);
 350
 351 ShowHelp() if ($opt_help);
 352
 353 my $tests = shift;
 354
 355 # quick hack to disable rpc validation when using valgrind - its way too slow
 356 unless (defined($ENV{VALGRIND})) {
 357         $ENV{VALIDATE} = "validate";
 358         $ENV{MALLOC_CHECK_} = 2;
 359 }
 360
 361 my $bindir = ($opt_bindir or "$builddir/bin");
 362 my $bindir_abs = abs_path($bindir);
 363
 364 # Backwards compatibility:
 365 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
 366         if (defined($ENV{FEDORA_DS_ROOT})) {
 367                 $ldap = "fedora-ds";
 368         } else {
 369                 $ldap = "openldap";
 370         }
 371 }
 372
 373 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 374 if ($ldap) {
 375         # LDAP is slow
 376         $torture_maxtime *= 2;
 377 }
 378
 379 $prefix =~ s+//+/+;
 380 $prefix =~ s+/./+/+;
 381 $prefix =~ s+/$++;
 382
 383 die("using an empty prefix isn't allowed") unless $prefix ne "";
 384
 385 #Ensure we have the test prefix around
 386 mkdir($prefix, 0777) unless -d $prefix;
 387
 388 my $prefix_abs = abs_path($prefix);
 389 my $srcdir_abs = abs_path($srcdir);
 390 my $builddir_abs = abs_path($builddir);
 391
 392 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
 393 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
 394
 395 $ENV{PREFIX} = $prefix;
 396 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
 397 $ENV{PREFIX_ABS} = $prefix_abs;
 398 $ENV{SRCDIR} = $srcdir;
 399 $ENV{SRCDIR_ABS} = $srcdir_abs;
 400 $ENV{BUILDDIR} = $builddir;
 401 $ENV{BUILDDIR_ABS} = $builddir_abs;
 402 $ENV{EXEEXT} = $exeext;
 403
 404 my $tls_enabled = not $opt_quick;
 405 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 406 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
 407 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
 408 sub prefix_pathvar($$)
 409 {
 410         my ($name, $newpath) = @_;
 411         if (defined($ENV{$name})) {
 412                 $ENV{$name} = "$newpath:$ENV{$name}";
 413         } else {
 414                 $ENV{$name} = $newpath;
 415         }
 416 }
 417 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
 418 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
 419
 420 if ($opt_socket_wrapper_keep_pcap) {
 421         # Socket wrapper keep pcap implies socket wrapper pcap
 422         $opt_socket_wrapper_pcap = 1;
 423 }
 424
 425 if ($opt_socket_wrapper_pcap) {
 426         # Socket wrapper pcap implies socket wrapper
 427         $opt_socket_wrapper = 1;
 428 }
 429
 430 my $socket_wrapper_dir;
 431 if ($opt_socket_wrapper) {
 432         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
 433         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 434 } else {
 435          unless ($< == 0) {
 436                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
 437          }
 438 }
 439
 440 my $target;
 441 my $testenv_default = "none";
 442
 443 if ($opt_target eq "samba4") {
 444         $testenv_default = "member";
 445         require target::Samba4;
 446         $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
 447 } elsif ($opt_target eq "samba3") {
 448         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
 449                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
 450         }
 451         $testenv_default = "member";
 452         require target::Samba3;
 453         $target = new Samba3($bindir);
 454 } elsif ($opt_target eq "win") {
 455         die("Windows tests will not run with socket wrapper enabled.")
 456                 if ($opt_socket_wrapper);
 457         $testenv_default = "dc";
 458         require target::Windows;
 459         $target = new Windows();
 460 } elsif ($opt_target eq "kvm") {
 461         die("Kvm tests will not run with socket wrapper enabled.")
 462                 if ($opt_socket_wrapper);
 463         require target::Kvm;
 464         die("No image specified") unless ($opt_image);
 465         $target = new Kvm($opt_image, undef);
 466 }
 467
 468 #
 469 # Start a Virtual Distributed Ethernet Switch
 470 # Returns the pid of the switch.
 471 #
 472 sub start_vde_switch($)
 473 {
 474         my ($path) = @_;
 475
 476         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
 477
 478         open(PID, "$path/vde.pid");
 479         <PID> =~ /([0-9]+)/;
 480         my $pid = $1;
 481         close(PID);
 482
 483         return $pid;
 484 }
 485
 486 # Stop a Virtual Distributed Ethernet Switch
 487 sub stop_vde_switch($)
 488 {
 489         my ($pid) = @_;
 490         kill 9, $pid;
 491 }
 492
 493 sub read_test_regexes($)
 494 {
 495         my ($name) = @_;
 496         my @ret = ();
 497         open(LF, "<$name") or die("unable to read $name: $!");
 498         while (<LF>) {
 499                 chomp;
 500                 next if (/^#/);
 501                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
 502                         push (@ret, [$1, $4]);
 503                 } else {
 504                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
 505                         push (@ret, [$_, undef]);
 506                 }
 507         }
 508         close(LF);
 509         return @ret;
 510 }
 511
 512 foreach (@opt_exclude) {
 513         push (@excludes, read_test_regexes($_));
 514 }
 515
 516 foreach (@opt_include) {
 517         push (@includes, read_test_regexes($_));
 518 }
 519
 520 my $interfaces = join(',', ("127.0.0.6/8",
 521                             "127.0.0.7/8",
 522                             "127.0.0.8/8",
 523                             "127.0.0.9/8",
 524                             "127.0.0.10/8",
 525                             "127.0.0.11/8"));
 526
 527 my $conffile = "$prefix_abs/client/client.conf";
 528 $ENV{SMB_CONF_PATH} = $conffile;
 529
 530 sub write_clientconf($$)
 531 {
 532         my ($conffile, $vars) = @_;
 533
 534         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
 535
 536         if ( -d "$prefix/client/private" ) {
 537                 unlink <$prefix/client/private/*>;
 538         } else {
 539                 mkdir("$prefix/client/private", 0777);
 540         }
 541
 542         if ( -d "$prefix/client/lock" ) {
 543                 unlink <$prefix/client/lockdir/*>;
 544         } else {
 545                 mkdir("$prefix/client/lockdir", 0777);
 546         }
 547
 548         open(CF, ">$conffile");
 549         print CF "[global]\n";
 550         if (defined($ENV{VALGRIND})) {
 551                 print CF "\ticonv:native = true\n";
 552         } else {
 553                 print CF "\ticonv:native = false\n";
 554         }
 555         print CF "\tnetbios name = client\n";
 556         if (defined($vars->{DOMAIN})) {
 557                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 558         }
 559         if (defined($vars->{REALM})) {
 560                 print CF "\trealm = $vars->{REALM}\n";
 561         }
 562         if ($opt_socket_wrapper) {
 563                 print CF "\tinterfaces = $interfaces\n";
 564         }
 565         print CF "
 566         private dir = $prefix_abs/client/private
 567         lock dir = $prefix_abs/client/lockdir
 568         name resolve order = bcast
 569         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
 570         max xmit = 32K
 571         notify:inotify = false
 572         ldb:nosync = true
 573         system:anonymous = true
 574         client lanman auth = Yes
 575         torture:basedir = $prefix_abs/client
 576 #We don't want to pass our self-tests if the PAC code is wrong
 577         gensec:require_pac = true
 578         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
 579 ";
 580         close(CF);
 581 }
 582
 583 my @todo = ();
 584
 585 my $testsdir = "$srcdir/selftest";
 586
 587 my %required_envs = ();
 588
 589 sub read_testlist($)
 590 {
 591         my ($filename) = @_;
 592
 593         my @ret = ();
 594         open(IN, $filename) or die("Unable to open $filename: $!");
 595
 596         while (<IN>) {
 597                 if ($_ eq "-- TEST --\n") {
 598                         my $name = <IN>;
 599                         $name =~ s/\n//g;
 600                         my $env = <IN>;
 601                         $env =~ s/\n//g;
 602                         my $cmdline = <IN>;
 603                         $cmdline =~ s/\n//g;
 604                         if (not defined($tests) or $name =~ /$tests/) {
 605                                 $required_envs{$env} = 1;
 606                                 push (@ret, [$name, $env, $cmdline]);
 607                         }
 608                 } else {
 609                         print;
 610                 }
 611         }
 612         close(IN) or die("Error creating recipe");
 613         return @ret;
 614 }
 615
 616 if ($#testlists == -1) {
 617         die("No testlists specified");
 618 }
 619
 620 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
 621 if ($opt_socket_wrapper) {
 622         $ENV{SELFTEST_INTERFACES} = $interfaces;
 623 } else {
 624         $ENV{SELFTEST_INTERFACES} = "";
 625 }
 626 if ($opt_verbose) {
 627         $ENV{SELFTEST_VERBOSE} = "1";
 628 } else {
 629         $ENV{SELFTEST_VERBOSE} = "";
 630 }
 631 if ($opt_quick) {
 632         $ENV{SELFTEST_QUICK} = "1";
 633 } else {
 634         $ENV{SELFTEST_QUICK} = "";
 635 }
 636 $ENV{SELFTEST_TARGET} = $opt_target;
 637 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
 638
 639 my @available = ();
 640 foreach my $fn (@testlists) {
 641         foreach (read_testlist($fn)) {
 642                 my $name = $$_[0];
 643                 next if (@includes and not defined(find_in_list(\@includes, $name)));
 644                 push (@available, $_);
 645         }
 646 }
 647
 648 Subunit::testsuite_count($#available+1);
 649 Subunit::report_time(time());
 650
 651 foreach (@available) {
 652         my $name = $$_[0];
 653         my $skipreason = skip($name);
 654         if (defined($skipreason)) {
 655                 Subunit::skip_testsuite($name, $skipreason);
 656         } else {
 657                 push(@todo, $_);
 658         }
 659 }
 660
 661 if ($#todo == -1) {
 662         print STDERR "No tests to run\n";
 663         exit(1);
 664         }
 665
 666 my $suitestotal = $#todo + 1;
 667 my $i = 0;
 668 $| = 1;
 669
 670 my %running_envs = ();
 671
 672 sub get_running_env($)
 673 {
 674         my ($name) = @_;
 675
 676         my $envname = $name;
 677
 678         $envname =~ s/:.*//;
 679
 680         return $running_envs{$envname};
 681 }
 682
 683 my @exported_envvars = (
 684         # domain stuff
 685         "DOMAIN",
 686         "REALM",
 687
 688         # domain controller stuff
 689         "DC_SERVER",
 690         "DC_SERVER_IP",
 691         "DC_NETBIOSNAME",
 692         "DC_NETBIOSALIAS",
 693
 694         # server stuff
 695         "SERVER",
 696         "SERVER_IP",
 697         "NETBIOSNAME",
 698         "NETBIOSALIAS",
 699
 700         # user stuff
 701         "USERNAME",
 702         "PASSWORD",
 703         "DC_USERNAME",
 704         "DC_PASSWORD",
 705
 706         # misc stuff
 707         "KRB5_CONFIG",
 708         "WINBINDD_SOCKET_DIR",
 709         "WINBINDD_PRIV_PIPE_DIR"
 710 );
 711
 712 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
 713         my $signame = shift;
 714         teardown_env($_) foreach(keys %running_envs);
 715         die("Received signal $signame");
 716 };
 717
 718 sub setup_env($)
 719 {
 720         my ($name) = @_;
 721
 722         my $testenv_vars = undef;
 723
 724         my $envname = $name;
 725         my $option = $name;
 726
 727         $envname =~ s/:.*//;
 728         $option =~ s/^[^:]*//;
 729         $option =~ s/^://;
 730
 731         $option = "client" if $option eq "";
 732
 733         if ($envname eq "none") {
 734                 $testenv_vars = {};
 735         } elsif (defined(get_running_env($envname))) {
 736                 $testenv_vars = get_running_env($envname);
 737                 if (not $target->check_env($testenv_vars)) {
 738                         $testenv_vars = undef;
 739                 }
 740         } else {
 741                 $testenv_vars = $target->setup_env($envname, $prefix);
 742         }
 743
 744         return undef unless defined($testenv_vars);
 745
 746         $running_envs{$envname} = $testenv_vars;
 747
 748         if ($option eq "local") {
 749                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
 750                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
 751         } elsif ($option eq "client") {
 752                 SocketWrapper::set_default_iface(6);
 753                 write_clientconf($conffile, $testenv_vars);
 754                 $ENV{SMB_CONF_PATH} = $conffile;
 755         } else {
 756                 die("Unknown option[$option] for envname[$envname]");
 757         }
 758
 759         foreach (@exported_envvars) {
 760                 if (defined($testenv_vars->{$_})) {
 761                         $ENV{$_} = $testenv_vars->{$_};
 762                 } else {
 763                         delete $ENV{$_};
 764                 }
 765         }
 766
 767         return $testenv_vars;
 768 }
 769
 770 sub exported_envvars_str($)
 771 {
 772         my ($testenv_vars) = @_;
 773         my $out = "";
 774
 775         foreach (@exported_envvars) {
 776                 next unless defined($testenv_vars->{$_});
 777                 $out .= $_."=".$testenv_vars->{$_}."\n";
 778         }
 779
 780         return $out;
 781 }
 782
 783 sub getlog_env($)
 784 {
 785         my ($envname) = @_;
 786         return "" if ($envname eq "none");
 787         return $target->getlog_env(get_running_env($envname));
 788 }
 789
 790 sub check_env($)
 791 {
 792         my ($envname) = @_;
 793         return 1 if ($envname eq "none");
 794         return $target->check_env(get_running_env($envname));
 795 }
 796
 797 sub teardown_env($)
 798 {
 799         my ($envname) = @_;
 800         return if ($envname eq "none");
 801         $target->teardown_env(get_running_env($envname));
 802         delete $running_envs{$envname};
 803 }
 804
 805 if ($opt_no_lazy_setup) {
 806         setup_env($_) foreach (keys %required_envs);
 807 }
 808
 809 if ($opt_testenv) {
 810         my $testenv_name = $ENV{SELFTEST_TESTENV};
 811         $testenv_name = $testenv_default unless defined($testenv_name);
 812
 813         my $testenv_vars = setup_env($testenv_name);
 814
 815         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 816
 817         my $envvarstr = exported_envvars_str($testenv_vars);
 818
 819         my $term = ($ENV{TERM} or "xterm");
 820         system("$term -e 'echo -e \"
 821 Welcome to the Samba4 Test environment '$testenv_name'
 822
 823 This matches the client environment used in make test
 824 server is pid `cat \$PIDDIR/samba.pid`
 825
 826 Some useful environment variables:
 827 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 828 SMB_CONF_PATH=\$SMB_CONF_PATH
 829
 830 $envvarstr
 831 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
 832         teardown_env($testenv_name);
 833 } else {
 834         foreach (@todo) {
 835                 $i++;
 836                 my $cmd = $$_[2];
 837                 $cmd =~ s/([\(\)])/\\$1/g;
 838                 my $name = $$_[0];
 839                 my $envname = $$_[1];
 840
 841                 my $envvars = setup_env($envname);
 842                 if (not defined($envvars)) {
 843                         Subunit::skip_testsuite($name,
 844                                 "unable to set up environment $envname");
 845                         next;
 846                 }
 847
 848                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
 849
 850                 if (defined($opt_analyse_cmd)) {
 851                         system("$opt_analyse_cmd \"$name\"");
 852                 }
 853
 854                 teardown_env($envname) if ($opt_resetup_env);
 855         }
 856 }
 857
 858 print "\n";
 859
 860 teardown_env($_) foreach (keys %running_envs);
 861
 862 $target->stop();
 863
 864 my $failed = 0;
 865
 866 # if there were any valgrind failures, show them
 867 foreach (<$prefix/valgrind.log*>) {
 868         next unless (-s $_);
 869         system("grep DWARF2.CFI.reader $_ > /dev/null");
 870         if ($? >> 8 == 0) {
 871             print "VALGRIND FAILURE\n";
 872             $failed++;
 873             system("cat $_");
 874         }
 875 }
 876 exit 0;