Add ssh key updating to instances when users change their keys via the web

interface. We do this with the AMV3 PerformOperationalAction call. The
actual updates are invoked from the apt_daemon; after a key change we just
set a flag in the apt_instances table.

Also some unrelated debugging code in APT_Instance.

account/addpubkey.in

 #!/usr/bin/perl -wT
 #
-# Copyright (c) 2000-2015 University of Utah and the Flux Group.
+# Copyright (c) 2000-2016 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 
@@ -101,6 +101,7 @@ use libaudit;
 use libdb;
 use libtestbed;
 use User;
+use APT_Utility;
 
 #
 # Function prototypes
@@ -471,6 +472,7 @@ sub ParseKey($) {
     # Mark user record as modified so nodes are updated.
     #
     TBNodeUpdateAccountsByUID($user_uid);
+    APT_Utility::UpdateInstancesByUser($target_user);
 
     my $chunked = "";
 

apt/APT_Instance.pm.in

@@ -74,6 +74,16 @@ my $debug      = 0;
 
 # Debugging
 my $usemydevtree  = 0;
+sub devurl($)
+{
+    my ($cmurl) = @_;
+
+    if ($usemydevtree) {
+	$cmurl =~ s/protogeni/protogeni\/stoller/;
+	$cmurl =~ s/12369/12396/;
+    }
+    return $cmurl;
+}
 
 #
 # Lookup by uuid.
@@ -818,13 +828,13 @@ sub WriteCredentials($$)
 #
 # Build a set of sshkeys.
 #
-sub GetSSHKeys($$)
+sub GetSSHKeys($$;$)
 {
-    my ($self, $pref) = @_;
+    my ($self, $pref, $target_user) = @_;
     my $rval;
     my @keys;
 
-    my $geniuser = $self->GetGeniUser();
+    my $geniuser = $target_user || $self->GetGeniUser();
     return -1
 	if (!defined($geniuser));
     my $project  = $self->GetProject();
@@ -844,6 +854,10 @@ sub GetSSHKeys($$)
 	      'keys'  => [ @keys ]
 	     }];
 
+    # Want keys for single user.
+    goto done
+	if (defined($target_user));
+
     if (! ($project->pid() eq $APT_HOLDINGPROJECT ||
 	   $project->pid() eq $CLOUD_HOLDINGPROJECT)) {
 	#
@@ -885,6 +899,7 @@ sub GetSSHKeys($$)
 	    }
 	}
     }
+  done:
     $$pref = $rval;
     return 0;
 }
@@ -952,6 +967,7 @@ use APT_Geni;
 use Data::Dumper;
 use vars qw($AUTOLOAD);
 use overload ('""' => 'Stringify');
+sub devurl($) { return APT_Instance::devurl($_[0]); }
 
 #
 # Lookup and create a class instance to return.
@@ -1376,7 +1392,7 @@ sub Terminate($)
 	
 	# Convert URL to use AM interface.
 	$cmurl =~ s/\/cm$/\/am/;
-	$cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+	$cmurl = devurl($cmurl) if ($usemydevtree);
     }
 
     #
@@ -1530,8 +1546,8 @@ sub Extend($$)
 	$method = "RenewSlice";
     }
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
-
+    $cmurl = devurl($cmurl) if ($usemydevtree);
+    
     my $tries = 10;
     my $response;
     while ($tries) {
@@ -1592,7 +1608,7 @@ sub SliceStatus($)
 		   });
     }
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $response =
 	Genixmlrpc::CallMethod($cmurl, $context, "SliverStatus", @params);
@@ -1660,7 +1676,7 @@ sub GetManifest($)
 				      $speaksfor_credential->asString()]});
     }
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $tries = 10;
     my $response;
@@ -1732,7 +1748,7 @@ sub Provision($$$$)
     my $cmurl = $authority->url();
     # Convert URL.
     $cmurl =~ s/\/cm$/\/am/;
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
     $cmurl .= "/3.0";
 
     my $tries = 10;
