diff --git a/protogeni/lib/GNUmakefile.in b/protogeni/lib/GNUmakefile.in
index 599aff51e1885dba027e9a69a163e00a1072ac83..c8159d8e9d02b3d185cea6f7fbaa7bf864c6731f 100644
--- a/protogeni/lib/GNUmakefile.in
+++ b/protogeni/lib/GNUmakefile.in
@@ -13,7 +13,7 @@ include $(OBJDIR)/Makeconf
LIB_SCRIPTS = Protogeni.pm GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
- test.pl GeniTicket.pm GeniSliver.pm
+ test.pl GeniTicket.pm GeniSliver.pm GeniCredential.pm
#
# Force dependencies on the scripts so that they will be rerun through
diff --git a/protogeni/lib/GeniCM.pm.in b/protogeni/lib/GeniCM.pm.in
index 9364b102c4ab9af20f305773b77975add6766b74..54b593968e411f178b8c2ee9c5bdfd66285ca495 100644
--- a/protogeni/lib/GeniCM.pm.in
+++ b/protogeni/lib/GeniCM.pm.in
@@ -23,6 +23,7 @@ use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
+use GeniCredential;
use GeniSliver;
use GeniUser;
use libtestbed;
@@ -52,26 +53,39 @@ my $NALLOC = "$TB/bin/nalloc";
sub GetTicket($)
{
my ($argref) = @_;
- my $owner_uuid = $argref->{'owner_uuid'};
my $slice_uuid = $argref->{'slice_uuid'};
my $rspec = $argref->{'rspec'};
+ my $impotent = $argref->{'impotent'};
+ my $credstring = $argref->{'credential_string'};
+ my $owner_uuid = $ENV{'GENIUSER'};
if (! (defined($slice_uuid) && ($slice_uuid =~ /^[-\w]+$/))) {
return GeniResponse->MalformedArgsResponse();
}
- # XXX This needs to come from the SSL environment.
if (! (defined($owner_uuid) && ($owner_uuid =~ /^[-\w]+$/))) {
return GeniResponse->MalformedArgsResponse();
}
if (! defined($rspec)) {
return GeniResponse->MalformedArgsResponse();
}
+ $impotent = 0
+ if (!defined($impotent));
+
+ my $credential = GeniCredential->CreateFromSigned($credstring);
+ if (!defined($credential)) {
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Could not create GeniCredential object");
+ }
+ # The credential owner/slice has to match what was provided.
+ if (! ($owner_uuid eq $credential->owner_uuid() &&
+ $slice_uuid eq $credential->this_uuid())) {
+ return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
+ "Invalid credentials for operation");
+ }
#
# XXX Should we create a local geni_slices record in the DB?
#
-if (0) {
- #
# If the underlying experiment does not exist, need to create
# a holding experiment. All these are going to go into the same
# project for now. Generally, users for non-local slices do not
@@ -110,7 +124,6 @@ if (0) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Improper node id");
}
-}
#
# Create the ticket first, before allocating the node.
@@ -120,20 +133,20 @@ if (0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniTicket object");
}
-if (0) {
# Nalloc might fail if the node gets picked up by someone else.
-# system("$NALLOC $pid $eid $node_id");
- if (($? >> 8) < 0) {
- $ticket->Delete();
- return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
- "Allocation failure");
- }
- elsif (($? >> 8) > 0) {
- $ticket->Delete();
- return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
- "Could not allocate node\n");
+ if (!$impotent) {
+ system("$NALLOC $pid $eid $node_id");
+ if (($? >> 8) < 0) {
+ $ticket->Delete();
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Allocation failure");
+ }
+ elsif (($? >> 8) > 0) {
+ $ticket->Delete();
+ return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
+ "Could not allocate node\n");
+ }
}
-}
if ($ticket->Sign() != 0) {
# Release will free the node.
$ticket->Release();
@@ -147,6 +160,8 @@ if (0) {
#
# Create a sliver.
#
+# XXX Credentials stuff.
+#
sub CreateSliver($)
{
my ($argref) = @_;
@@ -190,5 +205,74 @@ sub CreateSliver($)
"Could not provision sliver");
}
- return GeniResponse->Create(GENIRESPONSE_SUCCESS, 0, "Wow!");
+ return GeniResponse->Create(GENIRESPONSE_SUCCESS, $sliver->uuid(), "Wow!");
+}
+
+
+#
+# Start a sliver. I take this to mean, reboot the node. Currently, using
+# the ticket as the credential.
+#
+# XXX Credentials stuff.
+#
+sub StartSliver($)
+{
+ my ($argref) = @_;
+ my $ticket = $argref->{'ticket'};
+ my $sliver_uuid = $argref->{'uuid'};
+
+ if (!defined($sliver_uuid)) {
+ return GeniResponse->Create(GENIRESPONSE_BADARGS);
+ }
+ my $sliver = GeniSliver->Lookup($sliver_uuid);
+ if (!defined($sliver)) {
+ return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
+ "No such sliver $sliver_uuid");
+ }
+
+ if (! (defined($ticket) &&
+ !TBcheck_dbslot($ticket, "default", "text",
+ TBDB_CHECKDBSLOT_ERROR))) {
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "ticket: ". TBFieldErrorString());
+ }
+ $ticket = GeniTicket->CreateFromSignedTicket($ticket);
+ if (!defined($ticket)) {
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Could not create GeniTicket object");
+ }
+
+ $sliver->Start() == 0 or
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Could not start $sliver");
+
+ return GeniResponse->Create(GENIRESPONSE_SUCCESS);
+}
+
+#
+# Destroy a sliver.
+#
+# XXX Credential stuff ...
+#
+sub DestroySliver($)
+{
+ my ($argref) = @_;
+ my $sliver_uuid = $argref->{'uuid'};
+
+ if (!defined($sliver_uuid)) {
+ return GeniResponse->Create(GENIRESPONSE_BADARGS);
+ }
+ my $sliver = GeniSliver->Lookup($sliver_uuid);
+ if (!defined($sliver)) {
+ return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
+ "No such sliver $sliver_uuid");
+ }
+ $sliver->UnProvision() == 0 or
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Could not unprovision sliver");
+ $sliver->Delete() == 0 or
+ return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+ "Could not delete sliver");
+
+ return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
diff --git a/protogeni/lib/GeniCMClient.pm.in b/protogeni/lib/GeniCMClient.pm.in
index c9b30d9eba4e1b96924732122f01a4cd5b74e67f..3b2143c38535d9607da833df672358268d651a67 100644
--- a/protogeni/lib/GeniCMClient.pm.in
+++ b/protogeni/lib/GeniCMClient.pm.in
@@ -23,6 +23,7 @@ use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
+use GeniCredential;
use GeniSliver;
use User;
use libtestbed;
@@ -50,7 +51,8 @@ sub DiscoverResources($$)
my ($experiment, $pref) = @_;
my $response =
- Genixmlrpc::CallMethodHTTP($GENICENTRAL, "SA::DiscoverResources",
+ Genixmlrpc::CallMethodHTTP($GENICENTRAL, User->LookupByUnixId($UID),
+ "SA::DiscoverResources",
{ "uuid" => $experiment->uuid() });
return -1
@@ -87,11 +89,28 @@ sub GetTicket($$$$)
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->AddCapability("createslice", 0)) {
+ print STDERR "Could not add capability to slice credential!\n";
+ return -1;
+ }
+ if ($credential->Sign()) {
+ print STDERR "Could not sign slice credential!\n";
+ return -1;
+ }
+
my $response =
- Genixmlrpc::CallMethodHTTP($component, "CM::GetTicket",
- { "slice_uuid" => $experiment->uuid(),
- "owner_uuid" => $this_user->uuid(),
- "rspec" => $rspec });
+ Genixmlrpc::CallMethodHTTP($component, $this_user, "CM::GetTicket",
+ { "slice_uuid" => $experiment->uuid(),
+ "credential_string" => $credential->asString(),
+ "impotent" => 1,
+ "rspec" => $rspec });
return -1
if (!defined($response));
@@ -120,15 +139,35 @@ sub CreateSliver($$$)
return -1
if (!defined($response));
- print Dumper($response);
-
return -1
if ($response->code() != GENIRESPONSE_SUCCESS);
- my $sliver = undef;
-
+ my $sliver = GeniSliver->Create($ticket, $response->value());
+ if (!defined($sliver)) {
+ print STDERR "Could not create local sliver object\n";
+ return undef;
+ }
$$pref = $sliver;
return 0;
+}
+
+sub DestroySliver($$)
+{
+ my ($experiment, $sliver) = @_;
+ my $ticket = $sliver->GetTicket();
+ my $response =
+ Genixmlrpc::CallMethodHTTP($ticket->component(),
+ "CM::DestroySliver",
+ { "uuid" => $sliver->uuid() });
+
+ if ($response->code() != GENIRESPONSE_SUCCESS) {
+ print STDERR "Could not destroy sliver $sliver\n";
+ return -1;
+ }
+ $sliver->Delete() == 0
+ or return -1;
+
+ return 0;
}
diff --git a/protogeni/lib/GeniCredential.pm.in b/protogeni/lib/GeniCredential.pm.in
new file mode 100644
index 0000000000000000000000000000000000000000..2ef01e73935d467f3574294a2d6e65eade093fac
--- /dev/null
+++ b/protogeni/lib/GeniCredential.pm.in
@@ -0,0 +1,228 @@
+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2008 University of Utah and the Flux Group.
+# All rights reserved.
+#
+package GeniCredential;
+
+#
+# Some simple credential 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 Experiment;
+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 $GENICENTRAL = "https://boss/protogeni/xmlrpc";
+my $SIGNCRED = "$TB/sbin/signgenicred";
+my $VERIFYCRED = "$TB/sbin/verifygenicred";
+my $NFREE = "$TB/bin/nfree";
+
+#
+# Create an empty credential object.
+#
+sub Create($$$$)
+{
+ my ($class, $this_uuid, $owner_uuid) = @_;
+
+ my $self = {};
+ $self->{'this_uuid'} = $this_uuid;
+ $self->{'owner_uuid'} = $owner_uuid;
+ $self->{'string'} = undef;
+ $self->{'capabilities'} = undef;
+ bless($self, $class);
+
+ return $self;
+}
+# accessors
+sub field($$) { return ($_[0]->{$_[1]}); }
+sub this_uuid($) { return field($_[0], "this_uuid"); }
+sub owner_uuid($) { return field($_[0], "owner_uuid"); }
+sub asString($) { return field($_[0], "string"); }
+sub capabilities($) { return field($_[0], "capabilities"); }
+
+#
+# Add a capability to the array.
+#
+sub AddCapability($$$)
+{
+ my ($self, $name, $delegate) = @_;
+
+ return -1
+ if (!ref($self));
+
+ if (!defined($self->capabilities())) {
+ $self->{'capabilities'} = {};
+ }
+ $self->{'capabilities'}->{$name} = {"can_delegate" => $delegate};
+ return 0;
+}
+
+#
+# Create a credential object from a signed credential string.
+#
+sub CreateFromSigned($$)
+{
+ my ($class, $string) = @_;
+
+ # First verify the credential
+ my ($fh, $filename) = tempfile(UNLINK => 0);
+ return undef
+ if (!defined($fh));
+ print $fh $string;
+ close($fh);
+ system("$VERIFYCRED $filename");
+ if ($?) {
+ print STDERR "Credential in $filename did not verify\n";
+ return undef;
+ }
+ unlink($filename);
+
+ # Use XML::Simple to convert to something we can mess with.
+ my $parser = XML::LibXML->new;
+ my $doc = $parser->parse_string($string);
+
+ # Dig out the capabilities
+ my ($cap_node) = $doc->getElementsByTagName("capabilities");
+ return undef
+ if (!defined($cap_node));
+ my $capabilities = XMLin($cap_node->toString(), ForceArray => 0);
+
+ # Dig out the slice uuid. Locally, I am not sure if we bother to
+ # keep slices in the DB (they are in the DB at geni central).
+ my ($uuid_node) = $doc->getElementsByTagName("this_uuid");
+ return undef
+ if (!defined($uuid_node));
+ my $this_uuid = $uuid_node->to_literal();
+
+ if (! ($this_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
+ print STDERR "Invalid this_uuid in credential\n";
+ return undef;
+ }
+
+ # Dig out the owner uuid. Locally, I am not sure if we bother to
+ # keep users in the DB (they are in the DB at geni central).
+ ($uuid_node) = $doc->getElementsByTagName("owner_uuid");
+ return undef
+ if (!defined($uuid_node));
+ my $owner_uuid = $uuid_node->to_literal();
+
+ if (! ($owner_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
+ print STDERR "Invalid owner_uuid in credential\n";
+ return undef;
+ }
+
+ my $self = {};
+ $self->{'capabilities'} = $capabilities;
+ $self->{'this_uuid'} = $this_uuid;
+ $self->{'owner_uuid'} = $owner_uuid;
+ $self->{'string'} = $string;
+ $self->{'xmlref'} = $doc;
+ bless($self, $class);
+
+ return $self;
+}
+
+#
+# Might have to delete this from the DB.
+#
+sub Delete($)
+{
+ my ($self) = @_;
+
+ return -1
+ if (! ref($self));
+
+ return 0;
+}
+
+#
+# Sign the credential.
+#
+sub Sign($)
+{
+ my ($self) = @_;
+
+ return -1
+ if (!ref($self));
+
+ # If no capabilities, then allow all rights, no delegation.
+ if (!defined($self->capabilities())) {
+ $self->AddCapability("*", 0);
+ }
+ # This little wrapup is for xmlout.
+ my $capabilities = {"capability" => $self->capabilities()};
+
+ # Every one gets a new unique index, which is used in the xml:id below.
+ my $idx = TBGetUniqueIndex('next_ticket', 1);
+
+ my $this_uuid = $self->this_uuid();
+ my $owner_uuid = $self->owner_uuid();
+ my $cap_xml = XMLout($capabilities, "NoAttr" => 1);
+ $cap_xml =~ s/opt\>/capabilities\>/g;
+
+ #
+ # Create a template xml file to sign.
+ #
+ my $template =
+ "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n".
+ "<credential xml:id=\"ref1\">\n".
+ " <type>capability</type>\n".
+ " <serial>$idx</serial>\n".
+ " <owner_uuid>$owner_uuid</owner_uuid>\n".
+ " <this_uuid>$this_uuid</this_uuid>\n".
+ " $cap_xml\n".
+ "</credential>\n";
+
+ my ($fh, $filename) = tempfile(UNLINK => 0);
+ return -1
+ if (!defined($fh));
+
+ print $fh $template;
+ close($fh);
+
+ #
+ # Fire up the signer and capture the output. This is the signed credential
+ # that is returned.
+ #
+ if (! open(SIGNER, "$SIGNCRED $filename |")) {
+ print STDERR "Could not start $SIGNCRED on $filename\n";
+ return -1;
+ }
+ my $credential = "";
+ while (<SIGNER>) {
+ $credential .= $_;
+ }
+ if (!close(SIGNER)) {
+ print STDERR "Could not sign $filename\n";
+ return -1;
+ }
+ $self->{'string'} = $credential;
+ unlink($filename);
+ return 0;
+}
+
+# _Always_ make sure that this 1 is at the end of the file...
+1;
diff --git a/protogeni/lib/GeniSliver.pm.in b/protogeni/lib/GeniSliver.pm.in
index 9f9e46bbce2e101d6c1276b1ff17befa35c8cb8d..4be2ec12eadcfb8baf1d2f2f330ce9c60227ff41 100644
--- a/protogeni/lib/GeniSliver.pm.in
+++ b/protogeni/lib/GeniSliver.pm.in
@@ -25,6 +25,7 @@ use Node;
use English;
use Data::Dumper;
use File::Temp qw(tempfile);
+use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
@@ -96,20 +97,22 @@ sub Stringify($)
}
#
-# Create a sliver. Not much to it yet.
+# Create a sliver.
#
-sub Create($$)
+sub Create($$;$)
{
- my ($class, $ticket) = @_;
+ my ($class, $ticket, $uuid) = @_;
my @insert_data = ();
# Every sliver gets a new unique index.
my $idx = TBGetUniqueIndex('next_sliver', 1);
- # And a new uuid.
- my $uuid = NewUUID();
if (!defined($uuid)) {
- print "*** WARNING: Could not generate a UUID!\n";
- return undef;
+ # And a new uuid for a local sliver.
+ $uuid = NewUUID();
+ if (!defined($uuid)) {
+ print "*** WARNING: Could not generate a UUID!\n";
+ return undef;
+ }
}
my $slice_uuid = $ticket->slice_uuid();
my $owner_uuid = $ticket->owner_uuid();
@@ -127,7 +130,12 @@ sub Create($$)
DBQueryWarn("insert into geni_slivers set " . join(",", @insert_data))
or return undef;
- return GeniSlice->Lookup($idx);
+ my $sliver = GeniSliver->Lookup($idx);
+ return undef
+ if (!defined($sliver));
+ $sliver->{'TICKET'} = $ticket;
+
+ return $sliver;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'SLIVER'}->{$_[1]}); }
@@ -170,11 +178,67 @@ sub GetExperiment($)
return Experiment->Lookup($self->slice_uuid());
}
+#
+# Get the ticket for the sliver.
+#
+sub GetTicket($)
+{
+ my ($self) = @_;
+
+ return undef
+ if (! ref($self));
+
+ if (!exists($self->{'TICKET'})) {
+ print STDERR "No ticket object associated with $self\n";
+ return undef;
+ }
+ return $self->{'TICKET'};
+}
+
#
# Provision a slice. We actually did this when the ticket was requested.
#
sub Provision($)
{
+ my ($self) = @_;
+
+ return -1
+ if (! ref($self));
+
+ #
+ # the node is already allocated to the sliver, but still need to enter
+ # a virt_nodes entry, and possibly more virt table entries, so that the
+ # node will boot properly, and is otherwie controllable.
+ #
+ my $experiment = Experiment->Lookup($self->slice_uuid());
+ if (!defined($experiment)) {
+ print STDERR "Could not map $self to its experiment\n";
+ return -1;
+ }
+ my $node_id = $self->node_id();
+ return 0
+ if (!defined($node_id));
+ my $node = Node->Lookup($node_id);
+ if (!defined($node)) {
+ print STDERR "Could not map node $node_id to its object\n";
+ return -1;
+ }
+ my $reservation = $node->Reservation();
+ if (!defined($reservation)) {
+ print STDERR "$node was already released from $self\n";
+ return -1;
+ }
+ if ($reservation->SameExperiment($experiment)) {
+ if ($experiment->InsertVirtNode($node) != 0) {
+ print STDERR "Could not add virtnode entry for $node to $self\n";
+ return -1;
+ }
+ }
+ else {
+ print STDERR "$node is reserved to another, not $self\n";
+ # Signal error so we can look at what happened.
+ return -1;
+ }
return 0;
}
@@ -189,20 +253,83 @@ sub UnProvision($)
if (! ref($self));
my $experiment = Experiment->Lookup($self->slice_uuid());
+ if (!defined($experiment)) {
+ print STDERR "Could not map $self to its experiment\n";
+ return -1;
+ }
my $node_id = $self->node_id();
+ return 0
+ if (!defined($node_id));
my $node = Node->Lookup($node_id);
- return -1
- if (!defined($node));
- my $reservation = Node->Reservation();
-
- if (defined($reservation) && $reservation->SameExperiment($experiment)) {
+ if (!defined($node)) {
+ print STDERR "Could not map node $node_id to its object\n";
+ return -1;
+ }
+ my $reservation = $node->Reservation();
+ if (!defined($reservation)) {
+ print STDERR "$node was already released from $self\n";
+ return 0;
+ }
+ if ($reservation->SameExperiment($experiment)) {
my $pid = $experiment->pid();
my $eid = $experiment->eid();
- system("$NFREE $pid $eid $node_id");
+ system("export NORELOAD=1; $NFREE -q $pid $eid $node_id");
+ if ($?) {
+ print STDERR "Could not deallocate $node from $self\n";
+ return -1;
+ }
+ }
+ else {
+ print STDERR "$node is reserved to another, not $self\n";
+ # Signal error so we can look at what happened.
+ return -1;
+ }
+ return 0;
+}
+
+#
+# Start a slice, which roughly translates to reboot the node.
+#
+sub Start($)
+{
+ my ($self) = @_;
+
+ return -1
+ if (! ref($self));
+
+ my $experiment = Experiment->Lookup($self->slice_uuid());
+ if (!defined($experiment)) {
+ print STDERR "Could not map $self to its experiment\n";
+ return -1;
+ }
+ my $node_id = $self->node_id();
+ return 0
+ if (!defined($node_id));
+ my $node = Node->Lookup($node_id);
+ if (!defined($node)) {
+ print STDERR "Could not map node $node_id to its object\n";
+ return -1;
+ }
+ my $reservation = $node->Reservation();
+ if (!defined($reservation)) {
+ print STDERR "$node was already released from $self\n";
+ return -1;
+ }
+ if ($reservation->SameExperiment($experiment)) {
+ #
+ # Reboot and wait?
+ #
+ #system("$NODEREBOOT $node_id");
+ }
+ else {
+ print STDERR "$node is reserved to another, not $self\n";
+ # Signal error so we can look at what happened.
+ return -1;
}
return 0;
}
+
# _Always_ make sure that this 1 is at the end of the file...
1;
diff --git a/protogeni/lib/GeniTicket.pm.in b/protogeni/lib/GeniTicket.pm.in
index 3e29f903e7be7a78b85489746df1569fb079ec28..19a9fd4a024366de8f3d778b3b857bdd6f40480a 100644
--- a/protogeni/lib/GeniTicket.pm.in
+++ b/protogeni/lib/GeniTicket.pm.in
@@ -37,6 +37,7 @@ my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "https://boss/protogeni/xmlrpc";
my $SIGNCRED = "$TB/sbin/signgenicred";
+my $VERIFYCRED = "$TB/sbin/verifygenicred";
my $NFREE = "$TB/bin/nfree";
#
@@ -78,6 +79,19 @@ sub CreateFromSignedTicket($$)
{
my ($class, $ticket_string) = @_;
+ # First verify the ticket.
+ my ($fh, $filename) = tempfile(UNLINK => 0);
+ return undef
+ if (!defined($fh));
+ print $fh $ticket_string;
+ close($fh);
+ system("$VERIFYCRED $filename");
+ if ($?) {
+ print STDERR "Ticket in $filename did not verify\n";
+ return undef;
+ }
+ unlink($filename);
+
# Use XML::Simple to convert to something we can mess with.
my $parser = XML::LibXML->new;
my $doc = $parser->parse_string($ticket_string);
@@ -142,8 +156,6 @@ sub CreateFromSignedTicket($$)
$self->{'idx'} = $serial;
bless($self, $class);
- print Dumper($self);
-
return $self;
}
@@ -182,8 +194,9 @@ sub Grant($$)
}
#
-# Store the given ticket in the DB. We only do this for signed tickets
-# which we hand out, so we have a record of them.
+# Store the given ticket in the DB. We only do this for signed tickets,
+# so we have a record of them. We store them on the server and the client
+# side.
#
sub Store($$)
{
@@ -267,12 +280,16 @@ sub Sign($)
while (<SIGNER>) {
$ticket .= $_;
}
- close(SIGNER);
+ if (!close(SIGNER)) {
+ print STDERR "Could not sign $filename\n";
+ return -1;
+ }
$self->{'ticket_string'} = $ticket;
$self->Store($idx) == 0
or return -1;
+ unlink($filename);
return 0;
}
diff --git a/protogeni/lib/test.pl.in b/protogeni/lib/test.pl.in
index 389484f95c21d5aebafbde23fd48d452402429fa..dc1274449f13048116cdacd1a54ec8918d07e515 100644
--- a/protogeni/lib/test.pl.in
+++ b/protogeni/lib/test.pl.in
@@ -30,11 +30,18 @@ GeniCMClient::GetTicket($experiment, $resources->[0], $rspec, \$ticket);
open(T, "> /tmp/T");
print T $ticket->asString();
close(T);
-
exit(0);
-if ($ticket) {
+
+if (defined($ticket)) {
GeniCMClient::CreateSliver($experiment, $ticket, \$sliver);
}
+# Wait for input before proceeding.
+$_ = <STDIN>;
+
+if (defined($sliver)) {
+ print $sliver . "\n";
+ GeniCMClient::DestroySliver($experiment, $sliver);
+}
diff --git a/protogeni/xmlrpc/Genixmlrpc.pm.in b/protogeni/xmlrpc/Genixmlrpc.pm.in
index a57956492a12fc65e32b5a75ed11b45e952c24a0..5c4f2cc342ae4a37a3efc3b3b427cff492b1ae96 100644
--- a/protogeni/xmlrpc/Genixmlrpc.pm.in
+++ b/protogeni/xmlrpc/Genixmlrpc.pm.in
@@ -30,16 +30,10 @@ use Data::Dumper;
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
+my $EMULAB_PEMFILE = "@prefix@/etc/server.pem";
my $debug = 1;
-#
-# This is for the Crypt::SSL library, many levels down. It appears to
-# be the only way to specify this.
-#
-$ENV{'HTTPS_CERT_FILE'} = "@prefix@/etc/server.pem";
-$ENV{'HTTPS_KEY_FILE'} = "@prefix@/etc/server.pem";
-
##
# The package version number
#
@@ -63,9 +57,29 @@ my $PACKAGE_VERSION = 0.1;
# If there was an HTTP error, the hash also contains the keys
# httpcode and httpmsg.
#
-sub CallMethodHTTP($$@)
+sub CallMethodHTTP($$$@)
{
- my ($httpURL,$method,@args) = @_;
+ my ($httpURL, $user, $method, @args) = @_;
+
+ #
+ # This is for the Crypt::SSL library, many levels down. It appears to
+ # be the only way to specify this. Even worse, when we want to use
+ # an encrypted key belonging to a user, have to use the pkcs12 format
+ # of the file, since that is the only format for which we can provide
+ # the passphrase.
+ #
+ if (!defined($user)) {
+ $ENV{'HTTPS_CERT_FILE'} = $EMULAB_PEMFILE;
+ $ENV{'HTTPS_KEY_FILE'} = $EMULAB_PEMFILE;
+ }
+ else {
+ my $pkcs12 = $user->HomeDir() . "/.ssl/encrypted.p12";
+ my $password;
+ $user->SSLPassPhrase(1,\$password);
+ $ENV{'HTTPS_PKCS12_FILE'} = $pkcs12;
+ $ENV{'HTTPS_PKCS12_PASSWORD'} = $password;
+ print "$password, $pkcs12\n";
+ }
my $request = new RPC::XML::request($method, @args);
if ($debug) {
diff --git a/protogeni/xmlrpc/protogeni-client.pl.in b/protogeni/xmlrpc/protogeni-client.pl.in
index f511e2277ac866ba69286aace12596dec10ea670..914fff2737eccd5ebc80f115ee8001037af5b913 100644
--- a/protogeni/xmlrpc/protogeni-client.pl.in
+++ b/protogeni/xmlrpc/protogeni-client.pl.in
@@ -21,7 +21,7 @@ my $server = shift(@ARGV);
my $method = shift(@ARGV);
my $response =
- Genixmlrpc::CallMethodHTTP("https://$server/protogeni/xmlrpc",
+ Genixmlrpc::CallMethodHTTP("https://$server/protogeni/xmlrpc", undef,
$method, @ARGV);
print Dumper($response);
diff --git a/protogeni/xmlrpc/protogeni-cm.pl.in b/protogeni/xmlrpc/protogeni-cm.pl.in
index eb63373450b3630c6ba5350ea38896df6079515e..d23ba6d809982c150c2b2d01433c32baec962276 100644
--- a/protogeni/xmlrpc/protogeni-cm.pl.in
+++ b/protogeni/xmlrpc/protogeni-cm.pl.in
@@ -56,6 +56,22 @@ $EUID = $UID = $unix_uid;
$ENV{'USER'} = $user;
$ENV{'LOGNAME'} = $user;
+#
+# The UUID of the client certificate is in the env var SSL_CLIENT_S_DN_CN.
+# If it actually looks like a UUID, then this correponds to an actual user,
+# and the supplied credentials/tickets must match. At present, if there is
+# no UUID, it is another emulab making a request directly, with no user
+# context, and we just let that pass for now.
+#
+if (exists($ENV{'SSL_CLIENT_S_DN_CN'}) &&
+ $ENV{'SSL_CLIENT_S_DN_CN'} =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
+ $ENV{'GENIUSER'} = $ENV{'SSL_CLIENT_S_DN_CN'};
+}
+else {
+ delete($ENV{'GENIUSER'})
+ if (exists($ENV{'GENIUSER'}));
+}
+
#
# Use libaudit to capture any output from libraries and programs.
# Send that to tbops so they can be fixed.
@@ -69,6 +85,7 @@ my $responder = Frontier::Responder->new( "methods" => {
"SA::DiscoverResources" => \&Protogeni::SA::DiscoverResources,
"CM::GetTicket" => \&GeniCM::GetTicket,
"CM::CreateSliver" => \&GeniCM::CreateSliver,
+ "CM::DestroySliver" => \&GeniCM::DestroySliver,
"add" => \&Protogeni::add,
},
);