Commit 564d958d authored by Leigh B. Stoller's avatar Leigh B. Stoller

A fair number of changes.

* The rest of the backend support for simplistic experiment duplication,
  either from an existing (current) experiment, or from a specific
  archive revision of a current or terminated experiment.

* Rework the swapmod code so that the archive is committed at the exact
  end of the swapout phase. This required adding (and moving) some code
  from swapexp to tbswap sine that is where the actual swapout/swapin
  happens during a swapmod

* Add a special directory called "archive" to the experiment
  directory, which is a place where users can store stuff they want
  saved away. This will eventually be a user defined set of
  directories, but this was good for getting the basic mechanism in
  place. Note that the when the contents of this directory are copied
  out for placement into the archive, it is an exact copy made with
  rsync.

* No longer "clean" the contents of the temporary store between
  commits of the archive. This was creating a lot of headaches, and
  was also causing the revision history to get messed up. The downside
  of this is that we have to be more careful to explicitly delete
  files that the user no longer uses. I have not solved all these
  issues yet, so in the meantime files will get left in the archive
  even if the user no longer references them.
parent 9c8ddc33
......@@ -54,9 +54,10 @@ sub usage()
}
sub ParseArgs();
sub GetNSFile();
sub fatal($);
my $optlist = "iE:g:e:p:S:L:a:l:sfwqt:nz";
my $optlist = "iE:g:e:p:S:L:a:l:sfwqt:nzc:";
my $batchmode= 1;
my $frontend = 0;
my $waitmode = 0;
......@@ -65,6 +66,7 @@ my $linktest = 0; # non-zero means level to run at.
my $zeemode = 0; # Hey, out of options.
my $zeeopt = ""; # To pass along.
my $savestate= 0;
my $copyexp;
#
# Configure variables
......@@ -173,9 +175,11 @@ ParseArgs();
#
# Sanity check them.
#
if (!defined($pid) || !defined($eid)) {
usage();
}
usage()
if (!defined($pid) || !defined($eid));
usage()
if (defined($tempnsfile) && defined($copyexp));
if (!defined($gid)) {
$gid = $pid;
}
......@@ -185,10 +189,10 @@ if (!defined($description)) {
if (! $swappable && (!defined($noswap_reason) || $noswap_reason eq "")) {
tbdie("Must provide a reason with -S option (not swappable reason)!");
}
if (! $idleswap && (!defined($noidleswap_reason) || $noidleswap_reason eq "")) {
if (! $idleswap && (!defined($noidleswap_reason) || $noidleswap_reason eq "")){
tbdie("Must provide a reason with -L option (no idleswap reason)!");
}
if (!defined($tempnsfile) && !TBAdmin($dbuid)) {
if (!defined($tempnsfile) && !defined($copyexp) && !TBAdmin($dbuid)) {
tbdie("Only admins can create experiments with no NS file");
}
my $nsfile = "$eid.ns";
......@@ -207,11 +211,12 @@ if (! TBProjAccessCheck($dbuid, $pid, $gid, TB_PROJECT_CREATEEXPT)) {
die("You do not have permission to create experiments in $pid/$gid");
}
#
# If no NS file, then override swap/idle stuff. Again, might change
# when new forms installed
#
if (!defined($tempnsfile)) {
if (defined($copyexp)) {
# See if we can get the NS file from an existing (or past) experiment.
GetNSFile();
}
elsif (!defined($tempnsfile)) {
# If no NS file, then override swap/idle stuff.
$swappable = 0;
$idleswap = 0;
}
......@@ -619,6 +624,11 @@ if (system("$tbbindir/tbreport -b $pid $eid 2>&1 > $repfile") != 0) {
fatal("tbreport failed!");
}
# Latest log is always called the same thing.
if (defined($logname)) {
system("cp -fp $logname $workdir/" . EXPTLOGNAME());
}
#
# Try to copy off the files for testbed information gathering.
#
......@@ -630,6 +640,12 @@ TBSaveExpLogFiles($pid, $eid);
#
system("cp -Rfp $workdir/ $userdir/tbdata");
# Now add that copy to the archive.
if (defined($logname)) {
libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/tbdata/" . EXPTLOGNAME());
}
#
# Do a SavePoint on the experiment files.
#
......@@ -926,6 +942,19 @@ sub ParseArgs()
$savestate = 1;
}
#
# Clone an experiment, either an existing experiment or an old one
# (using the archive).
#
if (defined($options{"c"})) {
$copyexp = $options{"c"};
if (! (($copyexp =~ /^([-\w]+),([-\w]+)(?::[-\w]*)?$/) ||
($copyexp =~ /^(\d+)(?::[-\w]*)?$/))) {
tbdie("Bad data in argument: $copyexp");
}
}
#
# pid,eid,gid get passed along as shell commands args; must taint check.
#
......@@ -1014,6 +1043,130 @@ sub ParseArgs()
}
}
#
# Try to get an NS file when copying an experiment.
#
sub GetNSFileFromExperiment($$);
sub GetNSFileFromArchive($$$$);
sub GetNSFile()
{
if ($copyexp =~ /^([-\w]+),([-\w]+)((?::[-\w]*)?)$/) {
#
# pid,eid of an existing experiment.
#
my $copypid = $1;
my $copyeid = $2;
my $copytag = $3;
if ($copytag == "") {
GetNSFileFromExperiment($copypid, $copyeid);
}
else {
my $exptidx;
if (!TBExptIDX($copypid, $copyeid, \$exptidx)) {
tbdie("Could not get experiment index for $copypid/$copyeid");
}
GetNSFileFromArchive($exptidx, $copypid, $copyeid, $copytag);
}
}
elsif ($copyexp =~ /^(\d+)((?::[-\w]*)?)$/) {
#
# By convention, using an idx means we want to go to the experiment
# archive instead of what is currently in the filesystem.
#
my $exptidx = $1;
my $copytag = ($2 == "" ? undef : $2);
my $query_result =
DBQueryFatal("select pid,eid from experiment_stats ".
"where exptidx='$exptidx'");
if (! $query_result->numrows) {
tbdie("No such experiment index: $exptidx");
}
my ($copypid, $copyeid) = $query_result->fetchrow_array();
if (!TBProjAccessCheck($UID, $copypid, $copypid, TB_PROJECT_READINFO)){
tberror("You do not have permission to copy experiment: ".
"$copypid/$copyeid");
exit(1);
}
GetNSFileFromArchive($exptidx, $copypid, $copyeid, $copytag);
}
else {
tbdie("Bad data in -c option: $copyexp");
}
}
#
# Look at an existing experiment and grab its NS file. User must have
# permission of course.
#
sub GetNSFileFromExperiment($$)
{
my ($copypid, $copyeid) = @_;
print "Extracting NS file from current experiment $copypid/$copyeid\n";
if (!ExpState($copypid, $copyeid)) {
tberror("No such experiment to copy: $copypid/$copyeid");
exit(1);
}
if (!TBExptAccessCheck($UID, $copypid, $copyeid, TB_EXPT_READINFO)) {
tberror("You do not have permission to copy experiment: ".
"$copypid/$copyeid");
exit(1);
}
my $copyworkdir = TBExptWorkDir($copypid, $copyeid);
my $copynsfile = "$copyworkdir/$copyeid.ns";
if (! -e $copynsfile) {
tberror("Cannot find the NS file from $copypid/$copyeid");
exit(1);
}
$tempnsfile = $copynsfile;
}
#
# Here we get the NS file from an experiment archive.
#
sub GetNSFileFromArchive($$$$)
{
my ($exptidx, $copypid, $copyeid, $tag) = @_;
print "Extracting NS file from experiment archive for ".
"$copypid/$copyeid ($exptidx)\n";
my $copydir = "/var/tmp/checkout.$$";
my $copynsfile = "$copydir/proj/$copypid/exp/$copyeid/$copyeid.ns";
#
# Ask for a checkout of the archive.
#
if (libArchive::TBCheckoutExperimentArchivebyExptIDX($exptidx,
$copydir, $tag) < 0) {
tbdie("Could not check out a copy from the archive!");
}
if (! -e $copynsfile) {
system("/bin/rm -rf $copydir");
tbdie("Cannot find the NS file in the archive for expt $exptidx");
}
# global variable
$tempnsfile = "/tmp/nsfile.$$";
system("/bin/cp $copynsfile $tempnsfile");
my $rval = $?;
system("/bin/rm -rf $copydir");
if ($rval) {
tbdie("Cannot copy NS file from $copydir");
}
}
#
# We need this END block to make sure that we clean up after a fatal
# exit in the library. This is problematic, cause we could be exiting
......
This diff is collapsed.
......@@ -40,7 +40,8 @@ my $projroot = PROJROOT();
my $grouproot= GROUPROOT();
my $tbdata = "tbdata";
my @dirlist = ($tbdata, "bin", "tmp", "logs", "tftpboot", "swapinfo");
my @dirlist = ($tbdata, "bin", "tmp", "logs", "archive",
"tftpboot", "swapinfo");
my $exitval;
#
......
......@@ -833,6 +833,13 @@ if ($inout eq "out") {
fatal("Failed to add traced files to the experiment archive!");
}
#
# Add the special per-experiment archive directory.
#
if (libArchive::TBExperimentArchiveAddUserFiles($pid, $eid) < 0) {
fatal("Failed to add user specified files to the experiment archive!");
}
SetExpState($pid, $eid, EXPTSTATE_SWAPPED)
or fatal("Failed to set experiment state to " . EXPTSTATE_SWAPPED());
TBExptClearPanicBit($pid, $eid);
......@@ -861,6 +868,7 @@ elsif ($inout eq "modify") {
#
# Prepare the Archive for the swapmod, in case we have to "roll back".
#
print "Doing a preswapmod on the experiment archive ...\n";
if (libArchive::TBExperimentArchivePreSwapMod($pid, $eid) < 0) {
fatal("Failed to do a preswapmod on the experiment archive!");
}
......@@ -953,14 +961,6 @@ elsif ($inout eq "modify") {
#
SetExpState($pid, $eid, EXPTSTATE_ACTIVE);
$estate = EXPTSTATE_ACTIVE;
#
# Add the files that have been detected by tracing to the archive.
#
if (libArchive::TBExperimentArchiveAddTracedFiles($pid,
$eid) < 0) {
fatal("Failed to add traced files to the experiment archive!");
}
}
else {
$modifyError = $errorstat = $? >> 8;
......@@ -1032,6 +1032,11 @@ else { # $inout eq "restart" assumed.
SetExpState($pid, $eid, EXPTSTATE_ACTIVE);
}
# Latest log is always called the same thing.
if (defined($logname)) {
system("cp -fp $logname $workdir/" . EXPTLOGNAME());
}
#
# Try to copy off the files for testbed information gathering.
#
......@@ -1044,28 +1049,31 @@ TBSaveExpLogFiles($pid, $eid);
#
system("cp -Rfp $workdir/ $userdir/tbdata/");
# Now add that copy to the archive.
if (defined($logname)) {
libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/tbdata/" . EXPTLOGNAME());
}
# Always copy the NS file into the archive.
system("cp -p $workdir/$eid.ns $userdir/$eid.ns");
libArchive::TBExperimentArchiveAddFile($pid, $eid, "$userdir/$eid.ns") == 0 or
fatal("Failed to add $userdir/$eid.ns to the archive!");
#
# The archive gets different treatment when doing a swapmod.
#
if ($inout eq "modify") {
# Get the new NS file into the new swapdir.
if (defined($nsfile)) {
system("cp -p $workdir/$nsfile $userdir/$nsfile");
if (libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/$nsfile") < 0) {
fatal("Failed to add $userdir/$nsfile to the archive!");
}
}
print "Doing a commit on the previous experiment archive ...\n";
libArchive::TBExperimentArchiveSwapModCommit($pid, $eid) == 0 or
fatal("Failed to commit experiment archive!");
libArchive::TBExperimentArchiveSwapModCommit($pid, $eid,
$estate eq EXPTSTATE_SWAPPED)
== 0 or fatal("Failed to commit experiment archive!");
}
#
# Do a SavePoint on the experiment files.
#
print "Doing a savepoint on the experiment archive ...\n";
if (libArchive::TBExperimentArchiveSavePoint($pid, $eid, $tag) < 0) {
fatal("Failed to do a savepoint on the experiment archive!");
}
......
......@@ -53,6 +53,7 @@ use libtestbed;
use libadminctrl;
use libadminmfs;
use libtblog;
use libArchive;
#require exitonwarn; # exitonwarn isn't really a module, so just require it
......@@ -253,6 +254,12 @@ elsif ($swapop eq "update") {
$errors = doSwapout(UPDATE);
print STDERR "Doing a swapmodswapout on the experiment archive ...\n";
if (libArchive::TBExperimentArchiveSwapModSwapOut($pid, $eid) < 0) {
tberror("Failed to do a swapmodswapout on the experiment archive!");
$errors = 1;
}
if ($errors) {
#
# Clean up the mess, leaving the experiment in the SWAPPED state,
......
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