Commit 51caf999 authored by Leigh B. Stoller's avatar Leigh B. Stoller

Checkpoint. Raw links now work via an rspec. Note that these are

completely raw links; just a vlan between two interfaces. No traffic
shaping or anything like that.
parent e6e0405a
...@@ -80,7 +80,15 @@ sub Lookup($$) ...@@ -80,7 +80,15 @@ sub Lookup($$)
$self->{'CREDENTIAL'} = undef; $self->{'CREDENTIAL'} = undef;
$self->{'SLICE'} = undef; $self->{'SLICE'} = undef;
$self->{'PARENT'} = undef; $self->{'PARENT'} = undef;
bless($self, $class);
# Bless into sub package if called for.
my $type = $self->{'AGGREGATE'}->{'type'};
if (defined($type) && $type ne "") {
bless($self, $class . "::" . $type);
}
else {
bless($self, $class);
}
# #
# Grab the certificate, since we will probably want it. # Grab the certificate, since we will probably want it.
...@@ -117,9 +125,9 @@ sub Stringify($) ...@@ -117,9 +125,9 @@ sub Stringify($)
# for now. The client side does not actually know its an aggregate, at # for now. The client side does not actually know its an aggregate, at
# least not yet. # least not yet.
# #
sub Create($$) sub Create($$;$)
{ {
my ($class, $ticket) = @_; my ($class, $ticket, $aggregate_type) = @_;
my @insert_data = (); my @insert_data = ();
# Every aggregate gets a new unique index. # Every aggregate gets a new unique index.
...@@ -141,6 +149,8 @@ sub Create($$) ...@@ -141,6 +149,8 @@ sub Create($$)
push(@insert_data, "uuid='$uuid'"); push(@insert_data, "uuid='$uuid'");
push(@insert_data, "creator_uuid='$owner_uuid'"); push(@insert_data, "creator_uuid='$owner_uuid'");
push(@insert_data, "slice_uuid='$slice_uuid'"); push(@insert_data, "slice_uuid='$slice_uuid'");
push(@insert_data, "type='$aggregate_type'")
if (defined($aggregate_type));
# Insert into DB. # Insert into DB.
if (!DBQueryWarn("insert into geni_aggregates set " . if (!DBQueryWarn("insert into geni_aggregates set " .
...@@ -154,15 +164,62 @@ sub Create($$) ...@@ -154,15 +164,62 @@ sub Create($$)
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); } sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
sub idx($) { return field($_[0], "idx"); } sub idx($) { return field($_[0], "idx"); }
sub uuid($) { return field($_[0], "uuid"); } sub uuid($) { return field($_[0], "uuid"); }
sub type($) { return field($_[0], "type"); }
sub slice_uuid($) { return field($_[0], "slice_uuid"); } sub slice_uuid($) { return field($_[0], "slice_uuid"); }
sub creator_uuid($) { return field($_[0], "creator_uuid"); } sub creator_uuid($) { return field($_[0], "creator_uuid"); }
sub created($) { return field($_[0], "created"); } sub created($) { return field($_[0], "created"); }
sub credential_idx($) { return field($_[0], "credential_idx"); } sub credential_idx($) { return field($_[0], "credential_idx"); }
sub ticket_idx($) { return field($_[0], "ticket_idx"); } sub ticket_idx($) { return field($_[0], "ticket_idx"); }
sub aggregate_idx($) { return field($_[0], "aggregate_idx"); } sub aggregate_idx($) { return field($_[0], "aggregate_idx"); }
sub status($) { return field($_[0], "status"); }
sub cert($) { return $_[0]->{'CERTIFICATE'}->cert(); } sub cert($) { return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($) { return $_[0]->{'CERTIFICATE'}; } sub GetCertificate($) { return $_[0]->{'CERTIFICATE'}; }
#
# Destroy all the slivers in the aggregate, and then the aggregate if there
# is nothing in it. Leave it around if something goes wrong.
#
sub Delete($)
{
my ($self) = @_;
my $broken = 0;
return -1
if (! ref($self));
my @slivers = ();
if ($self->SliverList(\@slivers) != 0) {
print STDERR "Could not get sliver list for $self\n";
return -1;
}
foreach my $sliver (@slivers) {
if ($sliver->status() eq "broken") {
$broken++;
next;
}
if ($sliver->Delete() != 0) {
print STDERR "Could not delete $sliver from $self\n";
$sliver->SetStatus("broken");
$broken++;
next;
}
}
return -1
if ($broken);
my $idx = $self->idx();
my $uuid = $self->uuid();
DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
or return -1;
DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
or return -1;
DBQueryWarn("delete from geni_aggregates where idx='$idx'")
or return -1;
return 0;
}
# #
# List of slivers for this aggregate. # List of slivers for this aggregate.
# #
...@@ -236,7 +293,7 @@ sub SetAggregate($$) ...@@ -236,7 +293,7 @@ sub SetAggregate($$)
} }
# #
# Get the aggregate for a sliver. # Get the aggregate for an aggregate.
# #
sub GetAggregate($) sub GetAggregate($)
{ {
...@@ -258,6 +315,27 @@ sub GetAggregate($) ...@@ -258,6 +315,27 @@ sub GetAggregate($)
return $aggregate; return $aggregate;
} }
#
# Set the status for the aggregate
#
sub SetStatus($$)
{
my ($self, $status) = @_;
return undef
if (! ref($self));
my $idx = $self->idx();
return -1
if (!DBQueryWarn("update geni_aggregates set ".
" status='$status' ".
"where idx='$idx'"));
$self->{'AGGREGATE'}->{'status'} = $status;
return 0;
}
# #
# Get the credential for the aggregate. # Get the credential for the aggregate.
# #
...@@ -336,7 +414,7 @@ sub NewCredential($$) ...@@ -336,7 +414,7 @@ sub NewCredential($$)
# #
# Start all the slivers in the aggregate. # Start all the slivers in the aggregate.
# #
sub StartUp($) sub Start($)
{ {
my ($self) = @_; my ($self) = @_;
...@@ -349,7 +427,7 @@ sub StartUp($) ...@@ -349,7 +427,7 @@ sub StartUp($)
return -1; return -1;
} }
foreach my $sliver (@slivers) { foreach my $sliver (@slivers) {
if ($sliver->StartUp() != 0) { if ($sliver->Start() != 0) {
print STDERR "Could not start $sliver in $self\n"; print STDERR "Could not start $sliver in $self\n";
next; next;
} }
...@@ -357,6 +435,30 @@ sub StartUp($) ...@@ -357,6 +435,30 @@ sub StartUp($)
return 0; return 0;
} }
#
# Provision all the slivers in the aggregate.
#
sub Provision($)
{
my ($self) = @_;
return -1
if (! ref($self));
my @slivers = ();
if ($self->SliverList(\@slivers) != 0) {
print STDERR "Could not get sliver list for $self\n";
return -1;
}
foreach my $sliver (@slivers) {
if ($sliver->Provision() != 0) {
print STDERR "Could not provision $sliver in $self\n";
next;
}
}
return 0;
}
# #
# Unprovision all the slivers in the aggregate. # Unprovision all the slivers in the aggregate.
# #
...@@ -375,22 +477,43 @@ sub UnProvision($) ...@@ -375,22 +477,43 @@ sub UnProvision($)
foreach my $sliver (@slivers) { foreach my $sliver (@slivers) {
if ($sliver->UnProvision() != 0) { if ($sliver->UnProvision() != 0) {
print STDERR "Could not unprovision $sliver in $self\n"; print STDERR "Could not unprovision $sliver in $self\n";
DBQueryWarn("update geni_slivers set status='broken' ". $sliver->SetStatus("broken");
"where idx=" . $sliver->idx());
next; next;
} }
} }
return 0; return 0;
} }
############################################################################
# #
# Destroy all the slivers in the aggregate, and then the aggregate if there # Link aggregates need special handling.
# is nothing in it. Leave it around if something goes wrong.
# #
sub Delete($) package GeniAggregate::Link;
use vars qw(@ISA);
@ISA = "GeniAggregate";
use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
use Experiment;
use Interface;
sub Create($$)
{
my ($class, $ticket) = @_;
return GeniAggregate->Create($ticket, "Link");
}
#
# Provision all the slivers in the aggregate.
#
sub Provision($)
{ {
my ($self) = @_; my ($self) = @_;
my $broken = 0;
return -1 return -1
if (! ref($self)); if (! ref($self));
...@@ -400,32 +523,97 @@ sub Delete($) ...@@ -400,32 +523,97 @@ sub Delete($)
print STDERR "Could not get sliver list for $self\n"; print STDERR "Could not get sliver list for $self\n";
return -1; return -1;
} }
foreach my $sliver (@slivers) {
if ($sliver->status() eq "broken") { my $experiment = Experiment->Lookup($self->slice_uuid());
$broken++; if (!defined($experiment)) {
next; print STDERR "Could not map $self to its experiment\n";
} return -1;
if ($sliver->Delete() != 0) { }
print STDERR "Could not delete $sliver from $self\n"; my $sliver0 = $slivers[0];
DBQueryWarn("update geni_slivers set status='broken' ". my $sliver1 = $slivers[1];
"where idx=" . $sliver->idx()); my $interface0 = Interface->LookupByUUID($sliver0->resource_uuid());
$broken++; my $interface1 = Interface->LookupByUUID($sliver1->resource_uuid());
next; 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());
if (!defined($vlan)) {
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;
}
if (! $vlan->AddMember($interface1->node_id(), $interface1->iface())) {
print STDERR "$self: Could not add $interface1 to $vlan\n";
goto bad;
}
if ($vlan->Instantiate() != 0) {
print STDERR "$self: Could not instantiate $vlan on switches\n";
goto bad;
} }
return 0;
bad:
$vlan->UnInstantiate()
if (defined($vlan));
$vlan->Destroy()
if (defined($vlan));
return -1 return -1
if ($broken); }
my $idx = $self->idx();
my $uuid = $self->uuid();
DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'") #
or return -1; # Unprovision all the slivers in the aggregate.
DBQueryWarn("delete from geni_certificates where uuid='$uuid'") #
or return -1; sub UnProvision($)
DBQueryWarn("delete from geni_aggregates where idx='$idx'") {
or return -1; my ($self) = @_;
return -1
if (! ref($self));
my @slivers = ();
if ($self->SliverList(\@slivers) != 0) {
print STDERR "Could not get sliver list for $self\n";
return -1;
}
my $experiment = Experiment->Lookup($self->slice_uuid());
if (!defined($experiment)) {
print STDERR "Could not map $self to its experiment\n";
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());
if (! defined($vlan)) {
print STDERR "Could not map self to its vlan object\n";
return -1;
}
if ($vlan->UnInstantiate() != 0) {
print STDERR "Could not uninstantiate $vlan\n";
return -1;
}
if ($vlan->Destroy() != 0) {
print STDERR "Could not destroy $vlan\n";
return -1;
}
return 0; return 0;
} }
......
...@@ -88,11 +88,11 @@ sub DiscoverResources($) ...@@ -88,11 +88,11 @@ sub DiscoverResources($)
# Eventually we will take an optional rspec, but for now just return # Eventually we will take an optional rspec, but for now just return
# a list of free nodes using avail. # a list of free nodes using avail.
# #
if (! open(AVAIL, "$AVAIL type=pc aslist |")) { my @nodelist = ();
if (! open(AVAIL, "$AVAIL type=pc aslist |")) {
return GeniResponse->Create(GENIRESPONSE_ERROR, undef, return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not start avail"); "Could not start avail");
} }
my @nodelist = ();
while (<AVAIL>) { while (<AVAIL>) {
my $nodeid = $_; my $nodeid = $_;
chomp($nodeid); chomp($nodeid);
...@@ -149,8 +149,8 @@ sub GetTicket($) ...@@ -149,8 +149,8 @@ sub GetTicket($)
GeniResponse->Create(GENIRESPONSE_BADARGS, undef, GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Improper rspec"); "Improper rspec");
} }
# Convert the rspec back to a structure. $rspec = XMLin($rspec, ForceArray => ["node", "link"]);
$rspec = XMLin($rspec, ForceArray => ["node"]); #print Dumper($rspec);
$impotent = 0 $impotent = 0
if (!defined($impotent)); if (!defined($impotent));
...@@ -232,15 +232,13 @@ sub GetTicket($) ...@@ -232,15 +232,13 @@ sub GetTicket($)
my $pid = $experiment->pid(); my $pid = $experiment->pid();
my $eid = $experiment->eid(); my $eid = $experiment->eid();
foreach my $node_id (keys(%{$rspec->{'node'}})) { foreach my $resource_uuid (keys(%{$rspec->{'node'}})) {
if ($node_id =~ /^(\w*)$/) { my $node = Node->Lookup($resource_uuid);
$node_id = $1; if (!defined($node)) {
}
else {
return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Improper node id: $node_id"); "Bad resource_uuid $resource_uuid");
} }
push(@nodeids, $node_id); push(@nodeids, $node->node_id());
} }
# #
...@@ -359,6 +357,7 @@ sub CreateSliver($) ...@@ -359,6 +357,7 @@ sub CreateSliver($)
"Could not create GeniAggregate object"); "Could not create GeniAggregate object");
} }
} }
#print Dumper($ticket);
# #
# 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
...@@ -366,8 +365,9 @@ sub CreateSliver($) ...@@ -366,8 +365,9 @@ sub CreateSliver($)
# #
my %slivers = (); my %slivers = ();
foreach my $resource_uuid (keys(%{$ticket->rspec()->{'node'}})) { foreach my $resource_uuid (keys(%{$ticket->rspec()->{'node'}})) {
if (! ($resource_uuid =~ /^[-\w]*$/)) { my $node = Node->Lookup($resource_uuid);
$message = "Improper resource_uuid in ticket: $resource_uuid"; if (!defined($node)) {
$message = "Unknown resource_uuid in ticket: $resource_uuid";
goto bad; goto bad;
} }
my $sliver = GeniSliver::Node->Create($slice, $owner, $resource_uuid); my $sliver = GeniSliver::Node->Create($slice, $owner, $resource_uuid);
...@@ -378,6 +378,64 @@ sub CreateSliver($) ...@@ -378,6 +378,64 @@ sub CreateSliver($)
$slivers{$resource_uuid} = $sliver; $slivers{$resource_uuid} = $sliver;
} }
#
# Now do the links. For each link, we have to add a sliver for the
# interfaces, and then combine those two interfaces into an aggregate,
# and then that aggregate goes into the aggregate for toplevel sliver.
#
foreach my $linkname (keys(%{$ticket->rspec()->{'link'}})) {
my @linkslivers = ();
if (! ($linkname =~ /^[-\w]*$/)) {
$message = "Bad name for link: $linkname";
goto bad;
}
my $linkaggregate = GeniAggregate::Link->Create($ticket);
if (!defined($linkaggregate)) {
$message = "Could not create link aggregate for $linkname";
goto bad;
}
$slivers{$linkaggregate->uuid()} = $linkaggregate;
my $linkendpoints =
$ticket->rspec()->{'link'}->{$linkname}->{'LinkEndPoints'};
my $src_interface_spec = $linkendpoints->{'source_interface'};
my $dst_interface_spec = $linkendpoints->{'destination_interface'};
my @interfaces = ($src_interface_spec, $dst_interface_spec);
foreach my $iface (@interfaces) {
my $node_uuid = $iface->{'node_uuid'};
my $iface = $iface->{'iface_name'};
my $nodesliver= $slivers{$node_uuid};
if (!defined($nodesliver)) {
$message = "Link $linkname specifies a non-existent node";
goto bad;
}
my $nodeobject= Node->Lookup($node_uuid);
if (!defined($nodeobject)) {
$message = "Could not find node object for $node_uuid";
goto bad;
}
my $interface = Interface->LookupByIface($nodeobject, $iface);
if (!defined($interface)) {
$message = "No such interface $iface on node $nodeobject";
goto bad;
}
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;
}
}
}
# #
# Now do the provisioning (note that we actually allocated the node # Now do the provisioning (note that we actually allocated the node
# above when the ticket was granted). The add the sliver to the aggregate. # above when the ticket was granted). The add the sliver to the aggregate.
...@@ -396,14 +454,13 @@ sub CreateSliver($) ...@@ -396,14 +454,13 @@ sub CreateSliver($)
} }
# #
# Run swapexp in update mode. The nodes are already allocated, but need # This stuff needs to be moved elsewhere.
# to be configured like a real experiment.
# #
# XXX What if we have multiple slivers for this slice? We are going # 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 # 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. # tbswap only once, or at least no more then one at a time.
# #
if (!$impotent) { if (0 && !$impotent) {
system("$SWAPEXP -s modify -g $pid $eid"); system("$SWAPEXP -s modify -g $pid $eid");
if ($?) { if ($?) {
$message = "Failed to tbswap $pid,$eid"; $message = "Failed to tbswap $pid,$eid";
...@@ -411,51 +468,6 @@ sub CreateSliver($) ...@@ -411,51 +468,6 @@ sub CreateSliver($)
} }
} }
#
# 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;
}