Commit 23a12aa5 authored by Leigh Stoller's avatar Leigh Stoller

Checkpoint

parent 8f598e53
......@@ -14,8 +14,9 @@ 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 \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
node.pl
#
# Force dependencies on the scripts so that they will be rerun through
......
......@@ -110,6 +110,13 @@ sub LookupSlice($)
"No slice authority found for slice");
}
# User bindings too.
my @userbindings = ();
if ($slice->UserBindings(\@userbindings) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error getting user bindings for slice");
}
# Return a blob.
my $blob = { "hrn" => $slice->hrn(),
"uuid" => $slice->uuid(),
......@@ -119,7 +126,8 @@ sub LookupSlice($)
"uuid" => $authority->uuid(),
"cert" => $authority->cert(),
"uuid_prefix" => $authority->uuid_prefix(),
"url" => $authority->url() }
"url" => $authority->url() },
"userbindings" => \@userbindings,
};
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
......@@ -342,3 +350,126 @@ sub DiscoverResources($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}
#
# Bind user to slice
#
sub BindUser($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'slice_uuid'};
my $user_uuid = $argref->{'user_uuid'};
if (! (defined($slice_uuid) && defined($user_uuid))) {
return GeniResponse->MalformedArgsResponse();
}
#
# Use the Emulab checkslot routines.
#
if (! ($slice_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! ($user_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
# Need to verify the UUID is permitted for the SA making the request.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $query_result =
DBQueryWarn("select idx, uuid_prefix from geni_sliceauthorities ".
"where uuid='$sa_uuid'");
return GeniResponse->Create(GENIRESPONSE_DBERROR)
if (!defined($query_result));
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, "Who are You?")
if (!$query_result->numrows);
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such slice $slice_uuid");
}
my $user = GeniUser->Lookup($user_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such user $user_uuid");
}
DBQueryWarn("replace into geni_bindings set ".
" slice_uuid='$slice_uuid', user_uuid='$user_uuid', ".
" created=now()")
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been bound to slice");
}
#
# UnBind user from slice
#
sub UnBindUser($)
{
my ($argref) = @_;
my $slice_uuid = $argref->{'slice_uuid'};
my $user_uuid = $argref->{'user_uuid'};
if (! (defined($slice_uuid) && defined($user_uuid))) {
return GeniResponse->MalformedArgsResponse();
}
#
# Use the Emulab checkslot routines.
#
if (! ($slice_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! ($user_uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
# Need to verify the UUID is permitted for the SA making the request.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $query_result =
DBQueryWarn("select idx, uuid_prefix from geni_sliceauthorities ".
"where uuid='$sa_uuid'");
return GeniResponse->Create(GENIRESPONSE_DBERROR)
if (!defined($query_result));
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, "Who are You?")
if (!$query_result->numrows);
my $slice = GeniSlice->Lookup($slice_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such slice $slice_uuid");
}
my $user = GeniUser->Lookup($user_uuid);
if (!defined($slice)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No such user $user_uuid");
}
DBQueryWarn("delete from geni_bindings ".
"where slice_uuid='$slice_uuid' and user_uuid='$user_uuid'")
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error unbinding user from slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been unbound from slice");
}
......@@ -35,7 +35,7 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.little-emulab-bsd61.testbed.emulab.net";
my $GENICENTRAL = "myboss.myelab.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc/ch";
#
......@@ -194,3 +194,39 @@ sub DiscoverResources($$)
return 0;
}
#
# Bind and unbind users to/from slices
#
sub BindUser($$)
{
my ($slice_uuid, $user_uuid) = @_;
my $args = { "slice_uuid" => $slice_uuid,
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::BindUser", $args);
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
}
sub UnBindUser($$)
{
my ($slice_uuid, $user_uuid) = @_;
my $args = { "slice_uuid" => $slice_uuid,
"user_uuid" => $user_uuid };
my $response =
Genixmlrpc::CallMethodHTTP($GENICENTRALURL, undef,
"CH::UnBindUser", $args);
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return 0;
}
......@@ -186,6 +186,11 @@ sub GetTicket($)
"Could not get slice info from ClearingHouse");
}
}
else {
$slice->UpdateFromRegistry() == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not update slice info from ClearingHouse");
}
#
# Ditto the user.
......@@ -345,6 +350,20 @@ sub CreateSliver($)
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
# Bind the other users too.
my @userbindings;
if ($slice->UserBindings(\@userbindings) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding users to slice");
}
foreach my $otheruuid (@userbindings) {
my $otheruser = GeniUser->Lookup($otheruuid);
if (!$otheruser->BindToSlice($slice) != 0) {
print STDERR "Could not bind $otheruser to $slice\n";
}
}
#
# We are actually an Aggregate, so return an aggregate of slivers,
# unless there is just one node.
......@@ -453,21 +472,6 @@ sub CreateSliver($)
}
}
#
# This stuff needs to be moved elsewhere.
#
# XXX What if we have multiple slivers for this slice? We are going
# to need some locking or management at the slice level so that we run
# tbswap only once, or at least no more then one at a time.
#
if (0 && !$impotent) {
system("$SWAPEXP -s modify -g $pid $eid");
if ($?) {
$message = "Failed to tbswap $pid,$eid";
goto bad;
}
}
#
# The API states we return a credential to control the sliver/aggregate.
#
......@@ -602,213 +606,3 @@ sub DestroySliver($)
return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
#
# Bind a user to a slice.
#
sub BindUser($)
{
my ($argref) = @_;
my $sliver = $argref->{'sliver'};
my $hrn = $argref->{'userinfo'}->{'hrn'};
my $uuid = $argref->{'userinfo'}->{'uuid'};
my $name = $argref->{'userinfo'}->{'name'};
my $email = $argref->{'userinfo'}->{'email'};
my $cert = $argref->{'userinfo'}->{'cert'};
my $sshkey = $argref->{'userinfo'}->{'sshkey'};
my $sliver_uuid;
if (! (defined($hrn) && defined($name) && defined($sliver) &&
defined($email) && defined($cert) && defined($uuid))) {
return GeniResponse->MalformedArgsResponse();
}
GeniCertificate->CertificateInfo($sliver, \$sliver_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
#
# See if we have a record of this sliver in the DB. If not, then we have
# to go to the ClearingHouse to find its record, so that we can find out
# who the SA for it is.
#
$sliver = GeniSliver->Lookup($sliver_uuid);
if (!defined($sliver)) {
# Might be an aggregate instead.
$sliver = GeniAggregate->Lookup($sliver_uuid);
if (!defined($sliver)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No such sliver $sliver_uuid");
}
}
my $slice = $sliver->GetSlice();
#
# Use the Emulab checkslot routines.
#
if (! ($hrn =~ /^[-\w\.]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"hrn: Invalid characters");
}
if (! ($uuid =~ /^[-\w]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"uuid: Invalid characters");
}
if (! TBcheck_dbslot($name, "users", "usr_name", TBDB_CHECKDBSLOT_ERROR)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"name: ". TBFieldErrorString());
}
if (! TBcheck_dbslot($email, "users", "usr_email",TBDB_CHECKDBSLOT_ERROR)){
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"email: ". TBFieldErrorString());
}
if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"cert: Invalid characters");
}
if (defined($sshkey) && ! ($sshkey =~ /^[\012\015\040-\176]*$/)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"sshkey: Invalid characters");
}
#
# The SA UUID comes from the SSL environment (certificate). Verify it
# and the prefix match for the uuid.
#
my $sa_uuid = $ENV{'GENIUUID'};
my $authority = GeniAuthority->Lookup($sa_uuid);
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority record for $sa_uuid");
}
if (! $authority->PrefixMatch($uuid)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"uuid: Prefix mismatch");
}
#
# Verify that this is the SA for the slice.
#
if (! $slice->IsSliceAuthority($authority)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Must be the SA for the slice");
}
# Might already exist. Not an error, Just check binding and return.
my $user = GeniUser->Lookup($uuid);
if (defined($user)) {
$user->BindToSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$hrn/$email has been bound to slice");
}
#
# XXX
#
# What kind of uniquess requirements do we need? No one else with this
# email address? Of course, we have to allow hrn reuse, but should we
# require that for a given SA, that hrn is unique, at least to avoid
# lots of confusion?
#
if (GeniUser->CheckExisting($hrn, $email)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$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,
$authority->idx(), $sshkey);
if (!defined($newuser)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"$hrn/$email could not be registered");
}
$newuser->BindToSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to sliver");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$hrn/$email has been bound to $sliver_uuid");
}
#
# Unbind user from sliver.
#
sub UnBindUser($)
{
my ($argref) = @_;
my $sliver = $argref->{'sliver'};
my $user = $argref->{'user'};
my $sliver_uuid;
my $user_uuid;
if (! (defined($sliver) && defined($user))) {
return GeniResponse->MalformedArgsResponse();
}
GeniCertificate->CertificateInfo($sliver, \$sliver_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
GeniCertificate->CertificateInfo($user, \$user_uuid) == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get uuid from Certificate");
#
# See if we have a record of this sliver in the DB. If not, then we have
# to go to the ClearingHouse to find its record, so that we can find out
# who the SA for it is.
#
$sliver = GeniSliver->Lookup($sliver_uuid);
if (!defined($sliver)) {
# Might be an aggregate instead.
$sliver = GeniAggregate->Lookup($sliver_uuid);
if (!defined($sliver)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No such sliver $sliver_uuid");
}
}
# Does not exist? Not an error.
$user = GeniUser->Lookup($user_uuid);
if (! defined($user)) {
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid is not bound to $sliver_uuid");
}
my $slice = $sliver->GetSlice();
#
# The SA UUID comes from the SSL environment (certificate).
#
my $sa_uuid = $ENV{'GENIUUID'};
my $authority = GeniAuthority->Lookup($sa_uuid);
if (!defined($authority)) {
return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
"No slice authority record for $sa_uuid");
}
#
# Verify that this is the SA for the slice.
#
if (! $slice->IsSliceAuthority($authority)) {
return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
"Must be the SA for the slice");
}
$user->UnBindFromSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error unbinding user from sliver");
return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
"$user_uuid has been unbound from sliver");
}
......@@ -38,8 +38,6 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
my $GENICENTRAL = "myboss.little-emulab-bsd61.testbed.emulab.net";
my $GENICENTRALURL = "https://$GENICENTRAL/protogeni/xmlrpc";
# _Always_ make sure that this 1 is at the end of the file...
1;
......
......@@ -159,6 +159,52 @@ sub url($) { return field($_[0], "url"); }
sub hrn($) { return field($_[0], "hrn"); }
sub cert($) { return field($_[0], "cert"); }
#
# Class method to lookup the component for a given resource (uuid) by
# looking in the resources table.
#
sub LookupByResource($$)
{
my ($class, $uuid) = @_;
return undef
if (! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/));
my $query_result =
DBQueryWarn("select component_idx from geni_resources ".
"where resource_uuid='$uuid'");
return undef
if (! $query_result || !$query_result->numrows);
my ($idx) = $query_result->fetchrow_array();
return GeniComponent->Lookup($idx);
}
#
# Method to insert a new geni_resources record for the component.
#
sub NewResource($$)
{
my ($self, $uuid) = @_;
return -1
if (! ref($self));
my $idx = TBGetUniqueIndex('next_resource', 1);
my $component_idx = $self->idx();
$uuid = DBQuoteSpecial("$uuid");
return -1
if (! DBQueryWarn("replace into geni_resources set ".
" idx=$idx, resource_uuid=$uuid, ".
" resource_type='node', ".
" created=now(), component_idx=$component_idx"));
return 0;
}
#
# Refresh a class instance by reloading from the DB.
#
......@@ -248,64 +294,6 @@ sub DiscoverResources($$$$$)
return 0;
}
#
# Bind and UnBind users to/from slivers.
#
# We do this with the local SA as the credential, not the sliver credential.
#
sub BindUser($$$$)
{
my ($self, $sliver, $target_user) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($sliver) && ref($target_user)));
my $sshkey;
$target_user->GetSSHKey(\$sshkey);
my $userinfo = { "hrn" => $target_user->hrn(),
"uuid" => $target_user->uuid(),
"name" => $target_user->name(),
"email" => $target_user->email(),
"cert" => $target_user->cert(),
"sshkey" => $sshkey
};
my $response =
Genixmlrpc::CallMethodHTTP($self->url(), undef,
"CM::BindUser",
{ "sliver" => $sliver->cert(),
"userinfo" => $userinfo });
if ($response->code() != GENIRESPONSE_SUCCESS) {
print STDERR "Could not bind $target_user to sliver $sliver\n";
return -1;
}
return 0;
}
sub UnBindUser($$$$)
{
my ($self, $sliver, $target_user) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($sliver) && ref($target_user)));
my $response =
Genixmlrpc::CallMethodHTTP($self->url(), undef,
"CM::UnBindUser",
{ "sliver" => $sliver->cert(),
"user" => $target_user->cert() });
if ($response->code() != GENIRESPONSE_SUCCESS) {
print STDERR "Could not unbind $target_user to sliver $sliver\n";
return -1;
}
return 0;
}
#
# Get a Ticket from a component;
#
......
......@@ -49,6 +49,39 @@ $LOCALSA_FLAG = 1;
$LOCALCM_FLAG = 2;
@EXPORT_OK = qw(LOCALSA_FLAG LOCALCM_FLAG);
#
# Look for a signed credential in the DB. At present, we store a credential
# by user/object (uuid/uuid), not worrying about different flavors of creds
# with different permissions. This is basically a cache on the client side of
# credentials in use so that they do not need to be regenerated.
#
sub Lookup($$$)
{
my ($class, $this, $owner) = @_;
return undef
if (! (ref($this) && ref($owner)));
my $this_uuid = $this->uuid();
my $owner_uuid = $owner->uuid();
my $query_result =
DBQueryWarn("select * from geni_credentials ".
"where owner_uuid='$owner_uuid' and ".
" this_uuid='$this_uuid'");
return undef
if (!defined($query_result) || !$query_result->numrows);
my $credential = GeniCredential->Create($this, $owner);
return undef
if (!defined($credential));
my $row = $query_result->fetchrow_hashref();
$credential->{'idx'} = $row->{'idx'};
$credential->{'string'} = $row->{'credential_string'};
return $credential;
}
#
# Create an empty credential object.
#
......
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniEmulab;
#
# Stuff to interface between Emulab core and Geni nodes.
#
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 Genixmlrpc;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
use GeniSlice;
use GeniSliver;
use GeniUser;
use libtestbed;
use User;
use Node;
use Interface;
use English;
use Data::Dumper;
use Experiment;
# Configure variables
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my $TBAUDIT = "@TBAUDITEMAIL@";
my $BOSSNODE = "@BOSSNODE@";
my $OURDOMAIN = "@OURDOMAIN@";
#
# Allocate the GENI slivers for an Emulab experiment. The nodes to be created
# are passed in, otherwise lookup the nodes for the experiment.
#
# XXX Need to deal with links between nodes.
#
sub AllocateSlivers($$$)
{
my ($class, $experiment, $nodelist) = @_;
my $thisuser = User->ThisUser();
#
# Create a Geni user from current user doing the operation.
#
my $geniuser = GeniUser->CreateFromLocal($thisuser);
if (!defined($geniuser)) {
print STDERR
"Could not create a geni user from current user $thisuser\n";
return -1;
}
# Register user at the ClearingHouse.
if ($geniuser->Register() != 0) {
print STDERR "Could not register $geniuser at the ClearingHouse.\n";
return -1;
}
#
# The slice should already be registered by this point, but it does