Checkpoint

protogeni/lib/GNUmakefile.in

@@ -15,7 +15,7 @@ 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
+		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
 
 #
 # Force dependencies on the scripts so that they will be rerun through

protogeni/lib/GeniAggregate.pm.in

+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2008 University of Utah and the Flux Group.
+# All rights reserved.
+#
+package GeniAggregate;
+
+#
+# Some simple ticket stuff.
+#
+use strict;
+use Exporter;
+use vars qw(@ISA @EXPORT);
+
+@ISA    = "Exporter";
+@EXPORT = qw ( );
+
+# Must come after package declaration!
+use lib '@prefix@/lib';
+use GeniDB;
+use GeniCredential;
+use GeniCertificate;
+use GeniSliver;
+use libdb qw(TBGetUniqueIndex);
+use English;
+use overload ('""' => 'Stringify');
+use XML::Simple;
+
+# Configure variables
+my $TB		   = "@prefix@";
+my $TBOPS          = "@TBOPSEMAIL@";
+my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
+my $TBAUDIT   	   = "@TBAUDITEMAIL@";
+my $BOSSNODE       = "@BOSSNODE@";
+my $OURDOMAIN      = "@OURDOMAIN@";
+my $SIGNCRED	   = "$TB/sbin/signgenicred";
+my $VERIFYCRED	   = "$TB/sbin/verifygenicred";
+
+# Cache of instances to avoid regenerating them.
+my %aggregates     = ();
+
+#
+# Lookup by idx, or uuid.
+#
+sub Lookup($$)
+{
+    my ($class, $token) = @_;
+    my $query_result;
+    my $idx;
+
+    if ($token =~ /^\d+$/) {
+	$idx = $token;
+    }
+    elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
+	$query_result =
+	    DBQueryWarn("select idx from geni_aggregates ".
+			"where uuid='$token'");
+	    return undef
+		if (! $query_result || !$query_result->numrows);
+
+	    ($idx) = $query_result->fetchrow_array();
+    }
+    else {
+	return undef;
+    }
+    # Look in cache first
+    return $aggregates{"$idx"}
+        if (exists($aggregates{"$idx"}));
+
+    $query_result =
+	DBQueryWarn("select * from geni_aggregates where idx='$idx'");
+    
+    return undef
+	if (!$query_result || !$query_result->numrows);
+
+    my $self              = {};
+    $self->{'AGGREGATE'}  = $query_result->fetchrow_hashref();
+    $self->{'CREDENTIAL'} = undef;
+    bless($self, $class);
+
+    #
+    # Grab the certificate, since we will probably want it.
+    #
+    my $uuid = $self->{'AGGREGATE'}->{'uuid'};
+    my $certificate = GeniCertificate->Lookup($uuid);
+    if (!defined($certificate)) {
+	print STDERR "Could not find certificate for aggregate $idx ($uuid)\n";
+	return undef;
+    }
+    $self->{'CERTIFICATE'} = $certificate;
+    
+    # Add to cache. 
+    $aggregates{$self->{'AGGREGATE'}->{'idx'}} = $self;
+    
+    return $self;
+}
+
+#
+# Stringify for output.
+#
+sub Stringify($)
+{
+    my ($self) = @_;
+    
+    my $uuid = $self->uuid();
+    my $idx  = $self->idx();
+
+    return "[GeniAggregate: $uuid, IDX: $idx]";
+}
+
+#
+# Create a Geni aggregate in the DB. This happens on the server side only
+# for now. The client side does not actually know its an aggregate, at
+# least not yet.
+#
+sub Create($$)
+{
+    my ($class, $ticket) = @_;
+    my @insert_data = ();
+
+    # Every aggregate gets a new unique index.
+    my $idx = TBGetUniqueIndex('next_aggregate', 1);
+
+    # Create a cert pair, which gives us a new uuid.
+    my $certificate = GeniCertificate->Create("aggregate");
+    if (!defined($certificate)) {
+	print STDERR "Could not generate new certificate and UUID!\n";
+	return undef;
+    }
+    my $uuid        = $certificate->uuid();
+    my $slice_uuid  = $ticket->slice_uuid();
+    my $owner_uuid  = $ticket->owner_uuid();
+
+    # Now tack on other stuff we need.
+    push(@insert_data, "created=now()");
+    push(@insert_data, "idx='$idx'");
+    push(@insert_data, "uuid='$uuid'");
+    push(@insert_data, "creator_uuid='$owner_uuid'");
+    push(@insert_data, "slice_uuid='$slice_uuid'");
+
+    # Insert into DB.
+    if (!DBQueryWarn("insert into geni_aggregates set " .
+		     join(",", @insert_data))) {
+	$certificate->Delete();
+	return undef;
+    }
+    return GeniAggregate->Lookup($idx);
+}
+# accessors
+sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
+sub idx($)		{ return field($_[0], "idx"); }
+sub uuid($)		{ return field($_[0], "uuid"); }
+sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
+sub creator_uuid($)	{ return field($_[0], "creator_uuid"); }
+sub created($)		{ return field($_[0], "created"); }
+sub credential_idx($)	{ return field($_[0], "credential_idx"); }
+sub ticket_idx($)	{ return field($_[0], "ticket_idx"); }
+sub cert($)		{ return $_[0]->{'CERTIFICATE'}->cert(); }
+sub GetCertificate($)   { return $_[0]->{'CERTIFICATE'}; }
+
+#
+# List of slivers for this aggregate.
+#
+sub SliverList($$)
+{
+    my ($self, $pref) = @_;
+    my @result = ();
+    
+    return -1
+	if (! (ref($self) && ref($pref)));
+
+    my $idx = $self->idx();
+    my $query_result =
+	DBQueryWarn("select idx from geni_slivers where aggregate_idx='$idx'");
+    return -1
+	if (!$query_result);
+
+    while (my ($sliver_idx) = $query_result->fetchrow_array()) {
+	my $sliver = GeniSliver->Lookup($sliver_idx);
+	if (!defined($sliver)) {
+	    print STDERR "Could not find sliver object for $sliver_idx\n";
+	    return -1;
+	}
+	push(@result, $sliver);
+    }
+    @$pref = @result;
+    return 0;
+    
+}
+
+#
+# Get the credential for the aggregate.
+#
+sub GetCredential($)
+{
+    my ($self) = @_;
+
+    return undef
+	if (! ref($self));
+
+    return $self->{'CREDENTIAL'} if (defined($self->{'CREDENTIAL'}));
+
+    if (!defined($self->credential_idx())) {
+	print STDERR "No credential associated with $self\n";
+	return undef;
+    }
+    my $credential = GeniCredential->Lookup($self->credential_idx());
+    if (!defined($credential)) {
+	print STDERR "Could not get credential object associated with $self\n";
+	return undef;
+    }
+    $self->{'CREDENTIAL'} = $credential;
+    return $credential;
+}
+
+#
+# Create a signed credential for this aggregate, issued to the provided user.
+# The credential will grant all permissions for now.
+#
+# Should we store these credentials in the DB, recording what we hand out?
+#
+sub NewCredential($$)
+{
+    my ($self, $owner) = @_;
+
+    return undef
+	if (! (ref($self) && ref($owner)));
+
+    my $credential = GeniCredential->Create($self, $owner);
+    if (!defined($credential)) {
+	print STDERR "Could not create credential for $self, $owner\n";
+	return undef;
+    }
+    if ($credential->Sign($self->GetCertificate()) != 0) {
+	print STDERR "Could not sign credential for $self, $owner\n";
+	return undef;
+    }
+    return $credential;
+}
+
+#
+# Start all the slivers in the aggregate.
+#
+sub StartUp($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    my @slivers = ();
+    if ($self->SliverList(\@slivers) != 0) {
+	print STDERR "Could not get sliver list for $self\n";
+	return -1;
+    }
+    foreach my $sliver (@slivers) {
+	if ($sliver->StartUp() != 0) {
+	    print STDERR "Could not start $sliver in $self\n";
+	    next;
+	}
+    }
+    return 0;
+}
+
+#
+# Unprovision all the slivers in the aggregate.
+#
+sub UnProvision($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    my @slivers = ();
+    if ($self->SliverList(\@slivers) != 0) {
+	print STDERR "Could not get sliver list for $self\n";
+	return -1;
+    }
+    foreach my $sliver (@slivers) {
+	if ($sliver->UnProvision() != 0) {
+	    print STDERR "Could not unprovision $sliver in $self\n";
+	    DBQueryWarn("update geni_slivers set status='broken' ".
+			"where idx=" . $sliver->idx());
+	    next;
+	}
+    }
+    return 0;
+}
+
+#
+# Destroy all the slivers in the aggregate, and then the aggregate if there
+# is nothing in it. Leave it around if something goes wrong.
+#
+sub Delete($)
+{
+    my ($self) = @_;
+    my $broken = 0;
+
+    return -1
+	if (! ref($self));
+
+    my @slivers = ();
+    if ($self->SliverList(\@slivers) != 0) {
+	print STDERR "Could not get sliver list for $self\n";
+	return -1;
+    }
+    foreach my $sliver (@slivers) {
+	if ($sliver->status() eq "broken") {
+	    $broken++;
+	    next;
+	}
+	if ($sliver->Delete() != 0) {
+	    print STDERR "Could not delete $sliver from $self\n";
+	    DBQueryWarn("update geni_slivers set status='broken' ".
+			"where idx=" . $sliver->idx());
+	    $broken++;
+	    next;
+	}
+    }
+    return -1
+	if ($broken);
+    
+    my $idx  = $self->idx();
+    my $uuid = $self->uuid();
+
+    DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
+	or return -1;
+    DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
+	or return -1;
+    DBQueryWarn("delete from geni_aggregates where idx='$idx'")
+	or return -1;
+    
+    return 0;
+}
+
+# _Always_ make sure that this 1 is at the end of the file...
+1;
+

