Checkpoint

protogeni/lib/GNUmakefile.in

@@ -14,7 +14,8 @@ 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
+		  GeniComponent.pm GeniCH.pm GeniCHClient.pm \
+		  GeniAuthority.pm GeniCertificate.pm
 
 #
 # Force dependencies on the scripts so that they will be rerun through

protogeni/lib/GeniAuthority.pm.in

+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2008 University of Utah and the Flux Group.
+# All rights reserved.
+#
+package GeniAuthority;
+
+#
+# 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 libtestbed;
+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 %authorities    = ();
+
+#
+# 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_sliceauthorities ".
+			"where uuid='$token'");
+	    return undef
+		if (! $query_result || !$query_result->numrows);
+
+	    ($idx) = $query_result->fetchrow_array();
+    }
+    else {
+	return undef;
+    }
+    # Look in cache first
+    return $authorities{"$idx"}
+        if (exists($authorities{"$idx"}));
+
+    $query_result =
+	DBQueryWarn("select * from geni_sliceauthorities where idx='$idx'");
+    
+    return undef
+	if (!$query_result || !$query_result->numrows);
+
+    my $self              = {};
+    $self->{'AUTHORITY'}  = $query_result->fetchrow_hashref();
+    bless($self, $class);
+
+    #
+    # Grab the certificate, since we will probably want it.
+    #
+    my $uuid = $self->{'AUTHORITY'}->{'uuid'};
+    $query_result = DBQueryWarn("select cert from geni_certificates ".
+				"where uuid='$uuid'");
+    if (!$query_result || !$query_result->numrows) {
+	print STDERR "Could not find certificate for authority $idx\n";
+	return undef;
+    }
+    my ($cert) = $query_result->fetchrow_array();
+    $self->{'AUTHORITY'}->{'cert'} = $cert;
+    
+    # Add to cache. 
+    $authorities{$self->{'AUTHORITY'}->{'idx'}} = $self;
+    
+    return $self;
+}
+
+#
+# Stringify for output.
+#
+sub Stringify($)
+{
+    my ($self) = @_;
+    
+    my $uuid = $self->uuid();
+    my $idx  = $self->idx();
+
+    return "[GeniAuthority: $uuid, IDX: $idx]";
+}
+
+#
+# Create a Geni authority in the DB.
+#
+sub Create($$$$$)
+{
+    my ($class, $uuid, $hrn, $url, $cert) = @_;
+
+    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);
+    
+    # Now tack on other stuff we need.
+    push(@insert_data, "created=now()");
+    push(@insert_data, "idx='$idx'");
+    push(@insert_data, "hrn=$safe_hrn");
+    push(@insert_data, "url=$safe_url");
+    push(@insert_data, "uuid=$safe_uuid");
+
+    # Insert into DB.
+    DBQueryWarn("replace into geni_sliceauthorities set " .
+		join(",", @insert_data))
+	or return undef;
+
+    # Insert the certificate.
+    if (!DBQueryWarn("replace into geni_certificates set ".
+		     "  uuid=$safe_uuid, cert=$safe_cert")) {
+	DBQueryWarn("delete from geni_sliceauthorities where idx='$idx'");
+	return undef;
+    }
+
+    return GeniAuthority->Lookup($idx);
+}
+# accessors
+sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AUTHORITY'}->{$_[1]}); }
+sub idx($)		{ return field($_[0], "idx"); }
+sub uuid($)		{ return field($_[0], "uuid"); }
+sub uuid_prefix($)	{ return field($_[0], "uuid_prefix"); }
+sub url($)		{ return field($_[0], "url"); }
+sub hrn($)		{ return field($_[0], "hrn"); }
+sub cert($)		{ return field($_[0], "cert"); }
+
+# _Always_ make sure that this 1 is at the end of the file...
+1;
+

protogeni/lib/GeniCH.pm.in

@@ -25,6 +25,7 @@ use User;
 use GeniUser;
 use GeniSlice;
 use GeniComponent;
+use GeniAuthority;
 use libtestbed;
 use emutil;
 use English;
