selftest.pl

samba最新软件

#!/usr/bin/perl
# Bootstrap Samba and run a number of tests against it.
# Copyright (C) 2005-2008 Jelmer Vernooij <[e-mail]>
# Published under the GNU GPL, v3 or later.

=pod

=head1 NAME

selftest - Samba test runner

=head1 SYNOPSIS

selftest --help

selftest [--srcdir=DIR] [--builddir=DIR] [--target=samba4|samba3|win|kvm] [--socket-wrapper] [--quick] [--exclude=FILE] [--include=FILE] [--one] [--prefix=prefix] [--immediate] [--testlist=FILE] [TESTS]

=head1 DESCRIPTION

A simple test runner. TESTS is a regular expression with tests to run.

=head1 OPTIONS

=over 4

=item I<--help>

Show list of available options.

=item I<--srcdir=DIR>

Source directory.

=item I<--builddir=DIR>

Build directory.

=item I<--prefix=DIR>

Change directory to run tests in. Default is 'st'.

=item I<--immediate>

Show errors as soon as they happen rather than at the end of the test run.
		
=item I<--target samba4|samba3|win|kvm>

Specify test target against which to run. Default is 'samba4'.

=item I<--quick>

Run only a limited number of tests. Intended to run in about 30 seconds on 
moderately recent systems.
		
=item I<--socket-wrapper>

Use socket wrapper library for communication with server. Only works 
when the server is running locally.

Will prevent TCP and UDP ports being opened on the local host but 
(transparently) redirects these calls to use unix domain sockets.

=item I<--expected-failures>

Specify a file containing a list of tests that are expected to fail. Failures for 
these tests will be counted as successes, successes will be counted as failures.

The format for the file is, one entry per line:

TESTSUITE-NAME.TEST-NAME