@@ -1790,7 +1806,7 @@ sub ConsoleInfo($$)
 			  $speaksfor_credential->asString()],
     };
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     return Genixmlrpc::CallMethod($cmurl, $context, "ConsoleInfo", $args);
 }
@@ -1822,7 +1838,7 @@ sub ConsoleURL($$)
 			  $speaksfor_credential->asString()],
     };
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     return Genixmlrpc::CallMethod($cmurl, $context, "ConsoleURL", $args);
 }
@@ -1864,7 +1880,7 @@ sub CreateImage($$$$;$$$)
 	if (defined($copyback_uuid));
 
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
     
     return Genixmlrpc::CallMethod($cmurl, $context, "CreateImage", $args);
 }
@@ -1903,7 +1919,7 @@ sub SliverAction($$$@)
 	$args->{"slice_urn"} = $slice->urn();
     }
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $response;
     my $tries = 5;
@@ -1964,7 +1980,7 @@ sub Lockdown($$)
     $args->{"clear"} = 1
 	if ($clear);
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $response = Genixmlrpc::CallMethod($cmurl, $context, "Lockdown", $args);
     $slice->SetExpiration($oldexpires)
@@ -2010,7 +2026,7 @@ sub Panic($$)
     $args->{"clear"} = 1
 	if ($clear);
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $response = Genixmlrpc::CallMethod($cmurl, $context, "Panic", $args);
     $slice->SetExpiration($oldexpires)
@@ -2060,7 +2076,7 @@ sub RunLinktest($$$)
 	$args->{"level"}  = $level;
     }
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     my $response = Genixmlrpc::CallMethod($cmurl,
 					  $context, "RunLinktest", $args);
@@ -2095,10 +2111,80 @@ sub ImageInfo($$)
 			  $speaksfor_credential->asString()],
     };
     my $cmurl = $authority->url();
-    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    $cmurl = devurl($cmurl) if ($usemydevtree);
 
     return Genixmlrpc::CallMethod($cmurl, $context, "ImageInfo", $args);
 }
 
+#
+# Update ssh keys.
+#
+sub UpdateKeys($$)
+{
+    my ($self, $users) = @_;
+    my $authority = $self->GetGeniAuthority();
+    my $urn       = $self->aggregate_urn();
+    my $geniuser  = $self->instance()->GetGeniUser();
+    my $slice     = $self->instance()->GetGeniSlice();
+    my $context   = APT_Geni::GeniContext();
+    return -1
+	if (! (defined($geniuser) && defined($authority) &&
+	       defined($slice) && defined($context)));
+
+    my ($slice_credential, $speaksfor_credential) =
+	APT_Geni::GenCredentials($slice, $geniuser);
+    return -1
+	if (! (defined($speaksfor_credential) &&
+	       defined($slice_credential)));
+
+    #
+    # AM V3 API.
+    #
+    my @params = ([$slice->urn()],
+		  [{"geni_type" => "geni_sfa",
+		    "geni_version" => 3,
+		    "geni_value" => $speaksfor_credential->asString()},
+		   {"geni_type" => "geni_sfa",
+		    "geni_version" => 3,
+		    "geni_value" => $slice_credential->asString()},
+		  ],
+		  "geni_update_users",
+		  # Options array.
+		  {"speaking_for" => $geniuser->urn(),
+		   "geni_speaking_for" => $geniuser->urn(),
+		   "geni_users"       => $users,
+		  });
+ 
+    my $cmurl = $authority->url();
+    # Convert URL.
+    $cmurl =~ s/\/cm$/\/am/;
+    $cmurl = devurl($cmurl) if ($usemydevtree);
+    $cmurl .= "/3.0";
+
+    my $tries = 10;
+    my $response;
+    while ($tries) {
+	$response =
+	    Genixmlrpc::CallMethod($cmurl, $context,
+				   "PerformOperationalAction", @params);
+
+	if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
+	    if (defined($response) &&
+		($response->code() == GENIRESPONSE_SERVER_UNAVAILABLE ||
+		 $response->code() == GENIRESPONSE_BUSY) &&
+		$tries >= 0) {
+		print STDERR "Server for $urn reports too busy or slice busy, ".
+		    "waiting a while ...\n";
+		sleep(int(rand(20)) + 10);
+		$tries--;
+		next;
+	    }
+	    return $response;
+	}
+	last;
+    }
+    return $response;
+}
+
 # _Always_ make sure that this 1 is at the end of the file...
 1;

