Checkpoint changes for sucessful swapout of experiments using remote

vlans.

protogeni/lib/GeniAggregate.pm.in

@@ -488,7 +488,25 @@ sub UnProvision($)
 	print STDERR "Could not get sliver list for $self\n";
 	return -1;
     }
+
+    #
+    # Might be an aggregate that includes link aggregates. Lets do those
+    # first to avoid work when tearing down the nodes.
+    #
+    my @nonlinks = ();
+
     foreach my $sliver (@slivers) {
+	if (! (ref($sliver) eq "GeniAggregate" and $sliver->type() eq "Link")){
+	    push(@nonlinks, $sliver);
+	    next;
+	}
+	if ($sliver->UnProvision() != 0) {
+	    print STDERR "Could not unprovision $sliver in $self\n";
+	    $sliver->SetStatus("broken");
+	    next;
+	}
+    }
+    foreach my $sliver (@nonlinks) {
 	if ($sliver->UnProvision() != 0) {
 	    print STDERR "Could not unprovision $sliver in $self\n";
 	    $sliver->SetStatus("broken");
@@ -550,7 +568,7 @@ sub Provision($;$)
     }
 
     foreach my $sliver (@slivers) {
-	my $interface = Interface->LookupByUUID($sliver->resource_uuid());
+	my $interface = Interface->LookupByUUID($sliver->uuid());
 	if (! defined($interface)) {
 	    print STDERR "Could not map $sliver to its interface object\n";
 	    goto bad;
@@ -598,7 +616,7 @@ sub UnProvision($)
 
     my $vlan = VLan->Lookup($experiment, $self->uuid());
     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";
 	return -1;
     }
     if ($vlan->UnInstantiate() != 0) {

protogeni/lib/GeniCM.pm.in

@@ -583,6 +583,7 @@ sub RedeemTicket($)
 	    my $sliver = GeniSliver::Interface->Create($slice,
 						       $owner->uuid(),
 						       $interface->uuid(),
+						       $node_uuid,
 			       $ticket->rspec()->{'link'}->{$linkname});
 	    if (!defined($sliver)) {
 		$message = "Could not create GeniSliver ".
@@ -753,6 +754,7 @@ sub DeleteSliver($)
     }
     my $sliver_uuid = $credential->this_uuid();
     my $user_uuid   = $credential->owner_uuid();
+    my @slivers     = ();
     
     #
     # Make sure the credential was issued to the caller.
@@ -764,21 +766,35 @@ sub DeleteSliver($)
     my $sliver = GeniSliver->Lookup($sliver_uuid);
     if (!defined($sliver)) {
 	# Might be an aggregate instead.
-	$sliver = GeniAggregate->Lookup($sliver_uuid);
-	if (!defined($sliver)) {
+	my $aggregate = GeniAggregate->Lookup($sliver_uuid);
+	if (!defined($aggregate)) {
 	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
 				    "No such sliver/aggregate $sliver_uuid");
 	}
+	push(@slivers, $aggregate);
     }
-    if (!$impotent) {
-	$sliver->UnProvision() == 0 or
+    else {
+	# 
+	# Find dependent slivers first (say, links on a node). These
+	# have to be torn down first to prevent dangling vlans.
+	#
+	if ($sliver->DependentSlivers(\@slivers) != 0) {
 	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				"Could not unprovision sliver/aggregate");
+					"Could not get DependentSlivers");
+	}
+	@slivers = (@slivers, $sliver);
+    }
+
+    foreach $sliver (@slivers) {
+	if (!$impotent) {
+	    $sliver->UnProvision() == 0 or
+		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					    "Could not unprovision sliver");
+	}
+	$sliver->Delete() == 0 or
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					"Could not delete sliver");
     }
-    $sliver->Delete() == 0 or
-	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "Could not delete sliver/aggregate");
-    
     return GeniResponse->Create(GENIRESPONSE_SUCCESS);
 }
 
@@ -961,7 +977,26 @@ sub CleanupDeadSlice($)
 	print STDERR "Could not get dead aggregates for $slice.\n";
 	return -1;
     }
