deletelease.in 6.69 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2013-2017 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
# 
# {{{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 strict;
use English;
use Getopt::Std;
use Date::Parse;

#
# Delete a lease.
#
sub usage()
{
34
    print STDERR "Usage: deletelease [-fFhd] lname\n";
35 36
    print STDERR "   -h       This message\n";
    print STDERR "   -d       Print additional debug info\n";
37
    print STDERR "   -f       Force destruction even if lease is not in the correct state\n";
38
    print STDERR "   -F       Force destruction even if lease is in use (admin only)\n";
39
    print STDERR "   -G       Force destruction even if lease is Geni created (admin only)\n";
40
    print STDERR "   -w time  Try for up to time seconds to lock lease (0 means forever)\n";
41 42 43
    print STDERR "   lname    Name of lease in <pid>/<id> form\n";
    exit(-1);
}
44
my $optlist  = "dhfFw:bG";
45
my $debug = 0;
46
my $force = 0;
47
my $background = 0;
48
my $geniforce = 0;
49
my $logname;
50
my $pid;
51
my $gid;
52
my $lname;
53
my $lease;
54
my $waittime;
55 56 57 58 59 60 61 62

# Protos
sub fatal($);

#
# Configure variables
#
my $TB		 = "@prefix@";
63
my $TBOPS        = "@TBOPSEMAIL@";
64 65 66 67 68

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
69
use libtestbed;
70 71 72
use libdb;
use Lease;
use Project;
73
use Group;
74
use User;
75
use APT_Dataset;
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98

#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:";

#
# 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{h})) {
    usage();
}
if (defined($options{d})) {
99 100
    $debug = 1;
}
101 102 103
if (defined($options{b})) {
    $background = 1;
}
104 105
if (defined($options{f})) {
    $force = 1;
106
}
107 108 109
if (defined($options{F})) {
    $force = 2;
}
110 111 112
if (defined($options{G})) {
    $geniforce = 2;
}
113 114 115 116 117 118
if (defined($options{w})) {
    $waittime = $options{w};
    if ($waittime !~ /^\d+$/) {
	fatal("Wait time must be >= 0.");
    }
}
119 120 121 122 123 124 125
if (@ARGV != 1) {
    print STDERR "Must specify exactly one lname\n";
    usage();
}

$lname = $ARGV[0];
if ($lname =~ /^([-\w]+)\/([-\w]+)$/) {
126
    $pid   = $gid = $1;
127
    $lname = $2;
128 129 130 131 132 133 134
}
elsif ($lname =~ /^([-\w]+)\/([-\w]+)\/([-\w]+)$/) {
    $pid   = $1;
    $gid   = $2;
    $lname = $3;
}
else {
135 136 137 138 139 140 141 142 143 144 145 146
    fatal("Lease name $lname not in the form <pid>/<lname>.");
}

my $this_user = User->ThisUser();
if (! defined($this_user)) {
    fatal("You ($UID) do not exist!");
}

#
# Check lease: project must exist, lease must exist,
# caller must have privilege to destroy.
#
147 148 149 150
$lease = Lease->Lookup($pid, $gid, $lname);
if (!defined($lease)) {
    fatal("No such lease $pid/$lname.");
}
151 152 153 154 155 156 157
#
# Do not allow leases created via the Portal interface to be deleted
# via the command line. This confuses things. 
#
if (!$geniforce && APT_Dataset->LookupByRemoteUUID($lease->uuid())) {
    fatal("Not allowed to delete portal created dataset via this interface");
}
158
if (!$lease->AccessCheck($this_user, LEASE_ACCESS_DESTROY())) {
159 160 161
    fatal("Cannot access lease $pid/$lname.");
}

