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