Commit 55d1bb6e authored by Leigh Stoller's avatar Leigh Stoller

Mostly this commit is the switch from SVN archives to ZIP archives.

Other stuff leaked in too ...

I did separate out a lot of tbsetup/libArchive into db/Archive, and
whats left in libArchive.pm will eventually move over into the
Template library.

Note that I have dropped archiving of plain experiments; this is not
really owrth it outside the workbench context, and it just wastes
space and makes a lot if stuff painful in the web interface.
parent 529ed6ca
This diff is collapsed.
......@@ -17,10 +17,10 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use libtblog;
use User;
use Project;
use Group;
use Node;
use English;
use Data::Dumper;
use File::Basename;
......@@ -133,8 +133,16 @@ sub Lookup($$;$)
$self->{'STATS'} = $query_result->fetchrow_hashref();
# We get this lazily.
$self->{'RSRC'} = undef;
my $rsrcidx = $self->{'STATS'}->{'rsrcidx'};
$query_result =
DBQueryWarn("select * from experiment_resources ".
"where idx='$rsrcidx'");
return -1
if (!$query_result || !$query_result->numrows);
$self->{'RSRC'} = $query_result->fetchrow_hashref();
bless($self, $class);
......@@ -144,8 +152,9 @@ sub Lookup($$;$)
return $self;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{$_[1]}); }
sub stats($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'STATS'}->{$_[1]}); }
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'EXPT'}->{$_[1]}); }
sub stats($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'STATS'}->{$_[1]});}
sub resources($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'RSRC'}->{$_[1]}); }
sub pid($) { return field($_[0], 'pid'); }
sub gid($) { return field($_[0], 'gid'); }
......@@ -184,6 +193,8 @@ sub swapper_idx($) { return field($_[0], 'swapper_idx');}
sub use_ipassign($) { return field($_[0], 'use_ipassign');}
sub ipassign_args($) { return field($_[0], 'ipassign_args');}
sub security_level($) { return field($_[0], 'security_level');}
sub archive_idx($) { return stats($_[0], 'archive_idx'); }
sub archive_tag($) { return resources($_[0], 'archive_tag'); }
#
# Lookup an experiment given an experiment index.
......@@ -249,6 +260,7 @@ sub LockTables($;$)
$spec = "experiments write"
if (!defined($spec));
$spec .= ", experiment_stats read";
$spec .= ", experiment_resources read";
DBQueryWarn("lock tables $spec")
or return -1;
......@@ -520,7 +532,7 @@ sub Refresh($)
if (! ref($self));
my $idx = $self->idx();
my $query_result =
DBQueryWarn("select * from experiments where idx=$idx");
......@@ -528,6 +540,7 @@ sub Refresh($)
if (!$query_result || !$query_result->numrows);
$self->{'EXPT'} = $query_result->fetchrow_hashref();
$self->{'ISINSTANCE'} = undef;
$query_result =
DBQueryWarn("select * from experiment_stats where exptidx='$idx'");
......@@ -537,8 +550,16 @@ sub Refresh($)
$self->{'STATS'} = $query_result->fetchrow_hashref();
# And this is lazy again.
$self->{'RSRC'} = undef;
my $rsrcidx = $self->rsrcidx();
$query_result =
DBQueryWarn("select * from experiment_resources ".
"where idx='$rsrcidx'");
return -1
if (!$query_result || !$query_result->numrows);
$self->{'RSRC'} = $query_result->fetchrow_hashref();
return 0;
}
......@@ -1188,7 +1209,7 @@ sub Report($;$$)
#
# Return list of local nodes.
#
sub LocalNodeList($$)
sub LocalNodeListNames($$)
{
my ($self, $lref) = @_;
......@@ -1203,6 +1224,39 @@ sub LocalNodeList($$)
return 0;
}
#
# Return list of experiment nodes (objects or just names)
#
sub NodeList($;$)
{
my ($self, $namesonly) = @_;
my @nodenames = ();
# Must be a real reference.
return -1
if (! ref($self));
my $pid = $self->pid();
my $eid = $self->eid();
@nodenames = ExpNodes($pid, $eid);
return @nodenames
if (defined($namesonly) && $namesonly);
my @nodes = ();
foreach my $node (@nodenames) {
my $node = Node->Lookup($node);
if (!defined($node)) {
print STDERR "*** Could not map $node to its object\n";
return undef;
}
push(@nodes, $node);
}
return @nodes;
}
#
# Copy log files to long term storage.
#
......@@ -1819,6 +1873,19 @@ sub IsInstance($)
return 0
if (! ref($self));
if (defined($self->{'ISINSTANCE'})) {
return $self->{'ISINSTANCE'};
}
my $idx = $self->idx();
my $query_result =
DBQueryWarn("select parent_guid from experiment_template_instances ".
"where exptidx='$idx'");
return 0
if (!$query_result);
$self->{'ISINSTANCE'} = $query_result->numrows;
return $self->{'ISINSTANCE'};
}
......
......@@ -24,7 +24,7 @@ WEB_BIN_SCRIPTS = webnfree
LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS) xmlconvert
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
NodeType.pm Interface.pm User.pm Group.pm Project.pm \
Image.pm OSinfo.pm
Image.pm OSinfo.pm Archive.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy
......
......@@ -17,8 +17,9 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use NodeType;
use Interface;
require NodeType;
require Interface;
require Experiment;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
......@@ -55,6 +56,9 @@ sub Lookup($$)
return $nodes{$nodeid}
if (exists($nodes{$nodeid}));
return undef
if (! ($nodeid =~ /^\w+$/));
my $query_result =
DBQueryWarn("select * from nodes as n ".
"where n.node_id='$nodeid'");
......@@ -119,6 +123,24 @@ sub Stringify($)
return "[Node: $nodeid]";
}
#
# Check permissions. Allow for either uid or a user ref until all code
# updated.
#
sub AccessCheck($$$)
{
my ($self, $user, $access_type) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $uid = (ref($user) ? $user->uid() : $user);
my $node_id = $self->node_id();
return TBNodeAccessCheck($uid, $access_type, $node_id);
}
#
# Lazily load the reservation info.
#
......@@ -146,6 +168,53 @@ sub IsReserved($)
return 1;
}
#
# Get the experiment this node is reserved too, or null.
#
sub Reservation($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0
if (! $self->IsReserved());
return Experiment->Lookup($self->{"RSRV"}->{'pid'},
$self->{"RSRV"}->{'eid'});
}
#
# Get the raw reserved table info and return it, or null if no reservation
#
sub ReservedTableEntry($)
{
my ($self) = @_;
return undef
if (! ref($self));
return undef
if (! $self->IsReserved());
return $self->{"RSRV"};
}
# Need to create a set of access methods for the reservation.
sub vname($)
{
my ($self) = @_;
return undef
if (! ref($self));
return undef
if (! $self->IsReserved());
return $self->{"RSRV"}->{'vname'};
}
#
# Return type info. We cache this in the instance since node_type stuff
# does not change much.
......@@ -227,6 +296,30 @@ sub rebootable($;$) {
return NodeTypeInfo($_[0])->rebootable($_[1]);
}
#
# Perform some updates ...
#
sub Update($$)
{
my ($self, $argref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $nodeid = $self->node_id();
my $query = "update nodes set ".
join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));
$query .= " where node_id='$nodeid'";
return -1
if (! DBQueryWarn($query));
return Refresh($self);
}
#
# Create new vnodes. This routine obviously cannot be called on a specific
# instance since it does not exist! The argument is still a reference; to a
......
......@@ -41,6 +41,24 @@ CREATE TABLE `active_checkups` (
PRIMARY KEY (`object`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `archive_revisions`
--
DROP TABLE IF EXISTS `archive_revisions`;
CREATE TABLE `archive_revisions` (
`archive_idx` int(10) unsigned NOT NULL default '0',
`revision` int(10) unsigned NOT NULL auto_increment,
`parent_revision` int(10) unsigned default NULL,
`tag` varchar(64) NOT NULL default '',
`view` varchar(64) NOT NULL default '',
`date_created` int(10) unsigned NOT NULL default '0',
`converted` tinyint(1) default '0',
`description` text,
PRIMARY KEY (`archive_idx`,`revision`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
--
-- Table structure for table `archive_tags`
--
......@@ -53,6 +71,7 @@ CREATE TABLE `archive_tags` (
`view` varchar(64) NOT NULL default '',
`date_created` int(10) unsigned NOT NULL default '0',
`tagtype` enum('user','commit','savepoint','internal') NOT NULL default 'internal',
`version` tinyint(1) default '0',
`description` text,
PRIMARY KEY (`idx`),
UNIQUE KEY `tag` (`tag`,`archive_idx`,`view`)
......@@ -66,11 +85,13 @@ DROP TABLE IF EXISTS `archive_views`;
CREATE TABLE `archive_views` (
`view` varchar(64) NOT NULL default '',
`archive_idx` int(10) unsigned NOT NULL default '0',
`current_tag` varchar(64) NOT NULL default '',
`revision` int(10) unsigned default NULL,
`current_tag` varchar(64) default NULL,
`previous_tag` varchar(64) default NULL,
`date_created` int(10) unsigned NOT NULL default '0',
`branch_tag` varchar(64) default NULL,
`parent_view` varchar(64) default NULL,
`parent_revision` int(10) unsigned default NULL,
PRIMARY KEY (`view`,`archive_idx`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
......
......@@ -3988,3 +3988,26 @@ last_net_act,last_cpu_act,last_ext_act);
alter table images add
`mbr_version` tinyint(4) NOT NULL default '1'
after global;
4.120: Convert to zip archives.
CREATE TABLE `archive_revisions` (
`archive_idx` int(10) unsigned NOT NULL default '0',
`revision` int(10) unsigned NOT NULL auto_increment,
`parent_revision` int(10) unsigned default NULL,
`tag` varchar(64) NOT NULL default '',
`view` varchar(64) NOT NULL default '',
`date_created` int(10) unsigned NOT NULL default '0',
`description` text,
`converted` tinyint(1) default '0',
PRIMARY KEY (`archive_idx`,`revision`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
alter table archive_views add `revision` int(10) unsigned
default NULL after archive_idx;
alter table archive_views add `parent_revision` int(10) unsigned
default NULL after parent_view;
alter table archive_views change current_tag
`current_tag` varchar(64) default NULL;
alter table archive_tags add `version` tinyint(1)
default '0' after tagtype;
......@@ -21,6 +21,8 @@ use libdb;
use libtestbed;
use libtblog;
use libArchive;
use Archive;
use Project;
use User;
use Experiment;
use Group;
......@@ -126,9 +128,11 @@ sub Lookup($$$)
sub guid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'guid'}); }
sub vers($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'vers'}); }
sub pid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'pid'}); }
sub pid_idx($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'pid_idx'}); }
sub gid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'gid'}); }
sub gid_idx($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'gid_idx'}); }
sub eid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'eid'}); }
sub exptidx($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'exptidx'}); }
sub tid($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'tid'}); }
sub path($) { return ((! ref($_[0])) ? -1 : $_[0]->{'TEMPLATE'}->{'path'}); }
sub archive_idx($) {
......@@ -1775,6 +1779,34 @@ sub Stamp($$;$$$)
return 0;
}
#
# Return archive object for the template.
#
sub GetArchive($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
return Archive->Lookup($self->archive_idx());
}
#
# Return project object for the template.
#
sub GetProject($)
{
my ($self) = @_;
# Must be a real reference.
return undef
if (! ref($self));
return Project->Lookup($self->pid_idx());
}
############################################################################
package Template::Instance;
......@@ -2951,8 +2983,6 @@ sub CopyDataStore($$$;$)
or return -1;
}
libArchive::setdebug(2);
libArchive::TBCheckoutExperimentArchivebyExptIDX($exptidx,
$to_path,
$archive_tag,
......@@ -3407,6 +3437,24 @@ sub Stamp($$;$$$)
return 0;
}
#
# Return archive object for template instance.
#
sub GetArchive($$)
{
my ($self, $viewp) = @_;
# Must be a real reference.
return undef
if (! ref($self));
# The view is always the experiment index.
$$viewp = $self->exptidx()
if (defined($viewp));
$self->template()->GetArchive();
}
############################################################################
package Template::Instance::Run;
......@@ -3414,7 +3462,6 @@ use libdb;
use libtestbed;
use libtblog;
use English;
use libArchive;
use overload ('""' => 'Stringify');
# Flags for functions below.
......
......@@ -19,7 +19,7 @@ sub usage()
" archive_control checktag <pid> <eid> <tag>\n";
exit(-1);
}
my $optlist = "dfat:m:us:";
my $optlist = "dfat:m:us:l";
my $debug = 0;
my $force = 0;
my $dbuid;
......@@ -121,9 +121,6 @@ if (! $experiment->AccessCheck($this_user, TB_EXPT_UPDATE)) {
fatal("You do not have permission to control the archive for $pid/$eid!");
}
# Temporary
libArchive::setdebug($debug);
# Do not audit this operation.
if ($action eq "checktag") {
usage()
......@@ -325,6 +322,7 @@ elsif ($action eq "list" ||
my @files = ();
my $tag = undef;
my $subdir = undef;
my $long = (defined($options{"l"}) ? 1 : 0);
if (defined($options{"t"})) {
$tag = $options{"t"};
......@@ -367,7 +365,8 @@ elsif ($action eq "list" ||
}
my $rval =
libArchive::TBListExperimentArchive($pid, $eid, \@files, $tag, $subdir);
libArchive::TBListExperimentArchive($pid, $eid, \@files,
$long, $tag, $subdir);
exit($rval)
if ($rval);
......
......@@ -72,7 +72,6 @@ my $branch_template; # New stuff; experiment templates.
my $instance; # New stuff; experiment templates.
# 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.
......@@ -339,6 +338,16 @@ if (!defined($template) || defined($instance)) {
error => ['create_experiment_directory_failed']},
"Failed to created experiment directory");
}
if (defined($instance)) {
# Need to cross-mark the instance right away so that it is flagged.
# Would be better to do this with a plain flag.
my %args = ();
$args{'exptidx'} = $experiment->idx();
$instance->Update(0, \%args) == 0
or fatal("Could not update experiment instance record!");
}
}
else {
#
......@@ -382,15 +391,6 @@ if (defined($branch_template)) {
$pid, $archive_eid, undef)
< 0);
}
elsif ($copybranch) {
# Currently, support branching from existing experiment only.
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'create', undef, undef]},
"Could not create experiment archive!")
if (libArchive::TBForkExperimentArchive($pid, $eid,
$copypid,
$copyeid, $copytag) < 0);
}
elsif (libArchive::TBCreateExperimentArchive($pid, $eid) < 0) {
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'create', undef, undef]},
......@@ -641,7 +641,7 @@ if (! ($frontend || $batchmode)) {
#
my @localnodes = ();
fatal("Could not get local node list for $pid/$eid")
if ($experiment->LocalNodeList(\@localnodes));
if ($experiment->LocalNodeListNames(\@localnodes));
if (@localnodes && scalar(@localnodes) > 2) {
my $vlans_result =
......@@ -700,18 +700,6 @@ if (! defined($template)) {
}
}
#
# 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 && !defined($template)) {
print "Doing a commit on the experiment archive ...\n";
libArchive::TBCommitExperimentArchive($pid, $eid, "branch_merge") == 0 or
fatal({type => 'secondary', severity => SEV_SECONDARY,
error => ['archive_op_failed', 'commit', undef, undef]},
"Failed to commit experiment archive!");
}
#
# Gather statistics.
#
......@@ -1006,10 +994,6 @@ sub ParseArgs()
error => ['bad_data', 'argument', $copyarg]},
"Bad data in argument: $copyarg");
}
# This option only makes sense with -c option.
if (defined($options{"b"})) {
$copybranch = 1;
}
}
#
......
This diff is collapsed.
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002, 2004 University of Utah and the Flux Group.
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
# All rights reserved.
#
use strict;
use English;
use Getopt::Std;
......@@ -26,7 +27,8 @@ sub usage()
"Use -e to change parameters of all nodes in an experiment.\n");
exit(-1);
}
my $optlist = "de:l";
my $optlist = "de:l";
my $debug = 0;
#
# Array of allowed names. All of these values are text, so no need to
......@@ -68,12 +70,8 @@ my $TBLOGS = "@TBLOGSEMAIL@";
my $osselect = "$TB/bin/os_select";
my @nodes = ();
my %controls = ();
my $eidmode = 0;
my $debug = 0;
my $errors = 0;
my $pid;
my $eid;
my $dbuid;
my $experiment;
#
# Load the Testbed support stuff.
......@@ -81,8 +79,12 @@ my $dbuid;
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use User;
use Experiment;
use Node;
my $IsAdmin = TBAdmin($UID);
# Protos
sub fatal($);
# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
......@@ -95,7 +97,7 @@ $| = 1;
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
my %options = ();
if (! getopts($optlist, \%options)) {
usage();
}
......@@ -120,22 +122,26 @@ if (defined($options{"l"})) {
}
exit(0);
}
# Experiment mode.
if (defined($options{"e"})) {
$eidmode = $options{"e"};
if ($eidmode =~ /([-\w]*),([-\w]*)/) {
$pid = $1;
$eid = $2;
}
else {
usage();
$experiment = Experiment->Lookup($options{"e"});
if (!defined($experiment)) {
fatal("No such experiment in the Emulab DB!");
}
}
if (! @ARGV) {
usage();
}
#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
fatal("You ($UID) do not exist!");
}
my $isadmin = TBAdmin();
#
# Shift off the set strings (name=value). Verify that each one is in the
# proper format.
......@@ -149,14 +155,12 @@ while (@ARGV) {
shift;
if (! defined($controlset{$1})) {
die("*** $0:\n".
" Illegal control setting: $1='$2'. Try the -l option!\n");
fatal("Illegal control setting: $1='$2'. Try the -l option!");
}
my ($admin,$multi) = @{ $controlset{$1} };
if ($admin && ! $IsAdmin) {
die("*** $0:\n".
" You do not have permission to set $1. Try the -l option!\n");
if ($admin && ! $isadmin) {
fatal("You do not have permission to set $1. Try the -l option!");
}
if ($multi && defined($controls{$1})) {
......@@ -178,17 +182,15 @@ if ($debug) {
# get the nodes. Otherwise, check access for each node given on the
# command line.
#
if ($eidmode) {
if (defined($experiment)) {
# Permission check.
if ($UID && !TBAdmin($UID) &&
! TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
die("*** $0:\n".
" You do not have permission to control nodes in $pid/$eid!\n");
if (!$isadmin &&
!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
fatal("You do not have permission to control nodes in $experiment!");
}
if (! (@nodes = ExpNodes($pid, $eid))) {
die("*** $0:\n".
" There are no nodes in $pid/$eid!\n");
if (! (@nodes = $experiment->NodeList())) {
fatal("There are no nodes in $experiment!");
}
}
else {
......@@ -196,29 +198,25 @@ else {
usage();
}
# Untaint the nodes.
foreach my $node ( @ARGV ) {
if ($node =~ /^([-\w]+)$/) {
$node = $1;
foreach my $nodeid (@ARGV) {
my $node = Node->Lookup($nodeid);
if (!defined($node)) {
fatal("Bad node name: $node");
}
else {
die("Bad node name: $node.");
}
push(@nodes, $node);
}
}
#
# Create an update clause for all of the specified values.
# Create update key/value pairs
#
my $physnodes_updatestr;
my $virtnodes_updatestr;