Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
emulab-devel
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
143
Issues
143
List
Boards
Labels
Service Desk
Milestones
Merge Requests
6
Merge Requests
6
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
emulab
emulab-devel
Commits
a56be512
Commit
a56be512
authored
Jan 17, 2006
by
Leigh B. Stoller
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add support for user defined tags and commit messages, when the user
does his own commit.
parent
e6d1d9f5
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
426 additions
and
60 deletions
+426
-60
tbsetup/archive_control.in
tbsetup/archive_control.in
+65
-14
tbsetup/libArchive.pm.in
tbsetup/libArchive.pm.in
+119
-41
www/archive_tag.php3
www/archive_tag.php3
+230
-0
www/archive_view.php3
www/archive_view.php3
+2
-5
www/dbcheck.php3
www/dbcheck.php3
+8
-0
www/dbdefs.php3.in
www/dbdefs.php3.in
+2
-0
No files found.
tbsetup/archive_control.in
View file @
a56be512
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005 University of Utah and the Flux Group.
# Copyright (c) 2005
, 2006
University of Utah and the Flux Group.
# All rights reserved.
#
use
English
;
...
...
@@ -13,14 +13,14 @@ use Getopt::Std;
sub
usage
()
{
print
STDERR
"
Usage: archive_control [-f] commit <pid> <eid>
\n
"
.
"
archive_control [-f] [-a] addfile <pid> <eid> [files ...]
\n
";
"
Usage: archive_control [-f] [-t tag] [-m file] commit <pid> <eid>
\n
"
.
"
archive_control [-f] [-a] addfile <pid> <eid> [files ...]
\n
"
.
"
archive_control checktag <pid> <eid> <tag>
\n
";
exit
(
-
1
);
}
my
$optlist
=
"
dfa
";
my
$optlist
=
"
dfa
t:m:
";
my
$debug
=
0
;
my
$force
=
0
;
my
$exact
=
0
;
my
$dbuid
;
#
...
...
@@ -74,9 +74,6 @@ if (@ARGV < 3) {
if
(
defined
(
$options
{"
d
"}))
{
$debug
=
1
;
}
if
(
defined
(
$options
{"
a
"}))
{
$exact
=
1
;
}
if
(
defined
(
$options
{"
f
"}))
{
$force
=
1
;
}
...
...
@@ -87,7 +84,7 @@ my $eid = shift(@ARGV);
#
# Untaint args.
#
if
(
$action
=~
/^(commit|addfile)$/
)
{
if
(
$action
=~
/^(commit|addfile
|checktag
)$/
)
{
$action
=
$
1
;
}
else
{
...
...
@@ -127,6 +124,28 @@ if ($expstate ne EXPTSTATE_ACTIVE &&
fatal
("
Experiment
$pid
/
$eid
must be active or swapped!
");
}
# Temporary
libArchive::
setdebug
(
2
);
# Do not audit this operation.
if
(
$action
eq
"
checktag
")
{
usage
()
if
(
!
@ARGV
);
my
$tag
=
$ARGV
[
0
];
if
(
!
TBcheck_dbslot
(
$tag
,
"
archive_tags
",
"
tag
",
TBDB_CHECKDBSLOT_WARN
|
TBDB_CHECKDBSLOT_ERROR
))
{
fatal
("
Illegal characters in tag
");
}
my
$unique
;
fatal
("
Error checking tag for uniqueness!
")
if
(
libArchive::
TBIsTaqUnique
(
$pid
,
$eid
,
$tag
,
\
$unique
)
<
0
);
exit
((
$unique
?
0
:
1
));
}
#
# This script is always audited. Mail is sent automatically upon exit.
#
...
...
@@ -137,13 +156,38 @@ if (AuditStart(0)) {
exit
(
0
);
}
# Temporary
libArchive::
setdebug
(
1
);
#
# Allow the user to force a commit of the archive.
#
if
(
$action
eq
"
commit
")
{
my
$tag
=
"
user_commit
";
my
$mfile
=
undef
;
if
(
defined
(
$options
{"
t
"}))
{
$tag
=
$options
{"
t
"};
if
(
!
TBcheck_dbslot
(
$tag
,
"
archive_tags
",
"
tag
",
TBDB_CHECKDBSLOT_WARN
|
TBDB_CHECKDBSLOT_ERROR
))
{
fatal
("
Illegal characters in tag
");
}
# Force a taint check; the library will escape it for the shell.
$tag
=~
/(.*)/
;
$tag
=
$
1
;
}
if
(
defined
(
$options
{"
m
"}))
{
#
# Argument is a pathname to a tempfile.
#
$mfile
=
$options
{"
m
"};
if
(
$mfile
=~
/^([-\w\/\.]+)$/
)
{
$mfile
=
$
1
;
}
else
{
fatal
("
Illegal characters in
$mfile
");
}
}
if
(
$NFSTRACESUPPORT
)
{
#
# This program asks the nodes for the trace results.
...
...
@@ -175,16 +219,23 @@ if ($action eq "commit") {
fatal
("
Failed to do a savepoint on the experiment archive!
");
}
#
Commit the archive after swapout
#
And commit the archive.
print
"
Doing a commit on the experiment archive ...
\n
";
if
(
libArchive::
TBCommitExperimentArchive
(
$pid
,
$eid
,
"
user_commit
")
<
0
)
{
if
(
libArchive::
TBCommitExperimentArchive
(
$pid
,
$eid
,
$tag
,
1
,
$mfile
)
<
0
)
{
fatal
("
Failed to commit experiment archive!
");
}
}
elsif
(
$action
eq
"
addfile
")
{
my
$exact
=
0
;
usage
()
if
(
!
@ARGV
);
if
(
defined
(
$options
{"
a
"}))
{
$exact
=
1
;
}
# The Archive library does a taint check on the pathnames.
while
(
@ARGV
)
{
my
$pathname
=
shift
(
@ARGV
);
...
...
tbsetup/libArchive.pm.in
View file @
a56be512
...
...
@@ -54,6 +54,11 @@ my %ROOTS = ("proj" => "proj",
"share"
=>
"share"
,
"groups"
=>
"groups"
);
my
$
TAGTYPE_USER
=
"user"
;
my
$
TAGTYPE_COMMIT
=
"commit"
;
my
$
TAGTYPE_SAVEPOINT
=
"savepoint"
;
my
$
TAGTYPE_INTERNAL
=
"internal"
;
#
Little
helper
and
debug
function
.
sub
mysystem
($)
{
...
...
@@ -199,6 +204,7 @@ sub ArchiveCreate(;$$$)
#
Now
enter
an
initial
tag
for
the
tree
.
Nothing
actually
gets
tagged
.
DBQueryWarn
(
"insert into archive_tags set idx=NULL, "
.
" tag='$tag', archive_idx='$idx', view='$view', "
.
" tagtype='$TAGTYPE_INTERNAL', "
.
" date_created=UNIX_TIMESTAMP(now())"
)
or
goto
bad
;
return
$
idx
;
...
...
@@ -419,6 +425,7 @@ sub ArchiveSavePoint($;$$$)
DBQueryWarn
(
"insert into archive_tags set idx=NULL, "
.
" tag='$savetag', view='$view', "
.
" archive_idx='$archive_idx', "
.
" tagtype='$TAGTYPE_SAVEPOINT', "
.
" date_created=UNIX_TIMESTAMP(now())"
)
or
goto
bad
;
okay
:
...
...
@@ -438,9 +445,9 @@ sub ArchiveSavePoint($;$$$)
#
Commit
the
current
contents
of
the
temporary
store
to
the
archive
.
#
Returns
-
1
if
any
error
.
Otherwise
return
0.
#
sub
ArchiveCommit
($;$$$)
sub
ArchiveCommit
($;$$$
$
)
{
my
($
archive_idx
,
$
newtag
,
$
view
,
$
altdir
)
=
@
_
;
my
($
archive_idx
,
$
newtag
,
$
mfile
,
$
view
,
$
altdir
)
=
@
_
;
my
$
noactivity
=
0
;
my
$
cwd
;
...
...
@@ -526,6 +533,19 @@ sub ArchiveCommit($;$$$)
print
"ArchiveCommit: Archive is clean; no need to commit.
\n
"
;
$
noactivity
=
1
;
}
#
#
Message
can
come
from
a
file
.
#
my
$
message_arg
=
"-m 'Commit merge of ${archive_tag} to trunk'"
;
if
(
defined
($
mfile
))
{
if
(
! -r $mfile) {
print
STDERR
"*** ArchiveCommit: $mfile cannot be read!
\n
"
;
goto
bad
;
}
$
message_arg
=
"-F $mfile"
;
}
#
#
Okay
,
do
the
commit
to
the
trunk
for
this
view
.
...
...
@@ -558,11 +578,7 @@ sub ArchiveCommit($;$$$)
" trunk"
)
==
0
or
goto
bad
;
#
#
Now
commit
to
the
trunk
!
#
mysystem
(
"$SVN commit $svnopt "
.
" -m 'Commit merge of ${archive_tag} to trunk' trunk"
)
mysystem
(
"$SVN commit $svnopt $message_arg trunk"
)
==
0
or
goto
bad
;
#
Clean
the
temp
dir
,
...
...
@@ -574,7 +590,7 @@ sub ArchiveCommit($;$$$)
}
#
Create
a
tag
in
the
tags
directory
for
the
commit
.
mysystem
(
"$SVN copy $svnopt
-m 'ArchiveCommit'
"
.
mysystem
(
"$SVN copy $svnopt
$message_arg
"
.
" file://$repodir/$view/trunk "
.
" file://$repodir/$view/tags/${newtag}"
)
==
0
or
goto
bad
;
...
...
@@ -582,7 +598,7 @@ sub ArchiveCommit($;$$$)
#
Create
a
tag
in
the
history
directory
for
the
commit
.
The
#
history
directory
has
just
the
commit
tags
,
so
its
easy
to
go
#
back
in
time
.
mysystem
(
"$SVN copy $svnopt
-m 'ArchiveCommit'
"
.
mysystem
(
"$SVN copy $svnopt
$message_arg
"
.
" file://$repodir/$view/trunk "
.
" file://$repodir/$view/history/${newtag}"
)
==
0
or
goto
bad
;
...
...
@@ -592,11 +608,16 @@ sub ArchiveCommit($;$$$)
" file://$repodir/$view/trunk "
.
" file://$repodir/$view/tags/${newtag}-branch"
)
==
0
or
goto
bad
;
#
For
putting
message
into
DB
.
my
$
dclause
=
(
defined
($
mfile
)
?
", description="
.
DBQuoteSpecial
(`
cat
$
mfile
`)
:
""
);
DBQueryWarn
(
"insert into archive_tags set idx=NULL, "
.
" tag='$newtag', view='$view', "
.
" archive_idx='$archive_idx', "
.
" date_created=UNIX_TIMESTAMP(now())"
)
" tagtype='$TAGTYPE_COMMIT', "
.
" date_created=UNIX_TIMESTAMP(now()) $dclause"
)
or
goto
bad
;
DBQueryWarn
(
"update archive_views set "
.
...
...
@@ -605,25 +626,6 @@ sub ArchiveCommit($;$$$)
"where archive_idx='$archive_idx' and view='$view'"
)
or
goto
bad
;
#
Clean
the
temp
dir
for
later
.
if
(
0
)
{
if
(
!defined($altdir)) {
mysystem
(
"/bin/rm -rf $checkin"
);
if
($?)
{
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")) {
print
STDERR
"ArchiveCommit: Cannot chdir to $checkout!
\n
"
;
...
...
@@ -670,12 +672,12 @@ sub ArchiveFork($$;$$$)
#
my
$
directory
;
if
(
GetArchiveDirectory
($
archive_idx
,
\$
directory
)
<
0
)
{
print
STDERR
"Archive
Commit
: "
.
print
STDERR
"Archive
Fork
: "
.
"Archive '$archive_idx' does not exist in the DB!
\n
"
;
goto
bad
;
}
if
(
! -d $directory || ! -w $directory) {
print
STDERR
"Archive
Commit
: $directory cannot be written!
\n
"
;
print
STDERR
"Archive
Fork
: $directory cannot be written!
\n
"
;
goto
bad
;
}
my
$
repodir
=
"$directory/repo"
;
...
...
@@ -700,7 +702,7 @@ sub ArchiveFork($$;$$$)
my
($
archive_tag
,
$
previous_tag
);
if
(
GetArchiveCurrentTags
($
archive_idx
,
$
view
,
\$
archive_tag
,
\$
previous_tag
)
<
0
)
{
print
STDERR
"Archive
Commit
: "
.
print
STDERR
"Archive
Fork
: "
.
"Archive '$archive_idx' does not have a current tag!
\n
"
;
goto
bad
;
}
...
...
@@ -782,6 +784,7 @@ sub ArchiveFork($$;$$$)
#
Now
enter
an
initial
tag
for
the
new
view
.
Nothing
actually
gets
tagged
.
DBQueryWarn
(
"insert into archive_tags set idx=NULL, "
.
" tag='$newtag', archive_idx='$archive_idx', "
.
" tagtype='$TAGTYPE_INTERNAL', "
.
" view='$newview', "
.
" date_created=UNIX_TIMESTAMP(now())"
)
or
goto
bad
;
...
...
@@ -1110,6 +1113,29 @@ sub IsArchiveShared($$)
return
0
;
}
#
#
See
if
a
tag
is
unique
to
the
archive
.
#
sub
IsArchiveTaqUnique
($$$;$)
{
my
($
idx
,
$
tag
,
$
prval
,
$
view
)
=
@
_
;
$
view
=
$
defaultview
if
(
!defined($view));
my
$
query_result
=
DBQueryWarn
(
"select * from archive_tags "
.
"where archive_idx='$idx' and "
.
" view='$view' and tag='$tag'"
);
return
-
1
if
(
!$query_result);
$$
prval
=
(($
query_result
->
numrows
>
0
)
?
0
:
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
.
...
...
@@ -1649,7 +1675,8 @@ sub TBExperimentArchiveSwapModCommit($$$)
print
"Doing a commit on the experiment archive ...
\n
"
;
return
-
1
if
(
ArchiveCommit
($
archive_idx
,
$
newtag
,
$
view
,
$
location
)
!= 0);
if
(
ArchiveCommit
($
archive_idx
,
$
newtag
,
undef
,
$
view
,
$
location
)
!= 0);
if
(
!DBQueryWarn("update experiment_resources set ".
" archive_tag='$newtag' "
.
...
...
@@ -1680,9 +1707,9 @@ sub TBExperimentArchiveSwapModCommit($$$)
#
#
Commit
an
experiment
archive
.
#
sub
TBCommitExperimentArchive
($$$)
sub
TBCommitExperimentArchive
($$$
;$$
)
{
my
($
pid
,
$
eid
,
$
tagext
)
=
@
_
;
my
($
pid
,
$
eid
,
$
tagext
,
$
usertagged
,
$
mfile
)
=
@
_
;
my
($
archive_idx
,
$
view
);
return
0
...
...
@@ -1707,21 +1734,52 @@ sub TBCommitExperimentArchive($$$)
my
($
rsrcidx
)
=
$
query_result
->
fetchrow_array
();
#
#
Derive
a
tag
.
#
Derive
a
tag
,
unless
its
a
user
specified
tag
.
In
that
case
it
#
has
to
be
unique
cause
we
are
going
to
use
the
whole
thing
as
is
.
#
my
($
seconds
,
$
microseconds
)
=
gettimeofday
();
my
$
newtag
=
POSIX
::
strftime
(
"T20%y%m%d-%H%M%S-"
,
localtime
());
$
newtag
.=
int
($
microseconds
/
1000
);
$
newtag
.=
"_${tagext}"
;
my
$
newtag
;
if
(
! $usertagged) {
my
($
seconds
,
$
microseconds
)
=
gettimeofday
();
$
newtag
=
POSIX
::
strftime
(
"T20%y%m%d-%H%M%S-"
,
localtime
());
$
newtag
.=
int
($
microseconds
/
1000
);
$
newtag
.=
"_${tagext}"
;
}
else
{
$
newtag
=
$
tagext
;
my
$
unique
;
return
-
1
if
(
IsArchiveTaqUnique
($
archive_idx
,
$
newtag
,
\$
unique
,
$
view
)
<
0
);
if
(
! $unique) {
print
STDERR
"*** ArchiveCommit: Duplicate user tag: $newtag
\n
"
;
return
-
1
;
}
}
return
-
1
if
(
ArchiveCommit
($
archive_idx
,
$
newtag
,
$
view
)
!= 0);
if
(
ArchiveCommit
($
archive_idx
,
$
newtag
,
$
mfile
,
$
view
)
!= 0);
if
(
!DBQueryWarn("update experiment_resources set ".
" archive_tag='$newtag' "
.
"where idx='$rsrcidx'"
))
{
return
-
1
;
}
#
A
user
specified
tag
is
updated
.
if
($
usertagged
)
{
my
$
query_result
=
DBQueryWarn
(
"update archive_tags set "
.
" tagtype='$TAGTYPE_USER' "
.
"where archive_idx='$archive_idx' and "
.
" view='$view' and tag='$newtag'"
);
return
-
1
if
(
!$query_result);
if
(
!$query_result->affectedrows) {
print
STDERR
"*** ArchiveCommit: "
.
"Could not update user tag: $newtag
\n
"
;
}
}
return
0
;
}
...
...
@@ -1884,5 +1942,25 @@ sub TBForkExperimentArchive($$$$$)
return
0
;
}
#
#
Check
that
a
tag
is
unique
.
#
sub
TBIsTaqUnique
($$$$)
{
my
($
pid
,
$
eid
,
$
tag
,
$
prval
)
=
@
_
;
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
);
return
IsArchiveTaqUnique
($
archive_idx
,
$
tag
,
$
prval
,
$
view
);
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
www/archive_tag.php3
0 → 100644
View file @
a56be512
<?php
#
# EMULAB-COPYRIGHT
# Copyright (c) 2006 University of Utah and the Flux Group.
# All rights reserved.
#
include
(
"defs.php3"
);
include
(
"showstuff.php3"
);
#
# Only known and logged in users can look at experiments.
#
$uid
=
GETLOGIN
();
LOGGEDINORDIE
(
$uid
);
$isadmin
=
ISADMIN
(
$uid
);
#
# Verify page arguments.
#
if
(
!
isset
(
$pid
)
||
strcmp
(
$pid
,
""
)
==
0
)
{
USERERROR
(
"You must provide a Project ID."
,
1
);
}
if
(
!
isset
(
$eid
)
||
strcmp
(
$eid
,
""
)
==
0
)
{
USERERROR
(
"You must provide an Experiment ID."
,
1
);
}
if
(
!
TBvalid_pid
(
$pid
))
{
PAGEARGERROR
(
"Invalid project ID."
);
}
if
(
!
TBvalid_eid
(
$eid
))
{
PAGEARGERROR
(
"Invalid experiment ID."
);
}
function
SPITFORM
(
$formfields
,
$errors
)
{
global
$isadmin
,
$pid
,
$eid
,
$TBDB_ARCHIVE_TAGLEN
;
#
# Standard Testbed Header
#
PAGEHEADER
(
"Commit/Tag archive for experiment
$pid
/
$eid
"
);
echo
"<center>
Commit/Tag Archive
</center><br>
\n
"
;
if
(
$errors
)
{
echo
"<table class=nogrid
align=center border=0 cellpadding=6 cellspacing=0>
<tr>
<th align=center colspan=2>
<font size=+1 color=red>
Oops, please fix the following errors!
</font>
</td>
</tr>
\n
"
;
while
(
list
(
$name
,
$message
)
=
each
(
$errors
))
{
echo
"<tr>
<td align=right>
<font color=red>
$name
: </font></td>
<td align=left>
<font color=red>
$message
</font></td>
</tr>
\n
"
;
}
echo
"</table><br>
\n
"
;
}
echo
"<table align=center border=1>
<form action=archive_tag.php3?pid=
$pid
&eid=
$eid
method=post>
\n
"
;
echo
"<tr>
<td align=center>
<b>Please enter a tag[<b>1</b>]</b>
</td>
</tr>
\n
"
;
echo
"<tr>
<td class=left>
<input type=text
name=
\"
formfields[tag]
\"
value=
\"
"
.
$formfields
[
tag
]
.
"
\"
size=
$TBDB_ARCHIVE_TAGLEN
maxlength=
$TBDB_ARCHIVE_TAGLEN
>
</tr>
\n
"
;
echo
"<tr>
<td align=center>
<b>Please enter an optional message to be logged
with the tag.</b>
</td>
</tr>
<tr>
<td align=center class=left>
<textarea name=
\"
formfields[message]
\"
rows=10 cols=70>"
.
ereg_replace
(
"
\r
"
,
""
,
$formfields
[
message
])
.
"</textarea>
</td>
</tr>
\n
"
;
echo
"<tr>
<td align=center>
<b><input type=submit name=submit value='Commit and Tag'></b>
</td>
</tr>
\n
"
;
echo
"</form>
</table>
\n
"
;
echo
"<blockquote><blockquote><blockquote>
<ol>
<li> Optional tag must contain only alphanumeric characters,
starting with an alpha character. If no tag is supplied,
we will make one up for you, but that is probably not
what you want.
</ol>
</blockquote></blockquote></blockquote>
\n
"
;
}
#
# On first load, display a virgin form and exit.
#
if
(
!
$submit
)
{
$defaults
=
array
();
SPITFORM
(
$defaults
,
0
);
PAGEFOOTER
();
return
;
}
# Args to shell.
$tag
=
""
;
$tagarg
=
""
;
$message
=
""
;
$tmpfname
=
Null
;
function
CLEANUP
()
{
global
$tmpfname
;
if
(
$tmpfname
!=
NULL
)
unlink
(
$tmpfname
);
exit
();
}
register_shutdown_function
(
"CLEANUP"
);
#
# Otherwise, must validate and redisplay if errors
#
$errors
=
array
();
#
# Tag
#
if
(
isset
(
$formfields
[
"tag"
])
&&
$formfields
[
"tag"
]
!=
""
)
{
if
(
!
TBvalid_archive_tag
(
$formfields
[
"tag"
]))
{
$errors
[
"Tag"
]
=
TBFieldErrorString
();
}
else
{
$tag
=
escapeshellarg
(
$formfields
[
"tag"
]);
$tagarg
=
"-t
$tag
"
;
}
}
if
(
isset
(
$formfields
[
"message"
])
&&
$formfields
[
"message"
]
!=
""
)
{
if
(
!
TBvalid_archive_message
(
$formfields
[
"message"
]))
{
$errors
[
"Message"
]
=
TBFieldErrorString
();
}
else
{
#
# Easier to stick the entire message into a temporary file and
# send that through.
#
$tmpfname
=
tempnam
(
"/tmp"
,
"archive_tag"
);
$fp
=
fopen
(
$tmpfname
,
"w"
);
fwrite
(
$fp
,
$formfields
[
"message"
]);
fclose
(
$fp
);
chmod
(
$tmpfname
,
0666
);
$message
=
"-m
$tmpfname
"
;
}
}
#
# If any errors, respit the form with the current values and the
# error messages displayed. Iterate until happy.
#
if
(
count
(
$errors
))
{
SPITFORM
(
$formfields
,
$errors
);
PAGEFOOTER
();
return
;
}
if
(
!
TBExptGroup
(
$pid
,
$eid
,
$gid
))
{
TBERROR
(
"Could not get experiment gid for
$pid
/
$eid
!"
,
1
);
}
#
# First lets make sure the tag is unique.
#
$retval
=
SUEXEC
(
$uid
,
"
$pid
,
$gid
"
,
"webarchive_control checktag
$pid
$eid
$tag
"
,
SUEXEC_ACTION_IGNORE
);
#
# Fatal Error.
#
if
(
$retval
<
0
)
{
SUEXECERROR
(
SUEXEC_ACTION_DIE
);
}
# User error. Tell user and exit.
if
(
$retval
)
{
$errors
[
"Tag"
]
=
"Already in use; pick another"
;