Skip to content
GitLab
Commit a8018a42 authored by Leigh B. Stoller's avatar Leigh B. Stoller
Browse files

Oh, I figure its time to checkpoint ...

parent 085fabba
Expand all Hide whitespace changes
Inline Side-by-side
protogeni/lib/GNUmakefile.in
View file @ a8018a42
......@@ -13,24 +13,31 @@ 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 \
GeniTicket.pm GeniSliver.pm GeniCredential.pm \
GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
node.pl
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
SCRIPTS = test.pl node.pl test2.pl addauthority
OPS_LIBS = GeniCMClient.pm GeniSAClient.pm GeniCHClient.pm
#
# Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed.
#
all: $(LIB_SCRIPTS)
all: $(LIB_SCRIPTS) $(SCRIPTS)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_LIBDIR)/, $(LIB_SCRIPTS))
install: $(addprefix $(INSTALL_LIBDIR)/, $(LIB_SCRIPTS)) \
$(addprefix $(INSTALL_DIR)/opsdir/lib/, $(OPS_LIBS))
control-install:
clean:
rm -f *.o core $(LIB_SCRIPTS)
$(INSTALL_DIR)/opsdir/lib/%: %
@echo "Installing $<"
-mkdir -p $(INSTALL_DIR)/opsdir/lib
$(INSTALL) $< $@
protogeni/lib/GeniAggregate.pm.in
View file @ a8018a42
......@@ -493,7 +493,6 @@ use vars qw(@ISA);
@ISA = "GeniAggregate";
use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
......@@ -617,6 +616,33 @@ sub UnProvision($)
return 0;
}
#
# Nothing to do yet.
#
sub Start($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0;
}
#
# Nothing to do yet.
#
sub Stop($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
protogeni/lib/GeniAuthority.pm.in
View file @ a8018a42
......@@ -52,13 +52,22 @@ sub Lookup($$)
}
elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
$query_result =
DBQueryWarn("select idx from geni_sliceauthorities ".
DBQueryWarn("select idx from geni_authorities ".
"where uuid='$token'");
return undef
if (! $query_result || !$query_result->numrows);
($idx) = $query_result->fetchrow_array();
}
elsif ($token =~ /^[\w\.]*$/) {
$query_result =
DBQueryWarn("select idx from geni_authorities ".
"where hrn='$token'");
return undef
if (! $query_result || !$query_result->numrows);
($idx) = $query_result->fetchrow_array();
}
else {
return undef;
}
......@@ -67,7 +76,7 @@ sub Lookup($$)
if (exists($authorities{"$idx"}));
$query_result =
DBQueryWarn("select * from geni_sliceauthorities where idx='$idx'");
DBQueryWarn("select * from geni_authorities where idx='$idx'");
return undef
if (!$query_result || !$query_result->numrows);
......@@ -80,14 +89,12 @@ sub Lookup($$)
# 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) {
my $certificate = GeniCertificate->Lookup($uuid);
if (!defined($certificate)) {
print STDERR "Could not find certificate for authority $idx\n";
return undef;
}
my ($cert) = $query_result->fetchrow_array();
$self->{'AUTHORITY'}->{'cert'} = $cert;
$self->{'CERT'} = $certificate;
# Add to cache.
$authorities{$self->{'AUTHORITY'}->{'idx'}} = $self;
......@@ -113,7 +120,7 @@ sub Stringify($)
#
sub Create($$$$$$)
{
my ($class, $uuid, $hrn, $url, $cert, $prefix) = @_;
my ($class, $uuid, $hrn, $url, $cert, $prefix, $type) = @_;
my @insert_data = ();
my $idx = TBGetUniqueIndex('next_authority', 1);
......@@ -123,6 +130,7 @@ sub Create($$$$$$)
my $safe_uuid = DBQuoteSpecial($uuid);
my $safe_cert = DBQuoteSpecial($cert);
my $safe_prefix = DBQuoteSpecial($prefix);
my $safe_type = DBQuoteSpecial($type);
# Now tack on other stuff we need.
push(@insert_data, "created=now()");
......@@ -131,16 +139,17 @@ sub Create($$$$$$)
push(@insert_data, "url=$safe_url");
push(@insert_data, "uuid=$safe_uuid");
push(@insert_data, "uuid_prefix=$safe_prefix");
push(@insert_data, "type=$safe_type");
# Insert into DB.
DBQueryWarn("replace into geni_sliceauthorities set " .
DBQueryWarn("replace into geni_authorities 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'");
DBQueryWarn("delete from geni_authorities where idx='$idx'");
return undef;
}
......@@ -153,7 +162,9 @@ 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"); }
sub type($) { return field($_[0], "type"); }
sub cert($) { return $_[0]->{'CERT'}->cert(); }
sub GetCertificate($) { return $_[0]->{'CERT'}; }
#
# Does the uuid prefix match.
......
protogeni/lib/GeniCH.pm.in
View file @ a8018a42
This diff is collapsed.
protogeni/lib/GeniCHClient.pm.in
View file @ a8018a42
......@@ -20,37 +20,88 @@ use vars qw(@ISA @EXPORT);
# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use User;
use libtestbed;
use English;
use Data::Dumper;
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.myelab.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch";
#
# Lookup a user at the clearing house.
# Context for making calls to the clearinghouse. Opaque to this module.
#
sub LookupUser($$)
my $MyContext;
#
# Set the context for subsequent calls made to the clearing house.
#
sub SetContext($$)
{
my ($uuid, $pref) = @_;
my ($class, $context) = @_;
$MyContext = $context;
return 0;
}
#
# Our credential for talking to the clearinghouse. Should be cached
# but currently asking for a new one each time.
#
my $Credential;
sub SetCredential()
{
return
if (defined($Credential));
GetCredential(undef, undef, undef, \$Credential) == 0
or die("Could not get our CH credential from the clearinghouse.\n");
}
#
# Ask the clearing house for a credential.
#
sub GetCredential($$$$)
{
my ($credential, $uuid, $type, $pref) = @_;
my %args = ();
$args{'credential'} = $credential
if (defined($credential));
$args{'uuid'} = $uuid
if (defined($uuid));
$args{'type'} = $type
if (defined($type));
my $response =
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"GetCredential", \%args);
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
$$pref = $response->value();
return 0;
}
#
# Lookup a record at the clearing house.
#
sub Resolve($$$)
{
my ($uuid, $type, $pref) = @_;
$$pref = undef;
SetCredential();
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::LookupUser",
{ "uuid" => $uuid });
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Resolve",
{ "credential" => $Credential,
"type" => $type,
"uuid" => $uuid });
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
......@@ -58,6 +109,16 @@ sub LookupUser($$)
return 0;
}
#
# Lookup a user at the clearing house.
#
sub LookupUser($$)
{
my ($uuid, $pref) = @_;
return Resolve($uuid, "User", $pref);
}
#
# Lookup a slice (experiment) at the clearing house.
#
......@@ -65,16 +126,28 @@ sub LookupSlice($$)
{
my ($uuid, $pref) = @_;
$$pref = undef;
return Resolve($uuid, "Slice", $pref);
}
#
# Register a record at the clearing house.
#
sub Register($$$$)
{
my ($hrn, $type, $cert, $info) = @_;
SetCredential();
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::LookupSlice",
{ "uuid" => $uuid });
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Register",
{ "credential" => $Credential,
"type" => $type,
"hrn" => $hrn,
"cert" => $cert,
"info" => $info });
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
$$pref = $response->value();
return 0;
}
......@@ -82,43 +155,44 @@ sub LookupSlice($$)
# Register a local Emulab user at the Geni ClearingHouse (which in the
# prototype is Utah Emulab).
#
sub RegisterUser($$$$$$)
sub RegisterUser($$$$$)
{
my ($hrn, $uuid, $name, $email, $cert, $sshkey) = @_;
my $args = { "hrn" => $hrn,
"uuid" => $uuid,
"name" => $name,
"email" => $email,
"cert" => $cert};
$args->{"sshkey"} = $sshkey
my ($hrn, $name, $email, $cert, $sshkey) = @_;
my $info = { "name" => $name,
"email" => $email };
$info->{"sshkey"} = $sshkey
if (defined($sshkey));
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::RegisterUser", $args);
return Register($hrn, "User", $cert, $info);
}
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
#
# Register a slice at the Clearinghouse.
#
sub RegisterSlice($$$)
{
my ($hrn, $creator_uuid, $cert) = @_;
my $info = { "creator_uuid" => $creator_uuid };
return Register($hrn, "Slice", $cert, $info);
}
#
# Register a local Emulab experiment at the Clearinghouse, as a slice.
# Remove a record at the clearing house.
#
sub RegisterSlice($$$$)
sub Remove($$)
{
my ($hrn, $uuid, $creator_uuid, $cert) = @_;
my ($type, $uuid) = @_;
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::CreateSliceName",
{ "hrn" => $hrn,
"uuid" => $uuid,
"creator_uuid" => $creator_uuid,
"cert" => $cert });
SetCredential();
my $response =
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Remove",
{ "credential" => $Credential,
"type" => $type,
"uuid" => $uuid });
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
......@@ -128,19 +202,11 @@ sub RegisterSlice($$$$)
#
# Delete a slice registration.
#
sub DeleteSlice($)
sub RemoveSlice($)
{
my ($uuid) = @_;
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::FreeSliceName",
{ "uuid" => $uuid });
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
return Remove("Slice", $uuid);
}
#
......@@ -155,7 +221,7 @@ sub DiscoverResources($$)
my ($slice, $pref) = @_;
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::DiscoverResources",
{ "slice" => $slice->cert() });
......@@ -165,32 +231,7 @@ sub DiscoverResources($$)
return -1
if ($response->code() != GENIRESPONSE_SUCCESS);
#
# We get back a list of components right now, which we cache locally.
#
my @result = ();
foreach my $ref (@{ $response->value() }) {
my $uuid = $ref->{'uuid'};
my $url = $ref->{'url'};
my $hrn = $ref->{'hrn'};
my $cert = $ref->{'cert'};
my $component = GeniComponent->Lookup($uuid);
if (!defined($component)) {
$component = GeniComponent->Create($uuid, $hrn, $url, $cert);
if (!defined($component)) {
return GeniResponse->Create(GENIRESPONSE_DBERROR);
}
}
elsif ($url ne $component->url() ||
$hrn ne $component->hrn()) {
$component->Update({"url" => $url, "hrn" => $hrn}) == 0 or
return GeniResponse->Create(GENIRESPONSE_DBERROR);
}
push(@result, $component);
}
@$pref = @result;
$$pref = $response->value();
return 0;
}
......@@ -205,7 +246,7 @@ sub BindUser($$)
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::BindUser", $args);
return -1
......@@ -221,7 +262,7 @@ sub UnBindUser($$)
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::UnBindUser", $args);
return -1
......@@ -230,3 +271,5 @@ sub UnBindUser($$)
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
protogeni/lib/GeniCM.pm.in
View file @ a8018a42
......@@ -27,6 +27,7 @@ use GeniCredential;
use GeniCertificate;
use GeniSlice;
use GeniAggregate;
use GeniAuthority;
use GeniSliver;
use GeniUser;
use libtestbed;
......@@ -179,7 +180,7 @@ sub GetTicket($)
#
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
$slice = GeniSlice->CreateFromRegistry($slice_uuid);
$slice = CreateSliceFromRegistry($slice_uuid);
if (!defined($slice)) {
print STDERR "No slice $slice_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
......@@ -187,7 +188,7 @@ sub GetTicket($)
}
}
else {
$slice->UpdateFromRegistry() == 0 or
UpdateSliceFromRegistry($slice) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not update slice info from ClearingHouse");
}
......@@ -197,7 +198,7 @@ sub GetTicket($)
#
my $user = GeniUser->Lookup($owner_uuid);
if (!defined($user)) {
$user = GeniUser->CreateFromRegistry($owner_uuid);
$user = CreateUserFromRegistry($owner_uuid);
if (!defined($user)) {
print STDERR "No user $owner_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
......@@ -606,3 +607,133 @@ sub DestroySliver($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
#
# Utility Routines.
#
# Create a slice from the ClearingHouse, by looking up the info.
#
sub CreateSliceFromRegistry($)
{
my ($slice_uuid) = @_;
my $blob;
return undef
if (GeniCHClient::LookupSlice($slice_uuid, \$blob) != 0);
my $authority = GeniAuthority->Lookup($blob->{'sa_uuid'});
if (!defined($authority)) {
$authority = CreateAuthorityFromRegistry($blob->{'sa_uuid'});
if (!defined($authority)) {
print STDERR "Could not create new authority record\n";
return undef;
}
}
my $slice = GeniSlice->Create($blob->{'hrn'},
$blob->{'uuid'},
$blob->{'creator_uuid'},
$blob->{'cert'}, $authority);
return undef
if (!defined($slice));
# Add the user bindings.
foreach my $uuid (@{ $blob->{'userbindings'} }) {
my $user = GeniUser->Lookup($uuid);
if (!defined($user)) {
$user = CreateUserFromRegistry($uuid);
if (!defined($user)) {
print STDERR "No user $uuid in the ClearingHouse\n";
next;
}
}
DBQueryWarn("replace into geni_bindings set ".
" created=now(), slice_uuid='$slice_uuid', ".
" user_uuid='$uuid'")
or print STDERR
"Could not insert user binding for $uuid to slice $slice_uuid\n";
}
return $slice;
}
#
# Update slice from the ClearingHouse, by looking up the info.
#
sub UpdateSliceFromRegistry($)
{
my ($slice) = @_;
my $slice_uuid = $slice->uuid();
my $blob;
return -1
if (GeniCHClient::LookupSlice($slice_uuid, \$blob) != 0);
DBQueryWarn("delete from geni_bindings ".
"where slice_uuid='$slice_uuid'")
or print STDERR
"Could not delete user bindings from slice $slice_uuid\n";
# Add the user bindings.
foreach my $uuid (@{ $blob->{'userbindings'} }) {
my $user = GeniUser->Lookup($uuid);
if (!defined($user)) {
$user = CreateUserFromRegistry($uuid);
if (!defined($user)) {
print STDERR "No user $uuid in the ClearingHouse\n";
next;
}
}
DBQueryWarn("replace into geni_bindings set ".
" created=now(), slice_uuid='$slice_uuid', ".
" user_uuid='$uuid'")
or print STDERR
"Could not insert user binding for $uuid to slice $slice_uuid\n";
}
return 0;
}
#
# Create a user from the ClearingHouse, by looking up the info.
#
sub CreateUserFromRegistry($)
{
my ($uuid) = @_;
my $blob;
return undef
if (GeniCHClient::LookupUser($uuid, \$blob) != 0);