@@ -59,15 +60,28 @@ sub LookupUser($)
 				    "No such user $uuid");
     }
 
-    # Return a blob.
-    my $blob = { "uid"    => $user->uid(),
-		 "hrn"    => $user->hrn(),
-		 "uuid"   => $user->uuid(),
-		 "email"  => $user->email(),
-		 "name"   => $user->name() };
+    my $authority = GeniAuthority->Lookup($user->sa_idx());
+    if (!defined($authority)) {
+	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+				    "No slice authority found for user");
+    }
 
+    # Return a blob.
+    my $blob = { "uid"      => $user->uid(),
+		 "hrn"      => $user->hrn(),
+		 "uuid"     => $user->uuid(),
+		 "email"    => $user->email(),
+		 "cert"     => $user->cert(),
+		 "name"     => $user->name(),
+		 "sa"       => { "hrn"      => $authority->hrn(),
+				 "uuid"     => $authority->uuid(),
+				 "cert"     => $authority->cert(),
+				 "url"      => $authority->url() }
+	       };
+    
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
 }
+
 sub LookupSlice($)
 {
     my ($argref) = @_;
@@ -82,11 +96,22 @@ sub LookupSlice($)
 				    "No such user $uuid");
     }
 
+    my $authority = GeniAuthority->Lookup($slice->sa_idx());
+    if (!defined($authority)) {
+	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+				    "No slice authority found for slice");
+    }
+
     # Return a blob.
     my $blob = { "hrn"          => $slice->hrn(),
 		 "uuid"         => $slice->uuid(),
 		 "creator_uuid" => $slice->creator_uuid(),
-		 "cert"         => $slice->cert() };
+		 "cert"         => $slice->cert(),
+		 "sa"           => { "hrn"      => $authority->hrn(),
+				     "uuid"     => $authority->uuid(),
+				     "cert"     => $authority->cert(),
+				     "url"      => $authority->url() }
+	       };
 
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
 }
@@ -98,15 +123,13 @@ sub RegisterUser($)
 {
     my ($argref) = @_;
     my $hrn   = $argref->{'hrn'};
-    my $uid   = $argref->{'uid'};
     my $uuid  = $argref->{'uuid'};
     my $name  = $argref->{'name'};
     my $email = $argref->{'email'};
     my $cert  = $argref->{'cert'};
 
-    if (! (defined($hrn) && defined($uid) && defined($name) &&
-	   defined($email) &&
-	   defined($cert) && defined($uuid))) {
+    if (! (defined($hrn) && defined($name) &&
+	   defined($email) && defined($cert) && defined($uuid))) {
 	return GeniResponse->MalformedArgsResponse();
     }
 
@@ -125,10 +148,6 @@ sub RegisterUser($)
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "name: ". TBFieldErrorString());
     }
-    if (! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
-	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "uid: ". TBFieldErrorString());
-    }
     if (! TBcheck_dbslot($email, "users", "usr_email",TBDB_CHECKDBSLOT_ERROR)){
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "email: ". TBFieldErrorString());
@@ -179,6 +198,16 @@ sub RegisterUser($)
 				    "$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, $sa_idx);
     if (!defined($newuser)) {

protogeni/lib/GeniCM.pm.in

@@ -116,15 +116,16 @@ sub DiscoverResources($)
 sub GetTicket($)
 {
     my ($argref) = @_;
-    my $slice_uuid = $argref->{'slice_uuid'};
+    my $slice_cert = $argref->{'slice'};
     my $rspec      = $argref->{'rspec'};
     my $impotent   = $argref->{'impotent'};
     my $credential = $argref->{'credential'};
     my $owner_uuid = $ENV{'GENIUSER'};
+    my $slice_uuid;
 
-    if (! (defined($slice_uuid) && ($slice_uuid =~ /^[-\w]+$/))) {
+    if (! defined($slice_cert)) {
 	GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
-			     "Improper slice uuid");	
+			     "Improper slice");
     }
     if (! (defined($rspec) && ($rspec =~ /^[-\w]+$/))) {
 	GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
@@ -141,6 +142,11 @@ sub GetTicket($)
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "Could not create GeniCredential object");
     }
