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