Commit 58d825e3 authored by Leigh Stoller's avatar Leigh Stoller

Checkpoint

parent 85777f5c
......@@ -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
......
......@@ -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);
}
......@@ -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;
}
#!/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;
......@@ -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;
......@@ -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