+    GeniCredential->CertificateInfo($slice_cert, \$slice_uuid) == 0 or
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "Could not get uuid from Certificate");
+	
+	
     # The credential owner/slice has to match what was provided.
     if (! ($owner_uuid eq $credential->owner_uuid() &&
 	   $slice_uuid eq $credential->this_uuid())) {
@@ -155,13 +161,27 @@ sub GetTicket($)
     #
     my $slice = GeniSlice->Lookup($slice_uuid);
     if (!defined($slice)) {
-
+	$slice = GeniSlice->CreateFromRegistry($slice_uuid);
+	if (!defined($slice)) {
+	    print STDERR "No slice $slice_uuid in the ClearingHouse\n";
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+			    "Could not get slice info from ClearingHouse");
+	}
     }
 
-    
-
     #
-    # XXX Should we create a local geni_slices record in the DB?
+    # Ditto the user.
+    #
+    my $user = GeniUser->Lookup($owner_uuid);
+    if (!defined($user)) {
+	$user = GeniUser->CreateFromRegistry($owner_uuid);
+	if (!defined($user)) {
+	    print STDERR "No user $owner_uuid in the ClearingHouse\n";
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+			    "Could not get user info from ClearingHouse");
+	}
+    }
+
     #
     # If the underlying experiment does not exist, need to create
     # a holding experiment. All these are going to go into the same
@@ -208,7 +228,7 @@ sub GetTicket($)
     #
     # Create the ticket first, before allocating the node.
     #
-    my $ticket = GeniTicket->Create($slice_uuid, $owner_uuid, $rspec);
+    my $ticket = GeniTicket->Create($slice, $user, $rspec);
     if (!defined($ticket)) {
 	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
 				    "Could not create GeniTicket object");

protogeni/lib/GeniCMClient.pm.in

@@ -41,47 +41,6 @@ my $OURDOMAIN      = "@OURDOMAIN@";
 my $GENICENTRAL    = "myboss.little-emulab-bsd61.testbed.emulab.net";
 my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc";
 
