Little bits and pieces in support of protogeni.

db/Experiment.pm.in

@@ -110,6 +110,16 @@ sub Lookup($$;$)
 	    $arg1 = $1;
 	    $arg2 = $2;
 	}
+	elsif ($arg1 =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
+	    my $result =
+		DBQueryWarn("select idx from experiments ".
+			    "where eid_uuid='$arg1'");
+
+	    return undef
+		if (! $result || !$result->numrows);
+
+	    ($idx) = $result->fetchrow_array();
+	}
 	else {
 	    return undef;
 	}
@@ -376,6 +386,7 @@ sub Create($$$$)
 {
     my ($class, $group, $eid, $argref) = @_;
     my $exptidx;
+    my $uuid;
     my $now = time();
 
     return undef
@@ -478,10 +489,23 @@ sub Create($$$$)
     }
 
     # And a UUID (universally unique identifier).
-    my $uuid = NewUUID();
-    if (!defined($uuid)) {
-	print "*** WARNING: Could not generate a UUID!\n";
-	return undef;
+    if (exists($argref->{'eid_uuid'})) {
+	$uuid = $argref->{'eid_uuid'};
+	delete($argref->{'eid_uuid'});
+
+	if (! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
+	    DBQueryWarn("unlock tables");
+	    print "*** WARNING: Bad format in UUID!\n";
+	    return undef;
+	}
+    }
+    else {
+	$uuid = NewUUID();
+	if (!defined($uuid)) {
+	    DBQueryWarn("unlock tables");
+	    print "*** WARNING: Could not generate a UUID!\n";
+	    return undef;
+	}
     }
 
     #
@@ -591,6 +615,8 @@ sub Delete($;$)
     $purge = 0
 	if (!defined($purge));
 
+    $self->UnBindNonLocalUsers();
+
     #
     # Try to remove experiment directory. We allow for it not being there
     # cause we often run the tb programs directly. We also allow for not
@@ -3289,5 +3315,73 @@ sub VnameToPmap($$)
     return Node->Lookup($node_id);
 }
 
+#
+# Insert a virt_nodes entry, as needed when allocating a node to an
+# experiment outside the NS file parsing path. Currently using this
+# from the Geni sliver provisioning code.
+#
+sub InsertVirtNode($$)
+{
+    my ($self, $node) = @_;
+
+    # Must be a real reference. 
+    if (!ref($node)) {
+	$node = Node->Lookup($node);
+	return -1
+	    if (!defined($node));
+    }
+    my $pid = $self->pid();
+    my $eid = $self->eid();
+    my $idx = $self->idx();
+    my $node_id = $node->node_id();
+
+    DBQueryWarn("replace into virt_nodes set ".
+		"  pid='$pid', eid='$eid', exptidx='$idx', ".
+		"  vname='$node_id', type='pc', ips='', ".
+		"  cmd_line='', startupcmd='', osname=''")
+	or return -1;
+    
+    return 0;
+}
+sub DeleteVirtNode($$)
+{
+    my ($self, $node) = @_;
+
+    # Must be a real reference. 
+    if (!ref($node)) {
+	$node = Node->Lookup($node);
+	return -1
+	    if (!defined($node));
+    }
+    my $idx = $self->idx();
+    my $node_id = $node->node_id();
+
+    DBQueryWarn("delete from virt_nodes  ".
+		"where exptidx='$idx' and vname='$node_id'")
+	or return -1;
+    
+    return 0;
+}
+
+#
+# Unbind nonlocal users from this experiment.
+#
+sub UnBindNonLocalUsers($)
+{
+    my ($self) = @_;
+
+    # Must be a real reference.
+    return -1
+	if (!ref($self));
+
+    my $idx = $self->idx();
+
+    DBQueryWarn("delete from nonlocal_user_bindings  ".
+		"where exptidx='$idx'")
+	or return -1;
+    
+    return 0;
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;

db/User.pm.in

@@ -1036,6 +1036,38 @@ sub SSLCert($$$)
     return 0;
 }
 
