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