Checkpoint

protogeni/lib/GNUmakefile.in

@@ -16,20 +16,25 @@ LIB_SCRIPTS     = GeniDB.pm GeniUser.pm GeniSAClient.pm \
 		  GeniTicket.pm GeniSliver.pm GeniCredential.pm \
 		  GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
 		  GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
-		  GeniUtil.pm
+		  GeniUtil.pm GeniRegistry.pm
+SBIN_SCRIPTS	= plabnodewrapper plabslicewrapper
 		  
-SCRIPTS		= test.pl addnode.pl test.pl addauthority
+SCRIPTS		= test.pl addnode.pl test.pl addauthority regtest.pl
 OPS_LIBS	= GeniCMClient.pm GeniSAClient.pm GeniCHClient.pm
 
+# These scripts installed setuid, with sudo. 
+SETUID_SBIN_SCRIPTS  = plabnodewrapper plabslicewrapper
+
 #
 # Force dependencies on the scripts so that they will be rerun through
 # configure if the .in file is changed.
 # 
-all:	$(LIB_SCRIPTS) $(SCRIPTS)
+all:	$(LIB_SCRIPTS) $(SBIN_SCRIPTS) $(SCRIPTS)
 
 include $(TESTBED_SRCDIR)/GNUmakerules
 
 install: $(addprefix $(INSTALL_LIBDIR)/, $(LIB_SCRIPTS)) \
+	 $(addprefix $(INSTALL_SBINDIR)/, $(SBIN_SCRIPTS)) \
 	 $(addprefix $(INSTALL_DIR)/opsdir/lib/, $(OPS_LIBS))
 
 control-install:

protogeni/lib/GeniAggregate.pm.in

@@ -23,6 +23,7 @@ use GeniCredential;
 use GeniCertificate;
 use GeniSliver;
 use GeniSlice;
+use GeniRegistry;
 use libdb qw(TBGetUniqueIndex);
 use English;
 use overload ('""' => 'Stringify');
@@ -143,6 +144,9 @@ sub Create($$$$$$)
     my $slice_uuid  = $slice->uuid();
     my $owner_uuid  = $owner->uuid();
 
+    $aggregate_type = "Aggregate"
+    	if (! defined($aggregate_type));
+
     # Now tack on other stuff we need.
     push(@insert_data, "created=now()");
     push(@insert_data, "idx='$idx'");
@@ -151,8 +155,7 @@ 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));
+    push(@insert_data, "type='$aggregate_type'");
 
     # Insert into DB.
     if (!DBQueryWarn("insert into geni_aggregates set " .
@@ -237,6 +240,32 @@ sub hrn($)
     return "emulab.aggregate_" . $self->idx();
 }
 
+#
+# Look up toplevel aggregate for a locally instantiated slice. 
+#
+sub SliceAggregate($$)
+{
+    my ($class, $slice) = @_;
+
+    my $slice_uuid = $slice->uuid();
+    my @result = ();
+
+    my $query_result =
+	DBQueryWarn("select idx from geni_aggregates ".
+		    "where slice_uuid='$slice_uuid' and type='Aggregate'");
+    return undef
+	if (!$query_result);
+    return undef
+	if ($query_result->numrows != 1);
+
+    my ($idx) = $query_result->fetchrow_array();
+    my $aggregate = GeniAggregate->Lookup($idx);
+    return undef
+	if (!defined($aggregate));
+
+    return $aggregate;
+}
+
 #
 # Look up a list of aggregates for a locally instantiated slice. 
 # Used by the CM.
@@ -690,6 +719,285 @@ sub Stop($)
 }
 
 
