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
......
......@@ -102,9 +102,9 @@ use libdb;
use libtestbed;
use libtblog;
use libArchive;
use Experiment;
my $parser = "$TB/libexec/parse-ns";
my $mkexpdir = "$TB/libexec/mkexpdir";
my $checkquota = "$TB/sbin/checkquota";
my $tbbindir = "$TB/bin/";
my $RSYNC = "/usr/local/bin/rsync";
......@@ -113,6 +113,7 @@ my $user_name;
my $user_email;
my $dbuid;
my $exptidx;
my $logname;
# Be careful not to exit on transient error; 0 means infinite retry.
$libdb::DBQUERY_MAXTRIES = 0;
......@@ -159,6 +160,8 @@ my $exptstate = EXPTSTATE_NEW();
my $batchstate = BATCHSTATE_UNLOCKED();
my $now = localtime();
my $committed = 0;
my $experiment;
my $copy_experiment;
#
# Verify user and get his DB uid.
......@@ -201,7 +204,7 @@ if (!defined($gid)) {
$gid = $pid;
}
if (!defined($description)) {
$description = "'Created by $dbuid'";
$description = "Created by $dbuid";
}
if (! $swappable && (!defined($noswap_reason) || $noswap_reason eq "")) {
tbdie("Must provide a reason with -S option (not swappable reason)!");
......@@ -216,9 +219,9 @@ my $nsfile = "$eid.ns";
my $repfile = "$eid.report";
# Defaults for the DB and for the email message.
$noswap_reason = "'None Given'"
$noswap_reason = "None Given"
if (!defined($noswap_reason));
$noidleswap_reason = "'None Given'"
$noidleswap_reason = "None Given"
if (!defined($noidleswap_reason));
#
......@@ -271,128 +274,38 @@ if ($waitmode) {
}
#
# Create an experiment record. The pid/eid has to be unique, so lock the
# table for the check/insert.
#
DBQueryFatal("lock tables experiments write, ".
" experiment_stats write, ".
" experiment_resources write, ".
" emulab_indicies write, ".
" testbed_stats read");
$query_result =
DBQueryFatal("SELECT pid,eid FROM experiments ".
"WHERE eid='$eid' and pid='$pid'");
if ($query_result->numrows) {
DBQueryWarn("unlock tables");
tbdie("Experiment $eid in project $pid already exists!");
}
#
# Grab the next highest index to use. We used to use an auto_increment
# field in the table, but if the DB is ever "dropped" and recreated,
# it will reuse indicies that are crossed referenced in the other two
# tables.
#
$query_result =
DBQueryFatal("select idx from emulab_indicies ".
"where name='next_exptidx'");
# Seed with a proper value.
if (! $query_result->num_rows) {
$query_result =
DBQueryFatal("select MAX(exptidx) + 1 from experiment_stats");
($exptidx) = $query_result->fetchrow_array();
$exptidx = 1
if (!defined($exptidx));
DBQueryFatal("insert into emulab_indicies (name, idx) ".
"values ('next_exptidx', $exptidx)");
}
else {
($exptidx) = $query_result->fetchrow_array();
}
my $nextidx = $exptidx + 1;
DBQueryFatal("update emulab_indicies set idx='$nextidx' ".
"where name='next_exptidx'");
#
# Lets be really sure!
#
foreach my $table ("experiments", "experiment_stats", "experiment_resources",
"testbed_stats") {
my $slot = (($table eq "experiments") ? "idx" : "exptidx");
$query_result =
DBQueryFatal("select * from $table where ${slot}=$exptidx");
if ($query_result->numrows) {
DBQueryWarn("unlock tables");
tbdie("Experiment index $exptidx exists in $table; this is bad!");
}
}
#
# Insert the record. This reserves the pid/eid for us. If its a batchmode
# experiment, we will update the record later so that the batch daemon
# will recognize it. We insert the record as locked and ACTIVATING so that
# no one can mess with the experiment until later.
#
if (! DBQueryWarn("INSERT INTO experiments ".
"(idx, eid, pid, gid, expt_created, expt_name,".
" expt_head_uid,expt_swap_uid, state, priority, swappable,".
" idleswap, idleswap_timeout, autoswap, autoswap_timeout,".
" idle_ignore, keyhash, expt_locked, eventkey,".
" noswap_reason, noidleswap_reason, batchmode, ".
" batchstate, linktest_level, savedisk, instance_idx,dpdb) ".
"VALUES ($exptidx, '$eid', '$pid', '$gid', now(), ".
"$description,'$dbuid', '$dbuid', '$exptstate', $priority, ".
"$swappable, $idleswap, '$swaptime', $autoswap, ".
"'$autoswaptime', $idleignore, '$webkey', ".
"now(), '$eventkey', $noswap_reason, ".
"$noidleswap_reason, $batchmode, '$batchstate', ".
"$linktest, $savestate, $instance_idx, $dpdb)")) {
DBQueryWarn("unlock tables");
tbdie("DB error inserting experiment record for $pid/$eid!");
}
#
# Create an experiment_resources record for the above record.
#
$query_result =
DBQueryWarn("insert into experiment_resources (tstamp, exptidx) ".
"values (now(), $exptidx)");
if (!$query_result) {
DBQueryWarn("delete from experiments where pid='$pid' and eid='$eid'");
DBQueryWarn("unlock tables");
tbdie("DB error inserting experiment resources record for $pid/$eid!");
}
my $rsrcidx = $query_result->insertid;
#
# Now create an experiment_stats record to match.
#
if (! DBQueryWarn("insert into experiment_stats ".
"(eid, pid, creator, gid, created, batch, exptidx, rsrcidx) ".
"values('$eid', '$pid', '$dbuid', '$gid', now(), ".
"$batchmode, $exptidx, $rsrcidx)")) {
DBQueryWarn("delete from experiments where pid='$pid' and eid='$eid'");
DBQueryWarn("delete from experiment_resources where idx=$rsrcidx");
DBQueryWarn("unlock tables");
tbdie("DB error inserting experiment stats record for $pid/$eid!");
}
if (! DBQueryWarn("unlock tables")) {
DBQueryWarn("delete from experiments where pid='$pid' and eid='$eid'");
DBQueryWarn("delete from experiment_resources where idx=$rsrcidx");
DBQueryWarn("delete from experiment_stats where exptidx=$exptidx");
tbdie("DB error unlocking tables!");
# Create an arg array of parameters.
#
my %args = ();
$args{'idx'} = $exptidx;
$args{'gid'} = $gid;
$args{'expt_head_uid'} = $dbuid;
$args{'expt_swap_uid'} = $dbuid;
$args{'state'} = $exptstate;
$args{'priority'} = $priority;
$args{'swappable'} = $swappable;
$args{'idleswap'} = $idleswap;
$args{'idleswap_timeout'} = $swaptime;
$args{'autoswap'} = $autoswap;
$args{'autoswap_timeout'} = $autoswaptime;
$args{'idle_ignore'} = $idleignore;
$args{'keyhash'} = $webkey;
$args{'eventkey'} = $eventkey;
$args{'batchmode'} = $batchmode;
$args{'batchstate'} = $batchstate;
$args{'linktest_level'} = $linktest;
$args{'savedisk'} = $savestate;
$args{'instance_idx'} = $instance_idx;
$args{'dpdb'} = $dpdb;
# These are special; the library will DBQuote them.
$args{'expt_name'} = $description;
$args{'noswap_reason'} = $noswap_reason;
$args{'noidleswap_reason'} = $noidleswap_reason;
# Now create the experiment; we get back a perl class instance.
if (! ($experiment = Experiment->Create($pid, $eid, \%args))) {
tbdie("Could not create a new experiment record!");
}
#
......@@ -409,20 +322,20 @@ tblog_set_info($pid,$eid,$UID);
#
# Create a directory structure for the experiment.
#
if (system("$mkexpdir $pid $gid $eid") != 0) {
if ($experiment->CreateDirectory() != 0) {
if (($? >> 8) == EDQUOT()) {
# Obey exit status protocol for web page; User should see this.
$errorstat = 1;
}
fatal("$mkexpdir failed");
fatal("Failed to created experiment directory");
}
#
# Grab the working directory path, and thats where we work.
# The user's experiment directory is off in /proj space.
#
my $workdir = TBExptWorkDir($pid, $eid);
my $userdir = TBExptUserDir($pid, $eid);
my $workdir = $experiment->WorkDir();
my $userdir = $experiment->UserDir();
chdir("$workdir") or
fatal("Could not chdir to $workdir: $!");
......@@ -472,14 +385,14 @@ if ($copyarg) {
# Dump the eventkey into a file in the experiment directory.
#
if ($EVENTSYS) {
open(KEY, ">" . TBDB_EVENTKEY($pid, $eid)) or
open(KEY, ">" . $experiment->EventKeyPath()) or
fatal("Could not create eventkey file: $!");
print KEY $eventkey;
close(KEY);
}
# And dump the web key too.
open(KEY, ">" . TBDB_WEBKEY($pid, $eid)) or
open(KEY, ">" . $experiment->WebKeyPath()) or
fatal("Could not create webkey file: $!");
print KEY $webkey;
close(KEY);
......@@ -490,7 +403,7 @@ close(KEY);
# the user is forced to do a modify first (to give it a topology).
#
if (!defined($tempnsfile)) {
TBUnLockExp($pid, $eid, EXPTSTATE_NEW());
$experiment->Unlock(EXPTSTATE_NEW());
exit(0);
}
......@@ -533,10 +446,13 @@ goto skiplog
# is ready. In waitmode, we hold the parent waiting so that the user
# can script it. Must protect against async (^C) termination though.
#
my $logname = TBExptCreateLogFile($pid, $eid, "startexp");
TBExptSetLogFile($pid, $eid, $logname);