Commit 80118387 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint before radically new approach

parent f354c7d2
......@@ -79,6 +79,7 @@ sub Lookup($$)
$self->{'AGGREGATE'} = $query_result->fetchrow_hashref();
$self->{'CREDENTIAL'} = undef;
$self->{'SLICE'} = undef;
$self->{'PARENT'} = undef;
bless($self, $class);
#
......@@ -158,6 +159,7 @@ sub creator_uuid($) { return field($_[0], "creator_uuid"); }
sub created($) { return field($_[0], "created"); }
sub credential_idx($) { return field($_[0], "credential_idx"); }
sub ticket_idx($) { return field($_[0], "ticket_idx"); }
sub aggregate_idx($) { return field($_[0], "aggregate_idx"); }
sub cert($) { return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($) { return $_[0]->{'CERTIFICATE'}; }
......@@ -186,11 +188,76 @@ sub SliverList($$)
}
push(@result, $sliver);
}
#
# And any aggregates that are children.
#
$query_result =
DBQueryWarn("select idx from geni_aggregates ".
"where aggregate_idx='$idx'");
return -1
if (!$query_result);
while (my ($aggregate_idx) = $query_result->fetchrow_array()) {
my $aggregate = GeniAggregate->Lookup($aggregate_idx);
if (!defined($aggregate_idx)) {
print STDERR
"Could not find aggregate object for $aggregate_idx\n";
return -1;
}
push(@result, $aggregate);
}
@$pref = @result;
return 0;
}
#
# Set the aggregate for an aggregate.
#
sub SetAggregate($$)
{
my ($self, $aggregate) = @_;
return -1
if (! (ref($self) && ref($aggregate)));
my $idx = $self->idx();
my $agg_idx = $aggregate->idx();
return -1
if (!DBQueryWarn("update geni_aggregates set ".
" aggregate_idx='$agg_idx' ".
"where idx='$idx'"));
$self->{'AGGREGATE'}->{'aggregate_idx'} = $agg_idx;
$self->{'PARENT'} = $aggregate;
return 0;
}
#
# Get the aggregate for a sliver.
#
sub GetAggregate($)
{
my ($self) = @_;
return undef
if (! ref($self));
return $self->{'PARENT'} if (defined($self->{'PARENT'}));
return undef
if (!defined($self->aggregate_idx()));
my $aggregate = GeniAggregate->Lookup($self->aggregate_idx());
if (!defined($aggregate)) {
print STDERR "Could not get aggregate object associated with $self\n";
return undef;
}
$self->{'PARENT'} = $aggregate;
return $aggregate;
}
#
# Get the credential for the aggregate.
#
......
......@@ -34,6 +34,7 @@ use libtestbed;
use libdb qw(TBGetUniqueIndex TBcheck_dbslot TBDB_CHECKDBSLOT_ERROR);
use User;
use Node;
use Interface;
use English;
use Data::Dumper;
use XML::Simple;
......@@ -108,6 +109,18 @@ sub DiscoverResources($)
$xml .= "<node uuid=\"$uuid\" name=\"$nodeid\">".
"<available>true</available></node>\n";
my @interfaces = Interface->LookupAll($node);
foreach my $interface (@interfaces) {
my $iface_uuid = $interface->uuid();
my $iface = $interface->iface();
next
if (! $interface->IsExperimental());
$xml .= "<interface uuid=\"$iface_uuid\" node_name=\"$nodeid\">".
"<iface>$iface</iface></interface>\n";
}
}
$xml .= "</rspec>";
......@@ -124,6 +137,7 @@ sub GetTicket($)
my $rspec = $argref->{'rspec'};
my $impotent = $argref->{'impotent'};
my $credential = $argref->{'credential'};
my $vtopo = $argref->{'virtual_topology'};
my $owner_uuid = $ENV{'GENIUSER'};
my $slice_uuid;
......@@ -251,6 +265,13 @@ sub GetTicket($)
"Could not allocate node\n");
}
}
if (defined($vtopo) && $experiment->InsertVirtTopo($vtopo) != 0) {
# Release will free the nodes.
$ticket->Release();
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not insert virt topology");
}
if ($ticket->Sign() != 0) {
# Release will free the nodes.
$ticket->Release();
......@@ -325,45 +346,50 @@ sub CreateSliver($)
$owner->BindToSlice($slice) == 0
or return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Error binding user to slice");
#
# We are actually an Aggregate, so return an aggregate of slivers,
# even if there is just one node (simpler).
# unless there is just one node.
#
my $aggregate = GeniAggregate->Create($ticket);
if (!defined($aggregate)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
my $aggregate;
if (scalar(keys(%{$ticket->rspec()->{'node'}})) > 1) {
$aggregate = GeniAggregate->Create($ticket);
if (!defined($aggregate)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniAggregate object");
}
}
#
# Now for each resource (okay, node) in the ticket create a sliver and
# add it to the aggregate.
#
my @slivers = ();
my %slivers = ();
foreach my $resource_uuid (keys(%{$ticket->rspec()->{'node'}})) {
if (! ($resource_uuid =~ /^[-\w]*$/)) {
$message = "Improper resource_uuid in ticket: $resource_uuid";
goto bad;
}
my $sliver = GeniSliver->Create($slice, $owner, $resource_uuid);
my $sliver = GeniSliver::Node->Create($slice, $owner, $resource_uuid);
if (!defined($sliver)) {
$message = "Could not create GeniSliver object for $resource_uuid";
goto bad;
}
push(@slivers, $sliver);
$slivers{$resource_uuid} = $sliver;
}
#
# Now do the provisioning (note that we actually allocated the node
# above when the ticket was granted). The add the sliver to the aggregate.
#
foreach my $sliver (@slivers) {
foreach my $sliver (values(%slivers)) {
if (!$impotent && $sliver->Provision() != 0) {
$message = "Could not provision $sliver";
goto bad;
}
if ($sliver->SetAggregate($aggregate) != 0) {
if (defined($aggregate) &&
$sliver->SetAggregate($aggregate) != 0) {
$message = "Could not aggregate for $sliver to $aggregate";
goto bad;
}
......@@ -378,25 +404,76 @@ sub CreateSliver($)
# tbswap only once, or at least no more then one at a time.
#
if (!$impotent) {
system("$SWAPEXP -s modify -r -g $pid $eid");
system("$SWAPEXP -s modify -g $pid $eid");
if ($?) {
$message = "Failed to tbswap $pid,$eid";
goto bad;
}
}
#
# Grab the links after swapmod since we do not know what interfaces
# assign will pick until now.
#
# XXX Not sure how to deal with users picking interfaces themselves.
#
foreach my $linkname (keys(%{$ticket->rspec()->{'link'}})) {
my @linkslivers = ();
if (! ($linkname =~ /^[-\w]*$/)) {
$message = "Bad name for link: $linkname";
goto bad;
}
my $linkaggregate = GeniAggregate->Create($ticket);
if (!defined($linkaggregate)) {
$message = "Could not create aggregate for $linkname";
goto bad;
}
$slivers{$linkaggregate->uuid()} = $linkaggregate;
#
# Grab the endpoints of the links, which are supposed to refer to
# nodes we have already seen.
#
my @interfaces;
if ($experiment->LinkInterfaces($linkname, \@interfaces) != 0) {
$message = "Could not find interfaces for $linkname";
goto bad;
}
foreach my $interface (@interfaces) {
my $sliver = GeniSliver::Interface->Create($slice, $owner,
$interface->uuid());
if (!defined($sliver)) {
$message = "Could not create GeniSliver ".
"$interface in $linkname";
goto bad;
}
if ($sliver->SetAggregate($linkaggregate) != 0) {
$message = "Could not add link sliver $sliver to $aggregate";
goto bad;
}
}
}
#
# The API states we return a credential to control the sliver/aggregate.
#
my $credential = $aggregate->NewCredential($owner);
my $credential;
if (defined($aggregate)) {
$credential = $aggregate->NewCredential($owner);
}
else {
$credential = ((values(%slivers))[0])->NewCredential($owner);
}
if (!defined($credential)) {
$message = "Could not create credential for $aggregate";
$message = "Could not create credential";
goto bad;
}
return GeniResponse->Create(GENIRESPONSE_SUCCESS, $credential->asString());
bad:
foreach my $sliver (@slivers) {
foreach my $sliver (values(%slivers)) {
$sliver->UnProvision()
if (! $impotent);
$sliver->Delete();
......
......@@ -242,7 +242,7 @@ sub DiscoverResources($$$$$)
return -1
if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
my $rspec = XMLin($response->value(), ForceArray => ["node"]);
my $rspec = XMLin($response->value(), ForceArray => ["node", "interface"]);
$$pref = $rspec;
return 0;
......@@ -309,9 +309,9 @@ sub UnBindUser($$$$)
#
# Get a Ticket from a component;
#
sub GetTicket($$$$$)
sub GetTicket($$$$$;$)
{
my ($self, $slice, $rspec, $user, $credential) = @_;
my ($self, $slice, $rspec, $user, $credential, $vtopo) = @_;
my $rspec_xml = $rspec;
# Must be a real reference.
......@@ -322,15 +322,16 @@ sub GetTicket($$$$$)
if (ref($rspec_xml)) {
$rspec_xml = XMLout($rspec_xml, RootName => "rspec");
}
my $args = { "slice" => $slice->cert(),
"credential" => $credential->asString(),
"impotent" => $impotent,
"rspec" => $rspec_xml };
$args->{'virtual_topology'} = $vtopo
if (defined($vtopo));
my $response =
Genixmlrpc::CallMethodHTTP($self->url(),
$user,
"CM::GetTicket",
{ "slice" => $slice->cert(),
"credential" => $credential->asString(),
"impotent" => $impotent,
"rspec" => $rspec_xml });
$user, "CM::GetTicket", $args);
return undef
if (!defined($response));
......@@ -376,7 +377,8 @@ sub CreateSliver($$$$)
return undef;
}
my $sliver = GeniSliver->Create($slice, $user, undef, $credential, $self);
my $sliver = GeniSliver->Create($slice, $user, undef, undef,
$credential, $self);
if (!defined($sliver)) {
print STDERR "Could not create local sliver object.\n";
return undef;
......
......@@ -23,7 +23,7 @@ use GeniCredential;
use GeniCertificate;
use GeniAggregate;
# Hate to import all this crap; need a utility library.
use libdb qw(TBGetUniqueIndex TBDB_ALLOCSTATE_RES_INIT_DIRTY);
use libdb qw(TBGetUniqueIndex);
use libtestbed;
use Experiment;
use Node;
......@@ -100,7 +100,15 @@ sub Lookup($$)
return undef;
}
$self->{'CERTIFICATE'} = $certificate;
bless($self, $class);
# Bless into sub package if called for.
my $resource_type = $self->{'SLIVER'}->{'resource_type'};
if (defined($resource_type) && $resource_type ne "") {
bless($self, $class . "::" . $self->{'SLIVER'}->{'resource_type'});
}
else {
bless($self, $class);
}
# Add to cache.
$slivers{$self->{'SLIVER'}->{'idx'}} = $self;
......@@ -125,9 +133,10 @@ sub Stringify($)
# Create a sliver record in the DB. On the client side we save the credential
# that allows control of it, for later operations.
#
sub Create($$$;$$)
sub Create($$$$;$$$)
{
my ($class, $slice, $user, $resource_uuid, $credential, $component) = @_;
my ($class, $slice, $user, $resource_uuid, $resource_type,
$credential, $component) = @_;
my @insert_data = ();
my $uuid;
my $certificate;
......@@ -165,6 +174,8 @@ sub Create($$$;$$)
push(@insert_data, "uuid='$uuid'");
push(@insert_data, "resource_uuid='$resource_uuid'")
if (defined($resource_uuid));
push(@insert_data, "resource_type='$resource_type'")
if (defined($resource_type));
push(@insert_data, "creator_uuid='$owner_uuid'");
push(@insert_data, "slice_uuid='$slice_uuid'");
......@@ -204,6 +215,7 @@ sub creator_uuid($) { return field($_[0], "creator_uuid"); }
sub created($) { return field($_[0], "created"); }
sub credential_idx($) { return field($_[0], "credential_idx"); }
sub resource_uuid($) { return field($_[0], "resource_uuid"); }
sub resource_type($) { return field($_[0], "resource_type"); }
sub ticket_idx($) { return field($_[0], "ticket_idx"); }
sub component_idx($) { return field($_[0], "component_idx"); }
sub aggregate_idx($) { return field($_[0], "aggregate_idx"); }
......@@ -452,6 +464,54 @@ sub UnBindUser($$)
return 0;
}
#
# Create a signed credential for this sliver, issued to the provided user.
# The credential will grant all permissions for now.
#
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
{
my ($self, $owner) = @_;
return undef
if (! (ref($self) && ref($owner)));
my $credential = GeniCredential->Create($self, $owner);
if (!defined($credential)) {
print STDERR "Could not create credential for $self, $owner\n";
return undef;
}
if ($credential->Sign($self->GetCertificate()) != 0) {
print STDERR "Could not sign credential for $self, $owner\n";
return undef;
}
return $credential;
}
############################################################################
#
# The server side methods are in packages which inherit from above.
#
package GeniSliver::Node;
use vars qw(@ISA);
@ISA = "GeniSliver";
use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
use libdb qw(TBDB_ALLOCSTATE_RES_INIT_DIRTY);
sub Create()
{
my ($class, $slice, $user, $resource_uuid) = @_;
return GeniSliver->Create($slice, $user, $resource_uuid, "Node");
}
#
# Provision a slice. We actually did this when the ticket was requested.
# We fill in some virt table stuff so that tbswap will work.
......@@ -487,10 +547,6 @@ sub Provision($)
return -1;
}
if ($reservation->SameExperiment($experiment)) {
if ($experiment->InsertVirtNode($node) != 0) {
print STDERR "Could not add virtnode entry for $node to $self\n";
return -1;
}
# Set sliver_idx in the reservation so that Emulab knows.
if ($node->ModifyReservation({"genisliver_idx" => $self->idx()}) != 0){
return -1;
......@@ -508,31 +564,6 @@ sub Provision($)
return 0;
}
#
# Create a signed credential for this sliver, issued to the provided user.
# The credential will grant all permissions for now.
#
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
{
my ($self, $owner) = @_;
return undef
if (! (ref($self) && ref($owner)));
my $credential = GeniCredential->Create($self, $owner);
if (!defined($credential)) {
print STDERR "Could not create credential for $self, $owner\n";
return undef;
}
if ($credential->Sign($self->GetCertificate()) != 0) {
print STDERR "Could not sign credential for $self, $owner\n";
return undef;
}
return $credential;
}
#
# Unprovision a sliver.
#
......@@ -566,11 +597,6 @@ sub UnProvision($)
my $pid = $experiment->pid();
my $eid = $experiment->eid();
if ($experiment->DeleteVirtNode($node) != 0) {
print STDERR "Could remove virtnode entry for $node from $self\n";
return -1;
}
system("export NORELOAD=1; $NFREE -q $pid $eid $node_id");
if ($?) {
print STDERR "Could not deallocate $node from $self\n";
......@@ -628,6 +654,60 @@ sub StartUp($)
return 0;
}
##########################################################################
package GeniSliver::Interface;
use vars qw(@ISA);
@ISA = "GeniSliver";
use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
sub Create()
{
my ($class, $slice, $user, $resource_uuid) = @_;
return GeniSliver->Create($slice, $user, $resource_uuid, "Interface");
}
sub Provision($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0;
}
#
# Unprovision a sliver.
#
sub UnProvision($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0;
}
#
# Start a sliver, which means what?
#
sub StartUp($)
{
my ($self) = @_;
return -1
if (! ref($self));
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
......@@ -113,7 +113,8 @@ sub CreateFromSignedTicket($$;$$)
my ($rspec_node) = $doc->getElementsByTagName("rspec");
return undef
if (!defined($rspec_node));
my $rspec = XMLin($rspec_node->toString(), ForceArray => ["node"]);
my $rspec = XMLin($rspec_node->toString(), ForceArray => ["node",
"link"]);
# Dig out the slice uuid. Locally, I am not sure if we bother to
# keep slices in the DB (they are in the DB at geni central).
......
......@@ -24,23 +24,26 @@ if (! defined($this_user)) {
}
my $blob;
my $experiment = Experiment->Lookup("testbed", "one-node");
my $experiment = Experiment->Lookup("testbed", "too");
my @components;
my @resources;
my $ticket;
my $sliver;
#
# Create a Geni user from local user. This just checks the registry
# and inserts an entry if none exists.
# Create a Geni user from local user.
#
my $geniuser = GeniUser->CreateFromLocal($this_user);
if (!defined($geniuser)) {
die("Could not create a geni user from local user $this_user\n");
}
# Register at the ClearingHouse.
$geniuser->Register() == 0
or die("Could not register $geniuser at the Geni ClearingHouse.\n");
#
# Another user, for testing binding users to slices.
#
my $leebee = GeniUser->CreateFromLocal(User->Lookup("leebee"));
if (!defined($leebee)) {
die("Could not create a geni user from local user leebee\n");
......@@ -84,6 +87,11 @@ if ($credential->Sign($GeniCredential::LOCALSA_FLAG)) {
die("Could not sign slice credential!\n");
}
#
# Discover resources on each component. This stuff is just a placeholder
# for something else later. For now, we just pass the rspec right back
# to get the ticket.
#
foreach my $component (@components) {
my $rspec;
......@@ -97,11 +105,52 @@ foreach my $component (@components) {
my $rspec = $resources[0];
print Dumper($rspec);
$ticket = $components[0]->GetTicket($slice, $rspec, $this_user, $credential);
#
# Make myself an rspec request from the available resources. We need
# some code to generate this stuff.
#
my @keys = keys(%{$rspec->{'node'}});
my $node1 = $rspec->{'node'}->{$keys[0]};
my $node2 = $rspec->{'node'}->{$keys[1]};
my $nspec = {'node' => {$keys[0] => { "uuid" => $node1->{'uuid'} },
$keys[1] => { "uuid" => $node2->{'uuid'} },
},
'link' => {'link0' => { "link_name" => 'link0',
}
}
};
#
# Construct virtual topo information to send over with rspec. Private API.
# This is awful. Also need some code to generate this.
#
my $vtopo = {'node' => {$keys[0] => { "node_name" => "node1",
"osname" => "FBSD-STD",
},
$keys[1] => { "node_name" => "node2",
"osname" => "FBSD-STD",