xref: /titanic_50/usr/src/cmd/dtrace/test/cmd/scripts/dtest.pl (revision 4088bb40326b75ef60834a6c2a92e29e25474b68)
1#!/usr/perl5/bin/perl
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27#ident	"%Z%%M%	%I%	%E% SMI"
28
29require 5.6.1;
30
31use File::Find;
32use File::Basename;
33use Getopt::Std;
34use Cwd;
35
36$PNAME = $0;
37$PNAME =~ s:.*/::;
38$USAGE = "Usage: $PNAME [-abghlqsu] [-d dir] [-i isa] "
39    . "[-x opt[=arg]] [file | dir ...]\n";
40($MACH = `uname -p`) =~ s/\W*\n//;
41
42$dtrace_path = '/usr/sbin/dtrace';
43@dtrace_argv = ();
44
45$ksh_path = '/usr/bin/ksh';
46
47@files = ();
48$errs = 0;
49$bypassed = 0;
50
51#
52# If no test files are specified on the command-line, execute a find on "."
53# and append any tst.*.d, tst.*.ksh, err.*.d or drp.*.d files found within
54# the directory tree.
55#
56sub wanted
57{
58	push(@files, $File::Find::name)
59	    if ($_ =~ /^(tst|err|drp)\..+\.(d|ksh)$/ && -f "$_");
60}
61
62sub dirname {
63	my($s) = @_;
64	my($i);
65
66	$s = substr($s, 0, $i) if (($i = rindex($s, '/')) != -1);
67	return $i == -1 ? '.' : $i == 0 ? '/' : $s;
68}
69
70sub usage
71{
72	print $USAGE;
73	print "\t -a  execute test suite using anonymous enablings\n";
74	print "\t -b  execute bad ioctl test program\n";
75	print "\t -d  specify directory for test results files and cores\n";
76	print "\t -g  enable libumem debugging when running tests\n";
77	print "\t -h  display verbose usage message\n";
78	print "\t -i  specify ISA to test instead of isaexec(3C) default\n";
79	print "\t -l  save log file of results and PIDs used by tests\n";
80	print "\t -q  set quiet mode (only report errors and summary)\n";
81	print "\t -s  save results files even for tests that pass\n";
82	print "\t -x  pass corresponding -x argument to dtrace(1M)\n";
83	exit(2);
84}
85
86sub errmsg
87{
88	my($msg) = @_;
89
90	print STDERR $msg;
91	print LOG $msg if ($opt_l);
92	$errs++;
93}
94
95sub fail
96{
97	my(@parms) = @_;
98	my($msg) = $parms[0];
99	my($errfile) = $parms[1];
100	my($n) = 0;
101	my($dest) = basename($file);
102
103	while (-d "$opt_d/failure.$n") {
104		$n++;
105	}
106
107	unless (mkdir "$opt_d/failure.$n") {
108		warn "ERROR: failed to make directory $opt_d/failure.$n: $!\n";
109		exit(125);
110	}
111
112	open(README, ">$opt_d/failure.$n/README");
113	print README "ERROR: " . $file . " " . $msg;
114
115	if (scalar @parms > 1) {
116		print README "; see $errfile\n";
117	} else {
118		if (-f "$opt_d/$pid.core") {
119			print README "; see $pid.core\n";
120		} else {
121			print README "\n";
122		}
123	}
124
125	close(README);
126
127	if (-f "$opt_d/$pid.out") {
128		rename("$opt_d/$pid.out", "$opt_d/failure.$n/$pid.out");
129		link("$file.out", "$opt_d/failure.$n/$dest.out");
130	}
131
132	if (-f "$opt_d/$pid.err") {
133		rename("$opt_d/$pid.err", "$opt_d/failure.$n/$pid.err");
134		link("$file.err", "$opt_d/failure.$n/$dest.err");
135	}
136
137	if (-f "$opt_d/$pid.core") {
138		rename("$opt_d/$pid.core", "$opt_d/failure.$n/$pid.core");
139	}
140
141	link("$file", "$opt_d/failure.$n/$dest");
142
143	$msg = "ERROR: " . $dest . " " . $msg;
144
145	if (scalar @parms > 1) {
146		$msg = $msg . "; see $errfile in failure.$n\n";
147	} else {
148		$msg = $msg . "; details in failure.$n\n";
149	}
150
151	errmsg($msg);
152}
153
154sub logmsg
155{
156	my($msg) = @_;
157
158	print STDOUT $msg unless ($opt_q);
159	print LOG $msg if ($opt_l);
160}
161
162die $USAGE unless (getopts('abd:ghi:lqsux:'));
163usage() if ($opt_h);
164
165foreach $arg (@ARGV) {
166	if (-f $arg) {
167		push(@files, $arg);
168	} elsif (-d $arg) {
169		find(\&wanted, $arg);
170	} else {
171		die "$PNAME: $arg is not a valid file or directory\n";
172	}
173}
174
175$defdir = -d '/opt/SUNWdtrt/tst' ? '/opt/SUNWdtrt/tst' : '.';
176$bindir = -d '/opt/SUNWdtrt/bin' ? '/opt/SUNWdtrt/bin' : '.';
177
178find(\&wanted, "$defdir/common") if (scalar(@ARGV) == 0);
179find(\&wanted, "$defdir/$MACH") if (scalar(@ARGV) == 0);
180die $USAGE if (scalar(@files) == 0);
181
182if ($opt_d) {
183	die "$PNAME: -d arg must be absolute path\n" unless ($opt_d =~ /^\//);
184	die "$PNAME: -d arg $opt_d is not a directory\n" unless (-d "$opt_d");
185	system("coreadm -p $opt_d/%p.core");
186} else {
187	my $dir = getcwd;
188	system("coreadm -p $dir/%p.core");
189	$opt_d = '.';
190}
191
192if ($opt_i) {
193	$dtrace_path = "/usr/sbin/$opt_i/dtrace";
194	die "$PNAME: dtrace(1M) for ISA $opt_i not found\n"
195	    unless (-x "$dtrace_path");
196}
197
198if ($opt_x) {
199	push(@dtrace_argv, '-x');
200	push(@dtrace_argv, $opt_x);
201}
202
203die "$PNAME: failed to open $PNAME.$$.log: $!\n"
204    unless (!$opt_l || open(LOG, ">$PNAME.$$.log"));
205
206if ($opt_g) {
207	$ENV{'UMEM_DEBUG'} = 'default,verbose';
208	$ENV{'UMEM_LOGGING'} = 'fail,contents';
209	$ENV{'LD_PRELOAD'} = 'libumem.so';
210}
211
212#
213# Ensure that $PATH contains a cc(1) so that we can execute the
214# test programs that require compilation of C code.
215#
216$ENV{'PATH'} = $ENV{'PATH'} . ':/ws/on10-tools/SUNWspro/SOS8/bin';
217
218if ($opt_b) {
219	logmsg("badioctl'ing ... ");
220
221	if (($badioctl = fork()) == -1) {
222		errmsg("ERROR: failed to fork to run badioctl: $!\n");
223		next;
224	}
225
226	if ($badioctl == 0) {
227		open(STDIN, '</dev/null');
228		exit(125) unless open(STDOUT, ">$opt_d/$$.out");
229		exit(125) unless open(STDERR, ">$opt_d/$$.err");
230
231		exec($bindir . "/badioctl");
232		warn "ERROR: failed to exec badioctl: $!\n";
233		exit(127);
234	}
235
236
237	logmsg("[$badioctl]\n");
238
239	#
240	# If we're going to be bad, we're just going to iterate over each
241	# test file.
242	#
243	foreach $file (sort @files) {
244		($name = $file) =~ s:.*/::;
245		$dir = dirname($file);
246
247		if (!($name =~ /^tst\./ && $name =~ /\.d$/)) {
248			next;
249		}
250
251		logmsg("baddof'ing $file ... ");
252
253		if (($pid = fork()) == -1) {
254			errmsg("ERROR: failed to fork to run baddof: $!\n");
255			next;
256		}
257
258		if ($pid == 0) {
259			open(STDIN, '</dev/null');
260			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
261			exit(125) unless open(STDERR, ">$opt_d/$$.err");
262
263			unless (chdir($dir)) {
264				warn "ERROR: failed to chdir for $file: $!\n";
265				exit(126);
266			}
267
268			exec($bindir . "/baddof", $name);
269
270			warn "ERROR: failed to exec for $file: $!\n";
271			exit(127);
272		}
273
274		sleep 60;
275		kill(9, $pid);
276		waitpid($pid, 0);
277
278		logmsg("[$pid]\n");
279
280		unless ($opt_s) {
281			unlink($pid . '.out');
282			unlink($pid . '.err');
283		}
284	}
285
286	kill(9, $badioctl);
287	waitpid($badioctl, 0);
288
289	unless ($opt_s) {
290		unlink($badioctl . '.out');
291		unlink($badioctl . '.err');
292	}
293
294	exit(0);
295}
296
297if ($opt_u) {
298	logmsg "spawning module unloading process... ";
299
300	$unloader = fork;
301
302	if ($unloader != 0 && !defined $unloader) {
303		#
304		# Couldn't fork for some reason.
305		#
306		die "couldn't fork: $!\n";
307	}
308
309	if ($unloader == 0) {
310		#
311		# We're in the child.  Go modunload krazy.
312		#
313		for (;;) {
314			system("modunload -i 0");
315		}
316	} else {
317		logmsg "[$unloader]\n";
318
319		$SIG{INT} = sub {
320			kill 9, $unloader;
321			exit($errs != 0);
322		};
323	}
324}
325
326#
327# Iterate over the set of test files specified on the command-line or located
328# by a find on "." and execute each one.  If the test file is executable, we
329# assume it is a #! script and run it.  Otherwise we run dtrace -s on it.
330# If the file is named tst.* we assume it should return exit status 0.
331# If the file is named err.* we assume it should return exit status 1.
332# If the file is named err.D_[A-Z0-9]+[.*].d we use dtrace -xerrtags and
333# examine stderr to ensure that a matching error tag was produced.
334# If the file is named drp.[A-Z0-9]+[.*].d we use dtrace -xdroptags and
335# examine stderr to ensure that a matching drop tag was produced.
336# If any *.out or *.err files are found we perform output comparisons.
337#
338foreach $file (sort @files) {
339	$file =~ m:.*/((.*)\.(\w+)):;
340	$name = $1;
341	$base = $2;
342	$ext = $3;
343
344	$dir = dirname($file);
345	$isksh = 0;
346	$tag = 0;
347	$droptag = 0;
348
349	if ($name =~ /^tst\./) {
350		$isksh = ($ext eq 'ksh');
351		$status = 0;
352	} elsif ($name =~ /^err\.(D_[A-Z0-9_]+)\./) {
353		$status = 1;
354		$tag = $1;
355	} elsif ($name =~ /^err\./) {
356		$status = 1;
357	} elsif ($name =~ /^drp\.([A-Z0-9_]+)\./) {
358		$status = 0;
359		$droptag = $1;
360	} else {
361		errmsg("ERROR: $file is not a valid test file name\n");
362		next;
363	}
364
365	$fullname = "$dir/$name";
366	$exe = "$dir/$base.exe";
367	$exe_pid = -1;
368
369	if ($opt_a && ($status != 0 || $tag != 0 || $droptag != 0 ||
370	    -x $exe || $isksh || -x $fullname)) {
371		$bypassed++;
372		next;
373	}
374
375	if (!$isksh && -x $exe) {
376		if (($exe_pid = fork()) == -1) {
377			errmsg("ERROR: failed to fork to run $exe: $!\n");
378			next;
379		}
380
381		if ($exe_pid == 0) {
382			open(STDIN, '</dev/null');
383
384			exec($exe);
385
386			warn "ERROR: failed to exec $exe: $!\n";
387		}
388	}
389
390	logmsg("testing $file ... ");
391
392	if (($pid = fork()) == -1) {
393		errmsg("ERROR: failed to fork to run test $file: $!\n");
394		next;
395	}
396
397	if ($pid == 0) {
398		open(STDIN, '</dev/null');
399		exit(125) unless open(STDOUT, ">$opt_d/$$.out");
400		exit(125) unless open(STDERR, ">$opt_d/$$.err");
401
402		unless (chdir($dir)) {
403			warn "ERROR: failed to chdir for $file: $!\n";
404			exit(126);
405		}
406
407		push(@dtrace_argv, '-xerrtags') if ($tag);
408		push(@dtrace_argv, '-xdroptags') if ($droptag);
409		push(@dtrace_argv, $exe_pid) if ($exe_pid != -1);
410
411		if ($isksh) {
412			exit(123) unless open(STDIN, "<$name");
413			exec($ksh_path);
414		} elsif (-x $name) {
415		        warn "ERROR: $name is executable\n";
416			exit(1);
417		} else {
418			if ($tag == 0 && $status == $0 && $opt_a) {
419				push(@dtrace_argv, '-A');
420			}
421
422			push(@dtrace_argv, '-C');
423			push(@dtrace_argv, '-s');
424			push(@dtrace_argv, $name);
425			exec($dtrace_path, @dtrace_argv);
426		}
427
428		warn "ERROR: failed to exec for $file: $!\n";
429		exit(127);
430	}
431
432	if (waitpid($pid, 0) == -1) {
433		errmsg("ERROR: timed out waiting for $file\n");
434		kill(9, $exe_pid) if ($exe_pid != -1);
435		kill(9, $pid);
436		next;
437	}
438
439	kill(9, $exe_pid) if ($exe_pid != -1);
440
441	if ($tag == 0 && $status == $0 && $opt_a) {
442		#
443		# We can chuck the earler output.
444		#
445		unlink($pid . '.out');
446		unlink($pid . '.err');
447
448		#
449		# This is an anonymous enabling.  We need to get the module
450		# unloaded.
451		#
452		system("dtrace -ae 1> /dev/null 2> /dev/null");
453		system("svcadm disable -s svc:/network/nfs/mapid:default");
454		system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
455		if (!system("modinfo | grep dtrace")) {
456			warn "ERROR: couldn't unload dtrace\n";
457			system("svcadm enable " .
458			    "-s svc:/network/nfs/mapid:default");
459			exit(124);
460		}
461
462		#
463		# DTrace is gone.  Now update_drv(1M), and rip everything out
464		# again.
465		#
466		system("update_drv dtrace");
467		system("dtrace -ae 1> /dev/null 2> /dev/null");
468		system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
469		if (!system("modinfo | grep dtrace")) {
470			warn "ERROR: couldn't unload dtrace\n";
471			system("svcadm enable " .
472			    "-s svc:/network/nfs/mapid:default");
473			exit(124);
474		}
475
476		#
477		# Now bring DTrace back in.
478		#
479		system("sync ; sync");
480		system("dtrace -l -n bogusprobe 1> /dev/null 2> /dev/null");
481		system("svcadm enable -s svc:/network/nfs/mapid:default");
482
483		#
484		# That should have caused DTrace to reload with the new
485		# configuration file.  Now we can try to snag our anonymous
486		# state.
487		#
488		if (($pid = fork()) == -1) {
489			errmsg("ERROR: failed to fork to run test $file: $!\n");
490			next;
491		}
492
493		if ($pid == 0) {
494			open(STDIN, '</dev/null');
495			exit(125) unless open(STDOUT, ">$opt_d/$$.out");
496			exit(125) unless open(STDERR, ">$opt_d/$$.err");
497
498			push(@dtrace_argv, '-a');
499
500			unless (chdir($dir)) {
501				warn "ERROR: failed to chdir for $file: $!\n";
502				exit(126);
503			}
504
505			exec($dtrace_path, @dtrace_argv);
506			warn "ERROR: failed to exec for $file: $!\n";
507			exit(127);
508		}
509
510		if (waitpid($pid, 0) == -1) {
511			errmsg("ERROR: timed out waiting for $file\n");
512			kill(9, $pid);
513			next;
514		}
515	}
516
517	logmsg("[$pid]\n");
518	$wstat = $?;
519	$wifexited = ($wstat & 0xFF) == 0;
520	$wexitstat = ($wstat >> 8) & 0xFF;
521	$wtermsig = ($wstat & 0x7F);
522
523	if (!$wifexited) {
524		fail("died from signal $wtermsig");
525		next;
526	}
527
528	if ($wexitstat == 125) {
529		die "$PNAME: failed to create output file in $opt_d " .
530		    "(cd elsewhere or use -d)\n";
531	}
532
533	if ($wexitstat != $status) {
534		fail("returned $wexitstat instead of $status");
535		next;
536	}
537
538	if (-f "$file.out" && system("cmp -s $file.out $opt_d/$pid.out") != 0) {
539		fail("stdout mismatch", "$pid.out");
540		next;
541	}
542
543	if (-f "$file.err" && system("cmp -s $file.err $opt_d/$pid.err") != 0) {
544		fail("stderr mismatch: see $pid.err");
545		next;
546	}
547
548	if ($tag) {
549		open(TSTERR, "<$opt_d/$pid.err");
550		$tsterr = <TSTERR>;
551		close(TSTERR);
552
553		unless ($tsterr =~ /: \[$tag\] line \d+:/) {
554			fail("errtag mismatch: see $pid.err");
555			next;
556		}
557	}
558
559	if ($droptag) {
560		$found = 0;
561		open(TSTERR, "<$opt_d/$pid.err");
562
563		while (<TSTERR>) {
564			if (/\[$droptag\] /) {
565				$found = 1;
566				last;
567			}
568		}
569
570		close (TSTERR);
571
572		unless ($found) {
573			fail("droptag mismatch: see $pid.err");
574			next;
575		}
576	}
577
578	unless ($opt_s) {
579		unlink($pid . '.out');
580		unlink($pid . '.err');
581	}
582}
583
584if ($opt_a) {
585	#
586	# If we're running with anonymous enablings, we need to restore the
587	# .conf file.
588	#
589	system("dtrace -A 1> /dev/null 2> /dev/null");
590	system("dtrace -ae 1> /dev/null 2> /dev/null");
591	system("modunload -i 0 ; modunload -i 0 ; modunload -i 0");
592	system("update_drv dtrace");
593}
594
595$opt_q = 0; # force final summary to appear regardless of -q option
596
597logmsg("\n==== TEST RESULTS ====\n");
598logmsg("   passed: " . (scalar(@files) - $errs - $bypassed) . "\n");
599
600if ($bypassed) {
601	logmsg(" bypassed: " . $bypassed . "\n");
602}
603
604logmsg("   failed: " . $errs . "\n");
605logmsg("    total: " . scalar(@files) . "\n");
606
607if ($opt_u) {
608	kill 9, $unloader;
609	waitpid $unloader, 0;
610}
611
612exit($errs != 0);
613