Commit b9161642 authored by Leigh B. Stoller's avatar Leigh B. Stoller

By popular demand, you can now force a swap modify to be done when

doing a Start Run. On the web page, there is a new checkbox, and
on ops, template_startrun takes a new -m option.

Caveat: You cannot specify a new NS file, yet. The original file is
reparsed, and the idea is that a change in the template parameters
will result in a change to the topology. I will add the ability to
specify a new NS file in the next revision of this change.

If you really really want to change the NS file, go to
/proj/$pid/exp/$eid/archive/nsdata and edit nsfile.ns ...

In addtion, DATASTORE is now defined while parsing the NS file. This
turned to be quite the headache!
parent 7f78f90e
...@@ -580,9 +580,9 @@ sub WebKeyPath($) ...@@ -580,9 +580,9 @@ sub WebKeyPath($)
# #
# Add an environment variable. # Add an environment variable.
# #
sub AddEnvVariable($$$) sub AddEnvVariable($$$;$)
{ {
my ($self, $var, $val) = @_; my ($self, $name, $value, $index) = @_;
# Must be a real reference. # Must be a real reference.
return -1 return -1
...@@ -591,10 +591,19 @@ sub AddEnvVariable($$$) ...@@ -591,10 +591,19 @@ sub AddEnvVariable($$$)
my $pid = $self->pid(); my $pid = $self->pid();
my $eid = $self->eid(); my $eid = $self->eid();
return -1 if (defined($value)) {
if (! DBQueryWarn("insert into virt_user_environment set ". $value = DBQuoteSpecial($value);
" name='$var', value='$val', ". }
" pid='$pid', eid='$eid'")); else {
$value = "''";
}
DBQueryWarn("replace into virt_user_environment set ".
" name='$name', value=$value, ".
(defined($index) ? "idx=$index, " : "") .
" pid='$pid', eid='$eid'")
or return -1;
return 0; return 0;
} }
......
...@@ -26,6 +26,7 @@ use overload ('""' => 'Stringify'); ...@@ -26,6 +26,7 @@ use overload ('""' => 'Stringify');
# Configure variables # Configure variables
my $TB = "@prefix@"; my $TB = "@prefix@";
my $CONTROL = "@USERNODE@";
my $MD5 = "/sbin/md5"; my $MD5 = "/sbin/md5";
my $MKDIR = "/bin/mkdir"; my $MKDIR = "/bin/mkdir";
my $RMDIR = "/bin/rmdir"; my $RMDIR = "/bin/rmdir";
...@@ -2044,8 +2045,7 @@ sub NewRun($$;$) ...@@ -2044,8 +2045,7 @@ sub NewRun($$;$)
my $query_result = my $query_result =
DBQueryWarn("insert into experiment_runs set ". DBQueryWarn("insert into experiment_runs set ".
" exptidx='$exptidx', runid='$runid', $dclause ". " $dclause exptidx='$exptidx', runid='$runid' ");
" start_time=now()");
return -1 return -1
if (! $query_result); if (! $query_result);
...@@ -2096,6 +2096,31 @@ sub DeleteCurrentRun($) ...@@ -2096,6 +2096,31 @@ sub DeleteCurrentRun($)
return Refresh($self); return Refresh($self);
} }
#
# Start the (first) experiment run.
#
sub StartFirstRun($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $idx = $self->idx();
my $runidx = $self->runidx();
my $exptidx = $self->exptidx();
return -1
if (!defined($runidx));
DBQueryWarn("update experiment_runs set start_time=now() ".
"where exptidx='$exptidx' and idx='$runidx'")
or return -1;
return $self->Start();
}
# #
# Stop the current experiment run, # Stop the current experiment run,
# #
...@@ -2266,13 +2291,44 @@ sub NewRunBinding($$$) ...@@ -2266,13 +2291,44 @@ sub NewRunBinding($$$)
" name='$name', value=$value") " name='$name', value=$value")
or return -1; or return -1;
DBQueryFatal("replace into virt_user_environment set ". DBQueryWarn("replace into virt_user_environment set ".
" name='$name', value=$value, ". " name='$name', value=$value, ".
" pid='$pid', eid='$eid'"); " pid='$pid', eid='$eid'")
or return -1;
return 0; return 0;
} }
#
# Get list of bindings for the current run.
#
sub RunBindingList($$)
{
my ($self, $prval) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my %results = ();
my $exptidx = $self->exptidx();
my $runidx = $self->runidx();
my $query_result =
DBQueryWarn("select name,value ".
" from experiment_run_bindings ".
"where exptidx='$exptidx' and runidx='$runidx'");
return -1
if (!$query_result);
while (my ($name,$value) = $query_result->fetchrow_array()) {
$results{$name} = $value;
}
%$prval = %results;
return 0;
}
# #
# Make up a new run name based on the previous run name. # Make up a new run name based on the previous run name.
# #
...@@ -2739,6 +2795,98 @@ sub WriteEnvVariables($) ...@@ -2739,6 +2795,98 @@ sub WriteEnvVariables($)
return $experiment->WriteEnvVariables(); return $experiment->WriteEnvVariables();
} }
#
# Setup the environment variables for a template swapin.
#
sub InitializeEnvVariables($;$)
{
my ($self, $parameters) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $experiment = $self->Experiment();
my $instance_path = $self->path();
my $pid = $self->pid();
my $eid = $self->eid();
my $dbuid = $self->uid();
return -1
if (! defined($experiment));
#
# Ick, Ick, Ick. I want these to be at the beginning of the enviroment
# strings so they are set in case the user has used any OPT variables
# in the NS file (and they refer to $DATASTORE or $ARCHIVE).
#
my $query_result =
DBQueryWarn("select MAX(idx) from virt_user_environment ".
"where pid='$pid' and eid='$eid'");
return -1
if (!$query_result);
my ($maxenv) = $query_result->fetchrow_array();
if ($maxenv) {
for (my $idx = $maxenv; $idx > 0; $idx--) {
my $newidx = $idx + 2;
DBQueryFatal("update virt_user_environment set idx=$newidx ".
"where idx='$idx' and pid='$pid' and eid='$eid'");
}
}
$experiment->AddEnvVariable("DATASTORE",
"$instance_path/template_datastore", 1)
== 0 or return -1;
$experiment->AddEnvVariable("ARCHIVE",
"$instance_path/archive", 2)
== 0 or return -1;
if ($experiment->dpdb() && $experiment->dpdbname() ne "") {
my $dpdbname = $experiment->dpdbname();
$experiment->AddEnvVariable("DP_DBNAME", $dpdbname) == 0
or return -1;
$experiment->AddEnvVariable("DP_HOST", $CONTROL) == 0
or return -1;
#
# XXX This needs to change to a per-experiment user/password.
#
$experiment->AddEnvVariable("DP_USER", $dbuid) == 0
or return -1;
$query_result =
DBQueryFatal("select mailman_password from users ".
"where uid='$dbuid'");
my ($mailman_password) = $query_result->fetchrow_array();
if (defined($mailman_password)) {
$experiment->AddEnvVariable("DP_PASSWORD", $mailman_password) == 0
or return -1;
}
}
#
# Before we actually swapin, copy the parameters to the environment
# table so that they are available to the program agent when it starts up
# on the nodes.
#
if (defined($parameters)) {
foreach my $name (keys(%{ $parameters })) {
my $value = $parameters->{$name};
$experiment->AddEnvVariable($name, $value) == 0
or return -1;
}
}
return 0;
}
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
...@@ -50,6 +50,7 @@ my $pid; ...@@ -50,6 +50,7 @@ my $pid;
my $gid; my $gid;
my $eid; my $eid;
my $nsfile; my $nsfile;
my $experiment;
# #
# Turn off line buffering on output # Turn off line buffering on output
...@@ -86,6 +87,8 @@ use libtestbed; ...@@ -86,6 +87,8 @@ use libtestbed;
use libtblog; use libtblog;
use libtblog qw(dblog *SERR); use libtblog qw(dblog *SERR);
use NodeType; use NodeType;
use Template;
use Experiment;
use constant false => 0; use constant false => 0;
use constant true => 1; use constant true => 1;
...@@ -152,6 +155,12 @@ if (defined($pid)) { ...@@ -152,6 +155,12 @@ if (defined($pid)) {
else { else {
die("Bad data in argument: $gid."); die("Bad data in argument: $gid.");
} }
# Slowly convert to new libraries ...
$experiment = Experiment->Lookup($pid, $eid);
if (! defined($experiment)) {
tbdie("Cannot find the experiment object for $pid/$eid");
}
} }
# Remove temps cause of swapin by alternates. # Remove temps cause of swapin by alternates.
...@@ -626,26 +635,40 @@ sub GenDefsFile($) ...@@ -626,26 +635,40 @@ sub GenDefsFile($)
# #
# For Templates. # For Templates.
# #
if (defined($pid)) { print TCL "# Template goo\n";
$query_result = # Does not matter what it is, as long as it is set.
DBQueryFatal("select instance_idx from experiments ". print TCL "set ::DATASTORE \"/proj\"\n";
"where pid='$pid' and eid='$eid'");
my ($instance_idx) = $query_result->fetchrow_array(); if (defined($experiment)) {
if ($instance_idx) { my $instance =
print TCL "# Template goo\n"; Template::Instance->LookupByID($experiment->instance_idx());
$query_result = if (defined($instance)) {
DBQueryFatal("select * from experiment_template_instance_bindings ". my $datastore = $instance->path() . "/template_datastore";
"where instance_idx='$instance_idx'"); my %parameters;
while (my %row = $query_result->fetchhash()) { print TCL "set ::DATASTORE \"$datastore\"\n";
my $name = $row{'name'};
my $value = $row{'value'}; $instance->BindingList(\%parameters) == 0
or tbdie("Could not get binding list for $instance");
foreach my $name (keys(%parameters)) {
my $value = $parameters{$name};
print TCL "set parameter_list_defaults($name) \"$value\"\n";
}
$instance->RunBindingList(\%parameters) == 0
or tbdie("Could not get run binding list for $instance");
foreach my $name (keys(%parameters)) {
my $value = $parameters{$name};
print TCL "set parameter_list_defaults($name) \"$value\"\n"; print TCL "set parameter_list_defaults($name) \"$value\"\n";
} }
} }
} }
print TCL "\n\n";
print TCL "}\n"; print TCL "}\n";
close(TCL); close(TCL);
......
...@@ -14,6 +14,7 @@ variable links ...@@ -14,6 +14,7 @@ variable links
# optional items # optional items
variable rtproto "none" variable rtproto "none"
variable simname variable simname
variable DATASTORE "/proj"
rename puts real_puts rename puts real_puts
proc puts {args} { proc puts {args} {
......
...@@ -43,7 +43,7 @@ sub usage() ...@@ -43,7 +43,7 @@ sub usage()
"<guid/vers> - GUID and version to swapin\n"); "<guid/vers> - GUID and version to swapin\n");
exit(-1); exit(-1);
} }
my $optlist = "qwx:p:E:a:r:e:dscft:i"; my $optlist = "qwx:p:E:a:r:e:dscft:im";
my %options = (); my %options = ();
my $quiet = 0; my $quiet = 0;
my $waitmode = 0; my $waitmode = 0;
...@@ -51,6 +51,7 @@ my $debug = 0; ...@@ -51,6 +51,7 @@ my $debug = 0;
my $foreground = 0; my $foreground = 0;
my $ignoreerrors = 0; my $ignoreerrors = 0;
my $clean = 0; my $clean = 0;
my $doswapmod = 0;
my $paramfile; my $paramfile;
my %parameters = (); my %parameters = ();
my $action; my $action;
...@@ -89,6 +90,7 @@ my $cleaning = 0; ...@@ -89,6 +90,7 @@ my $cleaning = 0;
my $justexit = 1; my $justexit = 1;
# Programs we need # Programs we need
my $swapexp = "$TB/bin/swapexp";
my $checkquota = "$TB/sbin/checkquota"; my $checkquota = "$TB/sbin/checkquota";
my $archcontrol = "$TB/bin/archive_control"; my $archcontrol = "$TB/bin/archive_control";
my $eventcontrol= "$TB/bin/eventsys_control"; my $eventcontrol= "$TB/bin/eventsys_control";
...@@ -423,42 +425,48 @@ $justexit = 0; ...@@ -423,42 +425,48 @@ $justexit = 0;
# #
# And the bindings for the run ... # And the bindings for the run ...
# #
if ($paramfile) { foreach my $name (keys(%parameters)) {
foreach my $name (keys(%parameters)) { my $value = $parameters{$name};
my $value = $parameters{$name};
$instance->NewRunBinding($name, $value) == 0 $instance->NewRunBinding($name, $value) == 0
or fatal(-1, "Could not create new experiment run binding ". or fatal(-1, "Could not create new experiment run binding ".
"for $instance!"); "for $instance!");
}
# # We munge the environment variables.
# Hmm. Before we actually swapin, copy the parameters to the $instance->InitializeEnvVariables(\%parameters) == 0
# environment table so that they are available to the program or fatal(-1, "Could not add new environment variables to instance");
# agent when it starts up on the nodes (say, on reboot).
#
if (defined($value)) {
$value = DBQuoteSpecial($value);
}
else {
$value = "''";
}
DBQueryFatal("update virt_user_environment set value=$value ".
"where pid='$pid' and eid='$eid' and name='$name'");
}
print "Writing environment strings ...\n";
$instance->WriteEnvVariables() == 0
or fatal(-1, "Could not write environment strings for program agents");
print "Asking program agents to reload ... this will take a moment.\n"; print "Writing environment strings ...\n";
SignalProgAgents("RELOAD"); $instance->WriteEnvVariables() == 0
} or fatal(-1, "Could not write environment strings for program agents");
print "Asking program agents to reload ... this will take a moment.\n";
SignalProgAgents("RELOAD");
#
# Restart the event stream from the beginning. if ($doswapmod) {
# #
print "Asking the event system to replay events ...\n"; # Now do the swapmod, using the original NS file for now.
system("$eventcontrol replay $pid $eid") == 0 #
or fatal(-1, "Could not restart the event system!"); my $archivedir = libArchive::TBUserFileArchiveDirectory($pid, $eid);
my $nsfile = "$archivedir/nsdata/nsfile.ns";
my @arguments = ($swapexp, "-q", "-x", "-s", "modify",
$pid, $eid, $nsfile);
print "Starting a swap modify ...\n";
system(@arguments);
fatal($? >> 8, "Swap modify failed!")
if ($?);
}
else {
#
# Restart the event stream from the beginning.
#
print "Asking the event system to replay events ...\n";
system("$eventcontrol replay $pid $eid") == 0
or fatal(-1, "Could not restart the event system!");
}
print "Experiment run '$runid' has been started.\n"; print "Experiment run '$runid' has been started.\n";
done: done:
...@@ -582,6 +590,9 @@ sub ParseArgs() ...@@ -582,6 +590,9 @@ sub ParseArgs()
if (defined($options{"i"})) { if (defined($options{"i"})) {
$ignoreerrors = 1; $ignoreerrors = 1;
} }
if (defined($options{"m"})) {
$doswapmod = 1;
}
if (defined($options{"t"})) { if (defined($options{"t"})) {
$ctoken = $options{"t"}; $ctoken = $options{"t"};
......
...@@ -452,27 +452,6 @@ if ($paramfile) { ...@@ -452,27 +452,6 @@ if ($paramfile) {
or tbdie("Could not copy out $paramfile"); or tbdie("Could not copy out $paramfile");
} }
#
# Hmm. Before we actually swapin, copy the parameters to the environment
# table so that they are available to the program agent when it starts up
# on the nodes. Note that we destructively modify a virt_ table, but thats
# okay for now. Of course, it has to be done *before* the swapin so that
# the values are in place when the nodes boot!
#
foreach my $name (keys(%parameters)) {
my $value = $parameters{$name};
if (defined($value)) {
$value = DBQuoteSpecial($value);
}
else {
$value = "''";
}
DBQueryFatal("replace into virt_user_environment set ".
" name='$name', value=$value, ".
" pid='$pid', eid='$eid'");
}
# #
# Copy the datastore into the experiment directory. This really needs # Copy the datastore into the experiment directory. This really needs
# to be a checkout, and it really needs to go someplace other then the # to be a checkout, and it really needs to go someplace other then the
...@@ -488,57 +467,10 @@ $instance->CopyDataStore($template_tag, ...@@ -488,57 +467,10 @@ $instance->CopyDataStore($template_tag,
$instance->CopyTemplateEvents() == 0 $instance->CopyTemplateEvents() == 0
or fatal(-1, "Could not copy template events to instance"); or fatal(-1, "Could not copy template events to instance");
# # We munge the environment variables.
# Ick, Ick, Ick. I want these to be at the beginning of the enviroment $instance->InitializeEnvVariables(\%parameters) == 0
# strings so they are set in case the user has used any OPT variables or fatal(-1, "Could not add new environment variables to instance");
# in the NS file (and they refer to $DATASTORE or $ARCHIVE).
#
my $query_result =
DBQueryFatal("select MAX(idx) from virt_user_environment ".
"where pid='$pid' and eid='$eid'");
my ($maxenv) = $query_result->fetchrow_array();
for (my $idx = $maxenv; $idx > 0; $idx--) {
my $newidx = $idx + 2;
DBQueryFatal("update virt_user_environment set idx=$newidx ".
"where idx='$idx' and pid='$pid' and eid='$eid'");
}
DBQueryFatal("replace into virt_user_environment set ".
" name='DATASTORE', value='$instance_path/template_datastore',".
" idx=1, pid='$pid', eid='$eid'");
DBQueryFatal("replace into virt_user_environment set ".
" name='ARCHIVE', value='$instance_path/archive',".
" idx=2, pid='$pid', eid='$eid'");
if ($experiment->dpdb() && $experiment->dpdbname() ne "") {
my $dpdbname = $experiment->dpdbname();
DBQueryFatal("insert into virt_user_environment set ".
" name='DP_DBNAME', value='$dpdbname',".
" pid='$pid', eid='$eid'");
DBQueryFatal("insert into virt_user_environment set ".
" name='DP_HOST', value='$CONTROL',".
" pid='$pid', eid='$eid'");
#
# XXX This needs to change to a per-experiment user/password.
#
DBQueryFatal("insert into virt_user_environment set ".
" name='DP_USER', value='$dbuid',".
" pid='$pid', eid='$eid'");
my $query_result =
DBQueryFatal("select mailman_password from users where uid='$dbuid'");
my ($mailman_password) = $query_result->fetchrow_array();
if (defined($mailman_password)) {
DBQueryFatal("insert into virt_user_environment set ".
" name='DP_PASSWORD', value='$mailman_password',".
" pid='$pid', eid='$eid'");
}
}
print "Writing environment strings ...\n"; print "Writing environment strings ...\n";
$instance->WriteEnvVariables() == 0 $instance->WriteEnvVariables() == 0
or fatal(-1, "Could not write environment strings for program agents"); or fatal(-1, "Could not write environment strings for program agents");
...@@ -613,15 +545,14 @@ $instance->NewRun($eid, $description) == 0 ...@@ -613,15 +545,14 @@ $instance->NewRun($eid, $description) == 0
# #
# And the bindings for the default run ... # And the bindings for the default run ...
#