apt/APT_Utility.pm.in

+#!/usr/bin/perl -wT
+#
+# Copyright (c) 2007-2016 University of Utah and the Flux Group.
+# 
+# {{{EMULAB-LICENSE
+# 
+# This file is part of the Emulab network testbed software.
+# 
+# This file is free software: you can redistribute it and/or modify it
+# under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+# 
+# This file is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
+# License for more details.
+# 
+# You should have received a copy of the GNU Affero General Public License
+# along with this file.  If not, see <http://www.gnu.org/licenses/>.
+# 
+# }}}
+#
+#
+# Stuff that has no where else to go.
+#
+package APT_Utility;
+
+use strict;
+use English;
+use Data::Dumper;
+use Carp;
+use Exporter;
+use vars qw(@ISA @EXPORT);
+
+@ISA    = "Exporter";
+@EXPORT = qw ( );
+
+# Must come after package declaration!
+use emdb;
+use libtestbed;
+use APT_Instance;
+use Project;
+use Group;
+
+# Configure variables
+my $TB		  = "@prefix@";
+my $MAINSITE      = @TBMAINSITE@;
+my $TBOPS         = "@TBOPSEMAIL@";
+
+#
+# Find all of the instances a user has (should have) an account on, and
+# mark those instances for update.
+#
+sub UpdateInstancesByUser($)
+{
+    my ($user) = @_;
+    my @projects  = ();
+    my %instances = ();
+
+    if ($user->ProjectMembershipList(\@projects)) {
+	return -1;
+    }
+    return 0
+	if (!@projects);
+
+    foreach my $project (@projects) {
+	my $pid_idx = $project->pid_idx();
+
+	my $query_result =
+	    DBQueryWarn("select uuid from apt_instances ".
+			"where pid_idx='$pid_idx'");
+	return -1
+	    if (!$query_result);
+
+	while (my ($uuid) = $query_result->fetchrow_array()) {
+	    my $instance = APT_Instance->Lookup($uuid);
+	    next
+		if (!defined($instance));
+	    $instances{$uuid} = $instance;
+	}
+    }
+    # Update each instance only once. 
+    foreach my $instance (values(%instances)) {
+	$instance->Update({"needupdate" => 1});
+    }
+    return 0;
+}

apt/GNUmakefile.in

@@ -34,7 +34,7 @@ BIN_SCRIPTS	= manage_profile manage_instance manage_dataset \
                   create_instance rungenilib
 SBIN_SCRIPTS	= apt_daemon aptevent_daemon
 LIB_SCRIPTS     = APT_Profile.pm APT_Instance.pm APT_Dataset.pm APT_Geni.pm \
-		  APT_Aggregate.pm
+		  APT_Aggregate.pm APT_Utility.pm
 WEB_BIN_SCRIPTS = webmanage_profile webmanage_instance webmanage_dataset \
                   webcreate_instance webrungenilib
 WEB_SBIN_SCRIPTS=

apt/apt_daemon.in

 #!/usr/bin/perl -w
 #
-# Copyright (c) 2008-2015 University of Utah and the Flux Group.
+# Copyright (c) 2008-2016 University of Utah and the Flux Group.
 # 
 # {{{GENIPUBLIC-LICENSE
 # 
