Commit a7f52ca6 authored by Kirk Webb's avatar Kirk Webb

Checkpoint for mobile networking equipment (UE) support.

parent dc39d6d4
#
# Copyright (c) 2016 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/>.
#
# }}}
#
SRCDIR = @srcdir@
TESTBED_SRCDIR = @top_srcdir@
OBJDIR = ..
SUBDIR = mobile
include $(OBJDIR)/Makeconf
LIB_FILES = libjsonrpc.pm tbadb_rpc.pm
BIN_SCRIPTS = tbadb
REMOTE_SCRIPTS = tbadb_proxy
# These scripts installed setuid, with sudo.
SETUID_BIN_SCRIPTS = tbadb
#
# Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed.
#
all: $(BIN_SCRIPTS) $(LIB_FILES)
include $(TESTBED_SRCDIR)/GNUmakerules
install: \
$(addprefix $(INSTALL_BINDIR)/, $(BIN_SCRIPTS))
$(addprefix $(INSTALL_LIBDIR)/, $(LIB_FILES))
post-install:
chown root $(INSTALL_BINDIR)/tbadb
chmod u+s $(INSTALL_BINDIR)/tbadb
clean:
#!/usr/bin/perl -w
#
# Copyright (c) 2016 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/>.
#
# }}}
#
package libjsonrpc;
use Exporter;
@ISA = "Exporter";
@EXPORT =
qw ( EncodeCall EncodeResult EncodeError
DecodeRPCData SendRPCData RecvRPCData );
# After package decl.
use English;
use JSON;
use Data::Dumper;
# Constants
my $MAXFID = 100;
# Global variables
our $debug = 0;
my $FID = 0;
my %fid2func = ();
my $PDUBUF = '';
my $PDUBUFSIZ = 10_000;
my $SEPSTR = "\r\n\r\n";
my $MINTMO = 1; # No less than 1 second
my $MAXTMO = 300; # No more than 5 minutes
sub _getNextFID($) {
my ($func) = @_;
my $wrapped = 0;
while (1) {
$FID++;
if (!exists($fid2func{$FID})) {
return $FID;
}
if ($FID > $MAXFID) {
if ($wrapped) {
die "FID wrapped and no free FID slot found!\n";
}
warn "libjsonrpc::GetNextFid: Warning: FID wrapped!\n";
$FID = 1;
$wrapped = 1;
}
}
die "libjsonrpc::GetNextFid: Control should never reach here!";
}
sub EncodeCall($;$) {
my ($func, $args) = @_;
if (!$func) {
warn "libjsonrpc::EncodeCall: No function call specified!\n";
return undef;
}
my $fid = _getNextFID($func);
# We don't check or validate the arguments in any way. That will be
# up to the receiving end to do in context. If they can be JSON encoded,
# all is well from this encoding function's perspective. Also, if
# nothing is passed in for $args, it will be passed along here as undefined
# to the json encoder which will in turn convert it to a JSON 'null'.
warn "libjsonrpc::EncodeCall: encoding '$func'\nArgs:\n" . Dumper($args)
if $debug;
my $json_text = eval { to_json({FID => $fid,
FUNCTION => $func,
ARGS => $args}); };
if ($@) {
warn "Error encoding function call to JSON data: $@\n";
return undef;
}
if (!$json_text) {
warn "libjsonrpc::EncodeCall: Nothing returned by to_json!\n";
return undef;
}
$fid2func{$fid} = $func;
return $json_text;
}
sub EncodeResult($$) {
my ($fid, $results) = @_;
if (!$fid) {
warn "TBDB::EncodeResult: A valid function call ID must be given!";
return undef;
}
# We don't check or validate results in any way. That will be
# up to the receiving end to do in context. If they can be JSON encoded,
# all is well from this encoding function's perspective.
my $json_text = to_json({FID => $fid,
RESULT => $results});
if (!$json_text) {
warn "libjsonrpc::EncodeResult: Nothing returned by to_json!\n";
return undef;
}
return $json_text;
}
sub EncodeError($$;$) {
my ($fid, $code, $message) = @_;
if (!$fid || $fid < 1 || !defined($code)) {
warn "libjsonrpc::EncodeError: Must provide valid FID and code id!\n";
return undef;
}
$message ||= "(No Message)";
my $json_text = to_json({FID => $fid,
ERROR => {CODE => $code, MESSAGE => $message}});
if (!$json_text) {
warn "libjsonrpc::EncodeError: Nothing returned by to_json!\n";
return undef;
}
return $json_text;
}
sub DecodeRPCData($) {
my ($json_text) = @_;
if (!$json_text) {
warn "libjsonrpc::DecodeRPCData: No data to decode!\n";
return undef;
}
my $data = eval { from_json($json_text); };
if ($@) {
warn "Error trying to decode JSON data: $@\n";
return undef;
}
if (ref($data) ne "HASH") {
warn "Did not parse out a hash from JSON data!\n";
return undef;
}
if (!exists($data->{FID})) {
warn "No FID (function ID) found in JSON data!\n";
return undef;
}
my $fid = $data->{FID};
if (exists($data->{FUNCTION})) {
warn "libjsonrpc::DecodeRPCData: Function $data->{FUNCTION} called.\n"
if $debug;
}
elsif (exists($data->{RESULT})) {
if (!exists($fid2func{$fid}) && $fid != -1) {
warn "libjsonrpc::DecodeRPCData: Unknown FID in results: $fid\n";
} else {
warn "libjsonrpc::DecodeRPCData: Results returned for FID $fid ($fid2func{$fid})\n"
if $debug;
delete $fid2func{$fid};
}
}
elsif (exists($data->{ERROR})) {
if (!exists($fid2func{$fid})) {
warn "libjsonrpc::DecodeRPCData: Unknown FID in error: $fid\n";
} else {
warn "libjsonrpc::DecodeRPCData: Error returned for FID $fid ($fid2func{$fid})\n"
if $debug;
delete $fid2func{$fid};
}
}
else {
warn "libjsonrpc::DecodeRPCData: Unidentifiable RPC data!\n";
return undef;
}
return $data;
}
sub SendRPCData($$) {
my ($fh, $encdata) = @_;
if (!$fh) {
warn "libjsonrpc::SendRPCData: Must provide valid filehandle!\n";
return 0;
}
if (!$encdata) {
warn "libjsonrpc::SendRPCData: Must provide data to send!\n";
return 0;
}
warn "libjsonrpc::SendRPCData: sending: $encdata\n"
if $debug;
$encdata .= $SEPSTR;
my $res = eval { print $fh $encdata };
if ($@) {
warn "libjsonrpc::SendRPCData: Error while attempting to send data: $@";
return 0;
}
if (!$res) {
warn "libjsonrpc::SendRPCData: Printing to filehandle failed: $!";
return 0;
}
return 1;
}
sub _getPDU() {
my $index = index($PDUBUF, $SEPSTR);
if ($index == -1) {
warn "libjsonrpc::GetPDU: PDU separator not found in buffer.\n"
if $debug;
return undef;
}
my $retval = substr($PDUBUF, 0, $index);
$PDUBUF = substr($PDUBUF, $index + length($SEPSTR));
return $retval;
}
sub RecvRPCData($$;$) {
my ($fh, $ppdu, $timeout) = @_;
my $PDU;
$timeout = $MAXTMO if (!defined($timeout));
if (!$fh) {
warn "libjsonrpc::RecvRPCData: Must provide valid filehandle!\n";
return 0;
}
if (!$ppdu || ref($ppdu) ne "SCALAR") {
warn "libjsonrpc::RecvRPCData: Must pass in a scalar reference for holding data!\n";
return 0;
}
if ($timeout && ($timeout < $MINTMO || $timeout > $MAXTMO)) {
warn "Timeout is out of bounds ($MINTMO < timeout < $MAXTMO): $timeout\n";
return 0;
}
my $bits = '';
vec($bits, fileno($fh), 1) = 1;
while (!($PDU = _getPDU())) {
my $nready = select($bits, undef, undef, $timeout);
if (!$nready) {
warn "libjsonrpc::RecvRPCData: Timeout while waiting for data!\n"
if $debug;
return -1;
}
warn "libjsonrpc::RecvRPCData: input filehandle has data.\n"
if $debug;
my $nbytes = sysread($fh, $PDUBUF, $PDUBUFSIZ, length($PDUBUF));
if (!defined($nbytes)) {
warn "libjsonrpc::RecvRPCData: Error reading RPC data from file handle: $!\n";
return 0;
}
elsif ($nbytes == 0) {
warn "libjsonrpc::RecvRPCData: Premature EOF?\n"
if $debug;
return 0;
}
}
$$ppdu = $PDU;
return 1;
}
# Mandatory fun
1;
#!/usr/bin/perl -w
use strict;
use English;
use libjsonrpc;
use Data::Dumper;
my $TMPFILE = "/tmp/footest.tmp";
print "Encoding func with single scalar arg\n";
my $json1 = EncodeCall("scalarargfunc", 1);
print "Encoded as: $json1\n\n";
print "Encoding func with no args\n";
my $json2 = EncodeCall("noargfunc");
print "Encoded as: $json2\n\n";
print "Encoding func with array args\n";
my $json3 = EncodeCall("arrayfunc", ["foo","bar","baz"]);
print "Encoded as: $json3\n\n";
print "Encoding func with hash args\n";
my $json4 = EncodeCall("hashfunc", {FOO => 1, BAR => 2});
print "Encoded as: $json4\n\n";
print "Encoding func with bad arguments (circular ref)\n";
my $dee = {};
my $dum = { DEE => $dee };
$dee->{DUM} = $dum;
my $badjson = EncodeCall("badargs", [$dee, $dum]);
if (!$badjson) {
print "No return value\n\n";
} else {
print "Encoded as: $badjson\n\n";
}
print "'Sending' RPC\n";
my $memvar;
open(my $fh, ">", $TMPFILE) or
die "Could not open $TMPFILE for writing!\n";
my $ret = SendRPCData($fh, $json3);
print "Retval: $ret\n";
print "Sent as: ". `cat $TMPFILE` ."\n";
print "'Sending' another RPC same FH\n";
$ret = SendRPCData($fh, $json4);
print "Retval: $ret\n";
print "Sent as: ". `cat $TMPFILE` ."\n";
print "Sending with undefined data arg.\n";
$ret = SendRPCData($fh, undef);
print "Retval: $ret\n\n";
print "Sending with empty data arg.\n";
$ret = SendRPCData($fh, "");
print "Retval: $ret\n\n";
print "Sending to bogus filehandle.\n";
my $bogus = "asdf";
$ret = SendRPCData($bogus, $json1);
print "Retval: $ret\n\n";
print "Receiving from $TMPFILE!\n";
close $fh;
open ($fh, "<", $TMPFILE) or
die "Could not open $TMPFILE for reading!\n";
my $data1 = RecvRPCData($fh);
print "Received: $data1\n";
print "Receiving again from $TMPFILE...\n";
my $data2 = RecvRPCData($fh);
print "Received: $data2\n";
print "Decoding first read from $TMPFILE.\n";
my $dec1 = DecodeRPCData($data1);
print "Decoded as: ". Dumper($dec1);
print "Decoding second read from $TMPFILE.\n";
my $dec2 = DecodeRPCData($data2);
print "Decoded as: ". Dumper($dec2);
print "Receiving from STDIN...\n";
my $count = 0;
do {
my $data = RecvRPCData(*STDIN, 10);
if (!$data) {
print "No data received.\n";
} elsif ( $data =~ /^-1$/) {
print "Timeout!\n";
} else {
print "Received data: $data\n";
print "Attemping to decode:\n";
my $decoded = DecodeRPCData($data);
if (!$decoded) {
print "Nothing decoded!\n";
} else {
print "Data decoded as: ". Dumper($data);
}
}
$count++;
} while ($count < 10);
close($fh);
print "Done\n";
#!/usr/bin/perl -w
#
# Copyright (c) 2016 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 POSIX ":sys_wait_h";
use Getopt::Std;
use Data::Dumper;
use File::Basename;
use libjsonrpc;
use EmulabConstants;
use Image;
use User;
# Func prototypes
sub cmd_loadimage($@);
sub cmd_reboot($;@);
sub GetSSHPipe();
sub chldhandler($);
sub genhandler($);
sub cleanexit($);
sub mysystem($);
# AUTOCONF variables
#my $TB = "@prefix@";
# Global variables
my $SSHPIPE;
my $CHWAITTMO = 10;
my $TBADB_PROXYCMD = "cd ~kwebb/git/emulab-devel/mobile && ./tbadb_proxy 2> /tmp/tbadb_proxy.log";
my $TBADB_HELLO_TMO = 10;
my $TBADB_CHECKIMAGE_TMO = 30;
my $TBADB_LOADIMAGE_TMO = 120;
my $TBADB_REBOOT_TMO = 60;
my $SCP = "/usr/bin/scp";
my $SSHTB = "$TB/bin/sshtb";
my @SSH_ARGS = ('-o','BatchMode=yes','-o','StrictHostKeyChecking=no',
'-o','ConnectTimeout=10');
my %DISPATCH = (
'loadimage' => \&cmd_loadimage,
'reboot' => \&cmd_reboot,
);
sub showhelp() {
print "Usage: $0 <rhost> <cmd> <args>\n\n";
print "<rhost>: Remote host to run on (hosts adb-controlled devices)\n".
"<cmd>: TBADB command to run (see list below).\n".
"<args>: set of arguments specific to <cmd>\n";
print "Command list: ". join(", ", keys %DISPATCH) ."\n";
}
#
# Untaint the path
#
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# We don't want to run this script unless it's the real version.
#
if ($EUID != 0) {
die("*** $0:\n".
" Must be setuid! Maybe it's a development version?\n");
}
#
# Verify user and get user's DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
die("You ($UID) do not exist!\n");
}
my %opts = ();
if (!getopts("dh",\%opts) || $opts{'h'} || @ARGV < 2) {
showhelp();
exit 1;
}
my ($RHOST, $CMD, @ARGS) = @ARGV;
my $debug = $opts{'d'} ? 1 : 0;
$libjsonrpc::debug = 1 if $debug;
die "tbadb: unknown command: $CMD\n"
if (!exists($DISPATCH{$CMD}));
# Setup stuff for the SSH Pipe.
$SIG{CHLD} = \&chldhandler;
$SIG{HUP} = $SIG{TERM} = $SIG{INT} = \&genhandler;
$SSHPIPE = TBADB::SSHPipe->New($RHOST, $TBADB_PROXYCMD);
exit $DISPATCH{$CMD}->($RHOST, @ARGS);
#
# Given a valid image identifier (name, osid), project (to scope
# image) and node_id, load an image onto a remote device. Check with
# the remote side to ensure the image is there, and tranfer it first
# if necessary. The remote end keeps an LRU cache of images.
#
sub cmd_loadimage($@) {
my ($rhost, $imagepid, $imagename, $node_id) = @_;
# Argument checks.
die "tbadb::cmd_loadimage: missing one or more arguments (need: <project> <image_name> <node_id>)!\n"
if (!$rhost || !$imagepid || !$imagename || !$node_id);
# Lookup image and extract some info.
my $image = Image->Lookup($imagepid, $imagename);
die "tbadb::cmd_loadimage: No such image descriptor $imagename in project $imagepid!\n"
if (!defined($image));
my $imageid = $image->imageid();
my $imagepath = $image->path();
$imagename = $image->imagename(); # strip any version
# Check user's access to the image.
die "tbadb::cmd_loadimage: You do not have permission to use imageid $imageid!\n"
if (!$this_user->IsAdmin() &&
!$image->AccessCheck($this_user, TB_IMAGEID_ACCESS));
die "tbadb::cmd_loadimage: Cannot access image file: $imagepath\n"
if (!-r $imagepath);
# Make sure user has access to requested node too.
my $node = Node->Lookup($node_id);
die "tbadb::cmd_loadimage: Invalid node name $node_id!\n"
if (!defined($node));
die("tbadb::cmd_loadimage: You do not have permission to load an image onto $node\n")
if (!$node->AccessCheck($this_user, TB_NODEACCESS_LOADIMAGE));
# Get stats from the image file.
my @fstats = stat($imagepath);
my $mtime = $fstats[9];
my $size = $fstats[7];
# Grab the RPC pipe.
my ($chin, $chout) = GetPipe();
die "tbadb::cmd_loadimage: Failed to get valid SSH pipe filehandles!\n"
if (!$chin || !$chout);
# Have remote side check for this image in its cache.
die "tbadb::cmd_loadimage: Failed to send 'checkimage' RPC!\n"
if (!SendRPCData($chout,
EncodeCall("checkimage",
{
IMG_PROJ => $imgpid,
IMG_NAME => $imagename,
IMG_TIME => $mtime,
IMG_SIZE => $size,
})));
my $pdu;
die "tbadb::cmd_loadimage: Failed to receive valid response for 'checkimage'\n"
if (RecvRPCData($chin, \$pdu, $TBADB_CHECKIMAGE_TMO) != 1);
my $data = DecodeRPCData($pdu);
die "tbadb::cmd_loadimage: Could not decode RPC response from 'checkimage'"
if (!$data);
if (exists($data->{ERROR})) {
warn "tbadb::cmd_loadimage: Received error from 'checkimage':\n";
warn "". Dumper($data);
exit 1;
}
# Transfer the image to the remote host if necessary (SCP).
if ($data->{RESULT}->{NEED_IMG} == 1) {
print "tbadb: Sending $imagepath to $rhost\n";
my $rpath = $data->{RESULT}->{REMOTE_PATH};
die "tbadb::cmd_loadimage: Failed to transfer image to $rhost: $imagepath\n"
if (mysystem("$SCP -q -B -p $imagepath $rhost:$rpath") != 0);
}
# Now that the image is (ostensibly) in place on the remote side,
# ask the remote host to load it onto the device.
die "tbadb::cmd_loadimage: Failed to send 'loadimage' RPC!\n"
if (!SendRPCData($chout,
EncodeCall("loadimage",
{
IMG_PROJ => $imgpid,
IMG_NAME => $imgname,
NODE_ID => $node_id,
})));
die "tbadb::cmd_loadimage: Failed to receive response for 'loadimage'\n"
if (RecvRPCData($chin, \$pdu, $TBADB_LOADIMAGE_TMO) != 1);
$data = DecodeRPCData($pdu);
die "tbadb::cmd_loadimage: Could not decode RPC response from 'loadimage'\n"
if (!$data);
if (exists($data->{ERROR}) || !exists($data->{RESULT}->{SUCCESS})) {
warn "tbadb::cmd_loadimage: Received error from 'loadimage':\n";
warn "". Dumper($data);
exit 1;
}
# Done!
print "tbadb: Successfully loaded $imagepath to $node_id\n";
exit 0;
}
sub cmd_reboot($;@) {
my ($rhost, $node_id) = @_;
die "tbadb::cmd_reboot: node_id or rhost arguments missing!\n"
if (!$rhost || !$node_id);
# Make sure user has access to requested node
my $node = Node->Lookup($node_id);
die "tbadb::cmd_reboot: Invalid node name $node_id!\n"
if (!defined($node));
die("tbadb::cmd_reboot: You do not have permission to reboot $node\n")
if (!$node->AccessCheck($this_user, TB_NODEACCESS_REBOOT));
my ($chin, $chout) = GetPipe();
die "tbadb::cmd_reboot: Failed to get valid SSH pipe filehandles!\n"
if (!$chin || !$chout);
die "tbadb::cmd_reboot: Failed to send 'reboot' RPC!\n"
if (!SendRPCData($chout,
EncodeCall("reboot", { NODE_ID => $node_id })));
my $pdu;
die "tbadb::cmd_reboot: Failed to receive valid response for 'reboot'\n"
if (RecvRPCData($chin, \$pdu, $TBADB_REBOOT_TMO) != 1);
my $data = DecodeRPCData($pdu);
die "tbadb::cmd_loadimage: Could not decode RPC response from 'reboot'"
if (!$data);
if (exists($data->{ERROR}) || !exists($data->{RESULT}->{SUCCESS})) {
warn "tbadb::cmd_loadimage: Received error from 'reboot':\n";
warn "". Dumper($data);
exit 1;
}
print "tbadb: Successfully rebooted $node_id\n";
exit 0;
}
sub GetPipe() {
my ($chin, $chout);
if (!$SSHPIPE->isopen()) {
my $pdu;
($chin, $chout) = $SSHPIPE->GetPipe();
my $res = RecvRPCData($chin, \$pdu, $TBADB_HELLO_TMO);
if ($res == -1) {
die "tbadb: Timeout while opening SSH Pipe!\n";
}
elsif ($res == 0) {
die "tbadb: Error encountered while opening SSH Pipe!\n";
}
my $hello = DecodeRPCData($pdu);
die "tbadb: Unexpected data received when opening SSH Pipe!\n"
if (!$hello);
die "tbadb: Did not receive valid 'hello' from remote end!\n"
if (!exists($hello->{RESULT}->{HELLO}));
}
return ($chin, $chout);
}
sub cleanexit($) {
my $exval = shift;
if ($SSHPIPE && $SSHPIPE->child()) {
warn "tbadb: Killing SSH pipe process\n";
$SIG{CHLD} = "IGNORE";
my $stime = time();
while (1) {
kill("TERM", $SSHPIPE->child());
select(undef,undef,undef,0.25); # Sleep for a quarter of a second.
my $pid = waitpid($SSHPIPE->child(), WNOHANG);