Commit 210845c3 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap daemonize, email support fixes

parent 7403758f
OldTests
email
Massive Run
test daemonize
Painpoints
......@@ -11,6 +9,7 @@ Testoutput - TestBuilderWrapper
DOCS TODO
backoff example
more prose docs
TODO
TESTLWP
......
package TestBed::Daemonize;
use SemiModern::Perl;
sub ForkOrDie {
my $pid;
return $pid if (defined($pid = fork));
die "Fork failed: $!";
}
sub daemonize {
exit if ForkOrDie;
die "Cannot detach from controlling Terminal" unless POSIX::setsid;
exit if ForkOrDie;
open(STDIN, "+>/dev/null");
open(STDOUT, "+>", "stdout.$$");
open(STDERR, "+>", "stderr.$$");
}
sub email {
my $s = eval "use Email::Stuff; Email::Stuff->new;";
if ($@) {
die "Email::Stuff not installed";
}
return $s;
}
sub email_daemonize_logs {
my ($to) = @_;
my $s = email;
$s->from ('TestSwap__dont_reply@emulab.net' )
->to ($to )
->subject ("TestSwap run $$")
->text_body("TestSwap run $$")
->attach_file("stdout.$$")
->attach_file("stderr.$$")
->send;
}
=pod
=head TestBed::Daemonize
=over 4
=item C<ForkOrDie>
dies if fork fails
=item C<daemonize>
daemonizes the process redirecting stdout and stderr to files
=item C<email>
generates a EMail::Stuff object
=item C<email_daemonize_logs($to)>
send logs of daemon activity to $to
=back
=cut
1;
......@@ -315,6 +315,10 @@ B<INTERNAL>: generates expinfo subs
B<INTERNAL>: catches socket timeout exceptions and rexecutes &sub after printing $message
=item C<< succeed_on_TIMEOUT(&sub, $messag) >>
B<INTERNAL>: catches socket timeout exceptions and returns success
=back
=cut
......
......@@ -221,28 +221,6 @@ sub splat_to_temp {
return $tmp;
}
sub ForkOrDie {
my $pid;
return $pid if (defined($pid = fork));
die "Fork failed: $!";
}
sub daemonize {
exit if ForkOrDie;
die "Cannot detach from controlling Terminal" unless POSIX::setsid;
exit if ForkOrDie;
open(STDIN, "+>/dev/null");
open(STDOUT, "+>", "stdout.$$");
open(STDERR, "+>", "stderr.$$");
}
=item C<ForkOrDie>
dies if fork fails
=item C<daemonize>
daemonizes the process redirecting stdout and stderr to files
=back
......
......@@ -42,7 +42,7 @@ sub install_deps_from_cpan {
Test::Exception
Term::ReadKey
);
# Test::Class
#Test::Class
#Crypt::SSLeay # required for SSL
#Data::UUID requires user input
#Net::Ping #tests fail, default installed version 2.31 is good enough
......@@ -74,15 +74,27 @@ sub automate_ssh_install {
}
sub main {
if (!(grep {$_ eq '--override' } @ARGV) and -e glob("~/.cpan")) {
die "NOT installing local CPAN ~/.cpan exists, specify --override to ignore check";
}
print "WARNING installing local CPAN to '~/lib/perl5' -- type yes <ENTER> to continue\n";
my $response = <STDIN>;
chomp $response;
if ($response ne "yes") {
die "$response does not match yes";
}
prep_local_cpan;
$ENV{PERL5LIB} = glob('~/lib/perl5');
if ($ARGV[0] && $ARGV[0] eq 'MI') {
automate_module_install; #too complicated on FreeBSD
automate_ssh_install; #too complicated on FreeBSD
automate_module_install; #too complicated for fluxers on FreeBSD
automate_ssh_install; #too complicated for fluxers on FreeBSD
}
else {
install_deps_from_cpan;
}
}
#main;
main;
#!/usr/bin/perl
BEGIN {
#add localcpan path to library search path
if (-f glob("~/lib/perl5/Test/Harness.pm")) {
my $localcpan_path = glob('~/lib/perl5');
push @INC, $localcpan_path;
}
}
use lib 'lib';
use SemiModern::Perl;
use TBConfig;
......
......@@ -9,16 +9,19 @@ BEGIN {
$ENV { PERL5LIB} .= "$sep" . " $localcpan_path";
push @INC, $localcpan_path;
}
push @INC, $localcpan_path;
}
$ENV{PERL5LIB} .= ":tests";
push @INC,"/Users/grahamellis/jan06";
}
use lib qw(lib tests);
use SemiModern::Perl;
use Data::Dumper;
use TBConfig;
use TestBed::Daemonize;
my $emailme;
my $daemonize;
{
use Getopt::Long;
my $debug;
......@@ -47,6 +50,7 @@ use TBConfig;
"dontkill" => \$dontkill,
"alreadyalive" => \$alreadyalive,
"daemonize" => \$daemonize,
"emailme=s" => \$emailme,
);
if ($debug) { $ENV { 'TBTS_DEBUG' } = 1 ; $TBConfig::DEBUG_XML_CLIENT = 1 ; }
......@@ -60,7 +64,7 @@ use TBConfig;
if ($runonly) { $TBConfig::runonly = [split(/ /, $runonly)]; }
if ($dontkill) { $TBConfig::exclude_steps = [qw/swapout end/]}
if ($alreadyalive) { $TBConfig::exclude_steps = [qw/create swapin swapout end/]}
if ($daemonize) { Tools::daemonize; }
if ($daemonize or $emailme) { TestBed::Daemonize::daemonize; }
}
sub usage {
......@@ -85,14 +89,16 @@ TestBed TestSwap
--alreadyalive => --excludesteps "create swapin swapout end"
--excludesteps "swapout end"
--excludesteps "create swapin swapout end"
--runonly "testname1 testname2 testname3"
--daemonize
--emailme user\@emulab.net
TESTSUITES:
test - all topology tests
sanity - all framework utility and xmlrpc client modules test
lib - all framework utility tests
xmlrpc - all xmlrpc client modules tests
critic - runs perl critic on framework code
TESTFILES:
......@@ -117,6 +123,7 @@ if (@ARGV) {
elsif (/coding/) { runharness( qw(t/coding/pod_coverage.t) ); }
}
else {
print usage();
usage();
}
TestBed::Daemonize::email_daemonize_logs($emailme) if $emailme;
......@@ -6,13 +6,9 @@ use Data::Dumper;
use OldTestSuite;
our @should_pass = qw( basic cbr complete5 delaylan1 delaylink );
our @who_knows_passed = qw( lan1 multilink );
our @who_knows = qw( ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping );
our @who_knows_passed = qw( multilink ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping );
our @should_fail = qw( negprerun toomanylinks toofast );
#cbr basic complete5 delaylan1 delaylink
#lan1 multilink
#ixp nodes singlenode trafgen simplelink simplex red ping
#negprerun toomanylinks toofast
#unclassified
......@@ -23,7 +19,7 @@ vtypes (may want to parameterize the vtypes)
fixed (you will have to change the ns file depending on which nodes are available)
=cut
for (@who_knows) {
for (@should_fail) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
......
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