+############################################################################
+#
+# Tunnel aggregates need special handling too
+#
+package GeniAggregate::Tunnel;
+use vars qw(@ISA);
+@ISA = "GeniAggregate";
+
+use GeniDB;
+use GeniSlice;
+use GeniCredential;
+use GeniCertificate;
+use GeniRegistry;
+use GeniAggregate;
+use Experiment;
+use Interface;
+use Data::Dumper;
+
+sub Create($$$$$$)
+{
+    my ($class, $slice, $owner, $node1sliver, $node2sliver, $rspec) = @_;
+    my $clearinghouse;
+
+    my $linkname = $rspec->{'nickname'};
+    return undef
+	if (!defined($linkname));
+
+    my $experiment = Experiment->Lookup($slice->uuid());
+    if (!defined($experiment)) {
+	print STDERR "Could not map $slice to its experiment\n";
+	return -1;
+    }
+
+    #
+    # Form an hrn using the slicename and linkname
+    #
+    my $hrn = "emulab." . $slice->slicename() . "." . $linkname;
+
+    my $aggregate = GeniAggregate->Create($slice, $owner, "Tunnel",
+					  $hrn, $linkname);
+    goto bad
+	if (!defined($aggregate));
+
+    #
+    # Create a tunnel entry in the lans table.
+    #
+    my $tunnel = Tunnel->Create($experiment, $aggregate->uuid(), "", "gre");
+    if (!defined($tunnel)) {
+	print STDERR "Could not create tunnel entry in lans table\n";
+	return undef;
+    }
+
+    my $node1ref = (@{$rspec->{'linkendpoints'}})[0];
+    my $node2ref = (@{$rspec->{'linkendpoints'}})[1];
+
+    # These are the ips of the tunnel.
+    my $ip1      = $node1ref->{'tunnel_ip'};
+    my $ip2      = $node2ref->{'tunnel_ip'};
+    my $ctrlip1;
+    my $ctrlip2;
+    my $iface1;
+    my $iface2;
+
+    # We need the control network addresses, but it is possible that
+    # one of the nodes is not on this testbed.
+    if (defined($node1sliver)) {
+	my $node1 = Node->Lookup($node1ref->{'node_uuid'});
+	my $interface = Interface->LookupControl($node1);
+	goto bad
+	    if (!defined($interface));
+	$ctrlip1 = $interface->IP();
+	$iface1  = $tunnel->AddMember($node1);
+	if (!defined($iface1)) {
+	    print STDERR "Could not add $node1 to $tunnel\n";
+	    goto bad;
+	}
+    }
+    else {
+	#
+	# Need to ask the clearinghouse where this node comes from.
+	#
+	$clearinghouse = GeniRegistry::ClearingHouse->Create();
+	
+	my $blob;
+	if ($clearinghouse->Resolve($node1ref->{'node_uuid'},
+				    "Component", \$blob) != 0) {
+	    print STDERR "Could not lookup node at clearinghouse\n";
+	    goto bad;
+	}
+	my $certificate = GeniCertificate->LoadFromString($blob->{'cm'});
+	goto bad
+	    if (!defined($certificate));
+	
+	my $component = GeniComponent->Lookup($certificate->uuid());
+	if (!defined($component)) {
+	    $component = GeniComponent->CreateFromCertificate($certificate,
+							      $blob->{'url'});
+	    if (!defined($component)) {
+		print STDERR "Could not create component from $certificate\n";
+		goto bad;
+	    }
+	}
+	my $credential = GeniRegistry::Client->CreateCredential($component);
+	if (!defined($credential)) {
+	    print STDERR "Could not create a credential for $component\n";
+	    goto bad;
+
+	}
+	my $registry = GeniRegistry::Client->Create($component, undef,
+						    $credential);
+	if (!defined($registry)) {
+	    print STDERR "Could not create a registry client for $component\n";
+	    goto bad;
+	}
+	$registry->Resolve($node1ref->{'node_uuid'}, "Node", \$blob);
+
+	foreach my $ref (@{ $blob->{'interfaces'} }) {
+	    $ctrlip1 = $ref->{'IP'}
+	        if ($ref->{'role'} eq "ctrl");
+	}
+    }
+    if (defined($node2sliver)) {
+	my $node2 = Node->Lookup($node2ref->{'node_uuid'});
+	my $interface = Interface->LookupControl($node2);
+	goto bad
+	    if (!defined($interface));
+	$ctrlip2 = $interface->IP();
+	$iface2  = $tunnel->AddMember($node2);
+	if (!defined($iface2)) {
+	    print STDERR "Could not add $node2 to $tunnel\n";
+	    goto bad;
+	}
+    }
+    else {
+	#
+	# Need to ask the clearinghouse where this node comes from.
+	#
+	$clearinghouse = GeniRegistry::ClearingHouse->Create()
+	    if (!defined($clearinghouse));
+	
+	my $blob;
+	if ($clearinghouse->Resolve($node2ref->{'node_uuid'},
+				    "Component", \$blob) != 0) {
+	    print STDERR "Could not lookup node at clearinghouse\n";
+	    goto bad;
+	}
+	my $certificate = GeniCertificate->LoadFromString($blob->{'cm'});
+	goto bad
+	    if (!defined($certificate));
+	
+	my $component = GeniComponent->Lookup($certificate->uuid());
+	if (!defined($component)) {
+	    $component = GeniComponent->CreateFromCertificate($certificate,
+							      $blob->{'url'});
+	    if (!defined($component)) {
+		print STDERR "Could not create component from $certificate\n";
+		goto bad;
+	    }
+	}
+	my $credential = GeniRegistry::Client->CreateCredential($component);
+	if (!defined($credential)) {
+	    print STDERR "Could not create a credential for $component\n";
+	    goto bad;
+
+	}
+	my $registry = GeniRegistry::Client->Create($component, undef,
+						    $credential);
+	if (!defined($registry)) {
+	    print STDERR "Could not create a registry client for $component\n";
+	    goto bad;
+	}
+	$registry->Resolve($node2ref->{'node_uuid'}, "Node", \$blob);
+
+	foreach my $ref (@{ $blob->{'interfaces'} }) {
+	    $ctrlip2 = $ref->{'IP'}
+	        if ($ref->{'role'} eq "ctrl");
+	}
+    }
+    print STDERR "$ip1, $ip2, $ctrlip1, $ctrlip2\n";
+
+    if (defined($iface1)) {
+	$iface1->SetAttribute("tunnel_ip", $ip1);
+	$iface1->SetAttribute("tunnel_peerip", $ip2);
+	$iface1->SetAttribute("tunnel_srcip", $ctrlip1);
+	$iface1->SetAttribute("tunnel_dstip", $ctrlip2);
+	$iface1->SetAttribute("tunnel_ipmask", "255.255.255.0");
+	$iface1->SetAttribute("tunnel_lan", $linkname);
+	$iface1->SetAttribute("tunnel_unit", $iface1->memberid());
+	$iface1->SetAttribute("tunnel_style", "gre");
+    }
+    if (defined($iface2)) {
+	$iface2->SetAttribute("tunnel_ip", $ip2);
+	$iface2->SetAttribute("tunnel_peerip", $ip1);
+	$iface2->SetAttribute("tunnel_srcip", $ctrlip2);
+	$iface2->SetAttribute("tunnel_dstip", $ctrlip1);
+	$iface2->SetAttribute("tunnel_ipmask", "255.255.255.0");
+	$iface2->SetAttribute("tunnel_lan", $linkname);
+	$iface2->SetAttribute("tunnel_unit", $iface2->memberid());
+	$iface2->SetAttribute("tunnel_style", "gre");
+    }
+    return $aggregate;
+
+  bad:
+    $tunnel->Destroy()
+	if (defined($tunnel));
+    $aggregate->Delete()
+	if (defined($aggregate));
+    return undef;
+}
+
+#
+# All the work done above.
+#
+sub Provision($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    $self->SetStatus("ready");
+    return 0;
+}
+
+#
+# Destroy the underlying tunnel in the lans table.
+#
+sub UnProvision($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    my $experiment = Experiment->Lookup($self->slice_uuid());
+    if (!defined($experiment)) {
+	print STDERR "Could not map $self to its experiment\n";
+	return -1;
+    }
+
+    my $tunnel = Tunnel->Lookup($experiment, $self->uuid());
+    if (! defined($tunnel)) {
+	print STDERR "No tunnel associated with $self\n";
+	return 0;
+    }
+    if ($tunnel->Destroy() != 0) {
+	print STDERR "Could not destroy $tunnel\n";
+	return -1;
+    }
+    return 0;
+}
+
+#
+# Nothing to do yet.
+#
+sub Start($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    return 0;
+}
+
+#
+# Nothing to do yet.
+#
+sub Stop($)
+{
+    my ($self) = @_;
+
+    return -1
+	if (! ref($self));
+
+    return 0;
+}
+
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;
 

