dtest.pl   [plain text]

#!/usr/bin/perl
##!/usr/perl5/bin/perl
#
# CDDL HEADER START
#
# The contents of this file are subject to the terms of the
# Common Development and Distribution License (the "License").
# You may not use this file except in compliance with the License.
#
# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
# or http://www.opensolaris.org/os/licensing.
# See the License for the specific language governing permissions
# and limitations under the License.
#
# When distributing Covered Code, include this CDDL HEADER in each
# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
# If applicable, add the following below this CDDL HEADER, with the
# fields enclosed by brackets "[]" replaced with your own identifying
# information: Portions Copyright [yyyy] [name of copyright owner]
#
# CDDL HEADER END
#

#
# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
#ident	"@(#)dtest.pl	1.1	06/08/28 SMI"

require 5.6.1;

use File::Find;
use File::Basename;
use Getopt::Std;
use Cwd;

$PNAME = $0;
$PNAME =~ s:.*/::;
$USAGE = "Usage: $PNAME [-abghlqsu] [-d dir] [-i isa] "
    . "[-x opt[=arg]] [file | dir ...]\n";
($MACH = `uname -p`) =~ s/\W*\n//;

$dtrace_path = '/usr/sbin/dtrace';
@dtrace_argv = ();

## $ksh_path = '/usr/bin/ksh';
$ksh_path = '/bin/ksh';

@files = ();
$errs = 0;
$bypassed = 0;

#
# If no test files are specified on the command-line, execute a find on "."
# and append any tst.*.d, tst.*.ksh, err.*.d or drp.*.d files found within
# the directory tree.
#
sub wanted
{
	push(@files, $File::Find::name)
	    if ($_ =~ /^(tst|err|drp)\..+\.(d|ksh)$/ && -f "$_");
}

sub dirname {
	my($s) = @_;
	my($i);

	$s = substr($s, 0, $i) if (($i = rindex($s, '/')) != -1);
	return $i == -1 ? '.' : $i == 0 ? '/' : $s;
}

sub usage
{
	print $USAGE;
	print "\t -a  execute test suite using anonymous enablings\n";
	print "\t -b  execute bad ioctl test program\n";
	print "\t -d  specify directory for test results files and cores\n";
	print "\t -g  enable libumem debugging when running tests\n";
	print "\t -h  display verbose usage message\n";
	print "\t -i  specify ISA to test instead of isaexec(3C) default\n";
	print "\t -l  save log file of results and PIDs used by tests\n";
	print "\t -q  set quiet mode (only report errors and summary)\n";
	print "\t -s  save results files even for tests that pass\n";
	print "\t -x  pass corresponding -x argument to dtrace(1M)\n";
	exit(2);
}

sub errmsg
{
	my($msg) = @_;

	print STDERR $msg;
	print LOG $msg if ($opt_l);
	$errs++;
}

sub fail
{
	my(@parms) = @_;
	my($msg) = $parms[0];
	my($errfile) = $parms[1];
	my($n) = 0;
	my($dest) = basename($file);

	while (-d "$opt_d/failure.$n") {
		$n++;
	}

	unless (mkdir "$opt_d/failure.$n") {
		warn "ERROR: failed to make directory $opt_d/failure.$n: $!\n";
		exit(125);
	}

	open(README, ">$opt_d/failure.$n/README");
	print README "ERROR: " . $file . " " . $msg;
	
	if (scalar @parms > 1) {
		print README "; see $errfile\n";
	} else {
		if (-f "$opt_d/$pid.core") {
			print README "; see $pid.core\n";
		} else {
			print README "\n";
		}
	}

	close(README);

	if (-f "$opt_d/$pid.out") {
		rename("$opt_d/$pid.out", "$opt_d/failure.$n/$pid.out");
		link("$file.out", "$opt_d/failure.$n/$dest.out");
	}

	if (-f "$opt_d/$pid.err") {
		rename("$opt_d/$pid.err", "$opt_d/failure.$n/$pid.err");
		link("$file.err", "$opt_d/failure.$n/$dest.err");
	}

	if (-f "$opt_d/$pid.core") {
		rename("$opt_d/$pid.core", "$opt_d/failure.$n/$pid.core");
	}

	link("$file", "$opt_d/failure.$n/$dest");

	$msg = "ERROR: " . $dest . " " . $msg;

	if (scalar @parms > 1) {
		$msg = $msg . "; see $errfile in failure.$n\n";
	} else {
		$msg = $msg . "; details in failure.$n\n";
	}

	errmsg($msg);
}

sub logmsg
{
	my($msg) = @_;

	print STDOUT $msg unless ($opt_q);
	print LOG $msg if ($opt_l);
}