The reason for a test can also be specified, by adding a hash sign (#) and the reason 
after the test name.

=item I<--exclude>

Specify a file containing a list of tests that should be skipped. Possible 
candidates are tests that segfault the server, flip or don't end. The format of this file is the same as 
for the --expected-failures flag.

=item I<--include>

Specify a file containing a list of tests that should be run. Same format 
as the --exclude flag.

Not includes specified means all tests will be run.

=item I<--one>

Abort as soon as one test fails.

=item I<--testlist>

Load a list of tests from the specified location.

=back

=head1 ENVIRONMENT

=over 4

=item I<SMBD_VALGRIND>

=item I<TORTURE_MAXTIME>

=item I<VALGRIND>

=item I<TLS_ENABLED>

=item I<srcdir>

=back

=head1 LICENSE

selftest is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.

=head1 AUTHOR

Jelmer Vernooij

=cut

use strict;

use FindBin qw($RealBin $Script);
use File::Spec;
use Getopt::Long;
use POSIX;
use Cwd qw(abs_path);
use lib "$RealBin";
use Subunit qw(parse_results);
use SocketWrapper;

my $opt_help = 0;
my $opt_target = "samba4";
my $opt_quick = 0;
my $opt_socket_wrapper = 0;
my $opt_socket_wrapper_pcap = undef;
my $opt_socket_wrapper_keep_pcap = undef;
my $opt_one = 0;
my $opt_immediate = 0;
my $opt_expected_failures = undef;
my @opt_exclude = ();
my @opt_include = ();
my $opt_verbose = 0;
my $opt_image = undef;
my $opt_testenv = 0;
my $ldap = undef;
my $opt_analyse_cmd = undef;
my $opt_resetup_env = undef;
my $opt_bindir = undef;
my $opt_no_lazy_setup = undef;
my $opt_format = "plain";
my @testlists = ();

my $srcdir = ".";
my $builddir = ".";
my $prefix = "./st";

my @expected_failures = ();
my @includes = ();
my @excludes = ();

my $statistics = {
	SUITES_FAIL => 0,

	TESTS_UNEXPECTED_OK => 0,
	TESTS_EXPECTED_OK => 0,
	TESTS_UNEXPECTED_FAIL => 0,
	TESTS_EXPECTED_FAIL => 0,
	TESTS_ERROR => 0,
	TESTS_SKIP => 0,
};

sub find_in_list($$)
{
	my ($list, $fullname) = @_;

	foreach (@$list) {
		if ($fullname =~ /$$_[0]/) {
			 return ($$_[1]) if ($$_[1]);
			 return "NO REASON SPECIFIED";
		}
	}

	return undef;
}

sub expecting_failure($)
{
	my ($name) = @_;
	return find_in_list(\@expected_failures, $name);
}

sub skip($)
{
	my ($name) = @_;

	return find_in_list(\@excludes, $name);
}

sub getlog_env($);

sub setup_pcap($)
{
	my ($name) = @_;

	return unless ($opt_socket_wrapper_pcap);
	return unless defined($ENV{SOCKET_WRAPPER_PCAP_DIR});

	my $fname = $name;
	$fname =~ s%[^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789\-]%_%g;

	my $pcap_file = "$ENV{SOCKET_WRAPPER_PCAP_DIR}/$fname.pcap";

	SocketWrapper::setup_pcap($pcap_file);

	return $pcap_file;
}

sub cleanup_pcap($$$)
{
	my ($pcap_file, $expected_ret, $ret) = @_;

	return unless ($opt_socket_wrapper_pcap);
	return if ($opt_socket_wrapper_keep_pcap);
	return unless ($expected_ret == $ret);
	return unless defined($pcap_file);

	unlink($pcap_file);
}

sub run_testsuite($$$$$$)
{
	my ($envname, $name, $cmd, $i, $totalsuites, $msg_ops) = @_;
	my $pcap_file = setup_pcap($name);

	$msg_ops->start_test([], $name);

	unless (open(RESULT, "$cmd 2>&1|")) {
		$statistics->{TESTS_ERROR}++;
		$msg_ops->end_test([], $name, "error", 1, "Unable to run $cmd: $!");
		$statistics->{SUITES_FAIL}++;
		return 0;
	}

	my $expected_ret = parse_results(
		$msg_ops, $statistics, *RESULT, \&expecting_failure, [$name]);

	my $envlog = getlog_env($envname);
	$msg_ops->output_msg("ENVLOG: $envlog\n") if ($envlog ne "");

	$msg_ops->output_msg("CMD: $cmd\n");

	my $ret = close(RESULT);
	$ret = 0 unless $ret == 1;

	my $exitcode = $? >> 8;

	if ($ret == 1) {
		$msg_ops->end_test([], $name, "success", $expected_ret != $ret, undef); 
	} else {
		$msg_ops->end_test([], $name, "failure", $expected_ret != $ret, "Exit code was $exitcode");
	}

	cleanup_pcap($pcap_file, $expected_ret, $ret);

	if (not $opt_socket_wrapper_keep_pcap and defined($pcap_file)) {
		$msg_ops->output_msg("PCAP FILE: $pcap_file\n");
	}

	if ($ret != $expected_ret) {
		$statistics->{SUITES_FAIL}++;
		exit(1) if ($opt_one);
	}

	return ($ret == $expected_ret);
}

sub ShowHelp()
{
	print "Samba test runner
Copyright (C) Jelmer Vernooij <jelmer\@samba.org>

Usage: $Script [OPTIONS] PREFIX

Generic options:
 --help                     this help page
 --target=samba[34]|win|kvm Samba version to target
 --testlist=FILE			file to read available tests from

Paths:
 --prefix=DIR               prefix to run tests in [st]
 --srcdir=DIR               source directory [.]
 --builddir=DIR             output directory [.]

Target Specific:
 --socket-wrapper-pcap		save traffic to pcap directories
 --socket-wrapper-keep-pcap keep all pcap files, not just those for tests that 
                            failed
 --socket-wrapper           enable socket wrapper
 --expected-failures=FILE   specify list of tests that is guaranteed to fail

Samba4 Specific:
 --ldap=openldap|fedora-ds     back smbd onto specified ldap server

Samba3 Specific:
 --bindir=PATH              path to binaries

Kvm Specific:
 --image=PATH               path to KVM image

Behaviour:
 --quick                    run quick overall test
 --one                      abort when the first test fails
 --immediate                print test output for failed tests during run
 --verbose                  be verbose
 --analyse-cmd CMD          command to run after each test
";
	exit(0);
}

my $result = GetOptions (
		'help|h|?' => \$opt_help,
		'target=s' => \$opt_target,
		'prefix=s' => \$prefix,
		'socket-wrapper' => \$opt_socket_wrapper,
		'socket-wrapper-pcap' => \$opt_socket_wrapper_pcap,
		'socket-wrapper-keep-pcap' => \$opt_socket_wrapper_keep_pcap,
		'quick' => \$opt_quick,
		'one' => \$opt_one,
		'immediate' => \$opt_immediate,
		'expected-failures=s' => \$opt_expected_failures,
		'exclude=s' => \@opt_exclude,
		'include=s' => \@opt_include,
		'srcdir=s' => \$srcdir,
		'builddir=s' => \$builddir,
		'verbose' => \$opt_verbose,
		'testenv' => \$opt_testenv,
		'ldap:s' => \$ldap,
		'analyse-cmd=s' => \$opt_analyse_cmd,
		'no-lazy-setup' => \$opt_no_lazy_setup,
		'resetup-environment' => \$opt_resetup_env,
		'bindir:s' => \$opt_bindir,
		'format=s' => \$opt_format,
		'image=s' => \$opt_image,
		'testlist=s' => \@testlists
	    );

exit(1) if (not $result);

ShowHelp() if ($opt_help);

my $tests = shift;

# quick hack to disable rpc validation when using valgrind - its way too slow
unless (defined($ENV{VALGRIND})) {
	$ENV{VALIDATE} = "validate";
	$ENV{MALLOC_CHECK_} = 2;
}

my $old_pwd = "$RealBin/..";

# Backwards compatibility:
if (defined($ENV{TEST_LDAP}) and $ENV{TEST_LDAP} eq "yes") {
	if (defined($ENV{FEDORA_DS_ROOT})) {
		$ldap = "fedora-ds";
	} else {
		$ldap = "openldap";
	}
}

my $torture_maxtime = ($ENV{TORTURE_MAXTIME} or 1200);
if ($ldap) {
	# LDAP is slow
	$torture_maxtime *= 2;
}

$prefix =~ s+//+/+;
$prefix =~ s+/./+/+;
$prefix =~ s+/$++;

die("using an empty prefix isn't allowed") unless $prefix ne "";

#Ensure we have the test prefix around
mkdir($prefix, 0777) unless -d $prefix;

my $prefix_abs = abs_path($prefix);
my $srcdir_abs = abs_path($srcdir);

die("using an empty absolute prefix isn't allowed") unless $prefix_abs ne "";
die("using '/' as absolute prefix isn't allowed") unless $prefix_abs ne "/";

$ENV{PREFIX} = $prefix;
$ENV{KRB5CCNAME} = "$prefix/krb5ticket";
$ENV{PREFIX_ABS} = $prefix_abs;
$ENV{SRCDIR} = $srcdir;
$ENV{SRCDIR_ABS} = $srcdir_abs;

if (defined($ENV{RUN_FROM_BUILD_FARM}) and 
	($ENV{RUN_FROM_BUILD_FARM} eq "yes")) {
	$opt_format = "buildfarm";
}

my $tls_enabled = not $opt_quick;
$ENV{TLS_ENABLED} = ($tls_enabled?"yes":"no");
$ENV{LDB_MODULES_PATH} = "$old_pwd/bin/modules/ldb";
$ENV{LD_SAMBA_MODULE_PATH} = "$old_pwd/bin/modules";
sub prefix_pathvar($$)
{
	my ($name, $newpath) = @_;
	if (defined($ENV{$name})) {
		$ENV{$name} = "$newpath:$ENV{$name}";
	} else {
		$ENV{$name} = $newpath;
	}
}
prefix_pathvar("PKG_CONFIG_PATH", "$old_pwd/bin/pkgconfig");
# Required for smbscript:
prefix_pathvar("PATH", "$old_pwd/bin");
prefix_pathvar("PYTHONPATH", "$old_pwd/bin/python");

if ($opt_socket_wrapper_keep_pcap) {
	# Socket wrapper keep pcap implies socket wrapper pcap
	$opt_socket_wrapper_pcap = 1;
}

if ($opt_socket_wrapper_pcap) {
	# Socket wrapper pcap implies socket wrapper
	$opt_socket_wrapper = 1;
}

my $socket_wrapper_dir;
if ($opt_socket_wrapper) {
	$socket_wrapper_dir = SocketWrapper::setup_dir("$prefix/w", $opt_socket_wrapper_pcap);
	print "SOCKET_WRAPPER_DIR=$socket_wrapper_dir\n";
} else {