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