Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
5fa14dd7
Commit
5fa14dd7
authored
Nov 27, 2013
by
Mike Hibler
Browse files
boss-side program for listing/creating/destroying storage server volumes.
parent
e15074d9
Changes
2
Hide whitespace changes
Inline
Side-by-side
tbsetup/GNUmakefile.in
View file @
5fa14dd7
...
...
@@ -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
...
...
tbsetup/bscontrol.in
0 → 100644
View file @
5fa14dd7
#!/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
);