Commit 5cf2ed45 authored by Leigh B Stoller's avatar Leigh B Stoller

Power module to talk to Jon's Awesome Arduino Power Controller

which I affectionately call "powduino".
parent fa68f6da
......@@ -106,7 +106,7 @@ LIBEXEC_STUFF = wanlinksolve wanlinkinfo os_setup mkexpdir console_setup \
$(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS)
LIB_STUFF = libtbsetup.pm exitonwarn.pm libtestbed.pm \
power_rpc27.pm power_apc.pm power_ue.pm \
power_rpc27.pm power_apc.pm power_ue.pm power_powduino.pm \
power_sgmote.pm power_racktivity.pm \
libaudit.pm libreboot.pm libosload.pm libtestbed.py \
libadminmfs.pm libtblog.pm libtblog_simple.pm libArchive.pm \
......
#!/usr/bin/perl -wT
#!/usr/bin/perl -w
#
# Copyright (c) 2000-2016 University of Utah and the Flux Group.
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
#
# {{{EMULAB-LICENSE
#
......@@ -55,6 +55,7 @@ use power_icebox;
use power_apc;
use power_racktivity;
use power_ue;
use power_powduino;
use libtestbed;
use User;
use Node;
......@@ -452,6 +453,12 @@ foreach my $power_id (keys %outlets) {
} elsif ($type =~ "RPC") {
if (rpc27ctrl($op,$power_id,@outlets)) {
print "Control of $nodestr failed.\n"; $exitval++;
$errors++;
}
} elsif ($type eq "powduino") {
if (powduinoctrl($op,$power_id,@outlets)) {
print "Control of $nodestr failed.\n"; $exitval++;
$errors++;
}
} elsif (($class eq "sg") || ($type eq "garcia")) {
# XXX: 'garcia' is temporary until stargates are subnodes of
......
#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2018 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 power_powduino;
use Exporter;
@ISA = ("Exporter");
@EXPORT = qw( powduinoctrl );
use Socket;
use IO::Handle;
use lib "@prefix@/lib";
use libdb;
use Node;
use POSIX qw(strftime);
#
# A little perl module for using Jon's arduino relay on a Powder node.
#
# Turn off line buffering on output
$| = 1;
# Number of times to try sending command in the face of "Input error"
my $ntries = 3;
# Set for more output.
my $debug = 0;
# Prompt string
my $PROMPT = 'power> ';
my %CMDS =
("cycle" => "power cycle",
"on" => "power on",
"off" => "power off");
# Main routine.
# usage: powduinoctrl(cmd, controller, outlet)
# cmd = { "cycle" | "on" | "off" }
# controller = <node_id>
# outlet = int, 0 <= outlet < N
#
# Returns 0 on success. Non-zero on failure.
#
sub powduinoctrl {
my($cmd, $controller, @outlets) = @_;
#
# Check parameters
#
if (!defined($CMDS{$cmd})) {
print STDERR "*** Undefined command: '$cmd'\n";
return 1;
}
if (grep {$_ < 0 || $_ > 3} @outlets) {
print STDERR "*** Invalid outlet '$outlet': Must be 0-3\n";
return 1;
}
if ($debug) {
print "outlets: ", join(" ",map("($_)",@outlets)), "\n";
}
#
# Run the rest in a child process, protected by an alarm to ensure that
# we are not hung up forever if the controller is in some funky state.
#
my $syspid = fork();
if ($syspid) {
local $SIG{ALRM} = sub { kill("TERM", $syspid); };
#
# Give it 30 seconds for initial connect plus time per outlet.
# Probably too long.
#
alarm 30 + (10 * scalar(@outlets));
waitpid($syspid, 0);
alarm 0;
my $exitstatus = $?;
if ($exitstatus == 15) {
print STDERR "*** power: $controller is wedged.\n";
}
return($exitstatus);
}
TBdbfork();
#
# Form the connection to the controller via a "tip" line to the
# capture process. Once we have that, we can just talk to the
# controller directly.
#
if (! ($TIP = tipconnect($controller))) {
print STDERR "*** Could not form TIP connection to $controller\n";
exit(1);
}
foreach my $outlet (@outlets) {
my $command = "$CMDS{$cmd} $outlet";
my $status;
for my $try (1..$ntries) {
$status = syncandsend($controller, $TIP, $command);
last
if $status >= 0;
}
if ($status) {
close($TIP);
exit(1);
}
}
close($TIP);
exit(0);
}
#
# Sync up with the power controller, and set it a command. $controller is the
# controller name, for error message purposes, $TIP is the connection to
# the controller opened with tipconnect, and $command is the whole command
# (ie. 'reboot 20,40') to send.
#
# Returns 0 if successful, -1 if the caller should try again,
# 1 on an unexpected error.
#
sub syncandsend($$$) {
my ($controller,$TIP,$cmd) = @_;
#
# Send a newline to get the command prompt, and then wait
# for it to print out the command prompt. This loop is set for a small
# number since if it cannot get the prompt quickly, then something has
# gone wrong.
#
my $insync = 0;
for (my $i = 0; $i < 20; $i++) {
my $line;
if (syswrite($TIP, "\r") == 0) {
print STDERR
"*** Power control sync write failed ($controller/$outlet)\n";
return 1;
}
$line = rpc_readline($TIP);
if (!defined($line)) {
print STDERR
"*** Power control sync read failed ".
"($controller/$outlet)\n";
return 1;
}
if ($debug) {
print "Read: $line";
}
if ($line =~ /$PROMPT/) {
if ($debug) {
print "Matched prompt 'PROMPT'!\n";
}
$insync = 1;
last;
}
}
if (! $insync) {
print STDERR "*** Could not sync with power controller! ".
"($controller)\n";
return 1;
}
if ($debug) {
print "Sending '$cmd' to $controller\n";
}
# Okay, got a prompt. Send it the string:
if (syswrite($TIP, "$cmd\r") == 0) {
print STDERR "*** Power control write failed ($controller/$outlet)\n";
return 1;
}
#
# Read and parse all the output until the next prompt to ensure that
# there was no read error.
#
my $gotcmd = 0;
print "Reading output following command\n"
if ($debug);
while (my $line = rpc_readline($TIP)) {
print "Read: $line"
if ($debug);
# skip echoed prompt+command
if ($line =~ /$cmd/) {
$gotcmd = 1;
print "GotCmd\n" if ($debug);
next;
}
# didn't recognize our command for some reason, return failure
if ($line =~ /Invalid/) {
print "Bad result\n" if ($debug);
return -1;
}
#
# Got the following prompt, all done.
#
if ($gotcmd && $line =~ /$PROMPT/) {
last;
}
}
return 0;
}
#
# Connect up to the capture process. This should probably be in a library
# someplace.
#
sub tipconnect($) {
my($controller) = $_[0];
my($server, $portnum, $keylen, $keydata, $capreturn);
my($inetaddr, $paddr, $proto);
my(%powerid_row);
local *TIP;
my $query_result =
DBQueryWarn("select * from tiplines where node_id='$controller'");
if ($query_result->numrows < 1) {
print STDERR "*** No such tipline: $controller\n";
return 0;
}
%powerid_row = $query_result->fetchhash();
$server = $powerid_row{'server'};
$portnum = $powerid_row{'portnum'};
$keylen = $powerid_row{'keylen'};
$keydata = $powerid_row{'keydata'};
$disabled= $powerid_row{'disabled'};
if ($disabled) {
print STDERR "*** $controller tipline is disabled\n";
return 0;
}
if ($debug) {
print "tipconnect: $server $portnum $keylen $keydata\n";
}
#
# We have to send over the key. This is a little hokey, since we have
# to make it look like the C struct.
#
my $secretkey = pack("iZ256", $keylen, $keydata);
my $capret = pack("i", 0);
#
# This stuff from the PERLIPC manpage.
#
if (! ($inetaddr = inet_aton($server))) {
print STDERR "*** Cannot map $server to IP address\n";
return 0;
}
$paddr = sockaddr_in($portnum, $inetaddr);
$proto = getprotobyname('tcp');
for (my $i = 0; $i < 20; $i++) {
if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
print STDERR "*** Cannot create socket.\n";
return 0;
}
if (! connect(TIP, $paddr)) {
print STDERR
"*** Cannot connect to $controller on $server($portnum)\n";
close(TIP);
return 0;
}
TIP->autoflush(1);
#
# While its a fatal error if the connect fails, the write and the
# read that follows might fail because the tip is currently is
# active. The handshake writes back a value and then immediately
# closes the socket, which could manifest itself as a closed
# connection on this end, even before we get a change to do these.
# operations. In that case, just go around the loop again. We hope
# to succeed at some point.
#
if (! syswrite(TIP, $secretkey)) {
print STDERR
"*** Cannot write to $controller on $server($portnum)\n";
goto again;
}
if (! sysread(TIP, $capret, length($capret))) {
print STDERR
"*** Cannot read from $controller on $server($portnum)\n";
goto again;
}
my $foo = unpack("i", $capret);
if ($debug) {
print "Capture returned $foo\n";
}
if ($foo == 0) {
return(*TIP);
}
again:
close(TIP);
if ($i && (($i % 5) == 0)) {
printf STDERR
"*** WARNING: $controller on $server($portnum) is busy\n".
" Waiting a bit before trying again. Pass $i.\n";
}
sleep(5);
}
print STDERR
"*** $controller on $server($portnum) was busy for too long\n";
return 0;
}
sub rpc_readline($)
{
my ($TIP) = @_;
my $line;
my $cc = 0;
while (1) {
if (sysread($TIP, $line, 1, $cc) == 0) {
return undef;
}
print "got: =$line=\n" if ($debug > 1);
$cc++;
last if ($line =~ /\n/ || $line =~ /$PROMPT/ || $cc > 1023);
}
return $line;
}
1;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment