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

Checkpoint working swapout of experiments with remote lans. Also

working program agents! Yippie.
parent e5566916
......@@ -83,7 +83,7 @@ sub Lookup($$)
# Bless into sub package if called for.
my $type = $self->{'AGGREGATE'}->{'type'};
if (defined($type) && $type ne "") {
if (defined($type) && $type ne "" && $type ne "Aggregate") {
bless($self, $class . "::" . $type);
}
else {
......@@ -125,9 +125,9 @@ sub Stringify($)
# for now. The client side does not actually know its an aggregate, at
# least not yet.
#
sub Create($$;$)
sub Create($$$$)
{
my ($class, $ticket, $aggregate_type) = @_;
my ($class, $ticket, $aggregate_type, $hrn) = @_;
my @insert_data = ();
# Every aggregate gets a new unique index.
......@@ -146,6 +146,7 @@ sub Create($$;$)
# Now tack on other stuff we need.
push(@insert_data, "created=now()");
push(@insert_data, "idx='$idx'");
push(@insert_data, "hrn=" . DBQuoteSpecial($hrn));
push(@insert_data, "uuid='$uuid'");
push(@insert_data, "creator_uuid='$owner_uuid'");
push(@insert_data, "slice_uuid='$slice_uuid'");
......@@ -227,6 +228,11 @@ sub hrn($)
{
my ($self) = @_;
my $hrn = field($self, "hrn");
if (defined($hrn) && $hrn ne "") {
return $hrn;
}
return $OURDOMAIN . ".aggregates." . $self->idx();
}
......@@ -532,11 +538,11 @@ use GeniAggregate;
use Experiment;
use Interface;
sub Create($$)
sub Create($$$)
{
my ($class, $ticket) = @_;
my ($class, $ticket, $hrn) = @_;
return GeniAggregate->Create($ticket, "Link");
return GeniAggregate->Create($ticket, "Link", $hrn);
}
#
......@@ -616,8 +622,8 @@ sub UnProvision($)
my $vlan = VLan->Lookup($experiment, $self->uuid());
if (! defined($vlan)) {
print STDERR "Could not map $self to its vlan object\n";
return -1;
print STDERR "No vlan associated with $self\n";
return 0;
}
if ($vlan->UnInstantiate() != 0) {
print STDERR "Could not uninstantiate $vlan\n";
......
......@@ -507,7 +507,8 @@ sub RedeemTicket($)
#
my $aggregate;
if (scalar(@{$ticket->rspec()->{'node'}}) > 1) {
$aggregate = GeniAggregate->Create($ticket);
$aggregate = GeniAggregate->Create($ticket, "Aggregate",
$slice->hrn());
if (!defined($aggregate)) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not create GeniAggregate object");
......@@ -551,7 +552,7 @@ sub RedeemTicket($)
goto bad;
}
my $linkaggregate = GeniAggregate::Link->Create($ticket);
my $linkaggregate = GeniAggregate::Link->Create($ticket, $linkname);
if (!defined($linkaggregate)) {
$message = "Could not create link aggregate for $linkname";
goto bad;
......@@ -775,14 +776,20 @@ sub DeleteSliver($)
}
else {
#
# Find dependent slivers first (say, links on a node). These
# have to be torn down first to prevent dangling vlans.
# Find dependent slivers first (say, links on a node). For now,
# do not allow this sliver to be torn down until the dependent
# sliver(s) are torn down first. Eventually we want to tear them
# down here in the proper order, hence the code below.
#
if ($sliver->DependentSlivers(\@slivers) != 0) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not get DependentSlivers");
}
@slivers = (@slivers, $sliver);
if (@slivers) {
return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
"Must tear dow dependent slivers");
}
@slivers = (@slivers, $sliver);
}
foreach $sliver (@slivers) {
......
......@@ -389,8 +389,7 @@ sub Sign($$)
# Who signs the credential? $how is either a flag (CM or SA) or its
# a certificate object in the DB.
#
my $certificate;
if (ref($how)) {
if (ref($how)) {
# This will auto delete too.
my $certfile = $how->WriteToFile();
if (!defined($certfile)) {
......
......@@ -252,9 +252,6 @@ sub AllocateSlivers($$$)
print STDERR "Could not get node/iface for $member\n";
return -1;
}
#
#
#
my $tmp = $pnode_component{$node->node_id()};
$component = $tmp
......@@ -268,6 +265,7 @@ sub AllocateSlivers($$$)
$component_lans{$component->uuid()} = []
if (!exists($component_lans{$component->uuid()}));
push(@{ $component_lans{$component->uuid()} }, $lan);
$lan->SetAttribute("geni-component", $component->uuid(), "string");
}
#
......@@ -422,6 +420,12 @@ sub InstantiateSlivers($$$)
return -1;
}
my @lans;
if (Lan->ExperimentLans($experiment, \@lans) != 0) {
print STDERR "Could not get lans for $experiment\n";
return -1;
}
#
# Loop through nodes, combining nodes at the same component into a
# list for that component.
......@@ -429,9 +433,11 @@ sub InstantiateSlivers($$$)
# Bookkeeping for the rest of this function.
my %components = ();
my %component_nodes = ();
my %component_lans = ();
my %component_tickets = ();
my %node_component = ();
my %node_slivers = ();
my %lan_slivers = ();
my %pnodes = ();
foreach my $node (@{ $nodelist }) {
......@@ -470,6 +476,19 @@ sub InstantiateSlivers($$$)
return -1;
}
}
foreach my $lan (@lans) {
next
if ($lan->type() ne "geni-vlan");
my $component_uuid;
if ($lan->GetAttribute("geni-component", \$component_uuid) != 0) {
print STDERR "Could not find geni-component attribute in $lan\n";
return -1;
}
$component_lans{$component_uuid} = []
if (!exists($component_lans{$component_uuid}));
push(@{ $component_lans{$component_uuid} }, $lan);
}
#
# For each component, submit the ticket associated with the list of
......@@ -477,8 +496,10 @@ sub InstantiateSlivers($$$)
#
foreach my $component_uuid (keys(%component_tickets)) {
my @nodelist = @{ $component_nodes{$component_uuid} };
my @lanlist = @{ $component_lans{$component_uuid} };
my $component = $components{$component_uuid};
my $ticket = $component_tickets{$component_uuid};
my @slivers = ();
#
# Create sliver on component using the ticket.
......@@ -502,14 +523,9 @@ sub InstantiateSlivers($$$)
# split it apart so that we have a credential for each node.
#
if (@nodelist > 1) {
my @slivers;
if ($component->SplitSliver($sliver, $context, \@slivers) != 0) {
print STDERR "Could not split $sliver on $component\n";
if ($sliver->Destroy($context) != 0) {
print STDERR "Could not destroy $sliver\n";
}
return -1;
goto bad;
}
foreach my $node (@nodelist) {
my $physnode = $pnodes{$node->uuid()};
......@@ -527,13 +543,32 @@ sub InstantiateSlivers($$$)
}
if (!defined($node_sliver)) {
print STDERR "Could not get sliver for $node in $sliver\n";
if ($sliver->Destroy($context) != 0) {
print STDERR "Could not destroy $sliver\n";
}
return -1;
goto bad;
}
$node_slivers{$node->uuid()} = $node_sliver;
}
foreach my $lan (@lanlist) {
next
if ($lan->type() ne "geni-vlan");
my $lan_sliver;
foreach my $s (@slivers) {
#
# XXX Bogus use of hrn, but I am assuming the only
# time this happens is when speaking to another Emulab
# which will be doing the same thing.
#
if ($s->hrn() eq $lan->vname()) {
$lan_sliver = $s;
last;
}
}
if (!defined($lan_sliver)) {
print STDERR "Could not get sliver for $lan in $sliver\n";
goto bad;
}
$lan_slivers{$lan->vname()} = $lan_sliver;
}
}
else {
# For loop below.
......@@ -545,9 +580,27 @@ sub InstantiateSlivers($$$)
if ($node->SetGeniSliverInfo($s->idx()) != 0) {
print STDERR "Could not set sliver idx for $node\n";
return -1;
goto bad;
}
}
foreach my $lan (@lanlist) {
my $s = $lan_slivers{$lan->vname()};
if ($lan->SetAttribute("geni-sliver", $s->idx(), "integer") != 0) {
print STDERR "Could not set sliver idx for $lan\n";
goto bad;
}
}
next;
bad:
foreach my $s (@slivers) {
$s->Delete();
}
if (defined($sliver) && $sliver->Destroy($context) != 0) {
print STDERR "Could not destroy $sliver\n";
}
return -1;
}
return 0;
}
......
......@@ -315,6 +315,28 @@ sub SetAggregate($$)
return 0;
}
#
# And clear the aggregate.
#
sub ClearAggregate($$)
{
my ($self) = @_;
return -1
if (! ref($self));
my $idx = $self->idx();
return -1
if (!DBQueryWarn("update geni_slivers set ".
" aggregate_uuid=NULL ".
"where idx='$idx'"));
$self->{'SLIVER'}->{'aggregate_uuid'} = undef;
$self->{'AGGREGATE'} = undef;
return 0;
}
#
# Get the aggregate for a sliver.
#
......
......@@ -220,7 +220,7 @@ sub CreateFromSignedTicket($$;$$)
# 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).
my ($uuid_node) = $doc->getElementsByTagName("target_uuid");
($uuid_node) = $doc->getElementsByTagName("target_uuid");
return undef
if (!defined($uuid_node));
my $slice_cert = $uuid_node->to_literal();
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment