diff --git a/db/Experiment.pm.in b/db/Experiment.pm.in index e45ba56859286e1271858aed6d9406c7ab365534..5f86fef0647c3dd8185f997a1266956440da6d3f 100644 --- a/db/Experiment.pm.in +++ b/db/Experiment.pm.in @@ -580,9 +580,9 @@ sub WebKeyPath($) # # Add an environment variable. # -sub AddEnvVariable($$$) +sub AddEnvVariable($$$;$) { - my ($self, $var, $val) = @_; + my ($self, $name, $value, $index) = @_; # Must be a real reference. return -1 @@ -591,10 +591,19 @@ sub AddEnvVariable($$$) my $pid = $self->pid(); my $eid = $self->eid(); - return -1 - if (! DBQueryWarn("insert into virt_user_environment set ". - " name='$var', value='$val', ". - " pid='$pid', eid='$eid'")); + if (defined($value)) { + $value = DBQuoteSpecial($value); + } + 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; } diff --git a/tbsetup/Template.pm.in b/tbsetup/Template.pm.in index 76891daf227f6641afd4d51d0c4179bb2649aea9..102125691efc132138ac728b8ff50dcd6b730b32 100644 --- a/tbsetup/Template.pm.in +++ b/tbsetup/Template.pm.in @@ -26,6 +26,7 @@ use overload ('""' => 'Stringify'); # Configure variables my $TB = "@prefix@"; +my $CONTROL = "@USERNODE@"; my $MD5 = "/sbin/md5"; my $MKDIR = "/bin/mkdir"; my $RMDIR = "/bin/rmdir"; @@ -2044,8 +2045,7 @@ sub NewRun($$;$) my $query_result = DBQueryWarn("insert into experiment_runs set ". - " exptidx='$exptidx', runid='$runid', $dclause ". - " start_time=now()"); + " $dclause exptidx='$exptidx', runid='$runid' "); return -1 if (! $query_result); @@ -2096,6 +2096,31 @@ sub DeleteCurrentRun($) 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, # @@ -2266,13 +2291,44 @@ sub NewRunBinding($$$) " name='$name', value=$value") or return -1; - DBQueryFatal("replace into virt_user_environment set ". - " name='$name', value=$value, ". - " pid='$pid', eid='$eid'"); + DBQueryWarn("replace into virt_user_environment set ". + " name='$name', value=$value, ". + " pid='$pid', eid='$eid'") + or return -1; 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. # @@ -2739,6 +2795,98 @@ sub 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... 1; diff --git a/tbsetup/ns2ir/parse-ns.in b/tbsetup/ns2ir/parse-ns.in index ac6a363faf4fcae6453d0c635c0dcfe344c15a7f..97de81c8ec97818371fb2652cfba91bf64a3f19d 100644 --- a/tbsetup/ns2ir/parse-ns.in +++ b/tbsetup/ns2ir/parse-ns.in @@ -50,6 +50,7 @@ my $pid; my $gid; my $eid; my $nsfile; +my $experiment; # # Turn off line buffering on output @@ -86,6 +87,8 @@ use libtestbed; use libtblog; use libtblog qw(dblog *SERR); use NodeType; +use Template; +use Experiment; use constant false => 0; use constant true => 1; @@ -152,6 +155,12 @@ if (defined($pid)) { else { 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. @@ -626,26 +635,40 @@ sub GenDefsFile($) # # For Templates. # - if (defined($pid)) { - $query_result = - DBQueryFatal("select instance_idx from experiments ". - "where pid='$pid' and eid='$eid'"); - my ($instance_idx) = $query_result->fetchrow_array(); - if ($instance_idx) { - print TCL "# Template goo\n"; + print TCL "# Template goo\n"; + # Does not matter what it is, as long as it is set. + print TCL "set ::DATASTORE \"/proj\"\n"; + + if (defined($experiment)) { + my $instance = + Template::Instance->LookupByID($experiment->instance_idx()); - $query_result = - DBQueryFatal("select * from experiment_template_instance_bindings ". - "where instance_idx='$instance_idx'"); + if (defined($instance)) { + my $datastore = $instance->path() . "/template_datastore"; + my %parameters; - while (my %row = $query_result->fetchhash()) { - my $name = $row{'name'}; - my $value = $row{'value'}; + print TCL "set ::DATASTORE \"$datastore\"\n"; + + $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 "\n\n"; print TCL "}\n"; close(TCL); diff --git a/tbsetup/nsverify/nstbparse.in b/tbsetup/nsverify/nstbparse.in index b07bac98b1f78b6575a43322b8c25582e6bb38b2..15d3b3d21ac1290bb4546a1c0aa5b432cdd3e460 100644 --- a/tbsetup/nsverify/nstbparse.in +++ b/tbsetup/nsverify/nstbparse.in @@ -14,6 +14,7 @@ variable links # optional items variable rtproto "none" variable simname +variable DATASTORE "/proj" rename puts real_puts proc puts {args} { diff --git a/tbsetup/template_exprun.in b/tbsetup/template_exprun.in index 4f0f358f76572767b133a3ce3dfb7f46294da299..b3dfdc917902bfce042a284e35e3a1bfd039e4a6 100644 --- a/tbsetup/template_exprun.in +++ b/tbsetup/template_exprun.in @@ -43,7 +43,7 @@ sub usage() " - GUID and version to swapin\n"); 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 $quiet = 0; my $waitmode = 0; @@ -51,6 +51,7 @@ my $debug = 0; my $foreground = 0; my $ignoreerrors = 0; my $clean = 0; +my $doswapmod = 0; my $paramfile; my %parameters = (); my $action; @@ -89,6 +90,7 @@ my $cleaning = 0; my $justexit = 1; # Programs we need +my $swapexp = "$TB/bin/swapexp"; my $checkquota = "$TB/sbin/checkquota"; my $archcontrol = "$TB/bin/archive_control"; my $eventcontrol= "$TB/bin/eventsys_control"; @@ -423,42 +425,48 @@ $justexit = 0; # # And the bindings for the run ... # -if ($paramfile) { - foreach my $name (keys(%parameters)) { - my $value = $parameters{$name}; +foreach my $name (keys(%parameters)) { + my $value = $parameters{$name}; - $instance->NewRunBinding($name, $value) == 0 - or fatal(-1, "Could not create new experiment run binding ". - "for $instance!"); + $instance->NewRunBinding($name, $value) == 0 + or fatal(-1, "Could not create new experiment run binding ". + "for $instance!"); +} - # - # 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 (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"); +# We munge the environment variables. +$instance->InitializeEnvVariables(\%parameters) == 0 + or fatal(-1, "Could not add new environment variables to instance"); - print "Asking program agents to reload ... this will take a moment.\n"; - SignalProgAgents("RELOAD"); -} +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"; +SignalProgAgents("RELOAD"); -# -# 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!"); + +if ($doswapmod) { + # + # Now do the swapmod, using the original NS file for now. + # + 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"; done: @@ -582,6 +590,9 @@ sub ParseArgs() if (defined($options{"i"})) { $ignoreerrors = 1; } + if (defined($options{"m"})) { + $doswapmod = 1; + } if (defined($options{"t"})) { $ctoken = $options{"t"}; diff --git a/tbsetup/template_instantiate.in b/tbsetup/template_instantiate.in index df5bd6d7511db57d10166e6e1abb6c2779e0bf7d..a7fd85ed39766cca4ea04a7060e6997c99a17f25 100644 --- a/tbsetup/template_instantiate.in +++ b/tbsetup/template_instantiate.in @@ -452,27 +452,6 @@ if ($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 # to be a checkout, and it really needs to go someplace other then the @@ -488,57 +467,10 @@ $instance->CopyDataStore($template_tag, $instance->CopyTemplateEvents() == 0 or fatal(-1, "Could not copy template events to instance"); -# -# 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 = - 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; +# We munge the environment variables. +$instance->InitializeEnvVariables(\%parameters) == 0 + or fatal(-1, "Could not add new environment variables to instance"); - 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"; $instance->WriteEnvVariables() == 0 or fatal(-1, "Could not write environment strings for program agents"); @@ -613,15 +545,14 @@ $instance->NewRun($eid, $description) == 0 # # And the bindings for the default run ... # -if ($paramfile) { - foreach my $name (keys(%parameters)) { - my $value = $parameters{$name}; +foreach my $name (keys(%parameters)) { + my $value = $parameters{$name}; - $instance->NewRunBinding($name, $value) == 0 - or fatal(-1, "Error inserting run binding into DB!"); - } + $instance->NewRunBinding($name, $value) == 0 + or fatal(-1, "Error inserting run binding into DB!"); } -$instance->Start() == 0 + +$instance->StartFirstRun() == 0 or fatal(-1, "Could not update start time in instance record!"); # Stop the web interface from spewing. diff --git a/tbsetup/template_swapin.in b/tbsetup/template_swapin.in index df5bd6d7511db57d10166e6e1abb6c2779e0bf7d..a7fd85ed39766cca4ea04a7060e6997c99a17f25 100644 --- a/tbsetup/template_swapin.in +++ b/tbsetup/template_swapin.in @@ -452,27 +452,6 @@ if ($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 # to be a checkout, and it really needs to go someplace other then the @@ -488,57 +467,10 @@ $instance->CopyDataStore($template_tag, $instance->CopyTemplateEvents() == 0 or fatal(-1, "Could not copy template events to instance"); -# -# 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 = - 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; +# We munge the environment variables. +$instance->InitializeEnvVariables(\%parameters) == 0 + or fatal(-1, "Could not add new environment variables to instance"); - 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"; $instance->WriteEnvVariables() == 0 or fatal(-1, "Could not write environment strings for program agents"); @@ -613,15 +545,14 @@ $instance->NewRun($eid, $description) == 0 # # And the bindings for the default run ... # -if ($paramfile) { - foreach my $name (keys(%parameters)) { - my $value = $parameters{$name}; +foreach my $name (keys(%parameters)) { + my $value = $parameters{$name}; - $instance->NewRunBinding($name, $value) == 0 - or fatal(-1, "Error inserting run binding into DB!"); - } + $instance->NewRunBinding($name, $value) == 0 + or fatal(-1, "Error inserting run binding into DB!"); } -$instance->Start() == 0 + +$instance->StartFirstRun() == 0 or fatal(-1, "Could not update start time in instance record!"); # Stop the web interface from spewing. diff --git a/www/template_exprun.php b/www/template_exprun.php index 1f7296cbe7d1b06a4a7b5370d871cf0409cbd76b..1a2b660f3743c48a677ce6a02263a411b49c1917 100644 --- a/www/template_exprun.php +++ b/www/template_exprun.php @@ -187,6 +187,23 @@ function SPITFORM($instance, $formfields, $parameters, $errors) \n"; + # + # Swapmod? + # + echo " + Reparse NS file?: + + "; + echo "  (effectively a 'swap modify') + + \n"; + echo " Use this text area for an (optional) description: @@ -369,6 +386,13 @@ if (isset($formfields[clean]) && $formfields[clean] == "Yep") { $command_options .= " -c"; } +# +# Swapmod? +# +if (isset($formfields[swapmod]) && $formfields[swapmod] == "Yep") { + $command_options .= " -m"; +} + # # Description: # diff --git a/xmlrpc/emulabserver.py.in b/xmlrpc/emulabserver.py.in index 56a1a7112f48ffdf38771f33ebc9178812145e8a..121ffab1acc32853fd933f25e4d8cfb05b9a6c3d 100755 --- a/xmlrpc/emulabserver.py.in +++ b/xmlrpc/emulabserver.py.in @@ -4760,6 +4760,11 @@ class template: argstr += " -w " pass pass + elif opt == "modify": + if xbool(val): + argstr += " -m " + pass + pass elif opt == "xmlfilepath": # Backend script will verify this local path. xmlfilename = escapeshellarg(val) diff --git a/xmlrpc/script_wrapper.py.in b/xmlrpc/script_wrapper.py.in index 36f0c1bd6801fcf37c579f331d9481b66c97550e..dd58a23c5b83bbeb12c07cb099489e12deb4dd35 100755 --- a/xmlrpc/script_wrapper.py.in +++ b/xmlrpc/script_wrapper.py.in @@ -2079,7 +2079,7 @@ class template_startrun: def apply(self): try: - opts, req_args = getopt.getopt(self.argv, "we:E:r:p:cx:", + opts, req_args = getopt.getopt(self.argv, "we:E:r:p:cx:m", [ "help" ]); pass except getopt.error, e: @@ -2102,6 +2102,9 @@ class template_startrun: elif opt == "-w": params["wait"] = "yes" pass + elif opt == "-m": + params["modify"] = "yes" + pass elif opt == "-c": params["clear"] = "yes" pass