From bce3d5d8a66a2017fdf368e28b2234f95bb04e9e Mon Sep 17 00:00:00 2001 From: "Leigh B. Stoller" Date: Mon, 28 Apr 2008 15:12:30 +0000 Subject: [PATCH] Checkpoint --- protogeni/lib/GeniSAClient.pm.in | 44 +++++++ protogeni/lib/GeniUser.pm.in | 38 +++++- protogeni/lib/Protogeni.pm.in | 56 ++++++++- protogeni/xmlrpc/GNUmakefile.in | 7 +- protogeni/xmlrpc/Genixmlrpc.pm.in | 155 ++++++++++++++++++++++++ protogeni/xmlrpc/protogeni-client.pl.in | 29 +++++ protogeni/xmlrpc/protogeni-cm.pl.in | 3 +- 7 files changed, 320 insertions(+), 12 deletions(-) create mode 100644 protogeni/lib/GeniSAClient.pm.in create mode 100644 protogeni/xmlrpc/Genixmlrpc.pm.in create mode 100644 protogeni/xmlrpc/protogeni-client.pl.in diff --git a/protogeni/lib/GeniSAClient.pm.in b/protogeni/lib/GeniSAClient.pm.in new file mode 100644 index 000000000..839e01f3b --- /dev/null +++ b/protogeni/lib/GeniSAClient.pm.in @@ -0,0 +1,44 @@ +#!/usr/bin/perl -wT +# +# EMULAB-COPYRIGHT +# Copyright (c) 2008 University of Utah and the Flux Group. +# All rights reserved. +# +package GeniSAClient; + +# +# The client side of the SA interface, used by Slice Authorities to +# invoke operations on Geni Central and on Slices (Components). +# + +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 vars qw(); + +# Configure variables +my $TB = "@prefix@"; +my $TBOPS = "@TBOPSEMAIL@"; +my $TBAPPROVAL = "@TBAPPROVALEMAIL@"; +my $TBAUDIT = "@TBAUDITEMAIL@"; +my $BOSSNODE = "@BOSSNODE@"; +my $CONTROL = "@USERNODE@"; +my $OURDOMAIN = "@OURDOMAIN@"; + +# +# Register a user at the Geni ClearingHouse (which in the prototype is +# is Utah Emulab). +# +sub RegisterUser() +{ + +} diff --git a/protogeni/lib/GeniUser.pm.in b/protogeni/lib/GeniUser.pm.in index 0fe576b0b..eafcc98ca 100644 --- a/protogeni/lib/GeniUser.pm.in +++ b/protogeni/lib/GeniUser.pm.in @@ -92,6 +92,19 @@ sub name($) { return field($_[0], "name"); } sub email($) { return field($_[0], "email"); } sub sa_idx($) { return field($_[0], "sa_idx"); } +# +# Stringify for output. +# +sub Stringify($) +{ + my ($self) = @_; + + my $uid = $self->uid(); + my $uid_idx = $self->uid_idx(); + + return "[GeniUser: $uid, IDX: $uid_idx]"; +} + # # Lookup user given a UUID. # @@ -112,12 +125,33 @@ sub LookupByUUID($$) return GeniUser->Lookup($uid_idx); } +# +# Class method to check for an existing user that has the same +# uid/email. Lets not allow this for now. Return the number of +# users that match or -1 if an error. +# +sub CheckExisting($$$) +{ + my ($class, $uid, $email) = @_; + + my $safe_uid = DBQuoteSpecial($uid); + my $safe_email = DBQuoteSpecial($email); + + my $query_result = + DBQueryFatal("select uid_idx from geni_users ". + "where uid=$safe_uid and email=$safe_email"); + return -1 + if (!defined($query_result)); + + return $query_result->numrows; +} + # # Class function to create new Geni user and return object. # -sub Create($$$) +sub Create($$$$$) { - my ($class, $uid, $uuid, $name, $email, $sa_idx) = @_; + my ($class, $uid, $name, $email, $sa_idx) = @_; my @insert_data = (); # Every user gets a new unique index. diff --git a/protogeni/lib/Protogeni.pm.in b/protogeni/lib/Protogeni.pm.in index db110fd26..796c7bfa9 100644 --- a/protogeni/lib/Protogeni.pm.in +++ b/protogeni/lib/Protogeni.pm.in @@ -6,6 +6,12 @@ # package Protogeni; +# +# XXX: Permissions need to be worked on. Some of these interfaces are +# only valid for SAs and others are available to mere users (geni +# users of course). +# + use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK @@ -77,8 +83,10 @@ sub add ($$) } ############################################################################# -package Protogeni::User; -use emdbi; +# The Slice Authority interface for the Geni Clearinghouse. +# +package Protogeni::SA; +use GeniDB; use English; use User; use GeniUser; @@ -91,7 +99,7 @@ use GeniUser; # @param GID the GID of the user to lookup. # @return the public key bound to the user GID, or error if no user. # -sub LookupKey($) +sub Lookup($) { my ($uuid) = @_; @@ -101,9 +109,13 @@ sub LookupKey($) my $user = User->LookupByUUID($uuid); if (defined($user)) { # - # A local Emulab user. Return that key. - # - return Protogeni::MakeResponse(0, 2); + # A local Emulab user. Return the pubkey for the user. + # + my $cert; + if ($user->SSLCert(1, \$cert) != 0) { + return Protogeni::MakeResponse($Protogeni::RESPONSE_ERROR, ""); + } + return Protogeni::MakeResponse(0, $cert); } return Protogeni::BadArgsResponse("No such user for GID") if (!defined($user)); @@ -114,5 +126,37 @@ sub LookupKey($) return Protogeni::MakeResponse(0, 1); } +# +# Register a new Geni user in the DB. Returns the UUID (GUD). +# +sub Register($$$) +{ + my ($uid, $name, $email) = @_; + + if (! (defined($uid) && defined($name) && defined($email) && + $uid =~ /^ + + # + # XXX TODO! + # + # Who is the SA? We get this from the SSL environment (certificate). + # + my $sa_idx = 1; + + # + # XXX + # + # What kind of uniquess requirements do we need? No one else with this + # email address? Of course, we have to allow uid reuse, but should we + # require that for a given SA, that uid is unique, at least to avoid + # lots of confusion? + # + if (GeniUser->CheckExisting($uid, $name)) { + return Protogeni::MakeResponse($Protogeni::RESPONSE_ERROR, + "$uid/$email already registered"); + } +} + + # _Always_ make sure that this 1 is at the end of the file... 1; diff --git a/protogeni/xmlrpc/GNUmakefile.in b/protogeni/xmlrpc/GNUmakefile.in index 3eb5945c8..809ffe745 100644 --- a/protogeni/xmlrpc/GNUmakefile.in +++ b/protogeni/xmlrpc/GNUmakefile.in @@ -20,16 +20,17 @@ SETUID_LIBX_SCRIPTS = # Force dependencies on the scripts so that they will be rerun through # configure if the .in file is changed. # -all: protogeni.py protogeni-client.py protogeni.pl +all: protogeni.py protogeni-client.pl protogeni.pl Genixmlrpc.pm include $(TESTBED_SRCDIR)/GNUmakerules -install: $(INSTALL_DIR)/protogeni/xmlrpc/protogeni.pl +install: $(INSTALL_DIR)/protogeni/xmlrpc/protogeni.pl \ + $(INSTALL_LIBDIR)/Genixmlrpc.pm control-install: clean: - rm -f *.o core + rm -f *.o core *.pl *.pm *.py $(INSTALL_DIR)/protogeni/xmlrpc/%: % @echo "Installing $<" diff --git a/protogeni/xmlrpc/Genixmlrpc.pm.in b/protogeni/xmlrpc/Genixmlrpc.pm.in new file mode 100644 index 000000000..e7656adf1 --- /dev/null +++ b/protogeni/xmlrpc/Genixmlrpc.pm.in @@ -0,0 +1,155 @@ +#!/usr/bin/perl -w +# +# EMULAB-COPYRIGHT +# Copyright (c) 2008 University of Utah and the Flux Group. +# All rights reserved. +# +# Perl code to access an XMLRPC server using http. Derived from the +# Emulab library (pretty sure Dave wrote the http code in that file, +# and I'm just stealing it). +# +package Genixmlrpc; +use strict; +use Exporter; +use vars qw(@ISA @EXPORT); +@ISA = "Exporter"; +@EXPORT = qw (RESPONSE_SUCCESS RESPONSE_BADARGS RESPONSE_ERROR + RESPONSE_FORBIDDEN RESPONSE_BADVERSION RESPONSE_SERVERERROR + RESPONSE_TOOBIG RESPONSE_REFUSED RESPONSE_TIMEDOUT +); + +# Must come after package declaration! +use lib '@prefix@/lib'; +use English; +use RPC::XML; +use RPC::XML::Parser; +use LWP::UserAgent; +use HTTP::Request::Common qw(POST); +use HTTP::Headers; + +# Configure variables +my $TB = "@prefix@"; +my $TBOPS = "@TBOPSEMAIL@"; +my $BOSSNODE = "@BOSSNODE@"; + +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"; + +# +# GENI XMLRPC defs. Also see ../lib/Protogeni.pm.in if you change this. +# +sub RESPONSE_SUCCESS() { 0; } +sub RESPONSE_BADARGS() { 1; } +sub RESPONSE_ERROR() { 2; } +sub RESPONSE_FORBIDDEN() { 3; } +sub RESPONSE_BADVERSION() { 4; } +sub RESPONSE_SERVERERROR() { 5; } +sub RESPONSE_TOOBIG() { 6; } +sub RESPONSE_REFUSED() { 7; } +sub RESPONSE_TIMEDOUT() { 8; } + +## +# The package version number +# +my $PACKAGE_VERSION = 0.1; + +# +# This is the "structure" returned by the RPC server. It gets converted into +# a perl hash by the unmarshaller, and we return that directly to the caller +# (as a reference). +# +# class EmulabResponse: +# def __init__(self, code, value=0, output=""): +# self.code = code # A RESPONSE code +# self.value = value # A return value; any valid XML type. +# self.output = output # Pithy output to print +# return +# + +# +# Call to a non-Emulab xmlrpc server. +# If there was an HTTP error, the hash also contains the keys +# httpcode and httpmsg. +# +sub CallMethodHTTP($$@) +{ + my ($httpURL,$method,@args) = @_; + + my $request = new RPC::XML::request($method, @args); + if ($debug) { + print STDERR "xml request: " . $request->as_string(); + print STDERR "\n"; + } + + # + # Send an http post. + # + my $reqstr = $request->as_string(); + my $ua = LWP::UserAgent->new(); + my $hreq = HTTP::Request->new(POST => $httpURL); + $hreq->content_type('text/xml'); + $hreq->content($reqstr); + my $hresp = $ua->request($hreq); + + if ($debug) { + print STDERR "xml response: " . $hresp->as_string(); + print STDERR "\n"; + } + + if (!$hresp->is_success()) { + return { 'httpcode' => $hresp->code(), + 'httpmsg' => $hresp->message() }; + } + + # + # Read back the xmlgoo from the child. + # + my $xmlgoo = $hresp->content(); + + if ($debug) { + print STDERR "xmlgoo: " . $xmlgoo; + print STDERR "\n"; + } + + # + # Convert the xmlgoo to Perl and return it. + # + my $parser = RPC::XML::Parser->new(); + my $goo = $parser->parse($xmlgoo); + my ($value,$output,$code); + + # Python servers seem to return faults in structs, not as elements. + # Sigh. + if (!ref($goo)) { + print STDERR "Error in XMLRPC parse: $goo\n"; + return undef; + } + elsif ($goo->value()->is_fault() + || (ref($goo->value()) && UNIVERSAL::isa($goo->value(),"HASH") + && exists($goo->value()->{'faultCode'}))) { + $code = $goo->value()->{"faultCode"}->value; + $value = $code; + $output = $goo->value()->{"faultString"}->value; + } + else { + $code = 0; + $value = $goo->value; + if (ref($value)) { + $value = $value->value; + } + $output = $value; + } + return {"code" => $code, + "value" => $value, + "output" => $output}; +} + +# _Always_ make sure that this 1 is at the end of the file... + +1; diff --git a/protogeni/xmlrpc/protogeni-client.pl.in b/protogeni/xmlrpc/protogeni-client.pl.in new file mode 100644 index 000000000..f511e2277 --- /dev/null +++ b/protogeni/xmlrpc/protogeni-client.pl.in @@ -0,0 +1,29 @@ +#!/usr/bin/perl -w +# +# EMULAB-COPYRIGHT +# Copyright (c) 2008 University of Utah and the Flux Group. +# All rights reserved. +# +use strict; +use English; +use Data::Dumper; + +# +# Configure variables +# +my $TB = "@prefix@"; + +# Geni libraries. +use lib "@prefix@/lib"; +use Genixmlrpc; + +my $server = shift(@ARGV); +my $method = shift(@ARGV); + +my $response = + Genixmlrpc::CallMethodHTTP("https://$server/protogeni/xmlrpc", + $method, @ARGV); + +print Dumper($response); + + diff --git a/protogeni/xmlrpc/protogeni-cm.pl.in b/protogeni/xmlrpc/protogeni-cm.pl.in index a3a3515ba..86679e9f9 100644 --- a/protogeni/xmlrpc/protogeni-cm.pl.in +++ b/protogeni/xmlrpc/protogeni-cm.pl.in @@ -32,7 +32,8 @@ delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; # The UUID of the client certificate is in the env var SSL_CLIENT_S_DN_CN. # my $responder = Frontier::Responder->new( "methods" => { - "User::Lookup" => \&Protogeni::User::Lookup, + "SA::Lookup" => \&Protogeni::SA::Lookup, + "SA::Register" => \&Protogeni::SA::Register, "add" => \&Protogeni::add, }, ); -- GitLab