Checkpoint

protogeni/lib/GNUmakefile.in

@@ -14,8 +14,9 @@ include $(OBJDIR)/Makeconf
 LIB_SCRIPTS     = GeniDB.pm GeniUser.pm GeniSAClient.pm \
 		  GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
 		  test.pl GeniTicket.pm GeniSliver.pm GeniCredential.pm \
-		  GeniComponent.pm GeniCH.pm GeniCHClient.pm \
-		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
+		  GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
+		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
+		  node.pl
 
 #
 # Force dependencies on the scripts so that they will be rerun through

protogeni/lib/GeniCH.pm.in

@@ -110,6 +110,13 @@ sub LookupSlice($)
 				    "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.
     my $blob = { "hrn"          => $slice->hrn(),
 		 "uuid"         => $slice->uuid(),
@@ -119,7 +126,8 @@ sub LookupSlice($)
 				    "uuid"     => $authority->uuid(),
 				    "cert"     => $authority->cert(),
 				    "uuid_prefix" => $authority->uuid_prefix(),
-				    "url"      => $authority->url() }
+				    "url"      => $authority->url() },
+		 "userbindings" => \@userbindings,
 	       };
 
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
@@ -342,3 +350,126 @@ sub DiscoverResources($)
     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");
+}
+

protogeni/lib/GeniCHClient.pm.in

@@ -35,7 +35,7 @@ my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
 my $TBAUDIT   	   = "@TBAUDITEMAIL@";
 my $BOSSNODE       = "@BOSSNODE@";
 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";
 
 #
@@ -194,3 +194,39 @@ sub DiscoverResources($$)
     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;
+}
+

protogeni/lib/GeniCM.pm.in

@@ -186,6 +186,11 @@ sub GetTicket($)
 			    "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.
@@ -345,6 +350,20 @@ sub CreateSliver($)
 	or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				       "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,
     # unless there is just one node.
@@ -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.
     #
@@ -602,213 +606,3 @@ sub DestroySliver($)
     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");
-}
-

protogeni/lib/GeniCMClient.pm.in

@@ -38,8 +38,6 @@ my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
 my $TBAUDIT   	   = "@TBAUDITEMAIL@";
 my $BOSSNODE       = "@BOSSNODE@";
 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...
 1;

protogeni/lib/GeniComponent.pm.in

@@ -159,6 +159,52 @@ sub url($)		{ return field($_[0], "url"); }
 sub hrn($)		{ return field($_[0], "hrn"); }
 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.
 #
@@ -248,64 +294,6 @@ sub DiscoverResources($$$$$)
     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;
 #