protogeni/lib/GeniCH.pm.in

@@ -166,6 +166,27 @@ sub Resolve($)
     
 	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
     }
+    if ($type eq "Component") {
+	my $component = GeniComponent->LookupByResource($uuid);
+	
+	if (!defined($component)) {
+	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+					"No such resource $uuid");
+	}
+	my $certificate = GeniCertificate->Lookup($uuid);
+	if (!defined($certificate)) {
+	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+					"No certificate for $uuid");
+	}
+
+	# Return a blob.
+	my $blob = { "gid"      => $certificate->cert(),
+		     "cm"	=> $component->cert(),
+		     "url"      => $component->url(),
+		 };
+    
+	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
+    }
     if ($type eq "SA" || $type eq "sa") {
 	my $authority = GeniAuthority->Lookup($uuid);
 	if (!defined($authority)) {
@@ -468,6 +489,34 @@ sub Register($)
 	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
 				    "Slice has been registered");
     }
+    if ($type eq "Component") {
+	my $resource_type  = $info->{'resource_type'};
+	my $resource_uuid  = $info->{'resource_uuid'};
+
+	my $component = GeniComponent->Lookup($ENV{'GENIUUID'});
+	if (!defined($component)) {
+	    print STDERR "Could not find component object for caller.\n";
+	    return GeniResponse->Create(GENIRESPONSE_ERROR);
+	}
+
+	if (! ($resource_uuid =~ /^[-\w]+$/)) {
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					"resource_uuid: Invalid characters");
+	}
+	if (! ($resource_type =~ /^[-\w]+$/)) {
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					"resource_type: Invalid characters");
+	}
+	if ($certificate->Store() != 0) {
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					"Could not store certificate");
+	}
+	if ($component->NewResource($resource_uuid) != 0) {
+	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+					"Could not register new resource");
+	}
+    }
+
     return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
 }
 