+    #
+    # Link aggregates first.
+    #
+    my @nonlinks = ();
+    
     foreach my $aggregate (@aggregates) {
+	if ($aggregate->type() ne "Link") {
+	    push(@nonlinks, $aggregate);
+	    next;
+	}
+	if ($aggregate->UnProvision() != 0) {
+	    print STDERR "Could not UnProvision $aggregate\n";
+	    return -1;
+	}
+	if ($aggregate->Delete() != 0) {
+	    print STDERR "Could not delete $aggregate\n";
+	    return -1;
+	}
+    }
+    foreach my $aggregate (@nonlinks) {
 	if ($aggregate->UnProvision() != 0) {
 	    print STDERR "Could not UnProvision $aggregate\n";
 	    return -1;

protogeni/lib/GeniEmulab.pm.in

@@ -683,6 +683,77 @@ sub DestroySlivers($$$)
     return $errors;
 }
 
+#
+# Teardown links.
+#
+sub DestroyLinks($$)
+{
+    my ($class, $experiment) = @_;
+    my $thisuser = User->ThisUser();
+    my $errors   = 0;
+
+    #
+    # The RPC context for this test script is mostly as an SA.
+    #
+    Genixmlrpc->SetContext(Genixmlrpc->Context("@prefix@/etc/genisa.pem"));
+
+    #
+    # except when it has to be as the user.
+    #
+    my $context = Genixmlrpc->UserContext($thisuser);
+
+    my $slice = GeniSlice->LookupByExperiment($experiment);
+    if (!defined($slice)) {
+	print STDERR "No local slice record for $experiment\n";
+	return -1;
+    }
+
+    #
+    # Lookup all geni-vlans and get the sliver idx from the lan attributes
+    # table. Then kill them.
+    #
+    my @lans;
+    if (Lan->ExperimentLans($experiment, \@lans) != 0) {
+	print STDERR "Could not get lans for $experiment\n";
+	return -1;
+    }
+    return 0
+	if (! @lans);
+
+    foreach my $lan (@lans) {
+	next
+	    if ($lan->type() ne "geni-vlan");
+
+	my $sliver_idx;
+
+	if ($lan->GetAttribute("geni-sliver", \$sliver_idx) != 0) {
+	    print STDERR "Could not get sliver idx for $lan\n";
+	    $errors++;
+	    next;
+	}
+	if (!defined($sliver_idx) || $sliver_idx == 0) {
+	    print STDERR "Sliver idx is not defined for $lan\n";
+	    $errors++;
+	    next;
+	}
+
+	my $sliver = GeniSliver->Lookup($sliver_idx);
+	if (!defined($sliver)) {
+	    print STDERR "Could not find sliver for $lan in $experiment\n";
+	    $errors++;
+	    next;
+	}
+	print STDERR "Releasing $sliver for $lan\n";
+	
+	if ($sliver->Destroy($context) != 0) {
+	    print STDERR "Could not destroy $sliver for $lan\n";
+	    $errors++;
+	    next;
+	}
+    }
+    return $errors;
+}
+
 
 # _Always_ make sure that this 1 is at the end of the file...
 1;

protogeni/lib/GeniSliver.pm.in

@@ -470,6 +470,39 @@ sub SliceSlivers($$$)
     return 0;
 }
 
+#
+# Find slivers "dependent" on this sliver, as for interfaces on nodes.
+#
+sub DependentSlivers($$)
+{
+    my ($self, $pref) = @_;
+
+    return -1
+	if (! (ref($self) && ref($pref)));
+    @$pref = ();
+
+    my $idx = $self->idx();
+    my $resource_uuid = $self->resource_uuid();
+
+    my $query_result =
+	DBQueryWarn("select idx from geni_slivers ".
+		    "where idx!='$idx' and resource_uuid='$resource_uuid'");
+    return -1
+	if (!$query_result);
+
+    my @result = ();
+    while (my ($idx) = $query_result->fetchrow_array()) {
+	my $sliver = GeniSliver->Lookup($idx);
+	if (!defined($sliver)) {
+	    print STDERR "Could not get sliver object for $idx\n";
+	    return -1;
+	}
+	push(@result, $sliver);
+    }
+    @$pref = @result;
+    return 0;
+}
+
 #
 # Create a signed credential for this sliver, issued to the provided user.
 # The credential will grant all permissions for now.
@@ -585,6 +618,21 @@ sub SetAggregate($$)
 
     return 0;
 }
+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'"));
+    return 0;
+}
 sub GetAggregate($)
 {
     my ($self) = @_;
@@ -933,9 +981,10 @@ use Node;
 
 sub Create()
 {
-    my ($class, $slice, $user_uuid, $resource_uuid, $rspec) = @_;
+    my ($class, $slice, $user_uuid,
+	$interface_uuid, $resource_uuid, $rspec) = @_;
 
-    return GeniSliver->Create($slice, $user_uuid, $resource_uuid,
+    return GeniSliver->Create($slice, $user_uuid, $interface_uuid,
 			      $resource_uuid, "Interface", $rspec);
 }
 
@@ -954,19 +1003,34 @@ sub Provision($)
 }
 
 #
-# Unprovision a sliver. 
+# Unprovision a single interface from a link/lan. 
 #
 sub UnProvision($)
 {
     my ($self) = @_;
 
-    #
-    # This is actually implemented in GeniAggregate since currently "link"
-    # is the smallest entity; you cannot operate on an individual interface.
-    #
     return -1
 	if (! ref($self));
 
+    my $aggregate = $self->GetAggregate();
+    if (!defined($aggregate)) {
+	print STDERR "Could not find aggregate for $self\n";
+	return -1;
+    }
+
+    #
+    # This is terrible; we need an interface to remove ports form vlans,
+    # so that we do not have to tear down the entire vlan and recreate.
+    #
+    if ($aggregate->UnProvision() != 0) {
+	print STDERR "Could not unprovision $aggregate\n";
+	return -1;
+    }
+    $self->ClearAggregate();
+    if ($aggregate->Provision() != 0) {
+	print STDERR "Could not provision $aggregate\n";
+	return -1;
+    }
     return 0;
 }