protogeni/lib/GeniCH.pm.in

@@ -65,6 +65,11 @@ sub LookupUser($)
 	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
 				    "No slice authority found for user");
     }
+    # Grab ssh key.
+    my $sshkey;
+    if ($user->GetSSHKey(\$sshkey) != 0) {
+	print STDERR "Could not get ssh key for $user\n";
+    }
 
     # Return a blob.
     my $blob = { "uid"      => $user->uid(),
@@ -78,6 +83,8 @@ sub LookupUser($)
 				 "cert"     => $authority->cert(),
 				 "url"      => $authority->url() }
 	       };
+    $blob->{'sshkey'} = $sshkey
+	if (defined($sshkey));
     
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
 }
@@ -127,6 +134,7 @@ sub RegisterUser($)
     my $name  = $argref->{'name'};
     my $email = $argref->{'email'};
     my $cert  = $argref->{'cert'};
+    my $sshkey= $argref->{'sshkey'};
 
     if (! (defined($hrn) && defined($name) &&
 	   defined($email) && defined($cert) && defined($uuid))) {
@@ -156,6 +164,10 @@ sub RegisterUser($)
 	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
@@ -209,7 +221,7 @@ sub RegisterUser($)
 				    "uid: ". TBFieldErrorString());
     }
     my $newuser = GeniUser->Create($hrn, $uid, $uuid,
-				   $name, $email, $cert, $sa_idx);
+				   $name, $email, $cert, $sa_idx, $sshkey);
     if (!defined($newuser)) {
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "$hrn/$email could not be registered");