+#
+# Get user ssh key. This is bogus; I am returning a single key, making sure
+# not to return the emulab key. The keys table needs work.
+#
+sub GetSSHKey($$)
+{
+    my ($self, $pref) = @_;
+    
+    # Must be a real reference. 
+    return -1
+	if (! (ref($self) && ref($pref)));
+
+    my $uid_idx = $self->uid_idx();
+
+    my $query_result =
+	DBQueryWarn("select pubkey from user_pubkeys ".
+		    "where uid_idx='$uid_idx' and ".
+		    "      comment not like '%${OURDOMAIN}' limit 1");
+
+    return -1
+	if (!defined($query_result));
+
+    if ($query_result->numrows) {
+	my ($sshkey) = $query_result->fetchrow_array();
+	$$pref = $sshkey;
+    }
+    else {
+	$$pref = undef;
+    }
+    return 0;
+}
+
 #
 # Get the passphrase for the encrypted key.
 #
@@ -1530,6 +1562,7 @@ sub escapeshellarg($)
 # Non-local users, as for federation/geni.
 #
 package User::NonLocal;
+use User;
 use libdb;
 use libtestbed;
 use English;
@@ -1607,15 +1640,25 @@ sub Stringify($)
 }
 
 #
-# Class function to create a new Geni user and return object.
+# Class function to create a new nonlocal user and return object.
 #
-sub Create($$$$$)
+sub Create($$$$$$;$)
 {
-    my ($class, $uid, $uuid, $name, $email) = @_;
+    my ($class, $idx, $uid, $uuid, $name, $email, $sshkey) = @_;
     my @insert_data = ();
 
     # Every user gets a new unique index.
-    my $idx = User->NextIDX();
+    if (!defined($idx) || $idx == 0) {
+	$idx = User->NextIDX();
+    }
+    else {
+	# Sanity check.
+	my $existing = User->Lookup($idx);
+	if (defined($existing)) {
+	    print STDERR "NonLocal user with $idx already exists: $existing\n";
+	    return undef;
+	}
+    }
 
     # Now tack on other stuff we need.
     push(@insert_data, "created=now()");
@@ -1630,10 +1673,21 @@ sub Create($$$$$)
     push(@insert_data, "email=$safe_email");
     push(@insert_data, "uid_uuid=$safe_uuid");
 
-    # Insert into DB.
-    DBQueryWarn("insert into nonlocal_users set " . join(",", @insert_data))
-	or return undef;
+    if (defined($sshkey)) {
+	my $safe_sshkey = DBQuoteSpecial($sshkey);
+
+	DBQueryWarn("insert into user_pubkeys set ".
+		    "  uid=$safe_uid, uid_idx='$idx', ".
+		    "  idx=NULL, stamp=now(), pubkey=$safe_sshkey")
+	    or return undef;
+    }
 
+    # Insert into DB.
+    if (!DBQueryWarn("insert into nonlocal_users set " .
+		     join(",", @insert_data))) {
+	DBQueryWarn("delete from user_pubkeys where uid_idx='$idx'");
+	return undef;
+    }
     return User::NonLocal->Lookup($idx);
 }
 
@@ -1649,11 +1703,57 @@ sub Delete($)
 
     my $idx = $self->idx();
 
+    DBQueryWarn("delete from user_pubkeys where uid_idx='$idx'")
+	or return -1;
+    DBQueryWarn("delete from nonlocal_user_bindings where uid_idx='$idx'")
+	or return -1;
     DBQueryWarn("delete from nonlocal_users where uid_idx='$idx'")
 	or return -1;
     
     return 0;
 }
 
