deletelease.in 6.1 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2013-2014 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 "   -w time  Try for up to time seconds to lock lease (0 means forever)\n";
40 41 42
    print STDERR "   lname    Name of lease in <pid>/<id> form\n";
    exit(-1);
}
43
my $optlist  = "dhfFw:b";
44
my $debug = 0;
45
my $force = 0;
46 47
my $background = 0;
my $logname;
48
my $pid;
49
my $gid;
50
my $lname;
51
my $lease;
52
my $waittime;
53 54 55 56 57 58 59 60

# Protos
sub fatal($);

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

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

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

$lname = $ARGV[0];
if ($lname =~ /^([-\w]+)\/([-\w]+)$/) {
120
    $pid   = $gid = $1;
121
    $lname = $2;
122 123 124 125 126 127 128
}
elsif ($lname =~ /^([-\w]+)\/([-\w]+)\/([-\w]+)$/) {
    $pid   = $1;
    $gid   = $2;
    $lname = $3;
}
else {
129 130 131 132 133 134 135 136 137 138 139 140
    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.
#
141 142 143 144 145
$lease = Lease->Lookup($pid, $gid, $lname);
if (!defined($lease)) {
    fatal("No such lease $pid/$lname.");
}
if (!$lease->AccessCheck($this_user, LEASE_ACCESS_DESTROY())) {
146 147 148
    fatal("Cannot access lease $pid/$lname.");
}

149 150 151 152
#
# Lock the lease and handle cleanup.
#
my $ostate = $lease->state();
153 154 155 156 157
if (!defined($waittime)) {
    fatal("$pid/$lname: could not acquire lock, try again with -w")
	if ($lease->Lock());
} else {
    my $rv = $lease->WaitLock($waittime, 1);
158

159 160 161 162
    # someone else deleted it, that is okay with us
    if ($rv == LEASE_ERROR_GONE()) {
	print "Someone else deleted '$pid/$lname'.\n";
	exit(0);
163 164
    }

165 166 167 168
    # any other error is fatal (maybe not if $force is set?)
    if ($rv) {
	fatal("$pid/$lname: could not acquire lock after $waittime seconds");
    }
169 170

    #
171 172 173 174
    # 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).
175
    #
176 177 178 179 180 181
    my $nstate = $lease->state();
    if ($ostate ne $nstate) {
	print STDERR
	    "WARNING: lease changed state while waiting for the lock".
	    " ($ostate => $nstate).\n";
	$ostate = $nstate;
182
    }
183
}
184

185 186
# if the lease is in use, disallow unless forced
if ($lease->InUse()) {
187
    my $expts = int(@{$lease->GetReservations()});
188
    if ($force < 2) {
189 190 191 192 193 194 195 196
	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")) {
197 198 199 200 201 202 203 204 205 206 207 208 209
    # 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";
210
    }
211 212
}

213 214 215 216 217 218 219 220 221 222
if ($background) {
    print "Resource deallocation proceeding the background ...\n";
	
    $logname = TBMakeLogname("deletelease");
    if (my $childpid = TBBackGround($logname)) {
	exit(0);
    }
    # Let parent exit;
    sleep(2);
}
223 224 225
# Dealloc will put the lease back into the unapproved state
if ($lease->DeallocResources()) {
    $lease->UpdateState(LEASE_STATE_LOCKED());
226 227 228 229 230 231

    #
    # Need to notify on error, if ran in the background.
    #
    if ($background) {
	SENDMAIL($TBOPS, "Lease deallocation failed!",
232 233 234
	 "Background resource deallocation for Lease '$pid/$gid/$lname' ".
	 "failed!\n\n",
	 $TBOPS, undef, $logname);
235
    }
236
    fatal("$pid/$lname: could not deallocate resources, left in 'locked' state.");
237 238
}

239
if ($lease->Delete()) {
240
    fatal("$pid/$lname: could not destroy lease.");
241 242
}

243
print "Deleted lease '$pid/$lname'.\n";
244 245 246 247 248 249
exit(0);

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

250 251
    $lease->Unlock()
	if (defined($lease) && $lease->GotLock());
252 253 254
    die("*** $0:\n".
	"    $mesg\n");
}