Skip to content

GitLab

emulab-devel
emulab-devel
Commit ed74a4b3 authored by Robert Ricci's avatar Robert Ricci
Browse files
Options

This got commited accidentaly - appears to be a copy of a file from 

the image-test directory
parent 53f7c14d
Hide whitespace changes
Inline Side-by-side
Showing with 0 additions and 503 deletions
pelab/bgmon/ImageTest.pm deleted 100644 → 0
View file @ 53f7c14d
package ImageTest;
use Exporter;
@ISA = "Exporter";
@EXPORT = qw (test test_cmd test_ssh test_rcmd test_experiment exit_str
ERR_MASK ERR_NONE ERR_FAILED ERR_FATAL ERR_INT
STATUS_MASK STATUS_NONE STATUS_SWAPPEDIN STATUS_EXISTS STATUS_CLEANUP);
use IO::File;
use strict;
use vars qw(%parms %dependencies %tally);
use vars qw($eid $pid $datadir $resultsdir);
use vars qw(@mapping @nodes @pnodes %to_physical %from_physical);
use vars qw($FAILED);
use vars qw(%ERR %STATUS);
sub true() {1}
sub false() {0}
#
# exit values, or two parts together
#
sub ERR_MASK {3};
sub ERR_NONE {0};
sub ERR_FAILED {1}; # tests failed
sub ERR_FATAL {2}; # fatal error
sub ERR_INT {3}; # interrupted
%ERR = (ERR_NONE, 'ERR_NONE',
ERR_FAILED, 'ERR_FAILED',
ERR_FATAL, 'ERR_FATAL',
ERR_INT, 'ERR_INT');
sub STATUS_MASK {3 << 2};
sub STATUS_NONE {0 << 2};
sub STATUS_SWAPPEDIN {1 << 2}; # experment still swapped in
sub STATUS_EXISTS {2 << 2}; # experment still exists
sub STATUS_CLEANUP {3 << 2}; # requires cleanup
%STATUS = (STATUS_NONE, 'STATUS_NONE',
STATUS_SWAPPEDIN, 'STATUS_SWAPPEDIN',
STATUS_EXISTS, 'STATUS_EXISTS',
STATUS_CLEANUP, 'STATUS_CLEANUP');
sub exit_str($) {
my ($exit) = @_;
return join(' ', $ERR{$exit & ERR_MASK}, $STATUS{$exit & STATUS_MASK});
}
#
# Performs a test on a swapped in experient. Returns true if the test
# passed.
#
# Each test can depend and on any number of other tests. The test
# will be skipped unless all the dependencies are satisfied.
#
# Examples:
# test 'test 1', [], sub {...};
# test 'test 2', ['test 1'], sub {...};
# test 'login prompt', [], sub {
# local $_ = cat "/var/log/tiplogs/$pnode.run";
# /login\: /;
# }
#
sub test ($$&) {
my ($name,$requires,$test) = @_;
$tally{total}++;
my $deps_sat = 1;
foreach (@$requires) {$deps_sat = 0 unless $dependencies{$_}}
unless ($deps_sat) {
print "Skipping test \"$name\" due to unsatisfied dependies.\n";
return 0;
}
print "<=== Starting Test: $name\n";
my $res;
eval {$res = &$test(%parms)};
if ($res) {
$tally{passed}++;
$dependencies{$name} = 1;
print ">=== \"$name\" succeeded\n";
return true;
} elsif ($@) {
$tally{failed}++;
print $FAILED "$name\n";
print ">*** \"$name\" died: $@";
return false;
} else {
$tally{failed}++;
print $FAILED "$name\n";
print ">*** \"$name\" failed\n";
return false;
}
}
#
#
#
sub sys (@) {
print "<- Executing: ", join(' ', @_), "\n";
system @_;
print ">- Done\n";
return $? >> 8 == 0;
}
#
# Performs a test by executing a command and optionally checking the output
#
# Example :
# test_cmd "ssh $node", [], "ssh $node.$eid.$pid true";
#
sub test_cmd ($$$;&) {
my ($name,$requires,$cmd,$output_test) = @_;
test $name, $requires, sub {
if (not defined $output_test) {
return sys($cmd);
} else {
local $/ = undef;
my $F = new IO::File;
print "<- Executing: $cmd\n";
open $F, "$cmd |" or return false;
local $_ = <$F>;
close $F;
print ">- Done\n";
return 0 unless ($? >> 8 == 0);
open $F, ">$resultsdir/$name.out";
print $F $_;
close $F;
my $res = &$output_test;
print "*** Output of \"$cmd\" did not match expected output\n" unless $res;
return $res;
}
};
}
#
# Test that ssh is working on a node
#
# Example:
# test_ssh 'node';
#
sub test_ssh ($) {
my ($node) = @_;
test_cmd "ssh-$node", [], "ssh-node $node true";
}
#
# Performs a test by executing a remote command and optionally
# checking the output. test_ssh must be executed on the node before
# any remote commands for the node.
#
# Examples:
# test_rcmd 'sudo', [], 'node', 'sudo touch /afile.txt';
# test_rcmd 'hostname' , [], 'node', 'hostname', sub {/^node\.$eid\.$pid/};
#
sub test_rcmd ($$$$;&) {
my ($name,$requires,$node,$cmd,$output_test) = @_;
&test_cmd($name, ["ssh-$node", @$requires],
"ssh-node $node $cmd", $output_test);
}
#
# Scans a log file for any errors or serious warnings. The log file
# may also be a pipe as the string is passed directly to open.
#
# Example:
# test_scanlog 'error free log', [], 'log';
#
sub test_scanlog ($$$) {
my ($name,$requires,$log) = @_;
test $name, $requires, sub {
my $F = new IO::File;
open $F, $log or die "Unable to open \"$log\" for reading.";
my $errors = 0;
while (<$F>) {
next unless /^\*\*\* /;
print;
$errors = 1;
}
close $F;
return $errors == 0;
};
}
#
#
#
sub cat ($) {
open F, $_[0];
local $/ = undef;
local $_ = <F>;
close F;
return $_;
};
#
#
#
sub single_node_tests ($) {
my ($node) = @_;
my ($pnode) = $to_physical{$node};
test_ssh $node;
return if $parms{skip_std_tests};
test_rcmd "sudo-$node", [], $node, 'sudo touch /afile.txt';
test_rcmd "hostname-$node" , [], $node, 'hostname', sub {
/^$node\.$eid\.$pid/i || /^$pnode/i;
};
test "login_prompt-$node", [], sub {
local $_ = cat "/var/log/tiplogs/$pnode.run";
/login\: /;
};
test "proj_mount-$node", ["ssh-$node"], sub {
sys "ssh-node $node touch $resultsdir/working/$node"
or return false;
return -e "$resultsdir/working/$node";
}
}
#
#
#
sub multi_node_tests () {
#test_cmd 'linktest', [], "run_linktest.pl -v -e $pid/$eid";
return if $parms{skip_std_tests};
sleep 10;
test_cmd 'linktest1', [], "run_linktest.pl -v -L 1 -l 1 -e $pid/$eid";
sleep 2;
test_cmd 'linktest2', [], "run_linktest.pl -v -L 2 -l 2 -e $pid/$eid";
sleep 2;
test_cmd 'linktest3', [], "run_linktest.pl -v -L 3 -l 3 -e $pid/$eid";
sleep 2;
test_cmd 'linktest4', [], "run_linktest.pl -v -L 4 -l 4 -e $pid/$eid";
}
#
# Creats and swaps in a test experment in and performs tests on the
# images after it is done. When all the tests are done swap the experment out,
# copy the experment data dir to EXP-YYYYMMDDHHMM and terminate the experiment.
#
# Will fork a child to do the actual work and return the pid of the child
#
# Expects a hash of parmaters as input for example:
# test_experiment
# pid => 'tbres',
# eid => 'it-single',
# os => 'RHL73-STD',
# hardware => 'pc850',
# datadir => '...',
# resultsdir => '...',
#
# The .ns file for the experiment is expected to be named "<datadir>/nsfile.ns".
# The file will be scanned and any instances of @PARM@ will be substituted
# for the value of PARM. Any image specific tests should be located in
# "<datadir>/tests.ns".
#
sub test_experiment (%) {
{
my $pid = fork();
die unless defined $pid;
return $pid if $pid != 0; # child
}
%parms = @_;
%dependencies = ();
%tally = (total => 0, passed => 0, failed => 0);
$eid = $parms{eid};
$pid = $parms{pid};
$datadir = $parms{datadir};
$resultsdir = $parms{resultsdir};
my $err = ERR_NONE;
my $status = STATUS_NONE;
$SIG{__DIE__} = sub {
return unless defined $^S && !$^S;
$! = (ERR_FATAL | $status);
die $_[0];
};
$SIG{INT} = 'IGNORE';
$SIG{TERM} = sub {
print "TERMINATING\n";
exit (ERR_INT | $status);
};
mkdir $resultsdir, 0777;
chdir $resultsdir;
mkdir "working", 0777;
mkdir "bin", 0777;
#sleep 5;
#exit 0;
$ENV{PATH} = "$resultsdir/bin:$ENV{PATH}";
open STDOUT, ">log" or die;
open STDERR, ">&STDOUT" or die;
my ($F,$O);
$F = new IO::File ">pid" or die;
print $F "$$\n";
close $F;
$FAILED = new IO::File ">failed-tests" or die;
$F = new IO::File ">parms" or die;
foreach (sort keys %parms) {
print $F "$_: $parms{$_}\n";
}
close $F;
$F = new IO::File ">bin/ssh-node" or die;
print $F "#!/bin/sh\n";
print $F "\n";
print $F 'cmd=$1',"\n";
print $F 'shift', "\n";
print $F join(' ',
'ssh', "-x",
"-o BatchMode=yes", "-o StrictHostKeyChecking=no",
"-o UserKnownHostsFile=$resultsdir/working/known_hosts",
"\$cmd.$parms{eid}.$parms{pid}", '"$@"', "\n");
close $F;
chmod 0755, "bin/ssh-node";
if ($parms{stages} =~ /c/) {
$F = new IO::File "$datadir/nsfile.ns" or die;
$O = new IO::File ">nsfile.ns" or die;
while (<$F>) {
s/\@([^@]+)\@/$parms{lc $1}/g;
print $O $_;
}
close $O;
close $F;
$status = STATUS_EXISTS;
sys("/usr/testbed/bin/startexp -w -i -f".
" -E \"Experiment For Testing Images\"".
" -p $pid -e $eid nsfile.ns");
if ($? >> 8 != 0) {
print "*** Could not create experment\n";
exit (ERR_FATAL | STATUS_NONE);
}
}
my $swapin_success = 1;
if ($parms{stages} =~ /s/) {
$status = STATUS_SWAPPEDIN;
$swapin_success = test_cmd 'swapin', [],
"/usr/testbed/bin/swapexp -w -e $pid,$eid in";
$status = STATUS_EXISTS unless $swapin_success;
}
if ($swapin_success) {
if ($parms{stages} =~ /s/) {
# FIXME: need proper way to get the log file
test_scanlog 'error_free_swapin', [],
`ls -t /proj/$pid/exp/$eid/tbdata/swapexp.* | head -1`;
}
local (@mapping, @nodes, @pnodes, %to_physical, %from_physical);
open F, "/usr/testbed/bin/expinfo -m $pid $eid | ";
while (<F>) {
last if /^---/;
}
while (<F>) {
next unless /\w/;
local @_ = split /\s+/;
push @mapping, [@_];
push @nodes, $_[0];
push @pnodes, $_[3];
$to_physical{$_[0]} = $_[3];
$from_physical{$_[3]} = $_[0];
}
if ($parms{stages} =~ /t/) {
foreach my $node (@nodes) {
single_node_tests($node);
}
if (@nodes > 1) {
multi_node_tests();
}
if (-e "$datadir/tests.pl") {
do "$datadir/tests.pl";
if ($@) {
print "*** Unable to complete tests: $@";
print "*** Results may not be accurate.\n";
$err = ERR_FATAL
}
}
}
if ($parms{stages} =~ /[oe]/) {
test_cmd 'loghole', [], "loghole -e $pid/$eid sync";
foreach my $node (@nodes) {
my $pnode = $to_physical{$node};
sys "cp -pr /var/log/tiplogs/$pnode.run tiplog-$node"
or print "*** WARNING: Unable to copy tiplog for node $node.\n";
}
test_cmd 'swapout', [],
"/usr/testbed/bin/swapexp -w -e $pid,$eid out"
and $status = STATUS_EXISTS;
# FIXME: need proper way to get the log file
test_scanlog 'error_free_swapout', ['swapout'],
`ls -t /proj/$pid/exp/$eid/tbdata/swapexp.* | head -1`;
}
} else {
$err = ERR_FATAL;
}
$err = ERR_FAILED if $err == ERR_NONE && $tally{failed} > 0;
if ($parms{stages} =~ /e/) {
sys("cp -pr /proj/$pid/exp/$eid exp-data");
if ($? >> 8 != 0) {
print "*** Unable to copy exp data. Not terminating exp\n";
exit ($err | STATUS_CLEANUP);
}
sys("/usr/testbed/bin/endexp -w -e $pid,$eid");
if ($? >> 8 != 0) {
print "*** Could not terminate experiment. Must do manually\n";
exit ($err | STATUS_CLEANUP);
}
$status = STATUS_NONE;
}
if ($parms{stages} =~ /t/) {
print "\n";
print "Num Tests: $tally{total}\n";
print "Passed: $tally{passed}\n";
print "Failed: $tally{failed}\n";
my $unex = $tally{total} - $tally{passed} - $tally{failed};
print "Unable to Execute: $unex\n";
}
exit ($err | $status);
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment