Commit c85367b4 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint

parent 3e2702be
......@@ -24,6 +24,8 @@ CREATE TABLE `geni_users` (
`idx` mediumint(8) unsigned NOT NULL default '0',
`uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`expires` datetime default NULL,
`locked` datetime default NULL,
`archived` datetime default NULL,
`status` enum('active','archived','frozen') NOT NULL default 'frozen',
`name` tinytext,
......@@ -100,6 +102,8 @@ CREATE TABLE `geni_slices` (
`uuid` varchar(40) NOT NULL default '',
`exptidx` int(11) default NULL,
`created` datetime default NULL,
`expires` datetime default NULL,
`locked` datetime default NULL,
`creator_uuid` varchar(40) NOT NULL default '',
`name` tinytext,
`sa_uuid` varchar(40) NOT NULL default '',
......@@ -123,6 +127,8 @@ CREATE TABLE `geni_slivers` (
`resource_uuid` varchar(40) NOT NULL default '',
`resource_type` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`expires` datetime default NULL,
`locked` datetime default NULL,
`credential_idx` int(10) unsigned default NULL,
`component_uuid` varchar(40) default NULL,
`aggregate_uuid` varchar(40) default NULL,
......@@ -146,6 +152,8 @@ CREATE TABLE `geni_aggregates` (
`slice_uuid` varchar(40) NOT NULL default '',
`creator_uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`expires` datetime default NULL,
`locked` datetime default NULL,
`credential_idx` int(10) unsigned default NULL,
`component_idx` int(10) unsigned NOT NULL default '0',
`aggregate_idx` int(10) unsigned default NULL,
......@@ -166,6 +174,7 @@ CREATE TABLE `geni_tickets` (
`slice_uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`redeem_before` datetime default NULL,
`locked` datetime default NULL,
`valid_until` datetime default NULL,
`component_uuid` varchar(40) NOT NULL default '',
`seqno` int(10) unsigned NOT NULL default '0',
......
......@@ -19,7 +19,7 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniUtil.pm GeniRegistry.pm
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = test.pl addnode.pl test.pl addauthority
SCRIPTS = test.pl addnode.pl
#OPS_LIBS = GeniCMClient.pm GeniSAClient.pm
# These scripts installed setuid, with sudo.
......
......@@ -33,13 +33,18 @@ use GeniUser;
use GeniRegistry;
use libtestbed;
# Hate to import all this crap; need a utility library.
use libdb qw(TBGetUniqueIndex TBcheck_dbslot TBDB_CHECKDBSLOT_ERROR);
use libdb qw(TBGetUniqueIndex TBcheck_dbslot TBGetSiteVar
TBDB_CHECKDBSLOT_ERROR);
use User;
use Node;
use libadminctrl;
use Interface;
use English;
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
use Experiment;
# Configure variables
......@@ -187,6 +192,23 @@ sub DiscoverResources($)
"Invalid credentials for operation");
}
#
# A sitevar controls whether external users can get any nodes.
#
my $allow_externalusers = 0;
if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
# Cannot get the value, say no.
$allow_externalusers = 0;
}
if (!$allow_externalusers) {
my $user = GeniUser->Lookup($user_uuid, 1);
# No record means the user is remote.
if (!defined($user) || !$user->IsLocal()) {
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"External users temporarily denied");
}
}
#
# Use ptopgen in xml mode to spit back an xml file.
#
......@@ -214,6 +236,7 @@ sub GetTicket($)
my $cred = $argref->{'credential'};
my $vtopo = $argref->{'virtual_topology'};
my $owner_uuid = $ENV{'GENIUSER'};
my $response = undef;
if (! defined($cred)) {
return GeniResponse->MalformedArgsResponse();
......@@ -245,9 +268,7 @@ sub GetTicket($)
}
#
# See if we have a record of this slice in the DB. If not, then we have
# to go to the ClearingHouse to find its record, so that we can find out
# who the SA for it is.
# Create slice form the certificate.
#
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
......@@ -272,10 +293,73 @@ sub GetTicket($)
}
}
#
# A sitevar controls whether external users can get any nodes.
#
my $allow_externalusers = 0;
if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
# Cannot get the value, say no.
$allow_externalusers = 0;
}
if (!$allow_externalusers && !$user->IsLocal()) {
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"External users temporarily denied");
}
#
# For now all tickets expire ery quickly (minutes), but once the
# ticket is redeemed, it will expire according to the rspec request.
#
if (exists($rspec->{'valid_until'})) {
my $expires = $rspec->{'valid_until'};
if (! ($expires =~ /^[-\w:.\/]+/)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Illegal valid_until in rspec");
}
# Convert to a localtime.
my $when = timegm(strptime($expires));
if (!defined($when)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Could not parse valid_until");
}
#
# No more then 24 hours out ... Needs to be a sitevar?
#
my $diff = $when - time();
if ($diff < (60 * 15) || $diff > (3600 * 24)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"valid_until out of range");
}
}
else {
# Give it a reasonable default for later when the ticket is redeemed.
$rspec->{'valid_until'} =
POSIX::strftime("20%y-%m-%dT%H:%M:%S", gmtime(time() + (3600*1)));
}
#
#
# Lock the slice from further access.
#
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
# For now, there can be only a single toplevel aggregate per slice.
#
my $aggregate = GeniAggregate->SliceAggregate($slice);
if (defined($aggregate)) {
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Already have an aggregate for slice");
}
my $experiment = GeniExperiment($slice_uuid);
if (!defined($experiment)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Internal Error");
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_ERROR,
undef, "Internal Error");
}
#
......@@ -292,10 +376,32 @@ sub GetTicket($)
foreach my $ref (@{$rspec->{'node'}}) {
my $resource_uuid = $ref->{'uuid'};
my $node = Node->Lookup($resource_uuid);
my $node;
#
# Mostly for debugging right now, allow a wildcard.
#
if ($resource_uuid eq "*") {
$node = FindFreeNode();
if (!defined($node)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Bad resource_uuid $resource_uuid");
$response = GeniResponse->Create(GENIRESPONSE_UNAVAILABLE,
undef,
"No free nodes for wildcard");
goto bad;
}
$resource_uuid = $node->uuid();
$ref->{'uuid'} = $node->uuid();
}
else {
$node = Node->Lookup($resource_uuid);
if (!defined($node)) {
$response =
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Bad resource $resource_uuid");
goto bad;
}
}
#
# Widearea nodes do not need to be allocated, but for now all
......@@ -303,8 +409,10 @@ sub GetTicket($)
#
if ($node->isremotenode()) {
if (! $node->isplabphysnode()) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
$response =
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Only plab widearea nodes");
goto bad;
}
next;
}
......@@ -314,49 +422,89 @@ sub GetTicket($)
#
my $reservation = $node->Reservation();
if (defined($reservation)) {
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"$resource_uuid ($node) is not available");
$response =
GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"$resource_uuid ($node) not available");
goto bad;
}
push(@nodeids, $node->node_id());
}
#
# A sitevar controls how many total nodes external users can allocate.
#
# XXX All this policy stuff is a whack job for the initial release.
#
my $max_externalnodes = 0;
if (!TBGetSiteVar('protogeni/max_externalnodes', \$max_externalnodes)){
# Cannot get the value, say none.
$max_externalnodes = 0;
}
if (scalar(@nodeids) > $max_externalnodes) {
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"Too many nodes; limited to $max_externalnodes");
}
# Check current usage by dipping into the libadminctrl library.
my $curusage = libadminctrl::LoadCurrent($experiment->creator(),
$experiment->pid(),
$experiment->gid());
if (!defined($curusage)) {
$slice->UnLock();
print STDERR "Could not get current usage from adminctl library\n";
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"Temporarily unavailable");
}
if ($curusage->{"nodes"}->{'project'} + scalar(@nodeids) >=
$max_externalnodes) {
$slice->UnLock();
my $nodesleft = $max_externalnodes - $curusage->{"nodes"}->{'project'};
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"Too many nodes; limited to $nodesleft");
}
#
# Create the ticket first, before allocating the node.
#
my $ticket = GeniTicket->Create($slice, $user, $rspec);
if (!defined($ticket)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniTicket object");
goto bad;
}
# Nalloc might fail if the node gets picked up by someone else.
if (@nodeids && !$impotent) {
system("$NALLOC $pid $eid @nodeids");
if (($? >> 8) < 0) {
$ticket->Delete();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Allocation failure");
goto bad;
}
elsif (($? >> 8) > 0) {
$ticket->Delete();
return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
$response =
GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
"Could not allocate node");
goto bad;
}
}
if (defined($vtopo) && $experiment->InsertVirtTopo($vtopo) != 0) {
# Release will free the nodes.
$ticket->Release();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not insert virt topology");
}
if ($ticket->Sign() != 0) {
# Release will free the nodes.
$ticket->Release();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
$response = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not sign Ticket");
goto bad;
}
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_SUCCESS,
$ticket->asString());
bad:
$slice->UnLock()
if (defined($slice));
return $response;
}
#
......@@ -367,6 +515,7 @@ sub RedeemTicket($)
my ($argref) = @_;
my $ticket = $argref->{'ticket'};
my $impotent = $argref->{'impotent'};
my $keys = $argref->{'keys'};
my $extraargs = $argref->{'extraargs'};
$impotent = 0
......@@ -391,7 +540,40 @@ sub RedeemTicket($)
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"This is not your credential!");
}
return ModifySliver(undef, $ticket, $ticket->rspec(), $impotent);
my $slice = GeniSlice->Lookup($ticket->slice_uuid());
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
#
# Do not redeem an expired ticket, kill it now.
#
if ($ticket->Expired()) {
$ticket->Release();
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_EXPIRED, undef,
"Ticket has expired");
}
#
# For now, ther can be only a single toplevel aggregate per slice.
#
my $aggregate = GeniAggregate->SliceAggregate($slice);
if (defined($aggregate)) {
$ticket->Release();
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Already have an aggregate for slice");
}
my $response = ModifySliver(undef, $slice, $ticket,
$ticket->rspec(), $impotent, $keys);
$slice->UnLock();
return $response;
}
#
......@@ -403,6 +585,8 @@ sub UpdateSliver($)
my $cred = $argref->{'credential'};
my $rspec = $argref->{'rspec'};
my $impotent = $argref->{'impotent'};
my $keys = $argref->{'keys'};
my $extraargs = $argref->{'extraargs'};
$impotent = 0
if (!defined($impotent));
......@@ -440,40 +624,34 @@ sub UpdateSliver($)
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"No such aggregate $sliver_uuid");
}
return ModifySliver($aggregate, $credential, $rspec, $impotent);
my $slice = GeniSlice->Lookup($aggregate->slice_uuid());
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
my $response = ModifySliver($aggregate, $slice,
$credential, $rspec, $impotent, $keys);
$slice->UnLock();
return $response;
}
#
# Utility function for above routines.
#
sub ModifySliver($$$$)
sub ModifySliver($$$$$$)
{
my ($object, $credential, $rspec, $impotent) = @_;
my ($object, $slice, $credential, $rspec, $impotent, $keys) = @_;
my $owner_uuid = $credential->owner_uuid();
my $message = "Error creating sliver/aggregate";
my $slice_uuid;
my $aggregate;
#
# See if we have a record of this slice in the DB. If not, throw an
# error; might change later.
#
if (defined($object)) {
# We get the slice via the sliver/aggregate.
$slice_uuid = $object->slice_uuid();
}
else {
$slice_uuid = $credential->slice_uuid();
}
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
#
# Ditto the user.
# Create the user.
#
my $owner = GeniUser->Lookup($owner_uuid);
if (!defined($owner)) {
......@@ -484,8 +662,11 @@ sub ModifySliver($$$$)
"No user record for $owner_uuid");
}
}
if (!$owner->IsLocal() && defined($keys)) {
$owner->Modify(undef, undef, $keys);
}
my $experiment = GeniExperiment($slice_uuid);
my $experiment = GeniExperiment($slice->uuid());
if (!defined($experiment)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No local experiment for slice");
......@@ -529,6 +710,37 @@ sub ModifySliver($$$$)
}
}
#
# Figure out new expiration time; this is the time at which we can
# idleswap the slice out.
#
if (exists($rspec->{'valid_until'})) {
my $expires = $rspec->{'valid_until'};
if (! ($expires =~ /^[-\w:.\/]+/)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Illegal valid_until in rspec");
}
# Convert to a localtime.
my $when = timegm(strptime($expires));
if (!defined($when)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Could not parse valid_until");
}
#
# No more then 24 hours out ... Needs to be a sitevar?
#
my $diff = $when - time();
if ($diff < (60 * 15) || $diff > (3600 * 24)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"valid_until out of range");
}
if ($slice->SetExpiration($when) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not set expiration time");
}
}
#
# Figure out what nodes need to be allocated.
#
......@@ -951,10 +1163,24 @@ sub ReleaseTicket($)
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"This is not your credential!");
}
#
# Lock the slice to avoid concurrent operation.
#
my $slice = GeniSlice->Lookup($ticket->slice_uuid());
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
if ($ticket->Release() != 0) {
print STDERR "Error releasing $ticket\n";
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_ERROR);
}
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
......@@ -997,11 +1223,23 @@ sub StartSliver($)
"No such sliver/aggregate $sliver_uuid");
}
}
if (!$impotent) {
$sliver->Start() == 0 or
#
# Lock the slice to avoid concurrent operation.
#
my $slice = GeniSlice->Lookup($sliver->slice_uuid());
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
if (!$impotent && $sliver->Start() != 0) {
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not start sliver/aggregate");
}
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
......@@ -1013,6 +1251,8 @@ sub DeleteSliver($)
my ($argref) = @_;
my $cred = $argref->{'credential'};
my $impotent = $argref->{'impotent'};
my $slice_uuid;
my $response;
$impotent = 0
if (!defined($impotent));
......@@ -1044,9 +1284,22 @@ sub DeleteSliver($)
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"No such sliver/aggregate $sliver_uuid");
}
$slice_uuid = $aggregate->slice_uuid();
push(@slivers, $aggregate);
}
else {
$slice_uuid = $sliver->slice_uuid();
}
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No slice record for slice");
}
if ($slice->Lock() != 0) {
return GeniResponse->BusyResponse();
}
if (defined($sliver)) {
#
# Find dependent slivers first (say, links on a node). For now,
# do not allow this sliver to be torn down until the dependent
......@@ -1054,83 +1307,359 @@ sub DeleteSliver($)
# down here in the proper order, hence the code below.
#
if ($sliver->DependentSlivers(\@slivers) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get DependentSlivers");
goto bad;
}
if (@slivers) {
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
$response =
GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
"Must tear dow dependent slivers");
goto bad;
}
@slivers = (@slivers, $sliver);
}
foreach $sliver (@slivers) {
if (!$impotent) {
$sliver->UnProvision() == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
if (!$impotent && $sliver->UnProvision() != 0) {
$response =
GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not unprovision sliver");
goto bad;
}
$sliver->Delete() == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
if ($sliver->Delete() != 0) {
$response = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not delete sliver");
goto bad;
}
}
$slice->UnLock();
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
bad:
$slice->UnLock();
return $response;
}
#
# Utility Routines.