@@ -234,7 +234,8 @@ sub FixFailedImaging()
 	}
 	$genislice->UnLock();
       skip:
-	$genislice->Flush();
+	$genislice->Flush()
+	    if (defined($genislice));
 	next;
     }
 }
@@ -448,6 +449,67 @@ sub UpdateAggregateGraphs()
     return 0;
 }
 
+#
+# Push out updates.
+#
+sub PushUpdates()
+{
+    my $query_result =
+	DBQueryWarn("select uuid from apt_instances ".
+		    "where status='ready' and needupdate!=0");
+    return
+	if (!$query_result);
+
+    while (my ($uuid) = $query_result->fetchrow_array()) {
+	my $instance = APT_Instance->Lookup($uuid);
+	if (!defined($instance)) {
+	    print STDERR "No such instance $uuid\n";
+	    next;
+	}
+	print STDERR "$instance needs update.\n";
+	next
+	    if ($impotent);
+
+	#
+	# If its locked, then do not bother trying; wait till next time
+	# through the loop. 
+	#
+	my $genislice = $instance->GetGeniSlice();
+	next
+	    if (!defined($genislice));
+	goto skip
+	    if ($genislice->Lock() != 0);
+
+	#
+	# Clear the needupdate flag now. If a user comes along and
+	# adds a new key during this update, the next time through the
+	# loop we will get it. If it results in doing the same thing
+	# twice, no big deal. 
+	#
+	$instance->Update({"needupdate" => 0}) == 0
+	    or goto skip;
+
+	#
+	# Unlock before we call out to do the update; if someone else
+	# locks it, the update will fail and we will reset the needupdate
+	# flag for next time through the loop. No one else clears it
+	# so this is safe for now. 
+	#	
+	$genislice->UnLock();
+	system("$MANAGEINSTANCE updatekeys $uuid");
+	if ($?) {
+	    $instance->Update({"needupdate" => 1});
+	}
+      skip:
+	$genislice->Flush();
+    }
+}
+
+if ($oneshot) {
+    PushUpdates();
+    exit(0);
+}
+
 my $reportcounter = 0;
 
 # Do this once at startup
