Commit aca4f452 authored by Leigh Stoller's avatar Leigh Stoller

Checkpoint changes to the Archive code.

* Add support for linking to the NS file that will be used, from the
  begin experiment page, when duplicating or branching an experiment.
  Ultimately we want to separate things so that user can first edit
  the NS file and then proceed to branching.

* In discussion we agreed to use the convention that a directory called
  "archive" in experiment directory, will always be saved and restored.
  This has been implemented.

* Add more of the support for branching an experiment (the archive).
  Batchexp takes a couple of new arguments:

	-c pid,eid[:tag]  or
	-c exptidx[:tag]

  The above specifies what and where to duplicate or branch. Simply
  giving pid,eid does not use the archive, but just copies right out
  of the existing experiment directory.

  Adding the -b option says to branch instead of duplicate.
parent b12b4f92
......@@ -54,10 +54,11 @@ sub usage()
}
sub ParseArgs();
sub GetNSFile();
sub CheckCopyArgs();
sub CopyInArchive();
sub fatal($);
my $optlist = "iE:g:e:p:S:L:a:l:sfwqt:nzc:";
my $optlist = "iE:g:e:p:S:L:a:l:sfwqt:nzc:b";
my $batchmode= 1;
my $frontend = 0;
my $waitmode = 0;
......@@ -66,7 +67,16 @@ 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;
# All of these are for experiment dup and branch. Really mucks things up.
# These globals are set when we parse the -c argument, but used later
my $copybranch = 0; # A branch instead of a duplicate
my $copyfrom; # Copy from where, archive or current experiment.
my $copyarg; # The -c argument.
my $copyidx; # The index of the experiment copied.
my $copypid; # The pid of the experiment copied.
my $copyeid; # The eid of the experiment copied.
my $copytag; # The archive tag to us.
my $copydir; # Directory extracted from archive, to delete.
#
# Configure variables
......@@ -89,10 +99,11 @@ use libtestbed;
use libtblog;
use libArchive;
my $parser = "$TB/libexec/parse-ns";
my $mkexpdir = "$TB/libexec/mkexpdir";
my $checkquota = "$TB/sbin/checkquota";
my $tbbindir = "$TB/bin/";
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";
my $errorstat=-1;
my $user_name;
my $user_email;
......@@ -171,6 +182,7 @@ if (system("$checkquota $dbuid") != 0) {
# Parse command arguments.
#
ParseArgs();
CheckCopyArgs();
#
# Sanity check them.
......@@ -178,7 +190,7 @@ ParseArgs();
usage()
if (!defined($pid) || !defined($eid));
usage()
if (defined($tempnsfile) && defined($copyexp));
if (defined($tempnsfile) && defined($copyarg));
if (!defined($gid)) {
$gid = $pid;
......@@ -192,7 +204,7 @@ if (! $swappable && (!defined($noswap_reason) || $noswap_reason eq "")) {
if (! $idleswap && (!defined($noidleswap_reason) || $noidleswap_reason eq "")){
tbdie("Must provide a reason with -L option (no idleswap reason)!");
}
if (!defined($tempnsfile) && !defined($copyexp) && !TBAdmin($dbuid)) {
if (!defined($tempnsfile) && !defined($copyarg) && !TBAdmin($dbuid)) {
tbdie("Only admins can create experiments with no NS file");
}
my $nsfile = "$eid.ns";
......@@ -211,9 +223,9 @@ if (! TBProjAccessCheck($dbuid, $pid, $gid, TB_PROJECT_CREATEEXPT)) {
die("You do not have permission to create experiments in $pid/$gid");
}
if (defined($copyexp)) {
# See if we can get the NS file from an existing (or past) experiment.
GetNSFile();
if (defined($copyarg)) {
# This will be handled below.
;
}
elsif (!defined($tempnsfile)) {
# If no NS file, then override swap/idle stuff.
......@@ -379,10 +391,6 @@ if (system("$mkexpdir $pid $gid $eid") != 0) {
fatal("$mkexpdir failed");
}
if (libArchive::TBCreateExperimentArchive($pid, $eid) < 0) {
fatal("Could not create experiment archive!");
}
#
# Grab the working directory path, and thats where we work.
# The user's experiment directory is off in /proj space.
......@@ -393,6 +401,31 @@ my $userdir = TBExptUserDir($pid, $eid);
chdir("$workdir") or
fatal("Could not chdir to $workdir: $!");
#
# Create a new archive, which might actually be a branch of an existing one
# when doing an experiment branch (fork).
#
if ($copybranch) {
# Currently, support branching from existing experiment only.
fatal("Could not create experiment archive!")
if (libArchive::TBForkExperimentArchive($pid, $eid,
$copypid,
$copyeid, $copytag) < 0);
}
elsif (libArchive::TBCreateExperimentArchive($pid, $eid) < 0) {
fatal("Could not create experiment archive!");
}
#
# Okay, if copying/branching an experiment, we have to go find the
# NS file, extracting the special (currently by convention) archive
# directory into the new experiment. This will set the tempnsfile
# variable needed below.
#
if ($copyarg) {
CopyInArchive();
}
#
# It would be nice to check for overquota during the rest of this
# setup, but thats going to be a pain. Besides, its very unlikely
......@@ -568,19 +601,6 @@ if (system("$tbbindir/tbprerun $zeeopt $pid $eid $nsfile") != 0) {
SetExpState($pid, $eid, EXPTSTATE_SWAPPED)
or fatal("Failed to set experiment state to " . EXPTSTATE_SWAPPED());
#
# Lets get the NS file into the archive now, since we want to quit before
# going further if it fails. Note that any NS files the experiment sourced
# were added by the parse wrapper.
#
system("cp -p $workdir/$nsfile $userdir/$nsfile");
if ($? != 0 ||
(libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/$nsfile") < 0)) {
fatal("Failed to add $userdir/$nsfile to the archive!");
}
#
# If not in frontend mode (preload only) continue to swapping exp in.
#
......@@ -645,14 +665,34 @@ if (defined($logname)) {
libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/tbdata/" . EXPTLOGNAME());
}
libArchive::TBExperimentArchiveAddFile($pid, $eid, "$userdir/tbdata/$repfile");
#
# Make a copy of the NS file where we can get at it easily. Then add it.
#
system("cp -p $workdir/$nsfile $userdir/archive/$nsfile");
libArchive::TBExperimentArchiveAddFile($pid, $eid,
"$userdir/archive/$nsfile") == 0 or
fatal("Failed to add $userdir/archive/$nsfile to the archive!");
#
# Do a SavePoint on the experiment files.
#
print "Doing a savepoint on the experiment archive ...\n";
if (libArchive::TBExperimentArchiveSavePoint($pid, $eid, "startexp") < 0) {
fatal("Failed to do a savepoint on the experiment archive!");
}
#
# If this is a branch, then do a commit. Otherwise, the archive looks
# wrong cause its a branch from the original and shows all those files.
#
if ($copybranch) {
print "Doing a commit on the experiment archive ...\n";
libArchive::TBCommitExperimentArchive($pid, $eid, "branch_merge") == 0 or
fatal("Failed to commit experiment archive!");
}
#
# Gather statistics.
#
......@@ -947,11 +987,15 @@ sub ParseArgs()
# (using the archive).
#
if (defined($options{"c"})) {
$copyexp = $options{"c"};
$copyarg = $options{"c"};
if (! (($copyexp =~ /^([-\w]+),([-\w]+)(?::[-\w]*)?$/) ||
($copyexp =~ /^(\d+)(?::[-\w]*)?$/))) {
tbdie("Bad data in argument: $copyexp");
if (! (($copyarg =~ /^([-\w]+),([-\w]+)(?::[-\w]*)?$/) ||
($copyarg =~ /^(\d+)(?::[-\w]*)?$/))) {
tbdie("Bad data in argument: $copyarg");
}
# This option only makes sense with -c option.
if (defined($options{"b"})) {
$copybranch = 1;
}
}
......@@ -1044,127 +1088,105 @@ sub ParseArgs()
}
#
# Try to get an NS file when copying an experiment.
# Check the -c argument, and set some global variables at the same time.
#
sub GetNSFileFromExperiment($$);
sub GetNSFileFromArchive($$$$);
sub GetNSFile()
sub CheckCopyArgs()
{
if ($copyexp =~ /^([-\w]+),([-\w]+)((?::[-\w]*)?)$/) {
return 0
if (!defined($copyarg));
if ($copyarg =~ /^([-\w]+),([-\w]+)(?::([-\w]*))?$/) {
#
# pid,eid of an existing experiment.
#
my $copypid = $1;
my $copyeid = $2;
my $copytag = $3;
$copypid = $1;
$copyeid = $2;
$copytag = (defined($3) ? (($3 eq "") ? undef : $3) : undef);
$copyfrom = "exp";
if ($copytag eq "") {
GetNSFileFromExperiment($copypid, $copyeid);
}
else {
my $exptidx;
if (!TBExptIDX($copypid, $copyeid, \$exptidx)) {
#
# If given a tag, must use the archive. To do that, we need the
# experiment index of the experiment we are copying from.
#
if (defined($copytag)) {
if (!TBExptIDX($copypid, $copyeid, \$copyidx)) {
tbdie("Could not get experiment index for $copypid/$copyeid");
}
GetNSFileFromArchive($exptidx, $copypid, $copyeid, $copytag);
$copyfrom = "archive";
}
}
elsif ($copyexp =~ /^(\d+)((?::[-\w]*)?)$/) {
elsif ($copyarg =~ /^(\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 eq "" ? undef : $2);
$copyidx = $1;
$copytag = (defined($2) ? (($2 eq "") ? undef : $2) : undef);
$copyfrom = "arch";
my $query_result =
DBQueryFatal("select pid,eid from experiment_stats ".
"where exptidx='$exptidx'");
"where exptidx='$copyidx'");
if (! $query_result->numrows) {
tbdie("No such experiment index: $exptidx");
tbdie("No such experiment index: $copyidx");
}
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");
tberror("You do not have permission to copy experiment ".
"$copypid/$copyeid ($copyidx)");
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);
tbdie("Bad data in -c option: $copyarg");
}
$tempnsfile = $copynsfile;
}
#
# Here we get the NS file from an experiment archive.
# Copy in what we need from another experiment (or archive).
#
sub GetNSFileFromArchive($$$$)
sub CopyInArchive()
{
my ($exptidx, $copypid, $copyeid, $tag) = @_;
return 0
if (!defined($copyarg));
print "Extracting NS file from experiment archive for ".
"$copypid/$copyeid ($exptidx)\n";
my $dstdir = "$userdir/archive";
my $copydir = "/var/tmp/checkout.$$";
my $copynsfile = "$copydir/proj/$copypid/exp/$copyeid/$copyeid.ns";
if ($copyfrom eq "exp") {
#
# Copy in from a current experiment. This is probably a bad thing
# to do, but hey.
#
my $srcdir = TBExptUserDir($copypid, $copyeid) . "/archive";
#
# 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");
print "Copying experiment archive from ${srcdir}\n";
system("$RSYNC -ax --delete ${srcdir}/ $dstdir");
if ($?) {
fatal("CopyInArchive: Failed to copy ${srcdir} to $dstdir");
}
}
# 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");
else {
#
# Ask for a checkout of the archive.
#
my $subdir = "/proj/$copypid/exp/$copyeid/archive";
print "Checking out experiment archive to $dstdir\n";
libArchive::TBCheckoutExperimentArchivebyExptIDX($copyidx,
$dstdir,
$copytag,
$subdir)
== 0 or fatal("CopyInArchive: Checking out archive");
}
# The directory contains the old NS file. Move that out of the way
# and set the tempnsfile.
system("/bin/mv -f $dstdir/$copyeid.ns $dstdir/nsfile.ns") == 0
or fatal("CopyInArchive: ".
"Could not mv $dstdir/$copyeid.ns $dstdir/nsfile.ns");
$tempnsfile = "$dstdir/nsfile.ns";
}
#
......
......@@ -47,7 +47,7 @@ my $SVNADMIN = "/usr/local/bin/svnadmin";
my $IMPORTER = "$TB/sbin/svn_load_dirs.pl";
my $inittag = 'root';
my $defaultview = 'head';
my $debug = 0;
my $debug = 2;
my $svnopt = ($debug ? "" : "-q");
my %ROOTS = ("proj" => "proj",
"users" => "users",
......@@ -197,8 +197,8 @@ sub ArchiveCreate(;$$$)
" date_created=UNIX_TIMESTAMP(now())") or goto bad;
# Now enter an initial tag for the tree. Nothing actually gets tagged.
DBQueryWarn("insert into archive_tags set idx=NULL, view='$view', ".
" tag='$tag', archive_idx='$idx', ".
DBQueryWarn("insert into archive_tags set idx=NULL, ".
" tag='$tag', archive_idx='$idx', view='$view', ".
" date_created=UNIX_TIMESTAMP(now())") or goto bad;
return $idx;
......@@ -400,7 +400,8 @@ sub ArchiveSavePoint($;$$$)
goto bad;
}
mysystem("$IMPORTER -no_user_input file://$repodir ".
" $view/savepoint . > /dev/null")
" $view/savepoint . " .
($debug < 2 ? "> /dev/null" : ""))
== 0 or goto bad;
#
......@@ -749,12 +750,24 @@ sub ArchiveFork($$;$$$)
" file://$repodir/$newview/trunk")
== 0 or goto bad;
# Do not want to copy the tags/savepoints directories. Add new ones.
# Ditto for the savepoints directory.
mysystem("$SVN copy $svnopt -m 'ArchiveFork' ".
" file://$repodir/$view/savepoint ".
" file://$repodir/$newview/savepoint")
== 0 or goto bad;
# Do not want to copy the tags/history directories. Add new ones.
mysystem("$SVN mkdir $svnopt -m 'ArchiveFork' ".
" file://$repodir/$newview/savepoint ".
" file://$repodir/$newview/history ".
" file://$repodir/$newview/tags")
== 0 or goto bad;
# Create a branch tag in the tags directory to base differences against.
mysystem("$SVN copy $svnopt -m 'ArchiveFork Branch' ".
" file://$repodir/$newview/trunk ".
" file://$repodir/$newview/tags/${newtag}-branch")
== 0 or goto bad;
# Now check it out. This creates the checkouts/$newview directory.
mysystem("cd $checkouts; ".
"$SVN checkout $svnopt file://$repodir/$newview")
......@@ -788,9 +801,9 @@ sub ArchiveFork($$;$$$)
#
# Checkout a copy of the archive, optionally at a particular view/branch.
#
sub ArchiveCheckout($$;$$)
sub ArchiveCheckout($$;$$$)
{
my ($archive_idx, $target, $view, $tag) = @_;
my ($archive_idx, $target, $view, $tag, $subdir) = @_;
my $sourcepoint;
my $cwd;
......@@ -849,6 +862,9 @@ sub ArchiveCheckout($$;$$)
else {
$sourcepoint = "trunk"
}
# Allowed to check out a particular subdir (but not a file).
$sourcepoint = $sourcepoint . "/$subdir"
if (defined($subdir));
# Now check it out. This creates the $checkouts/$view directory.
mysystem("cd $target; ".
......@@ -951,9 +967,12 @@ sub ArchiveArchive($$)
# Destroy an archive. The DB state is retained unless optional flag says
# to clean it.
#
sub ArchiveDestroy($$)
sub ArchiveDestroy($$;$)
{
my ($archive_idx, $clean) = @_;
my ($archive_idx, $clean, $view) = @_;
$view = $defaultview
if (!defined($view));
#
# See if the archive exists and if it does, get the pathname to it.
......@@ -984,19 +1003,31 @@ sub ArchiveDestroy($$)
return 0;
}
mysystem("/bin/rm -rf $directory");
if ($?) {
print STDERR "ArchiveDestroy: ".
"Could not remove contents of $directory!\n";
# Is it shared? If so, certainly do not delete it!
my $shared;
if (IsArchiveShared($archive_idx, \$shared) < 0) {
return -1;
}
if (! $shared) {
mysystem("/bin/rm -rf $directory");
if ($?) {
print STDERR "ArchiveDestroy: ".
"Could not remove contents of $directory!\n";
return -1;
}
}
if ($clean) {
(DBQueryWarn("delete from archive_tags ".
"where archive_idx='$archive_idx'") &&
"where archive_idx='$archive_idx' and view='$view'") &&
DBQueryWarn("delete from archive_views ".
"where archive_idx='$archive_idx'") &&
DBQueryWarn("delete from archives ".
"where idx='$archive_idx'")) || return -1;
"where archive_idx='$archive_idx' and view='$view'"))
|| return -1;
if (! $shared) {
DBQueryWarn("delete from archives ".
"where idx='$archive_idx'") || return -1;
}
}
return 0;
}
......@@ -1045,6 +1076,29 @@ sub IsArchiveArchived($$$)
return 0;
}
#
# See if the archive is shared amongst more then one experiment. This
# only looks at current experiments. Once an archive is archived, not
# sure what we will do if the user want to branch from it.
#
sub IsArchiveShared($$)
{
my ($idx, $prval) = @_;
my $query_result =
DBQueryWarn("select e.pid,e.eid,s.archive_idx from experiments as e ".
"left join experiment_stats as s on s.exptidx=e.idx ".
"where s.archive_idx='$idx'");
return -1
if (!$query_result || !$query_result->numrows);
$$prval = ($query_result->numrows > 1)
if (defined($prval));
return 0;
}
#
# Get the current tag for an archive, given its index. Returns -1 on error,
# zero otherwise. Place tag in the return pointer.
......@@ -1141,11 +1195,12 @@ sub TBCreateExperimentArchive($$)
if (!TBGroupUnixInfo($pid, $gid, \$unix_gid, \$unix_name)) {
return -1;
}
my $view = "$exptidx";
#
# Create the new archive and get back the new index.
#
my $archive_idx = ArchiveCreate($archive_tag, "$exptidx", $unix_name);
my $archive_idx = ArchiveCreate($archive_tag, $view, $unix_name);
return -1
if ($archive_idx < 0);
......@@ -1156,13 +1211,13 @@ sub TBCreateExperimentArchive($$)
DBQueryWarn("update experiment_resources set ".
" archive_tag='$archive_tag' ".
"where idx='$rsrcidx'"))) {
ArchiveDestroy($archive_idx, 1);
ArchiveDestroy($archive_idx, 1, $view);
return -1;
}
return 0;
bad:
ArchiveDestroy($archive_idx, 1);
ArchiveDestroy($archive_idx, 1, $view);
return -1;
}
......@@ -1662,9 +1717,9 @@ sub TBCommitExperimentArchive($$$)
#
# Checkout a copy of an experiment archive, optionally at a branch.
#
sub TBCheckoutExperimentArchive($$$;$)
sub TBCheckoutExperimentArchive($$$;$$)
{
my ($pid, $eid, $path, $tag) = @_;
my ($pid, $eid, $path, $tag, $subdir) = @_;
my ($archive_idx, $view);
return 0
......@@ -1676,15 +1731,15 @@ sub TBCheckoutExperimentArchive($$$;$)
return -1
if ($rval < 0);
return ArchiveCheckout($archive_idx, $path, $view, $tag);
return ArchiveCheckout($archive_idx, $path, $view, $tag, $subdir);
}
#
# Checkout a copy of an experiment archive, optionally at a branch.
#
sub TBCheckoutExperimentArchivebyExptIDX($$;$)
sub TBCheckoutExperimentArchivebyExptIDX($$;$$)
{
my ($exptidx, $path, $tag) = @_;
my ($exptidx, $path, $tag, $subdir) = @_;
return 0
if (!$MAINSITE);
......@@ -1705,7 +1760,7 @@ sub TBCheckoutExperimentArchivebyExptIDX($$;$)
return 1
if (!defined($archive_idx) || $archive_idx == 0);
return ArchiveCheckout($archive_idx, $path, $exptidx, $tag);
return ArchiveCheckout($archive_idx, $path, $exptidx, $tag, $subdir);
}
#
......@@ -1746,7 +1801,7 @@ sub TBDeleteExperimentArchive($$)
return -1
if ($rval < 0);
return ArchiveDestroy($archive_idx, 0);
return ArchiveDestroy($archive_idx, 0, $view);
}
#
......@@ -1766,7 +1821,56 @@ sub TBDestroyExperimentArchive($$)
return -1
if ($rval < 0);
return ArchiveDestroy($archive_idx, 1);
return ArchiveDestroy($archive_idx, 1, $view);
}
#
# Branch an experiment archive. Only an existing experiment can be
# branched, but that will probably change later.
#
sub TBForkExperimentArchive($$$$$)
{
my ($pid, $eid, $copypid, $copyeid, $copytag) = @_;
my ($archive_idx, $copyview);
return 0
if (!$MAINSITE || $pid ne $ALLOWEDPID);
my $rval = TBExperimentArchiveInfo($copypid, $copyeid,
\$archive_idx, \$copyview);
return 0
if ($rval > 0);
return -1
if ($rval < 0);
# Grab experiment indicies we need,
my $query_result =
DBQueryWarn("select e.idx,s.rsrcidx from experiments as e ".
"left join experiment_stats as s on e.idx=s.exptidx ".
"where e.pid='$pid' and e.eid='$eid'");
if (!$query_result || !$query_result->numrows) {
return -1;
}
my ($exptidx,$rsrcidx) = $query_result->fetchrow_array();
my $archive_tag = "T${rsrcidx}";
my $newview = "$exptidx";
return -1
if (ArchiveFork($archive_idx, $newview,
$copytag, $archive_tag, $copyview) < 0);
if (! (DBQueryWarn("update experiment_stats set ".
" archive_idx='$archive_idx' ".
"where pid='$pid' and eid='$eid' and ".
" exptidx='$exptidx'") &&
DBQueryWarn("update experiment_resources set ".
" archive_tag='$archive_tag' ".
"where idx='$rsrcidx'"))) {
# Its a shared resource, but ArchiveDestroy() checks.
ArchiveDestroy($archive_idx, 1, $newview);
return -1;
}
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
......
......@@ -56,7 +56,7 @@ $exptidx = TBExptIndex($pid, $eid);
if ($exptidx < 0) {
TBERROR("Could not get experiment index for $pid/$eid!", 1);
}
$url = "cvsweb/cvsweb.php3?exptidx=$exptidx";
$url = "cvsweb/cvsweb.php3/${exptidx}?exptidx=$exptidx";
echo "<center>\n";
echo "This is the Subversion archive for your experiment.<br>";
......
<?php
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
# Copyright (c) 2000-2006 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -24,7 +24,7 @@ function INITFORM($formfields, $projlist)
#
# See what kind of copy.
#
if (preg_match("/^(\d+)((?::[-\w]*)?)$/", $copyid, $matches)) {
if (preg_match("/^(\d+)(?::([-\w]*))?$/", $copyid, $matches)) {
$exptidx = $matches[1];
if (TBvalid_integer($exptidx)) {
......@@ -43,7 +43,7 @@ function INITFORM($formfields, $projlist)
}
}
}
elseif (preg_match("/^([-\w]+),([-\w]+)((?::[-\w]*)?)$/",
elseif (preg_match("/^([-\w]+),([-\w]+)(?::([-\w]*))?$/",
$copyid, $matches)) {
$copypid = $matches[1];
$copyeid = $matches[2];
......@@ -208,7 +208,7 @@ function SPITFORM($formfields, $errors)
{
global $TBDB_PIDLEN, $TBDB_GIDLEN, $TBDB_EIDLEN, $TBDOCBASE;
global $view, $view_style, $projlist, $linktest_levels;
global $EXPOSELINKTEST;
global $EXPOSELINKTEST, $EXPOSEARCHIVE;
global $EXPOSESTATESAVE;
PAGEHEADER("Begin a Testbed Experiment");
......@@ -427,7 +427,21 @@ function SPITFORM($formfields, $errors)
echo "<tr>
<td class='pad4'>Copy of experiment: &nbsp</td>
<td class='pad4'>$copyid</td>
<td class='pad4'>
<a target=nsfile href=spitnsdata.php3?copyid=$copyid>
$copyid</a>\n";
if ($EXPOSEARCHIVE) {
$checked = "";
if ($formfields[exp_branch] == "1") {
$checked = "checked=1";
}
echo "&nbsp <input type='checkbox' $checked
name='formfields[exp_branch]' value='1'> ";