Commit 3ad57241 authored by Mike Hibler's avatar Mike Hibler

New basic utilities for create/delete/modify/show of leases.

parent 6b8a74cd
......@@ -34,7 +34,8 @@ SUBDIRS = nsgen
BIN_SCRIPTS = delay_config sshtb create_image node_admin link_config \
setdest loghole webcopy linkmon_ctl snmp-if-deref.sh \
template_record spewevents \
wbts_dump mkblob rmblob
wbts_dump mkblob rmblob \
showlease createlease deletelease modlease
SBIN_SCRIPTS = vlandiff vlansync withadminprivs export_tables cvsupd.pl \
eventping grantnodetype import_commitlog daemon_wrapper \
opsreboot deletenode node_statewait grabwebcams \
......
#!/usr/bin/perl -w
#
# Copyright (c) 2013 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 strict;
use English;
use Getopt::Std;
use Date::Parse;
#
# Create a lease.
#
sub usage()
{
print STDERR "Usage: createlease [-hd] [-o uid] [-a attrs] -t type -e expiration name\n";
print STDERR " -h This message\n";
print STDERR " -d Print additional debug info\n";
print STDERR " -t type Type of lease (stdataset or ltdataset)\n";
print STDERR " -o uid Owner of lease (defaults to caller)\n";
print STDERR " -e date Expiration date for lease\n";
print STDERR " -a attrs comma-seperated string of key=value attributes\n";
print STDERR " name Name of lease (of form <pid>/<id>)\n";
exit(-1);
}
my $optlist = "dho:t:e:a:";
my $debug = 0;
my $pid;
my $uid;
my $expire;
my $ltype;
my $lname;
my $attrstr;
my %attrs = ();
# Valid lease types
my %ltypes = (
"stdataset" => "Short-term dataset",
"ltdataset" => "Long-term dataset"
);
# Protos
sub fatal($);
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use Lease;
use Project;
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})) {
$debug++;
}
if (defined($options{o})) {
$uid = $options{o};
}
if (defined($options{t})) {
$ltype = $options{t};
}
if (defined($options{e})) {
$expire = str2time($options{e});
if (!$expire) {
fatal("Could not parse expiration date.");
}
}
if (defined($options{a})) {
$attrstr = $options{a};
}
if (!$ltype || !$expire || @ARGV != 1) {
print STDERR "Must specify type, expiration date, and lease name\n";
usage();
}
# lease name must include a project
$lname = $ARGV[0];
if ($lname =~ /^([-\w]+)\/([-\w]+)$/) {
$pid = $1;
$lname = $2;
} else {
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 owner: caller must be admin or be the specified user.
#
my $user;
if ($uid) {
$user = User->Lookup($uid);
if (TBAdmin()) {
if (!defined($user)) {
fatal("No such user $uid\n");
}
} else {
if (!$user || !$user->SameUser($this_user)) {
fatal("Must be admin to act on behalf of uid $uid");
}
}
} else {
$user = $this_user;
$uid = $this_user->uid();
}
#
# Check project: user must be admin or have access to the project.
#
my $project = Project->Lookup($pid);
if (!defined($project)) {
fatal("No such project $pid\n");
}
if (!TBAdmin() &&
!$project->AccessCheck($this_user, PROJMEMBERTRUST_ROOT())) {
fatal("Must have local_root privileges in pid $pid");
}
#
# Check type: currently only two defined.
#
if (!exists($ltypes{$ltype})) {
print STDERR "Invalid lease type $ltype, should be one of:\n";
foreach my $l (keys %ltypes) {
print STDERR "'$l': ", $ltypes{$l}, "\n";
}
exit(1);
}
#
# Check expiration: must be in the future.
#
if ($expire < time()) {
fatal("Expiration date is in the past!");
}
#
# Check attributes: right now, must just be a well-formed string.
#
foreach my $kv (split(',', $attrstr)) {
if ($kv =~ /^([-\w]+)=([-\w\.\+\/:]+)$/) {
$attrs{$1} = $2;
} else {
fatal("Malformed attribute string '$attrstr'.");
}
}
#
# Check name: must not already exist.
#
if (Lease->Lookup($pid, $lname)) {
fatal("Lease $pid/$lname already exists.");
}
my $args = {
"lease_id" => $lname,
"pid" => $project,
"uid" => $user,
"type" => $ltype,
"lease_end" => $expire,
"state" => "unapproved"
};
if (!Lease->Create($args, \%attrs)) {
fatal("Could not create lease $lname in $pid.");
}
exit(0);
sub fatal($)
{
my ($mesg) = $_[0];
die("*** $0:\n".
" $mesg\n");
}
#!/usr/bin/perl -w
#
# Copyright (c) 2013 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 strict;
use English;
use Getopt::Std;
use Date::Parse;
#
# Delete a lease.
#
sub usage()
{
print STDERR "Usage: deletelease [-hd] lname\n";
print STDERR " -h This message\n";
print STDERR " -d Print additional debug info\n";
print STDERR " lname Name of lease in <pid>/<id> form\n";
exit(-1);
}
my $optlist = "dh";
my $debug = 0;
my $pid;
my $lname;
# Protos
sub fatal($);
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use Lease;
use Project;
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})) {
$debug++;
}
if (@ARGV != 1) {
print STDERR "Must specify exactly one lname\n";
usage();
}
$lname = $ARGV[0];
if ($lname =~ /^([-\w]+)\/([-\w]+)$/) {
$pid = $1;
$lname = $2;
} else {
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.
#
my $lease;
if (!Project->Lookup($pid) || !($lease = Lease->Lookup($pid, $lname)) ||
!$lease->AccessCheck($this_user, LEASE_ACCESS_DESTROY())) {
fatal("Cannot access lease $pid/$lname.");
}
if ($lease->Delete()) {
fatal("Could not destroy lease $pid/$lname.");
}
exit(0);
sub fatal($)
{
my ($mesg) = $_[0];
die("*** $0:\n".
" $mesg\n");
}
#!/usr/bin/perl -w
#
# Copyright (c) 2013 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 strict;
use English;
use Getopt::Std;
use Date::Parse;
#
# Modify a lease.
# You can update the expiration or "last used" dates, change the state,
# or add/remove/modify the set of attributes.
#
sub usage()
{
print STDERR "Usage: modlease [-hd] [-s state] [-e expire] [-l last-used] [-a key=value] [-d key] name\n";
print STDERR " -h This message\n";
print STDERR " -d Print additional debug info\n";
print STDERR " -s state Update the state\n";
print STDERR " -e date Update the expiration date\n";
print STDERR " -l date Update the last used date ('now' for current time)\n";
print STDERR " -a key=val Add or update attribute 'key' with value 'val'\n";
print STDERR " -r key Remove attribute 'key'\n";
print STDERR " name Name of lease (of form <pid>/<id>)\n";
exit(-1);
}
my $optlist = "dhs:e:l:a:r:";
my $debug = 0;
my $pid;
my $state;
my $expire;
my $lastused;
my $addattr;
my $delattr;
my $lname;
my $now = time();
# Protos
sub fatal($);
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use Lease;
use Project;
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})) {
$debug++;
}
if (defined($options{s})) {
$state = $options{s};
}
if (defined($options{e})) {
if ($options{e} eq "now") {
$expire = $now;
} else {
$expire = str2time($options{e});
if (!$expire) {
fatal("Could not parse expiration date.");
}
}
}
if (defined($options{l})) {
if ($options{l} eq "now") {
$lastused = $now;
} else {
$lastused = str2time($options{l});
if (!defined($lastused)) {
fatal("Could not parse last-used date.");
}
}
}
if (defined($options{a})) {
$addattr = $options{a};
if ($addattr !~ /^([-\w]+)=([-\w\.\+\/:]+)$/) {
fatal("Malformed attribute name/value '$addattr'.");
}
}
if (defined($options{r})) {
$delattr = $options{r};
if ($delattr !~ /^([-\w]+)$/) {
fatal("Malformed attribute name '$delattr'.");
}
}
if (!($state || $expire || defined($lastused) || $addattr || $delattr)) {
print STDERR "Must specify SOME action!\n";
usage();
}
if (@ARGV != 1) {
print STDERR "Must specify exactly one lease.\n";
usage();
}
# lease name must include a project
$lname = $ARGV[0];
if ($lname =~ /^([-\w]+)\/([-\w]+)$/) {
$pid = $1;
$lname = $2;
} else {
fatal("Lease name $lname not in the form <pid>/<lname>.");
}
# XXX right now, must be admin
if (!TBAdmin()) {
fatal("Only admins can modify leases right now.");
}
my $this_user = User->ThisUser();
if (! defined($this_user)) {
fatal("You ($UID) do not exist!");
}
my $project = Project->Lookup($pid);
if (!defined($project)) {
fatal("No such project $pid\n");
}
#
# Check dates: must be appropriately in the past/future.
#
if ($expire && $expire < $now) {
fatal("Cannot set expiration date in the past.");
}
if (defined($lastused) && $lastused > $now) {
fatal("Cannot set last-used date in the future.");
}
#
# Check name: must exist and be modifiable.
#
my $lease = Lease->Lookup($pid, $lname);
if (!$lease) {
fatal("Lease $pid/$lname does not exist.");
}
if (!$lease->AccessCheck($this_user, LEASE_ACCESS_MODIFY())) {
fatal("Cannot modify lease $pid/$lname.");
}
# Handle state
if ($state && $lease->UpdateState($state)) {
fatal("Could not set state of $pid/$lname to '$state'.");
}
# Handle expiration date
if ($expire && $lease->SetEndTime($expire)) {
fatal("Could not update expiration time of $pid/$lname.");
}
# Handle last used date
if (defined($lastused)) {
if (($lastused >= $now && $lease->BumpLastUsed()) ||
($lastused < $now && $lease->SetLastUsedTime($lastused))) {
fatal("Could not update last-used time of $pid/$lname.");
}
}
#
# Handle attributes. Delete, then add (replace).
#
if ($delattr && $lease->DeleteAttribute($delattr)) {
fatal("Could not remove attribute $delattr on lease $pid/$lname.");
}
if ($addattr) {
if ($addattr !~ /^([-\w]+)=([-\w\.\+\/:]+)$/ ||
$lease->SetAttribute($1, $2)) {
fatal("Could not set attribute $addattr on lease $pid/$lname.");
}
}
exit(0);
sub fatal($)
{
my ($mesg) = $_[0];
die("*** $0:\n".
" $mesg\n");
}
#!/usr/bin/perl -w
#
# Copyright (c) 2013 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 strict;
use English;
use Getopt::Std;
use Date::Parse;
use POSIX qw(strftime);
#
# Show all leases the caller has access to.
#
sub usage()
{
print STDERR "Usage: showlease [-hda] [-p pid] [-u uid] lid ...\n";
print STDERR " -h This message\n";
print STDERR " -d Print additional debug info\n";
print STDERR " -a Show all leases (admin only)\n";
print STDERR " -p pid Show all leases for project <pid>\n";
print STDERR " -u uid Show all leases owned by user <uid>\n";
print STDERR " lid ... Show named leases (name is <pid>/<id>)\n";
exit(-1);
}
my $optlist = "dhap:u:";
my $debug = 0;
my $pid;
my $uid;
my $showall;
my @lids = ();
# Protos
sub fatal($);
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use Lease;
use Project;
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})) {
$debug++;
}
if (defined($options{a})) {
$showall = 1;
}
if (defined($options{p})) {
$pid = $options{p};
}
if (defined($options{u})) {
$uid = $options{u};
}
my @lnames = @ARGV;
if ($showall) {
if (!TBAdmin()) {
print STDERR "Only admin can use -a\n";
usage();
}
$pid = $uid = 0;
@lnames = ();
}
if ($pid && $uid) {
print STDERR "Specify only one of -p and -u\n";
usage();
}
if (($pid || $uid) && @lnames > 0) {
print STDERR "Specify only one of -p/-u and explicit list of lids\n";
usage();
}
my $this_user = User->ThisUser();
if (! defined($this_user)) {
fatal("You ($UID) do not exist!");
}
if ($showall) {
@lids = Lease->AllLeases();
}
if ($pid) {
my $project = Project->Lookup($pid);
if (!defined($project)) {
fatal("No such project $pid\n");
}
# must be admin or have access to the project
if (!TBAdmin() &&
!$project->AccessCheck($this_user, PROJMEMBERTRUST_USER())) {
fatal("You do not have access to pid $pid");
}
@lids = Lease->AllProjectLeases($project);
}
if ($uid) {
my $user = User->Lookup($uid);
if (!defined($user)) {
fatal("No such user $uid\n");
}
# must be admin or be the specified user
if (!TBAdmin() && !$user->SameUser($this_user)) {
fatal("You do not have access to uid $uid");
}
@lids = Lease->AllUserLeases($user);
}
# special case: no args, show all leases owned by the caller
elsif (!$showall && @lnames == 0) {
@lids = Lease->AllUserLeases($this_user);
}
foreach my $name (@lnames) {