Checkpoint.

protogeni/lib/GNUmakefile.in

@@ -15,9 +15,10 @@ LIB_SCRIPTS     = GeniDB.pm GeniUser.pm GeniSAClient.pm \
 		  GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
 		  GeniTicket.pm GeniSliver.pm GeniCredential.pm \
 		  GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
-		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
+		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
+		  GeniUtil.pm
 		  
-SCRIPTS		= test.pl addnode.pl test2.pl addauthority
+SCRIPTS		= test.pl addnode.pl test.pl addauthority
 OPS_LIBS	= GeniCMClient.pm GeniSAClient.pm GeniCHClient.pm
 
 #

protogeni/lib/GeniCM.pm.in

@@ -49,6 +49,7 @@ my $TBAUDIT   	   = "@TBAUDITEMAIL@";
 my $BOSSNODE       = "@BOSSNODE@";
 my $OURDOMAIN      = "@OURDOMAIN@";
 my $CREATEEXPT     = "$TB/bin/batchexp";
+my $ENDEXPT        = "$TB/bin/endexp";
 my $NALLOC	   = "$TB/bin/nalloc";
 my $AVAIL	   = "$TB/sbin/avail";
 my $TBSWAP	   = "$TB/bin/tbswap";
@@ -997,9 +998,65 @@ sub CleanupDeadSlice($)
 	    return -1;
 	}
     }
+
+    my $experiment = $slice->GetExperiment();
+    if (!defined($experiment)) {
+	print STDERR "Could not get experiment for $slice\n";
+	return -1;
+    }
+    # Note the -h option; allows experiment with no NS file.
+    system("$ENDEXPT -q -w " . $experiment->idx());
+    return -1
+	if ($?);
+    
     if ($slice->Delete() != 0) {
 	print STDERR "Could not delete $slice\n";
 	return -1;
     }
     return 0;
 }
+
+#
+# Remove a record, specifically a slice on this component.
+#
+sub DeleteSlice($)
+{
+    my ($argref) = @_;
+    my $credential = $argref->{'credential'};
+
+    if (! defined($credential)) {
+	return GeniResponse->MalformedArgsResponse();
+    }
+
+    $credential = GeniCredential->CreateFromSigned($credential);
+    if (!defined($credential)) {
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "Could not create GeniCredential object");
+    }
+
+    my $slice_uuid = $credential->this_uuid();
+    
+    #
+    # Make sure the credential was issued to the caller.
+    #
+    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "This is not your credential!");
+    }
+
+    #
+    # See if we have a record of this slice in the DB. If not, then we have
+    # to go to the ClearingHouse to find its record, so that we can find out
+    # who the SA for it is.
+    #
+    my $slice = GeniSlice->Lookup($slice_uuid);
+    if (!defined($slice)) {
+	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
+			    "No such slice on this component: $slice_uuid");
+    }
+    if (CleanupDeadSlice($slice) != 0) {
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "Could not cleanup slice");
+    }
+    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
+}

protogeni/lib/GeniEmulab.pm.in

@@ -471,7 +471,7 @@ sub DestroySlivers($$$)
 	}
 	print STDERR "Releasing $sliver for $node.\n";
 	
-	if ($sliver->Destroy() != 0) {
+	if ($sliver->Destroy($context) != 0) {
 	    print STDERR "Could not destroy $sliver for $node\n";
 	    $errors++;
 	    next;

protogeni/lib/GeniUtil.pm.in

+#!/usr/bin/perl -wT
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2008 University of Utah and the Flux Group.
+# All rights reserved.
+#
+package GeniUtil;
+
+use strict;
+use Exporter;
+use vars qw(@ISA @EXPORT);
+
+@ISA    = "Exporter";
+@EXPORT = qw ( );
+
+# Must come after package declaration!
+use lib '@prefix@/lib';
+use User;
+use English;
+use Data::Dumper;
+use XML::Simple;
+
+# Configure variables
+my $TB		   = "@prefix@";
+my $TBOPS          = "@TBOPSEMAIL@";
+my $user	   = "geniuser";
+my $group          = "GeniSlices";
+
+#
+# In the prototype, we accept certificate signed by trusted roots (CA
+# certs we have locally cached). Scripts runs as "geniuser" so that
+# there is an emulab user context, or many of the scripts we invoke
+# will complain and croak.
+#
+sub FlipToGeniUser()
+{
+    my $unix_uid = getpwnam("$user") or
+	die("*** $0:\n".
+	    "    No such user $user\n");
+    my $unix_gid = getgrnam("$group") or
+	die("*** $0:\n".
+	    "    No such group $group\n");
+
+    $GID            = $unix_gid;
+    $EGID           = "$unix_gid $unix_gid";
+    $EUID = $UID    = $unix_uid;
+    $ENV{'USER'}    = $user;
+    $ENV{'LOGNAME'} = $user;
+    return 0;
+}
+
+

protogeni/lib/addnode.pl.in

@@ -15,6 +15,7 @@ use GeniComponent;
 use English;
 use Node;
 use Interface;
+use Experiment;
 use Data::Dumper;
 
 my $this_user = User->LookupByUnixId($UID);
@@ -22,6 +23,7 @@ if (! defined($this_user)) {
     print STDERR "You ($UID) do not exist!\n";
     exit(-1);
 }
+my $experiment = Experiment->Lookup("emulab-ops", "geni-nodes");
 
 #
 # The RPC context for this test script is mostly as an SA, with some
@@ -73,7 +75,7 @@ my $response =
 			   $context,
 			   "Resolve",
 			   { "credential"  => $credential->asString(),
-			     "hrn"         => "pc41",
+			     "hrn"         => "pc167",
 			     "type"        => "Node",
 			   });
 if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
@@ -87,26 +89,23 @@ my $nodeargs = { "uuid"  => $value->{'uuid'},
 		 "role"  => "testnode",
 		 "vtype" => "pcfed" };
 
-my $node = Node->Create("pcfedphys1", undef, $nodeargs);
+my $node = Node->Create("pcfedphys2", $experiment, $nodeargs);
 if (!defined($node)) {
     die("Could not create new node.\n");
 }
+$node->SetStatus('up');
 
-# Just add the control network for now.
 foreach my $ref (@{ $value->{'interfaces'} }) {
-    if ($ref->{'role'} eq 'ctrl') {
-	my $ifaceargs = { "uuid"  => $ref->{'uuid'},
-			  "type"  => $ref->{'type'},
-			  "role"  => $ref->{'role'},
-			  "card"  => $ref->{'card'},
-			  "port"  => $ref->{'port'},
-			  "MAC"   => $ref->{'MAC'},
-			  "IP"    => $ref->{'IP'},
-			  "mask"  => $ref->{'mask'},
-		      };
-	print Dumper($ifaceargs);
-	Interface->Create($node, $ifaceargs);
-	last;
-    }
+    my $ifaceargs = { "uuid"  => $ref->{'uuid'},
+		      "type"  => $ref->{'type'},
+		      "role"  => $ref->{'role'},
+		      "card"  => $ref->{'card'},
+		      "port"  => $ref->{'port'},
+		      "MAC"   => $ref->{'MAC'},
+		      "IP"    => $ref->{'IP'},
+		      "mask"  => $ref->{'mask'},
+		  };
+    print Dumper($ifaceargs);
+    Interface->Create($node, $ifaceargs);
 }
 $component->NewResource($node->uuid());