Commit 28c1968f authored by Leigh Stoller's avatar Leigh Stoller

Add swappable and priority bits to experiment creation form. Not used,

but simply entered into the DB record for the experiment until we know
what to do with them. Add to batchexp script arguments, since all that
stuff is done outside the web interface. Add a swapexp perl script to
swap an an experiment in/out form the command line. Add web links on
the Experiment Information page to do this from the web interface. A
bunch of locking changes. Previously expt_terminating in the
experiment record prevented multiple calls to terminate an experiment,
but now we have a more general locking problem with
start,swapin,swapout, and terminate, so change expt_terminating to
expt_locked (still a datetime field) and add locking to all of
startexp, swapexp, and endexp. Note that batch experiments cannot be
swapped yet because of locking issues still to be resolved. Minor
cleanup in tbreport to make email message look better.
parent d1c48ea4
......@@ -1039,6 +1039,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
tbsetup/sched_reload tbsetup/sched_reserve tbsetup/reload_daemon \
tbsetup/batchexp tbsetup/batch_daemon \
tbsetup/webbatchexp tbsetup/webreport \
tbsetup/webswapexp tbsetup/swapexp \
tbsetup/startexp tbsetup/endexp tbsetup/webstartexp tbsetup/webendexp \
tbsetup/snmpit tbsetup/ns2ir/GNUmakefile \
tbsetup/ns2ir/parse.tcl tbsetup/ns2ir/tb_compat.tcl \
......
......@@ -161,6 +161,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
tbsetup/sched_reload tbsetup/sched_reserve tbsetup/reload_daemon \
tbsetup/batchexp tbsetup/batch_daemon \
tbsetup/webbatchexp tbsetup/webreport \
tbsetup/webswapexp tbsetup/swapexp \
tbsetup/startexp tbsetup/endexp tbsetup/webstartexp tbsetup/webendexp \
tbsetup/snmpit tbsetup/ns2ir/GNUmakefile \
tbsetup/ns2ir/parse.tcl tbsetup/ns2ir/tb_compat.tcl \
......
......@@ -11,7 +11,7 @@ include $(OBJDIR)/Makeconf
SUBDIRS = checkpass ns2ir
BIN_STUFF = power snmpit tbend tbswapin tbswapout tbprerun tbreport \
os_load savevlans startexp endexp batchexp \
os_load savevlans startexp endexp batchexp swapexp \
node_reboot nscheck node_update savelogs
# Stuff that mere users get on plastic.
......@@ -26,7 +26,7 @@ LIBEXEC_STUFF = mkprojdir rmproj mkacct-ctrl rmacct-ctrl \
os_setup mkexpdir console_setup webnscheck webreport \
webstartexp webendexp webbatchexp \
assign_wrapper ptopgen webnodeupdate webgroupupdate \
webrmgroup
webrmgroup webswapexp
LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm snmpit_intel.pm \
snmpit_cisco.pm snmpit_lib.pm snmpit_apc.pm power_rpc27.pm
......
......@@ -8,9 +8,9 @@ use Getopt::Std;
sub usage()
{
die("Usage: batchexp [-i] [-x expires] [-E description] [-g gid] ".
"-p <pid> -e <eid> <nsfile>\n");
"[-s] [-n low|high] -p <pid> -e <eid> <nsfile>\n");
}
my $optlist = "iE:d:g:x:e:p:";
my $optlist = "iE:d:g:x:e:p:sn:";
#
# Configure variables
......@@ -53,6 +53,8 @@ my $gid;
my $description;
my $expires;
my $tempnsfile;
my $swappable = 0;
my $priority = TB_EXPTPRIORITY_LOW;
#
# Verify user and get his DB uid.
......@@ -119,9 +121,9 @@ if ($query_result->numrows) {
#
if (! DBQueryWarn("INSERT INTO experiments ".
"(eid, pid, gid, expt_created, expt_expires, ".
" expt_name, expt_head_uid, state) ".
" expt_name, expt_head_uid, state, priority, swappable) ".
"VALUES ('$eid', '$pid', '$gid', now(), '$expires', ".
"$description, '$dbuid', 'new')")) {
"$description, '$dbuid', 'new', $priority, $swappable)")) {
DBQueryWarn("unlock tables");
die("*** $0:\n".
" Database error inserting record for $pid/$eid!\n");
......@@ -301,6 +303,20 @@ sub ParseArgs()
if (defined($options{"E"})) {
$description = $options{"E"};
}
if (defined($options{"s"})) {
$swappable = 1;
}
if (defined($options{"n"})) {
if ($options{"n"} eq "low") {
$priority = TB_EXPTPRIORITY_LOW;
}
elsif ($options{"n"} eq "high") {
$priority = TB_EXPTPRIORITY_HIGH;
}
else {
usage();
}
}
# Note different taint check (allow /).
if ($tempnsfile =~ /^([-\@\w.\/]+)$/) {
......
......@@ -94,15 +94,6 @@ else {
die("Tainted argument $eid!\n");
}
$logname = `mktemp /tmp/start-$pid-$eid.XXXXXX`;
if ($logname =~ /^([-\@\w.\/]+)$/) {
$logname = $1;
}
else {
die("Bad data in logfile name: $logname");
}
#
# Verify user and get his DB uid.
#
......@@ -152,14 +143,13 @@ my $expt_path = $hashrow{'path'};
my $isbatchexpt = $hashrow{'batchmode'};
my $ebatchstate = $hashrow{'batchstate'};
if (defined($hashrow{'expt_terminating'})) {
$val = $hashrow{'expt_terminating'};
if (defined($hashrow{'expt_locked'})) {
$val = $hashrow{'expt_locked'};
print STDOUT
"It appears that $pid/$eid started terminating at $val\n".
"You will be notified via email when the experiment has been ".
"torn down\n";
exit(-1);
die("*** $0:\n".
" It appears that $pid/$eid went into transition at $val.\n".
" You will be notified via email when the experiment is no\n".
" longer in transition.\n");
}
#
......@@ -222,7 +212,7 @@ if ($estate eq EXPTSTATE_PRERUN ||
#
# Set the timestamp now, and unlock the experiments table.
#
DBQueryFatal("UPDATE experiments SET expt_terminating=now() ".
DBQueryFatal("UPDATE experiments SET expt_locked=now() ".
"WHERE eid='$eid' and pid='$pid'");
DBQueryFatal("unlock tables");
......@@ -251,6 +241,15 @@ if (! UserDBInfo($expt_head_login, \$expt_head_name, \$expt_head_email)) {
# If not in batch mode, go into the background. Parent exits.
#
if (! $batch) {
$logname = `mktemp /tmp/end-$pid-$eid.XXXXXX`;
if ($logname =~ /^([-\@\w.\/]+)$/) {
$logname = $1;
}
else {
die("Bad data in logfile name: $logname");
}
if (TBBackGround($logname)) {
#
# Parent exits normally
......@@ -325,7 +324,9 @@ SENDMAIL("$user_name <$user_email>",
"Bcc: $TBLOGS",
($logname));
unlink("$logname");
if (defined($logname)) {
unlink("$logname");
}
exit 0;
sub fatal($)
......@@ -337,7 +338,7 @@ sub fatal($)
#
# Kill this for convenience later.
#
DBQueryWarn("update experiments set expt_terminating=NULL ".
DBQueryWarn("update experiments set expt_locked=NULL ".
"WHERE eid='$eid' and pid='$pid'");
#
......@@ -358,7 +359,9 @@ sub fatal($)
"Bcc: $TBOPS",
($logname));
unlink("$logname");
if (defined($logname)) {
unlink("$logname");
}
exit(-1);
}
......
......@@ -189,6 +189,14 @@ if (! chdir("$expt_path/$tbdata")) {
" Could not chdir to $expt_path/$tbdata: $!\n");
}
#
# Lock the experiment record with the timestamp so that it cannot
# terminated or swapped. This is basically a wrapper state for the
# variety of actual states.
#
DBQueryFatal("UPDATE experiments SET expt_locked=now() ".
"WHERE eid='$eid' and pid='$pid'");
#
# The rest of this goes into the background so that the user sees
# immediate response. We will send email later when the experiment
......@@ -238,9 +246,11 @@ DBQueryWarn("update projects ".
#
# Gen up a date for the started field of the record, and insert it.
# Unlock the experiment at the same time.
#
$expt_started = DBDateTime();
DBQueryWarn("update experiments set expt_start='$expt_started' ".
DBQueryWarn("update experiments set ".
"expt_start='$expt_started', expt_locked=NULL ".
"WHERE eid='$eid' and pid='$pid'");
#
......@@ -294,7 +304,7 @@ my $message =
"\n".
"Appended at the end is the output of the experiment setup. If you\n" .
"have any questions or comments, please include the output below\n" .
"in your message to $TBOPS\n";
"in your message to $TBOPS";
SENDMAIL("$user_name <$user_email>",
......@@ -328,12 +338,6 @@ sub fatal()
exit($errorstat);
}
#
# Otherwise, we have to cleanup since we are disconnected from the
# wrapper script.
#
ExptCleanup();
#
# Send a message to the testbed list.
#
......@@ -343,7 +347,13 @@ sub fatal()
"$user_name <$user_email>",
"Cc: $TBOPS",
($logname, "assign.log", $nsfile));
#
# We have to cleanup since we are disconnected from the wrapper script.
# Must be done after sending email so the nsfile is still around.
#
ExptCleanup();
unlink($logname);
exit($errorstat);
......
#!/usr/bin/perl -wT
use English;
use Getopt::Std;
#
# This gets invoked from the Web interface. Swap an experiment in or out.
#
# Note about exit value. -1 means error. 0 means backgrounded. 1 means
# somthing else. The web page uses this to decide what kind of message
# to give the user.
#
sub usage()
{
print STDOUT "Usage: swapexp [-b] <-s in | out> <pid> <eid>\n";
exit(-1);
}
my $optlist = "bs:";
#
# Configure variables
#
my $TB = "@prefix@";
my $DBNAME = "@TBDBNAME@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBLOGS = "@TBLOGSEMAIL@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
my $tbdir = "$TB/bin/";
my $batch = 0;
my $inout;
my $logname;
my $dbuid;
my $user_name;
my $user_email;
my @row;
#
# Untaint the path
#
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Turn off line buffering on output
#
$| = 1;
#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
usage();
}
if (@ARGV != 2) {
usage();
}
my $pid = $ARGV[0];
my $eid = $ARGV[1];
if (defined($options{"b"})) {
$batch = $options{"b"};
}
if (defined($options{"s"})) {
$inout = $options{"s"};
if ($inout ne "out" && $inout ne "in") {
usage();
}
}
else {
usage();
}
#
# Untaint the arguments.
#
if ($pid =~ /^([-\@\w.]+)$/) {
$pid = $1;
}
else {
die("Tainted argument $pid!\n");
}
if ($eid =~ /^([-\@\w.]+)$/) {
$eid = $1;
}
else {
die("Tainted argument $eid!\n");
}
#
# Verify user and get his DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
die("*** $0:\n".
" You do not exist in the Emulab Database.\n");
}
#
# Get email info for user.
#
if (! UserDBInfo($dbuid, \$user_name, \$user_email)) {
die("*** $0:\n".
" Cannot determine your name and email address.\n");
}
#
# Verify that this person is allowed to end the experiment.
# Note that any script down the line has to do an admin check also.
#
if ($UID && !TBAdmin($UID) &&
!TBExptAccessCheck($dbuid, $pid, $eid, TB_EXPT_DESTROY)) {
die("*** $0:\n".
" You do not have permission to end this experiment!\n");
}
#
# We have to protect against trying to end an experiment that is currently
# in the process of being terminated. We use a "wrapper" state (actually
# a timestamp so we can say when termination was requested) since
# terminating consists of a couple of different experiment states down inside
# the tb scripts.
#
DBQueryFatal("lock tables experiments write");
$query_result =
DBQueryFatal("SELECT * FROM experiments WHERE eid='$eid' and pid='$pid'");
if (! $query_result->numrows) {
die("*** $0:\n".
" No such experiment $pid/$eid exists!\n");
}
my %hashrow = $query_result->fetchhash();
my $expt_head_login = $hashrow{'expt_head_uid'};
my $estate = $hashrow{'state'};
my $expt_path = $hashrow{'path'};
my $isbatchexpt = $hashrow{'batchmode'};
my $ebatchstate = $hashrow{'batchstate'};
if (defined($hashrow{'expt_locked'})) {
$val = $hashrow{'expt_locked'};
die("*** $0:\n".
" It appears that $pid/$eid went into transition at $val.\n".
" You will be notified via email when experiment transition ".
" is complete.\n");
}
#
# Disallow batch experiment swaps for now.
#
if ($isbatchexpt) {
die("*** $0:\n".
" Batch experiments cannot be swapped yet!");
}
#
# Okay, check state. We do not allow swapping to start when the
# experiment is in transition. A future task would be to allow this,
# but for now the experiment must be in one of a few states to proceed
#
# Seems like too many states!
#
if ($estate ne EXPTSTATE_ACTIVE && $estate ne EXPTSTATE_SWAPPED) {
die("*** $0:\n".
" It appears that experiment $pid/$eid is in transition.\n".
" The user that created the experiment will be notified via\n".
" email when the experiment is no longer in transition.\n");
}
if ($inout eq "in" && $estate eq EXPTSTATE_ACTIVE) {
die("*** $0:\n".
" It appears that experiment $pid/$eid is already swapped in!");
}
if ($inout eq "out" && $estate eq EXPTSTATE_SWAPPED) {
die("*** $0:\n".
" It appears that experiment $pid/$eid is already swapped out!");
}
#
# Set the timestamp now, and unlock the experiments table.
#
DBQueryFatal("UPDATE experiments SET expt_locked=now() ".
"WHERE eid='$eid' and pid='$pid'");
DBQueryFatal("unlock tables");
#
# XXX - At this point a failure is going to leave things in an
# inconsistent state.
#
#
# Get email address of the experiment head, which may be different than
# the person who is actually terminating the experiment, since its polite
# to let the original creator know whats going on.
#
my $expt_head_name;
my $expt_head_email;
if (! UserDBInfo($expt_head_login, \$expt_head_name, \$expt_head_email)) {
print STDERR "*** WARNING: ".
"Could not determine name/email for $expt_head_login.\n";
$expt_head_name = "TBOPS";
$expt_head_email = $TBOPS;
}
#
# If not in batch mode, go into the background. Parent exits.
#
if (! $batch) {
$logname = `mktemp /tmp/swap-$pid-$eid.XXXXXX`;
if ($logname =~ /^([-\@\w.\/]+)$/) {
$logname = $1;
}
else {
die("Bad data in logfile name: $logname");
}
if (TBBackGround($logname)) {
#
# Parent exits normally
#
print STDOUT
"Experiment $pid/$eid is now swapping $inout.\n".
"You will be notified via email when the experiment has ".
"finished swapping.\n";
exit(0);
}
}
#
# Sanity check states in case someone changes something.
#
if ($inout eq "out") {
print STDOUT "Running tbswapout with arguments: $pid $eid\n";
if (system("$tbdir/tbswapout $pid $eid") != 0) {
fatal("tbswapout failed!\n");
}
$estate = ExpState($pid,$eid);
if ($estate ne EXPTSTATE_SWAPPED) {
fatal("Experiment is in the wrong state: $estate\n");
}
}
else {
print STDOUT "Running tbswapin with arguments: $pid $eid\n";
if (system("$tbdir/tbswapin $pid $eid") != 0) {
fatal("tbswapin failed!\n");
}
$estate = ExpState($pid,$eid);
if ($estate ne EXPTSTATE_ACTIVE) {
fatal("Experiment is in the wrong state: $estate\n");
}
}
#
# Must unlock before exit.
#
DBQueryWarn("update experiments set expt_locked=NULL ".
"WHERE eid='$eid' and pid='$pid'");
print "Swap Success\n";
#
# In batch mode, just exit without sending email.
#
if ($batch) {
exit(0);
}
#
# Send email notification to user.
#
my $message =
"Experiment `$eid' in project `$pid' has been swapped $inout.\n\n" .
"Appended below is the output of the experiment swap${inout}. If you\n" .
"have any questions or comments, please include the output below\n" .
"in your message to $TBOPS\n";
SENDMAIL("$user_name <$user_email>",
"TESTBED: Experiment $pid/$eid Swapped $inout",
$message,
"$user_name <$user_email>",
"Cc: $expt_head_name <$expt_head_email>\n".
"Bcc: $TBLOGS",
($logname));
if (defined($logname)) {
unlink("$logname");
}
exit 0;
sub fatal($)
{
my($mesg) = $_[0];
print STDOUT $mesg;
#
# Kill this for convenience later.
#
DBQueryWarn("update experiments set expt_locked=NULL ".
"WHERE eid='$eid' and pid='$pid'");
#
# In batch mode, exit without sending the email.
#
if ($batch) {
exit(-1);
}
#
# Send a message to the testbed list. Append the logfile.
#
SENDMAIL("$user_name <$user_email>",
"TESTBED: Swap${inout} Failure: $pid/$eid",
$mesg,
"$user_name <$user_email>",
"Cc: $expt_head_name <$expt_head_email>\n".
"Bcc: $TBOPS",
($logname));
if (defined($logname)) {
unlink("$logname");
}
exit(-1);
}
......@@ -112,13 +112,13 @@ if ($state eq EXPTSTATE_SWAPPED) {
my $result = DBQueryFatal("SELECT vname,member,delay,bandwidth,lossrate" .
" from virt_lans where pid=\"$pid\" and eid=\"$eid\"");
print "Lan/Link Info:\n";
printf "%-15s %-15s %-15s %-10s %-10s %-10s\n", "ID", "Member",
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", "ID", "Member",
"IP", "Delay", "Bandwidth", "Loss Rate";
print "--------------- --------------- --------------- ----------"
. " ---------- ----------\n";
print "--------------- --------------- --------------- --------- "
. "--------- ---------\n";
while (($vname,$member,$delay,$bandwidth,$lossrate)
= $result->fetchrow_array()) {
printf "%-15s %-15s %-15s %-10s %-10s %-10s\n", $vname,
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", $vname,
$member, $ipmap{$member}, $delay, $bandwidth, $lossrate;
}
$result->finish();
......@@ -152,10 +152,10 @@ if (($state eq EXPTSTATE_ACTIVE) || ($state eq EXPTSTATE_TESTING)) {
$result = DBQueryFatal("SELECT vname,member,delay,bandwidth,lossrate" .
" from virt_lans where pid=\"$pid\" and eid=\"$eid\"");
print "Lan/Link Info:\n";
printf "%-15s %-15s %-15s %-10s %-10s %-10s\n", "ID", "Member",
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", "ID", "Member",
"IP", "Delay", "Bandwidth", "Loss Rate";
print "--------------- --------------- --------------- ----------"
. " ---------- ----------\n";
print "--------------- --------------- --------------- --------- "
. "--------- ---------\n";
while (($vname,$member,$delay,$bandwidth,$lossrate)
= $result->fetchrow_array()) {
($vnode,$vport) = split(":",$member);
......@@ -165,7 +165,7 @@ if (($state eq EXPTSTATE_ACTIVE) || ($state eq EXPTSTATE_TESTING)) {
# shark hack
$pport = "eth0";
}
printf "%-15s %-15s %-15s %-10s %-10s %-10s\n", $vname,
printf "%-15s %-15s %-15s %-9s %-9s %-9s\n", $vname,
"$vnode:$pport", $ipmap{$member}, $delay, $bandwidth, $lossrate;
}
$result->finish();
......
#!/usr/bin/perl -w
use English;
#
# This gets invoked from the Web interface. Simply a wrapper ...
#
# usage: webswapexp arguments ...
#
#
# Configure variables
#
my $TB = "@prefix@";
#
# Run the real thing, and never return.
#
exec "$TB/bin/swapexp", @ARGV;
die("webswapexp: Could not exec swapexp: $!");
......@@ -27,6 +27,20 @@ if (!isset($exp_name) ||
FORMERROR("Experiment Description");
}
if (isset($exp_swappable)) {
if (strcmp($exp_swappable, "")) {
unset($exp_swappable);
}
elseif (strcmp($exp_swappable, "Yep")) {
USERERROR("Invalid argument for Swappable.", 1);
}
}
if (isset($exp_priority) &&
strcmp($exp_priority, "low") && strcmp($exp_priority, "high")) {
USERERROR("Invalid argument for Priority.", 1);
}
#
# Only known and logged in users can begin experiments.
#
......@@ -127,6 +141,22 @@ if (!TBValidGroup($exp_pid, $exp_gid)) {
USERERROR("No such group $exp_gid in project $exp_gid!", 1);
}
#
# Convert Priority and Swappable params to arguments to script.
#
if (isset($exp_swappable)) {
$exp_swappable = "-s";
}
else {
$exp_swappable = "";
}
if (!isset($exp_priority) || strcmp($exp_priority, "high") == 0) {
$exp_priority = "-n high";
}
else {
$exp_priority = "-n low";
}
#
# Verify permissions.
#
......@@ -157,6 +187,7 @@ $last = time();
$result = exec("$TBSUEXEC_PATH $uid $unix_gid ".
"webbatchexp -x \"$exp_expires\" -E \"$exp_name\" ".
"$exp_priority $exp_swappable ".
"-p $exp_pid -g $exp_gid -e $exp_id $nsfile",
$output, $retval);
......
......@@ -114,11 +114,23 @@ echo "<tr>
name=\"exp_expires\"></td>
</tr>\n";
echo "<tr>
<td colspan=2>Swappable?[<b>1</b>]:</td>
<td><input type=checkbox name=exp_swappable value=Yep> Yes</td>
</tr>\n";
echo "<tr>
<td colspan=2>Priority[<b>2</b>]:</td>
<td><input type=radio name=exp_priority value=low checked> <b>Low</b>
&nbsp &nbsp &nbsp
<input type=radio name=exp_priority value=high> High</td>
</tr>\n";
#
# Select a group
#
echo "<tr>
<td colspan=2>Group:<br>(leave blank to use default group)</td>
<td colspan=2>Group[<b>3</b>]:</td>
<td><input type=\"text\" name=\"exp_gid\"
size=$TBDB_GIDLEN maxlength=$TBDB_GIDLEN>
</td>
......@@ -133,6 +145,21 @@ echo "<tr>
</form>
</table>
<h4><blockquote><blockquote><blockquote>
<dl COMPACT>
<dt>[1]
<dd>Check if your experiment can be swapped out and swapped back in
without harm to your experiment. Useful for scheduling when
resources are tight.
<dt>[2]
<dd>You get brownie points for marking your experiments as Low
Priority, which indicates that we can swap you out before high
priority experiments.
<dt>[3]
<dd>Leave blank to use the default group for the project.
</dl>
</blockquote></blockquote></blockquote></h4>
<p>
<center>
<img alt="*" src="redball.gif">
......
......@@ -106,20 +106,31 @@ echo "<tr>
name=\"exp_expires\"></td>
</tr>\n";
echo "<tr>
<td colspan=2>Swappable?[<b>1</b>]:</td>
<td><input type=checkbox name=exp_swappable value=Yep> Yes</td>
</tr>\n";
echo "<tr>
<td colspan=2>Priority[<b>2</b>]:</td>
<td><input type=radio name=exp_priority value=low checked> <b>Low</b>