Commit 51caf999 authored by Leigh Stoller's avatar Leigh 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($$)
$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;
}
......
......@@ -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");
}
......
......@@ -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());
# Set it to boot the default OS.
if ($node->SelectOS() != 0) {
return -1;
}
}
else {
print STDERR "$node is reserved to another, not $self\n";
......@@ -597,6 +624,11 @@ 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";
......@@ -614,7 +646,7 @@ sub UnProvision($)
#
# Start a sliver, which means what?
#
sub StartUp($)
sub Start($)
{
my ($self) = @_;
......@@ -644,7 +676,7 @@ sub StartUp($)
#
# Reboot and wait?
#
#system("$NODEREBOOT $node_id");
system("$NODEREBOOT $node_id");
}
else {
print STDERR "$node is reserved to another, not $self\n";
......@@ -665,6 +697,9 @@ use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
use Interface;
use Experiment;
use Node;
sub Create()
{
......@@ -697,9 +732,9 @@ sub UnProvision($)
}
#
# Start a sliver, which means what?
# Start a sliver.
#
sub StartUp($)
sub Start($)
{
my ($self) = @_;
......
......@@ -24,7 +24,7 @@ if (! defined($this_user)) {
}
my $blob;
my $experiment = Experiment->Lookup("testbed", "too");
my $experiment = Experiment->Lookup("testbed", "two");
my @components;
my @resources;
my $ticket;
......@@ -44,9 +44,9 @@ $geniuser->Register() == 0
#
# 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");
my $rricci = GeniUser->CreateFromLocal(User->Lookup("rricci"));
if (!defined($rricci)) {
die("Could not create a geni user from local user rricci\n");
}
#
......@@ -112,41 +112,43 @@ print Dumper($rspec);
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",
},
my $nspec = {'node' => {$node1->{'uuid'} => { "uuid" => $node1->{'uuid'},
"node_name" => $keys[0],
},
$node2->{'uuid'} => { "uuid" => $node2->{'uuid'},
"node_name" => $keys[0],
},
},
'link' => {'link0' => { $keys[0] => { "IP" => "10.1.1.1"
},
$keys[1] => { "IP" => "10.1.1.2"
},
}
}
'link' => {
'link0' => {
"link_name" => 'link0',
"LinkEndPoints" => {
"source_interface" => {