Commit a8018a42 authored by Leigh Stoller's avatar Leigh Stoller

Oh, I figure its time to checkpoint ...

parent 085fabba
...@@ -13,24 +13,31 @@ include $(OBJDIR)/Makeconf ...@@ -13,24 +13,31 @@ include $(OBJDIR)/Makeconf
LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \ LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.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 \ GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \ GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
node.pl
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 # Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed. # configure if the .in file is changed.
# #
all: $(LIB_SCRIPTS) all: $(LIB_SCRIPTS) $(SCRIPTS)
include $(TESTBED_SRCDIR)/GNUmakerules 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: control-install:
clean: clean:
rm -f *.o core $(LIB_SCRIPTS) rm -f *.o core $(LIB_SCRIPTS)
$(INSTALL_DIR)/opsdir/lib/%: %
@echo "Installing $<"
-mkdir -p $(INSTALL_DIR)/opsdir/lib
$(INSTALL) $< $@
...@@ -493,7 +493,6 @@ use vars qw(@ISA); ...@@ -493,7 +493,6 @@ use vars qw(@ISA);
@ISA = "GeniAggregate"; @ISA = "GeniAggregate";
use GeniDB; use GeniDB;
use GeniComponent;
use GeniSlice; use GeniSlice;
use GeniCredential; use GeniCredential;
use GeniCertificate; use GeniCertificate;
...@@ -617,6 +616,33 @@ sub UnProvision($) ...@@ -617,6 +616,33 @@ sub UnProvision($)
return 0; 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... # _Always_ make sure that this 1 is at the end of the file...
1; 1;
...@@ -52,13 +52,22 @@ sub Lookup($$) ...@@ -52,13 +52,22 @@ sub Lookup($$)
} }
elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) { elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
$query_result = $query_result =
DBQueryWarn("select idx from geni_sliceauthorities ". DBQueryWarn("select idx from geni_authorities ".
"where uuid='$token'"); "where uuid='$token'");
return undef return undef
if (! $query_result || !$query_result->numrows); if (! $query_result || !$query_result->numrows);
($idx) = $query_result->fetchrow_array(); ($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 { else {
return undef; return undef;
} }
...@@ -67,7 +76,7 @@ sub Lookup($$) ...@@ -67,7 +76,7 @@ sub Lookup($$)
if (exists($authorities{"$idx"})); if (exists($authorities{"$idx"}));
$query_result = $query_result =
DBQueryWarn("select * from geni_sliceauthorities where idx='$idx'"); DBQueryWarn("select * from geni_authorities where idx='$idx'");
return undef return undef
if (!$query_result || !$query_result->numrows); if (!$query_result || !$query_result->numrows);
...@@ -80,14 +89,12 @@ sub Lookup($$) ...@@ -80,14 +89,12 @@ sub Lookup($$)
# Grab the certificate, since we will probably want it. # Grab the certificate, since we will probably want it.
# #
my $uuid = $self->{'AUTHORITY'}->{'uuid'}; my $uuid = $self->{'AUTHORITY'}->{'uuid'};
$query_result = DBQueryWarn("select cert from geni_certificates ". my $certificate = GeniCertificate->Lookup($uuid);
"where uuid='$uuid'"); if (!defined($certificate)) {
if (!$query_result || !$query_result->numrows) {
print STDERR "Could not find certificate for authority $idx\n"; print STDERR "Could not find certificate for authority $idx\n";
return undef; return undef;
} }
my ($cert) = $query_result->fetchrow_array(); $self->{'CERT'} = $certificate;
$self->{'AUTHORITY'}->{'cert'} = $cert;
# Add to cache. # Add to cache.
$authorities{$self->{'AUTHORITY'}->{'idx'}} = $self; $authorities{$self->{'AUTHORITY'}->{'idx'}} = $self;
...@@ -113,7 +120,7 @@ sub Stringify($) ...@@ -113,7 +120,7 @@ sub Stringify($)
# #
sub Create($$$$$$) sub Create($$$$$$)
{ {
my ($class, $uuid, $hrn, $url, $cert, $prefix) = @_; my ($class, $uuid, $hrn, $url, $cert, $prefix, $type) = @_;
my @insert_data = (); my @insert_data = ();
my $idx = TBGetUniqueIndex('next_authority', 1); my $idx = TBGetUniqueIndex('next_authority', 1);
...@@ -123,6 +130,7 @@ sub Create($$$$$$) ...@@ -123,6 +130,7 @@ sub Create($$$$$$)
my $safe_uuid = DBQuoteSpecial($uuid); my $safe_uuid = DBQuoteSpecial($uuid);
my $safe_cert = DBQuoteSpecial($cert); my $safe_cert = DBQuoteSpecial($cert);
my $safe_prefix = DBQuoteSpecial($prefix); my $safe_prefix = DBQuoteSpecial($prefix);
my $safe_type = DBQuoteSpecial($type);
# Now tack on other stuff we need. # Now tack on other stuff we need.
push(@insert_data, "created=now()"); push(@insert_data, "created=now()");
...@@ -131,16 +139,17 @@ sub Create($$$$$$) ...@@ -131,16 +139,17 @@ sub Create($$$$$$)
push(@insert_data, "url=$safe_url"); push(@insert_data, "url=$safe_url");
push(@insert_data, "uuid=$safe_uuid"); push(@insert_data, "uuid=$safe_uuid");
push(@insert_data, "uuid_prefix=$safe_prefix"); push(@insert_data, "uuid_prefix=$safe_prefix");
push(@insert_data, "type=$safe_type");
# Insert into DB. # Insert into DB.
DBQueryWarn("replace into geni_sliceauthorities set " . DBQueryWarn("replace into geni_authorities set " .
join(",", @insert_data)) join(",", @insert_data))
or return undef; or return undef;
# Insert the certificate. # Insert the certificate.
if (!DBQueryWarn("replace into geni_certificates set ". if (!DBQueryWarn("replace into geni_certificates set ".
" uuid=$safe_uuid, cert=$safe_cert")) { " uuid=$safe_uuid, cert=$safe_cert")) {
DBQueryWarn("delete from geni_sliceauthorities where idx='$idx'"); DBQueryWarn("delete from geni_authorities where idx='$idx'");
return undef; return undef;
} }
...@@ -153,7 +162,9 @@ sub uuid($) { return field($_[0], "uuid"); } ...@@ -153,7 +162,9 @@ sub uuid($) { return field($_[0], "uuid"); }
sub uuid_prefix($) { return field($_[0], "uuid_prefix"); } sub uuid_prefix($) { return field($_[0], "uuid_prefix"); }
sub url($) { return field($_[0], "url"); } sub url($) { return field($_[0], "url"); }
sub hrn($) { return field($_[0], "hrn"); } 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. # Does the uuid prefix match.
......
This diff is collapsed.
...@@ -20,37 +20,88 @@ use vars qw(@ISA @EXPORT); ...@@ -20,37 +20,88 @@ use vars qw(@ISA @EXPORT);
# Must come after package declaration! # Must come after package declaration!
use lib '@prefix@/lib'; use lib '@prefix@/lib';
use GeniDB;
use Genixmlrpc; use Genixmlrpc;
use GeniResponse; use GeniResponse;
use User;
use libtestbed;
use English; use English;
use Data::Dumper; use Data::Dumper;
# Configure variables # 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 $GENICENTRAL = "myboss.myelab.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch"; 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; $$pref = undef;
SetCredential();
my $response = my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Resolve",
"CH::LookupUser", { "credential" => $Credential,
{ "uuid" => $uuid }); "type" => $type,
"uuid" => $uuid });
return -1 return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS); if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
...@@ -58,6 +109,16 @@ sub LookupUser($$) ...@@ -58,6 +109,16 @@ sub LookupUser($$)
return 0; 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. # Lookup a slice (experiment) at the clearing house.
# #
...@@ -65,16 +126,28 @@ sub LookupSlice($$) ...@@ -65,16 +126,28 @@ sub LookupSlice($$)
{ {
my ($uuid, $pref) = @_; 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 = my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Register",
"CH::LookupSlice", { "credential" => $Credential,
{ "uuid" => $uuid }); "type" => $type,
"hrn" => $hrn,
"cert" => $cert,
"info" => $info });
return -1 return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS); if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
$$pref = $response->value();
return 0; return 0;
} }
...@@ -82,43 +155,44 @@ sub LookupSlice($$) ...@@ -82,43 +155,44 @@ sub LookupSlice($$)
# Register a local Emulab user at the Geni ClearingHouse (which in the # Register a local Emulab user at the Geni ClearingHouse (which in the
# prototype is Utah Emulab). # prototype is Utah Emulab).
# #
sub RegisterUser($$$$$$) sub RegisterUser($$$$$)
{ {
my ($hrn, $uuid, $name, $email, $cert, $sshkey) = @_; my ($hrn, $name, $email, $cert, $sshkey) = @_;
my $args = { "hrn" => $hrn, my $info = { "name" => $name,
"uuid" => $uuid, "email" => $email };
"name" => $name, $info->{"sshkey"} = $sshkey
"email" => $email,
"cert" => $cert};
$args->{"sshkey"} = $sshkey
if (defined($sshkey)); if (defined($sshkey));
my $response = return Register($hrn, "User", $cert, $info);
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, }
"CH::RegisterUser", $args);
return -1 #
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS); # Register a slice at the Clearinghouse.
#
return 0; 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 = SetCredential();
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::CreateSliceName",
{ "hrn" => $hrn,
"uuid" => $uuid,
"creator_uuid" => $creator_uuid,
"cert" => $cert });
my $response =
Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext, "Remove",
{ "credential" => $Credential,
"type" => $type,
"uuid" => $uuid });
return -1 return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS); if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
...@@ -128,19 +202,11 @@ sub RegisterSlice($$$$) ...@@ -128,19 +202,11 @@ sub RegisterSlice($$$$)
# #
# Delete a slice registration. # Delete a slice registration.
# #
sub DeleteSlice($) sub RemoveSlice($)
{ {
my ($uuid) = @_; my ($uuid) = @_;
my $response = return Remove("Slice", $uuid);
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::FreeSliceName",
{ "uuid" => $uuid });
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
} }
# #
...@@ -155,7 +221,7 @@ sub DiscoverResources($$) ...@@ -155,7 +221,7 @@ sub DiscoverResources($$)
my ($slice, $pref) = @_; my ($slice, $pref) = @_;
my $response = my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::DiscoverResources", "CH::DiscoverResources",
{ "slice" => $slice->cert() }); { "slice" => $slice->cert() });
...@@ -165,32 +231,7 @@ sub DiscoverResources($$) ...@@ -165,32 +231,7 @@ sub DiscoverResources($$)
return -1 return -1
if ($response->code() != GENIRESPONSE_SUCCESS); if ($response->code() != GENIRESPONSE_SUCCESS);
# $$pref = $response->value();
# 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;
return 0; return 0;
} }
...@@ -205,7 +246,7 @@ sub BindUser($$) ...@@ -205,7 +246,7 @@ sub BindUser($$)
"user_uuid" => $user_uuid }; "user_uuid" => $user_uuid };
my $response = my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::BindUser", $args); "CH::BindUser", $args);
return -1 return -1
...@@ -221,7 +262,7 @@ sub UnBindUser($$) ...@@ -221,7 +262,7 @@ sub UnBindUser($$)
"user_uuid" => $user_uuid }; "user_uuid" => $user_uuid };
my $response = my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef, Genixmlrpc::CallMethod($GENICENTRALURL, $MyContext,
"CH::UnBindUser", $args); "CH::UnBindUser", $args);
return -1 return -1
...@@ -230,3 +271,5 @@ sub UnBindUser($$) ...@@ -230,3 +271,5 @@ sub UnBindUser($$)
return 0; return 0;
} }
# _Always_ make sure that this 1 is at the end of the file...
1;
...@@ -27,6 +27,7 @@ use GeniCredential; ...@@ -27,6 +27,7 @@ use GeniCredential;
use GeniCertificate; use GeniCertificate;
use GeniSlice; use GeniSlice;
use GeniAggregate; use GeniAggregate;
use GeniAuthority;
use GeniSliver; use GeniSliver;
use GeniUser; use GeniUser;
use libtestbed; use libtestbed;
...@@ -179,7 +180,7 @@ sub GetTicket($) ...@@ -179,7 +180,7 @@ sub GetTicket($)
# #
my $slice = GeniSlice->Lookup($slice_uuid); my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) { if (!defined($slice)) {
$slice = GeniSlice->CreateFromRegistry($slice_uuid); $slice = CreateSliceFromRegistry($slice_uuid);
if (!defined($slice)) { if (!defined($slice)) {
print STDERR "No slice $slice_uuid in the ClearingHouse\n"; print STDERR "No slice $slice_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
...@@ -187,7 +188,7 @@ sub GetTicket($) ...@@ -187,7 +188,7 @@ sub GetTicket($)
} }
} }
else { else {
$slice->UpdateFromRegistry() == 0 or UpdateSliceFromRegistry($slice) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not update slice info from ClearingHouse"); "Could not update slice info from ClearingHouse");
} }
...@@ -197,7 +198,7 @@ sub GetTicket($) ...@@ -197,7 +198,7 @@ sub GetTicket($)
# #
my $user = GeniUser->Lookup($owner_uuid); my $user = GeniUser->Lookup($owner_uuid);
if (!defined($user)) { if (!defined($user)) {
$user = GeniUser->CreateFromRegistry($owner_uuid); $user = CreateUserFromRegistry($owner_uuid);
if (!defined($user)) { if (!defined($user)) {
print STDERR "No user $owner_uuid in the ClearingHouse\n"; print STDERR "No user $owner_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
...@@ -606,3 +607,133 @@ sub DestroySliver($) ...@@ -606,3 +607,133 @@ sub DestroySliver($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS); 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.