@@ -469,6 +531,7 @@ while (1) {
     FixFailedImaging();
     ExpireInstances();
     UpdateAggregateGraphs();
+    PushUpdates();
 
     # Do this once every 24 hours.
     if ($reportcounter >= (24 * 60 * 60)) {

apt/manage_instance.in

@@ -48,6 +48,7 @@ sub usage()
     print("Usage: manage_instance panic instance set|clear\n");
     print("Usage: manage_instance linktest instance [-k | level]\n");
     print("Usage: manage_instance writecreds instance directory\n");
+    print("Usage: manage_instance updatekeys instance [uid] \n");
     exit(-1);
 }
 my $optlist     = "dt:s";
@@ -94,6 +95,7 @@ use Genixmlrpc;
 use GeniResponse;
 use GeniSlice;
 use GeniImage;
+use GeniUser;
 use WebTask;
 use EmulabFeatures;
 
@@ -110,6 +112,7 @@ sub DoLockdown();
 sub DoPanic();
 sub DoManifests();
 sub DoLinktest();
+sub DoUpdateKeys();
 sub WriteCredentials();
 sub StartMonitor();
 sub StartMonitorInternal(;$);
@@ -178,6 +181,9 @@ elsif ($action eq "panic") {
 elsif ($action eq "linktest") {
     DoLinktest()
 }
+elsif ($action eq "updatekeys") {
+    DoUpdateKeys()
+}
 elsif ($action eq "writecreds") {
     WriteCredentials()
 }
@@ -2177,6 +2183,136 @@ sub DoLinktest()
     exit(1);
 }
 
+#
+# Update SSH keys.
+# 
+sub DoUpdateKeys()
+{
+    my $target_user;
+    my $errmsg;
+    my $errcode = 1;
+    
+    if (@ARGV) {
+	my $uid = shift(@ARGV);
+	# If a target user, we are operating on that user, not the
+	# entire instance.
+	$target_user = User->Lookup($uid);
+	if (!defined($target_user)) {
+	    fatal("no such target user $uid");
+	}
+	$target_user = GeniUser::LocalUser->Create($target_user);
+    }
+    my $slice = $instance->GetGeniSlice();
+    if (!defined($slice)) {
+	fatal("No slice for instance!");
+    }
+    # The web interface (and in the future the xmlrpc interface) sets this.
+    my $this_user = User->ImpliedUser();
+    if (! defined($this_user)) {
+	$this_user = User->ThisUser();
+    }
+
+    # This returns in CM format.
+    my $sshkeys;
+    if ($instance->GetSSHKeys(\$sshkeys, $target_user) < 0 || !@{$sshkeys}) {
+	fatal("Could not get ssh keys for instance");
+    }
+
+    #
+    # The AM API uses a different ssh key structure.
+    #
+    my $users = [];
+    foreach my $user (@{$sshkeys}) {
+	my @tmp = map { $_->{'key'} } @{$user->{'keys'}};
+	
+	push(@{$users},
+	     {"urn"  => $user->{'urn'},
+	      "keys" => [ @tmp ] });
+    }
+
+    #
+    # Lock the slice in case it is doing something else, like taking
+    # a disk image.
+    #
+    if ($slice->Lock()) {
+	fatal("Slice is busy, cannot lock it");
+    }
+    #
+    # Create the webtask object, but AFTER locking the slice so we do
+    # not destroy one in use.
+    #
+    if (defined($webtask_id)) {
+	$webtask = WebTask->LookupOrCreate($instance->uuid(), $webtask_id);
+	# Convenient.
+	$webtask->AutoStore(1);
+    }
+
+    #
+    # And tell the backend clusters to do the update.
+    #
+    my $coderef = sub {
+	my ($sliver) = @_;
+	my $webtask  = $sliver->webtask();
+
+	my $response = $sliver->UpdateKeys($users);
+	if (!defined($response)) {
+	    print STDERR "RPC Error calling updatekeys on $sliver\n";
+	    return -1;
+	}
+	if ($response->code() != GENIRESPONSE_SUCCESS) {
+	    print STDERR "Could not update keys on sliver: ".
+		$response->output() . "\n";
+	    $webtask->output($response->output());
+	    $webtask->Exited($response->code());
+	    return $response->code();
+	}
+	return 0;
+    };
+    my @return_codes = ();
+    my @agglist      = ();
+    #
+    # Cull out any aggregates with no nodes.
+    #
+    foreach my $agg ($instance->AggregateList()) {
+	push(@agglist, $agg)
+	    if ($agg->physnode_count() || $agg->virtnode_count());
+    }
+    
+    if (ParRun({"maxwaittime" => 99999,
+		"maxchildren" => scalar(@agglist)},
+	       \@return_codes, $coderef, @agglist)) {
+	$errmsg = "Internal error calling UpdateKeys()";
+	goto bad;
+    }
+    #
+    # Check the exit codes. 
+    #
+    foreach my $agg (@agglist) {
+	my $code = shift(@return_codes);
+	if ($code) {
+	    $errmsg = "Could not update keys on some slivers";
+	    if ($agg->webtask()->output()) {
+		$errmsg .= ": " . $agg->webtask()->output();
+		$errcode = $code;
+	    }
+	    goto bad;
+	}
+	if (!defined($webtask) && $agg->webtask()->results()) {
+	    print $agg->webtask()->results();
+	}
+    }
+    $slice->UnLock();
+    exit(0);
+  bad:
+    $slice->UnLock();
+    print STDERR $errmsg . "\n";
+    if (defined($webtask)) {
+	$webtask->output($errmsg);
+	$webtask->Exited($errcode);
+    }
+    exit(1);
+}
+