Commit 55d1bb6e authored by Leigh B. Stoller's avatar Leigh B. Stoller
Browse files

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;