Merge branch 'master' of git-public.flux.utah.edu:/flux/git/emulab-devel

.gitignore

-event/trafgen/tg2.0
-event/linktest/iperf/iperf-2.0.2
-event/linktest/rude/rude-0.70
-sensors/nfstrace/nfsdump2/Makefile
-sensors/nfstrace/nfsdump2/config.h
-sensors/nfstrace/nfsdump2/config.log
-protogeni/demo/.metadata
-protogeni/demo/map/.metadata

account/mksyscert.in

 #!/usr/bin/perl -w
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2009 University of Utah and the Flux Group.
+# Copyright (c) 2000-2010 University of Utah and the Flux Group.
 # All rights reserved.
 #
 use strict;
@@ -271,7 +271,6 @@ system("$OPENSSL ca -batch -policy policy_sslxmlrpc ".
        " -infiles syscert_req.pem $outline") == 0
     or fatal("Could not sign certificate request");
 $UID = $SAVEUID;
-TBScriptUnlock();
 
 #
 # Combine the key and the certificate into one file
@@ -288,6 +287,7 @@ else {
     system("cat syscert_key.pem syscert_cert.pem") == 0
 	or fatal("Could not combine cert and key");
 }
+TBScriptUnlock();
 exit(0);
 
 sub fatal($) {

apache/httpd.conf.in

@@ -1344,13 +1344,8 @@ SSLVerifyDepth  10
 SSLRequire ( %{SSL_CLIENT_S_DN_OU} ne "sslxmlrpc" )
 </Location>
 
-ScriptAlias /protogeni/xmlrpc/ch @prefix@/protogeni/xmlrpc/protogeni-ch.pl
-ScriptAlias /protogeni/xmlrpc/cm @prefix@/protogeni/xmlrpc/protogeni-cm.pl
-ScriptAlias /protogeni/xmlrpc/sa @prefix@/protogeni/xmlrpc/protogeni-sa.pl
-ScriptAlias /protogeni/xmlrpc/ses @prefix@/protogeni/xmlrpc/protogeni-ses.pl
-<IfDefine GENI_AM>
-ScriptAlias /protogeni/xmlrpc/am @prefix@/protogeni/xmlrpc/geni-am.pl
-</IfDefine>
+ScriptAlias /protogeni/xmlrpc @prefix@/protogeni/xmlrpc/protogeni-wrapper.pl
+
 <Directory "@prefix@/www/protogeni">
 	SSLRequireSSL
 	Order deny,allow

db/Experiment.pm.in

@@ -2076,6 +2076,8 @@ sub PreSwap($$$$)
     $swapper->BumpActivity();
     $self->GetProject()->BumpActivity();
     $self->GetGroup()->BumpActivity();
+    $self->Refresh() == 0
+	or goto failed;
     return 0;
 
   failed:
@@ -2157,16 +2159,7 @@ sub SwapFail($$$$;$)
 		"where idx='$rsrcidx'")
 	or return -1;
 
-    if ($which eq $EXPT_SWAPMOD &&
-	$self->state() eq libdb::EXPTSTATE_ACTIVE()) {
-	DBQueryWarn("update experiment_resources set ".
-		    ($flags & libdb::TBDB_STATS_FLAGS_MODHOSED() ?
-		     "swapout_time=swapmod_time, " : " ") .
-		    "swapmod_time=0 ".
-		    "where idx='$lastrsrc'")
-	    or return -1;
-    }
-
+    # Delete it.
     DBQueryWarn("delete from experiment_resources ".
 		"where idx=$rsrcidx")
 	or return -1;
@@ -2225,6 +2218,21 @@ sub PostSwap($$$$)
     my $prev_swapper = $swapper;
     my $query_result;
 
+    #
+    # Need to update the previous record with the swapmod_time.
+    #
+    if ($which eq $EXPT_SWAPMOD) {
+	my $when = "UNIX_TIMESTAMP(now())";
+	# unless its active, in which case pick up swapin time.
+	$when = $self->swapin_time()
+	    if ($self->state() eq libdb::EXPTSTATE_ACTIVE());
+	
+	DBQueryWarn("update experiment_resources set ".
+		    "  swapmod_time=$when ".
+		    "where idx='$lastrsrc'")
+	    or return -1;
+    }
+
     if ($which eq $EXPT_SWAPOUT ||
 	($which eq $EXPT_SWAPMOD &&
 	 $self->state() eq libdb::EXPTSTATE_ACTIVE())) {
@@ -2246,7 +2254,7 @@ sub PostSwap($$$$)
 		DBQueryWarn("select r.pnodes,r.vnodes,r.uid_idx, ".
 			    "  r.swapmod_time - r.swapin_time ".
 			    " from experiment_resources as r ".
-			    "where r.idx='$rsrcidx'");
+			    "where r.idx='$lastrsrc'");
 	}
 	return -1
 	    if (!$query_result);