@@ -534,7 +583,7 @@ sub Remove($)
     if ($type eq "Slice") {
 	my $slice = GeniSlice->Lookup($uuid);
 	if (!defined($slice)) {
-	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
+	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
 					"No such slice $uuid");
 	}
 	if ($slice->Delete()) {
@@ -552,14 +601,26 @@ sub Remove($)
 # This is just a placeholder; return a list of all components. Eventually
 # takes an rspec and we do a resource mapping. 
 #
-sub DiscoverResources($)
+sub ListComponents($)
 {
     my ($argref) = @_;
-    my $slice  = $argref->{'slice'};
+    my $cred  = $argref->{'credential'};
+
+    if (! defined($cred)) {
+	return GeniResponse->MalformedArgsResponse();
+    }
+    my $credential = GeniCredential->CreateFromSigned($cred);
+    if (!defined($credential)) {
+	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
+				    "Could not create GeniCredential object");
+    }
 
-    # This is a certificate. Ignored for now. 
-    if (!defined($slice)) {
-	return Protogeni::MalformedArgsResponse();
+    #
+    # 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!");
     }
 
     #
@@ -575,7 +636,9 @@ sub DiscoverResources($)
 	return GeniResponse->Create(GENIRESPONSE_DBERROR)
 	    if (!defined($component));
 	    
-	push(@results, { "gid" => $component->cert() });
+	push(@results, { "gid" => $component->cert(),
+			 "hrn" => $component->hrn(),
+		         "url" => $component->url() });
     }
     return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
 }

protogeni/lib/GeniCM.pm.in

@@ -56,19 +56,21 @@ my $AVAIL	   = "$TB/sbin/avail";
 my $PTOPGEN	   = "$TB/libexec/ptopgen";
 my $TBSWAP	   = "$TB/bin/tbswap";
 my $SWAPEXP	   = "$TB/bin/swapexp";
-my $PLABSLICE	   = "$TB/sbin/plabslice";
-
+my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
+my $NAMEDSETUP     = "$TB/sbin/named_setup";
+my $VNODESETUP     = "$TB/sbin/vnode_setup";
+my $GENTOPOFILE    = "$TB/libexec/gentopofile";
 
 #
