selftest: configure "ncalrpc dir" for the client
[ira/wip.git] / selftest / selftest.pl
1 #!/usr/bin/perl
2 # Bootstrap Samba and run a number of tests against it.
3 # Copyright (C) 2005-2009 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 Getopt::Long;
129 use POSIX;
130 use Cwd qw(abs_path);
131 use lib "$RealBin";
132 use Subunit qw(parse_results);
133 use Subunit::Filter;
134 use SocketWrapper;
135
136 my $opt_help = 0;
137 my $opt_target = "samba4";
138 my $opt_quick = 0;
139 my $opt_socket_wrapper = 0;
140 my $opt_socket_wrapper_pcap = undef;
141 my $opt_socket_wrapper_keep_pcap = undef;
142 my $opt_one = 0;
143 my @opt_exclude = ();
144 my @opt_include = ();
145 my $opt_verbose = 0;
146 my $opt_image = undef;
147 my $opt_testenv = 0;
148 my $ldap = undef;
149 my $opt_analyse_cmd = undef;
150 my $opt_resetup_env = undef;
151 my $opt_bindir = undef;
152 my $opt_no_lazy_setup = undef;
153 my @testlists = ();
154
155 my $srcdir = ".";
156 my $builddir = ".";
157 my $exeext = "";
158 my $prefix = "./st";
159
160 my @includes = ();
161 my @excludes = ();
162
163 sub find_in_list($$)
164 {
165         my ($list, $fullname) = @_;
166
167         foreach (@$list) {
168                 if ($fullname =~ /$$_[0]/) {
169                          return ($$_[1]) if ($$_[1]);
170                          return "";
171                 }
172         }
173
174         return undef;
175 }
176
177 sub skip($)
178 {
179         my ($name) = @_;
180
181         return find_in_list(\@excludes, $name);
182 }
183
184 sub getlog_env($);
185
186 sub setup_pcap($)
187 {
188         my ($name) = @_;
189
190         return unless ($opt_socket_wrapper_pcap);
191         return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});
192
193         my $fname = $name;
194         $fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;
195
196         my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";
197
198         SocketWrapper::setup_pcap($pcap_file);
199
200         return $pcap_file;
201 }
202
203 sub cleanup_pcap($$)
204 {
205         my ($pcap_file, $exitcode) = @_;
206
207         return unless ($opt_socket_wrapper_pcap);
208         return if ($opt_socket_wrapper_keep_pcap);
209         return unless ($exitcode == 0);
210         return unless defined($pcap_file);
211
212         unlink($pcap_file);
213 }
214
215 sub run_testsuite($$$$$)
216 {
217         my ($envname, $name, $cmd, $i, $totalsuites) = @_;
218         my $pcap_file = setup_pcap($name);
219
220         Subunit::start_testsuite($name);
221         Subunit::report_time(time());
222
223         open(RESULTS, "$cmd 2>&1|");
224         my $statistics = {
225                 TESTS_UNEXPECTED_OK => 0,
226                 TESTS_EXPECTED_OK => 0,
227                 TESTS_UNEXPECTED_FAIL => 0,
228                 TESTS_EXPECTED_FAIL => 0,
229                 TESTS_ERROR => 0,
230                 TESTS_SKIP => 0,
231         };
232
233         my $msg_ops = new Subunit::Filter("$name\.", []);
234
235         parse_results($msg_ops, $statistics, *RESULTS);
236
237         my $ret = 0;
238
239         unless (close(RESULTS)) {
240                 if ($!) {
241                         Subunit::end_testsuite($name, "error", "Unable to run $cmd: $!");
242                         return 0;
243                 } else {
244                         $ret = $?;
245                 }
246         } 
247
248         if ($ret & 127) {
249                 Subunit::end_testsuite($name, "error", sprintf("Testsuite died with signal %d, %s coredump", ($ret & 127), ($ret & 128) ? "with": "without"));
250                 return 0;
251         }
252         my $envlog = getlog_env($envname);
253         if ($envlog ne "") {
254                 print "envlog: $envlog\n";
255         }
256
257         print "command: $cmd\n";
258
259         my $exitcode = $ret >> 8;
260
261         Subunit::report_time(time());
262         if ($exitcode == 0) {
263                 Subunit::end_testsuite($name, "success");
264         } else {
265                 Subunit::end_testsuite($name, "failure", "Exit code was $exitcode");
266         }
267
268         cleanup_pcap($pcap_file, $exitcode);
269
270         if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
271                 print "PCAP FILE: $pcap_file\n";
272         }
273
274         if ($exitcode != 0) {
275                 exit(1) if ($opt_one);
276         }
277
278         return $exitcode;
279 }
280
281 sub ShowHelp()
282 {
283         print "Samba test runner
284 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
285 Copyright (C) Stefan Metzmacher <metze\@samba.org>
286
287 Usage: $Script [OPTIONS] TESTNAME-REGEX
288
289 Generic options:
290  --help                     this help page
291  --target=samba[34]|win|kvm Samba version to target
292  --testlist=FILE            file to read available tests from
293
294 Paths:
295  --prefix=DIR               prefix to run tests in [st]
296  --srcdir=DIR               source directory [.]
297  --builddir=DIR             output directory [.]
298  --exeext=EXT               executable extention []
299
300 Target Specific:
301  --socket-wrapper-pcap      save traffic to pcap directories
302  --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that 
303                             failed
304  --socket-wrapper           enable socket wrapper
305  --bindir=PATH              path to target binaries
306
307 Samba4 Specific:
308  --ldap=openldap|fedora-ds  back samba onto specified ldap server
309
310 Kvm Specific:
311  --image=PATH               path to KVM image
312
313 Behaviour:
314  --quick                    run quick overall test
315  --one                      abort when the first test fails
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                 'exclude=s' => \@opt_exclude,
332                 'include=s' => \@opt_include,
333                 'srcdir=s' => \$srcdir,
334                 'builddir=s' => \$builddir,
335                 'exeext=s' => \$exeext,
336                 'verbose' => \$opt_verbose,
337                 'testenv' => \$opt_testenv,
338                 'ldap:s' => \$ldap,
339                 'analyse-cmd=s' => \$opt_analyse_cmd,
340                 'no-lazy-setup' => \$opt_no_lazy_setup,
341                 'resetup-environment' => \$opt_resetup_env,
342                 'bindir:s' => \$opt_bindir,
343                 'image=s' => \$opt_image,
344                 'testlist=s' => \@testlists
345             );
346
347 exit(1) if (not $result);
348
349 ShowHelp() if ($opt_help);
350
351 my $tests = shift;
352
353 # quick hack to disable rpc validation when using valgrind - its way too slow
354 unless (defined($ENV{VALGRIND})) {
355         $ENV{VALIDATE} = "validate";
356         $ENV{MALLOC_CHECK_} = 2;
357 }
358
359 my $bindir = ($opt_bindir or "$builddir/bin");
360 my $bindir_abs = abs_path($bindir);
361
362 # Backwards compatibility:
363 if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
364         if (defined($ENV{FEDORA_DS_ROOT})) {
365                 $ldap = "fedora-ds";
366         } else {
367                 $ldap = "openldap";
368         }
369 }
370
371 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
372 if ($ldap) {
373         # LDAP is slow
374         $torture_maxtime *= 2;
375 }
376
377 $prefix =~ s+//+/+;
378 $prefix =~ s+/./+/+;
379 $prefix =~ s+/$++;
380
381 die("using an empty prefix isn't allowed") unless $prefix ne "";
382
383 #Ensure we have the test prefix around
384 mkdir($prefix, 0777) unless -d $prefix;
385
386 my $prefix_abs = abs_path($prefix);
387 my $srcdir_abs = abs_path($srcdir);
388 my $builddir_abs = abs_path($builddir);
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 $ENV{BUILDDIR} = $builddir;
399 $ENV{BUILDDIR_ABS} = $builddir_abs;
400 $ENV{EXEEXT} = $exeext;
401
402 my $tls_enabled = not $opt_quick;
403 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
404 $ENV{LDB_MODULES_PATH} = "$bindir_abs/modules/ldb";
405 $ENV{LD_SAMBA_MODULE_PATH} = "$bindir_abs/modules";
406 sub prefix_pathvar($$)
407 {
408         my ($name, $newpath) = @_;
409         if (defined($ENV{$name})) {
410                 $ENV{$name} = "$newpath:$ENV{$name}";
411         } else {
412                 $ENV{$name} = $newpath;
413         }
414 }
415 prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
416 prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
417
418 if ($opt_socket_wrapper_keep_pcap) {
419         # Socket wrapper keep pcap implies socket wrapper pcap
420         $opt_socket_wrapper_pcap = 1;
421 }
422
423 if ($opt_socket_wrapper_pcap) {
424         # Socket wrapper pcap implies socket wrapper
425         $opt_socket_wrapper = 1;
426 }
427
428 my $socket_wrapper_dir;
429 if ($opt_socket_wrapper) {
430         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
431         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
432 } else {
433          unless ($< == 0) { 
434                  print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
435          }
436 }
437
438 my $target;
439 my $testenv_default = "none";
440
441 if ($opt_target eq "samba4") {
442         $testenv_default = "member";
443         require target::Samba4;
444         $target = new Samba4($bindir, $ldap, "$srcdir/setup", $exeext);
445 } elsif ($opt_target eq "samba3") {
446         if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
447                 die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'.  Exiting....");
448         }
449         $testenv_default = "member";
450         require target::Samba3;
451         $target = new Samba3($bindir);
452 } elsif ($opt_target eq "win") {
453         die("Windows tests will not run with socket wrapper enabled.") 
454                 if ($opt_socket_wrapper);
455         $testenv_default = "dc";
456         require target::Windows;
457         $target = new Windows();
458 } elsif ($opt_target eq "kvm") {
459         die("Kvm tests will not run with socket wrapper enabled.") 
460                 if ($opt_socket_wrapper);
461         require target::Kvm;
462         die("No image specified") unless ($opt_image);
463         $target = new Kvm($opt_image, undef);
464 }
465
466 #
467 # Start a Virtual Distributed Ethernet Switch
468 # Returns the pid of the switch.
469 #
470 sub start_vde_switch($)
471 {
472         my ($path) = @_;
473
474         system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
475
476         open(PID, "$path/vde.pid");
477         <PID> =~ /([0-9]+)/;
478         my $pid = $1;
479         close(PID);
480
481         return $pid;
482 }
483
484 # Stop a Virtual Distributed Ethernet Switch
485 sub stop_vde_switch($)
486 {
487         my ($pid) = @_;
488         kill 9, $pid;
489 }
490
491 sub read_test_regexes($)
492 {
493         my ($name) = @_;
494         my @ret = ();
495         open(LF, "<$name") or die("unable to read $name: $!");
496         while (<LF>) { 
497                 chomp; 
498                 next if (/^#/);
499                 if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
500                         push (@ret, [$1, $4]);
501                 } else {
502                         s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
503                         push (@ret, [$_, undef]); 
504                 }
505         }
506         close(LF);
507         return @ret;
508 }
509
510 foreach (@opt_exclude) {
511         push (@excludes, read_test_regexes($_));
512 }
513
514 foreach (@opt_include) {
515         push (@includes, read_test_regexes($_));
516 }
517
518 my $interfaces = join(',', ("127.0.0.6/8", 
519                             "127.0.0.7/8",
520                             "127.0.0.8/8",
521                             "127.0.0.9/8",
522                             "127.0.0.10/8",
523                             "127.0.0.11/8"));
524
525 my $conffile = "$prefix_abs/client/client.conf";
526 $ENV{SMB_CONF_PATH} = $conffile;
527
528 sub write_clientconf($$)
529 {
530         my ($conffile, $vars) = @_;
531
532         mkdir("$prefix/client", 0777) unless -d "$prefix/client";
533         
534         if ( -d "$prefix/client/private" ) {
535                 unlink <$prefix/client/private/*>;
536         } else {
537                 mkdir("$prefix/client/private", 0777);
538         }
539
540         if ( -d "$prefix/client/lockdir" ) {
541                 unlink <$prefix/client/lockdir/*>;
542         } else {
543                 mkdir("$prefix/client/lockdir", 0777);
544         }
545
546         if ( -d "$prefix_abs/client/ncalrpcdir" ) {
547                 unlink <$prefix/client/ncalrpcdir/*>;
548         } else {
549                 mkdir("$prefix/client/ncalrpcdir", 0777);
550         }
551
552         open(CF, ">$conffile");
553         print CF "[global]\n";
554         if (defined($ENV{VALGRIND})) {
555                 print CF "\ticonv:native = true\n";
556         } else {
557                 print CF "\ticonv:native = false\n";
558         }
559         print CF "\tnetbios name = client\n";
560         if (defined($vars->{DOMAIN})) {
561                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
562         }
563         if (defined($vars->{REALM})) {
564                 print CF "\trealm = $vars->{REALM}\n";
565         }
566         if ($opt_socket_wrapper) {
567                 print CF "\tinterfaces = $interfaces\n";
568         }
569         print CF "
570         private dir = $prefix_abs/client/private
571         lock dir = $prefix_abs/client/lockdir
572         ncalrpc dir = $prefix_abs/client/ncalrpcdir
573         name resolve order = bcast
574         panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
575         max xmit = 32K
576         notify:inotify = false
577         ldb:nosync = true
578         system:anonymous = true
579         client lanman auth = Yes
580         torture:basedir = $prefix_abs/client
581 #We don't want to pass our self-tests if the PAC code is wrong
582         gensec:require_pac = true
583         modules dir = $ENV{LD_SAMBA_MODULE_PATH}
584 ";
585         close(CF);
586 }
587
588 my @todo = ();
589
590 my $testsdir = "$srcdir/selftest";
591
592 my %required_envs = ();
593
594 sub read_testlist($)
595 {
596         my ($filename) = @_;
597
598         my @ret = ();
599         open(IN, $filename) or die("Unable to open $filename: $!");
600
601         while (<IN>) {
602                 if ($_ eq "-- TEST --\n") {
603                         my $name = <IN>;
604                         $name =~ s/\n//g;
605                         my $env = <IN>;
606                         $env =~ s/\n//g;
607                         my $cmdline = <IN>;
608                         $cmdline =~ s/\n//g;
609                         if (not defined($tests) or $name =~ /$tests/) {
610                                 $required_envs{$env} = 1;
611                                 push (@ret, [$name, $env, $cmdline]);
612                         }
613                 } else {
614                         print;
615                 }
616         }
617         close(IN) or die("Error creating recipe");
618         return @ret;
619 }
620
621 if ($#testlists == -1) {
622         die("No testlists specified");
623 }
624
625 $ENV{SELFTEST_PREFIX} = "$prefix_abs";
626 if ($opt_socket_wrapper) {
627         $ENV{SELFTEST_INTERFACES} = $interfaces;
628 } else {
629         $ENV{SELFTEST_INTERFACES} = "";
630 }
631 if ($opt_verbose) {
632         $ENV{SELFTEST_VERBOSE} = "1";
633 } else {
634         $ENV{SELFTEST_VERBOSE} = "";
635 }
636 if ($opt_quick) {
637         $ENV{SELFTEST_QUICK} = "1";
638 } else {
639         $ENV{SELFTEST_QUICK} = "";
640 }
641 $ENV{SELFTEST_TARGET} = $opt_target;
642 $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
643
644 my @available = ();
645 foreach my $fn (@testlists) {
646         foreach (read_testlist($fn)) {
647                 my $name = $$_[0];
648                 next if (@includes and not defined(find_in_list(\@includes, $name)));
649                 push (@available, $_);
650         }
651 }
652
653 Subunit::testsuite_count($#available+1);
654 Subunit::report_time(time());
655
656 foreach (@available) {
657         my $name = $$_[0];
658         my $skipreason = skip($name);
659         if (defined($skipreason)) {
660                 Subunit::skip_testsuite($name, $skipreason);
661         } else {
662                 push(@todo, $_); 
663         }
664 }
665
666 if ($#todo == -1) {
667         print STDERR "No tests to run\n";
668         exit(1);
669         }
670
671 my $suitestotal = $#todo + 1;
672 my $i = 0;
673 $| = 1;
674
675 my %running_envs = ();
676
677 sub get_running_env($)
678 {
679         my ($name) = @_;
680
681         my $envname = $name;
682
683         $envname =~ s/:.*//;
684
685         return $running_envs{$envname};
686 }
687
688 my @exported_envvars = (
689         # domain stuff
690         "DOMAIN",
691         "REALM",
692
693         # domain controller stuff
694         "DC_SERVER",
695         "DC_SERVER_IP",
696         "DC_NETBIOSNAME",
697         "DC_NETBIOSALIAS",
698
699         # server stuff
700         "SERVER",
701         "SERVER_IP",
702         "NETBIOSNAME",
703         "NETBIOSALIAS",
704
705         # user stuff
706         "USERNAME",
707         "PASSWORD",
708         "DC_USERNAME",
709         "DC_PASSWORD",
710
711         # misc stuff
712         "KRB5_CONFIG",
713         "WINBINDD_SOCKET_DIR",
714         "WINBINDD_PRIV_PIPE_DIR"
715 );
716
717 $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub { 
718         my $signame = shift;
719         teardown_env($_) foreach(keys %running_envs);
720         die("Received signal $signame");
721 };
722
723 sub setup_env($)
724 {
725         my ($name) = @_;
726
727         my $testenv_vars = undef;
728
729         my $envname = $name;
730         my $option = $name;
731
732         $envname =~ s/:.*//;
733         $option =~ s/^[^:]*//;
734         $option =~ s/^://;
735
736         $option = "client" if $option eq "";
737
738         if ($envname eq "none") {
739                 $testenv_vars = {};
740         } elsif (defined(get_running_env($envname))) {
741                 $testenv_vars = get_running_env($envname);
742                 if (not $target->check_env($testenv_vars)) {
743                         $testenv_vars = undef;
744                 }
745         } else {
746                 $testenv_vars = $target->setup_env($envname, $prefix);
747         }
748
749         return undef unless defined($testenv_vars);
750
751         $running_envs{$envname} = $testenv_vars;
752
753         if ($option eq "local") {
754                 SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
755                 $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
756         } elsif ($option eq "client") {
757                 SocketWrapper::set_default_iface(6);
758                 write_clientconf($conffile, $testenv_vars);
759                 $ENV{SMB_CONF_PATH} = $conffile;
760         } else {
761                 die("Unknown option[$option] for envname[$envname]");
762         }
763
764         foreach (@exported_envvars) {
765                 if (defined($testenv_vars->{$_})) {
766                         $ENV{$_} = $testenv_vars->{$_};
767                 } else {
768                         delete $ENV{$_};
769                 }
770         }
771
772         return $testenv_vars;
773 }
774
775 sub exported_envvars_str($)
776 {
777         my ($testenv_vars) = @_;
778         my $out = "";
779
780         foreach (@exported_envvars) {
781                 next unless defined($testenv_vars->{$_});
782                 $out .= $_."=".$testenv_vars->{$_}."\n";
783         }
784
785         return $out;
786 }
787
788 sub getlog_env($)
789 {
790         my ($envname) = @_;
791         return "" if ($envname eq "none");
792         return $target->getlog_env(get_running_env($envname));
793 }
794
795 sub check_env($)
796 {
797         my ($envname) = @_;
798         return 1 if ($envname eq "none");
799         return $target->check_env(get_running_env($envname));
800 }
801
802 sub teardown_env($)
803 {
804         my ($envname) = @_;
805         return if ($envname eq "none");
806         $target->teardown_env(get_running_env($envname));
807         delete $running_envs{$envname};
808 }
809
810 if ($opt_no_lazy_setup) {
811         setup_env($_) foreach (keys %required_envs);
812 }
813
814 if ($opt_testenv) {
815         my $testenv_name = $ENV{SELFTEST_TESTENV};
816         $testenv_name = $testenv_default unless defined($testenv_name);
817
818         my $testenv_vars = setup_env($testenv_name);
819
820         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
821
822         my $envvarstr = exported_envvars_str($testenv_vars);
823
824         my $term = ($ENV{TERM} or "xterm");
825         system("$term -e 'echo -e \"
826 Welcome to the Samba4 Test environment '$testenv_name'
827
828 This matches the client environment used in make test
829 server is pid `cat \$PIDDIR/samba.pid`
830
831 Some useful environment variables:
832 TORTURE_OPTIONS=\$TORTURE_OPTIONS
833 SMB_CONF_PATH=\$SMB_CONF_PATH
834
835 $envvarstr
836 \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
837         teardown_env($testenv_name);
838 } else {
839         foreach (@todo) {
840                 $i++;
841                 my $cmd = $$_[2];
842                 $cmd =~ s/([\(\)])/\\$1/g;
843                 my $name = $$_[0];
844                 my $envname = $$_[1];
845                 
846                 my $envvars = setup_env($envname);
847                 if (not defined($envvars)) {
848                         Subunit::skip_testsuite($name, 
849                                 "unable to set up environment $envname");
850                         next;
851                 }
852
853                 run_testsuite($envname, $name, $cmd, $i, $suitestotal);
854
855                 if (defined($opt_analyse_cmd)) {
856                         system("$opt_analyse_cmd \"$name\"");
857                 }
858
859                 teardown_env($envname) if ($opt_resetup_env);
860         }
861 }
862
863 print "\n";
864
865 teardown_env($_) foreach (keys %running_envs);
866
867 $target->stop();
868
869 my $failed = 0;
870
871 # if there were any valgrind failures, show them
872 foreach (<$prefix/valgrind.log*>) {
873         next unless (-s $_);
874         system("grep DWARF2.CFI.reader $_ > /dev/null");
875         if ($? >> 8 == 0) {
876             print "VALGRIND FAILURE\n";
877             $failed++;
878             system("cat $_");
879         }
880 }
881 exit 0;