Commit 86cd9965 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint working swapin of experiments using multiple federated nodes with...

Checkpoint working swapin of experiments using multiple federated nodes with vlans between them. Now I need to figure out how to swap the experiment out
parent ab9ad2ba
...@@ -220,6 +220,16 @@ sub Delete($) ...@@ -220,6 +220,16 @@ sub Delete($)
return 0; return 0;
} }
#
# Cons up an hrn.
#
sub hrn($)
{
my ($self) = @_;
return $OURDOMAIN . ".aggregates." . $self->idx();
}
# #
# Look up a list of aggregates for a locally instantiated slice. # Look up a list of aggregates for a locally instantiated slice.
# Used by the CM. # Used by the CM.
...@@ -258,9 +268,11 @@ sub SliverList($$) ...@@ -258,9 +268,11 @@ sub SliverList($$)
return -1 return -1
if (! (ref($self) && ref($pref))); if (! (ref($self) && ref($pref)));
my $idx = $self->idx(); my $idx = $self->idx();
my $uuid = $self->uuid();
my $query_result = my $query_result =
DBQueryWarn("select idx from geni_slivers where aggregate_idx='$idx'"); DBQueryWarn("select idx from geni_slivers ".
"where aggregate_uuid='$uuid'");
return -1 return -1
if (!$query_result); if (!$query_result);
...@@ -530,31 +542,23 @@ sub Provision($;$) ...@@ -530,31 +542,23 @@ sub Provision($;$)
print STDERR "Could not map $self to its experiment\n"; print STDERR "Could not map $self to its experiment\n";
return -1; return -1;
} }
my $sliver0 = $slivers[0];
my $sliver1 = $slivers[1];
my $interface0 = Interface->LookupByUUID($sliver0->resource_uuid());
my $interface1 = Interface->LookupByUUID($sliver1->resource_uuid());
if (! defined($interface0)) {
print STDERR "Could not map $sliver0 to its object\n";
return -1;
}
if (! defined($interface1)) {
print STDERR "Could not map $sliver1 to its object\n";
return -1;
}
my $vlan = VLan->Create($experiment, $self->uuid()); my $vlan = VLan->Create($experiment, $self->uuid());
if (!defined($vlan)) { if (!defined($vlan)) {
print STDERR "Could not create vlan for $self\n"; print STDERR "Could not create vlan for $self\n";
return -1;
}
if (! $vlan->AddMember($interface0->node_id(), $interface0->iface())) {
print STDERR "$self: Could not add $interface0 to $vlan\n";
goto bad; goto bad;
} }
if (! $vlan->AddMember($interface1->node_id(), $interface1->iface())) {
print STDERR "$self: Could not add $interface1 to $vlan\n"; foreach my $sliver (@slivers) {
goto bad; my $interface = Interface->LookupByUUID($sliver->resource_uuid());
if (! defined($interface)) {
print STDERR "Could not map $sliver to its interface object\n";
goto bad;
}
if (! $vlan->AddMember($interface->node_id(), $interface->iface())) {
print STDERR "$self: Could not add $interface to $vlan\n";
goto bad;
}
} }
if ($vlan->Instantiate() != 0) { if ($vlan->Instantiate() != 0) {
print STDERR "$self: Could not instantiate $vlan on switches\n"; print STDERR "$self: Could not instantiate $vlan on switches\n";
...@@ -591,18 +595,7 @@ sub UnProvision($) ...@@ -591,18 +595,7 @@ sub UnProvision($)
print STDERR "Could not map $self to its experiment\n"; print STDERR "Could not map $self to its experiment\n";
return -1; return -1;
} }
my $sliver0 = $slivers[0];
my $sliver1 = $slivers[1];
my $interface0 = Interface->LookupByUUID($sliver0->resource_uuid());
my $interface1 = Interface->LookupByUUID($sliver1->resource_uuid());
if (! defined($interface0)) {
print STDERR "Could not map $sliver0 to its object\n";
return -1;
}
if (! defined($interface1)) {
print STDERR "Could not map $sliver1 to its object\n";
return -1;
}
my $vlan = VLan->Lookup($experiment, $self->uuid()); my $vlan = VLan->Lookup($experiment, $self->uuid());
if (! defined($vlan)) { if (! defined($vlan)) {
print STDERR "Could not map self to its vlan object\n"; print STDERR "Could not map self to its vlan object\n";
......
...@@ -121,6 +121,7 @@ sub Resolve($) ...@@ -121,6 +121,7 @@ sub Resolve($)
# Return a blob. # Return a blob.
my $blob = { "hrn" => "${OURDOMAIN}." . $node->node_id(), my $blob = { "hrn" => "${OURDOMAIN}." . $node->node_id(),
"uuid" => $node->uuid(), "uuid" => $node->uuid(),
"role" => $node->role(),
}; };
# #
...@@ -134,15 +135,23 @@ sub Resolve($) ...@@ -134,15 +135,23 @@ sub Resolve($)
my @iblobs = (); my @iblobs = ();
foreach my $interface (@interfaces) { foreach my $interface (@interfaces) {
next
if (!defined($interface->switch_id()));
my $iblob = { "uuid" => $interface->uuid(), my $iblob = { "uuid" => $interface->uuid(),
"iface" => $interface->iface(), "iface" => $interface->iface(),
"type" => $interface->type(), "type" => $interface->type(),
"card" => $interface->card(), "card" => $interface->card(),
"port" => $interface->port(), "port" => $interface->port(),
"role" => $interface->role(), "role" => $interface->role(),
"IP" => $interface->IP(), "IP" => $interface->IP() || "",
"mask" => $interface->mask(), "mask" => $interface->mask() || "",
"MAC" => $interface->mac(), "MAC" => $interface->mac(),
"switch_id" => "${OURDOMAIN}." .
$interface->switch_id(),
"switch_card" => $interface->switch_card(),
"switch_port" => $interface->switch_port(),
"wire_type" => $interface->wire_type(),
}; };
push(@iblobs, $iblob); push(@iblobs, $iblob);
...@@ -505,6 +514,8 @@ sub RedeemTicket($) ...@@ -505,6 +514,8 @@ sub RedeemTicket($)
} }
} }
print Dumper($ticket->rspec());
# #
# Now for each resource (okay, node) in the ticket create a sliver and # Now for each resource (okay, node) in the ticket create a sliver and
# add it to the aggregate. # add it to the aggregate.
...@@ -550,14 +561,11 @@ sub RedeemTicket($) ...@@ -550,14 +561,11 @@ sub RedeemTicket($)
my $linkendpoints = my $linkendpoints =
$ticket->rspec()->{'link'}->{$linkname}->{'LinkEndPoints'}; $ticket->rspec()->{'link'}->{$linkname}->{'LinkEndPoints'};
my $src_interface_spec = $linkendpoints->{'source_interface'}; foreach my $ifacename (keys(%{ $linkendpoints })) {
my $dst_interface_spec = $linkendpoints->{'destination_interface'}; my $iface = $linkendpoints->{$ifacename};
my $node_uuid = $iface->{'node_uuid'};
my @interfaces = ($src_interface_spec, $dst_interface_spec); my $iface_name = $iface->{'iface_name'};
foreach my $iface (@interfaces) { my $nodesliver = $slivers{$node_uuid};
my $node_uuid = $iface->{'node_uuid'};
my $iface = $iface->{'iface_name'};
my $nodesliver= $slivers{$node_uuid};
if (!defined($nodesliver)) { if (!defined($nodesliver)) {
$message = "Link $linkname specifies a non-existent node"; $message = "Link $linkname specifies a non-existent node";
goto bad; goto bad;
...@@ -567,9 +575,9 @@ sub RedeemTicket($) ...@@ -567,9 +575,9 @@ sub RedeemTicket($)
$message = "Could not find node object for $node_uuid"; $message = "Could not find node object for $node_uuid";
goto bad; goto bad;
} }
my $interface = Interface->LookupByIface($nodeobject, $iface); my $interface = Interface->LookupByIface($nodeobject, $iface_name);
if (!defined($interface)) { if (!defined($interface)) {
$message = "No such interface $iface on node $nodeobject"; $message = "No such interface $iface_name on node $nodeobject";
goto bad; goto bad;
} }
my $sliver = GeniSliver::Interface->Create($slice, my $sliver = GeniSliver::Interface->Create($slice,
...@@ -589,8 +597,9 @@ sub RedeemTicket($) ...@@ -589,8 +597,9 @@ sub RedeemTicket($)
} }
# #
# Now do the provisioning (note that we actually allocated the node # Now do the provisioning (note that we actually allocated the
# above when the ticket was granted). The add the sliver to the aggregate. # node above when the ticket was granted). Then add the sliver to
# the aggregate.
# #
foreach my $sliver (values(%slivers)) { foreach my $sliver (values(%slivers)) {
if (!$impotent && $sliver->Provision($extraargs) != 0) { if (!$impotent && $sliver->Provision($extraargs) != 0) {
...@@ -1060,3 +1069,66 @@ sub DeleteSlice($) ...@@ -1060,3 +1069,66 @@ sub DeleteSlice($)
} }
return GeniResponse->Create(GENIRESPONSE_SUCCESS); return GeniResponse->Create(GENIRESPONSE_SUCCESS);
} }
#
# Split an aggregated sliver into its separate parts and return a list.
#
sub SplitSliver($)
{
my ($argref) = @_;
my $cred = $argref->{'credential'};
my $impotent = $argref->{'impotent'};
$impotent = 0
if (!defined($impotent));
if (!defined($cred)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS);
}
my $credential = GeniCredential->CreateFromSigned($cred);
if (!defined($credential)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniCredential object");
}
my $sliver_uuid = $credential->this_uuid();
my $user_uuid = $credential->owner_uuid();
#
# Make sure the credential was issued to the caller.
#
if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"This is not your credential!");
}
my $user = GeniUser->Lookup($user_uuid);
if (!defined($user)) {
$user = CreateUserFromRegistry($user_uuid);
if (!defined($user)) {
print STDERR "No user $user_uuid in the ClearingHouse\n";
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"No user record for $user_uuid");
}
}
my $aggregate = GeniAggregate->Lookup($sliver_uuid);
if (!defined($aggregate)) {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"No such aggregate $sliver_uuid");
}
my @sliver_list = ();
if ($aggregate->SliverList(\@sliver_list) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get slivers for $aggregate");
}
my @credentials = ();
foreach my $sliver (@sliver_list) {
my $credential = $sliver->NewCredential($user);
if (!defined($credential)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create credential for $sliver");
}
push(@credentials, $credential->asString());
}
return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@credentials);
}
...@@ -202,6 +202,19 @@ sub NewResource($$) ...@@ -202,6 +202,19 @@ sub NewResource($$)
return 0; return 0;
} }
#
# Compare two component refs.
#
sub SameComponent($$)
{
my ($self, $other) = @_;
return 0
if (! (ref($self) && ref($other)));
return $self->idx() == $other->idx();
}
# #
# Refresh a class instance by reloading from the DB. # Refresh a class instance by reloading from the DB.
# #
...@@ -398,16 +411,6 @@ sub CreateSliver($$$$;$) ...@@ -398,16 +411,6 @@ sub CreateSliver($$$$;$)
return undef; return undef;
} }
#
# We need to store this credential (not the default) so we can
# operate on the sliver later.
#
if ($credential->Store() != 0) {
print STDER "Could not store $credential for new sliver\n";
$credential->Delete();
return undef;
}
my $sliver = GeniSliver::Client->Create($slice, $ticket->owner_uuid(), my $sliver = GeniSliver::Client->Create($slice, $ticket->owner_uuid(),
$ticket->rspec(), $ticket->rspec(),
$credential, $self); $credential, $self);
...@@ -475,6 +478,65 @@ sub StartSliver($$$) ...@@ -475,6 +478,65 @@ sub StartSliver($$$)
return 0; return 0;
} }
#
# Split a sliver.
#
sub SplitSliver($$$$)
{
my ($self, $sliver, $context, $pref) = @_;
# Must be a real reference.
return -1
if (! ref($self));
my $credential = $sliver->GetCredential($context->user());
return -1
if (!defined($credential));
my $slice = $sliver->GetSlice();
return -1
if (!defined($slice));
my $response =
Genixmlrpc::CallMethod($self->url(), $context,
"SplitSliver",
{ "credential" => $credential->asString() });
if ($response->code() != GENIRESPONSE_SUCCESS) {
print STDERR "Could not split sliver $sliver\n";
return -1;
}
#
# We get back signed credentials, which has the sliver uuid inside.
#
my @slivers = ();
foreach my $credential (@{ $response->value() }) {
my $credential = GeniCredential->CreateFromSigned($credential, 1);
if (!defined($credential)) {
print STDERR "Could not create local credential object.\n";
return -1;
}
my $s = GeniSliver::Client->Create($slice,
$credential->owner_uuid(),
undef,
$credential, $self);
if (!defined($s)) {
print STDERR "Could not create local sliver object.\n";
return -1;
}
$s->SetAggregate($sliver);
# XXX Kludge for Emulab aggregates
$s->Sethrn($credential->hrn());
push(@slivers, $s);
}
@$pref = @slivers;
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;
...@@ -115,6 +115,7 @@ sub Create($$$$) ...@@ -115,6 +115,7 @@ sub Create($$$$)
$self->{'target_uuid'} = $target->uuid(); $self->{'target_uuid'} = $target->uuid();
$self->{'target_cert'} = $target->cert(); $self->{'target_cert'} = $target->cert();
$self->{'owner_uuid'} = $owner->uuid(); $self->{'owner_uuid'} = $owner->uuid();
$self->{'hrn'} = $target->hrn();
$self->{'string'} = undef; $self->{'string'} = undef;
$self->{'capabilities'} = undef; $self->{'capabilities'} = undef;
$self->{'idx'} = undef; # Only set when stored to DB. $self->{'idx'} = undef; # Only set when stored to DB.
...@@ -125,6 +126,7 @@ sub Create($$$$) ...@@ -125,6 +126,7 @@ sub Create($$$$)
# accessors # accessors
sub field($$) { return ($_[0]->{$_[1]}); } sub field($$) { return ($_[0]->{$_[1]}); }
sub idx($) { return field($_[0], "idx"); } sub idx($) { return field($_[0], "idx"); }
sub hrn($) { return field($_[0], "hrn"); }
sub target($) { return field($_[0], "target"); } sub target($) { return field($_[0], "target"); }
sub owner($) { return field($_[0], "owner"); } sub owner($) { return field($_[0], "owner"); }
sub this_uuid($) { return field($_[0], "target_uuid"); } sub this_uuid($) { return field($_[0], "target_uuid"); }
...@@ -196,7 +198,14 @@ sub CreateFromSigned($$;$) ...@@ -196,7 +198,14 @@ sub CreateFromSigned($$;$)
# Use XML::Simple to convert to something we can mess with. # Use XML::Simple to convert to something we can mess with.
my $parser = XML::LibXML->new; my $parser = XML::LibXML->new;
my $doc = $parser->parse_string($string); my $doc;
eval {
$doc = $parser->parse_string($string);
};
if ($@) {
print STDERR "Failed to parse credential string: $@\n";
return undef;
}
# Dig out the capabilities # Dig out the capabilities
my ($cap_node) = $doc->getElementsByTagName("capabilities"); my ($cap_node) = $doc->getElementsByTagName("capabilities");
...@@ -219,6 +228,12 @@ sub CreateFromSigned($$;$) ...@@ -219,6 +228,12 @@ sub CreateFromSigned($$;$)
return undef; return undef;
} }
# Dig out the hrn.
my ($hrn_node) = $doc->getElementsByTagName("hrn");
return undef
if (!defined($hrn_node));
my $hrn = $hrn_node->to_literal();
# Dig out the owner uuid. Locally, I am not sure if we bother to # Dig out the owner uuid. Locally, I am not sure if we bother to
# keep users in the DB (they are in the DB at geni central). # keep users in the DB (they are in the DB at geni central).
($uuid_node) = $doc->getElementsByTagName("owner_uuid"); ($uuid_node) = $doc->getElementsByTagName("owner_uuid");
...@@ -239,6 +254,7 @@ sub CreateFromSigned($$;$) ...@@ -239,6 +254,7 @@ sub CreateFromSigned($$;$)
$self->{'target_uuid'} = $this_uuid; $self->{'target_uuid'} = $this_uuid;
$self->{'target_cert'} = $this_cert; $self->{'target_cert'} = $this_cert;
$self->{'owner_uuid'} = $owner_uuid; $self->{'owner_uuid'} = $owner_uuid;
$self->{'hrn'} = $hrn;
$self->{'string'} = $string; $self->{'string'} = $string;
$self->{'target'} = undef; $self->{'target'} = undef;
$self->{'owner'} = undef; $self->{'owner'} = undef;
...@@ -288,6 +304,7 @@ sub Sign($$) ...@@ -288,6 +304,7 @@ sub Sign($$)
# Every one gets a new unique index, which is used in the xml:id below. # Every one gets a new unique index, which is used in the xml:id below.
my $idx = TBGetUniqueIndex('next_ticket', 1); my $idx = TBGetUniqueIndex('next_ticket', 1);
my $hrn = $self->hrn();
# #
# Need the certificates for target and owner of the credential. # Need the certificates for target and owner of the credential.
...@@ -313,7 +330,10 @@ sub Sign($$) ...@@ -313,7 +330,10 @@ sub Sign($$)
" <type>capability</type>\n". " <type>capability</type>\n".
" <serial>$idx</serial>\n". " <serial>$idx</serial>\n".
" <owner_uuid>$owner_cert</owner_uuid>\n". " <owner_uuid>$owner_cert</owner_uuid>\n".
" <target_uuid>$target_cert</target_uuid>\n".
" <this_uuid>$target_cert</this_uuid>\n". " <this_uuid>$target_cert</this_uuid>\n".
" <hrn>$hrn</hrn>\n".
" <expires>2008-05-10T09:00:00</expires>\n".
" $cap_xml\n". " $cap_xml\n".
"</credential>\n"; "</credential>\n";
......
...@@ -31,6 +31,7 @@ use libtestbed; ...@@ -31,6 +31,7 @@ use libtestbed;
use User; use User;
use Node; use Node;
use Interface; use Interface;
use Lan;
use English; use English;
use Data::Dumper; use Data::Dumper;
use Experiment; use Experiment;
...@@ -180,36 +181,25 @@ sub AllocateSlivers($$$) ...@@ -180,36 +181,25 @@ sub AllocateSlivers($$$)
} }
# #
# Loop through each node and grab a ticket for it. The nodes table # Loop through nodes, combining nodes at the same component into a
# stores the uuid of the node as told to us in resource discovery. # list for that component.
# Use this to create a simple rspec. This will need to get fancier
# later.
#
# XXX We are still not using rspecs anywhere.
# #
# Bookkeeping for the rest of this function.
my %components = ();
my %component_nodes = ();
my %node_component = ();
my %pnode_component = ();
foreach my $node (@{ $nodelist }) { foreach my $node (@{ $nodelist }) {
my $sliver_idx;
return -1
if ($node->GetGeniSliverInfo(\$sliver_idx) != 0);
next
if ($sliver_idx);
# #
# The node is a virtnode, but we want a ticket for the physnode. # The node is a virtnode, but we want a ticket for the physnode.
# #
my $physnode = Node->Lookup($node->phys_nodeid()); my $pnode = Node->Lookup($node->phys_nodeid());
return -1 return -1
if (!defined($physnode)); if (!defined($pnode));
my $node_uuid = $physnode->uuid();
my $rspec =
"<rspec xmlns=\"http://protogeni.net/resources/rspec/0.1\"> " .
" <node uuid=\"$node_uuid\" ".
" virtualization_type=\"emulab-vnode\"> " .
" </node>" .
"</rspec>";
my $node_uuid = $pnode->uuid();
# #
# XXX The component is stored in the geni_resources table. Not sure # XXX The component is stored in the geni_resources table. Not sure
# how that will work out. # how that will work out.
...@@ -219,17 +209,161 @@ sub AllocateSlivers($$$) ...@@ -219,17 +209,161 @@ sub AllocateSlivers($$$)
print STDERR "Could not find CM for $node\n"; print STDERR "Could not find CM for $node\n";
return -1; return -1;
} }
$component_nodes{$component->uuid()} = []
if (!exists($component_nodes{$component->uuid()}));
push(@{ $component_nodes{$component->uuid()} }, $node);
$node_component{$node->node_id()} = $component;
$pnode_component{$pnode->node_id()} = $component;
$components{$component->uuid()} = $component;
}
#
# Now find links and lans between nodes, which of course must be at
# the same components since we talking about real vlans, not tunnels.
#
my %component_lans = ();
my @lans;
if (Lan->ExperimentLans($experiment, \@lans) != 0) {
print STDERR "Could not get lans for $experiment\n";
return -1;
}
foreach my $lan (@lans) {
next
if ($lan->type() ne "geni-vlan");
my @members;
if ($lan->MemberList(\@members) != 0) {
print STDERR "Could not get members for $lan\n";
return -1;