@@ -2264,18 +2272,6 @@ sub PostSwap($$$$)
 	}
     }
 
-    if ($which eq $EXPT_SWAPMOD) {
-	my $when = "UNIX_TIMESTAMP(now())";
-	# unless its active, in which case pick up swapin time.
-	$when = $self->swapin_time()
-	    if ($self->state() eq libdb::EXPTSTATE_ACTIVE());
-	
-	DBQueryWarn("update experiment_resources set ".
-		    "  swapmod_time=$when ".
-		    "where idx='$lastrsrc'")
-	    or return -1;
-    }
-
     # Special case for initial record. Needs to be fixed.
     if ($which eq $EXPT_SWAPIN && !$self->lastidx()) {
 	DBQueryWarn("update experiment_resources set byswapin=1 ".

db/Interface.pm.in

@@ -322,14 +322,38 @@ sub Create($$$)
 	print STDERR Dumper($argref);
 	return undef;
     }
-    DBQueryWarn("insert into interfaces set ".
+    
+    #
+    # Lock the tables to prevent concurrent creation
+    #
+    DBQueryWarn("lock tables interfaces write, ".
+		"            interface_state write, ".
+		"            wires write")
+	or return undef;
+
+    #
+    # See if we have a record; if we do, we can stop now. This is
+    # not actually correct, since creating a node is not atomic.
+    #
+    my $query_result =
+	DBQueryWarn("select node_id from interfaces ".
+		    "where node_id='$node_id' and ".
+		    "      card='$card' and port='$port'");
+    if ($query_result->numrows) {
+	DBQueryWarn("unlock tables");
+	return Interface->Lookup($node_id, $card, $port);
+    }
+    
+    if (!DBQueryWarn("insert into interfaces set ".
 		"  node_id='$node_id', " .
 		"  card=$card, port=$port, role='$ifrole', ".
 		"  mac='$MAC', IP='$IP', mask='$mask', " .
 		"  interface_type='$iftype', iface='$iface', " .
 		"  current_speed='$max_speed', duplex='$duplex', ".
-		"  uuid='$uuid'")
-	or return undef;
+		"  uuid='$uuid'")) {
+	DBQueryWarn("unlock tables");
+	return undef;
+    }
 
     if (!DBQueryWarn("insert into interface_state set ".
 		     "  node_id='$node_id', " .
@@ -337,6 +361,7 @@ sub Create($$$)
 	DBQueryWarn("delete from interfaces ".
 		    "where node_id='$node_id' and card='$card' ".
 		    "      and port='$port'");
+	DBQueryWarn("unlock tables");
 	return undef;
     }
 
@@ -359,9 +384,11 @@ sub Create($$$)
 	    DBQueryWarn("delete from interfaces ".
 			"where node_id='$node_id' and card='$card' ".
 			"      and port='$port'");
+	    DBQueryWarn("unlock tables");
 	    return undef;
 	}
     }
+    DBQueryWarn("unlock tables");
     return Interface->Lookup($node_id, $card, $port);
 }
 

db/Node.pm.in

@@ -338,8 +338,11 @@ sub Create($$$$)
     #
     # Lock the tables to prevent concurrent creation
     #
-    DBQueryWarn("lock tables nodes write, widearea_nodeinfo write")
-	or return -1;
+    DBQueryWarn("lock tables nodes write, widearea_nodeinfo write, ".
+		"node_hostkeys write, node_status write, ".
+		"node_utilization write, ".
+		"node_activity write, reserved write, node_auxtypes write")
+	or return undef;
 
     #
     # Make up a priority (just used for sorting)
@@ -351,6 +354,17 @@ sub Create($$$$)
 	$priority = 1;
     }
 
+    #
+    # See if we have a record; if we do, we can stop now and get the
+    # existing record.
+    #
+    my $query_result =
+	DBQueryWarn("select node_id from nodes where node_id='$node_id'");
+    if ($query_result->numrows) {
+	DBQueryWarn("unlock tables");
+	return Node->Lookup($node_id);
+    }
+
     if (!DBQueryWarn("insert into nodes set ".
 		     "  node_id='$node_id', type='$type', " .
 		     "  phys_nodeid='$node_id', role='$role', ".
@@ -378,7 +392,6 @@ sub Create($$$$)
 	    return undef;
 	}
     }
