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                 push(@$suitesfailed, $name);
 227                 print "TEST FAILED: $name (status $ret)\n";
 228         }
 229         print "==========================================\n";
 230 }
 231
 232 my $test_output = {};
 233 sub run_test_plain($$$$)
 234 {
 235         my ($name, $cmd, $i, $totalsuites) = @_;
 236         my $err = "";
 237         if ($#$suitesfailed+1 > 0) { $err = ", ".($#$suitesfailed+1)." errors"; }
 238         print "[$i/$totalsuites in " . (time() - $start)."s$err] $name\n";
 239         open(RESULT, "$cmd 2>&1|");
 240         my $expected_ret = 1;
 241         my $open_tests = {};
 242         $test_output->{$name} = "";
 243         while (<RESULT>) {
 244                 $test_output->{$name}.=$_;
 245                 print if ($opt_verbose);
 246                 if (/^test: (.+)\n/) {
 247                         $open_tests->{$1} = 1;
 248                 } elsif (/^(success|failure|skip|error): (.*?)( \[)?\n/) {
 249                         my $result = $1;
 250                         if ($1 eq "success") {
 251                                 delete $open_tests->{$2};
 252                                 if (expecting_failure("$name/$2")) {
 253                                         $statistics->{TESTS_UNEXPECTED_OK}++;
 254                                 } else {
 255                                         $statistics->{TESTS_EXPECTED_OK}++;
 256                                 }
 257                         } elsif ($1 eq "failure") {
 258                                 delete $open_tests->{$2};
 259                                 if (expecting_failure("$name/$2")) {
 260                                         $statistics->{TESTS_EXPECTED_FAIL}++;
 261                                         $expected_ret = 0;
 262                                 } else {
 263                                         $statistics->{TESTS_UNEXPECTED_FAIL}++;
 264                                 }
 265                         } elsif ($1 eq "skip") {
 266                                 delete $open_tests->{$2};
 267                         } elsif ($1 eq "error") {
 268                                 $statistics->{TESTS_ERROR}++;
 269                                 delete $open_tests->{$2};
 270                         }
 271                 }
 272         }
 273         $test_output->{$name}.="COMMAND: $cmd\n";
 274         foreach (keys %$open_tests) {
 275                 $test_output->{$name}.="$_ was started but never finished!\n";
 276                 $statistics->{TESTS_ERROR}++;
 277         }
 278         my $ret = close(RESULT);
 279         if ($ret != $expected_ret and ($opt_immediate or $opt_one) and not $opt_verbose) {
 280                 print "$test_output->{$name}\n";
 281         }
 282         if ($ret != $expected_ret) {
 283                 push(@$suitesfailed, $name);
 284                 $statistics->{SUITES_FAIL}++;
 285                 exit(1) if ($opt_one);
 286         } else {
 287                 $statistics->{SUITES_OK}++;
 288         }
 289 }
 290
 291 sub ShowHelp()
 292 {
 293         print "Samba test runner
 294 Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
 295
 296 Usage: $Script [OPTIONS] PREFIX
 297
 298 Generic options:
 299  --help                     this help page
 300
 301 Paths:
 302  --prefix=DIR               prefix to run tests in [st]
 303  --srcdir=DIR               source directory [.]
 304  --builddir=DIR             output directory [.]
 305
 306 Target Specific:
 307  --target=samba4|samba3|win Samba version to target
 308  --socket-wrapper-pcap=FILE save traffic to pcap file
 309  --socket-wrapper           enable socket wrapper
 310  --expected-failures=FILE   specify list of tests that is guaranteed to fail
 311  --ldap                     run against ldap
 312
 313 Behaviour:
 314  --quick                    run quick overall test
 315  --one                      abort when the first test fails
 316  --immediate                print test output for failed tests during run
 317  --verbose                  be verbose
 318  --analyse-cmd CMD          command to run after each test
 319 ";
 320         exit(0);
 321 }
 322
 323 my $result = GetOptions (
 324             'help|h|?' => \$opt_help,
 325                 'target=s' => \$opt_target,
 326                 'prefix=s' => \$prefix,
 327                 'socket-wrapper' => \$opt_socket_wrapper,
 328                 'socket-wrapper-pcap=s' => \$opt_socket_wrapper_pcap,
 329                 'quick' => \$opt_quick,
 330                 'one' => \$opt_one,
 331                 'immediate' => \$opt_immediate,
 332                 'expected-failures=s' => \$opt_expected_failures,
 333                 'skip=s' => \$opt_skip,
 334                 'srcdir=s' => \$srcdir,
 335                 'builddir=s' => \$builddir,
 336                 'verbose' => \$opt_verbose,
 337                 'testenv' => \$opt_testenv,
 338                 'ldap' => \$opt_ldap,
 339                 'analyse-cmd=s' => \$opt_analyse_cmd,
 340                 'resetup-environment' => \$opt_resetup_env,
 341             );
 342
 343 exit(1) if (not $result);
 344
 345 ShowHelp() if ($opt_help);
 346
 347 my $tests = shift;
 348
 349 # quick hack to disable rpc validation when using valgrind - its way too slow
 350 unless (defined($ENV{VALGRIND})) {
 351         $ENV{VALIDATE} = "validate";
 352     $ENV{MALLOC_CHECK_} = 2;
 353 }
 354
 355 my $old_pwd = "$RealBin/../..";
 356 my $ldap = 0;
 357 if (defined($ENV{TEST_LDAP})) {
 358         $ldap = ($ENV{TEST_LDAP} eq "yes");
 359 }
 360 if (defined($opt_ldap)) {
 361         $ldap = $opt_ldap;
 362 }
 363
 364 my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
 365 if ($ldap) {
 366         # LDAP is slow
 367         $torture_maxtime *= 2;
 368 }
 369
 370 $prefix =~ s+//+/+;
 371 $ENV{PREFIX} = $prefix;
 372 $ENV{SRCDIR} = $srcdir;
 373
 374 #Ensure we have the test prefix around
 375 mkdir $prefix unless -d $prefix;
 376
 377 my $tls_enabled = not $opt_quick;
 378 my $from_build_farm = (defined($ENV{RUN_FROM_BUILD_FARM}) and
 379                       ($ENV{RUN_FROM_BUILD_FARM} eq "yes"));
 380
 381 $ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
 382 $ENV{LD_LDB_MODULE_PATH} = "$old_pwd/bin/modules/ldb";
 383 $ENV{LD_SAMBA_MODULE_PATH} = "$old_pwd/bin/modules";
 384 if (defined($ENV{LD_LIBRARY_PATH})) {
 385         $ENV{LD_LIBRARY_PATH} = "$old_pwd/bin/shared:$ENV{LD_LIBRARY_PATH}";
 386 } else {
 387         $ENV{LD_LIBRARY_PATH} = "$old_pwd/bin/shared";
 388 }
 389 $ENV{PKG_CONFIG_PATH} = "$old_pwd/bin/pkgconfig:$ENV{PKG_CONFIG_PATH}";
 390 $ENV{PATH} = "$old_pwd/bin:$ENV{PATH}";
 391
 392 if ($opt_socket_wrapper_pcap) {
 393         SocketWrapper::setup_pcap($opt_socket_wrapper_pcap);
 394         # Socket wrapper pcap implies socket wrapper
 395         $opt_socket_wrapper = 1;
 396 }
 397
 398 my $socket_wrapper_dir;
 399 if ($opt_socket_wrapper) {
 400         $socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w");
 401         print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
 402 } else {
 403         warn("Not using socket wrapper, but also not running as root. Will not be able to listen on proper ports") unless $< == 0;
 404 }
 405
 406 my $target;
 407
 408 if ($opt_target eq "samba4") {
 409         $target = new Samba4("$srcdir/bin", $ldap, "$srcdir/setup");
 410 } elsif ($opt_target eq "samba3") {
 411         $target = new Samba3("$srcdir/bin", "$srcdir/setup");
 412 } elsif ($opt_target eq "win") {
 413         die("Windows tests will not run with socket wrapper enabled.")
 414                 if ($opt_socket_wrapper);
 415         $target = new Windows();
 416 }
 417
 418 if (defined($opt_expected_failures)) {
 419         open(KNOWN, "<$opt_expected_failures") or die("unable to read known failures file: $!");
 420         while (<KNOWN>) {
 421                 chomp;
 422                 s/([ \t]+)\#(.*)$//;
 423                 push (@expected_failures, $_); }
 424         close(KNOWN);
 425 }
 426
 427 if (defined($opt_skip)) {
 428         open(SKIP, "<$opt_skip") or die("unable to read skip file: $!");
 429         while (<SKIP>) {
 430                 chomp;
 431                 s/([ \t]+)\#(.*)$//;
 432                 push (@skips, $_); }
 433         close(SKIP);
 434 }
 435
 436 my $interfaces = join(',', ("127.0.0.6/8",
 437                                  "127.0.0.7/8",
 438                                                  "127.0.0.8/8",
 439                                                  "127.0.0.9/8",
 440                                                  "127.0.0.10/8",
 441                                                  "127.0.0.11/8"));
 442
 443 my $conffile = "$prefix/client.conf";
 444
 445 sub write_clientconf($$)
 446 {
 447         my ($conffile, $vars) = @_;
 448
 449         my $abs_srcdir = cwd();
 450
 451         mkdir "$prefix/client" unless -d "$prefix/client";
 452
 453         if ( -d "$prefix/client/private" ) {
 454                 unlink <$prefix/client/private/*>;
 455         } else {
 456                 mkdir("$prefix/client/private");
 457         }
 458
 459         open(CF, ">$conffile");
 460         print CF "[global]\n";
 461         if (defined($ENV{VALGRIND})) {
 462                 print CF "\ticonv:native = true\n";
 463         } else {
 464                 print CF "\ticonv:native = false\n";
 465         }
 466         print CF
 467 "       netbios name = client
 468 ";
 469         if (defined($vars->{DOMAIN})) {
 470                 print CF "\tworkgroup = $vars->{DOMAIN}\n";
 471         }
 472         if (defined($vars->{REALM})) {
 473                 print CF "\trealm = $vars->{REALM}\n";
 474         }
 475         if (defined($vars->{NCALRPCDIR})) {
 476                 print CF "\tncalrpc dir = $vars->{NCALRPCDIR}\n";
 477         }
 478         if (defined($vars->{PIDDIR})) {
 479                 print CF "\tpid directory = $vars->{PIDDIR}\n";
 480         }
 481         if (defined($vars->{WINBINDD_SOCKET_DIR})) {
 482                 print CF "\twinbindd socket directory = $vars->{WINBINDD_SOCKET_DIR}\n";
 483         }
 484         print CF "
 485         private dir = $abs_srcdir/$prefix/client/private
 486         js include = $abs_srcdir/scripting/libjs
 487         name resolve order = bcast
 488         interfaces = $interfaces
 489         panic action = $abs_srcdir/script/gdb_backtrace \%PID\% \%PROG\%
 490         max xmit = 32K
 491         notify:inotify = false
 492         ldb:nosync = true
 493         system:anonymous = true
 494         torture:basedir = ./st
 495 #We don't want to pass our self-tests if the PAC code is wrong
 496         gensec:require_pac = true
 497 ";
 498         close(CF);
 499 }
 500
 501
 502 my @torture_options = ();
 503 push (@torture_options, "--configfile=$conffile");
 504 # ensure any one smbtorture call doesn't run too long
 505 push (@torture_options, "--maximum-runtime=$torture_maxtime");
 506 push (@torture_options, "--target=$opt_target");
 507 push (@torture_options, "--option=torture:progress=no") if ($from_build_farm);
 508 push (@torture_options, "--format=subunit");
 509 push (@torture_options, "--option=torture:quick=yes") if ($opt_quick);
 510
 511 $ENV{TORTURE_OPTIONS} = join(' ', @torture_options);
 512 print "OPTIONS $ENV{TORTURE_OPTIONS}\n";
 513
 514 my @todo = ();
 515
 516 my $testsdir = "$srcdir/script/tests";
 517 $ENV{CONFIGURATION} = "--configfile=$conffile";
 518
 519
 520 if ($opt_quick) {
 521         open(IN, "$testsdir/tests_quick.sh|");
 522 } else {
 523         open(IN, "$testsdir/tests_all.sh|");
 524 }
 525 while (<IN>) {
 526         if ($_ eq "-- TEST --\n") {
 527                 my $name = <IN>;
 528                 $name =~ s/\n//g;
 529                 my $env = <IN>;
 530                 $env =~ s/\n//g;
 531                 my $cmdline = <IN>;
 532                 $cmdline =~ s/\n//g;
 533                 push (@todo, [$name, $env, $cmdline])
 534                         if (not defined($tests) or $name =~ /$tests/);
 535         } else {
 536                 print;
 537         }
 538 }
 539 close(IN) or die("Error creating recipe");
 540
 541 my $suitestotal = $#todo + 1;
 542 my $i = 0;
 543 $| = 1;
 544
 545 my %running_envs = ();
 546
 547 sub setup_env($)
 548 {
 549         my ($envname) = @_;
 550
 551         my $testenv_vars;
 552         if (defined($running_envs{$envname})) {
 553                 $testenv_vars = $running_envs{$envname};
 554         } elsif ($envname eq "none") {
 555                 $testenv_vars = {};
 556         } else {
 557                 $testenv_vars = $target->setup_env($envname, $prefix);
 558         }
 559         write_clientconf($conffile, $testenv_vars);
 560         foreach ("PASSWORD", "DOMAIN", "SERVER", "USERNAME", "NETBIOSNAME",
 561                          "KRB5_CONFIG") {
 562                 if (defined($testenv_vars->{$_})) {
 563                         $ENV{$_} = $testenv_vars->{$_};
 564                 } else {
 565                         delete $ENV{$_};
 566                 }
 567         }
 568
 569         $running_envs{$envname} = $testenv_vars;
 570         return $testenv_vars;
 571 }
 572
 573 sub teardown_env($)
 574 {
 575         my ($envname) = @_;
 576         $target->teardown_env($running_envs{$envname});
 577         delete $running_envs{$envname};
 578 }
 579 SocketWrapper::set_default_iface(6);
 580
 581 if ($opt_testenv) {
 582         my $testenv_vars = setup_env("dc");
 583         $ENV{PIDDIR} = $testenv_vars->{PIDDIR};
 584         my $term = ($ENV{TERM} or "xterm");
 585         system("$term -e 'echo -e \"Welcome to the Samba4 Test environment
 586 This matches the client environment used in make test
 587 smbd is pid `cat \$PIDDIR/smbd.pid`
 588
 589 Some useful environment variables:
 590 TORTURE_OPTIONS=\$TORTURE_OPTIONS
 591 CONFIGURATION=\$CONFIGURATION
 592 SERVER=\$SERVER
 593 NETBIOSNAME=\$NETBIOSNAME\" && bash'");
 594         teardown_env("dc");
 595 } else {
 596         foreach (@todo) {
 597                 $i++;
 598                 my $cmd = $$_[2];
 599                 $cmd =~ s/([\(\)])/\\$1/g;
 600                 my $name = $$_[0];
 601                 my $envname = $$_[1];
 602
 603                 if (skip($name)) {
 604                         print "SKIPPED: $name\n";
 605                         $statistics->{SUITES_SKIPPED}++;
 606                         next;
 607                 }
 608
 609                 setup_env($envname);
 610
 611                 if ($from_build_farm) {
 612                         run_test_buildfarm($name, $cmd, $i, $suitestotal);
 613                 } else {
 614                         run_test_plain($name, $cmd, $i, $suitestotal);
 615                 }
 616
 617                 if (defined($opt_analyse_cmd)) {
 618                         system("$opt_analyse_cmd \"$name\"");
 619                 }
 620
 621                 teardown_env($envname) if ($opt_resetup_env);
 622         }
 623 }
 624
 625 print "\n";
 626
 627 teardown_env($_) foreach (keys %running_envs);
 628
 629 $target->stop();
 630
 631 my $end = time();
 632 my $duration = ($end-$start);
 633 my $numfailed = $#$suitesfailed+1;
 634 if ($numfailed == 0) {
 635         my $ok = $statistics->{TESTS_EXPECTED_OK} + $statistics->{TESTS_EXPECTED_FAIL};
 636         print "ALL OK ($ok tests in $statistics->{SUITES_OK} testsuites)\n";
 637 } else {
 638         unless ($from_build_farm) {
 639                 if (not $opt_immediate and not $opt_verbose) {
 640                         foreach (@$suitesfailed) {
 641                                 print "===============================================================================\n";
 642                                 print "FAIL: $_\n";
 643                                 print $test_output->{$_};
 644                                 print "\n";
 645                         }
 646                 }
 647
 648                 print "FAILED ($statistics->{TESTS_UNEXPECTED_FAIL} failures and $statistics->{TESTS_ERROR} errors in $statistics->{SUITES_FAIL} testsuites)\n";
 649         }
 650 }
 651 print "DURATION: $duration seconds\n";
 652
 653 my $failed = 0;
 654
 655 # if there were any valgrind failures, show them
 656 foreach (<$prefix/valgrind.log*>) {
 657         next unless (-s $_);
 658         system("grep DWARF2.CFI.reader $_ > /dev/null");
 659         if ($? >> 8 == 0) {
 660             print "VALGRIND FAILURE\n";
 661             $failed++;
 662             system("cat $_");
 663         }
 664 }
 665
 666 if ($from_build_farm) {
 667         print "TEST STATUS: $numfailed\n";
 668 }
 669
 670 exit $numfailed;