deprecate_image.in 3.98 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
# 
# {{{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 File::Basename;
use Data::Dumper;

#
# Delete an image (descriptor) 
#
sub usage()
{
35 36
    print("Usage: deprecate_image [-n] [-e|-w] [-a] <image>".
	  " [warning message to users]\n".
37
	  "Options:\n".
38
	  "       -a     Deprecate all versions of the image.\n".
39
	  "       -e     Use of image is an error; default is warning\n".
40 41
	  "       -w     Use of image is a warning\n".
	  "       -n     Impotent mode\n");
42 43
    exit(-1);
}
44
my $optlist     = "ewdan";
45
my $debug       = 0;
46 47
my $impotent    = 0;
my $allvers     = 0;
48 49 50 51
my $doerror     = 0;
my $dowarning   = 0;
my $deprecated  = 0;
my $iserror     = 0;
52 53
my @imagelist   = ();
my $usetracker  = 0;
54 55 56 57 58 59
my $message;

#
# Configure variables
#
my $TB             = "@prefix@";
60 61
my $PGENISUPPORT   = @PROTOGENI_SUPPORT@;
my $POSTIMAGEDATA  = "$TB/sbin/protogeni/postimagedata";
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79

#
# 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 User;
use OSImage;
80
use libEmulab;
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95

# Protos
sub fatal($);

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
96 97 98 99 100 101
if (defined($options{"n"})) {
    $impotent = 1;
}
if (defined($options{"a"})) {
    $allvers = 1;
}
102 103 104 105 106 107 108 109 110 111 112
if (defined($options{"e"})) {
    $doerror = 1;
}
if (defined($options{"w"})) {
    $dowarning = 1;
}
usage()
    if (@ARGV < 1 || @ARGV > 2);
usage()
    if ($doerror && $dowarning);

113 114 115 116 117
if ($PGENISUPPORT &&
    GetSiteVar("protogeni/use_imagetracker")) {
    $usetracker = 1;
}

118 119 120 121 122 123 124 125 126 127 128
#
# Map invoking user to object. 
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    fatal("You ($UID) do not exist!");
}
my $image = OSImage->Lookup($ARGV[0]);
if (!defined($image)) {
    fatal("Image does not exist in the DB!");
}
Leigh Stoller's avatar
Leigh Stoller committed
129
if (!$this_user->IsAdmin()) {
130 131 132 133 134 135 136 137 138 139 140 141 142 143
    fatal("Only admins can deprecate an image");
}
if ($image->IsDeprecated(\$deprecated, \$message, \$iserror)) {
    fatal("Could not get current deprecation info for image");
}
if ($doerror) {
    $iserror = 1;
}
elsif ($dowarning) {
    $iserror = 0;
}
if (@ARGV > 1) {
    $message = $ARGV[1];
}
144 145 146 147 148 149 150 151
if ($allvers) {
    if ($image->AllVersions(\@imagelist)) {
	fatal("Could not get list of image (versions)");
    }
}
else {
    @imagelist = ($image);
}
152

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
foreach my $image (@imagelist) {
    my $versname = $image->versname();

    if ($impotent) {
	print "Would deprecate $versname\n";
    }
    else {
	$image->Deprecate($message, $iserror) == 0 or
	    fatal("Could not set deprecation info for image");
    }

    if ($usetracker && $image->ims_reported()) {
	if ($impotent) {
	    print "Would update $versname at the image server\n";
	}
	else {
	    my $imageid  = $image->imageid();
	    print "Updating $versname at the image server ...\n";
	    system("$POSTIMAGEDATA $versname");
	    if ($?) {
		print STDERR "Could not post to the image server\n";
	    }
	}
176 177
    }
}
178 179 180 181 182 183 184 185 186
exit(0);

sub fatal($)
{
    my ($mesg) = @_;

    die("*** $0:\n".
	"    $mesg\n");
}