-# Respond to a GetTicket request. 
+# Respond to a Resolve request. 
 #
 sub Resolve($)
 {
     my ($argref) = @_;
     my $uuid       = $argref->{'uuid'};
-    my $hrn        = $argref->{'hrn'};
     my $cred       = $argref->{'credential'};
     my $type       = $argref->{'type'};
+    my $hrn;
 
     if (! defined($cred)) {
 	return GeniResponse->MalformedArgsResponse();
@@ -77,15 +79,12 @@ sub Resolve($)
 	return GeniResponse->MalformedArgsResponse();
     }
     # Allow lookup by uuid or hrn.
-    if (! (defined($uuid) || defined($hrn))) {
+    if (! defined($uuid)) {
 	return GeniResponse->MalformedArgsResponse();
     }
     if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
 	return GeniResponse->MalformedArgsResponse();
     }
-    if (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
-	return GeniResponse->MalformedArgsResponse();
-    }
 
     my $credential = GeniCredential->CreateFromSigned($cred);
     if (!defined($credential)) {
@@ -507,7 +506,7 @@ sub ModifySliver($$$$)
     # Find current nodes and record their uuids. 
     #
     if (defined($object)) {
-	if ($object->type() eq "Link") {
+	if ($object->type() ne "Aggregate") {
 	    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
 					"Only node aggregates allowed");
 	}
@@ -619,11 +618,9 @@ sub ModifySliver($$$$)
 
 
     # Bind the other users too.
-    my @userbindings;
-    if ($slice->UserBindings(\@userbindings) != 0) {
-	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
-				    "Error binding users to slice");
-    }
+    # XXX Need to figure out where these come from.
+    my @userbindings = ();
+
     foreach my $otheruuid (@userbindings) {
 	my $otheruser = GeniUser->Lookup($otheruuid);
 	if (!defined($otheruser)) {
@@ -695,7 +692,7 @@ sub ModifySliver($$$$)
 	    my $iface_name  = $i->rspec()->{'iface_name'};
 
 	    my $linkendpoints =
-		$rspec->{'link'}->{$s->hrn()}->{'LinkEndPoints'};
+		$rspec->{'link'}->{$s->hrn()}->{'linkendpoints'};
 	}
     }
     
@@ -703,7 +700,8 @@ sub ModifySliver($$$$)
     # Now for each resource (okay, node) in the ticket create a sliver and
     # add it to the aggregate.
     #
-    my %slivers = ();
+    my %slivers   = ();
+    my @plabnodes = ();
     foreach my $ref (@{$rspec->{'node'}}) {
 	my $resource_uuid = $ref->{'uuid'};
 	# Already in the aggregate?
@@ -731,6 +729,16 @@ sub ModifySliver($$$$)
 	# have not turned into slivers yet. Ick.
 	#
 	delete($toalloc{$resource_uuid});
+
+	# See below; setup all pnodes at once.
+	if ($node->isremotenode()) {
+	    my $vnode = Node->Lookup($sliver->uuid());
+	    if (!defined($vnode)) {
+		print STDERR "Could not locate vnode $sliver\n";
+		goto bad;
+	    }
+	    push(@plabnodes, $vnode);
+	}
     }
 
     #
@@ -744,6 +752,35 @@ sub ModifySliver($$$$)
 	    $message = "Bad name for link: $linkname";
 	    goto bad;
 	}
+	my $linkref = $rspec->{'link'}->{$linkname};
+
+	#
+	# XXX Tunnels are a total kludge right now ...
+	#
+	if (exists($linkref->{'link_type'}) &&
+	    $linkref->{'link_type'} eq "tunnel") {
+
+	    my $node1ref = (@{$linkref->{'linkendpoints'}})[0];
+	    my $node2ref = (@{$linkref->{'linkendpoints'}})[1];
+
+	    my $node1sliver = $slivers{$node1ref->{'node_uuid'}} ||
+		$nodelist{$node1ref->{'node_uuid'}};
+	    my $node2sliver = $slivers{$node2ref->{'node_uuid'}} ||
+		$nodelist{$node2ref->{'node_uuid'}};
+