Skip to content

GitLab

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

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
Hide whitespace changes
Inline Side-by-side
protogeni/lib/GeniAggregate.pm.in
View file @ 51caf999
......@@ -80,7 +80,15 @@ sub Lookup($$)
$self->{'CREDENTIAL'} = undef;
$self->{'SLICE'} = 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.
......@@ -117,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) = @_;
my ($class, $ticket, $aggregate_type) = @_;
my @insert_data = ();
# Every aggregate gets a new unique index.
......@@ -141,6 +149,8 @@ sub Create($$)
push(@insert_data, "uuid='$uuid'");
push(@insert_data, "creator_uuid='$owner_uuid'");
push(@insert_data, "slice_uuid='$slice_uuid'");
push(@insert_data, "type='$aggregate_type'")
if (defined($aggregate_type));
# Insert into DB.
if (!DBQueryWarn("insert into geni_aggregates set " .
......@@ -154,15 +164,62 @@ sub Create($$)
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
sub idx($) { return field($_[0], "idx"); }
sub uuid($) { return field($_[0], "uuid"); }
sub type($) { return field($_[0], "type"); }
sub slice_uuid($) { return field($_[0], "slice_uuid"); }
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 status($) { return field($_[0], "status"); }
sub cert($) { return $_[0]->{'CERTIFICATE'}->cert(); }
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.
#
......@@ -236,7 +293,7 @@ sub SetAggregate($$)
}
#
# Get the aggregate for a sliver.
# Get the aggregate for an aggregate.
#
sub GetAggregate($)
{
......@@ -258,6 +315,27 @@ sub GetAggregate($)
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.
#
......@@ -336,7 +414,7 @@ sub NewCredential($$)
#
# Start all the slivers in the aggregate.
#
sub StartUp($)
sub Start($)
{
my ($self) = @_;
......@@ -349,7 +427,7 @@ sub StartUp($)
return -1;
}
foreach my $sliver (@slivers) {
if ($sliver->StartUp() != 0) {
if ($sliver->Start() != 0) {
print STDERR "Could not start $sliver in $self\n";
next;
}
......@@ -357,6 +435,30 @@ sub StartUp($)
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.
#
......@@ -375,22 +477,43 @@ sub UnProvision($)
foreach my $sliver (@slivers) {
if ($sliver->UnProvision() != 0) {
print STDERR "Could not unprovision $sliver in $self\n";
DBQueryWarn("update geni_slivers set status='broken' ".
"where idx=" . $sliver->idx());
$sliver->SetStatus("broken");
next;
}
}
return 0;
}
############################################################################
#
# Destroy all the slivers in the aggregate, and then the aggregate if there
# is nothing in it. Leave it around if something goes wrong.
# Link aggregates need special handling.
#
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 $broken = 0;
return -1
if (! ref($self));
......@@ -400,32 +523,97 @@ sub Delete($)
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";
DBQueryWarn("update geni_slivers set status='broken' ".
"where idx=" . $sliver->idx());
$broken++;
next;
}
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->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
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;
#
# Unprovision all the slivers in the aggregate.
#
sub UnProvision($)
{
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;
}
......
protogeni/lib/GeniCM.pm.in
View file @ 51caf999
......@@ -88,11 +88,11 @@ sub DiscoverResources($)
# Eventually we will take an optional rspec, but for now just return
# 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,
"Could not start avail");
}
my @nodelist = ();
while (<AVAIL>) {
my $nodeid = $_;
chomp($nodeid);
......@@ -149,8 +149,8 @@ sub GetTicket($)
GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
"Improper rspec");
}
# Convert the rspec back to a structure.
$rspec = XMLin($rspec, ForceArray => ["node"]);
$rspec = XMLin($rspec, ForceArray => ["node", "link"]);
#print Dumper($rspec);
$impotent = 0
if (!defined($impotent));
......@@ -232,15 +232,13 @@ sub GetTicket($)
my $pid = $experiment->pid();
my $eid = $experiment->eid();
foreach my $node_id (keys(%{$rspec->{'node'}})) {
if ($node_id =~ /^(\w*)$/) {
$node_id = $1;
}
else {
foreach my $resource_uuid (keys(%{$rspec->{'node'}})) {
my $node = Node->Lookup($resource_uuid);
if (!defined($node)) {
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($)
"Could not create GeniAggregate object");
}
}
#print Dumper($ticket);
#
# Now for each resource (okay, node) in the ticket create a sliver and
......@@ -366,8 +365,9 @@ sub CreateSliver($)
#
my %slivers = ();
foreach my $resource_uuid (keys(%{$ticket->rspec()->{'node'}})) {
if (! ($resource_uuid =~ /^[-\w]*$/)) {
$message = "Improper resource_uuid in ticket: $resource_uuid";
my $node = Node->Lookup($resource_uuid);
if (!defined($node)) {
$message = "Unknown resource_uuid in ticket: $resource_uuid";
goto bad;
}
my $sliver = GeniSliver::Node->Create($slice, $owner, $resource_uuid);
......@@ -378,6 +378,64 @@ sub CreateSliver($)
$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
# above when the ticket was granted). The add the sliver to the aggregate.
......@@ -396,14 +454,13 @@ sub CreateSliver($)
}
#
# Run swapexp in update mode. The nodes are already allocated, but need
# to be configured like a real experiment.
# 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 (!$impotent) {
if (0 && !$impotent) {
system("$SWAPEXP -s modify -g $pid $eid");
if ($?) {
$message = "Failed to tbswap $pid,$eid";
......@@ -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;
}
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.
#
......@@ -528,7 +540,7 @@ sub StartSliver($)
"Invalid credentials for operation");
}
if (!$impotent) {
$sliver->StartUp() == 0 or
$sliver->Start() == 0 or
return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
"Could not start sliver/aggregate");
}
......
protogeni/lib/GeniSliver.pm.in
View file @ 51caf999
......@@ -104,7 +104,7 @@ sub Lookup($$)
# 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'});
bless($self, $class . "::" . $resource_type);
}
else {
bless($self, $class);
......@@ -292,6 +292,27 @@ sub GetAggregate($)
return $aggregate;
}
#
# Set the status for the sliver.
#
sub SetStatus($$)
{
my ($self, $status) = @_;
return undef
if (! ref($self));
my $idx = $self->idx();
return -1
if (!DBQueryWarn("update geni_slivers set ".
" status='$status' ".
"where idx='$idx'"));
$self->{'SLIVER'}->{'status'} = $status;
return 0;
}
#
# Get the experiment for the slice this sliver belongs to.
#
......@@ -547,14 +568,20 @@ 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;
}
#
# This is so tbswap and children do the right thing.
#
$node->SetAllocState(TBDB_ALLOCSTATE_RES_INIT_DIRTY());