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
......
......@@ -38,7 +38,9 @@ my $MD5 = "/sbin/md5";
my $MKDIR = "/bin/mkdir";
my $CHMOD = "/bin/chmod";
my $TAR = "/usr/bin/tar";
my $RSYNC = "/usr/local/bin/rsync";
my $RM = "/bin/rm";
my $REALPATH = "/bin/realpath";
my $SVN = "/usr/local/bin/svn";
my $SVNADMIN = "/usr/local/bin/svnadmin";
my $IMPORTER = "$TB/sbin/svn_load_dirs.pl";
......@@ -194,27 +196,26 @@ sub ArchiveCreate(;$$)
# temporary store. Later, after all the files are in the tree, must
# commit it to the repo.
#
sub ArchiveAdd($$;$)
sub ArchiveAdd($$;$$)
{
my ($archive_idx, $pathname, $view) = @_;
my ($archive_idx, $pathname, $view, $exact) = @_;
$view = $defaultview
if (!defined($view));
$exact = 0
if (!defined($exact));
if (! -e $pathname || ! -r $pathname) {
print STDERR "ArchiveFile: $pathname cannot be read!\n";
return -1;
}
if (! -f $pathname) {
print STDERR "ArchiveFile: $pathname must be a plain file!\n";
return -1;
}
#
# Check that the path does not contain an links to files outside
# the directory space the user is allowed to access.
#
my $realpath = `realpath $pathname`;
my $realpath = `$REALPATH $pathname`;
if ($realpath =~ /^([-\w\/\.\+\@,]+)$/) {
$realpath = $1;
}
......@@ -261,24 +262,17 @@ sub ArchiveAdd($$;$)
my $checkin = "$directory/checkins/$view";
#
# See if the file is already in the archive. We currently deal with
# just files; directories are gonna be a pain in the butt.
#
my $target_path = "$checkin/$pathname";
#
# The file should not already exist in the temporary store.
#
if (-e $target_path) {
print STDERR "ArchiveFile: ".
"WARNING: $pathname already exists in archive '$archive_idx'!\n";
}
#
# Not in the archive. Copy the file in. We use tar cause we
# want to retain the directory structure and mode bits, etc.
# Copy the file in. We use tar on individual files (to retain the
# directory structure and mode bits, etc). On a directory, use either
# tar or rsync, depending on whether we want an exact copy (removing
# files in the target that are not present in the source).
#
if (-f "/${pathname}" || !$exact) {
mysystem("$TAR cf - -C / $pathname | tar xf - -C $checkin");
}
else {
mysystem("$RSYNC -R -avx --delete /${pathname} $checkin");
}
if ($?) {
print STDERR "ArchiveFile: Could not copy in /$pathname\n";
return -1;
......@@ -293,9 +287,9 @@ sub ArchiveAdd($$;$)
# head revision until the entire branch (all the savepoints) is committed
# later, say when the experiment is swapped out.
#
sub ArchiveSavePoint($;$$)
sub ArchiveSavePoint($;$$$)
{
my ($archive_idx, $savetag, $view) = @_;
my ($archive_idx, $savetag, $view, $altdir) = @_;
my $cwd;
$view = $defaultview
......@@ -319,8 +313,7 @@ sub ArchiveSavePoint($;$$)
goto bad;
}
my $repodir = "$directory/repo";
my $checkout = "$directory/checkouts/$view";
my $checkin = "$directory/checkins/$view";
my $checkin = (defined($altdir) ? $altdir : "$directory/checkins/$view");
# Need to remember where we came from!
chomp($cwd = `pwd`);
......@@ -439,12 +432,12 @@ sub ArchiveCommit($;$$$)
$cwd = $1;
}
else {
print STDERR "ArchiveSavePoint: Bad data in $cwd!\n";
print STDERR "ArchiveCommit: Bad data in $cwd!\n";
goto bad;
}
if (! chdir("$checkin")) {
print STDERR "ArchiveCommit: Cannot chdir to $checkin!\n";
if (! chdir("$directory")) {
print STDERR "ArchiveCommit: Cannot chdir to $directory!\n";
goto bad;
}
......@@ -491,17 +484,19 @@ sub ArchiveCommit($;$$$)
$noactivity = 1;
}
# Clean the temp dir for next phase.
mysystem("/bin/rm -rf $checkin/*");
if ($?) {
print STDERR "ArchiveCommit: Could not clean $checkin!\n";
goto bad;
}
#
# Okay, do the commit to the trunk for this view.
#
if (! $noactivity) {
#
# Create a temporary spot to work in.
#
if (! mkdir("merge.$$", 0777)) {
print STDERR "ArchiveCommit: Could not mkdir merge.$$: $!\n";
goto bad;
}
chdir("merge.$$");
#
# Check out the current trunk.
#
......@@ -526,6 +521,13 @@ sub ArchiveCommit($;$$$)
mysystem("$SVN commit $svnopt ".
" -m 'Commit merge of ${archive_tag} to trunk' trunk")
== 0 or goto bad;
# Clean the temp dir,
chdir("$directory");
mysystem("/bin/rm -rf merge.$$");
if ($?) {
print STDERR "ArchiveCommit: Could not remove merge.$$\n";
}
}
# Create a tag in the tags directory for the commit.
......@@ -561,11 +563,23 @@ sub ArchiveCommit($;$$$)
or goto bad;
# Clean the temp dir for later.
mysystem("/bin/rm -rf $checkin/*");
if (0) {
if (!defined($altdir)) {
mysystem("/bin/rm -rf $checkin");
if ($?) {
print STDERR "ArchiveCommit: Could not clean $checkin!\n";
print STDERR "ArchiveCommit: Could not remove $checkin!\n";
goto bad;
}
if (! mkdir("$checkin", 0777)) {
print STDERR "ArchiveCommit: Could not mkdir $checkin: $!\n";
goto bad;
}
if (! chmod(0777, "$checkin")) {
print STDERR "ArchiveCommit: Could not chmod $checkin: $!\n";
goto bad;
}
}
}
# And now into the checkout dir to checkout a current copy.
if (! chdir("$checkout")) {
......@@ -635,7 +649,7 @@ sub ArchiveFork($$;$$$)
$cwd = $1;
}
else {
print STDERR "ArchiveSavePoint: Bad data in $cwd!\n";
print STDERR "ArchiveFork: Bad data in $cwd!\n";
goto bad;
}
......@@ -1096,6 +1110,35 @@ sub TBExperimentArchiveAddTracedFiles($$)
return 0;
}
#
# Add files the user explicitly wants archived
#
sub TBExperimentArchiveAddUserFiles($$)
{
my ($pid, $eid) = @_;
my ($archive_idx, $view);
return 0
if (!$MAINSITE || $pid ne $ALLOWEDPID);
my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
return 0
if ($rval > 0);
return -1
if ($rval < 0);
my $userdir = TBExptUserDir($pid, $eid);
my $userarch = "$userdir/archive";
if (-e $userarch) {
$rval = ArchiveAdd($archive_idx, $userarch, $view, 1);
return $rval
if ($rval != 0);
}
return 0;
}
#
# SavePoint an experiment archive.
#
......@@ -1152,21 +1195,7 @@ sub TBExperimentArchivePreSwapMod($$)
return -1;
}
my $checkin = "$directory/checkins/$view";
my $preswapdir = "${checkin}.preswap";
#
# Derive a tag that says something useful?
#
my ($seconds, $microseconds) = gettimeofday();
my $newtag = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
$newtag .= int($microseconds / 1000);
$newtag .= "_preswapmod";
#
# Do a savepoint just for grins,
#
return -1
if (ArchiveSavePoint($archive_idx, $newtag, $view) != 0);
my $preswapdir = "${checkin}.preswapmod";
#
# Make a copy of the current tree, since its easier to rollback
......@@ -1209,6 +1238,96 @@ sub TBExperimentArchivePreSwapMod($$)
return -1;
}
#
# Next phase of a swapmod; do another snapshot after the swapout completes.
#
sub TBExperimentArchiveSwapModSwapOut($$)
{
my ($pid, $eid) = @_;
my ($archive_idx, $view);
return 0
if (!$MAINSITE || $pid ne $ALLOWEDPID);
my $rval = TBExperimentArchiveInfo($pid, $eid, \$archive_idx, \$view);
return 0
if ($rval > 0);
return -1
if ($rval < 0);
my $directory;
if (GetArchiveDirectory($archive_idx, \$directory) < 0) {
print STDERR "ArchiveSwapmodswapout: ".
"Archive '$archive_idx' does not exist in the DB!\n";
return -1;
}
if (! -d $directory || ! -w $directory) {
print STDERR "ArchiveSwapmodswapout: $directory cannot be written!\n";
return -1;
}
my $checkin = "$directory/checkins/$view";
my $preswapdir = "${checkin}.swapmodswapout";
#
# Grab the user specified files.
#
if (TBExperimentArchiveAddUserFiles($pid, $eid) < 0) {
print STDERR "ArchiveSwapmodswapout: ".
"Failed to add user specified files to the experiment archive!\n";
return -1;
}
#
# Add the files that have been detected by tracing to the archive.
#
if (TBExperimentArchiveAddTracedFiles($pid, $eid) < 0) {
print STDERR "ArchiveSwapmodswapout: ".
"Failed to add traced files to the experiment archive!\n";
return -1;
}
#
# Make a copy of the current tree; This is the tree that will be
# committed as the swapout if the swapmod completes okay.
#
if (-e $preswapdir) {
system("/bin/rm -rf $preswapdir");
if (-e $preswapdir) {
print STDERR
"ArchiveSwapmodswapout: Could not delete old preswap dir!\n";
return -1;
}
}
if (! mkdir("$preswapdir", 0777)) {
print STDERR
"ArchiveSwapmodswapout: Could not mkdir $preswapdir: $!\n";
return -1;
}
if (! chmod(0777, "$preswapdir")) {
print STDERR "ArchiveSwapmodswapout: ".
"Could not chmod directory $preswapdir: $!\n";
goto bad;
}
mysystem("$TAR cf - -C $checkin . | tar xf - -C $preswapdir");
if ($?) {
print STDERR "ArchiveSwapmodswapout: Could not copy to $preswapdir\n";
goto bad;
}
return 0;
bad:
# Be sure to remove the new directory!
if (-e $preswapdir) {
system("/bin/rm -rf $preswapdir");
if (-e $preswapdir) {
print STDERR
"ArchiveSwapmodswapout: Could not delete new preswap dir!\n";
}
}
return -1;
}
#
# Rollback from a failed swapmod.
#
......@@ -1237,7 +1356,8 @@ sub TBExperimentArchiveRollBack($$)
return -1;
}
my $checkin = "$directory/checkins/$view";
my $preswapdir = "${checkin}.preswap";
my $preswapdir = "${checkin}.preswapmod";
my $swapmodswapout = "${checkin}.swapmodswapout";
# In case we bailed out really early in the swapmod path.
return 0
......@@ -1250,7 +1370,15 @@ sub TBExperimentArchiveRollBack($$)
system("/bin/rm -rf $checkin");
if (-e $checkin) {
print STDERR
"ArchiveRollBack: Could not delete old preswap dir!\n";
"ArchiveRollBack: Could not delete $checkin!\n";
return -1;
}
}
if (-e $swapmodswapout) {
system("/bin/rm -rf $swapmodswapout");
if (-e $swapmodswapout) {
print STDERR
"ArchiveRollBack: Could not delete $swapmodswapout!\n";
return -1;
}
}
......@@ -1267,9 +1395,9 @@ sub TBExperimentArchiveRollBack($$)
# Swapmod completed okay. Need to commit the old preswap directory and
# move forward.
#
sub TBExperimentArchiveSwapModCommit($$)
sub TBExperimentArchiveSwapModCommit($$$)
{
my ($pid, $eid) = @_;
my ($pid, $eid, $swapped) = @_;
my ($archive_idx, $view);
return 0
......@@ -1292,7 +1420,14 @@ sub TBExperimentArchiveSwapModCommit($$)
return -1;
}
my $checkin = "$directory/checkins/$view";
my $preswapdir = "${checkin}.preswap";
my $preswapdir = "${checkin}.preswapmod";
my $swapmodswapout = "${checkin}.swapmodswapout";
#
# Where we get the previous stuff depends on whether the modify is
# of a swapped in or swapped out experiment.
#
my $location = ($swapped ? $preswapdir : $swapmodswapout);
#
# We need this below.
......@@ -1312,10 +1447,15 @@ sub TBExperimentArchiveSwapModCommit($$)
my ($seconds, $microseconds) = gettimeofday();
my $newtag = POSIX::strftime("T20%y%m%d-%H%M%S-", localtime());
$newtag .= int($microseconds / 1000);
$newtag .= "_postswapmod";
$newtag .= "_preswapmod";
print "Doing a savepoint on the experiment archive ...\n";
return -1
if (ArchiveCommit($archive_idx, $newtag, $view, $preswapdir) != 0);
if (ArchiveSavePoint($archive_idx, undef, $view, $location) != 0);
print "Doing a commit on the experiment archive ...\n";
return -1
if (ArchiveCommit($archive_idx, $newtag, $view, $location) != 0);
if (!DBQueryWarn("update experiment_resources set ".
" archive_tag='$newtag' ".
......@@ -1331,6 +1471,14 @@ sub TBExperimentArchiveSwapModCommit($$)