Backend web support for deleting profile versions, and tracking/deleting

image versions at the clusters.

apt/manage_images.in

+#!/usr/bin/perl -w
+#
+# Copyright (c) 2000-2017 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/>.
+# 
+# }}}
+#
+use English;
+use strict;
+use Getopt::Std;
+use Data::Dumper;
+use Date::Parse;
+use JSON;
+
+#
+# Back-end script to manage APT profiles.
+#
+sub usage()
+{
+    print STDERR "Usage: manage_images [options --] list ...\n";
+    print STDERR "Usage: manage_images [options --] delete <urn> ...\n";
+    exit(-1);
+}
+my $optlist     = "dt:";
+my $debug       = 0;
+my $webtask_id;
+my $webtask;
+
+# For development.
+my $usemydevtree = 0;
+
+#
+# Configure variables
+#
+my $TB		  = "@prefix@";
+my $TBOPS         = "@TBOPSEMAIL@";
+my $OURDOMAIN     = "@OURDOMAIN@";
+my $MYURN         = "urn:publicid:IDN+${OURDOMAIN}+authority+cm";
+my $MANAGEPROFILE = "$TB/bin/manage_profile";
+
+#
+# Untaint the path
+#
+$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Load the Testbed support stuff.
+#
+use lib "@prefix@/lib";
+use libtestbed;
+use emdb;
+use emutil;
+use Project;
+use User;
+use WebTask;
+use GeniResponse;
+use GeniXML;
+use GeniUser;
+use APT_Geni;
+use APT_Profile;
+
+# Protos
+sub fatal($);
+sub DoListImages();
+sub DoDeleteImage();
+
+#
+# Parse command arguments. Once we return from getopts, all that should be
+# left are the required arguments.
+#
+my %options = ();
+if (grep {$_ eq "--"} @ARGV &&
+    ! getopts($optlist, \%options)) {
+    usage();
+}
+if (defined($options{"d"})) {
+    $debug = 1;
+}
+if (defined($options{"t"})) {
+    $webtask_id = $options{"t"};
+    $webtask = WebTask->Lookup($webtask_id);
+    if (!defined($webtask)) {
+	fatal("Could not get webtask object");
+    }
+    $webtask->AutoStore(1);
+}
+if (@ARGV < 1) {
+    usage();
+}
+my $action = shift(@ARGV);
+
+# Need a real user.
+my $this_user = User->ThisUser();
+if (! defined($this_user)) {
+    fatal("You ($UID) do not exist!");
+}
+my $geniuser = GeniUser->CreateFromLocal($this_user);
+
+if ($action eq "list") {
+    exit(DoListImages());
+}
+elsif ($action eq "delete") {
+    exit(DoDeleteImage());
+}
+else {
+    usage();
+}
+exit(1);
+
+#
+# List all images at the specified cluster,
+#
+sub DoListImages()
+{
+    my $usage = sub {
+	print STDERR "Usage: manage_images list [-a am_urn]\n";
+	exit(-1);
+    };
+    my $optlist = "a:p";
+    my $aggregate_urn = $MYURN;
+    my $withprofiles  = 0;
+    my $errmsg;
+    my %options = ();
+    if (! getopts($optlist, \%options)) {
+	&$usage();
+    }
+    if (defined($options{"a"})) {
+	$aggregate_urn = $options{"a"};
+    }
+    if (defined($options{"p"})) {
+	$withprofiles = 1;
+    }
+    my $context = APT_Geni::GeniContext();
+    if (!defined($context)) {
+	fatal("Could not create context to talk to CM.");
+    }
+    Genixmlrpc->SetContext($context);
+    # Shorten default timeout.
+    Genixmlrpc->SetTimeout(60);
+
+    my $authority = GeniAuthority->Lookup($aggregate_urn);
+    if (!defined($authority)) {
+	fatal("No such aggregate");
+    }
+    my $cmurl = $authority->url();
+    if ($usemydevtree) {
+	$cmurl =~ s/protogeni/protogeni\/stoller/;
+    }
+    my ($credential, $speaksfor) = APT_Geni::GenUserCredential($geniuser);
+    fatal("Could not generate credentials for user")
+	if (!defined($credential));
+
+    my $credentials = [$credential->asString()];
+    if (defined($speaksfor)) {
+	$credentials = [@$credentials, $speaksfor->asString()];
+    }
+    my $args = {
+	"credentials" => $credentials,
+    };
+    my $response = Genixmlrpc::CallMethod($cmurl, undef, "ListImages", $args);
+
+    if ($response->code() != GENIRESPONSE_SUCCESS) {
+	if ($response->output()) {
+	    print STDERR $response->output() . "\n";
+	    if (defined($webtask)) {
+		$webtask->output($response->output());
+	    }
+	}
+	else {
+	    print STDERR "Operation failed, returned " .
+		$response->code() . "\n";
+	    if (defined($webtask)) {
+		$webtask->output("Operation failed");
+	    }
+	}
+	if (defined($webtask)) {
+	    $webtask->Exited($response->code());
+	}
+	exit($response->code());
+    }
+    #
+    # We get back a flat list, which can include mulitple versions of
+    # each image. Lets reorganize into multilevel hash structure
+    # before giving it back to the web interface, so the web interface
+    # can just pass it off to the client browser. Also make sure
+    # projects map to local projects, and put the local project into
+    # the list if so.
+    #
+    my %ilist = ();
+
+    #
+    # First pass, bin them. The urn is without the versions, and then
+    # there is a list of version urns.
+    #
+    foreach my $image (@{ $response->value() }) {
+	my $urn     = $image->{"urn"};
+	my $hrn     = GeniHRN->new($urn);
+	next
+	    if (!defined($hrn));
+	my ($auth, $ospid, $os, $osvers) = $hrn->ParseImage();
+	next
+	    if (!defined($authority));
+	# URN without the version.
+	$urn = GeniHRN::GenerateImage($auth,$ospid,$os,undef);
+	
+	# Default to version zero, for old sites not reporting version.
+	my $vers = (defined($osvers) ? $osvers : 0);
+	# Put it into the object so that PHP/JS code can find it easy.
+	$image->{'version'} = $vers;
+
+	# Try and set a local project, but use remote pid otherwise.
+	$image->{'pid'} = $ospid;
+
+	if (!exists($ilist{$urn})) {
+	    $ilist{$urn} = [];
+	}
+	push(@{	$ilist{$urn} }, $image);
+    }
+    #
+    # Convert to a lexically ordered list. 
+    #
+    my @ordered = ();
+    foreach my $urn (sort keys(%ilist)) {
+	push(@ordered, {"urn"      => $urn,
+			"versions" => $ilist{$urn}});
+    }
+    
+    #
+    # Find profiles using both the naked image and the version
+    # specific images. Also map the project urn to a local project.
+    #
+    foreach my $ref (@ordered) {
+	my $urn = $ref->{'urn'};
+	my @versions = @{$ref->{'versions'}};
+	my $image0 = $versions[0];
+
+	#
+	# Use version zero of the image to map the local project. 
+	#
+	if (exists($image0->{'project_urn'})) {
+	    my $projhrn = GeniHRN->new($image0->{'project_urn'});
+	    if ($projhrn->domain() eq $OURDOMAIN &&
+		defined($projhrn->project())) {
+		my $project = Project->Lookup($projhrn->project());
+		if (defined($project)) {
+		    $ref->{'pid'}     = $project->pid();
+		    $ref->{'pid_idx'} = $project->pid_idx();
+		}
+	    }
+	}
+	else {
+	    # Remote pid, set above
+	    $ref->{'pid'} = $image0->{'pid'};
+	}
+	
+	#
+	# Find profiles using the named image
+	#
+	$ref->{'using'} = [];
+	my @nakedusing  = ();
+	next
+	    if (APT_Profile::ImageInfo::FindProfilesUsing($urn, \@nakedusing));
+
+	#
+	# If no profiles using the naked image, mark it for delete, but
+	# if any versions are in use below, we will flip it to no.
+	#
+	$ref->{'candelete'} = (@nakedusing ? 0 : 1);
+	# How many of the children are inactive (can be deleted).
+	$ref->{'inactive'}  = 0;
+
+	#
+	# List of profiles, with a list of versions of each.
+	#
+	my %tmp = ();
+	foreach my $profile (@nakedusing) {
+	    my $profile_uuid = $profile->profile_uuid();
+
+	    if (!exists($tmp{$profile_uuid})) {
+		$tmp{$profile_uuid} = {
+		    "uuid"     => $profile_uuid,
+		    "name"     => $profile->name(),
+		    "creator"  => $profile->creator(),
+		    "project"  => $profile->pid(),
+		    "versions" => [],
+		};
+	    }
+	    push(@{$tmp{$profile_uuid}->{'versions'}},
+		 {"uuid"    => $profile->uuid(),
+		  "version" => $profile->version(),
+		  "created" => $profile->created(),
+		 });
+	}
+	$ref->{'using'} = [ values(%tmp) ];
+
+	#
+	# And for each version of the image.
+	#
+	# The last version of the image is special; it gets any profile
+	# references for the naked image, since that is what a naked image
+	# means; use the most recent image. So if we have naked references,
+	# mark the last image for the loop below so we can extend the list
+	#
+	if (@nakedusing) {
+	    $versions[scalar(@versions) - 1]->{'islast'} = 1;
+	}
+	foreach my $image (@versions) {
+	    my $urn = $image->{'urn'};
+	    my @using = ();
+	    $image->{'using'} = [];
+	    $image->{'candelete'} = 0;
+
+	    next
+		if (APT_Profile::ImageInfo::FindProfilesUsing($urn, \@using));
+
+	    # Combine the lists.
+	    if ($image->{'islast'}) {
+		foreach my $p (@nakedusing) {
+		    push(@using, $p)
+			if (!grep {$_->profileid() == $p->profileid()} @using);
+		}
+	    }
+
+	    #
+	    # No references *currently* means we can delete the image. 
+	    #
+	    if (!@using) {
+		$image->{'candelete'} = 1;
+		$ref->{'inactive'}++;
+		next;
+	    }
+	    # Reset candelete to no for entire image. See above.
+	    $ref->{'candelete'} = 0;
+
+	    %tmp = ();
+	    foreach my $profile (@using) {
+		my $profile_uuid = $profile->profile_uuid();
+
+		if (!exists($tmp{$profile_uuid})) {
+		    $tmp{$profile_uuid} = {
+			"uuid"     => $profile_uuid,
+			"name"     => $profile->name(),
+			"creator"  => $profile->creator(),
+			"project"  => $profile->pid(),
+			"versions" => [],
+		    };
+		}
+		push(@{$tmp{$profile_uuid}->{'versions'}},
+		     {"uuid"    => $profile->uuid(),
+		      "version" => $profile->version(),
+		      "created" => $profile->created(),
+		     });
+	    }
+	    $image->{'using'} = [ values(%tmp) ];
+	}
+    }
+    if (defined($webtask)) {
+	$webtask->value(\@ordered);
+	$webtask->Exited(0);
+    }
+    else {
+	print Dumper(\@ordered);
+    }
+    exit(0);
+}
+
+#
+# Delete image at the specified cluster,
+#
+sub DoDeleteImage()
+{
+    my $usage = sub {
+	print STDERR "Usage: manage_images delete [-a am_urn] <image_urn>\n";
+	exit(-1);
+    };
+    my $optlist = "a:d:n";
+    my $aggregate_urn = $MYURN;
+    my $impotent      = 0;
+    my $profile;
+    my $errmsg;
+    my %options = ();
+    if (! getopts($optlist, \%options)) {
+	&$usage();
+    }
+    if (defined($options{"a"})) {
+	$aggregate_urn = $options{"a"};
+    }
+    if (defined($options{"n"})) {
+	$impotent = 1;
+    }
+    &$usage()
+	if (!@ARGV);
+    my $image_urn = shift(@ARGV);
+    
+    if (defined($options{"d"})) {
+	$profile = APT_Profile->Lookup($options{"d"});
+	if (!defined($profile)) {
+	    fatal("Profile does not exist");
+	}
+	if ($profile->isLocked()) {
+	    fatal("Profile is locked down, cannot be deleted");
+	}
+	#
+	# This argument says; delete any version of the specified
+	# profile, that reference the image being deleted. So we
+	# have to go through every version of the profile and check
+	# to see if its using this image. For any of those versions,
+	# we try to delete it.
+	#
+	my @todelete = ();
+	
+	foreach my $version ($profile->AllVersions()) {
+	    my $usingimage = 0;
+	    my $conflict;
+
+	    #
+	    # Check image references for this version. We want to
+	    # know if there are any other images associated with this
+	    # version beside the one we are trying to delete. If so,
+	    # we cannot delete the profile version since that will
+	    # result in another image getting deleted.
+	    #
+	    my %irefs = %{ $version->images() };
+	    
+	    foreach my $client_id (keys(%irefs)) {
+		my $imageinfo = $irefs{$client_id};
+		# 
+		# We do not ever care about system images.
+		#
+		next
+		    if ($imageinfo->ospid() eq "emulab-ops");
+
+		my $snapname = $profile->name() . "." . $client_id;
+
+		next
+		    if (! ($imageinfo->os() eq $profile->name() ||
+			   $imageinfo->os() eq $snapname));
+
+		if ($imageinfo->image() eq $image_urn) {
+		    $usingimage = 1;
+		}
+		else {
+		    $conflict = $imageinfo->image();
+		}
+	    }
+	    if ($usingimage && $conflict) {
+		fatal("Version " . $version->version() . " of the " .
+		      $version->name() . " profile has another ".
+		      "image that would be deleted as well: $conflict. ".
+		      "You will need to go to the profile page and delete ".
+		      "that profile version before you can delete this image.");
+	    }
+	    if ($usingimage && $version->isLocked()) {
+		fatal("Version " . $version->version() . " is locked ".
+		      "down, cannot delete it.");
+	    }
+	    if ($usingimage) {
+		push(@todelete, $version);
+		print "Would delete profile version " .
+		    $version->version() . "\n";
+	    }
+	}
+	foreach my $version (@todelete) {
+	    my $vers = $version->version();
+	    my $uuid = $version->uuid();
+	    
+	    print "Deleting version $vers\n";
+	    my $opt = ($impotent ? "-n" : "");
+
+	    my $output =
+		emutil::ExecQuiet("$MANAGEPROFILE delete -- -k $opt $uuid");
+	    print $output;
+	    if ($?) {
+		fatal("Could not delete version $vers");
+	    }
+	}
+    }
+    
+    my $context = APT_Geni::GeniContext();
+    if (!defined($context)) {
+	fatal("Could not create context to talk to CM.");
+    }
+    Genixmlrpc->SetContext($context);
+    # Shorten default timeout.
+    Genixmlrpc->SetTimeout(60);
+
+    my $authority = GeniAuthority->Lookup($aggregate_urn);
+    if (!defined($authority)) {
+	fatal("No such aggregate");
+    }
+    my $cmurl = $authority->url();
+    if ($usemydevtree) {
+	$cmurl =~ s/protogeni/protogeni\/stoller/;
+    }
+    my ($credential, $speaksfor) = APT_Geni::GenUserCredential($geniuser);
+    fatal("Could not generate credentials for user")
+	if (!defined($credential));
+
+    my $credentials = [$credential->asString()];
+    if (defined($speaksfor)) {
+	$credentials = [@$credentials, $speaksfor->asString()];
+    }
+    my $args = {
+	"image_urn"   => $image_urn,
+	"credentials" => $credentials,
+    };
+    if ($impotent) {
+	$args->{"impotent"} = 1;
+    }
+    my $response = Genixmlrpc::CallMethod($cmurl, undef, "DeleteImage", $args);
+
+    if ($response->code() != GENIRESPONSE_SUCCESS &&
+	$response->code() != GENIRESPONSE_SEARCHFAILED) {
+	if ($response->output()) {
+	    print STDERR $response->output() . "\n";
+	    if (defined($webtask)) {
+		$webtask->output($response->output());
+	    }
+	}
+	else {
+	    print STDERR "Operation failed, returned " .
+		$response->code() . "\n";
+	    if (defined($webtask)) {
+		$webtask->output("Operation failed");
+	    }
+	}
+	if (defined($webtask)) {
+	    $webtask->Exited($response->code());
+	}
+	exit($response->code());
+    }
+    if (defined($webtask)) {
+	$webtask->Exited(0);
+    }
+    exit(0);
+}
+
+sub fatal($)
+{
+    my ($mesg) = @_;
+
+    if (defined($webtask)) {
+	$webtask->output($mesg);
+	$webtask->Exited(-1);
+    }
+    print STDERR "$mesg\n";
+    # Exit with negative status so web interface treats it as system error.
+    exit(-1);
+}
+
+sub escapeshellarg($)
+{
+    my ($str) = @_;
+
+    $str =~ s/[^[:alnum:]]/\\$&/g;
+    return $str;
+}
+