-#
-# Ask for a ticket. We provide an rspec. Neither of these are defined yet
-# so lets be simpleminded; send a count of nodes we want and get back a
-# count of nodes that can be allocated. I realize there is a problem of
-# those nodes getting allocated before the tickets are redeemed, but not
-# going to worry about that either.
-#
-# $component is just a url for now.
-#
-sub GetTicket($$$$)
-{
-    my ($experiment, $component, $rspec, $pref) = @_;
-
-    #
-    # XXX 
-    #
-    my $this_user = User->LookupByUnixId($UID);
-    if (! defined($this_user)) {
-    	print STDERR "You ($UID) do not exist!\n";
-	return -1;
-    }
-
-    # Need to construct a credential.
-    my $credential = GeniCredential->Create($experiment->uuid(),
-					    $this_user->uuid());
-    if (!defined($credential)) {
-	print STDERR "Could not create a slice credential for $experiment!\n";
-	return -1;
-    }
-    if ($credential->Sign()) {
-	print STDERR "Could not sign slice credential!\n";
-	return -1;
-    }
-
-    my $ticket = $component->GetTicket($this_user, $credential,
-				       $experiment->uuid(), $rspec);
-				       
-    $$pref = $ticket;
-    return 0;
-}
-
 sub CreateSliver($$$)
 {
     my ($experiment, $ticket, $pref) = @_;

protogeni/lib/GeniCertificate.pm.in

+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2008 University of Utah and the Flux Group.
+# All rights reserved.
+#
+package GeniCertificate;
+
+#
+# Some simple certificate 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 libtestbed;
+use libdb qw(TBGetUniqueIndex);
+use English;
+use XML::Simple;
+use XML::LibXML;
+use Data::Dumper;
+use File::Temp qw(tempfile);
+
+# 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";
+my $NFREE	   = "$TB/bin/nfree";
+my $OPENSSL	   = "/usr/bin/openssl";
+
+# _Always_ make sure that this 1 is at the end of the file...
+1;

protogeni/lib/GeniComponent.pm.in

@@ -250,11 +250,11 @@ sub DiscoverResources($$$$$)
 #
 sub GetTicket($$$$$)
 {
-    my ($self, $user, $credential, $slice_uuid, $rspec) = @_;
+    my ($self, $slice, $rspec, $user, $credential) = @_;
     my $rspec_xml = $rspec;
 
     # Must be a real reference. 
-    return -1
+    return undef
 	if (! ref($self));
 
     # The rspec is passed as XML. If we get a ref, convert it.
@@ -266,9 +266,9 @@ sub GetTicket($$$$$)
 	Genixmlrpc::CallMethodHTTP($self->url(),
 				   $user,
 				   "CM::GetTicket",
-				   { "slice_uuid"   => $slice_uuid,
+				   { "slice"        => $slice->cert(),
 				     "credential"   => $credential->asString(),
-				     "impotent"     => 0,
+				     "impotent"     => 1,
 				     "rspec"        => $rspec_xml });
     
     return undef
@@ -280,8 +280,7 @@ sub GetTicket($$$$$)
     #
     # Convert this into a (signed) ticket object.
     #
-    return GeniTicket->Create($slice_uuid, $user->uuid(),
-			      $rspec, $response->value(), $self);
+    return GeniTicket->CreateFromSignedTicket($response->value(), $self, 1);
 }
 
 #
@@ -289,10 +288,10 @@ sub GetTicket($$$$$)
 #
 sub CreateSliver($$$$)
 {
-    my ($self, $user, $ticket, $pref) = @_;
+    my ($self, $slice, $ticket, $user) = @_;
 
     # Must be a real reference. 
-    return -1
+    return undef
 	if (! ref($self));
 
     my $response =
@@ -300,10 +299,10 @@ sub CreateSliver($$$$)
 				   "CM::CreateSliver",
 				   { "ticket"  => $ticket->asString() });
     
-    return -1
+    return undef
 	if (!defined($response));
 
-    return -1
+    return undef
 	if ($response->code() != GENIRESPONSE_SUCCESS);
 
     #
@@ -312,16 +311,15 @@ sub CreateSliver($$$$)
     my $credential = GeniCredential->CreateFromSigned($response->value());
     if (!defined($credential)) {
 	print STDERR "Could not create local credential object.\n";
-	return -1;
+	return undef;
     }
 
     my $sliver = GeniSliver->Create($ticket, $credential);
     if (!defined($sliver)) {
 	print STDERR "Could not create local sliver object.\n";
-	return -1;
+	return undef;
     }
-    $$pref = $sliver;
-    return 0;
+    return $sliver;
 }
 
 #

protogeni/lib/GeniCredential.pm.in

@@ -298,6 +298,38 @@ sub Store($)
     return 0;
 }
 
+#
+# Create a certificate pair, which gives us a uuid to use for an object.
+# We need a file to store the cert/key in.
+#
+sub CreateCertificate($$$$)
+{
+    my ($class, $what, $certfile, $pref) = @_;
+
+    system("$MKCERT -o $certfile $what $uuid");
+    if ($?) {
+	print STDERR "Could not start $MKCERT\n";
+	return -1;
+    }
+    my $cert;
+    open(CERT, $certfile) or
+	return -1;
+    while (<CERT>) {
+	if ($_ =~ /^-----BEGIN CERT/) {
+	    $cert = "";
+	    next;
+	}
+	last
+	    if ($_ =~ /^-----END CERT/);
+	next
+	    if (!defined($cert));
+	$cert .= $_;
+    }
+    close(CERT);
+    $$pref = $cert;
+    return 0;
+}
+
 #
 # Convert a certificate to its uuid.
 #
@@ -306,7 +338,7 @@ sub CertificateInfo($$$)
     my ($class, $string, $pref) = @_;
 
     # Deleted when scope is left.
