Commit c4f53202 authored by Leigh Stoller's avatar Leigh Stoller

Checkpoint changes that have been discussed in the last few weeks:

* Records are now "help open" when a run is stopped. When the next run
  is started, a check is made to see if the files
  (/project/$pid/exp/$eid) have changed, and if so a new version of the
  archive is committed before the next run is started.

* Change the way swapmod is handled within an instance. A new option
  on the ShowExp page called Modify Resources. The intent is to allow
  an instance to be modified without having to start and stop runs,
  which tends to clutter things up, according to our user base. So, if
  you are within a run, that run is reset (reused) after the swapmod is
  finished. You can do this as many times as you like. If you are
  between runs (last operation was a stoprun), do the swapmod and then
  "speculatively" start a new run. Subsequent modifies reuse the that
  run again, as above.

  I think this is what Kevin was after ... there are some UI issues
  that may need to be resolved, will wait to hear what people have to
  say.

* Revising a record is now supported. Export, change in place, and
  then use the Revise link on the ShowRun page. Currently this has to
  happen from the export directory on ops, but eventually allow an
  upload (to correspond to downloaded exports)

* Check to see if export already exists, and give warning. Added a
  checkbox that allows user to overwrite the export.

* A bunch of minor UI changes to the various template pages.
parent b83aae91
......@@ -542,9 +542,10 @@ sub Add($$;$$$)
# Do a diff of the checkin directory against provided directory to
# determine if anything has changed.
#
sub Diff($$;$)
sub Diff($$;$$)
{
my ($self, $pathname, $view) = @_;
my ($self, $pathname, $view, @exceptions) = @_;
my $exclude_arg = "";
return -1
if (! ref($self));
......@@ -557,6 +558,12 @@ sub Diff($$;$)
print STDERR "ArchiveDiff: Could not validate pathname $pathname\n";
return -1;
}
if (@exceptions) {
foreach my $exception (@exceptions) {
$exclude_arg .= " '--exclude=$exception'";
}
}
#
# See if the archive exists and if it does, get the pathname to it.
......@@ -566,7 +573,8 @@ sub Diff($$;$)
print STDERR "ArchiveAdd: $directory cannot be written!\n";
return -1;
}
my $checkin = "$directory/checkins/$view";
# See Add() above for why we add "exp"
my $checkin = "$directory/checkins/$view/exp";
#
# If the target rootdir exists and is not writable by the current
......@@ -577,7 +585,7 @@ sub Diff($$;$)
mysystem("$SUCHOWN $checkin") == 0 or return -1
}
my $retval = mysystem("$DIFF -q -r $checkin $pathname");
my $retval = mysystem("$DIFF -q -r $exclude_arg $checkin $pathname");
return 0
if ($retval == 0);
return 1
......@@ -591,9 +599,9 @@ sub Diff($$;$)
# Commit the current contents of the temporary store to the archive.
# Returns -1 if any error. Otherwise return 0.
#
sub Commit($;$$$$)
sub Commit($;$$$$$)
{
my ($self, $newtag, $mfile, $view, $altdir) = @_;
my ($self, $newtag, $comment, $mfile, $view, $altdir) = @_;
my $noactivity = 0;
my $cwd;
......@@ -660,6 +668,9 @@ sub Commit($;$$$$)
}
$description = DBQuoteSpecial(`cat $mfile`);
}
elsif (defined($comment)) {
$description = DBQuoteSpecial($comment);
}
#
# Create a new revision record so I can get the revision number.
......@@ -736,6 +747,223 @@ sub Commit($;$$$$)
return -1;
}
#
# Revise is a lot like commit, except that we are changing an arbitrary
# revision, not the head of the view.
#
sub Revise($$$$$$$)
{
my ($self, $oldtag, $newtag, $comment, $mfile, $view, $dir) = @_;
my $noactivity = 0;
my $cwd;
return -1
if (! ref($self));
my $archive_idx = $self->idx();
$view = $defaultview
if (!defined($view));
my $View = $self->View($view);
return -1
if (!defined($View));
return -1
if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
TBSCRIPTLOCK_OKAY());
#
# See if the archive exists and if it does, get the pathname to it.
#
my $directory = $self->directory();
if (! -d $directory || ! -w $directory) {
print STDERR "ArchiveRevise: $directory cannot be written!\n";
goto bad;
}
my $repodir = "$directory/$REPO/$view";
my $checkin = $dir;
# Need to remember where we came from!
chomp($cwd = `pwd`);
# Must do the taint check too.
if ($cwd =~ /^([-\w\.\/]+)$/) {
$cwd = $1;
}
else {
print STDERR "ArchiveRevise: Bad data in $cwd!\n";
goto bad;
}
if (! chdir("$checkin")) {
print STDERR "ArchiveRevise: Cannot chdir to $checkin!\n";
goto bad;
}
my $revision_row = $self->Revision($view, $oldtag);
if (!defined($revision_row)) {
print STDERR "ArchiveRevise: Could not find revision for $oldtag!\n";
goto bad;
}
my $parent_revision = $revision_row->{'revision'};
#
# Message can come from a file.
#
my $description = "'Revise Archive'";
if (defined($mfile)) {
if (! -r $mfile) {
print STDERR "*** ArchiveRevise: $mfile cannot be read!\n";
goto bad;
}
$description = DBQuoteSpecial(`cat $mfile`);
}
elsif (defined($comment)) {
$description = DBQuoteSpecial($comment);
}
#
# Create a new revision record so I can get the revision number.
# Need to update the tag later.
#
my $query_result =
DBQueryWarn("insert into archive_revisions set revision=NULL, ".
" archive_idx='$archive_idx', view='$view', ".
" parent_revision=$parent_revision, ".
" description=$description, ".
" date_created=UNIX_TIMESTAMP(now())") or goto bad;
my $newrevision = $query_result->insertid;
my $zipfile = "$repodir/$newrevision";
$newtag = (defined($newtag) ? $newtag : "R${newrevision}");
#
# Okay, zip up the checkin directory. This becomes a new "revision"
#
mysystem("$ZIP $zipopt -y -r $zipfile .") == 0 or goto bad;
DBQueryWarn("update archive_revisions set ".
" tag='$newtag' ".
"where archive_idx='$archive_idx' and revision='$newrevision'")
or goto bad;
# Backwards compat
DBQueryWarn("insert into archive_tags set idx=NULL, version=$TAGVERSION, ".
" tag='$newtag', view='$view', ".
" archive_idx='$archive_idx', ".
" tagtype='$TAGTYPE_COMMIT', ".
" date_created=UNIX_TIMESTAMP(now())")
or goto bad;
okay:
TBScriptUnlock();
chdir($cwd)
if (defined($cwd));
return 0;
bad:
if (defined($newrevision)) {
DBQueryWarn("delete from archive_revisions ".
"where revision='$newrevision' and ".
" archive_idx='$archive_idx'");
}
TBScriptUnlock();
chdir($cwd)
if (defined($cwd));
return -1;
}
#
# Also like commit, but just replaces the zip archive file.
#
sub Replace($$$)
{
my ($self, $oldtag, $view) = @_;
my $cwd;
return -1
if (! ref($self));
my $archive_idx = $self->idx();
$view = $defaultview
if (!defined($view));
my $View = $self->View($view);
return -1
if (!defined($View));
return -1
if (TBScriptLock("archive_${archive_idx}_${view}", 0, 600) !=
TBSCRIPTLOCK_OKAY());
#
# See if the archive exists and if it does, get the pathname to it.
#
my $directory = $self->directory();
if (! -d $directory || ! -w $directory) {
print STDERR "ArchiveReplace: $directory cannot be written!\n";
goto bad;
}
my $repodir = "$directory/$REPO/$view";
my $checkin = "$directory/checkins/$view";
# Need to remember where we came from!
chomp($cwd = `pwd`);
# Must do the taint check too.
if ($cwd =~ /^([-\w\.\/]+)$/) {
$cwd = $1;
}
else {
print STDERR "ArchiveReplace: Bad data in $cwd!\n";
goto bad;
}
if (! chdir("$checkin")) {
print STDERR "ArchiveReplace: Cannot chdir to $checkin!\n";
goto bad;
}
my $revision_row = $self->Revision($view, $oldtag);
if (!defined($revision_row)) {
print STDERR "ArchiveReplace: Could not find revision for $oldtag!\n";
goto bad;
}
my $revision = $revision_row->{'revision'};
my $zipfile = "$repodir/${revision}.zip";
my $savefile = "$repodir/${revision}.save";
if (-e $zipfile) {
# print STDERR "ArchiveReplace: renaming $zipfile to $savefile\n";
if (!rename($zipfile, $savefile)) {
print STDERR "ArchiveReplace: Could not backup $zipfile!\n";
goto bad;
}
}
#
# Okay, zip up the checkin directory. This becomes a new "revision"
#
mysystem("$ZIP $zipopt -y -r $zipfile .") == 0 or goto bad;
okay:
TBScriptUnlock();
chdir($cwd)
if (defined($cwd));
return 0;
bad:
if (defined($zipfile) && -e $savefile) {
if (!rename($savefile, $zipfile)) {
print STDERR "ArchiveReplace: Could not restore $zipfile!\n";
goto bad;
}
}
TBScriptUnlock();
chdir($cwd)
if (defined($cwd));
return -1;
}
#
# Fork an archive (okay, branch) for use in separate development.
#
......@@ -1251,12 +1479,14 @@ sub Archive($$)
# Destroy an archive. The DB state is retained unless optional flag says
# to clean it.
#
sub Destroy($$;$)
sub Destroy($$;$$)
{
my ($self, $clean, $view) = @_;
my ($self, $clean, $view, $force) = @_;
$view = $defaultview
if (!defined($view));
$force = 0
if (!defined($force));
return -1
if (! ref($self));
......@@ -1272,7 +1502,7 @@ sub Destroy($$;$)
# Need additional check to make sure that it has not already been
# archived. Do not want to do anything, unless clean is specified.
#
if ($self->archived()) {
if ($self->archived() && !$force) {
print STDERR "ArchiveArchive: ".
"Archive $self archived on ". $self->date_archived() ."\n";
goto okay;
......@@ -1286,7 +1516,7 @@ sub Destroy($$;$)
if (! defined($shared)) {
goto bad;
}
if (! $shared) {
if (!$shared || $force) {
mysystem("/bin/rm -rf $directory");
if ($?) {
print STDERR "ArchiveDestroy: ".
......@@ -1374,5 +1604,21 @@ sub IsTagUnique($$;$)
return ($query_result->numrows == 0);
}
#
# Generate a tag. Nothing special, just a convenience function.
#
sub GenerateTag($$)
{
my ($self, $tagext) = @_;
my $newtag;
my ($seconds, $microseconds) = gettimeofday();
$newtag = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
$newtag .= int($microseconds / 1000);
$newtag .= "_${tagext}";
return $newtag;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -1629,6 +1629,30 @@ sub ClearPortRegistration($)
return 0;
}
#
# Does experiment have any program agents.
#
sub HaveProgramAgents($)
{
my ($self) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
my $query_result =
DBQueryWarn("select distinct vnode from virt_programs ".
"where pid='$pid' and eid='$eid'");
return -1
if (!defined($query_result));
return $query_result->numrows;
}
#
# Setup up phony program agent event agents and groups. This is so we
# can talk to the program agent itself, not to the programs the agent
......
......@@ -25,7 +25,8 @@ BIN_STUFF = power snmpit tbend tbprerun tbreport \
template_swapin template_swapout template_graph \
template_exprun template_delete template_metadata \
template_export template_control template_commit \
template_analyze template_linkgraph template_instantiate
template_analyze template_linkgraph template_instantiate \
template_revise
SBIN_STUFF = resetvlans console_setup.proxy sched_reload named_setup \
batch_daemon exports_setup reload_daemon sched_reserve \
......@@ -57,7 +58,7 @@ WEB_BIN_SCRIPTS = webnscheck webendexp webtbreport webbatchexp \
webtemplate_graph webtemplate_metadata webtemplate_export \
webtemplate_control webtemplate_commit webtemplate_analyze \
webtemplate_linkgraph webtemplate_instantiate \
webtemplate_delete
webtemplate_delete webtemplate_revise
LIBEXEC_STUFF = wanlinksolve wanlinkinfo os_setup mkexpdir console_setup \
assign_wrapper assign_wrapper2 \
......
......@@ -1994,6 +1994,25 @@ sub Update($$;$)
return Refresh($self);
}
#
# AccessCheck, which just hands off to the experiment access check if
# its a current instance, or to the template access check otherwise.
#
sub AccessCheck($$$)
{
my ($self, $user, $access_type);
# Must be a real reference.
return -1
if (! (ref($self) && ref($user)));
my $experiment = $self->Experiment();
return $experiment->AccessCheck($user, $access_type)
if (defined($experiment));
return $self->template()->AccessCheck($user, $access_type);
}
#
# Locking to prevent concurrent access
#
......@@ -2173,7 +2192,7 @@ sub Experiment($)
my ($self) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
return Experiment->LookupByIndex($self->exptidx());
......@@ -2364,6 +2383,18 @@ sub LookupRun($$)
return Template::Instance::Run->LookupByRunID($exptidx, $runid);
}
sub LookupRunByID($$)
{
my ($self, $runidx) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $exptidx = $self->exptidx();
return Template::Instance::Run->LookupByID($exptidx, $runidx);
}
#
# Delete the current run record.
......@@ -2661,13 +2692,15 @@ sub FirstRun($)
my $exptidx = $self->exptidx();
my $query_result =
DBQueryWarn("select * from experiment_runs ".
DBQueryWarn("select idx from experiment_runs ".
"where exptidx='$exptidx' order by idx asc limit 1");
return undef
if (!$query_result);
return $query_result->fetchrow_hashref();
my ($runidx) = $query_result->fetchrow_array();
return Template::Instance::Run->LookupByID($exptidx, $runidx);
}
#
......@@ -2714,7 +2747,8 @@ sub NewRunBinding($$$)
$value = "''";
}
DBQueryWarn("insert into experiment_run_bindings set ".
# Use replace cause of "modify" in template_exprun ...
DBQueryWarn("replace into experiment_run_bindings set ".
" exptidx='$exptidx', runidx='$runidx', ".
" name='$name', value=$value")
or return -1;
......@@ -3455,6 +3489,78 @@ sub GetArchive($$)
$self->template()->GetArchive();
}
#
# Archive Stuff.
#
sub ArchiveCommit($$$)
{
my ($self, $ptag, $comment) = @_;
my $rval;
# Must be a real reference.
return undef
if (! ref($self));
my $view;
my $archive = $self->GetArchive(\$view);
return -1
if (!defined($archive));
my $experiment = $self->Experiment();
return -1
if (!defined($experiment));
my $rsrcidx = $experiment->rsrcidx();
my $userdir = $self->path();
if (-e $userdir) {
$rval = $archive->Add("$userdir/.", $view, 1, 1);
return $rval
if ($rval != 0);
}
$$ptag = $archive->GenerateTag($$ptag);
$rval = $archive->Commit($$ptag, $comment, undef, $view, undef);
return $rval
if ($rval != 0);
# XXX
$experiment->TableUpdate("experiment_resources",
"archive_tag='$$ptag'", "idx='$rsrcidx'") == 0
or return -1;
return 0;
}
sub ArchiveReplace($$$)
{
my ($self, $tag) = @_;
my $rval;
# Must be a real reference.
return undef
if (! ref($self));
my $view;
my $archive = $self->GetArchive(\$view);
return -1
if (!defined($archive));
my $userdir = $self->path();
if (-e $userdir) {
$rval = $archive->Add("$userdir/.", $view, 1, 1);
return $rval
if ($rval != 0);
}
$rval = $archive->Replace($tag, $view);
return $rval
if ($rval != 0);
return 0;
}
############################################################################
package Template::Instance::Run;
......@@ -3627,6 +3733,31 @@ sub Refresh($)
return 0;
}
#
# Update record.
#
sub Update($$)
{
my ($self, $argref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $exptidx = $self->exptidx();
my $idx = $self->idx();
my $query = "update experiment_runs set ".
join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));
$query .= " where exptidx='$exptidx' and idx='$idx'";
return -1
if (! DBQueryWarn($query));
return Refresh($self);
}
#
# Get list of bindings for the run.
#
......@@ -3657,6 +3788,70 @@ sub BindingList($$)
return 0;
}
#
# Commit the archive for a run and remember the tag.
#
# I wonder if a better way to do this is a table of revisions associated with
# each run ...
#
sub ArchiveCommit($$)
{
my ($self, $which) = @_;
# Must be a real reference.
return -1
if (! ref($self));
# Cons up a tag and commit.
my $runid = $self->runid();
my $thistag = "${which}_${runid}";
my $instance = $self->instance();
my $comment = "Run $runid";
my $slot;
if ($which eq "startrun") {
$comment = "Starting $comment";
$slot = "starting_archive_tag";
}
elsif ($which eq "stoprun") {
$comment = "Stopping $comment";
$slot = "ending_archive_tag";
}
elsif ($which eq "stoprun_revised") {
$comment = "Revising $comment";
$slot = "ending_archive_tag";
}
else {
print STDERR "Unknown which $which in $self archive commit\n";
return -1;
}
$instance->ArchiveCommit(\$thistag, $comment) == 0 or
return -1;
# Update the run record since we want to remember this as the tag.
$self->Update({$slot => $thistag}) == 0 or
return -1;
return 0;
}
#
# Replace an archive, as for resource modification of a run.
#
sub ArchiveReplace($$)
{
my ($self, $tag) = @_;
# Must be a real reference.
return -1
if (! ref($self));
$self->instance()->ArchiveReplace($tag) == 0 or
return -1;
return 0;
}
#
# Mark a node as dead for this run; this is recorded in the DB.
#
......
......@@ -19,7 +19,7 @@ sub usage()
" archive_control checktag <pid> <eid> <tag>\n";
exit(-1);
}
my $optlist = "dfat:m:us:l";
my $optlist = "dfat:m:us:lc:";
my $debug = 0;
my $force = 0;
my $dbuid;
......@@ -158,6 +158,7 @@ if ($action eq "commit") {
my $tag = "commit";
my $usertag = 0;
my $mfile = undef;
my $comment = undef;
if (defined($options{"t"})) {
$tag = $options{"t"};
......@@ -188,6 +189,15 @@ if ($action eq "commit") {
fatal("Illegal characters in $mfile");
}
}
elsif (defined($options{"c"})) {
# A plain comment.
$comment = $options{"c"};
if (! TBcheck_dbslot($comment, "default", "tinytext",
TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
fatal("Illegal characters in comment");
}
}
if (0 && $NFSTRACESUPPORT) {
#
......@@ -223,7 +233,7 @@ if ($action eq "commit") {
# And commit the archive.
print "Doing a commit on the experiment archive ...\n";
if (libArchive::TBCommitExperimentArchive($pid, $eid, $tag,
$usertag, $mfile) < 0) {
$usertag, $mfile, $comment) < 0){
fatal("Failed to commit experiment archive!");
}
}
......
......@@ -501,7 +501,7 @@ sub TBExperimentArchiveSwapModCommit($$$)
print "Doing a commit on the experiment archive ...\n";
return -1
if ($archive->Commit($newtag, undef, $view, $location) != 0);
if ($archive->Commit($newtag, undef, undef, $view, $location) != 0);
if (!DBQueryWarn("update experiment_resources set ".
" archive_tag='$newtag' ".
......@@ -530,9 +530,9 @@ sub TBExperimentArchiveSwapModCommit($$$)
#
# Commit an experiment archive.
#
sub TBCommitExperimentArchive($$$;$$)
sub TBCommitExperimentArchive($$$;$$$)
{
my ($pid, $eid, $tagext, $usertagged, $mfile) = @_;
my ($pid, $eid, $tagext, $usertagged, $mfile, $comment) = @_;
my ($archive, $view);
return 0
......@@ -576,7 +576,7 @@ sub TBCommitExperimentArchive($$$;$$)
}
return -1
if ($archive->Commit($newtag, $mfile, $view) != 0);
if ($archive->Commit($newtag, $comment, $mfile, $view) != 0);
$experiment->TableUpdate("experiment_resources",
"archive_tag='$newtag'", "idx='$rsrcidx'") == 0
......
......@@ -909,19 +909,23 @@ if ($inout eq "out") {
#
# Add the files that have been detected by tracing to the archive.
#
if (libArchive::TBExperimentArchiveAddTracedFiles($pid, $eid) < 0) {
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'add_traced_files', undef, undef]},
"Failed to add traced files to the experiment archive!");
}
if (!$template_mode) {
if (libArchive::TBExperimentArchiveAddTracedFiles($pid, $eid) < 0) {
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'add_traced_files',
undef, undef]},
"Failed to add traced files to the experiment archive!");
}
#
# Add the experiment directory.
#
if (libArchive::TBExperimentArchiveAddUserFiles($pid, $eid) < 0) {
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'add_user_files', undef, undef]},
"Failed to add user specified files to the experiment archive!");
#