apt/manage_profile.in

@@ -30,6 +30,7 @@ use Data::Dumper;
 use CGI;
 use POSIX ":sys_wait_h";
 use POSIX qw(setsid);
+use Carp qw(cluck);
 
 #
 # Back-end script to manage APT profiles.
@@ -39,7 +40,9 @@ sub usage()
     print("Usage: manage_profile create [-s uuid | -c uuid] <xmlfile>\n");
     print("Usage: manage_profile update <profile> <xmlfile>\n");
     print("Usage: manage_profile publish <profile>\n");
-    print("Usage: manage_profile delete <profile> [all]\n");
+    print("Usage: manage_profile delete -a <profile>\n");
+    print("Usage: manage_profile undelete pid,name:version\n");
+    print("Usage: manage_profile listimages <profile>\n");
     exit(-1);
 }
 my $optlist     = "ds:t:c:m";
@@ -69,6 +72,7 @@ my $TBOPS           = "@TBOPSEMAIL@";
 my $TBLOGS	    = "@TBLOGSEMAIL@";
 my $MANAGEINSTANCE  = "$TB/bin/manage_instance";
 my $MANAGEGITREPO   = "$TB/bin/manage_gitrepo";
+my $MANAGEIMAGES    = "$TB/bin/manage_images";
 my $RUNGENILIB      = "$TB/bin/rungenilib";
 
 #
@@ -95,6 +99,7 @@ use User;
 use Project;
 use APT_Profile;
 use APT_Instance;
+use APT_Aggregate;
 use GeniXML;
 use GeniHRN;
 use WebTask;
@@ -103,9 +108,12 @@ use EmulabFeatures;
 # Protos
 sub fatal($);
 sub UserError(;$);
-sub DeleteProfile($);
-sub CanDelete($);
+sub DeleteProfile();
+sub UnDeleteProfile($);
+sub CanDelete($$);
 sub PublishProfile($);
+sub InsertImageRecords($);
+sub ListImages();
 
 # Parse args below.