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