-    DBQueryWarn("unlock tables");
 
     if ($role eq "testnode") {
 	DBQueryWarn("insert into node_hostkeys (node_id) ".
@@ -435,12 +448,14 @@ sub Create($$$$)
 		    "type='$vtype', count=$virtnode_capacity")
 	    or goto bad;
     }
+    DBQueryWarn("unlock tables");
     return Node->Lookup($node_id);
     
   bad:
     foreach my $table (@cleantables) {
 	DBQueryWarn("delete from $table where node_id='$node_id'");
     }
+    DBQueryWarn("unlock tables");
     return undef;
 }
 

db/emdbi.pm.in

@@ -193,7 +193,6 @@ sub TBDBDisconnect()
     for (my $i = 0; $i < @DB; $i++) {
 	undef($DB[$i]);
     }
-    select(undef, undef, undef, 0.2);
 }
 
 # Create a new DB handle and return the handle number

db/libGeni.pm.in

@@ -76,22 +76,49 @@ sub MapResources($$$$)
 	or return -1;
 
     foreach my $ref (@{ $rspec->{'node'} }) {
+	my $resource;
 	my %copy = %{ $ref };
 	my $copy = \%copy;
 	
-	my $node_urn = $copy->{'component_urn'};
+	my $node_urn = $copy->{'request_urn'};
 	my ($auth,$type,$node_id) = GeniHRN::Parse($node_urn);
 	my $cm = GeniHRN::Generate($auth, "authority", "cm");
-
 	$copy->{'component_manager_uuid'} = $cm;
-	if ($node_id eq "*") {
-	    # assign will use this, but its format is bogus. Kill it.
-	    delete($copy->{'component_urn'});
+
+	#
+	# Get the resource object.
+	#
+	if (!exists($cm_urns{$cm})) {
+	    $resource = GeniResource->Lookup($experiment->idx(), $cm);
+	    if (!defined($resource)) {
+		$resource = GeniResource->Create($experiment, $cm);
+		if (!defined($resource)) {
+		    print STDERR "Could not create GeniResource for $cm\n";
+		    return -1;
+		}
+	    }
+	    $cm_urns{$cm} = $resource;
 	}
-	else {
-	    $copy->{'component_uuid'} = $node_urn;
+	$resource = $cm_urns{$cm};
+
+	#
+	# request_urn means nothing to assign; kill that from the copy.
+	#
+	delete($copy->{'request_urn'});
+	# Ditto
+	delete($copy->{'tarfiles'});
+
+	#
+	# If already have the ticket, then leave the urn alone.
+	# We do not run assign again, but we need the rspec to be
+	# complete for loops below.
+	#
+	if (!$resource->HaveTicket()) {
+	    if ($node_id ne "*")  {
+		$copy->{'component_uuid'} = $node_urn;
+		$copy->{'component_urn'}  = $node_urn;
+	    }
 	}
-	$cm_urns{$cm} = $cm;
 
 	#
 	# The point of this is to split the rspec apart, since at present
@@ -125,6 +152,9 @@ sub MapResources($$$$)
 	foreach my $ref (@{ $rspec->{'link'} }) {
 	    my $linkname   = $ref->{'virtual_id'};
 
+	    # means nothing to assign; added again below.
+	    delete($ref->{'component_manager'});
+
 	    # Skip tunnels until rspec stitching in place.
 	    next
 		if (exists($ref->{'link_type'}) &&
@@ -156,21 +186,6 @@ sub MapResources($$$$)
 	}
     }
 
-    #
-    # Get the resource objects.
-    #
-    foreach my $cm (keys(%cm_urns)) {
-	my $resource = GeniResource->Lookup($experiment->idx(), $cm);
-	if (!defined($resource)) {
-	    $resource = GeniResource->Create($experiment, $cm);
-	    if (!defined($resource)) {
-		print STDERR "Could not create GeniResource for $cm\n";
-		return -1;
-	    }
-	}
-	$cm_urns{$cm} = $resource;
-    }
-
     #
     # Discover resources at the component and run assign.
     #
@@ -179,6 +194,14 @@ sub MapResources($$$$)
 	my $fragment = $fragments{$cm};
 	my $advertisement;
 
+	#
+	# We got the ticket on a previous loop.
+	#
+	if ($resource->HaveTicket()) {
+	    print STDERR "Already have a ticket for $resource; skipping ...\n";
+	    next;
+	}
+
 	print STDERR "Asking for resource list from $resource\n";
 	if ($resource->Discover($user, \$advertisement)) {
 		print STDERR "Could not get resource list for $resource\n";
@@ -316,6 +339,7 @@ sub GetTickets($$$$)
 {
     my ($experiment, $verbose, $user, $rspec) = @_;
     my %cm_urns   = ();
+    my %nodemap   = ();
 
     Register($experiment, $user) == 0
 	or return -1;
@@ -331,33 +355,39 @@ sub GetTickets($$$$)
 	    $ref->{'node_type'}->{'type_name'} eq "lan") {
 	    next;
 	}
+	my $virtual_id = $ref->{'virtual_id'};
 	my $node_urn = $ref->{'component_urn'};
 	my ($auth,$type,$node_id) = GeniHRN::Parse($node_urn);
 	my $cm = GeniHRN::Generate($auth, "authority", "cm");
 
-	$cm_urns{$cm} = $cm;
-
 	#
-	# This is how we get the client side to do cooked mode properly.
+	# Get the resource objects for below.
 	#
-	$ref->{'tarfiles'} = "/usr/local/etc/emulab ".
-	    "$TBDOCBASE/downloads/geniclient.tar";
-    }
-
-    #
-    # Get the resource objects.
-    #
-    foreach my $cm (keys(%cm_urns)) {
-	my $resource = GeniResource->Lookup($experiment->idx(), $cm);
-	if (!defined($resource)) {
-	    $resource = GeniResource->Create($experiment, $cm);
+	if (!exists($cm_urns{$cm})) {
+	    my $resource = GeniResource->Lookup($experiment->idx(), $cm);
 	    if (!defined($resource)) {
-		print STDERR "Could not create GeniResource for $cm\n";
+		print STDERR "Could not get GeniResource for $cm\n";
 		return -1;
 	    }
+	    $nodemap{$virtual_id} = $resource;
+	    
+	    #
+	    # We got the ticket on a previous loop.
+	    #
+	    next
+		if ($resource->HaveTicket());
+	    
+	    $cm_urns{$cm} = $resource;
 	}
-	$cm_urns{$cm} = $resource;
+	#
+	# This is how we get the client side to do cooked mode properly.
+	#
+	$ref->{'tarfiles'} = "/usr/local/etc/emulab ".
+	    "$TBDOCBASE/downloads/geniclient.tar";
     }
+    # No tickets needed, return now.
+    return 0
+	if (! scalar(keys(%cm_urns)));
 
     #
     # XXX Convert to a proper XML looking thing. This is just a temporay
@@ -390,6 +420,9 @@ sub GetTickets($$$$)
 		$resource->last_rpc_value()) {
 		print STDERR $resource->last_rpc_value() . "\n";
 	    }
+	    # Return indicator of possible forward progress.
+	    return 1
+		if ($resource->last_rpc_output() =~ /Could not map to/i);
 	    return -1;
 	}
 	return 0;
@@ -409,8 +442,9 @@ sub GetTickets($$$$)
     #
     # Check the exit codes. Eventually return specific error info.
     #
-    my $errors = 0;
-    my $count  = 0;
+    my $errors   = 0;
+    my $count    = 0;
+    my $progress = 0;
     foreach my $result (@results) {
 	my $resource = $resources[$count];
 
@@ -425,11 +459,41 @@ sub GetTickets($$$$)
 	elsif ($result != 0) {
 	    print STDERR "*** Error getting ticket for $resource\n";
 	    $errors++;
+
+	    # Watch for forward progress. Not being able to map actually
+	    # means forward progress since we want to try again with
+	    # different resources. The mapper will try a few times before
+	    $progress++
+		if ($result > 1);
+	}
+	else {
+	    $progress++;
+
+	    #
+	    # Got a ticket; mark the proxy nodes so that libvtop knows.
+	    # Failure to get a ticket means we need to release the node
+	    # up in libvtop. Probably need a state variable instead.
+	    #
+	    foreach my $virtual_id (keys(%nodemap)) {
+		next
+		    if (!$resource->SameResource($nodemap{$virtual_id}));
+
+		my $node = $experiment->VnameToNode($virtual_id);
+		if (defined($node)) {
+		    $node->ModifyReservation({"external_resource_index" =>
+						  $resource->idx()})
+			== 0 or return -1;