protogeni/lib/GeniCHClient.pm.in

@@ -82,18 +82,21 @@ sub LookupSlice($$)
 # Register a local Emulab user at the Geni ClearingHouse (which in the
 # prototype is Utah Emulab).
 #
-sub RegisterUser($$$$$)
+sub RegisterUser($$$$$$)
 {
-    my ($hrn, $uuid, $name, $email, $cert) = @_;
+    my ($hrn, $uuid, $name, $email, $cert, $sshkey) = @_;
+
+    my $args = { "hrn"    => $hrn,
+		 "uuid"   => $uuid,
+		 "name"   => $name,
+		 "email"  => $email,
+		 "cert"   => $cert};
+    $args->{"sshkey"} = $sshkey
+	if (defined($sshkey));
 
     my $response =
 	Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
-				   "CH::RegisterUser",
-				   { "hrn"   => $hrn,
-				     "uuid"  => $uuid,
-				     "name"  => $name,
-				     "email" => $email,
-				     "cert"  => $cert});
+				   "CH::RegisterUser", $args);
 
     return -1
 	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);

protogeni/lib/GeniCM.pm.in

@@ -26,6 +26,7 @@ use GeniTicket;
 use GeniCredential;
 use GeniCertificate;
 use GeniSlice;
+use GeniAggregate;
 use GeniSliver;
 use GeniUser;
 use libtestbed;
@@ -267,6 +268,7 @@ sub CreateSliver($)
     my $owner_uuid = $ENV{'GENIUSER'};
     my $ticket     = $argref->{'ticket'};
     my $impotent   = $argref->{'impotent'};
+    my $message    = "Error creating sliver/aggregate";
 
     $impotent = 0
 	if (!defined($impotent));
@@ -313,45 +315,92 @@ sub CreateSliver($)
 				    "No user record for $owner_uuid");
     }
 
-    my $sliver = GeniSliver->Create($ticket);
-    if (!defined($sliver)) {
+    #
+    # Create an emulab nonlocal user for tmcd.
+    #
+    $owner->BindToSlice($slice) == 0
+	or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				       "Error binding user to slice");
+	
+    #
+    # We are actually an Aggregate, so return an aggregate of sliver,
+    # even if there is just one node (simpler).
+    #
+    my $aggregate = GeniAggregate->Create($ticket);
+    if (!defined($aggregate)) {
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "Could not create GeniSliver object");
+				    "Could not create GeniAggregate object");
     }
 
     #