+#
+# Bind nonlocal user to experiment (slice, in Geni).
+#
+sub BindToExperiment($$)
+{
+    my ($self, $experiment) = @_;
+
+    return -1
+	if (! ref($self));
+
+    my $uid     = $self->uid();
+    my $idx     = $self->idx();
+    my $exptidx = $experiment->idx();
+    
+    # Insert into DB.
+    DBQueryWarn("replace into nonlocal_user_bindings set " .
+		"  uid='$uid', uid_idx='$idx', exptidx='$exptidx'")
+	or return -1;
+
+    return 0;
+}
+
+sub UnBindFromExperiment($$)
+{
+    my ($self, $experiment) = @_;
+
+    return -1
+	if (! ref($self));
+
+    my $uid     = $self->uid();
+    my $idx     = $self->idx();
+    my $exptidx = $experiment->idx();
+    
+    # Insert into DB.
+    DBQueryWarn("delete from nonlocal_user_bindings " .
+		"where uid_idx='$idx' and exptidx='$exptidx'")
+	or return -1;
+
+    return 0;
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;
+

tbsetup/swapexp.in

@@ -32,7 +32,7 @@ sub usage()
 	  "<nsfile> - Optional NS file to parse for experiment modify\n");
     exit(-1);
 }
-my  $optlist = "biafres:wqx";
+my  $optlist = "biafres:wqxg";
 
 #
 # Exit codes are important; they tell the web page what has happened so
@@ -102,6 +102,7 @@ my $force    = 0;
 my $reboot   = 0;
 my $waitmode = 0;
 my $quiet    = 0;
+my $genimode = 0;
 my $eventsys_restart   = 0;
 my $errorstat= -1;
 my $modifyHosed   = 0;
@@ -164,6 +165,9 @@ if (defined($options{"a"})) {
 if (defined($options{"f"})) {
     $force = 1;
 }
+if (defined($options{"g"})) {
+    $genimode = 1;
+}
 if (defined($options{"b"})) {
     $batch = 1;
 }
@@ -779,7 +783,7 @@ if ($inout eq "modify" && defined($modnsfile)) {
 #
 # If not in batch mode, go into the background. Parent exits.
 #
-if (! $batch && ! $template_mode) {
+if (! $batch && ! $template_mode && !$genimode) {
     # Cleanup
     $experiment->CleanLogFiles() == 0
 	or fatal("Could not clean up logfiles!");
@@ -1243,7 +1247,7 @@ $experiment->Unlock();
 $experiment->SetCancelFlag(EXPTCANCEL_CLEAR);
 
 exit(0)
-    if ($template_mode);
+    if ($template_mode || $genimode);
 
 print "Swap Success!\n";
 

tbsetup/tbreport.in

@@ -2,7 +2,7 @@
 
 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2007 University of Utah and the Flux Group.
+# Copyright (c) 2000-2008 University of Utah and the Flux Group.
 # All rights reserved.
 #
 
@@ -216,16 +216,16 @@ if ($shownodes) {
 	}
 
 	printf "%-15s %-12s %-15s %s\n", $vname, $type, $osname, $qualname;
-	if ($cmd_line ne "") {
+	if (defined($cmd_line) && $cmd_line ne "") {
 	    printf "   %-17s %s\n", "Command Line:", $cmd_line;
 	}
-	if ($startupcmd ne "") {
+	if (defined($startupcmd) && $startupcmd ne "") {
 	    printf "   %-17s %s\n", "Startup Command:", $startupcmd;
 	}
-	if ($rpms ne "") {
+	if (defined($rpms) && $rpms ne "") {
 	    printf "   %-17s %s\n", "RPMS:", $rpms;
 	}
-	if ($tarfiles ne "") {
+	if (defined($tarfiles) && $tarfiles ne "") {
 	    printf "   %-17s %s\n", "Tarfiles:", $tarfiles;
 	}
     }

tbsetup/tbswap.in

@@ -635,7 +635,8 @@ sub doSwapout($) {
                          "  from reserved as rv ".
 			 "left join nodes as n on n.node_id = rv.node_id ".
 			 "left join node_types as nt on nt.type=n.type ".
-			 "where rv.pid='$pid' and rv.eid='$eid'");
+			 "where rv.pid='$pid' and rv.eid='$eid' and ".
+			 "      rv.genisliver_idx is null");
 
 	while (my ($node,$allocstate,$isvirt) = $db_result->fetchrow_array) {
 	    if ($allocstate ne TBDB_ALLOCSTATE_RES_READY()) {