Commit 48d5feb4 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint

parent 5059ed9d
......@@ -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
test.pl GeniTicket.pm
#
# Force dependencies on the scripts so that they will be rerun through
......
......@@ -21,6 +21,8 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
use libtestbed;
use English;
use Data::Dumper;
......@@ -34,3 +36,41 @@ my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "https://boss/protogeni/xmlrpc";
#
# Respond to a GetTicket request. No worries about credentials yet; we
# trust the caller cause it got past the SSL client verify checks in the
# web server.
#
sub GetTicket($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'uuid'};
my $rspec = $argref->{'rspec'};
if (! (defined($slice_uuid) && ($slice_uuid =~ /^[-\w]+$/))) {
return GeniResponse->MalformedArgsResponse();
}
if (! defined($rspec)) {
return GeniResponse->MalformedArgsResponse();
}
#
# An rspec is a structure with a node count. :-)
#
# Find out how many nodes are available and grant that many. Silly, eh?
#
$rspec->{'granted'} = $rspec->{'requested'};
#
# Return a signed ticket.
#
my $ticket = GeniTicket->Create($slice_uuid, $rspec);
if (!defined($ticket)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniTicket object");
}
if ($ticket->Sign() != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not sign Ticket");
}
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->ticket());
}
......@@ -21,6 +21,8 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
use libtestbed;
use English;
use Data::Dumper;
......@@ -41,14 +43,61 @@ my $GENICENTRAL = "https://boss/protogeni/xmlrpc";
# lets not worry about that; just get a list of all components we can ask
# for resources from.
#
sub DiscoverResources($)
sub DiscoverResources($$)
{
my ($experiment) = @_;
my ($experiment, $pref) = @_;
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRAL, "SA::DiscoverResources",
{ "uuid" => $experiment->uuid() });
return -1
if (!defined($response));
#print Dumper($response);
return -1
if ($response->code() != GENIRESPONSE_SUCCESS);
$$pref = $response->value();
return 0;
}
#
# 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, $requested, $pref) = @_;
my $rspec = { "requested" => $requested,
"granted" => 0};
my $response =
Genixmlrpc::CallMethodHTTP($component, "CM::GetTicket",
{ "uuid" => $experiment->uuid(),
"rspec" => $rspec });
return -1
if (!defined($response));
print Dumper($response);
return $response->code();
return -1
if ($response->code() != GENIRESPONSE_SUCCESS);
#
# Convert this into a (signed) ticket object.
#
my $ticket = GeniTicket->Create($experiment->uuid(), $rspec,
$response->value());
$$pref = $ticket;
return 0;
}
......@@ -86,3 +86,17 @@ sub RegisterSlice($)
print Dumper($response);
return $response->code();
}
#
# Delete a slice registration.
#
sub DeleteSlice($)
{
my ($experiment) = @_;
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRAL, "SA::DeleteSlice",
{ "uuid" => $experiment->uuid()});
return $response->code();
}
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniTicket;
#
# 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 English;
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";
#
# Create a ticket. Not much to it yet.
#
# Should we keep track of tickets locally in the DB?
#
sub Create($$$;$)
{
my ($class, $uuid, $rspec, $ticket) = @_;
my $self = {};
$self->{'rspec'} = $rspec;
$self->{'uuid'} = $uuid; # The slice UUID.
$self->{'ticket'} = $ticket;
bless($self, $class);
return $self;
}
# accessors
sub field($$) { return ($_[0]->{$_[1]}); }
sub rspec($) { return field($_[0], "rspec"); }
sub uuid($) { return field($_[0], "uuid"); }
sub ticket($) { return field($_[0], "ticket"); }
#
# Populate the ticket with some stuff, which right now is just the
# number of node we are willing to grant.
#
sub Grant($$)
{
my ($self, $count) = @_;
return 0
if (! ref($self));
$self->{'count'} = $count;
return 0;
}
#
# Sign the ticket before returning it. We capture the output, which is
# in XML.
#
sub Sign($)
{
my ($self) = @_;
return -1
if (!ref($self));
my $uuid = $self->uuid();
my $requested = $self->rspec()->{'requested'};
my $granted = $self->rspec()->{'granted'};
#
# 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>ticket</type>\n".
" <owner_uuid>$uuid</owner_uuid>\n".
" <this_uuid>$uuid</this_uuid>\n".
" <ticket>\n".
" <can_delegate>1</can_delegate>\n".
" <rspec>\n".
" <requested>$requested</requested>\n".
" <granted>$granted</granted>\n".
" </rspec>\n".
" </ticket>\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 ticket
# that is returned.
#
if (! open(SIGNER, "$SIGNCRED $filename |")) {
print STDERR "Could not sign $filename\n";
return -1;
}
my $ticket = "";
while (<SIGNER>) {
$ticket .= $_;
}
close(SIGNER);
$self->{'ticket'} = $ticket;
return 0;
}
......@@ -259,7 +259,7 @@ sub DiscoverResources($)
while (my ($url) = $query_result->fetchrow_array()) {
push(@results, $url);
}
return GeniResponse->Create(GENIRESPONSE_SUCCESS, @results);
return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}
# _Always_ make sure that this 1 is at the end of the file...
......
......@@ -167,7 +167,13 @@ if (@ARGV) {
# Map invoking user to object.
my $this_user = User->LookupByUnixId($UID);
if (! defined($this_user)) {
fatal("You ($UID) do not exist!");
#
# We allow this script to run from the web interface as nobody,
# as when invoked via an xmlrpc request.
#
if (getpwuid($UID) ne "nobody") {
fatal("You ($UID) do not exist!");
}
}
#
......@@ -185,7 +191,15 @@ if (0 && AuditStart(0)) {
# might already be a signed credential and we just need to add another
# signature to it, but either way it should still pass the schema check.
#
if (system("$XMLLINT -noout -schema $SCHEMA $capfile")) {
my $xmlint_output = "";
open(TMP, "$XMLLINT -noout -schema $SCHEMA $capfile 2>&1 |")
or fatal("Could not start $XMLLINT on $capfile");
while(<TMP>) {
$xmlint_output .= $_;
}
if (!close(TMP)) {
print $xmlint_output;
fatal("$capfile does not conform to schema $SCHEMA");
}
......
......@@ -24,6 +24,7 @@ use RPC::XML::Parser;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use HTTP::Headers;
use Data::Dumper;
# Configure variables
my $TB = "@prefix@";
......@@ -88,8 +89,8 @@ sub CallMethodHTTP($$@)
}
if (!$hresp->is_success()) {
return GeniResponse->Create(GENIRESPONSE_RPCERROR,
$hresp->code(), $hresp->message());
return GeniResponse->new(GENIRESPONSE_RPCERROR,
$hresp->code(), $hresp->message());
}
#
......@@ -108,6 +109,8 @@ sub CallMethodHTTP($$@)
my $parser = RPC::XML::Parser->new();
my $goo = $parser->parse($xmlgoo);
my ($value,$output,$code);
#print Dumper($goo);
# Python servers seem to return faults in structs, not as <fault> elements.
# Sigh.
......@@ -123,12 +126,9 @@ sub CallMethodHTTP($$@)
$output = $goo->value()->{"faultString"}->value;
}
else {
$code = 0;
$value = $goo->value;
if (ref($value)) {
$value = $value->value;
}
$output = $value;
$code = $goo->value()->{'code'}->value;
$value = $goo->value()->{'value'}->value;
$output = $goo->value()->{'output'}->value;
}
return GeniResponse->new($code, $value, $output);
}
......
......@@ -16,6 +16,8 @@ use Frontier::Responder;
# Testbed libraries.
use lib '@prefix@/lib';
use Protogeni;
use GeniCM;
use libaudit;
#
# Turn off line buffering on output
......@@ -28,6 +30,12 @@ $| = 1;
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Use libaudit to capture any output from libraries and programs.
# Send that to tbops so they can be fixed.
#
LogStart(0);
#
# The UUID of the client certificate is in the env var SSL_CLIENT_S_DN_CN.
#
......@@ -36,8 +44,18 @@ my $responder = Frontier::Responder->new( "methods" => {
"SA::RegisterUser" => \&Protogeni::SA::RegisterUser,
"SA::RegisterSlice" => \&Protogeni::SA::RegisterSlice,
"SA::DiscoverResources" => \&Protogeni::SA::DiscoverResources,
"CM::GetTicket" => \&GeniCM::GetTicket,
"add" => \&Protogeni::add,
},
);
print $responder->answer();
my $response = $responder->answer();
#
# Terminate the log capture so that we can print the response to STDOUT
# for the web server.
#
LogEnd();
print $response;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment