source/script/tests/selftest.pl

   1 #!/usr/bin/perl
   2 # Bootstrap Samba and run a number of tests against it.
   3 # Copyright (C) 2005-2007 Jelmer Vernooij <jelmer@samba.org>
   4 # Published under the GNU GPL, v3 or later.
   5
   6 =pod
   7
   8 =head1 NAME
   9
  10 selftest - Samba test runner
  11
  12 =head1 SYNOPSIS
  13
  14 selftest --help
  15
  16 selftest [--srcdir=DIR] [--builddir=DIR] [--target=samba4|samba3|win] [--socket-wrapper] [--quick] [--one] [--prefix=prefix] [--immediate] [TESTS]
  17
  18 =head1 DESCRIPTION
  19
  20 A simple test runner. TESTS is a regular expression with tests to run.
  21
  22 =head1 OPTIONS
  23
  24 =over 4
  25
  26 =item I<--help>
  27
  28 Show list of available options.
  29
  30 =item I<--srcdir=DIR>
  31
  32 Source directory.
  33
  34 =item I<--builddir=DIR>
  35
  36 Build directory.
  37
  38 =item I<--prefix=DIR>
  39
  40 Change directory to run tests in. Default is 'st'.
  41
  42 =item I<--immediate>
  43
  44 Show errors as soon as they happen rather than at the end of the test run.
  45
  46 =item I<--target samba4|samba3|win>
  47
  48 Specify test target against which to run. Default is 'samba4'.
  49
  50 =item I<--quick>
  51
  52 Run only a limited number of tests. Intended to run in about 30 seconds on
  53 moderately recent systems.
  54
  55 =item I<--socket-wrapper>
  56
  57 Use socket wrapper library for communication with server. Only works
  58 when the server is running locally.
  59
  60 Will prevent TCP and UDP ports being opened on the local host but
  61 (transparently) redirects these calls to use unix domain sockets.
  62
  63 =item I<--expected-failures>
  64
  65 Specify a file containing a list of tests that are expected to fail. Failures for
  66 these tests will be counted as successes, successes will be counted as failures.
  67
  68 The format for the file is, one entry per line:
  69
  70 TESTSUITE-NAME/TEST-NAME
  71
  72 =item I<--skip>
  73
  74 Specify a file containing a list of tests that should be skipped. Possible candidates are
  75 tests that segfault the server, flip or don't end.
  76
  77 =item I<--one>
  78
  79 Abort as soon as one test fails.
  80
  81 =back
  82
  83 =head1 ENVIRONMENT
  84
  85 =over 4
  86
  87 =item I<SMBD_VALGRIND>
  88
  89 =item I<TORTURE_MAXTIME>
  90
  91 =item I<VALGRIND>
  92
  93 =item I<TLS_ENABLED>
  94
  95 =item I<srcdir>
  96
  97 =back
  98
  99 =head1 LICENSE
 100
 101 selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
 102
 103 =head1 AUTHOR
 104
 105 Jelmer Vernooij
 106
 107 =cut
 108
 109 use strict;
 110 use warnings;
 111
 112 use FindBin qw($RealBin $Script);
 113 use File::Spec;
 114 use Getopt::Long;
 115 use POSIX;
 116 use Cwd;
 117 use lib "$RealBin";
 118 use Samba3;
 119 use Samba4;
 120 use SocketWrapper;
 121
 122 my $opt_help = 0;
 123 my $opt_target = "samba4";
 124 my $opt_quick = 0;
 125 my $opt_socket_wrapper = 0;
 126 my $opt_socket_wrapper_pcap = undef;
 127 my $opt_one = 0;
 128 my $opt_immediate = 0;
 129 my $opt_expected_failures = undef;
 130 my $opt_skip = undef;
 131 my $opt_verbose = 0;
 132 my $opt_testenv = 0;
 133 my $opt_ldap = undef;
 134 my $opt_analyse_cmd = undef;
 135 my $opt_resetup_env = undef;
 136
 137 my $srcdir = ".";
 138 my $builddir = ".";
 139 my $prefix = "st";
 140
 141 my $suitesfailed = [];
 142 my $start = time();
 143 my @expected_failures = ();
 144 my @skips = ();
 145
 146 my $statistics = {
 147         SUITES_FAIL => 0,
 148         SUITES_OK => 0,
 149         SUITES_SKIPPED => 0,
 150
 151         TESTS_UNEXPECTED_OK => 0,
 152         TESTS_EXPECTED_OK => 0,
 153         TESTS_UNEXPECTED_FAIL => 0,
 154         TESTS_EXPECTED_FAIL => 0,
 155         TESTS_ERROR => 0
 156 };
 157
 158 sub expecting_failure($)
 159 {
 160         my $fullname = shift;
 161
 162         return 1 if (grep(/^$fullname$/, @expected_failures));
 163
 164         return 0;
 165 }
 166
 167 sub skip($)
 168 {
 169         my $fullname = shift;
 170
 171         return 1 if (grep(/^$fullname$/, @skips));
 172         return 0;
 173 }
 174
 175 sub run_test_buildfarm($$$$)
 176 {
 177         my ($name, $cmd, $i, $suitestotal) = @_;
 178         print "--==--==--==--==--==--==--==--==--==--==--\n";
 179         print "Running test $name (level 0 stdout)\n";
 180         print "--==--==--==--==--==--==--==--==--==--==--\n";
 181         system("date");
 182
 183         my $expected_ret = 1;
 184         my $open_tests = {};
 185         open(RESULT, "$cmd 2>&1|");
 186         while (<RESULT>) {
 187                 print;
 188                 if (/^test: (.+)\n/) {
 189                         $open_tests->{$1} = 1;
 190                 } elsif (/^(success|failure|skip|error): (.*?)( \[)?\n/) {
 191                         my $result = $1;
 192                         if ($1 eq "success") {
 193                                 delete $open_tests->{$2};
 194                                 if (expecting_failure("$name/$2")) {
 195                                         $statistics->{TESTS_UNEXPECTED_OK}++;
 196                                 } else {
 197                                         $statistics->{TESTS_EXPECTED_OK}++;
 198                                 }
 199                         } elsif ($1 eq "failure") {
 200                                 delete $open_tests->{$2};
 201                                 if (expecting_failure("$name/$2")) {
 202                                         $statistics->{TESTS_EXPECTED_FAIL}++;
 203                                         $expected_ret = 0;
 204                                 } else {
 205                                         $statistics->{TESTS_UNEXPECTED_FAIL}++;
 206                                 }
 207                         } elsif ($1 eq "skip") {
 208                                 delete $open_tests->{$2};
 209                         } elsif ($1 eq "error") {
 210                                 $statistics->{TESTS_ERROR}++;
 211                                 delete $open_tests->{$2};
 212                         }
 213                 }
 214         }
 215         print "COMMAND: $cmd\n";
 216         foreach (keys %$open_tests) {
 217                 print "$_ was started but never finished!\n";
 218                 $statistics->{TESTS_ERROR}++;
 219         }
 220         my $ret = close(RESULT);
 221
 222         print "==========================================\n";
 223         if ($ret == $expected_ret) {
 224                 print "TEST PASSED: $name\n";
 225         } else {
 226                 print "TEST FAILED: $name (status $ret)\n";
 227         }
 228         print "==========================================\n";
 229 }
 230
 231 my $test_output = {};
 232 sub run_test_plain($$$$)
 233 {
 234         my ($name, $cmd, $i, $totalsuites) = @_;
 235         my $err = "";
 236         if ($#$suitesfailed+1 > 0) { $err = ", ".($#$suitesfailed+1)." errors"; }
 237         print "[$i/$totalsuites in " . (time() - $start)."s$err] $name\n";
 238         open(RESULT, "$cmd 2>&1|");
 239         my $expected_ret = 1;
 240         my $open_tests = {};
 241         $test_output->{$name} = "";
 242         while (<RESULT>) {
 243                 $test_output->{$name}.=$_;
 244                 print if ($opt_verbose);
 245                 if (/^test: (.+)\n/) {
 246                         $open_tests->{$1} = 1;
 247                 } elsif (/^(success|failure|skip|error): (.*?)( \[)?\n/) {
 248                         my $result = $1;
 249                         if ($1 eq "success") {
 250                                 delete $open_tests->{$2};
 251                                 if (expecting_failure("$name/$2")) {
 252                                         $statistics->{TESTS_UNEXPECTED_OK}++;
 253                                 } else {
 254                                         $statistics->{TESTS_EXPECTED_OK}++;
 255                                 }
 256                         } elsif ($1 eq "failure") {
 257                                 delete $open_tests->{$2};
 258                                 if (expecting_failure("$name/$2")) {
 259                                         $statistics->{TESTS_EXPECTED_FAIL}++;
 260                                         $expected_ret = 0;
 261                                 } else {
 262                                         $statistics->{TESTS_UNEXPECTED_FAIL}++;
 263                                 }
 264                         } elsif ($1 eq "skip") {
 265                                 delete $open_tests->{$2};
 266                         } elsif ($1 eq "error") {
 267                                 $statistics->{TESTS_ERROR}++;
 268                                 delete $open_tests->{$2};
 269                         }
 270                 }
 271         }
 272         $test_output->{$name}.="COMMAND: $cmd\n";
 273         foreach (keys %$open_tests) {
 274                 $test_output->{$name}.="$_ was started but never finished!\n";
 275                 $statistics->{TESTS_ERROR}++;
 276         }
 277         my $ret = close(RESULT);
 278         if ($ret != $expected_ret and ($opt_immediate or $opt_one) and not $opt_verbose) {
 279                 print "$test_output->{$name}\n";
 280         }
 281         if ($ret != $expected_ret) {
 282                 push(@$suitesfailed, $name);
 283                 $statistics->{SUITES_FAIL}++;
 284                 exit(1) if ($opt_one);
 285         } else {
 286                 $statistics->{SUITES_OK}++;
 287         }
 288 }
 289
 290 sub ShowHelp()
 291 {
 292         print "Samba test runner
 293 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 294
 295 Usage: $Script [OPTIONS] PREFIX
 296
 297 Generic options:
 298  --help                     this help page
 299
 300 Paths:
 301  --prefix=DIR               prefix to run tests in [st]
 302  --srcdir=DIR               source directory [.]
 303  --builddir=DIR             output directory [.]
 304
 305 Target Specific:
 306  --target=samba4|samba3|win Samba version to target
 307  --socket-wrapper-pcap=FILE save traffic to pcap file
 308  --socket-wrapper           enable socket wrapper
 309  --expected-failures=FILE   specify list of tests that is guaranteed to fail
 310  --ldap                     run against ldap
 311
 312 Behaviour:
 313  --quick                    run quick overall test
 314  --one                      abort when the first test fails
 315  --immediate                print test output for failed tests during run
 316  --verbose                  be verbose
 317  --analyse-cmd CMD          command to run after each test
 318 ";
 319         exit(0);
 320 }
 321
 322 my $result = GetOptions (
 323             'help|h|?' => \$opt_help,
 324                 'target=s' => \$opt_target,
 325                 'prefix=s' => \$prefix,
 326                 'socket-wrapper' => \$opt_socket_wrapper,
 327                 'socket-wrapper-pcap=s' => \$opt_socket_wrapper_pcap,
 328                 'quick' => \$opt_quick,
 329                 'one' => \$opt_one,
 330                 'immediate' => \$opt_immediate,
 331                 'expected-failures=s' => \$opt_expected_failures,
 332                 'skip=s' => \$opt_skip,
 333                 'srcdir=s' => \$srcdir,
 334                 'builddir=s' => \$builddir,
 335                 'verbose' => \$opt_verbose,
 336                 'testenv' => \$opt_testenv,
 337                 'ldap' => \$opt_ldap,
 338                 'analyse-cmd=s' => \$opt_analyse_cmd,
 339                 'resetup-environment' => \$opt_resetup_env,
 340             );
 341
 342 exit(1) if (not $result);
 343
 344 ShowHelp() if ($opt_help);
 345
 346 my $tests = shift;
 347
 348 # quick hack to disable rpc validation when using valgrind - its way too slow
 349 unless (defined($ENV{VALGRIND})) {
 350         $ENV{VALIDATE} = "validate";
 351     $ENV{MALLOC_CHECK_} = 2;
 352 }
 353
 354 my $old_pwd = "$RealBin/../..";
 355 my $ldap = 0;
 356 if (defined($ENV{TEST_LDAP})) {
 357         $ldap = ($ENV{TEST_LDAP} eq "yes");
 358 }
 359 if (defined($opt_ldap)) {
 360         $ldap = $opt_ldap;
 361 }
 362
 363 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 364 if ($ldap) {
 365         # LDAP is slow
 366         $torture_maxtime *= 2;
 367 }
 368
 369 $prefix =~ s+//+/+;
 370 $ENV{PREFIX} = $prefix;
 371 $ENV{SRCDIR} = $srcdir;
 372
 373 my $tls_enabled = not $opt_quick;
 374 my $from_build_farm = (defined($ENV{RUN_FROM_BUILD_FARM}) and
 375                       ($ENV{RUN_FROM_BUILD_FARM} eq "yes"));
 376
 377 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 378 $ENV{LD_LDB_MODULE_PATH} = "$old_pwd/bin/modules/ldb";
 379 $ENV{LD_SAMBA_MODULE_PATH} = "$old_pwd/bin/modules";
 380 if (defined($ENV{LD_LIBRARY_PATH})) {
 381         $ENV{LD_LIBRARY_PATH} = "$old_pwd/bin/shared:$ENV{LD_LIBRARY_PATH}";
 382 } else {
 383         $ENV{LD_LIBRARY_PATH} = "$old_pwd/bin/shared";
 384 }
 385 $ENV{PKG_CONFIG_PATH} = "$old_pwd/bin/pkgconfig:$ENV{PKG_CONFIG_PATH}";
 386 $ENV{PATH} = "$old_pwd/bin:$ENV{PATH}";
 387
 388 if ($opt_socket_wrapper_pcap) {
 389         SocketWrapper::setup_pcap($opt_socket_wrapper_pcap);
 390         # Socket wrapper pcap implies socket wrapper
 391         $opt_socket_wrapper = 1;
 392 }
 393
 394 my $socket_wrapper_dir;
 395 if ($opt_socket_wrapper) {
 396         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w");
 397         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 398 } else {
 399         warn("Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports") unless $< == 0;
 400 }
 401
 402 my $target;
 403
 404 if ($opt_target eq "samba4") {
 405         $target = new Samba4("$srcdir/bin", $ldap, "$srcdir/setup");
 406 } elsif ($opt_target eq "samba3") {
 407         $target = new Samba3("$srcdir/bin", "$srcdir/setup");
 408 } elsif ($opt_target eq "win") {
 409         die("Windows tests will not run with socket wrapper enabled.")
 410                 if ($opt_socket_wrapper);
 411         $target = new Windows();
 412 }
 413
 414 if (defined($opt_expected_failures)) {
 415         open(KNOWN, "<$opt_expected_failures") or die("unable to read known failures file: $!");
 416         while (<KNOWN>) {
 417                 chomp;
 418                 s/([ \t]+)\#(.*)$//;
 419                 push (@expected_failures, $_); }
 420         close(KNOWN);
 421 }
 422
 423 if (defined($opt_skip)) {
 424         open(SKIP, "<$opt_skip") or die("unable to read skip file: $!");
 425         while (<SKIP>) {
 426                 chomp;
 427                 s/([ \t]+)\#(.*)$//;
 428                 push (@skips, $_); }
 429         close(SKIP);
 430 }
 431
 432 my $interfaces = join(',', ("127.0.0.6/8",
 433                                  "127.0.0.7/8",
 434                                                  "127.0.0.8/8",
 435                                                  "127.0.0.9/8",
 436                                                  "127.0.0.10/8",
 437                                                  "127.0.0.11/8"));
 438
 439 my $conffile = "$prefix/client.conf";
 440
 441 sub write_clientconf($$)
 442 {
 443         my ($conffile, $vars) = @_;
 444
 445         my $abs_srcdir = cwd();
 446
 447         open(CF, ">$conffile");
 448         print CF "[global]\n";
 449         if (defined($ENV{VALGRIND})) {
 450                 print CF "\ticonv:native = true\n";
 451         } else {
 452                 print CF "\ticonv:native = false\n";
 453         }
 454         print CF
 455 "       netbios name = localtest
 456         netbios aliases = localhost
 457 ";
 458         if (defined($vars->{DOMAIN})) {
 459                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 460         }
 461         if (defined($vars->{REALM})) {
 462                 print CF "\trealm = $vars->{REALM}\n";
 463         }
 464         if (defined($vars->{PIDDIR})) {
 465                 print CF "\tpid directory = $vars->{PIDDIR}\n";
 466         }
 467         if (defined($vars->{NCALRPCDIR})) {
 468                 print CF "\tncalrpc dir = $vars->{NCALRPCDIR}\n";
 469         }
 470         if (defined($vars->{WINBINDD_SOCKET_DIR})) {
 471                 print CF "\twinbindd socket directory = $vars->{WINBINDD_SOCKET_DIR}\n";
 472         }
 473         print CF "
 474         js include = $abs_srcdir/scripting/libjs
 475         name resolve order = bcast
 476         interfaces = $interfaces
 477         panic action = $abs_srcdir/script/gdb_backtrace \%PID\% \%PROG\%
 478         max xmit = 32K
 479         notify:inotify = false
 480         ldb:nosync = true
 481         system:anonymous = true
 482 #We don't want to pass our self-tests if the PAC code is wrong
 483         torture:basedir = ./st
 484         gensec:require_pac = true
 485 ";
 486         close(CF);
 487 }
 488
 489
 490 my @torture_options = ();
 491 push (@torture_options, "--configfile=$conffile");
 492 # ensure any one smbtorture call doesn't run too long
 493 push (@torture_options, "--maximum-runtime=$torture_maxtime");
 494 push (@torture_options, "--target=$opt_target");
 495 push (@torture_options, "--option=torture:progress=no") if ($from_build_farm);
 496 push (@torture_options, "--format=subunit");
 497 push (@torture_options, "--option=torture:quick=yes") if ($opt_quick);
 498
 499 $ENV{TORTURE_OPTIONS} = join(' ', @torture_options);
 500 print "OPTIONS $ENV{TORTURE_OPTIONS}\n";
 501
 502 my @todo = ();
 503
 504 my $testsdir = "$srcdir/script/tests";
 505 $ENV{CONFIGURATION} = "--configfile=$conffile";
 506
 507
 508 if ($opt_quick) {
 509         open(IN, "$testsdir/tests_quick.sh|");
 510 } else {
 511         open(IN, "$testsdir/tests_all.sh|");
 512 }
 513 while (<IN>) {
 514         if ($_ eq "-- TEST --\n") {
 515                 my $name = <IN>;
 516                 $name =~ s/\n//g;
 517                 my $env = <IN>;
 518                 $env =~ s/\n//g;
 519                 my $cmdline = <IN>;
 520                 $cmdline =~ s/\n//g;
 521                 push (@todo, [$name, $env, $cmdline])
 522                         if (not defined($tests) or $name =~ /$tests/);
 523         } else {
 524                 print;
 525         }
 526 }
 527 close(IN) or die("Error creating recipe");
 528
 529 my $suitestotal = $#todo + 1;
 530 my $i = 0;
 531 $| = 1;
 532
 533 my %running_envs = ();
 534
 535 sub setup_env($)
 536 {
 537         my ($envname) = @_;
 538
 539         my $testenv_vars;
 540         if (defined($running_envs{$envname})) {
 541                 $testenv_vars = $running_envs{$envname};
 542         } elsif ($envname eq "none") {
 543                 $testenv_vars = {};
 544         } else {
 545                 $testenv_vars = $target->setup_env($envname, $prefix, $socket_wrapper_dir);
 546         }
 547         write_clientconf($conffile, $testenv_vars);
 548         foreach ("PASSWORD", "DOMAIN", "SERVER", "USERNAME", "NETBIOSNAME",
 549                          "KRB5_CONFIG") {
 550                 if (defined($testenv_vars->{$_})) {
 551                         $ENV{$_} = $testenv_vars->{$_};
 552                 } else {
 553                         delete $ENV{$_};
 554                 }
 555         }
 556
 557         $running_envs{$envname} = $testenv_vars;
 558         return $testenv_vars;
 559 }
 560
 561 sub teardown_env($)
 562 {
 563         my ($envname) = @_;
 564         $target->teardown_env($running_envs{$envname});
 565         delete $running_envs{$envname};
 566 }
 567 SocketWrapper::set_default_iface(6);
 568
 569 if ($opt_testenv) {
 570         my $testenv_vars = setup_env("dc");
 571         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 572         my $term = ($ENV{TERM} or "xterm");
 573         system("$term -e 'echo -e \"Welcome to the Samba4 Test environment
 574 This matches the client environment used in make test
 575 smbd is pid `cat \$PIDDIR/smbd.pid`
 576
 577 Some useful environment variables:
 578 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 579 CONFIGURATION=\$CONFIGURATION
 580 SERVER=\$SERVER
 581 NETBIOSNAME=\$NETBIOSNAME\" && bash'");
 582         teardown_env("dc");
 583 } else {
 584         foreach (@todo) {
 585                 $i++;
 586                 my $cmd = $$_[2];
 587                 $cmd =~ s/([\(\)])/\\$1/g;
 588                 my $name = $$_[0];
 589                 my $envname = $$_[1];
 590
 591                 if (skip($name)) {
 592                         print "SKIPPED: $name\n";
 593                         $statistics->{SUITES_SKIPPED}++;
 594                         next;
 595                 }
 596
 597                 setup_env($envname);
 598
 599                 if ($from_build_farm) {
 600                         run_test_buildfarm($name, $cmd, $i, $suitestotal);
 601                 } else {
 602                         run_test_plain($name, $cmd, $i, $suitestotal);
 603                 }
 604
 605                 if (defined($opt_analyse_cmd)) {
 606                         system("$opt_analyse_cmd \"$name\"");
 607                 }
 608
 609                 teardown_env($envname) if ($opt_resetup_env);
 610         }
 611 }
 612
 613 print "\n";
 614
 615 teardown_env($_) foreach (keys %running_envs);
 616
 617 $target->stop();
 618
 619 my $end = time();
 620 my $duration = ($end-$start);
 621 my $numfailed = $#$suitesfailed+1;
 622 if ($numfailed == 0) {
 623         my $ok = $statistics->{TESTS_EXPECTED_OK} + $statistics->{TESTS_EXPECTED_FAIL};
 624         print "ALL OK ($ok tests in $statistics->{SUITES_OK} testsuites)\n";
 625 } else {
 626         unless ($from_build_farm) {
 627                 if (not $opt_immediate and not $opt_verbose) {
 628                         foreach (@$suitesfailed) {
 629                                 print "===============================================================================\n";
 630                                 print "FAIL: $_\n";
 631                                 print $test_output->{$_};
 632                                 print "\n";
 633                         }
 634                 }
 635
 636                 print "FAILED ($statistics->{TESTS_UNEXPECTED_FAIL} failures and $statistics->{TESTS_ERROR} errors in $statistics->{SUITES_FAIL} testsuites)\n";
 637         }
 638 }
 639 print "DURATION: $duration seconds\n";
 640
 641 my $failed = 0;
 642
 643 # if there were any valgrind failures, show them
 644 foreach (<$prefix/valgrind.log*>) {
 645         next unless (-s $_);
 646         system("grep DWARF2.CFI.reader $_ > /dev/null");
 647         if ($? >> 8 == 0) {
 648             print "VALGRIND FAILURE\n";
 649             $failed++;
 650             system("cat $_");
 651         }
 652 }
 653
 654 if ($from_build_farm) {
 655         print "TEST STATUS: $numfailed\n";
 656 }
 657
 658 exit $numfailed;