162 163 164 165
#
# Lock the lease and handle cleanup.
#
my $ostate = $lease->state();
166 167 168 169 170
if (!defined($waittime)) {
    fatal("$pid/$lname: could not acquire lock, try again with -w")
	if ($lease->Lock());
} else {
    my $rv = $lease->WaitLock($waittime, 1);
171

172 173 174 175
    # someone else deleted it, that is okay with us
    if ($rv == LEASE_ERROR_GONE()) {
	print "Someone else deleted '$pid/$lname'.\n";
	exit(0);
176 177
    }

178 179 180 181
    # any other error is fatal (maybe not if $force is set?)
    if ($rv) {
	fatal("$pid/$lname: could not acquire lock after $waittime seconds");
    }
182 183

    #
184 185 186 187
    # Warn about state changes while waiting for the lock.
    # Note that ValidTransition will ensure we don't do anything
    # really stupid in this case (e.g., lease was un-expired at the
    # last second).
188
    #
189 190 191 192 193 194
    my $nstate = $lease->state();
    if ($ostate ne $nstate) {
	print STDERR
	    "WARNING: lease changed state while waiting for the lock".
	    " ($ostate => $nstate).\n";
	$ostate = $nstate;
195
    }
196
}
197

198 199
# if the lease is in use, disallow unless forced
if ($lease->InUse()) {
200
    my $expts = int(@{$lease->GetReservations()});
201
    if ($force < 2) {
202 203 204 205 206 207 208 209
	fatal("$pid/$lname is in use by $expts experiment(s) right now");
    }
    print STDERR "$pid/$lname is in use by $expts experiment(s) right now,".
	" continuing anyway\n";
}

# make sure we can destroy a lease from the current state.
if (!$lease->ValidTransition("DEAD")) {
210 211 212 213 214 215 216 217 218 219 220 221 222
    # XXX special case: if the lease is valid but has never been used, allow
    if ($lease->state() eq LEASE_STATE_VALID() &&
	(!defined($lease->last_used()) || $lease->last_used() == 0 ||
	 $lease->last_used() == $lease->inception())) {
	print STDERR "$pid/$lname: lease is VALID but never used, ".
	    "allowing destroy.\n";
    } else {
	if (!$force) {
	    fatal("$pid/$lname: cannot destroy lease from state '$ostate'.");
	}
	print STDERR
	    "$pid/$lname: should not destroy lease from state '$ostate', ".
	    "continuing anyway.\n";
223
    }
224 225
}

226 227 228 229 230 231 232 233 234 235
if ($background) {
    print "Resource deallocation proceeding the background ...\n";
	
    $logname = TBMakeLogname("deletelease");
    if (my $childpid = TBBackGround($logname)) {
	exit(0);
    }
    # Let parent exit;
    sleep(2);
}
236 237 238
# Dealloc will put the lease back into the unapproved state
if ($lease->DeallocResources()) {
    $lease->UpdateState(LEASE_STATE_LOCKED());
239 240 241 242 243 244

    #
    # Need to notify on error, if ran in the background.
    #
    if ($background) {
	SENDMAIL($TBOPS, "Lease deallocation failed!",
245 246 247
	 "Background resource deallocation for Lease '$pid/$gid/$lname' ".
	 "failed!\n\n",
	 $TBOPS, undef, $logname);
248
	unlink($logname);
249
    }
250
    fatal("$pid/$lname: could not deallocate resources, left in 'locked' state.");
251
}
252 253 254
if ($background) {
    unlink($logname);
}
255

256
if ($lease->Delete()) {
257
    fatal("$pid/$lname: could not destroy lease.");
258 259
}

260
unlink($logname) if (defined($logname));
261
print "Deleted lease '$pid/$lname'.\n";
262 263 264 265 266 267
exit(0);

sub fatal($)
{
    my ($mesg) = $_[0];

268 269
    unlink($logname)
	if (defined($logname));
270 271
    $lease->Unlock()
	if (defined($lease) && $lease->GotLock());
272 273 274
    die("*** $0:\n".
	"    $mesg\n");
}