Commit 5fa14dd7 authored by Mike Hibler's avatar Mike Hibler
Browse files

boss-side program for listing/creating/destroying storage server volumes.

parent e15074d9
......@@ -64,7 +64,7 @@ SBIN_STUFF = resetvlans console_setup.proxy sched_reload named_setup \
nfstrace plabinelab smbpasswd_setup smbpasswd_setup.proxy \
rmproj snmpit.proxynew snmpit.proxyv2 pool_daemon \
checknodes_daemon snmpit.proxyv3 image_setup tcpp \
arplockdown
arplockdown bscontrol
ifeq ($(ISMAINSITE),1)
SBIN_STUFF += repos_daemon
......@@ -121,7 +121,8 @@ SETUID_BIN_SCRIPTS = node_reboot eventsys_control tarfiles_setup savelogs \
SETUID_SBIN_SCRIPTS = mkproj rmgroup mkgroup frisbeehelper \
rmuser idleswap named_setup exports_setup \
sfskey_update setgroups newnode_reboot vnode_setup \
elabinelab nfstrace rmproj arplockdown
elabinelab nfstrace rmproj arplockdown \
bscontrol
SETUID_LIBX_SCRIPTS = console_setup spewrpmtar_verify
SETUID_SUEXEC_SCRIPTS= spewlogfile
......
#!/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;
#
# Block storage server control utility.
#
# Contacts one or all available block storage servers to perform actions.
# Commands:
#
# bscontrol list
# List all configured blockstore servers.
#
# bscontrol [ -S server [ -P pool ] ] avail
# For the named servers (or all if none specified), print out
# how much storage is available.
#
# bscontrol [ -S server [ -P pool ] ] info
# Return detailed info the listed block servers (or all) including the
# name of all existant blockstores and their sizes, attributes, etc.
#
# The following commands are for persistent blockstores.
# For these, a blockstore name, "bsname", had better be unique.
#
# bscontrol [ -S server [ -P pool ] ] [-l leaseidx] -s size -t type create bsname
# Create a blockstore of the given size with the given name.
# If the server is not specified, we pick the "best" server,
# based on availability of space.
#
# bscontrol destroy [ -S server -P pool ] bsname
# Destroy the named blockstore freeing up the space.
# Here bsname needs to be unique across all servers
# or the server and pool need to be explicitly specified.
#
# bscontrol [ -S server [ -P pool ] ] copy from-bsname to-bsname
# Do an efficient copy of one blockstore to another. Use the
# server/pool arguments to force a specific placement of to-bsname.
#
sub usage()
{
print STDERR "Usage: bscontrol command args\n";
print STDERR " -h This message\n";
print STDERR " -d Print additional debug info\n";
exit(-1);
}
my $optlist = "hds:t:l:S:P:F";
my $debug = 0;
my $server;
my $pool;
my $size;
my $type = "stdataset";
my $leaseidx = 0;
my $fakeit = 0;
# Protos
sub fatal($);
sub bs_list($$$@);
sub bs_avail($$$@);
sub bs_info($$$@);
sub bs_create($$$@);
sub bs_destory($$$@);
#
# Configure variables
#
my $TB = "@prefix@";
#my $PROXYCMD = "/usr/testbed/sbin/bscontrol.proxy";
my $PROXYCMD = "perl -T /tmp/bscontrol.proxy.pl";
my $SSH = "ssh -n -o ConnectTimeout=2 -o Protocol=2 -o BatchMode=yes -o StrictHostKeyChecking=no";
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use emutil;
use Lease;
use Blockstore;
use Experiment;
use User;
use Project;
#
# Turn off line buffering on output
#
$| = 1;
#
# Untaint the path
#
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:";
#
# We don't want to run this script unless its the real version.
# That is, it must be setuid root.
#
if ($EUID != 0) {
die("*** $0:\n".
" Must be root! Maybe its a development version?\n");
}
# Must be admin to do this.
if (!TBAdmin()) {
fatal("Must be admin\n");
}
# Commands
my %cmds = (
"list" => \&bs_list,
"avail" => \&bs_avail,
"info" => \&bs_info,
"create" => \&bs_create,
"destroy" => \&bs_destroy,
);
#
# 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 = 1;
}
if (defined($options{S})) {
if ($options{S} =~ /^([-\w]+)$/) {
$server = $1;
}
}
if (defined($options{P})) {
$pool = $options{P};
if ($options{P} =~ /^([-\w]+)$/) {
$pool = $1;
}
}
if (defined($options{s})) {
$size = $options{s};
}
if (defined($options{t})) {
$type = $options{t};
}
if (defined($options{l})) {
$leaseidx = $options{l};
}
if (defined($options{F})) {
$fakeit = 1;
}
if (@ARGV < 1) {
usage();
}
my $cmd = shift;
if (!exists($cmds{$cmd})) {
print STDERR "Unrecognized command '$cmd', should be one of:\n";
print STDERR " ", join(", ", keys %cmds), "\n";
usage();
}
$fakeit = 1
if (-e "$TB/etc/bs-servers.txt");
if ($fakeit) {
print STDERR "WARNING: bscontrol operating in fake mode!\n";
}
exit(&{$cmds{$cmd}}($server, $pool, $size, @ARGV));
#
# Look in the database to find the storage servers
#
sub bsservers()
{
my @bs = ();
if ($fakeit) {
if (-e "$TB/etc/bs-servers.txt") {
foreach my $bs (`cat $TB/etc/bs-servers.txt`) {
# keep taint happy
if ($bs =~ /^([-\w]+)$/) {
push @bs, $1;
}
}
}
return @bs;
}
my $result =
DBQueryFatal("SELECT node_id FROM reserved WHERE erole='storagehost'".
" order by node_id");
while (my ($node) = $result->fetchrow_array) {
push @bs, $node;
}
return @bs;
}
sub fake_change($$$)
{
my ($file,$pool,$used) = @_;
my $line = `grep 'pool=$pool ' $file`;
if ($? == 0 && $line =~ /size=(\d+) avail=(\d+)/) {
my $size = $1;
my $oavail = $2;
my $navail = $oavail - $used;
if (system("sed -i '' -e 's/pool=$pool size=$size avail=$oavail/pool=$pool size=$size avail=$navail/' $file") == 0) {
return 1;
}
}
return 0;
}
sub fake_cmd($$$)
{
my ($host, $cmdstr, $outref) = @_;
my @output = ();
my ($fcmd,$fargs);
if ($cmdstr =~ /^$PROXYCMD\s+(\S+)(?:\s+(.*))?$/) {
$fcmd = $1;
$fargs = $2;
} else {
push @output, "Unrecognized command string '$cmdstr'";
$$outref = \@output;
return -1;
}
if ($fcmd =~ /^(volumes|pools)$/) {
if (-e "$TB/etc/bs-$fcmd-$host.txt") {
@output = `cat $TB/etc/bs-$fcmd-$host.txt`;
chomp @output;
}
$$outref = \@output;
return 0;
} elsif ($fcmd eq "create") {
# in format: create pool volume size
# out format: volume=lease-2 pool=rz-1 size=95
if ($fargs =~ /^(\S+)\s+(\S+)\s+(\S+)/) {
my $pool = $1;
my $vol = $2;
my $size = $3;
my $vfile = "$TB/etc/bs-volumes-$host.txt";
my $pfile = "$TB/etc/bs-pools-$host.txt";
system("cp -f $vfile $vfile.new");
system("cp -f $pfile $pfile.new");
system("echo 'volume=$vol pool=$pool size=$size' >> $vfile.new");
if (fake_change("$pfile.new", $pool, $size) &&
rename($pfile, "$pfile.old") &&
rename("$pfile.new", $pfile) &&
rename($vfile, "$vfile.old") &&
rename("$vfile.new", $vfile)) {
$$outref = \@output;
return 0;
}
}
push @output, "create $fargs failed!";
$$outref = \@output;
return -1;
} elsif ($fcmd eq "destroy") {
# in format: destroy pool volume
if ($fargs =~ /^(\S+)\s+(\S+)/) {
my $pool = $1;
my $volume = $2;
my $size;
my $vfile = "$TB/etc/bs-volumes-$host.txt";
my $pfile = "$TB/etc/bs-pools-$host.txt";
system("cp -f $vfile $vfile.new");
system("cp -f $pfile $pfile.new");
my $line = `grep 'volume=$volume pool=$pool' $vfile`;
if ($line =~ /size=(\d+)/) {
$size = $1;
if (fake_change("$pfile.new", $pool, -$size) &&
system("sed -i '' -e '/volume=$volume pool=$pool /d' $vfile.new") == 0 &&
rename($pfile, "$pfile.old") &&
rename("$pfile.new", $pfile) &&
rename($vfile, "$vfile.old") &&
rename("$vfile.new", $vfile)) {
$$outref = \@output;
return 0;
}
}
}
push @output, "destroy $fargs failed!";
$$outref = \@output;
return -1;
} else {
push @output, "Cannot fake '$fcmd' right now";
$$outref = \@output;
return -1;
}
}
#
# Execute a command on a remote blockstore server and return the output.
#
sub bsserver_cmd($$$)
{
my ($host, $cmdstr, $outref) = @_;
my @output = ();
my $stat = 0;
if ($fakeit) {
print STDERR "Faking '$SSH $host $cmdstr'\n"
if ($debug);
return fake_cmd($host, $cmdstr, $outref);
}
print STDERR "Doing '$SSH $host $cmdstr'\n"
if ($debug);
my $SAVEUID = $UID;
$UID = 0;
@output = `$SSH $host $cmdstr 2>&1`;
$UID = $SAVEUID;
if ($?) {
$stat = $? >> 8;
print STDERR "*** WARNING: ssh to $host failed ($stat)!\n";
}
print STDERR "Got output:\n", @output
if ($debug > 1);
chomp(@output);
$$outref = \@output;
return $stat;
}
sub parseattrs($)
{
my ($line) = @_;
my %attrs = ();
foreach my $pair (split(/\s+/, $line)) {
if ($pair =~ /^(\S+)=(\S+)$/) {
$attrs{$1} = $2;
}
}
return \%attrs;
}
#
# Augment volume attributes with Emulab blockstore attributes gleaned
# from the volume attributes.
#
sub get_bsattrs($)
{
my ($attrs) = @_;
#
# iname info implies that the volume is exported via iSCSI
# Parse out good stuff like the iqn, pid, eid, and vname.
# Get even more good stuff from the experiment.
#
my $iname = $attrs->{'iname'};
if ($iname) {
my ($iqn,$pid,$eid,$vname) = split(':', $iname);
$attrs->{'iqn'} = $iqn;
$attrs->{'pid'} = $pid;
$attrs->{'eid'} = $eid;
$attrs->{'vname'} = $vname;
$attrs->{'uname'} = "$pid/$eid/$vname";
if (defined($pid) && defined($eid)) {
my $expt;
if (!($expt = Experiment->Lookup("$pid/$eid"))) {
print STDERR "WARNING: no experiment info associated with $pid/$eid\n";
$attrs->{'swapper'} = $attrs->{'owner'} = "??";
} else {
$attrs->{'swapper'} = $expt->swapper();
$attrs->{'owner'} = $expt->creator();
}
}
$attrs->{'active'} = 1;
} else {
$attrs->{'active'} = 0;
}
#
# If the volume name is of the form 'lease-<id>' then this
# is a persistent dataset. Extract more info from the lease.
# Note that attributes from the lease override those from a
# swapped in experiment using the lease (e.g., owner and uname).
#
my $volume = $attrs->{'volume'};
if ($volume =~ /^lease-(\d+)$/) {
my $lidx = $1;
$attrs->{'lidx'} = $lidx;
my $lease = Lease->Lookup($lidx);
if (!$lease) {
print STDERR "WARNING: no lease info associated with persistent lease $lidx\n";
$attrs->{'lid'} = $attrs->{'owner'} = $attrs->{'lpid'} =
$attrs->{'type'} = $attrs->{'expiration'} = "??";
$attrs->{'uname'} = $volume;
} else {
$attrs->{'lid'} = $lease->lease_id();
$attrs->{'owner'} = $lease->owner();
$attrs->{'lpid'} = $lease->pid();
$attrs->{'type'} = $lease->type();
$attrs->{'expiration'} = $lease->expiration();
$attrs->{'uname'} = $attrs->{'lpid'} . "/" . $attrs->{'lid'};
}
$attrs->{'persist'} = 1;
} else {
$attrs->{'type'} = "volatile";
$attrs->{'persist'} = 0;
}
return $attrs;
}
sub getpools($$)
{
my ($dsrv,$dpool) = @_;
my %pools = ();
foreach my $srv (bsservers()) {
next
if (defined($dsrv) && $dsrv ne $srv);
my $outref;
if (bsserver_cmd($srv, "$PROXYCMD pools", \$outref) == 0) {
foreach my $pstr (@$outref) {
my $attrs = parseattrs($pstr);
my $pool = $attrs->{'pool'};
if (!defined($dpool) || $dpool eq $pool) {
$attrs->{'server'} = $srv;
$pools{"$srv/$pool"} = $attrs;
}
}
} else {
print STDERR "*** could not get pools from $srv, error:\n";
foreach my $str (@$outref) {
print STDERR " $str\n";
}
}
}
return \%pools;
}
sub getvolumes($$)
{
my ($dsrv,$dpool) = @_;
my %volumes = ();
foreach my $srv (bsservers()) {
next
if (defined($dsrv) && $dsrv ne $srv);
my $outref;
if (bsserver_cmd($srv, "$PROXYCMD volumes", \$outref) == 0) {
foreach my $vstr (@$outref) {
my $attrs = parseattrs($vstr);
my $pool = $attrs->{'pool'};
if (!defined($dpool) || $dpool eq $pool) {
$attrs->{'server'} = $srv;
my $vol = $attrs->{'volume'};
$volumes{"$srv/$pool/$vol"} = $attrs;
}
}
} else {
print STDERR "*** could not get volumes from $srv, error:\n";
foreach my $str (@$outref) {
print STDERR " $str\n";
}
}
}
return \%volumes;
}
sub getblockstores($$)
{
my ($dsrv,$dpool) = @_;
my %bstores = ();
foreach my $srv (bsservers()) {
next
if (defined($dsrv) && $dsrv ne $srv);
my $outref;
if (bsserver_cmd($srv, "$PROXYCMD volumes", \$outref) == 0) {
foreach my $vstr (@$outref) {
my $attrs = get_bsattrs(parseattrs($vstr));
if (!defined($dpool) || $dpool eq $attrs->{'pool'}) {
$attrs->{'server'} = $srv;
$bstores{$attrs->{'uname'}} = $attrs;
}
}
} else {
print STDERR "*** could not get blockstores from $srv, error:\n";
foreach my $str (@$outref) {
print STDERR " $str\n";
}
}
}
return \%bstores;
}
sub bs_list($$$@)
{
foreach my $srv (bsservers()) {
print "$srv\n";
}
}
sub bs_avail($$$@)
{
my ($dsrv,$dpool,undef) = @_;
my $poolref = getpools($dsrv, $dpool);
if (keys(%{$poolref}) > 0) {
printf("%-12s %-12s %10s %10s %-5s\n",
"Server", "Pool", "Size", "Avail", "Free %");
foreach my $pstr (sort keys(%{$poolref})) {
my $attrs = $poolref->{$pstr};
my $size = ($attrs->{'size'} ? $attrs->{'size'} : 1);
my $pct = $attrs->{'avail'} / $size * 100;
printf("%-12s %-12s %10s %10s %5.1f\n",
$attrs->{'server'}, $attrs->{'pool'},
$size, $attrs->{'avail'}, $pct);
}
}
return 0;
}
sub bs_info($$$@)
{
my ($dsrv,$dpool,undef) = @_;
my $bsref = getblockstores($dsrv, $dpool);
if (keys(%{$bsref}) > 0) {
printf("%-32s %-24s %-10s %10s %-s\n",
"Unique ID", "Server/Pool/Volume", "Type", "Size", "Exported as");
foreach my $bs (sort keys(%{$bsref})) {
my $attrs = $bsref->{$bs};
printf("%-32s %-24s %-10s %10s %s\n", $bs,
$attrs->{'server'} . "/" . $attrs->{'pool'} . "/" . $attrs->{'volume'},
$attrs->{'type'}, $attrs->{'size'},
($attrs->{'active'} ? $attrs->{'iname'} : ""));
}
}
return 0;
}
sub bs_create($$$@)
{
my ($srv,$pool,$size,$name) = @_;
if (!defined($size)) {
fatal("create: must specify a size in MiB (-s)");
}
if (!defined($name) || $name !~ /^[-\w]+$/) {
fatal("create: must specify a valid name");
}
if ($leaseidx !~ /^\d+$/) {
fatal("create: lease index must be an integer");
}
if ($type !~ /^(st|lt)dataset$/) {
fatal("create: type must be either 'stdataset' or 'ltdataset'");
}
# get all qualified pools
my $poolref = getpools($srv, $pool);