Commit 23a12aa5 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint

parent 8f598e53
...@@ -14,8 +14,9 @@ include $(OBJDIR)/Makeconf ...@@ -14,8 +14,9 @@ include $(OBJDIR)/Makeconf
LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \ LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \ GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
test.pl GeniTicket.pm GeniSliver.pm GeniCredential.pm \ test.pl GeniTicket.pm GeniSliver.pm GeniCredential.pm \
GeniComponent.pm GeniCH.pm GeniCHClient.pm \ GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
node.pl
# #
# Force dependencies on the scripts so that they will be rerun through # Force dependencies on the scripts so that they will be rerun through
......
...@@ -110,6 +110,13 @@ sub LookupSlice($) ...@@ -110,6 +110,13 @@ sub LookupSlice($)
"No slice authority found for slice"); "No slice authority found for slice");
} }
# User bindings too.
my @userbindings = ();
if ($slice->UserBindings(\@userbindings) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error getting user bindings for slice");
}
# Return a blob. # Return a blob.
my $blob = { "hrn" => $slice->hrn(), my $blob = { "hrn" => $slice->hrn(),
"uuid" => $slice->uuid(), "uuid" => $slice->uuid(),
...@@ -119,7 +126,8 @@ sub LookupSlice($) ...@@ -119,7 +126,8 @@ sub LookupSlice($)
"uuid" => $authority->uuid(), "uuid" => $authority->uuid(),
"cert" => $authority->cert(), "cert" => $authority->cert(),
"uuid_prefix" => $authority->uuid_prefix(), "uuid_prefix" => $authority->uuid_prefix(),
"url" => $authority->url() } "url" => $authority->url() },
"userbindings" => \@userbindings,
}; };
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
...@@ -342,3 +350,126 @@ sub DiscoverResources($) ...@@ -342,3 +350,126 @@ sub DiscoverResources($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results); return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
} }
#
# Bind user to slice
#
sub BindUser($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'slice_uuid'};
my $user_uuid = $argref->{'user_uuid'};
if (! (defined($slice_uuid) && defined($user_uuid))) {
return GeniResponse->MalformedArgsResponse();
}
#
# Use the Emulab checkslot routines.
#
if (! ($slice_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! ($user_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
# Need to verify the UUID is permitted for the SA making the request.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $query_result =
DBQueryWarn("select idx, uuid_prefix from geni_sliceauthorities ".
"where uuid='$sa_uuid'");
return GeniResponse->Create(GENIRESPONSE_DBERROR)
if (!defined($query_result));
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, "Who are You?")
if (!$query_result->numrows);
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such slice $slice_uuid");
}
my $user = GeniUser->Lookup($user_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such user $user_uuid");
}
DBQueryWarn("replace into geni_bindings set ".
" slice_uuid='$slice_uuid', user_uuid='$user_uuid', ".
" created=now()")
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been bound to slice");
}
#
# UnBind user from slice
#
sub UnBindUser($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'slice_uuid'};
my $user_uuid = $argref->{'user_uuid'};
if (! (defined($slice_uuid) && defined($user_uuid))) {
return GeniResponse->MalformedArgsResponse();
}
#
# Use the Emulab checkslot routines.
#
if (! ($slice_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! ($user_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
# Need to verify the UUID is permitted for the SA making the request.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $query_result =
DBQueryWarn("select idx, uuid_prefix from geni_sliceauthorities ".
"where uuid='$sa_uuid'");
return GeniResponse->Create(GENIRESPONSE_DBERROR)
if (!defined($query_result));
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, "Who are You?")
if (!$query_result->numrows);
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such slice $slice_uuid");
}
my $user = GeniUser->Lookup($user_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such user $user_uuid");
}
DBQueryWarn("delete from geni_bindings ".
"where slice_uuid='$slice_uuid' and user_uuid='$user_uuid'")
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error unbinding user from slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been unbound from slice");
}
...@@ -35,7 +35,7 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@"; ...@@ -35,7 +35,7 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@"; my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@"; my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@"; my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.little-emulab-bsd61.testbed.emulab.net"; my $GENICENTRAL = "myboss.myelab.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch"; my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch";
# #
...@@ -194,3 +194,39 @@ sub DiscoverResources($$) ...@@ -194,3 +194,39 @@ sub DiscoverResources($$)
return 0; return 0;
} }
#
# Bind and unbind users to/from slices
#
sub BindUser($$)
{
my ($slice_uuid, $user_uuid) = @_;
my $args = { "slice_uuid" => $slice_uuid,
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::BindUser", $args);
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
}
sub UnBindUser($$)
{
my ($slice_uuid, $user_uuid) = @_;
my $args = { "slice_uuid" => $slice_uuid,
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::UnBindUser", $args);
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
}
...@@ -186,6 +186,11 @@ sub GetTicket($) ...@@ -186,6 +186,11 @@ sub GetTicket($)
"Could not get slice info from ClearingHouse"); "Could not get slice info from ClearingHouse");
} }
} }
else {
$slice->UpdateFromRegistry() == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not update slice info from ClearingHouse");
}
# #
# Ditto the user. # Ditto the user.
...@@ -345,6 +350,20 @@ sub CreateSliver($) ...@@ -345,6 +350,20 @@ sub CreateSliver($)
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef, or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice"); "Error binding user to slice");
# Bind the other users too.
my @userbindings;
if ($slice->UserBindings(\@userbindings) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding users to slice");
}
foreach my $otheruuid (@userbindings) {
my $otheruser = GeniUser->Lookup($otheruuid);
if (!$otheruser->BindToSlice($slice) != 0) {
print STDERR "Could not bind $otheruser to $slice\n";
}
}
# #
# We are actually an Aggregate, so return an aggregate of slivers, # We are actually an Aggregate, so return an aggregate of slivers,
# unless there is just one node. # unless there is just one node.
...@@ -453,21 +472,6 @@ sub CreateSliver($) ...@@ -453,21 +472,6 @@ sub CreateSliver($)
} }
} }
#
# This stuff needs to be moved elsewhere.
#
# 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 (0 && !$impotent) {
system("$SWAPEXP -s modify -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.
# #
...@@ -602,213 +606,3 @@ sub DestroySliver($) ...@@ -602,213 +606,3 @@ 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");
}
...@@ -38,8 +38,6 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@"; ...@@ -38,8 +38,6 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@"; my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@"; my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@"; my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.little-emulab-bsd61.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc";
# _Always_ make sure that this 1 is at the end of the file... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
......
...@@ -159,6 +159,52 @@ sub url($) { return field($_[0], "url"); } ...@@ -159,6 +159,52 @@ sub url($) { return field($_[0], "url"); }
sub hrn($) { return field($_[0], "hrn"); } sub hrn($) { return field($_[0], "hrn"); }
sub cert($) { return field($_[0], "cert"); } sub cert($) { return field($_[0], "cert"); }
#
# Class method to lookup the component for a given resource (uuid) by
# looking in the resources table.
#
sub LookupByResource($$)
{
my ($class, $uuid) = @_;
return undef
if (! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/));
my $query_result =
DBQueryWarn("select component_idx from geni_resources ".
"where resource_uuid='$uuid'");
return undef
if (! $query_result || !$query_result->numrows);
my ($idx) = $query_result->fetchrow_array();
return GeniComponent->Lookup($idx);
}
#
# Method to insert a new geni_resources record for the component.
#
sub NewResource($$)
{
my ($self, $uuid) = @_;
return -1
if (! ref($self));
my $idx = TBGetUniqueIndex('next_resource', 1);
my $component_idx = $self->idx();
$uuid = DBQuoteSpecial("$uuid");
return -1
if (! DBQueryWarn("replace into geni_resources set ".
" idx=$idx, resource_uuid=$uuid, ".
" resource_type='node', ".
" created=now(), component_idx=$component_idx"));
return 0;
}
# #
# Refresh a class instance by reloading from the DB. # Refresh a class instance by reloading from the DB.
# #
...@@ -248,64 +294,6 @@ sub DiscoverResources($$$$$) ...@@ -248,64 +294,6 @@ 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);