Commit 4e3396cf authored by Leigh B. Stoller's avatar Leigh B. Stoller
Browse files

Checkpoint

parent 9e7294d9
...@@ -118,7 +118,27 @@ CREATE TABLE `geni_slivers` ( ...@@ -118,7 +118,27 @@ CREATE TABLE `geni_slivers` (
`uuid` varchar(40) NOT NULL default '', `uuid` varchar(40) NOT NULL default '',
`slice_uuid` varchar(40) NOT NULL default '', `slice_uuid` varchar(40) NOT NULL default '',
`creator_uuid` varchar(40) NOT NULL default '', `creator_uuid` varchar(40) NOT NULL default '',
`node_id` varchar(32) default NULL, `resource_uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`credential_idx` int(10) unsigned default NULL,
`ticket_idx` int(10) unsigned default NULL,
`component_idx` int(10) unsigned NOT NULL default '0',
`aggregate_idx` int(10) unsigned default NULL,
`status` enum('ready','broken') NOT NULL default 'ready',
PRIMARY KEY (`idx`),
UNIQUE KEY `uuid` (`uuid`),
INDEX `slice_uuid` (`slice_uuid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
#
# Geni Aggregates, which are a collection of resources (nodes, links, etc).
#
DROP TABLE IF EXISTS `geni_aggregates`;
CREATE TABLE `geni_aggregates` (
`idx` mediumint(8) unsigned NOT NULL default '0',
`uuid` varchar(40) NOT NULL default '',
`slice_uuid` varchar(40) NOT NULL default '',
`creator_uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL, `created` datetime default NULL,
`credential_idx` int(10) unsigned default NULL, `credential_idx` int(10) unsigned default NULL,
`ticket_idx` int(10) unsigned default NULL, `ticket_idx` int(10) unsigned default NULL,
...@@ -177,3 +197,13 @@ CREATE TABLE `geni_certificates` ( ...@@ -177,3 +197,13 @@ CREATE TABLE `geni_certificates` (
PRIMARY KEY (`uuid`) PRIMARY KEY (`uuid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1; ) ENGINE=MyISAM DEFAULT CHARSET=latin1;
#
# A clearinghouse table to hold sshkeys associated with geni users.
#
DROP TABLE IF EXISTS `geni_sshkeys`;
CREATE TABLE `geni_sshkeys` (
`uuid` varchar(40) NOT NULL default '',
`created` datetime default NULL,
`sshkey` text,
PRIMARY KEY (`uuid`)
) ENGINE=MyISAM DEFAULT CHARSET=latin1;
...@@ -22,6 +22,7 @@ use GeniDB; ...@@ -22,6 +22,7 @@ use GeniDB;
use GeniCredential; use GeniCredential;
use GeniCertificate; use GeniCertificate;
use GeniSliver; use GeniSliver;
use GeniSlice;
use libdb qw(TBGetUniqueIndex); use libdb qw(TBGetUniqueIndex);
use English; use English;
use overload ('""' => 'Stringify'); use overload ('""' => 'Stringify');
...@@ -77,6 +78,7 @@ sub Lookup($$) ...@@ -77,6 +78,7 @@ sub Lookup($$)
my $self = {}; my $self = {};
$self->{'AGGREGATE'} = $query_result->fetchrow_hashref(); $self->{'AGGREGATE'} = $query_result->fetchrow_hashref();
$self->{'CREDENTIAL'} = undef; $self->{'CREDENTIAL'} = undef;
$self->{'SLICE'} = undef;
bless($self, $class); bless($self, $class);
# #
...@@ -214,6 +216,31 @@ sub GetCredential($) ...@@ -214,6 +216,31 @@ sub GetCredential($)
return $credential; return $credential;
} }
#
# Get the slice for the aggregate.
#
sub GetSlice($)
{
my ($self) = @_;
return undef
if (! ref($self));
return $self->{'SLICE'} if (defined($self->{'SLICE'}));
if (!defined($self->slice_uuid())) {
print STDERR "No slice associated with $self\n";
return undef;
}
my $slice = GeniSlice->Lookup($self->slice_uuid());
if (!defined($slice)) {
print STDERR "Could not get slice object associated with $self\n";
return undef;
}
$self->{'SLICE'} = $slice;
return $slice;
}
# #
# Create a signed credential for this aggregate, issued to the provided user. # Create a signed credential for this aggregate, issued to the provided user.
# The credential will grant all permissions for now. # The credential will grant all permissions for now.
......
...@@ -111,17 +111,18 @@ sub Stringify($) ...@@ -111,17 +111,18 @@ sub Stringify($)
# #
# Create a Geni authority in the DB. # Create a Geni authority in the DB.
# #
sub Create($$$$$) sub Create($$$$$$)
{ {
my ($class, $uuid, $hrn, $url, $cert) = @_; my ($class, $uuid, $hrn, $url, $cert, $prefix) = @_;
my @insert_data = (); my @insert_data = ();
my $idx = TBGetUniqueIndex('next_authority', 1); my $idx = TBGetUniqueIndex('next_authority', 1);
my $safe_hrn = DBQuoteSpecial($hrn); my $safe_hrn = DBQuoteSpecial($hrn);
my $safe_url = DBQuoteSpecial($url); my $safe_url = DBQuoteSpecial($url);
my $safe_uuid = DBQuoteSpecial($uuid); my $safe_uuid = DBQuoteSpecial($uuid);
my $safe_cert = DBQuoteSpecial($cert); my $safe_cert = DBQuoteSpecial($cert);
my $safe_prefix = DBQuoteSpecial($prefix);
# Now tack on other stuff we need. # Now tack on other stuff we need.
push(@insert_data, "created=now()"); push(@insert_data, "created=now()");
...@@ -129,6 +130,7 @@ sub Create($$$$$) ...@@ -129,6 +130,7 @@ sub Create($$$$$)
push(@insert_data, "hrn=$safe_hrn"); push(@insert_data, "hrn=$safe_hrn");
push(@insert_data, "url=$safe_url"); push(@insert_data, "url=$safe_url");
push(@insert_data, "uuid=$safe_uuid"); push(@insert_data, "uuid=$safe_uuid");
push(@insert_data, "uuid_prefix=$safe_prefix");
# Insert into DB. # Insert into DB.
DBQueryWarn("replace into geni_sliceauthorities set " . DBQueryWarn("replace into geni_sliceauthorities set " .
......
...@@ -81,6 +81,7 @@ sub LookupUser($) ...@@ -81,6 +81,7 @@ sub LookupUser($)
"sa" => { "hrn" => $authority->hrn(), "sa" => { "hrn" => $authority->hrn(),
"uuid" => $authority->uuid(), "uuid" => $authority->uuid(),
"cert" => $authority->cert(), "cert" => $authority->cert(),
"uuid_prefix" => $authority->uuid_prefix(),
"url" => $authority->url() } "url" => $authority->url() }
}; };
$blob->{'sshkey'} = $sshkey $blob->{'sshkey'} = $sshkey
...@@ -114,10 +115,11 @@ sub LookupSlice($) ...@@ -114,10 +115,11 @@ sub LookupSlice($)
"uuid" => $slice->uuid(), "uuid" => $slice->uuid(),
"creator_uuid" => $slice->creator_uuid(), "creator_uuid" => $slice->creator_uuid(),
"cert" => $slice->cert(), "cert" => $slice->cert(),
"sa" => { "hrn" => $authority->hrn(), "sa" => {"hrn" => $authority->hrn(),
"uuid" => $authority->uuid(), "uuid" => $authority->uuid(),
"cert" => $authority->cert(), "cert" => $authority->cert(),
"url" => $authority->url() } "uuid_prefix" => $authority->uuid_prefix(),
"url" => $authority->url() }
}; };
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
......
...@@ -49,6 +49,8 @@ my $OURDOMAIN = "@OURDOMAIN@"; ...@@ -49,6 +49,8 @@ my $OURDOMAIN = "@OURDOMAIN@";
my $CREATEEXPT = "$TB/bin/batchexp"; my $CREATEEXPT = "$TB/bin/batchexp";
my $NALLOC = "$TB/bin/nalloc"; my $NALLOC = "$TB/bin/nalloc";
my $AVAIL = "$TB/sbin/avail"; my $AVAIL = "$TB/sbin/avail";
my $TBSWAP = "$TB/bin/tbswap";
my $SWAPEXP = "$TB/bin/swapexp";
# #
# Discover resources on this component, returning a resource availablity spec # Discover resources on this component, returning a resource availablity spec
...@@ -199,7 +201,7 @@ sub GetTicket($) ...@@ -199,7 +201,7 @@ sub GetTicket($)
# Note the -h option; allows experiment with no NS file. # Note the -h option; allows experiment with no NS file.
system("$CREATEEXPT -q -i -w -E 'Geni Slice Experiment' ". system("$CREATEEXPT -q -i -w -E 'Geni Slice Experiment' ".
"-h '$slice_uuid' -p genislices -e $eid"); "-h '$slice_uuid' -p GeniSlices -e $eid");
if ($?) { if ($?) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Internal Error"); "Internal Error");
...@@ -295,6 +297,8 @@ sub CreateSliver($) ...@@ -295,6 +297,8 @@ sub CreateSliver($)
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No local experiment for slice"); "No local experiment for slice");
} }
my $pid = $experiment->pid();
my $eid = $experiment->eid();
# #
# See if we have a record of this slice in the DB. If not, throw an # See if we have a record of this slice in the DB. If not, throw an
...@@ -323,7 +327,7 @@ sub CreateSliver($) ...@@ -323,7 +327,7 @@ sub CreateSliver($)
"Error binding user to slice"); "Error binding user to slice");
# #
# We are actually an Aggregate, so return an aggregate of sliver, # We are actually an Aggregate, so return an aggregate of slivers,
# even if there is just one node (simpler). # even if there is just one node (simpler).
# #
my $aggregate = GeniAggregate->Create($ticket); my $aggregate = GeniAggregate->Create($ticket);
...@@ -365,6 +369,22 @@ sub CreateSliver($) ...@@ -365,6 +369,22 @@ sub CreateSliver($)
} }
} }
#
# Run swapexp in update mode. The nodes are already allocated, but need
# to be configured like a real experiment.
#
# XXX What if we have multiple slivers for this slice? We are going
# to need some locking or management at the slice level so that we run
# tbswap only once, or at least no more then one at a time.
#
if (!$impotent) {
system("$SWAPEXP -s modify -r -g $pid $eid");
if ($?) {
$message = "Failed to tbswap $pid,$eid";
goto bad;
}
}
# #
# The API states we return a credential to control the sliver/aggregate. # The API states we return a credential to control the sliver/aggregate.
# #
...@@ -492,3 +512,214 @@ sub DestroySliver($) ...@@ -492,3 +512,214 @@ sub DestroySliver($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS); return GeniResponse->Create(GENIRESPONSE_SUCCESS);
} }
#
# Bind a user to a slice.
#
sub BindUser($)
{
my ($argref) = @_;
my $sliver = $argref->{'sliver'};
my $hrn = $argref->{'userinfo'}->{'hrn'};
my $uuid = $argref->{'userinfo'}->{'uuid'};
my $name = $argref->{'userinfo'}->{'name'};
my $email = $argref->{'userinfo'}->{'email'};
my $cert = $argref->{'userinfo'}->{'cert'};
my $sshkey = $argref->{'userinfo'}->{'sshkey'};
my $sliver_uuid;
if (! (defined($hrn) && defined($name) && defined($sliver) &&
defined($email) && defined($cert) && defined($uuid))) {
return GeniResponse->MalformedArgsResponse();
}
GeniCertificate->CertificateInfo($sliver, \$sliver_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
#
# See if we have a record of this sliver 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.
#
$sliver = GeniSliver->Lookup($sliver_uuid);
if (!defined($sliver)) {
# Might be an aggregate instead.
$sliver = GeniAggregate->Lookup($sliver_uuid);
if (!defined($sliver)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No such sliver $sliver_uuid");
}
}
my $slice = $sliver->GetSlice();
#
# Use the Emulab checkslot routines.
#
if (! ($hrn =~ /^[-\w\.]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"hrn: Invalid characters");
}
if (! ($uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! TBcheck_dbslot($name, "users", "usr_name", TBDB_CHECKDBSLOT_ERROR)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"name: ". TBFieldErrorString());
}
if (! TBcheck_dbslot($email, "users", "usr_email",TBDB_CHECKDBSLOT_ERROR)){
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"email: ". TBFieldErrorString());
}
if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"cert: Invalid characters");
}
if (defined($sshkey) && ! ($sshkey =~ /^[\012\015\040-\176]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"sshkey: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $authority = GeniAuthority->Lookup($sa_uuid);
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority record for $sa_uuid");
}
if (! $authority->PrefixMatch($uuid)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"uuid: Prefix mismatch");
}
#
# Verify that this is the SA for the slice.
#
if (! $slice->IsSliceAuthority($authority)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Must be the SA for the slice");
}
# Might already exist. Not an error, Just check binding and return.
my $user = GeniUser->Lookup($uuid);
if (defined($user)) {
$user->BindToSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$hrn/$email has been bound to slice");
}
#
# XXX
#
# What kind of uniquess requirements do we need? No one else with this
# email address? Of course, we have to allow hrn reuse, but should we
# require that for a given SA, that hrn is unique, at least to avoid
# lots of confusion?
#
if (GeniUser->CheckExisting($hrn, $email)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$hrn/$email already registered");
}
# The local uid we will use is the last part of the hrn.
my ($uid) = ($hrn =~ /^.*\.(\w*)$/);
if (!defined($uid)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uid: cannot parse hrn to get uid");
}
elsif (! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uid: ". TBFieldErrorString());
}
my $newuser = GeniUser->Create($hrn, $uid, $uuid,
$name, $email, $cert,
$authority->idx(), $sshkey);
if (!defined($newuser)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$hrn/$email could not be registered");
}
$newuser->BindToSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to sliver");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$hrn/$email has been bound to $sliver_uuid");
}
#
# Unbind user from sliver.
#
sub UnBindUser($)
{
my ($argref) = @_;
my $sliver = $argref->{'sliver'};
my $user = $argref->{'user'};
my $sliver_uuid;
my $user_uuid;
if (! (defined($sliver) && defined($user))) {
return GeniResponse->MalformedArgsResponse();
}
GeniCertificate->CertificateInfo($sliver, \$sliver_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
GeniCertificate->CertificateInfo($user, \$user_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
#
# See if we have a record of this sliver 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.
#
$sliver = GeniSliver->Lookup($sliver_uuid);
if (!defined($sliver)) {
# Might be an aggregate instead.
$sliver = GeniAggregate->Lookup($sliver_uuid);
if (!defined($sliver)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No such sliver $sliver_uuid");
}
}
# Does not exist? Not an error.
$user = GeniUser->Lookup($user_uuid);
if (! defined($user)) {
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid is not bound to $sliver_uuid");
}
my $slice = $sliver->GetSlice();
#
# The SA UUID comes from the SSL environment (certificate).
#
my $sa_uuid = $ENV{'GENIUUID'};
my $authority = GeniAuthority->Lookup($sa_uuid);
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority record for $sa_uuid");
}
#
# Verify that this is the SA for the slice.
#
if (! $slice->IsSliceAuthority($authority)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Must be the SA for the slice");
}
$user->UnBindFromSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error unbinding user from sliver");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been unbound from sliver");
}
...@@ -248,6 +248,64 @@ sub DiscoverResources($$$$$) ...@@ -248,6 +248,64 @@ sub DiscoverResources($$$$$)
return 0; return 0;
} }
#
# Bind and UnBind users to/from slivers.
#
# We do this with the local SA as the credential, not the sliver credential.
#
sub BindUser($$$$)
{
my ($self, $sliver, $target_user) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($sliver) && ref($target_user)));
my $sshkey;
$target_user->GetSSHKey(\$sshkey);
my $userinfo = { "hrn" => $target_user->hrn(),
"uuid" => $target_user->uuid(),
"name" => $target_user->name(),
"email" => $target_user->email(),
"cert" => $target_user->cert(),
"sshkey" => $sshkey
};
my $response =
Genixmlrpc::CallMethodHTTP($self->url(), undef,
"CM::BindUser",
{ "sliver" => $sliver->cert(),
"userinfo" => $userinfo });
if ($response->code() != GENIRESPONSE_SUCCESS) {
print STDERR "Could not bind $target_user to sliver $sliver\n";
return -1;
}
return 0;
}
sub UnBindUser($$$$)
{
my ($self, $sliver, $target_user) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($sliver) && ref($target_user)));
my $response =
Genixmlrpc::CallMethodHTTP($self->url(), undef,
"CM::UnBindUser",
{ "sliver" => $sliver->cert(),
"user" => $target_user->cert() });
if ($response->code() != GENIRESPONSE_SUCCESS) {
print STDERR "Could not unbind $target_user to sliver $sliver\n";
return -1;
}
return 0;
}
# #
# Get a Ticket from a component; # Get a Ticket from a component;
# #
......
...@@ -24,9 +24,11 @@ use lib '@prefix@/lib'; ...@@ -24,9 +24,11 @@ use lib '@prefix@/lib';
use GeniDB; use GeniDB;
use Genixmlrpc; use Genixmlrpc;
use GeniResponse; use GeniResponse;
use User;
use GeniUser; use GeniUser;
use libtestbed; use GeniSlice;
use GeniCredential;
use GeniCertificate;
use emutil;
use English; use English;
use Data::Dumper; use Data::Dumper;
......
...@@ -249,7 +249,8 @@ sub CreateFromRegistry($$) ...@@ -249,7 +249,8 @@ sub CreateFromRegistry($$)
$authority = GeniAuthority->Create($blob->{'sa'}->{'uuid'}, $authority = GeniAuthority->Create($blob->{'sa'}->{'uuid'},
$blob->{'sa'}->{'hrn'}, $blob->{'sa'}->{'hrn'},
$blob->{'sa'}->{'url'}, $blob->{'sa'}->{'url'},
$blob->{'sa'}->{'cert'}); $blob->{'sa'}->{'cert'},
$blob->{'sa'}->{'uuid_prefix'});
if (!defined($authority)) { if (!defined($authority)) {
print STDERR "Could not create new authority record\n"; print STDERR "Could not create new authority record\n";
return undef; return undef;
...@@ -291,6 +292,10 @@ sub Delete($) ...@@ -291,6 +292,10 @@ sub Delete($)
my $idx = $self->idx(); my $idx = $self->idx();
my $uuid = $self->uuid(); my $uuid = $self->uuid();
my $experiment = $self->GetExperiment();
return -1