-    my $tempfile = new File::Temp(UNLINK => 0);
+    my $tempfile = new File::Temp(UNLINK => 1);
     my $filename = $tempfile->filename;    
     print $tempfile "-----BEGIN CERTIFICATE-----\n";
     print $tempfile "$string";

protogeni/lib/GeniSlice.pm.in

@@ -17,6 +17,8 @@ use vars qw(@ISA @EXPORT);
 use lib '@prefix@/lib';
 use GeniDB;
 use GeniCHClient;
+use GeniAuthority;
+use GeniCredential;
 use libtestbed;
 # Hate to import all this crap; need a utility library.
 use libdb qw(TBGetUniqueIndex);
@@ -207,26 +209,11 @@ sub CreateFromLocal($$)
     # the DB so we have ready access to it.
     #
     my $certfile = $experiment->WorkDir() . "/genicert.pem";
-    system("$MKCERT -o $certfile slice $uuid");
-    if ($?) {
-	print STDERR "Could not start $MKCERT\n";
-	return undef;
-    }
     my $cert;
-    open(CERT, $certfile) or
+    if (GeniCredential->CreateCertificate("slice", $certfile, \$cert) != 0) {
+	print STDERR "Could not create certificate for slice.\n";
 	return undef;
-    while (<CERT>) {
-	if ($_ =~ /^-----BEGIN CERT/) {
-	    $cert = "";
-	    next;
-	}
-	last
-	    if ($_ =~ /^-----END CERT/);
-	next
-	    if (!defined($cert));
-	$cert .= $_;
     }
-    close(CERT);
     return GeniSlice->Create($hrn, $uuid, $creator_uuid, $cert, $sa_idx);
 }
 
@@ -247,6 +234,34 @@ sub Register($)
     return 0;
 }
 
+#
+# Create a slice from the ClearingHouse, by looking up the info.
+#
+sub CreateFromRegistry($$)
+{
+    my ($class, $slice_uuid) = @_;
+
+    my $blob;
+    return undef
+	if (GeniCHClient::LookupSlice($slice_uuid, \$blob) != 0);
+
+    my $authority = GeniAuthority->Lookup($blob->{'sa'}->{'uuid'});
+    if (!defined($authority)) {
+	$authority = GeniAuthority->Create($blob->{'sa'}->{'uuid'},
+					   $blob->{'sa'}->{'hrn'},
+					   $blob->{'sa'}->{'url'},
+					   $blob->{'sa'}->{'cert'});
+	if (!defined($authority)) {
+	    print STDERR "Could not create new authority record\n";
+	    return undef;
+	}
+    }
+    return GeniSlice->Create($blob->{'hrn'},
+			     $blob->{'uuid'},
+			     $blob->{'creator_uuid'},
+			     $blob->{'cert'}, $authority->idx());
+}
+
 #
 # Discover resources for a local slice. We do not worry about the experiment
 # yet, since we do not have a resource discovery service. We get back a list

protogeni/lib/GeniSliver.pm.in

@@ -116,18 +116,24 @@ sub Create($$;$)
     my ($class, $ticket, $credential) = @_;
     my @insert_data = ();
     my $uuid;
+    my $cert;
 
     # Every sliver gets a new unique index.
     my $idx = TBGetUniqueIndex('next_sliver', 1);
     if (defined($credential)) {
 	$uuid = $credential->this_uuid();
+	$cert = $credential->this_cert();
 
 	# Store the credential
 	return undef
 	    if ($credential->Store() != 0);
     }
     else {
-	# And a new uuid for a local sliver.
+	# Create a cert pair, which gives us a uuid. We have to store the
+	# certificate someplace. Grab the experiment and stick it into the
+	# workdir. xs
+	
+	# And a new uuid and cert for a local sliver.
 	$uuid = NewUUID();
 	if (!defined($uuid)) {
 	    print "*** WARNING: Could not generate a UUID!\n";
@@ -157,6 +163,13 @@ sub Create($$;$)
     DBQueryWarn("insert into geni_slivers set " . join(",", @insert_data))
 	or return undef;