Checkpoint

protogeni/etc/protogeni.sql

@@ -118,7 +118,27 @@ CREATE TABLE `geni_slivers` (
   `uuid` varchar(40) NOT NULL default '',
   `slice_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,
   `credential_idx` int(10) unsigned default NULL,
   `ticket_idx` int(10) unsigned default NULL,
@@ -177,3 +197,13 @@ CREATE TABLE `geni_certificates` (
   PRIMARY KEY  (`uuid`)
 ) 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;

protogeni/lib/GeniAggregate.pm.in

@@ -22,6 +22,7 @@ use GeniDB;
 use GeniCredential;
 use GeniCertificate;
 use GeniSliver;
+use GeniSlice;
 use libdb qw(TBGetUniqueIndex);
 use English;
 use overload ('""' => 'Stringify');
@@ -77,6 +78,7 @@ sub Lookup($$)
     my $self              = {};
     $self->{'AGGREGATE'}  = $query_result->fetchrow_hashref();
     $self->{'CREDENTIAL'} = undef;
+    $self->{'SLICE'}      = undef;
     bless($self, $class);
 
     #
@@ -214,6 +216,31 @@ sub GetCredential($)
     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.
 # The credential will grant all permissions for now.

protogeni/lib/GeniAuthority.pm.in

@@ -111,17 +111,18 @@ sub Stringify($)
 #
 # 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 $idx = TBGetUniqueIndex('next_authority', 1);
 
-    my $safe_hrn  = DBQuoteSpecial($hrn);
-    my $safe_url  = DBQuoteSpecial($url);
-    my $safe_uuid = DBQuoteSpecial($uuid);
-    my $safe_cert = DBQuoteSpecial($cert);
+    my $safe_hrn    = DBQuoteSpecial($hrn);
+    my $safe_url    = DBQuoteSpecial($url);
+    my $safe_uuid   = DBQuoteSpecial($uuid);
+    my $safe_cert   = DBQuoteSpecial($cert);
+    my $safe_prefix = DBQuoteSpecial($prefix);
     
     # Now tack on other stuff we need.
     push(@insert_data, "created=now()");
@@ -129,6 +130,7 @@ sub Create($$$$$)
     push(@insert_data, "hrn=$safe_hrn");
     push(@insert_data, "url=$safe_url");
     push(@insert_data, "uuid=$safe_uuid");
+    push(@insert_data, "uuid_prefix=$safe_prefix");
 
     # Insert into DB.
     DBQueryWarn("replace into geni_sliceauthorities set " .

protogeni/lib/GeniCH.pm.in

@@ -81,6 +81,7 @@ sub LookupUser($)
 		 "sa"       => { "hrn"      => $authority->hrn(),
 				 "uuid"     => $authority->uuid(),
 				 "cert"     => $authority->cert(),
+				 "uuid_prefix" => $authority->uuid_prefix(),
 				 "url"      => $authority->url() }
 	       };
     $blob->{'sshkey'} = $sshkey
@@ -114,10 +115,11 @@ sub LookupSlice($)
 		 "uuid"         => $slice->uuid(),
 		 "creator_uuid" => $slice->creator_uuid(),
 		 "cert"         => $slice->cert(),
-		 "sa"           => { "hrn"      => $authority->hrn(),
-				     "uuid"     => $authority->uuid(),
-				     "cert"     => $authority->cert(),
-				     "url"      => $authority->url() }
+		 "sa"           => {"hrn"      => $authority->hrn(),
+				    "uuid"     => $authority->uuid(),
+				    "cert"     => $authority->cert(),
+				    "uuid_prefix" => $authority->uuid_prefix(),
+				    "url"      => $authority->url() }
 	       };
 
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);

protogeni/lib/GeniCM.pm.in

@@ -49,6 +49,8 @@ my $OURDOMAIN      = "@OURDOMAIN@";
 my $CREATEEXPT     = "$TB/bin/batchexp";
 my $NALLOC	   = "$TB/bin/nalloc";
 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
@@ -199,7 +201,7 @@ sub GetTicket($)
 
 	# Note the -h option; allows experiment with no NS file.
 	system("$CREATEEXPT -q -i -w -E 'Geni Slice Experiment' ".
-	       "-h '$slice_uuid' -p genislices -e $eid");
+	       "-h '$slice_uuid' -p GeniSlices -e $eid");
 	if ($?) {
 	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 					"Internal Error");
@@ -295,6 +297,8 @@ sub CreateSliver($)
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "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
@@ -323,7 +327,7 @@ sub CreateSliver($)
 				       "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).
     #
     my $aggregate = GeniAggregate->Create($ticket);
@@ -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.
     #
@@ -492,3 +512,214 @@ 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/GeniComponent.pm.in

@@ -248,6 +248,64 @@ 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;
 #

protogeni/lib/GeniSA.pm.in

@@ -24,9 +24,11 @@ use lib '@prefix@/lib';
 use GeniDB;
 use Genixmlrpc;
 use GeniResponse;
-use User;
 use GeniUser;
-use libtestbed;
+use GeniSlice;
+use GeniCredential;
+use GeniCertificate;
+use emutil;
 use English;
 use Data::Dumper;
 

protogeni/lib/GeniSlice.pm.in

@@ -249,7 +249,8 @@ sub CreateFromRegistry($$)
 	$authority = GeniAuthority->Create($blob->{'sa'}->{'uuid'},
 					   $blob->{'sa'}->{'hrn'},
 					   $blob->{'sa'}->{'url'},
-					   $blob->{'sa'}->{'cert'});
+					   $blob->{'sa'}->{'cert'},
+					   $blob->{'sa'}->{'uuid_prefix'});
 	if (!defined($authority)) {
 	    print STDERR "Could not create new authority record\n";
 	    return undef;
@@ -291,6 +292,10 @@ sub Delete($)
 
     my $idx  = $self->idx();
     my $uuid = $self->uuid();
+    my $experiment = $self->GetExperiment();
+    return -1
+	if (!defined($experiment));
+    $experiment->UnBindNonLocalUsers();
 
     DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
 	or return -1;
@@ -301,34 +306,32 @@ sub Delete($)
 }
 
 #
-# Bind user to slice.
+# Return the emulab experiment for this slice.
 #
-sub BindUserToSlice($$)
+sub GetExperiment($)
 {
-    my ($self, $user) = @_;
+    my ($self) = @_;
 
-    return -1
-	if (! (ref($self) && ref($user)));
+    return undef
+	if (!ref($self));
 
-    my $experiment = Experiment->Lookup($self->uuid());
-    if (!defined($experiment)) {
-	print STDERR "Could not locate experiment object for $self\n";
-	return -1;
-    }
-    return $user
+    return Experiment->Lookup($self->uuid());
 }
 
 #
-# Return the emulab experiment for this slice.
+# Check if the given SA is the actual SA for the slice.
 #
-sub GetExperiment($)
+sub IsSliceAuthority($$)
 {
-    my ($self) = @_;
+    my ($self, $authority) = @_;
 
-    return undef
-	if (!ref($self));
+    return 0
+	if (! (ref($self) && ref($authority)));
 
-    return Experiment->Lookup($self->uuid());
+    return 1
+	if ($self->sa_idx() == $authority->idx());
+    
+    return 0;
 }
 
 # _Always_ make sure that this 1 is at the end of the file...

protogeni/lib/GeniSliver.pm.in

@@ -18,11 +18,12 @@ use vars qw(@ISA @EXPORT);
 use lib '@prefix@/lib';
 use GeniDB;
 use GeniComponent;
+use GeniSlice;
 use GeniCredential;
 use GeniCertificate;
 use GeniAggregate;
 # Hate to import all this crap; need a utility library.
-use libdb qw(TBGetUniqueIndex);
+use libdb qw(TBGetUniqueIndex TBDB_ALLOCSTATE_RES_INIT_DIRTY);
 use libtestbed;
 use Experiment;
 use Node;
@@ -85,6 +86,7 @@ sub Lookup($$)
     my $self              = {};
     $self->{'SLIVER'}     = $query_result->fetchrow_hashref();
     $self->{'COMPONENT'}  = undef;	# Client side.
+    $self->{'SLICE'}      = undef;	# Client side.
     $self->{'CREDENTIAL'} = undef;	# Client side.
     $self->{'AGGREGATE'}  = undef;	# server side.
 
@@ -189,6 +191,7 @@ sub Create($$$;$$)
     $sliver->{'COMPONENT'} = $component
 	if (defined($component));
     $sliver->{'AGGREGATE'} = undef;
+    $sliver->{'SLICE'}     = undef;
 
     return $sliver;
 }
@@ -340,6 +343,31 @@ sub GetComponent($)
     return $component;
 }