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{BINDIR} = $bindir_abs;
|
---|
425 | $ENV{EXEEXT} = $exeext;
|
---|
426 |
|
---|
427 | my $tls_enabled = not $opt_quick;
|
---|
428 | $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
|
---|
429 |
|
---|
430 | sub prefix_pathvar($$)
|
---|
431 | {
|
---|
432 | my ($name, $newpath) = @_;
|
---|
433 | if (defined($ENV{$name})) {
|
---|
434 | $ENV{$name} = "$newpath:$ENV{$name}";
|
---|
435 | } else {
|
---|
436 | $ENV{$name} = $newpath;
|
---|
437 | }
|
---|
438 | }
|
---|
439 | prefix_pathvar("PKG_CONFIG_PATH", "$bindir_abs/pkgconfig");
|
---|
440 | prefix_pathvar("PYTHONPATH", "$bindir_abs/python");
|
---|
441 |
|
---|
442 | if ($opt_socket_wrapper_keep_pcap) {
|
---|
443 | # Socket wrapper keep pcap implies socket wrapper pcap
|
---|
444 | $opt_socket_wrapper_pcap = 1;
|
---|
445 | }
|
---|
446 |
|
---|
447 | if ($opt_socket_wrapper_pcap) {
|
---|
448 | # Socket wrapper pcap implies socket wrapper
|
---|
449 | $opt_socket_wrapper = 1;
|
---|
450 | }
|
---|
451 |
|
---|
452 | my $socket_wrapper_dir;
|
---|
453 | if ($opt_socket_wrapper) {
|
---|
454 | $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix_abs/w", $opt_socket_wrapper_pcap);
|
---|
455 | print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
|
---|
456 | } else {
|
---|
457 | unless ($< == 0) {
|
---|
458 | print "WARNING: Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports\n";
|
---|
459 | }
|
---|
460 | }
|
---|
461 |
|
---|
462 | my $target;
|
---|
463 | my $testenv_default = "none";
|
---|
464 |
|
---|
465 | if ($opt_target eq "samba4") {
|
---|
466 | $testenv_default = "all";
|
---|
467 | require target::Samba4;
|
---|
468 | $target = new Samba4($bindir, $ldap, $srcdir, $exeext);
|
---|
469 | } elsif ($opt_target eq "samba3") {
|
---|
470 | if ($opt_socket_wrapper and `$bindir/smbd -b | grep SOCKET_WRAPPER` eq "") {
|
---|
471 | die("You must include --enable-socket-wrapper when compiling Samba in order to execute 'make test'. Exiting....");
|
---|
472 | }
|
---|
473 | $testenv_default = "member";
|
---|
474 | require target::Samba3;
|
---|
475 | $target = new Samba3($bindir, $srcdir_abs);
|
---|
476 | } elsif ($opt_target eq "win") {
|
---|
477 | die("Windows tests will not run with socket wrapper enabled.")
|
---|
478 | if ($opt_socket_wrapper);
|
---|
479 | $testenv_default = "dc";
|
---|
480 | require target::Windows;
|
---|
481 | $target = new Windows();
|
---|
482 | } elsif ($opt_target eq "kvm") {
|
---|
483 | die("Kvm tests will not run with socket wrapper enabled.")
|
---|
484 | if ($opt_socket_wrapper);
|
---|
485 | require target::Kvm;
|
---|
486 | die("No image specified") unless ($opt_image);
|
---|
487 | $target = new Kvm($opt_image, undef);
|
---|
488 | }
|
---|
489 |
|
---|
490 | #
|
---|
491 | # Start a Virtual Distributed Ethernet Switch
|
---|
492 | # Returns the pid of the switch.
|
---|
493 | #
|
---|
494 | sub start_vde_switch($)
|
---|
495 | {
|
---|
496 | my ($path) = @_;
|
---|
497 |
|
---|
498 | system("vde_switch --pidfile $path/vde.pid --sock $path/vde.sock --daemon");
|
---|
499 |
|
---|
500 | open(PID, "$path/vde.pid");
|
---|
501 | <PID> =~ /([0-9]+)/;
|
---|
502 | my $pid = $1;
|
---|
503 | close(PID);
|
---|
504 |
|
---|
505 | return $pid;
|
---|
506 | }
|
---|
507 |
|
---|
508 | # Stop a Virtual Distributed Ethernet Switch
|
---|
509 | sub stop_vde_switch($)
|
---|
510 | {
|
---|
511 | my ($pid) = @_;
|
---|
512 | kill 9, $pid;
|
---|
513 | }
|
---|
514 |
|
---|
515 | sub read_test_regexes($)
|
---|
516 | {
|
---|
517 | my ($name) = @_;
|
---|
518 | my @ret = ();
|
---|
519 | open(LF, "<$name") or die("unable to read $name: $!");
|
---|
520 | while (<LF>) {
|
---|
521 | chomp;
|
---|
522 | next if (/^#/);
|
---|
523 | if (/^(.*?)([ \t]+)\#([\t ]*)(.*?)$/) {
|
---|
524 | push (@ret, [$1, $4]);
|
---|
525 | } else {
|
---|
526 | s/^(.*?)([ \t]+)\#([\t ]*)(.*?)$//;
|
---|
527 | push (@ret, [$_, undef]);
|
---|
528 | }
|
---|
529 | }
|
---|
530 | close(LF);
|
---|
531 | return @ret;
|
---|
532 | }
|
---|
533 |
|
---|
534 | foreach (@opt_exclude) {
|
---|
535 | push (@excludes, read_test_regexes($_));
|
---|
536 | }
|
---|
537 |
|
---|
538 | foreach (@opt_include) {
|
---|
539 | push (@includes, read_test_regexes($_));
|
---|
540 | }
|
---|
541 |
|
---|
542 | my $interfaces = join(',', ("127.0.0.11/8",
|
---|
543 | "127.0.0.12/8",
|
---|
544 | "127.0.0.13/8",
|
---|
545 | "127.0.0.14/8",
|
---|
546 | "127.0.0.15/8",
|
---|
547 | "127.0.0.16/8"));
|
---|
548 |
|
---|
549 | my $clientdir = "$prefix_abs/client";
|
---|
550 |
|
---|
551 | my $conffile = "$clientdir/client.conf";
|
---|
552 | $ENV{SMB_CONF_PATH} = $conffile;
|
---|
553 |
|
---|
554 | sub write_clientconf($$$)
|
---|
555 | {
|
---|
556 | my ($conffile, $clientdir, $vars) = @_;
|
---|
557 |
|
---|
558 | mkdir("$clientdir", 0777) unless -d "$clientdir";
|
---|
559 |
|
---|
560 | if ( -d "$clientdir/private" ) {
|
---|
561 | unlink <$clientdir/private/*>;
|
---|
562 | } else {
|
---|
563 | mkdir("$clientdir/private", 0777);
|
---|
564 | }
|
---|
565 |
|
---|
566 | if ( -d "$clientdir/lockdir" ) {
|
---|
567 | unlink <$clientdir/lockdir/*>;
|
---|
568 | } else {
|
---|
569 | mkdir("$clientdir/lockdir", 0777);
|
---|
570 | }
|
---|
571 |
|
---|
572 | if ( -d "$clientdir/ncalrpcdir" ) {
|
---|
573 | unlink <$clientdir/ncalrpcdir/*>;
|
---|
574 | } else {
|
---|
575 | mkdir("$clientdir/ncalrpcdir", 0777);
|
---|
576 | }
|
---|
577 |
|
---|
578 | open(CF, ">$conffile");
|
---|
579 | print CF "[global]\n";
|
---|
580 | if (defined($ENV{VALGRIND})) {
|
---|
581 | print CF "\ticonv:native = true\n";
|
---|
582 | } else {
|
---|
583 | print CF "\ticonv:native = false\n";
|
---|
584 | }
|
---|
585 | print CF "\tnetbios name = client\n";
|
---|
586 | if (defined($vars->{DOMAIN})) {
|
---|
587 | print CF "\tworkgroup = $vars->{DOMAIN}\n";
|
---|
588 | }
|
---|
589 | if (defined($vars->{REALM})) {
|
---|
590 | print CF "\trealm = $vars->{REALM}\n";
|
---|
591 | }
|
---|
592 | if ($opt_socket_wrapper) {
|
---|
593 | print CF "\tinterfaces = $interfaces\n";
|
---|
594 | }
|
---|
595 | print CF "
|
---|
596 | private dir = $clientdir/private
|
---|
597 | lock dir = $clientdir/lockdir
|
---|
598 | ncalrpc dir = $clientdir/ncalrpcdir
|
---|
599 | name resolve order = bcast file
|
---|
600 | panic action = $RealBin/gdb_backtrace \%PID\% \%PROG\%
|
---|
601 | max xmit = 32K
|
---|
602 | notify:inotify = false
|
---|
603 | ldb:nosync = true
|
---|
604 | system:anonymous = true
|
---|
605 | client lanman auth = Yes
|
---|
606 | log level = 1
|
---|
607 | torture:basedir = $clientdir
|
---|
608 | #We don't want to pass our self-tests if the PAC code is wrong
|
---|
609 | gensec:require_pac = true
|
---|
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 | sub should_run_test($)
|
---|
620 | {
|
---|
621 | my $name = shift;
|
---|
622 | if ($#tests == -1) {
|
---|
623 | return 1;
|
---|
624 | }
|
---|
625 | for (my $i=0; $i <= $#tests; $i++) {
|
---|
626 | if ($name =~ /$tests[$i]/i) {
|
---|
627 | return 1;
|
---|
628 | }
|
---|
629 | }
|
---|
630 | return 0;
|
---|
631 | }
|
---|
632 |
|
---|
633 | sub read_testlist($)
|
---|
634 | {
|
---|
635 | my ($filename) = @_;
|
---|
636 |
|
---|
637 | my @ret = ();
|
---|
638 | open(IN, $filename) or die("Unable to open $filename: $!");
|
---|
639 |
|
---|
640 | while (<IN>) {
|
---|
641 | if (/-- TEST(-LOADLIST|-IDLIST|) --\n/) {
|
---|
642 | my $supports_loadlist = (defined($1) and $1 eq "-LOADLIST");
|
---|
643 | my $supports_idlist = (defined($1) and $1 eq "-IDLIST");
|
---|
644 | my $name = <IN>;
|
---|
645 | $name =~ s/\n//g;
|
---|
646 | my $env = <IN>;
|
---|
647 | $env =~ s/\n//g;
|
---|
648 | my $cmdline = <IN>;
|
---|
649 | $cmdline =~ s/\n//g;
|
---|
650 | if (should_run_test($name) == 1) {
|
---|
651 | push (@ret, [$name, $env, $cmdline, $supports_loadlist, $supports_idlist]);
|
---|
652 | }
|
---|
653 | } else {
|
---|
654 | print;
|
---|
655 | }
|
---|
656 | }
|
---|
657 | close(IN) or die("Error creating recipe");
|
---|
658 | return @ret;
|
---|
659 | }
|
---|
660 |
|
---|
661 | if ($#testlists == -1) {
|
---|
662 | die("No testlists specified");
|
---|
663 | }
|
---|
664 |
|
---|
665 | $ENV{SELFTEST_PREFIX} = "$prefix_abs";
|
---|
666 | $ENV{SELFTEST_TMPDIR} = "$tmpdir_abs";
|
---|
667 | $ENV{TEST_DATA_PREFIX} = "$tmpdir_abs";
|
---|
668 | if ($opt_socket_wrapper) {
|
---|
669 | $ENV{SELFTEST_INTERFACES} = $interfaces;
|
---|
670 | } else {
|
---|
671 | $ENV{SELFTEST_INTERFACES} = "";
|
---|
672 | }
|
---|
673 | if ($opt_verbose) {
|
---|
674 | $ENV{SELFTEST_VERBOSE} = "1";
|
---|
675 | } else {
|
---|
676 | $ENV{SELFTEST_VERBOSE} = "";
|
---|
677 | }
|
---|
678 | if ($opt_quick) {
|
---|
679 | $ENV{SELFTEST_QUICK} = "1";
|
---|
680 | } else {
|
---|
681 | $ENV{SELFTEST_QUICK} = "";
|
---|
682 | }
|
---|
683 | $ENV{SELFTEST_TARGET} = $opt_target;
|
---|
684 | $ENV{SELFTEST_MAXTIME} = $torture_maxtime;
|
---|
685 |
|
---|
686 | my @available = ();
|
---|
687 | foreach my $fn (@testlists) {
|
---|
688 | foreach (read_testlist($fn)) {
|
---|
689 | my $name = $$_[0];
|
---|
690 | next if (@includes and not defined(find_in_list(\@includes, $name)));
|
---|
691 | push (@available, $_);
|
---|
692 | }
|
---|
693 | }
|
---|
694 |
|
---|
695 | my $restricted = undef;
|
---|
696 | my $restricted_used = {};
|
---|
697 |
|
---|
698 | if ($opt_load_list) {
|
---|
699 | $restricted = [];
|
---|
700 | open(LOAD_LIST, "<$opt_load_list") or die("Unable to open $opt_load_list");
|
---|
701 | while (<LOAD_LIST>) {
|
---|
702 | chomp;
|
---|
703 | push (@$restricted, $_);
|
---|
704 | }
|
---|
705 | close(LOAD_LIST);
|
---|
706 | }
|
---|
707 |
|
---|
708 | my $individual_tests = undef;
|
---|
709 | $individual_tests = {};
|
---|
710 |
|
---|
711 | foreach my $testsuite (@available) {
|
---|
712 | my $name = $$testsuite[0];
|
---|
713 | my $skipreason = skip($name);
|
---|
714 | if (defined($restricted)) {
|
---|
715 | # Find the testsuite for this test
|
---|
716 | my $match = undef;
|
---|
717 | foreach my $r (@$restricted) {
|
---|
718 | if ($r eq $name) {
|
---|
719 | $individual_tests->{$name} = [];
|
---|
720 | $match = $r;
|
---|
721 | $restricted_used->{$r} = 1;
|
---|
722 | } elsif (substr($r, 0, length($name)+1) eq "$name.") {
|
---|
723 | push(@{$individual_tests->{$name}}, $r);
|
---|
724 | $match = $r;
|
---|
725 | $restricted_used->{$r} = 1;
|
---|
726 | }
|
---|
727 | }
|
---|
728 | if ($match) {
|
---|
729 | if (defined($skipreason)) {
|
---|
730 | Subunit::skip_testsuite($name, $skipreason);
|
---|
731 | } else {
|
---|
732 | push(@todo, $testsuite);
|
---|
733 | }
|
---|
734 | }
|
---|
735 | } elsif (defined($skipreason)) {
|
---|
736 | Subunit::skip_testsuite($name, $skipreason);
|
---|
737 | } else {
|
---|
738 | push(@todo, $testsuite);
|
---|
739 | }
|
---|
740 | }
|
---|
741 |
|
---|
742 | if (defined($restricted)) {
|
---|
743 | foreach (@$restricted) {
|
---|
744 | unless (defined($restricted_used->{$_})) {
|
---|
745 | print "No test or testsuite found matching $_\n";
|
---|
746 | }
|
---|
747 | }
|
---|
748 | } elsif ($#todo == -1) {
|
---|
749 | print STDERR "No tests to run\n";
|
---|
750 | exit(1);
|
---|
751 | }
|
---|
752 |
|
---|
753 | my $suitestotal = $#todo + 1;
|
---|
754 |
|
---|
755 | Subunit::progress($suitestotal);
|
---|
756 | Subunit::report_time(time());
|
---|
757 |
|
---|
758 | my $i = 0;
|
---|
759 | $| = 1;
|
---|
760 |
|
---|
761 | my %running_envs = ();
|
---|
762 |
|
---|
763 | sub get_running_env($)
|
---|
764 | {
|
---|
765 | my ($name) = @_;
|
---|
766 |
|
---|
767 | my $envname = $name;
|
---|
768 |
|
---|
769 | $envname =~ s/:.*//;
|
---|
770 |
|
---|
771 | return $running_envs{$envname};
|
---|
772 | }
|
---|
773 |
|
---|
774 | my @exported_envvars = (
|
---|
775 | # domain stuff
|
---|
776 | "DOMAIN",
|
---|
777 | "REALM",
|
---|
778 |
|
---|
779 | # domain controller stuff
|
---|
780 | "DC_SERVER",
|
---|
781 | "DC_SERVER_IP",
|
---|
782 | "DC_NETBIOSNAME",
|
---|
783 | "DC_NETBIOSALIAS",
|
---|
784 |
|
---|
785 | # domain member
|
---|
786 | "MEMBER_SERVER",
|
---|
787 | "MEMBER_SERVER_IP",
|
---|
788 | "MEMBER_NETBIOSNAME",
|
---|
789 | "MEMBER_NETBIOSALIAS",
|
---|
790 |
|
---|
791 | # rpc proxy controller stuff
|
---|
792 | "RPC_PROXY_SERVER",
|
---|
793 | "RPC_PROXY_SERVER_IP",
|
---|
794 | "RPC_PROXY_NETBIOSNAME",
|
---|
795 | "RPC_PROXY_NETBIOSALIAS",
|
---|
796 |
|
---|
797 | # domain controller stuff for Vampired DC
|
---|
798 | "VAMPIRE_DC_SERVER",
|
---|
799 | "VAMPIRE_DC_SERVER_IP",
|
---|
800 | "VAMPIRE_DC_NETBIOSNAME",
|
---|
801 | "VAMPIRE_DC_NETBIOSALIAS",
|
---|
802 |
|
---|
803 | # server stuff
|
---|
804 | "SERVER",
|
---|
805 | "SERVER_IP",
|
---|
806 | "NETBIOSNAME",
|
---|
807 | "NETBIOSALIAS",
|
---|
808 |
|
---|
809 | # user stuff
|
---|
810 | "USERNAME",
|
---|
811 | "USERID",
|
---|
812 | "PASSWORD",
|
---|
813 | "DC_USERNAME",
|
---|
814 | "DC_PASSWORD",
|
---|
815 |
|
---|
816 | # misc stuff
|
---|
817 | "KRB5_CONFIG",
|
---|
818 | "WINBINDD_SOCKET_DIR",
|
---|
819 | "WINBINDD_PRIV_PIPE_DIR",
|
---|
820 | "NMBD_SOCKET_DIR",
|
---|
821 | "LOCAL_PATH"
|
---|
822 | );
|
---|
823 |
|
---|
824 | $SIG{INT} = $SIG{QUIT} = $SIG{TERM} = sub {
|
---|
825 | my $signame = shift;
|
---|
826 | teardown_env($_) foreach(keys %running_envs);
|
---|
827 | die("Received signal $signame");
|
---|
828 | };
|
---|
829 |
|
---|
830 | sub setup_env($$)
|
---|
831 | {
|
---|
832 | my ($name, $prefix) = @_;
|
---|
833 |
|
---|
834 | my $testenv_vars = undef;
|
---|
835 |
|
---|
836 | my $envname = $name;
|
---|
837 | my $option = $name;
|
---|
838 |
|
---|
839 | $envname =~ s/:.*//;
|
---|
840 | $option =~ s/^[^:]*//;
|
---|
841 | $option =~ s/^://;
|
---|
842 |
|
---|
843 | $option = "client" if $option eq "";
|
---|
844 |
|
---|
845 | if ($envname eq "none") {
|
---|
846 | $testenv_vars = {};
|
---|
847 | } elsif (defined(get_running_env($envname))) {
|
---|
848 | $testenv_vars = get_running_env($envname);
|
---|
849 | if (not $testenv_vars->{target}->check_env($testenv_vars)) {
|
---|
850 | print $testenv_vars->{target}->getlog_env($testenv_vars);
|
---|
851 | $testenv_vars = undef;
|
---|
852 | }
|
---|
853 | } else {
|
---|
854 | $testenv_vars = $target->setup_env($envname, $prefix);
|
---|
855 | if (defined($testenv_vars) && not defined($testenv_vars->{target})) {
|
---|
856 | $testenv_vars->{target} = $target;
|
---|
857 | }
|
---|
858 | }
|
---|
859 |
|
---|
860 | return undef unless defined($testenv_vars);
|
---|
861 |
|
---|
862 | $running_envs{$envname} = $testenv_vars;
|
---|
863 |
|
---|
864 | if ($option eq "local") {
|
---|
865 | SocketWrapper::set_default_iface($testenv_vars->{SOCKET_WRAPPER_DEFAULT_IFACE});
|
---|
866 | $ENV{SMB_CONF_PATH} = $testenv_vars->{SERVERCONFFILE};
|
---|
867 | } elsif ($option eq "client") {
|
---|
868 | SocketWrapper::set_default_iface(11);
|
---|
869 | write_clientconf($conffile, $clientdir, $testenv_vars);
|
---|
870 | $ENV{SMB_CONF_PATH} = $conffile;
|
---|
871 | } else {
|
---|
872 | die("Unknown option[$option] for envname[$envname]");
|
---|
873 | }
|
---|
874 |
|
---|
875 | foreach (@exported_envvars) {
|
---|
876 | if (defined($testenv_vars->{$_})) {
|
---|
877 | $ENV{$_} = $testenv_vars->{$_};
|
---|
878 | } else {
|
---|
879 | delete $ENV{$_};
|
---|
880 | }
|
---|
881 | }
|
---|
882 |
|
---|
883 | return $testenv_vars;
|
---|
884 | }
|
---|
885 |
|
---|
886 | sub exported_envvars_str($)
|
---|
887 | {
|
---|
888 | my ($testenv_vars) = @_;
|
---|
889 | my $out = "";
|
---|
890 |
|
---|
891 | foreach (@exported_envvars) {
|
---|
892 | next unless defined($testenv_vars->{$_});
|
---|
893 | $out .= $_."=".$testenv_vars->{$_}."\n";
|
---|
894 | }
|
---|
895 |
|
---|
896 | return $out;
|
---|
897 | }
|
---|
898 |
|
---|
899 | sub getlog_env($)
|
---|
900 | {
|
---|
901 | my ($envname) = @_;
|
---|
902 | return "" if ($envname eq "none");
|
---|
903 | my $env = get_running_env($envname);
|
---|
904 | return $env->{target}->getlog_env($env);
|
---|
905 | }
|
---|
906 |
|
---|
907 | sub check_env($)
|
---|
908 | {
|
---|
909 | my ($envname) = @_;
|
---|
910 | return 1 if ($envname eq "none");
|
---|
911 | my $env = get_running_env($envname);
|
---|
912 | return $env->{target}->check_env($env);
|
---|
913 | }
|
---|
914 |
|
---|
915 | sub teardown_env($)
|
---|
916 | {
|
---|
917 | my ($envname) = @_;
|
---|
918 | return if ($envname eq "none");
|
---|
919 | my $env = get_running_env($envname);
|
---|
920 | $env->{target}->teardown_env($env);
|
---|
921 | delete $running_envs{$envname};
|
---|
922 | }
|
---|
923 |
|
---|
924 | # This 'global' file needs to be empty when we start
|
---|
925 | unlink("$prefix_abs/dns_host_file");
|
---|
926 |
|
---|
927 | if ($opt_testenv) {
|
---|
928 | my $testenv_name = $ENV{SELFTEST_TESTENV};
|
---|
929 | $testenv_name = $testenv_default unless defined($testenv_name);
|
---|
930 |
|
---|
931 | my $testenv_vars = setup_env($testenv_name, $prefix);
|
---|
932 |
|
---|
933 | die("Unable to setup environment $testenv_name") unless ($testenv_vars);
|
---|
934 |
|
---|
935 | $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
|
---|
936 | $ENV{ENVNAME} = $testenv_name;
|
---|
937 |
|
---|
938 | my $envvarstr = exported_envvars_str($testenv_vars);
|
---|
939 |
|
---|
940 | my $term = ($ENV{TERMINAL} or "xterm -e");
|
---|
941 | system("$term 'echo -e \"
|
---|
942 | Welcome to the Samba4 Test environment '$testenv_name'
|
---|
943 |
|
---|
944 | This matches the client environment used in make test
|
---|
945 | server is pid `cat \$PIDDIR/samba.pid`
|
---|
946 |
|
---|
947 | Some useful environment variables:
|
---|
948 | TORTURE_OPTIONS=\$TORTURE_OPTIONS
|
---|
949 | SMB_CONF_PATH=\$SMB_CONF_PATH
|
---|
950 |
|
---|
951 | $envvarstr
|
---|
952 | \" && LD_LIBRARY_PATH=$ENV{LD_LIBRARY_PATH} bash'");
|
---|
953 | teardown_env($testenv_name);
|
---|
954 | } elsif ($opt_list) {
|
---|
955 | foreach (@todo) {
|
---|
956 | my $cmd = $$_[2];
|
---|
957 | my $name = $$_[0];
|
---|
958 | my $envname = $$_[1];
|
---|
959 |
|
---|
960 | unless($cmd =~ /\$LISTOPT/) {
|
---|
961 | warn("Unable to list tests in $name");
|
---|
962 | next;
|
---|
963 | }
|
---|
964 |
|
---|
965 | $cmd =~ s/\$LISTOPT/--list/g;
|
---|
966 |
|
---|
967 | system($cmd);
|
---|
968 |
|
---|
969 | if ($? == -1) {
|
---|
970 | die("Unable to run $cmd: $!");
|
---|
971 | } elsif ($? & 127) {
|
---|
972 | die(snprintf("%s died with signal %d, %s coredump\n", $cmd, ($? & 127), ($? & 128) ? 'with' : 'without'));
|
---|
973 | }
|
---|
974 |
|
---|
975 | my $exitcode = $? >> 8;
|
---|
976 | if ($exitcode != 0) {
|
---|
977 | die("$cmd exited with exit code $exitcode");
|
---|
978 | }
|
---|
979 | }
|
---|
980 | } else {
|
---|
981 | foreach (@todo) {
|
---|
982 | $i++;
|
---|
983 | my $cmd = $$_[2];
|
---|
984 | my $name = $$_[0];
|
---|
985 | my $envname = $$_[1];
|
---|
986 |
|
---|
987 | my $envvars = setup_env($envname, $prefix);
|
---|
988 | if (not defined($envvars)) {
|
---|
989 | Subunit::start_testsuite($name);
|
---|
990 | Subunit::end_testsuite($name, "error",
|
---|
991 | "unable to set up environment $envname - exiting");
|
---|
992 | next;
|
---|
993 | }
|
---|
994 |
|
---|
995 | # Generate a file with the individual tests to run, if the
|
---|
996 | # test runner for this test suite supports it.
|
---|
997 | if ($individual_tests and $individual_tests->{$name}) {
|
---|
998 | if ($$_[3]) {
|
---|
999 | my ($fh, $listid_file) = tempfile(UNLINK => 0);
|
---|
1000 | foreach my $test (@{$individual_tests->{$name}}) {
|
---|
1001 | print $fh substr($test, length($name)+1) . "\n";
|
---|
1002 | }
|
---|
1003 | $cmd =~ s/\$LOADLIST/--load-list=$listid_file/g;
|
---|
1004 | } elsif ($$_[4]) {
|
---|
1005 | $cmd =~ s/\s+[^\s]+\s*$//;
|
---|
1006 | $cmd .= " " . join(' ', @{$individual_tests->{$name}});
|
---|
1007 | }
|
---|
1008 | }
|
---|
1009 |
|
---|
1010 | run_testsuite($envname, $name, $cmd, $i, $suitestotal);
|
---|
1011 |
|
---|
1012 | teardown_env($envname) if ($opt_resetup_env);
|
---|
1013 | }
|
---|
1014 | }
|
---|
1015 |
|
---|
1016 | print "\n";
|
---|
1017 |
|
---|
1018 | teardown_env($_) foreach (keys %running_envs);
|
---|
1019 |
|
---|
1020 | my $failed = 0;
|
---|
1021 |
|
---|
1022 | # if there were any valgrind failures, show them
|
---|
1023 | foreach (<$prefix/valgrind.log*>) {
|
---|
1024 | next unless (-s $_);
|
---|
1025 | print "VALGRIND FAILURE\n";
|
---|
1026 | $failed++;
|
---|
1027 | system("cat $_");
|
---|
1028 | }
|
---|
1029 | exit 0;
|
---|