Merge branch 'master' of git://git.samba.org/samba
[kai/samba-autobuild/.git] / selftest / selftest.pl
1 #!/usr/bin/perl
2 # Bootstrap Samba and run a number of tests against it.
3 # Copyright (C) 2005-2008 Jelmer Vernooij <jelmer@samba.org>
4 # Published under the GNU GPL, v3 or later.
5
6 =pod
7
8 =head1 NAME
9
10 selftest - Samba test runner
11
12 =head1 SYNOPSIS
13
14 selftest --help
15
16 selftest [--srcdir=DIR] [--builddir=DIR] [--target=samba4|samba3|win|kvm] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--immediate] [--testlist=FILE] [TESTS]
17
18 =head1 DESCRIPTION
19
20 A simple test runner. TESTS is a regular expression with tests to run.
21
22 =head1 OPTIONS
23
24 =over 4
25
26 =item I<--help>
27
28 Show list of available options.
29
30 =item I<--srcdir=DIR>
31
32 Source directory.
33
34 =item I<--builddir=DIR>
35
36 Build directory.
37
38 =item I<--prefix=DIR>
39
40 Change directory to run tests in. Default is 'st'.
41
42 =item I<--immediate>
43
44 Show errors as soon as they happen rather than at the end of the test run.
45                 
46 =item I<--target samba4|samba3|win|kvm>
47
48 Specify test target against which to run. Default is 'samba4'.
49
50 =item I<--quick>
51
52 Run only a limited number of tests. Intended to run in about 30 seconds on 
53 moderately recent systems.
54                 
55 =item I<--socket-wrapper>
56
57 Use socket wrapper library for communication with server. Only works 
58 when the server is running locally.
59
60 Will prevent TCP and UDP ports being opened on the local host but 
61 (transparently) redirects these calls to use unix domain sockets.
62
63 =item I<--expected-failures>
64
65 Specify a file containing a list of tests that are expected to fail. Failures for 
66 these tests will be counted as successes, successes will be counted as failures.
67
68 The format for the file is, one entry per line:
69
70 TESTSUITE-NAME.TEST-NAME
71
72 The reason for a test can also be specified, by adding a hash sign (#) and the reason 
73 after the test name.
74
75 =item I<--exclude>
76
77 Specify a file containing a list of tests that should be skipped. Possible 
78 candidates are tests that segfault the server, flip or don't end. The format of this file is the same as 
79 for the --expected-failures flag.
80
81 =item I<--include>
82
83 Specify a file containing a list of tests that should be run. Same format 
84 as the --exclude flag.
85
86 Not includes specified means all tests will be run.
87
88 =item I<--one>
89
90 Abort as soon as one test fails.
91
92 =item I<--testlist>
93
94 Load a list of tests from the specified location.
95
96 =back
97
98 =head1 ENVIRONMENT
99
100 =over 4
101
102 =item I<SMBD_VALGRIND>
103
104 =item I<TORTURE_MAXTIME>
105
106 =item I<VALGRIND>
107
108 =item I<TLS_ENABLED>
109
110 =item I<srcdir>
111
112 =back
113
114 =head1 LICENSE
115
116 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
117
118 =head1 AUTHOR
119
120 Jelmer Vernooij
121
122 =cut
123
124 use strict;
125
126 use FindBin qw($RealBin $Script);
127 use File::Spec;
128 use Getopt::Long;
129 use POSIX;
130 use Cwd qw(abs_path);
131 use lib "$RealBin";
132 use Subunit qw(parse_results);
133 use SocketWrapper;
134
135 my $opt_help = 0;
136 my $opt_target = "samba4";
137 my $opt_quick = 0;
138 my $opt_socket_wrapper = 0;
139 my $opt_socket_wrapper_pcap = undef;
140 my $opt_socket_wrapper_keep_pcap = undef;
141 my $opt_one = 0;
142 my $opt_immediate = 0;
143 my $opt_expected_failures = undef;
144 my @opt_exclude = ();
145 my @opt_include = ();
146 my $opt_verbose = 0;
147 my $opt_image = undef;
148 my $opt_testenv = 0;
149 my $ldap = undef;
150 my $opt_analyse_cmd = undef;
151 my $opt_resetup_env = undef;
152 my $opt_bindir = undef;
153 my $opt_no_lazy_setup = undef;
154 my $opt_format = "plain";
155 my @testlists = ();
156
157 my $srcdir = ".";
158 my $builddir = ".";
159 my $prefix = "./st";
160
161 my @expected_failures = ();
162 my @includes = ();
163 my @excludes = ();
164
165 my $statistics = {
166         SUITES_FAIL => 0,
167
168         TESTS_UNEXPECTED_OK => 0,
169         TESTS_EXPECTED_OK => 0,
170         TESTS_UNEXPECTED_FAIL => 0,
171         TESTS_EXPECTED_FAIL => 0,
172         TESTS_ERROR => 0,
173         TESTS_SKIP => 0,
174 };
175
176 sub find_in_list($$)
177 {
178         my ($list, $fullname) = @_;
179
180         foreach (@$list) {
181                 if ($fullname =~ /$$_[0]/) {
182                          return ($$_[1]) if ($$_[1]);
183                          return "NO REASON SPECIFIED";
184                 }
185         }
186
187         return undef;
188 }
189
190 sub expecting_failure($)
191 {
192         my ($name) = @_;
193         return find_in_list(\@expected_failures, $name);
194 }
195
196 sub skip($)
197 {
198         my ($name) = @_;
199
200         return find_in_list(\@excludes, $name);
201 }
202
203 sub getlog_env($);
204
205 sub setup_pcap($)
206 {
207         my ($name) = @_;
208
209         return unless ($opt_socket_wrapper_pcap);
210         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
211
212         my $fname = $name;
213         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
214
215         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
216
217         SocketWrapper::setup_pcap($pcap_file);
218
219         return $pcap_file;
220 }
221
222 sub cleanup_pcap($$$)
223 {
224         my ($pcap_file, $expected_ret, $ret) = @_;
225
226         return unless ($opt_socket_wrapper_pcap);
227         return if ($opt_socket_wrapper_keep_pcap);
228         return unless ($expected_ret == $ret);
229         return unless defined($pcap_file);
230
231         unlink($pcap_file);
232 }
233
234 sub run_testsuite($$$$$$)
235 {
236         my ($envname, $name, $cmd, $i, $totalsuites, $msg_ops) = @_;
237         my $pcap_file = setup_pcap($name);
238
239         $msg_ops->start_test([], $name);
240
241         unless (open(RESULT, "$cmd 2>&1|")) {
242                 $statistics->{TESTS_ERROR}++;
243                 $msg_ops->end_test([], $name, "error", 1, "Unable to run $cmd: $!");
244                 $statistics->{SUITES_FAIL}++;
245                 return 0;
246         }
247
248         my $expected_ret = parse_results(
249                 $msg_ops, $statistics, *RESULT, \&expecting_failure, [$name]);
250
251         my $envlog = getlog_env($envname);
252         $msg_ops->output_msg("ENVLOG: $envlog\n") if ($envlog ne "");
253
254         $msg_ops->output_msg("CMD: $cmd\n");
255
256         my $ret = close(RESULT);
257         $ret = 0 unless $ret == 1;
258
259         my $exitcode = $? >> 8;
260
261         if ($ret == 1) {
262                 $msg_ops->end_test([], $name, "success", $expected_ret != $ret, undef); 
263         } else {
264                 $msg_ops->end_test([], $name, "failure", $expected_ret != $ret, "Exit code was $exitcode");
265         }
266
267         cleanup_pcap($pcap_file, $expected_ret, $ret);
268
269         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
270                 $msg_ops->output_msg("PCAP FILE: $pcap_file\n");
271         }
272
273         if ($ret != $expected_ret) {
274                 $statistics->{SUITES_FAIL}++;
275                 exit(1) if ($opt_one);
276         }
277
278         return ($ret == $expected_ret);
279 }
280
281 sub ShowHelp()
282 {
283         print "Samba test runner
284 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
285
286 Usage: $Script [OPTIONS] TESTNAME-REGEX
287
288 Generic options:
289  --help                     this help page
290  --target=samba[34]|win|kvm Samba version to target
291  --testlist=FILE            file to read available tests from
292
293 Paths:
294  --prefix=DIR               prefix to run tests in [st]
295  --srcdir=DIR               source directory [.]
296  --builddir=DIR             output directory [.]
297
298 Target Specific:
299  --socket-wrapper-pcap      save traffic to pcap directories
300  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that 
301                             failed
302  --socket-wrapper           enable socket wrapper
303  --bindir=PATH              path to target binaries
304  --expected-failures=FILE   specify list of tests that is guaranteed to fail
305
306 Samba4 Specific:
307  --ldap=openldap|fedora-ds  back samba onto specified ldap server
308
309 Kvm Specific:
310  --image=PATH               path to KVM image
311
312 Behaviour:
313  --quick                    run quick overall test
314  --one                      abort when the first test fails
315  --immediate                print test output for failed tests during run
316  --verbose                  be verbose
317  --analyse-cmd CMD          command to run after each test
318 ";
319         exit(0);
320 }
321
322 my $result = GetOptions (
323                 'help|h|?' => \$opt_help,
324                 'target=s' => \$opt_target,
325                 'prefix=s' => \$prefix,
326                 'socket-wrapper' => \$opt_socket_wrapper,
327                 'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
328                 'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
329                 'quick' => \$opt_quick,
330                 'one' => \$opt_one,
331                 'immediate' => \$opt_immediate,
332                 'expected-failures=s' => \$opt_expected_failures,
333                 'exclude=s' => \@opt_exclude,
334                 'include=s' => \@opt_include,
335                 'srcdir=s' => \$srcdir,
336                 'builddir=s' => \$builddir,
337                 'verbose' => \$opt_verbose,
338                 'testenv' => \$opt_testenv,
339                 'ldap:s' => \$ldap,
340                 'analyse-cmd=s' => \$opt_analyse_cmd,
341                 'no-lazy-setup' => \$opt_no_lazy_setup,
342                 'resetup-environment' => \$opt_resetup_env,
343                 'bindir:s' => \$opt_bindir,
344                 'format=s' => \$opt_format,
345                 'image=s' => \$opt_image,
346                 'testlist=s' => \@testlists
347             );
348
349 exit(1) if (not $result);
350
351 ShowHelp() if ($opt_help);
352
353 my $tests = shift;
354
355 # quick hack to disable rpc validation when using valgrind - its way too slow
356 unless (defined($ENV{VALGRIND})) {
357         $ENV{VALIDATE} = "validate";
358         $ENV{MALLOC_CHECK_} = 2;
359 }
360
361 my $old_pwd = "$RealBin/..";
362
363 # Backwards compatibility:
364 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
365         if (defined($ENV{FEDORA_DS_ROOT})) {
366                 $ldap = "fedora-ds";
367         } else {
368                 $ldap = "openldap";
369         }
370 }
371
372 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
373 if ($ldap) {
374         # LDAP is slow
375         $torture_maxtime *= 2;
376 }
377
378 $prefix =~ s+//+/+;
379 $prefix =~ s+/./+/+;
380 $prefix =~ s+/$++;
381
382 die("using an empty prefix isn't allowed") unless $prefix ne "";
383
384 #Ensure we have the test prefix around
385 mkdir($prefix, 0777) unless -d $prefix;
386
387 my $prefix_abs = abs_path($prefix);
388 my $srcdir_abs = abs_path($srcdir);
389
390 die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
391 die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";
392
393 $ENV{PREFIX} = $prefix;
394 $ENV{KRB5CCNAME} = "$prefix/krb5ticket";
395 $ENV{PREFIX_ABS} = $prefix_abs;
396 $ENV{SRCDIR} = $srcdir;
397 $ENV{SRCDIR_ABS} = $srcdir_abs;
398
399 if (defined($ENV{RUN_FROM_BUILD_FARM}) and 
400         ($ENV{RUN_FROM_BUILD_FARM} eq "yes")) {
401         $opt_format = "buildfarm";
402 }
403
404 my $tls_enabled = not $opt_quick;
405 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
406 $ENV{LDB_MODULES_PATH} = "$old_pwd/source4/bin/modules/ldb";
407 $ENV{LD_SAMBA_MODULE_PATH} = "$old_pwd/source4/bin/modules";
408 sub prefix_pathvar($$)
409 {
410         my ($name, $newpath) = @_;
411         if (defined($ENV{$name})) {
412                 $ENV{$name} = "$newpath:$ENV{$name}";
413         } else {
414                 $ENV{$name} = $newpath;
415         }
416 }
417 prefix_pathvar("PKG_CONFIG_PATH", "$old_pwd/source4/bin/pkgconfig");
418 prefix_pathvar("PYTHONPATH", "$old_pwd/source4/bin/python");
419
420 if ($opt_socket_wrapper_keep_pcap) {
421         # Socket wrapper keep pcap implies socket wrapper pcap
422         $opt_socket_wrapper_pcap = 1;
423 }
424
425 if ($opt_socket_wrapper_pcap) {
426         # Socket wrapper pcap implies socket wrapper
427         $opt_socket_wrapper = 1;
428 }
429
430 my $socket_wrapper_dir;
431 if ($opt_socket_wrapper) {
432         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
433         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
434 } else {
435          unless ($< == 0) { 
436                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
437          }
438 }
439
440 my $target;
441 my $testenv_default = "none";
442
443 if ($opt_target eq "samba4") {
444         $testenv_default = "member";
445         require target::Samba4;
446         $target = new Samba4($opt_bindir or "$srcdir/bin", $ldap, "$srcdir/setup");
447 } elsif ($opt_target eq "samba3") {
448         my $bindir = ($opt_bindir or "$srcdir/bin");
449         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
450                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
451         }
452         $testenv_default = "dc";
453         require target::Samba3;
454         $target = new Samba3($bindir);
455 } elsif ($opt_target eq "win") {
456         die("Windows tests will not run with socket wrapper enabled.") 
457                 if ($opt_socket_wrapper);
458         $testenv_default = "dc";
459         require target::Windows;
460         $target = new Windows();
461 } elsif ($opt_target eq "kvm") {
462         die("Kvm tests will not run with socket wrapper enabled.") 
463                 if ($opt_socket_wrapper);
464         require target::Kvm;
465         die("No image specified") unless ($opt_image);
466         $target = new Kvm($opt_image, undef);
467 }
468
469 #
470 # Start a Virtual Distributed Ethernet Switch
471 # Returns the pid of the switch.
472 #
473 sub start_vde_switch($)
474 {
475         my ($path) = @_;
476
477         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
478
479         open(PID, "$path/vde.pid");
480         <PID> =~ /([0-9]+)/;
481         my $pid = $1;
482         close(PID);
483
484         return $pid;
485 }
486
487 # Stop a Virtual Distributed Ethernet Switch
488 sub stop_vde_switch($)
489 {
490         my ($pid) = @_;
491         kill 9, $pid;
492 }
493
494 sub read_test_regexes($)
495 {
496         my ($name) = @_;
497         my @ret = ();
498         open(LF, "<$name") or die("unable to read $name: $!");
499         while (<LF>) { 
500                 chomp; 
501                 next if (/^#/);
502                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
503                         push (@ret, [$1, $4]);
504                 } else {
505                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
506                         push (@ret, [$_, undef]); 
507                 }
508         }
509         close(LF);
510         return @ret;
511 }
512
513 if (defined($opt_expected_failures)) {
514         @expected_failures = read_test_regexes($opt_expected_failures);
515 }
516
517 foreach (@opt_exclude) {
518         push (@excludes, read_test_regexes($_));
519 }
520
521 foreach (@opt_include) {
522         push (@includes, read_test_regexes($_));
523 }
524
525 my $interfaces = join(',', ("127.0.0.6/8", 
526                             "127.0.0.7/8",
527                             "127.0.0.8/8",
528                             "127.0.0.9/8",
529                             "127.0.0.10/8",
530                             "127.0.0.11/8"));
531
532 my $conffile = "$prefix_abs/client/client.conf";
533 $ENV{SMB_CONF_PATH} = $conffile;
534
535 sub write_clientconf($$)
536 {
537         my ($conffile, $vars) = @_;
538
539         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
540         
541         if ( -d "$prefix/client/private" ) {
542                 unlink <$prefix/client/private/*>;
543         } else {
544                 mkdir("$prefix/client/private", 0777);
545         }
546
547         open(CF, ">$conffile");
548         print CF "[global]\n";
549         if (defined($ENV{VALGRIND})) {
550                 print CF "\ticonv:native = true\n";
551         } else {
552                 print CF "\ticonv:native = false\n";
553         }
554         print CF "\tnetbios name = client\n";
555         if (defined($vars->{DOMAIN})) {
556                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
557         }
558         if (defined($vars->{REALM})) {
559                 print CF "\trealm = $vars->{REALM}\n";
560         }
561         if (defined($vars->{NCALRPCDIR})) {
562                 print CF "\tncalrpc dir = $vars->{NCALRPCDIR}\n";
563         }
564         if (defined($vars->{PIDDIR})) {
565                 print CF "\tpid directory = $vars->{PIDDIR}\n";
566         }
567         if (defined($vars->{WINBINDD_SOCKET_DIR})) {
568                 print CF "\twinbindd socket directory = $vars->{WINBINDD_SOCKET_DIR}\n";
569         }
570         if ($opt_socket_wrapper) {
571                 print CF "\tinterfaces = $interfaces\n";
572         }
573         print CF "
574         private dir = $prefix_abs/client/private
575         name resolve order = bcast
576         panic action = $srcdir_abs/script/gdb_backtrace \%PID\% \%PROG\%
577         max xmit = 32K
578         notify:inotify = false
579         ldb:nosync = true
580         system:anonymous = true
581         torture:basedir = $prefix_abs/client
582 #We don't want to pass our self-tests if the PAC code is wrong
583         gensec:require_pac = true
584         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
585 ";
586         close(CF);
587 }
588
589 my @todo = ();
590
591 my $testsdir = "$srcdir/selftest";
592
593 my %required_envs = ();
594
595 sub read_testlist($)
596 {
597         my ($filename) = @_;
598
599         my @ret = ();
600         open(IN, $filename) or die("Unable to open $filename: $!");
601
602         while (<IN>) {
603                 if ($_ eq "-- TEST --\n") {
604                         my $name = <IN>;
605                         $name =~ s/\n//g;
606                         my $env = <IN>;
607                         $env =~ s/\n//g;
608                         my $cmdline = <IN>;
609                         $cmdline =~ s/\n//g;
610                         if (not defined($tests) or $name =~ /$tests/) {
611                                 $required_envs{$env} = 1;
612                                 push (@ret, [$name, $env, $cmdline]);
613                         }
614                 } else {
615                         print;
616                 }
617         }
618         close(IN) or die("Error creating recipe");
619         return @ret;
620 }
621
622 if ($#testlists == -1) {
623         die("No testlists specified");
624 }
625
626 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
627 if ($opt_socket_wrapper) {
628         $ENV{SELFTEST_INTERFACES} = $interfaces;
629 } else {
630         $ENV{SELFTEST_INTERFACES} = "";
631 }
632 if ($opt_verbose) {
633         $ENV{SELFTEST_VERBOSE} = "1";
634 } else {
635         $ENV{SELFTEST_VERBOSE} = "";
636 }
637 if ($opt_quick) {
638         $ENV{SELFTEST_QUICK} = "1";
639 } else {
640         $ENV{SELFTEST_QUICK} = "";
641 }
642 $ENV{SELFTEST_TARGET} = $opt_target;
643 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
644 $ENV{SELFTEST_CONFFILE} = $conffile;
645
646 my @available = ();
647 foreach my $fn (@testlists) {
648         foreach (read_testlist($fn)) {
649                 my $name = $$_[0];
650                 next if (@includes and not find_in_list(\@includes, $name));
651                 push (@available, $_);
652         }
653 }
654
655 my $msg_ops;
656 if ($opt_format eq "buildfarm") {
657         require output::buildfarm;
658         $msg_ops = new output::buildfarm($statistics);
659 } elsif ($opt_format eq "plain") {
660         require output::plain;
661         $msg_ops = new output::plain("$prefix/summary", $opt_verbose, $opt_immediate, $statistics, $#available+1);
662 } elsif ($opt_format eq "html") {
663         require output::html;
664         mkdir("test-results", 0777);
665         $msg_ops = new output::html("test-results", $statistics);
666 } else {
667         die("Invalid output format '$opt_format'");
668 }
669
670
671 foreach (@available) {
672         my $name = $$_[0];
673         my $skipreason = skip($name);
674         if ($skipreason) {
675                 $msg_ops->skip_testsuite($name, $skipreason);
676         } else {
677                 push(@todo, $_); 
678         }
679 }
680
681 if ($#todo == -1) {
682         print STDERR "No tests to run\n";
683         exit(1);
684         }
685
686 my $suitestotal = $#todo + 1;
687 my $i = 0;
688 $| = 1;
689
690 my %running_envs = ();
691
692 my @exported_envvars = (
693         # domain stuff
694         "DOMAIN",
695         "REALM",
696
697         # domain controller stuff
698         "DC_SERVER",
699         "DC_SERVER_IP",
700         "DC_NETBIOSNAME",
701         "DC_NETBIOSALIAS",
702
703         # server stuff
704         "SERVER",
705         "SERVER_IP",
706         "NETBIOSNAME",
707         "NETBIOSALIAS",
708
709         # user stuff
710         "USERNAME",
711         "PASSWORD",
712         "DC_USERNAME",
713         "DC_PASSWORD",
714
715         # misc stuff
716         "KRB5_CONFIG",
717         "WINBINDD_SOCKET_DIR",
718         "WINBINDD_PRIV_PIPE_DIR"
719 );
720
721 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { 
722         my $signame = shift;
723         teardown_env($_) foreach(keys %running_envs);
724         die("Received signal $signame");
725 };
726
727 sub setup_env($)
728 {
729         my ($envname) = @_;
730
731         my $testenv_vars;
732         if ($envname eq "none") {
733                 $testenv_vars = {};
734         } elsif (defined($running_envs{$envname})) {
735                 $testenv_vars = $running_envs{$envname};
736                 if (not $target->check_env($testenv_vars)) {
737                         $testenv_vars = undef;
738                 }
739         } else {
740                 $testenv_vars = $target->setup_env($envname, $prefix);
741         }
742
743         return undef unless defined($testenv_vars);
744
745         $running_envs{$envname} = $testenv_vars;
746
747         SocketWrapper::set_default_iface(6);
748         write_clientconf($conffile, $testenv_vars);
749
750         foreach (@exported_envvars) {
751                 if (defined($testenv_vars->{$_})) {
752                         $ENV{$_} = $testenv_vars->{$_};
753                 } else {
754                         delete $ENV{$_};
755                 }
756         }
757
758         return $testenv_vars;
759 }
760
761 sub exported_envvars_str($)
762 {
763         my ($testenv_vars) = @_;
764         my $out = "";
765
766         foreach (@exported_envvars) {
767                 next unless defined($testenv_vars->{$_});
768                 $out .= $_."=".$testenv_vars->{$_}."\n";
769         }
770
771         return $out;
772 }
773
774 sub getlog_env($)
775 {
776         my ($envname) = @_;
777         return "" if ($envname eq "none");
778         return $target->getlog_env($running_envs{$envname});
779 }
780
781 sub check_env($)
782 {
783         my ($envname) = @_;
784         return 1 if ($envname eq "none");
785         return $target->check_env($running_envs{$envname});
786 }
787
788 sub teardown_env($)
789 {
790         my ($envname) = @_;
791         return if ($envname eq "none");
792         $target->teardown_env($running_envs{$envname});
793         delete $running_envs{$envname};
794 }
795
796 if ($opt_no_lazy_setup) {
797         setup_env($_) foreach (keys %required_envs);
798 }
799
800 if ($opt_testenv) {
801         my $testenv_name = $ENV{SELFTEST_TESTENV};
802         $testenv_name = $testenv_default unless defined($testenv_name);
803
804         my $testenv_vars = setup_env($testenv_name);
805
806         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
807
808         my $envvarstr = exported_envvars_str($testenv_vars);
809
810         my $term = ($ENV{TERM} or "xterm");
811         system("$term -e 'echo -e \"
812 Welcome to the Samba4 Test environment '$testenv_name'
813
814 This matches the client environment used in make test
815 server is pid `cat \$PIDDIR/samba.pid`
816
817 Some useful environment variables:
818 TORTURE_OPTIONS=\$TORTURE_OPTIONS
819 CONFIGURATION=\$CONFIGURATION
820
821 $envvarstr
822 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
823         teardown_env($testenv_name);
824 } else {
825         foreach (@todo) {
826                 $i++;
827                 my $cmd = $$_[2];
828                 $cmd =~ s/([\(\)])/\\$1/g;
829                 my $name = $$_[0];
830                 my $envname = $$_[1];
831                 
832                 my $envvars = setup_env($envname);
833                 if (not defined($envvars)) {
834                         $msg_ops->skip_testsuite($name, "unable to set up environment $envname");
835                         next;
836                 }
837
838                 run_testsuite($envname, $name, $cmd, $i, $suitestotal, 
839                               $msg_ops);
840
841                 if (defined($opt_analyse_cmd)) {
842                         system("$opt_analyse_cmd \"$name\"");
843                 }
844
845                 teardown_env($envname) if ($opt_resetup_env);
846         }
847 }
848
849 print "\n";
850
851 teardown_env($_) foreach (keys %running_envs);
852
853 $target->stop();
854
855 $msg_ops->summary();
856
857 my $failed = 0;
858
859 # if there were any valgrind failures, show them
860 foreach (<$prefix/valgrind.log*>) {
861         next unless (-s $_);
862         system("grep DWARF2.CFI.reader $_ > /dev/null");
863         if ($? >> 8 == 0) {
864             print "VALGRIND FAILURE\n";
865             $failed++;
866             system("cat $_");
867         }
868 }
869
870 if ($opt_format eq "buildfarm") {
871         print "TEST STATUS: $statistics->{SUITES_FAIL}\n";
872 }
873
874 exit $statistics->{SUITES_FAIL};