-    # Provision the slice. Okay, we already allocated the node above,
-    # so this should just work, unless the node has been released cause
-    # it has been too long.
+    # Now for each resource (okay, node) in the ticket create a sliver and
+    # add it to the aggregate.
     #
-    if (!$impotent && $sliver->Provision() != 0) {
-	$sliver->Delete();
-	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "Could not provision sliver");
+    my @slivers = ();
+    foreach my $resource_uuid (keys(%{$ticket->rspec()->{'node'}})) {
+	if (! ($resource_uuid =~ /^[-\w]*$/)) {
+	    $message = "Improper resource_uuid in ticket: $resource_uuid";
+	    goto bad;
+	}
+	my $sliver = GeniSliver->Create($slice, $owner, $resource_uuid);
+	if (!defined($sliver)) {
+	    $message = "Could not create GeniSliver object for $resource_uuid";
+	    goto bad;
+	}
+	push(@slivers, $sliver);
     }
+
+    #
+    # Now do the provisioning (note that we actually allocated the node
+    # above when the ticket was granted). The add the sliver to the aggregate.
+    #
+    foreach my $sliver (@slivers) {
+	if (!$impotent && $sliver->Provision() != 0) {
+	    $message = "Could not provision $sliver";
+	    goto bad;
+	}
+	if ($sliver->SetAggregate($aggregate) != 0) {
+	    $message = "Could not aggregate for $sliver to $aggregate";
+	    goto bad;
+	}
+    }
+
     #
-    # The API states we return a credential to control the sliver.
+    # The API states we return a credential to control the sliver/aggregate.
     #
-    my $credential = $sliver->NewCredential($owner);
+    my $credential = $aggregate->NewCredential($owner);
     if (!defined($credential)) {
-	$sliver->UnProvision();
-	$sliver->Delete();
-	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "Could not create credential sliver");
+	$message = "Could not create credential for $aggregate";
+	goto bad;
     }
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $credential->asString());
+
+  bad:
+    foreach my $sliver (@slivers) {
+	$sliver->UnProvision()
+	    if (! $impotent);
+	$sliver->Delete();
+    }
+    $aggregate->Delete()
+	if (defined($aggregate));
+    
+    return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $message);
 }
 
 #
-# Destroy a sliver.
+# Start a sliver (not sure what this means yet, so reboot for now).
 #
-sub DestroySliver($)
+sub StartSliver($)
 {
     my ($argref) = @_;
     my $owner_uuid  = $ENV{'GENIUSER'};
     my $sliver_cert = $argref->{'sliver'};
     my $credential  = $argref->{'credential'};
     my $sliver_uuid;
+    my $impotent   = $argref->{'impotent'};
+
+    $impotent = 0
+	if (!defined($impotent));
 
     if (!defined($sliver_cert) || !defined($credential)) {
 	return GeniResponse->Create(GENIRESPONSE_BADARGS);
@@ -360,28 +409,86 @@ sub DestroySliver($)
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "Could not get uuid from Certificate");
     
+    $credential = GeniCredential->CreateFromSigned($credential);
+    if (!defined($credential)) {
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "Could not create GeniCredential object");
+    }
     my $sliver = GeniSliver->Lookup($sliver_uuid);
     if (!defined($sliver)) {
-	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
-				    "No such sliver $sliver_uuid");
+	# Might be an aggregate instead.
+	$sliver = GeniAggregate->Lookup($sliver_uuid);
+	if (!defined($sliver)) {
+	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
+				    "No such sliver/aggregate $sliver_uuid");
+	}
     }
+    
+    # The credential owner has to match what is in the ticket.
+    if (! ($owner_uuid eq $credential->owner_uuid() &&
+	   $sliver_uuid eq $credential->this_uuid())) {
+	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
+				    "Invalid credentials for operation");
+    }
+    if (!$impotent) {
+	$sliver->StartUp() == 0 or
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				"Could not start sliver/aggregate");
+    }
+    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
+}
+
+#
+# Destroy a sliver/aggregate.
+#
+sub DestroySliver($)
+{
+    my ($argref) = @_;
+    my $owner_uuid  = $ENV{'GENIUSER'};
+    my $sliver_cert = $argref->{'sliver'};
+    my $credential  = $argref->{'credential'};
+    my $sliver_uuid;
+    my $impotent   = $argref->{'impotent'};
+
+    $impotent = 0
+	if (!defined($impotent));
+
+    if (!defined($sliver_cert) || !defined($credential)) {
+	return GeniResponse->Create(GENIRESPONSE_BADARGS);
+    }
+    GeniCertificate->CertificateInfo($sliver_cert, \$sliver_uuid) == 0 or