die $USAGE unless (getopts('abd:ghi:lqsux:'));
usage() if ($opt_h);

foreach $arg (@ARGV) {
	if (-f $arg) {
		push(@files, $arg);
	} elsif (-d $arg) {
		find(\&wanted, $arg);
	} else {
		die "$PNAME: $arg is not a valid file or directory\n";
	}
}

## $defdir = -d '/opt/SUNWdtrt/tst' ? '/opt/SUNWdtrt/tst' : '.';
## $bindir = -d '/opt/SUNWdtrt/bin' ? '/opt/SUNWdtrt/bin' : '.';
$defdir = '.';
$bindir = '.';

find(\&wanted, "$defdir/common") if (scalar(@ARGV) == 0);
find(\&wanted, "$defdir/$MACH") if (scalar(@ARGV) == 0);
die $USAGE if (scalar(@files) == 0);

if ($opt_d) {
	die "$PNAME: -d arg must be absolute path\n" unless ($opt_d =~ /^\//);
	die "$PNAME: -d arg $opt_d is not a directory\n" unless (-d "$opt_d");
##	system("coreadm -p $opt_d/%p.core");
} else {
	my $dir = getcwd;
##	system("coreadm -p $dir/%p.core");
	$opt_d = '.';
}

if ($opt_i) {
	$dtrace_path = "/usr/sbin/$opt_i/dtrace";
	die "$PNAME: dtrace(1M) for ISA $opt_i not found\n"
	    unless (-x "$dtrace_path");
}

if ($opt_x) {
	push(@dtrace_argv, '-x');
	push(@dtrace_argv, $opt_x);
}

die "$PNAME: failed to open $PNAME.$$.log: $!\n"
    unless (!$opt_l || open(LOG, ">$PNAME.$$.log"));

## if ($opt_g) {
## 	$ENV{'UMEM_DEBUG'} = 'default,verbose';
## 	$ENV{'UMEM_LOGGING'} = 'fail,contents';
## 	$ENV{'LD_PRELOAD'} = 'libumem.so';
## }

#
# Ensure that $PATH contains a cc(1) so that we can execute the
# test programs that require compilation of C code.
#
## $ENV{'PATH'} = $ENV{'PATH'} . ':/ws/on10-tools/SUNWspro/SOS8/bin';
$ENV{'PATH'} = $ENV{'PATH'} . ':/usr/bin';

if ($opt_b) {
	logmsg("badioctl'ing ... ");

	if (($badioctl = fork()) == -1) {
		errmsg("ERROR: failed to fork to run badioctl: $!\n");
		next;
	}

	if ($badioctl == 0) {
		open(STDIN, '</dev/null');
		exit(125) unless open(STDOUT, ">$opt_d/$$.out");
		exit(125) unless open(STDERR, ">$opt_d/$$.err");

		exec($bindir . "/badioctl");
		warn "ERROR: failed to exec badioctl: $!\n";
		exit(127);
	}


	logmsg("[$badioctl]\n");

	#
	# If we're going to be bad, we're just going to iterate over each
	# test file.
	#
	foreach $file (sort @files) {
		($name = $file) =~ s:.*/::;
		$dir = dirname($file);

		if (!($name =~ /^tst\./ && $name =~ /\.d$/)) {
			next;
		}

		logmsg("baddof'ing $file ... ");

		if (($pid = fork()) == -1) {
			errmsg("ERROR: failed to fork to run baddof: $!\n");
			next;
		}

		if ($pid == 0) {
			open(STDIN, '</dev/null');
			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
			exit(125) unless open(STDERR, ">$opt_d/$$.err");

			unless (chdir($dir)) {
				warn "ERROR: failed to chdir for $file: $!\n";
				exit(126);
			}

			exec($bindir . "/baddof", $name);

			warn "ERROR: failed to exec for $file: $!\n";
			exit(127);
		}

		sleep 60;
		kill(9, $pid);
		waitpid($pid, 0);

		logmsg("[$pid]\n");

		unless ($opt_s) {
			unlink($pid . '.out');
			unlink($pid . '.err');
		}
	}

	kill(9, $badioctl);
	waitpid($badioctl, 0);

	unless ($opt_s) {
		unlink($badioctl . '.out');
		unlink($badioctl . '.err');
	}

	exit(0);
}

if ($opt_u) {
	logmsg "spawning module unloading process... ";

	$unloader = fork;

	if ($unloader != 0 && !defined $unloader) {
		#
		# Couldn't fork for some reason.
		#
		die "couldn't fork: $!\n";
	}

	if ($unloader == 0) {
		#
		# We're in the child.  Go modunload krazy.
		#
		for (;;) {
			system("modunload -i 0");
		}
	} else {
		logmsg "[$unloader]\n";

		$SIG{INT} = sub {
			kill 9, $unloader;
			exit($errs != 0);
		};
	}
}

#
# Iterate over the set of test files specified on the command-line or located
# by a find on "." and execute each one.  If the test file is executable, we
# assume it is a #! script and run it.  Otherwise we run dtrace -s on it.
# If the file is named tst.* we assume it should return exit status 0.
# If the file is named err.* we assume it should return exit status 1.
# If the file is named err.D_[A-Z0-9]+[.*].d we use dtrace -xerrtags and
# examine stderr to ensure that a matching error tag was produced.
# If the file is named drp.[A-Z0-9]+[.*].d we use dtrace -xdroptags and
# examine stderr to ensure that a matching drop tag was produced.
# If any *.out or *.err files are found we perform output comparisons.
#
foreach $file (sort @files) {
	$file =~ m:.*/((.*)\.(\w+)):;
	$name = $1;
	$base = $2;
	$ext = $3;
	
	$dir = dirname($file);
	$isksh = 0;
	$tag = 0;
	$droptag = 0;

	if ($name =~ /^tst\./) {
		$isksh = ($ext eq 'ksh');
		$status = 0;
	} elsif ($name =~ /^err\.(D_[A-Z0-9_]+)\./) {
		$status = 1;
		$tag = $1;
	} elsif ($name =~ /^err\./) {
		$status = 1;
	} elsif ($name =~ /^drp\.([A-Z0-9_]+)\./) {
		$status = 0;
		$droptag = $1;
	} else {
		errmsg("ERROR: $file is not a valid test file name\n");
		next;
	}

	$fullname = "$dir/$name";
	$exe = "$dir/$base.exe";
	$exe_pid = -1;

	if ($opt_a && ($status != 0 || $tag != 0 || $droptag != 0 ||
	    -x $exe || $isksh || -x $fullname)) {
		$bypassed++;
		next;
	}

	if (!$isksh && -x $exe) {
		if (($exe_pid = fork()) == -1) {
			errmsg("ERROR: failed to fork to run $exe: $!\n");
			next;
		}

		if ($exe_pid == 0) {
			open(STDIN, '</dev/null');

			exec($exe);

			warn "ERROR: failed to exec $exe: $!\n";
		}
	}

	logmsg("testing $file ... ");

	if (($pid = fork()) == -1) {
		errmsg("ERROR: failed to fork to run test $file: $!\n");
		next;
	}

	if ($pid == 0) {
		open(STDIN, '</dev/null');
		exit(125) unless open(STDOUT, ">$opt_d/$$.out");
		exit(125) unless open(STDERR, ">$opt_d/$$.err");

		unless (chdir($dir)) {
			warn "ERROR: failed to chdir for $file: $!\n";
			exit(126);
		}

		push(@dtrace_argv, '-xerrtags') if ($tag);
		push(@dtrace_argv, '-xdroptags') if ($droptag);
##		push(@dtrace_argv, $exe_pid) if ($exe_pid != -1);

		if ($isksh) {
			exit(123) unless open(STDIN, "<$name");
			exec($ksh_path);
		} elsif (-x $name) {
		        warn "ERROR: $name is executable\n";
			exit(1);
		} else {
			if ($tag == 0 && $status == $0 && $opt_a) {
				push(@dtrace_argv, '-A');
			}

			push(@dtrace_argv, '-C');
			push(@dtrace_argv, '-s');
			push(@dtrace_argv, $name);
## Following moved here from above. Puts the pid number in the right place on the "command line"
			push(@dtrace_argv, $exe_pid) if ($exe_pid != -1);
			exec($dtrace_path, @dtrace_argv);
		}

		warn "ERROR: failed to exec for $file: $!\n";
		exit(127);
	}

eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm(30);

	if (waitpid($pid, 0) == -1) {
		alarm(0);
		errmsg("ERROR: timed out waiting for $file\n");
		kill(9, $exe_pid) if ($exe_pid != -1);
		kill(9, $pid);
		next;
	}

alarm(0);
};

	kill(9, $exe_pid) if ($exe_pid != -1);

	if ($tag == 0 && $status == $0 && $opt_a) {
		#
		# We can chuck the earler output.
		#
		unlink($pid . '.out');
		unlink($pid . '.err');

		#
		# This is an anonymous enabling.  We need to get the module
		# unloaded.
		#
		system("dtrace -ae 1> /dev/null 2> /dev/null");
		system("svcadm disable -s svc:/network/nfs/mapid:default");
		system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
		if (!system("modinfo | grep dtrace")) {
			warn "ERROR: couldn't unload dtrace\n";
			system("svcadm enable " . 
			    "-s svc:/network/nfs/mapid:default");
			exit(124);
		}

		#
		# DTrace is gone.  Now update_drv(1M), and rip everything out
		# again.
		#
		system("update_drv dtrace");
		system("dtrace -ae 1> /dev/null 2> /dev/null");
		system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
		if (!system("modinfo | grep dtrace")) {
			warn "ERROR: couldn't unload dtrace\n";
			system("svcadm enable " . 
			    "-s svc:/network/nfs/mapid:default");
			exit(124);
		}

		#
		# Now bring DTrace back in.
		#
		system("sync ; sync");
		system("dtrace -l -n bogusprobe 1> /dev/null 2> /dev/null");
		system("svcadm enable -s svc:/network/nfs/mapid:default");

		#
		# That should have caused DTrace to reload with the new
		# configuration file.  Now we can try to snag our anonymous
		# state.
		#
		if (($pid = fork()) == -1) {
			errmsg("ERROR: failed to fork to run test $file: $!\n");
			next;
		}

		if ($pid == 0) {
			open(STDIN, '</dev/null');
			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
			exit(125) unless open(STDERR, ">$opt_d/$$.err");

			push(@dtrace_argv, '-a');

			unless (chdir($dir)) {
				warn "ERROR: failed to chdir for $file: $!\n";
				exit(126);
			}

			exec($dtrace_path, @dtrace_argv);
			warn "ERROR: failed to exec for $file: $!\n";
			exit(127);
		}

eval {
local $SIG{ALRM} = sub { die "alarm clock restart" };
alarm(30);

		if (waitpid($pid, 0) == -1) {
			errmsg("ERROR: timed out waiting for $file\n");
			kill(9, $pid);
			next;
		}

alarm(0);
};

	}

	logmsg("[$pid]\n");
	$wstat = $?;
	$wifexited = ($wstat & 0xFF) == 0;
	$wexitstat = ($wstat >> 8) & 0xFF;
	$wtermsig = ($wstat & 0x7F);

	if (!$wifexited) {
		fail("died from signal $wtermsig");
		next;
	}

	if ($wexitstat == 125) {
		die "$PNAME: failed to create output file in $opt_d " .
		    "(cd elsewhere or use -d)\n";
	}

	if ($wexitstat != $status) {
		fail("returned $wexitstat instead of $status");
		next;
	}

	if (-f "$file.out" && system("cmp -s $file.out $opt_d/$pid.out") != 0) {
		fail("stdout mismatch", "$pid.out");
		next;
	}

	if (-f "$file.err" && system("cmp -s $file.err $opt_d/$pid.err") != 0) {
		fail("stderr mismatch: see $pid.err");
		next;
	}

	if ($tag) {
		open(TSTERR, "<$opt_d/$pid.err");

		do { $tsterr = <TSTERR> } until ($tsterr =~ /dtrace: /);

		close(TSTERR);

		unless ($tsterr =~ /: \[$tag\] line \d+:/) {
			fail("errtag mismatch: see $pid.err");
			next;
		}
#
#		sleep after err.Dfoo scripts to allow cyclic clean up to tidy-up.
#
		sleep 1;
	}

	if ($droptag) {
		$found = 0;
		open(TSTERR, "<$opt_d/$pid.err");

		while (<TSTERR>) {
			if (/\[$droptag\] /) {
				$found = 1;
				last;
			}
		}

		close (TSTERR);

		unless ($found) {
			fail("droptag mismatch: see $pid.err");
			next;
		}
	}

	unless ($opt_s) {
		unlink($pid . '.out');
		unlink($pid . '.err');
	}
}

if ($opt_a) {
	#
	# If we're running with anonymous enablings, we need to restore the
	# .conf file.
	#
	system("dtrace -A 1> /dev/null 2> /dev/null");
	system("dtrace -ae 1> /dev/null 2> /dev/null");
	system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
	system("update_drv dtrace");
}

$opt_q = 0; # force final summary to appear regardless of -q option

logmsg("\n==== TEST RESULTS ====\n");
logmsg("   passed: " . (scalar(@files) - $errs - $bypassed) . "\n");

if ($bypassed) {
	logmsg(" bypassed: " . $bypassed . "\n");
}

logmsg("   failed: " . $errs . "\n");
logmsg("    total: " . scalar(@files) . "\n");

if ($opt_u) {
	kill 9, $unloader;
	waitpid $unloader, 0;
}

exit($errs != 0);