Commit 702ca300 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Convert scripts to use new Experiment library. Gonna take me a long time

to do everything!
parent 99c22c6c
......@@ -97,17 +97,32 @@ sub Lookup($$$)
return $self;
}
# accessors
sub pid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'pid'}); }
sub gid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'gid'}); }
sub eid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'eid'}); }
sub idx($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'idx'}); }
sub path($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'path'}); }
sub state($) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'state'}); }
sub rsrcidx($) { return ((! ref($_[0])) ? -1 : $_[0]->{'STATS'}->{'rsrcidx'});}
sub Created($) {
return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{'expt_created'});
}
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{$_[1]}); }
sub pid($) { return field($_[0], 'pid'); }
sub gid($) { return field($_[0], 'gid'); }
sub eid($) { return field($_[0], 'eid'); }
sub idx($) { return field($_[0], 'idx'); }
sub path($) { return field($_[0], 'path'); }
sub state($) { return field($_[0], 'state'); }
sub batchstate($) { return field($_[0], 'batchstate'); }
sub batchmode($) { return field($_[0], 'batchmode'); }
sub rsrcidx($) { return field($_[0], 'rsrcidx'); }
sub creator($) { return field($_[0], 'expt_head_uid');}
sub canceled($) { return field($_[0], 'canceled'); }
sub locked($) { return field($_[0], 'expt_locked'); }
sub elabinelab($) { return field($_[0], 'elab_in_elab');}
sub lockdown($) { return field($_[0], 'lockdown'); }
sub created($) { return field($_[0], 'expt_created'); }
sub swapper($) { return field($_[0], 'expt_swap_uid');}
sub swappable($) { return field($_[0], 'swappable');}
sub idleswap($) { return field($_[0], 'idleswap');}
sub autoswap($) { return field($_[0], 'autoswap');}
sub noswap_reason($){ return field($_[0], 'noswap_reason');}
sub noidleswap_reason($){ return field($_[0], 'noidleswap_reason');}
sub idleswap_timeout($) { return field($_[0], 'idleswap_timeout');}
sub autoswap_timeout($) { return field($_[0], 'autoswap_timeout');}
sub prerender_pid($) { return field($_[0], 'prerender_pid');}
#
# Lookup a template given an experiment index.
......@@ -128,6 +143,41 @@ sub LookupByIndex($$)
return Experiment->Lookup($pid, $eid);
}
#
# LockTables simple locks the given tables, and then refreshes the
# experiment instance (thereby getting the data from the DB after
# the tables are locked).
#
sub LockTables($;$)
{
my ($self, $spec) = @_;
# Must be a real reference.
return -1
if (! ref($self));
$spec = "experiments write"
if (!defined($spec));
$spec .= ", experiment_stats read";
DBQueryWarn("lock tables $spec")
or return -1;
return $self->Refresh();
}
sub UnLockTables($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
DBQueryWarn("unlock tables")
or return -1;
return 0;
}
#
# Create a new experiment. This installs the new record in the DB,
# and returns an instance. There is some bookkeeping along the way.
......@@ -326,7 +376,7 @@ sub Delete($;$)
TBExptDestroy($pid, $eid);
return
return 0
if (! $purge);
#
......@@ -398,6 +448,23 @@ sub Stringify($)
return "[Experiment: $pid/$eid]";
}
#
# Check permissions
#
sub AccessCheck($$$)
{
my ($self, $uid, $access_type) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
return TBExptAccessCheck($uid, $pid, $eid, $access_type);
}
#
# Create the directory structure.
#
......@@ -510,6 +577,41 @@ sub Unlock($;$)
return 0;
}
sub Lock(;$)
{
my ($self, $newstate) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $sclause = (defined($newstate) ? ",state='$newstate' " : "");
my $query_result =
DBQueryWarn("update experiments set expt_locked=now() $sclause ".
"where eid='$eid' and pid='$pid'");
if (! $query_result ||
$query_result->numrows == 0) {
return -1;
}
if (defined($newstate)) {
$self->{'EXPT'}->{'state'} = $newstate;
if ($EVENTSYS) {
EventSendWarn(objtype => libdb::TBDB_TBEVENT_EXPTSTATE(),
objname => "$pid/$eid",
eventtype => $newstate,
expt => "$pid/$eid",
host => $BOSSNODE);
}
}
return 0;
}
sub SetState($$)
{
my ($self, $newstate) = @_;
......@@ -620,6 +722,24 @@ sub CloseLogFile($)
return 0;
}
#
# And clear it ...
#
sub ClearLogFile($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
TBExptClearLogFile($pid, $eid);
return 0;
}
#
# Run scripts over an experiment.
#
......@@ -783,6 +903,42 @@ sub SetSwapInfo($$)
return $self->Refresh();
}
#
# Just the swap uid,
#
sub SetSwapper($$)
{
my ($self, $dbuid) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
TBExptSetSwapUID($pid, $eid, $dbuid);
return $self->Refresh();
}
#
# Just the swap time.
#
sub SetSwapTime($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
TBSetExpSwapTime($pid, $eid);
return 0;
}
#
# Set the cancel flag.
#
......@@ -801,5 +957,127 @@ sub SetCancelFlag($$)
return $self->Refresh();
}
#
# Clear the panic bit.
#
sub ClearPanicBit($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
TBExptClearPanicBit($pid, $eid);
return 0;
}
#
# Is experiment firewalled?
#
sub IsFirewalled($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
return TBExptFirewall($pid, $eid);
}
#
# Update the idleswap timeout. Why?
#
sub UpdateIdleSwapTime($$)
{
my ($self, $newtimeout) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
DBQueryWarn("update experiments set idleswap_timeout='$newtimeout' ".
"where eid='$eid' and pid='$pid'")
or return -1;
return 0;
}
#
# Experiment tables.
#
sub BackupVirtualState($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
return -1
if (TBExptBackupVirtualState($pid, $eid));
return 0;
}
sub RemoveVirtualState($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
return -1
if (TBExptRemoveVirtualState($pid, $eid));
return 0;
}
sub RestoreVirtualState($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
return -1
if (TBExptRestoreVirtualState($pid, $eid));
return 0;
}
sub ClearBackupState($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
TBExptClearBackupState($pid, $eid);
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -19,7 +19,7 @@ SBIN_SCRIPTS = avail inuse showgraph if2port backup webcontrol node_status \
elabinelab_bossinit update_permissions mysqld_watchdog \
dumperrorlog
LIBEXEC_SCRIPTS = webnodelog webnfree webnewwanode webidlemail xmlconvert
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy
......
This diff is collapsed.
......@@ -80,6 +80,7 @@ use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libArchive;
use Experiment;
# Be careful not to exit on transient error; 0 means infinite retry.
$libdb::DBQUERY_MAXTRIES = 0;
......@@ -150,8 +151,18 @@ if ($eid =~ /^([-\w\.]+)$/) {
else {
die("Tainted argument $eid!\n");
}
my $workdir = TBExptWorkDir($pid, $eid);
my $userdir = TBExptUserDir($pid, $eid);
#
# Grab the experiment.
#
my $experiment = Experiment->Lookup($pid, $eid);
if (! $experiment) {
die("*** $0:\n".
" No such experiment $pid/$eid in the Emulab Database.\n");
}
my $workdir = $experiment->WorkDir();
my $userdir = $experiment->UserDir();
#
# Verify user and get his DB uid.
......@@ -175,7 +186,7 @@ if (! UserDBInfo($dbuid, \$user_name, \$user_email)) {
# Note that any script down the line has to do an admin check also.
#
if ($UID && !$isadmin &&
!TBExptAccessCheck($dbuid, $pid, $eid, TB_EXPT_DESTROY)) {
! $experiment->AccessCheck($dbuid, TB_EXPT_DESTROY)) {
die("*** $0:\n".
" You do not have permission to end this experiment!\n");
}
......@@ -196,25 +207,19 @@ if ($waitmode) {
# 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'");
$experiment->LockTables("experiments write") == 0
or die("*** $0:\n".
" Could not lock experiment tables for $pid/$eid!\n");
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 $batchstate = $hashrow{'batchstate'};
my $expt_path = $hashrow{'path'};
my $isbatchexpt = $hashrow{'batchmode'};
my $cancelflag = $hashrow{'canceled'};
my $expt_locked = $hashrow{'expt_locked'};
my $elabinelab = $hashrow{'elab_in_elab'};
my $lockdown = $hashrow{'lockdown'};
my $expt_head_login = $experiment->creator();
my $estate = $experiment->state();
my $batchstate = $experiment->batchstate();
my $expt_path = $experiment->path();
my $isbatchexpt = $experiment->batchmode();
my $cancelflag = $experiment->canceled();
my $expt_locked = $experiment->locked();
my $elabinelab = $experiment->elabinelab();
my $lockdown = $experiment->lockdown();
#
# Batch experiments get a different protocol to avoid races with the
......@@ -271,7 +276,7 @@ else {
# already be running, but we deal with that by looking at the
# state below.
#
TBSetCancelFlag($pid, $eid, EXPTCANCEL_TERM);
$experiment->SetCancelFlag(EXPTCANCEL_TERM);
#
# If the state is QUEUED or SWAPPED, we can do it right away.
......@@ -355,8 +360,8 @@ else {
die("*** $0:\n".
" Experiment $pid/$eid appears to be in the wrong state: $estate\n");
}
TBLockExp($pid, $eid, $nextstate);
DBQueryFatal("unlock tables");
$experiment->Lock($nextstate);
$experiment->UnLockTables();
#
# XXX - At this point a failure is going to leave things in an
......@@ -385,9 +390,11 @@ if (! UserDBInfo($expt_head_login, \$expt_head_name, \$expt_head_email)) {
# If not in batch mode, go into the background. Parent exits.
#
if (!$batch && !$template_mode) {
$logname = TBExptCreateLogFile($pid, $eid, "endexp");
TBExptSetLogFile($pid, $eid, $logname);
TBExptOpenLogFile($pid, $eid);
if ($experiment->CreateLogFile("endexp", \$logname) != 0) {
fatal("Could not create logfile!");
}
$experiment->SetLogFile($logname);
$experiment->OpenLogFile($logname);
if (my $childpid = TBBackGround($logname)) {
#
......@@ -447,11 +454,13 @@ if ($estate eq EXPTSTATE_ACTIVE) {
GatherSwapStats($pid, $eid, $dbuid, TBDB_STATS_SWAPOUT, 0,
TBDB_STATS_FLAGS_START);
print STDOUT "Running 'tbswap out $pid $eid'\n";
if (system("$tbdir/tbswap out $pid $eid") != 0) {
fatal("tbswap out failed!\n");
if ($experiment->Swap("out") != 0) {
fatal("tbswap out failed!");
}
SetExpState($pid, $eid, EXPTSTATE_TERMINATING);
$experiment->SetState(EXPTSTATE_TERMINATING) == 0
or fatal("Failed to set experiment state to " .
EXPTSTATE_TERMINATING());
$estate = EXPTSTATE_SWAPPED;
#
......@@ -467,12 +476,13 @@ if ($estate eq EXPTSTATE_SWAPPED ||
$estate eq EXPTSTATE_QUEUED) {
GatherSwapStats($pid, $eid, $dbuid, TBDB_STATS_TERMINATE, 0,
TBDB_STATS_FLAGS_START);
print STDOUT "Running 'tbend $pid $eid'\n";
if (system("$tbdir/tbend $pid $eid") != 0) {
if ($experiment->End() != 0) {
fatal("tbend failed!\n");
}
SetExpState($pid, $eid, EXPTSTATE_TERMINATED);
$experiment->SetState(EXPTSTATE_TERMINATED) == 0
or fatal("Failed to set experiment state to " .EXPTSTATE_TERMINATED());
$estate = EXPTSTATE_TERMINATED;
#
......@@ -482,7 +492,7 @@ if ($estate eq EXPTSTATE_SWAPPED ||
}
# We better be here ...
$estate = ExpState($pid, $eid);
$estate = $experiment->state();
if ($estate ne EXPTSTATE_TERMINATED) {
fatal("Experiment is in the wrong state: $estate\n");
}
......@@ -490,7 +500,7 @@ if ($estate ne EXPTSTATE_TERMINATED) {
#
# Try to copy off the files for testbed information gathering.
#
TBSaveExpLogFiles($pid, $eid);
$experiment->SaveLogFiles();
# Copy out the archive and then delete it.
print "Archiving and clearing the experiment archive ...\n";
......@@ -502,13 +512,13 @@ libArchive::TBArchiveExperimentArchive($pid, $eid) == 0 or
#
if (!$template_mode) {
print "Experiment $pid/$eid has been successfully terminated!\n";
TBExptClearLogFile($pid, $eid);
$experiment->ClearLogFile();
}
#
# Cleanup DB state and remove directory.
#
TBExptDestroy($pid, $eid);
#
$experiment->Delete();
#
# In batch mode, exit now.
......@@ -539,13 +549,10 @@ sub fatal($)
print STDOUT $mesg;
#
# Kill this for convenience later.
#
TBUnLockExp($pid, $eid);
$experiment->Unlock();
# Copy over the log files so the user can see them.
system("/bin/cp -Rfp $workdir/ $userdir/tbdata");
$experiment->CopyLogFiles();
#
# In batch mode, exit without sending the email.
......@@ -558,7 +565,7 @@ sub fatal($)
# Clear the log file so the web page stops spewing.
#
if (defined($logname)) {
TBExptClearLogFile($pid, $eid);
$experiment->ClearLogFile();
}
#
......
This diff is collapsed.
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