Skip to content

GitLab

Commit 38f9b5fb authored by Leigh B. Stoller's avatar Leigh B. Stoller
Browse files

Checkpoint

parent 8c6bae5a
Hide whitespace changes
Inline Side-by-side
Showing with 502 additions and 156 deletions
protogeni/lib/GNUmakefile.in
View file @ 38f9b5fb
......@@ -14,7 +14,8 @@ 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 \
GeniComponent.pm GeniCH.pm GeniCHClient.pm
GeniComponent.pm GeniCH.pm GeniCHClient.pm \
GeniAuthority.pm GeniCertificate.pm
#
# Force dependencies on the scripts so that they will be rerun through
......
protogeni/lib/GeniAuthority.pm.in 0 → 100644
View file @ 38f9b5fb
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniAuthority;
#
# 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 libdb qw(TBGetUniqueIndex);
use English;
use overload ('""' => 'Stringify');
use XML::Simple;
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $SIGNCRED = "$TB/sbin/signgenicred";
my $VERIFYCRED = "$TB/sbin/verifygenicred";
# Cache of instances to avoid regenerating them.
my %authorities = ();
#
# Lookup by idx, or uuid.
#
sub Lookup($$)
{
my ($class, $token) = @_;
my $query_result;
my $idx;
if ($token =~ /^\d+$/) {
$idx = $token;
}
elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
$query_result =
DBQueryWarn("select idx from geni_sliceauthorities ".
"where uuid='$token'");
return undef
if (! $query_result || !$query_result->numrows);
($idx) = $query_result->fetchrow_array();
}
else {
return undef;
}
# Look in cache first
return $authorities{"$idx"}
if (exists($authorities{"$idx"}));
$query_result =
DBQueryWarn("select * from geni_sliceauthorities where idx='$idx'");
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
$self->{'AUTHORITY'} = $query_result->fetchrow_hashref();
bless($self, $class);
#
# 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) {
print STDERR "Could not find certificate for authority $idx\n";
return undef;
}
my ($cert) = $query_result->fetchrow_array();
$self->{'AUTHORITY'}->{'cert'} = $cert;
# Add to cache.
$authorities{$self->{'AUTHORITY'}->{'idx'}} = $self;
return $self;
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $uuid = $self->uuid();
my $idx = $self->idx();
return "[GeniAuthority: $uuid, IDX: $idx]";
}
#
# Create a Geni authority in the DB.
#
sub Create($$$$$)
{
my ($class, $uuid, $hrn, $url, $cert) = @_;
my @insert_data = ();
my $idx = TBGetUniqueIndex('next_authority', 1);
my $safe_hrn = DBQuoteSpecial($hrn);
my $safe_url = DBQuoteSpecial($url);
my $safe_uuid = DBQuoteSpecial($uuid);
my $safe_cert = DBQuoteSpecial($cert);
# Now tack on other stuff we need.
push(@insert_data, "created=now()");
push(@insert_data, "idx='$idx'");
push(@insert_data, "hrn=$safe_hrn");
push(@insert_data, "url=$safe_url");
push(@insert_data, "uuid=$safe_uuid");
# Insert into DB.
DBQueryWarn("replace into geni_sliceauthorities 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'");
return undef;
}
return GeniAuthority->Lookup($idx);
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AUTHORITY'}->{$_[1]}); }
sub idx($) { return field($_[0], "idx"); }
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"); }
# _Always_ make sure that this 1 is at the end of the file...
1;
protogeni/lib/GeniCH.pm.in
View file @ 38f9b5fb
......@@ -25,6 +25,7 @@ use User;
use GeniUser;
use GeniSlice;
use GeniComponent;
use GeniAuthority;
use libtestbed;
use emutil;
use English;
......@@ -59,15 +60,28 @@ sub LookupUser($)
"No such user $uuid");
}
# Return a blob.
my $blob = { "uid" => $user->uid(),
"hrn" => $user->hrn(),
"uuid" => $user->uuid(),
"email" => $user->email(),
"name" => $user->name() };
my $authority = GeniAuthority->Lookup($user->sa_idx());
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority found for user");
}
# Return a blob.
my $blob = { "uid" => $user->uid(),
"hrn" => $user->hrn(),
"uuid" => $user->uuid(),
"email" => $user->email(),
"cert" => $user->cert(),
"name" => $user->name(),
"sa" => { "hrn" => $authority->hrn(),
"uuid" => $authority->uuid(),
"cert" => $authority->cert(),
"url" => $authority->url() }
};
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
}
sub LookupSlice($)
{
my ($argref) = @_;
......@@ -82,11 +96,22 @@ sub LookupSlice($)
"No such user $uuid");
}
my $authority = GeniAuthority->Lookup($slice->sa_idx());
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority found for slice");
}
# Return a blob.
my $blob = { "hrn" => $slice->hrn(),
"uuid" => $slice->uuid(),
"creator_uuid" => $slice->creator_uuid(),
"cert" => $slice->cert() };
"cert" => $slice->cert(),
"sa" => { "hrn" => $authority->hrn(),
"uuid" => $authority->uuid(),
"cert" => $authority->cert(),
"url" => $authority->url() }
};
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
}
......@@ -98,15 +123,13 @@ sub RegisterUser($)
{
my ($argref) = @_;
my $hrn = $argref->{'hrn'};
my $uid = $argref->{'uid'};
my $uuid = $argref->{'uuid'};
my $name = $argref->{'name'};
my $email = $argref->{'email'};
my $cert = $argref->{'cert'};
if (! (defined($hrn) && defined($uid) && defined($name) &&
defined($email) &&
defined($cert) && defined($uuid))) {
if (! (defined($hrn) && defined($name) &&
defined($email) && defined($cert) && defined($uuid))) {
return GeniResponse->MalformedArgsResponse();
}
......@@ -125,10 +148,6 @@ sub RegisterUser($)
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"name: ". TBFieldErrorString());
}
if (! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uid: ". TBFieldErrorString());
}
if (! TBcheck_dbslot($email, "users", "usr_email",TBDB_CHECKDBSLOT_ERROR)){
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"email: ". TBFieldErrorString());
......@@ -179,6 +198,16 @@ sub RegisterUser($)
"$hrn/$email already registered");
}
# The local uid we will use is the last part of the hrn.
my ($uid) = ($hrn =~ /^.*\.(\w*)$/);
if (!defined($uid)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uid: cannot parse hrn to get uid");
}
elsif (! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uid: ". TBFieldErrorString());
}
my $newuser = GeniUser->Create($hrn, $uid, $uuid,
$name, $email, $cert, $sa_idx);
if (!defined($newuser)) {
......
protogeni/lib/GeniCM.pm.in
View file @ 38f9b5fb
......@@ -116,15 +116,16 @@ sub DiscoverResources($)
sub GetTicket($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'slice_uuid'};
my $slice_cert = $argref->{'slice'};
my $rspec = $argref->{'rspec'};
my $impotent = $argref->{'impotent'};
my $credential = $argref->{'credential'};
my $owner_uuid = $ENV{'GENIUSER'};
my $slice_uuid;
if (! (defined($slice_uuid) && ($slice_uuid =~ /^[-\w]+$/))) {
if (! defined($slice_cert)) {
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Improper slice uuid");
"Improper slice");
}
if (! (defined($rspec) && ($rspec =~ /^[-\w]+$/))) {
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
......@@ -141,6 +142,11 @@ sub GetTicket($)
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniCredential object");
}
GeniCredential->CertificateInfo($slice_cert, \$slice_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
# The credential owner/slice has to match what was provided.
if (! ($owner_uuid eq $credential->owner_uuid() &&
$slice_uuid eq $credential->this_uuid())) {
......@@ -155,13 +161,27 @@ sub GetTicket($)
#
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
$slice = GeniSlice->CreateFromRegistry($slice_uuid);
if (!defined($slice)) {
print STDERR "No slice $slice_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get slice info from ClearingHouse");
}
}
#
# XXX Should we create a local geni_slices record in the DB?
# Ditto the user.
#
my $user = GeniUser->Lookup($owner_uuid);
if (!defined($user)) {
$user = GeniUser->CreateFromRegistry($owner_uuid);
if (!defined($user)) {
print STDERR "No user $owner_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get user info from ClearingHouse");
}
}
#
# If the underlying experiment does not exist, need to create
# a holding experiment. All these are going to go into the same
......@@ -208,7 +228,7 @@ sub GetTicket($)
#
# Create the ticket first, before allocating the node.
#
my $ticket = GeniTicket->Create($slice_uuid, $owner_uuid, $rspec);
my $ticket = GeniTicket->Create($slice, $user, $rspec);
if (!defined($ticket)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniTicket object");
......
protogeni/lib/GeniCMClient.pm.in
View file @ 38f9b5fb
......@@ -41,47 +41,6 @@ my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.little-emulab-bsd61.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc";
#
# 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, $rspec, $pref) = @_;
#
# XXX
#
my $this_user = User->LookupByUnixId($UID);
if (! defined($this_user)) {
print STDERR "You ($UID) do not exist!\n";
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->Sign()) {
print STDERR "Could not sign slice credential!\n";
return -1;
}
my $ticket = $component->GetTicket($this_user, $credential,
$experiment->uuid(), $rspec);
$$pref = $ticket;
return 0;
}
sub CreateSliver($$$)
{
my ($experiment, $ticket, $pref) = @_;
......
protogeni/lib/GeniCertificate.pm.in 0 → 100644
View file @ 38f9b5fb
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniCertificate;
#
# Some simple certificate 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 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 $SIGNCRED = "$TB/sbin/signgenicred";
my $VERIFYCRED = "$TB/sbin/verifygenicred";
my $NFREE = "$TB/bin/nfree";
my $OPENSSL = "/usr/bin/openssl";
# _Always_ make sure that this 1 is at the end of the file...
1;
protogeni/lib/GeniComponent.pm.in
View file @ 38f9b5fb
......@@ -250,11 +250,11 @@ sub DiscoverResources($$$$$)
#
sub GetTicket($$$$$)
{
my ($self, $user, $credential, $slice_uuid, $rspec) = @_;
my ($self, $slice, $rspec, $user, $credential) = @_;
my $rspec_xml = $rspec;
# Must be a real reference.
return -1
return undef
if (! ref($self));
# The rspec is passed as XML. If we get a ref, convert it.
......@@ -266,9 +266,9 @@ sub GetTicket($$$$$)
Genixmlrpc::CallMethodHTTP($self->url(),
$user,
"CM::GetTicket",
{ "slice_uuid" => $slice_uuid,
{ "slice" => $slice->cert(),
"credential" => $credential->asString(),
"impotent" => 0,
"impotent" => 1,
"rspec" => $rspec_xml });
return undef
......@@ -280,8 +280,7 @@ sub GetTicket($$$$$)
#
# Convert this into a (signed) ticket object.
#
return GeniTicket->Create($slice_uuid, $user->uuid(),
$rspec, $response->value(), $self);
return GeniTicket->CreateFromSignedTicket($response->value(), $self, 1);
}
#
......@@ -289,10 +288,10 @@ sub GetTicket($$$$$)
#
sub CreateSliver($$$$)
{
my ($self, $user, $ticket, $pref) = @_;
my ($self, $slice, $ticket, $user) = @_;
# Must be a real reference.
return -1
return undef
if (! ref($self));
my $response =
......@@ -300,10 +299,10 @@ sub CreateSliver($$$$)
"CM::CreateSliver",
{ "ticket" => $ticket->asString() });
return -1
return undef
if (!defined($response));
return -1
return undef
if ($response->code() != GENIRESPONSE_SUCCESS);
#
......@@ -312,16 +311,15 @@ sub CreateSliver($$$$)
my $credential = GeniCredential->CreateFromSigned($response->value());
if (!defined($credential)) {
print STDERR "Could not create local credential object.\n";
return -1;
return undef;
}
my $sliver = GeniSliver->Create($ticket, $credential);
if (!defined($sliver)) {
print STDERR "Could not create local sliver object.\n";
return -1;
return undef;
}
$$pref = $sliver;
return 0;
return $sliver;
}
#
......
protogeni/lib/GeniCredential.pm.in
View file @ 38f9b5fb
......@@ -298,6 +298,38 @@ sub Store($)
return 0;
}
#
# Create a certificate pair, which gives us a uuid to use for an object.
# We need a file to store the cert/key in.
#
sub CreateCertificate($$$$)
{
my ($class, $what, $certfile, $pref) = @_;
system("$MKCERT -o $certfile $what $uuid");
if ($?) {
print STDERR "Could not start $MKCERT\n";
return -1;
}
my $cert;
open(CERT, $certfile) or
return -1;
while (<CERT>) {
if ($_ =~ /^-----BEGIN CERT/) {
$cert = "";
next;
}
last
if ($_ =~ /^-----END CERT/);
next
if (!defined($cert));
$cert .= $_;
}
close(CERT);
$$pref = $cert;
return 0;
}
#
# Convert a certificate to its uuid.
#
......@@ -306,7 +338,7 @@ sub CertificateInfo($$$)
my ($class, $string, $pref) = @_;
# Deleted when scope is left.
my $tempfile = new File::Temp(UNLINK => 0);
my $tempfile = new File::Temp(UNLINK => 1);
my $filename = $tempfile->filename;
print $tempfile "-----BEGIN CERTIFICATE-----\n";
print $tempfile "$string";
......
protogeni/lib/GeniSlice.pm.in
View file @ 38f9b5fb
......@@ -17,6 +17,8 @@ use vars qw(@ISA @EXPORT);
use lib '@prefix@/lib';
use GeniDB;
use GeniCHClient;
use GeniAuthority;
use GeniCredential;
use libtestbed;
# Hate to import all this crap; need a utility library.
use libdb qw(TBGetUniqueIndex);
......@@ -207,26 +209,11 @@ sub CreateFromLocal($$)
# the DB so we have ready access to it.
#
my $certfile = $experiment->WorkDir() . "/genicert.pem";
system("$MKCERT -o $certfile slice $uuid");
if ($?) {
print STDERR "Could not start $MKCERT\n";
return undef;
}
my $cert;
open(CERT, $certfile) or
if (GeniCredential->CreateCertificate("slice", $certfile, \$cert) != 0) {
print STDERR "Could not create certificate for slice.\n";
return undef;
while (<CERT>) {
if ($_ =~ /^-----BEGIN CERT/) {
$cert = "";
next;
}
last
if ($_ =~ /^-----END CERT/);
next
if (!defined($cert));
$cert .= $_;
}
close(CERT);