power_rpc27.pm.in 12.8 KB
Newer Older
1
#!/usr/bin/perl -wT
2

Leigh Stoller's avatar
Leigh Stoller committed
3
#
4
# Copyright (c) 2000-2011 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{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/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24 25 26
#


27
package power_rpc27;
28

29 30
use Exporter;
@ISA = ("Exporter");
31
@EXPORT = qw( rpc27status rpc27ctrl );
32

33 34 35 36
use Socket;
use IO::Handle;
use lib "@prefix@/lib";
use libdb;
37
use POSIX qw(strftime);
38

39 40 41 42 43
# A little perl module to power cycle something attached to an RPC27.
# Thats a serially controlled, power controller.
#
# XXX The little secretkey handshake is coded in here. If this changes
# in capture, you have to change it here too. Look for the "pack"
44
# statement below.
45 46 47
#
# XXX Note that if someone has already tipped to the power controller 
# in question, this won't work at all.
48 49 50 51

# Turn off line buffering on output
$| = 1;

52 53 54
# Number of times to try sending command in the face of "Input error"
my $ntries = 3;

55
# Set for more output.
56
my $debug = 0;
57 58

# RPC27 Prompt string
59
my $RPC27_PROMPT = 'RPC-\d+>';
60 61 62 63

# RPC help message.  Used as terminator for status fetch.
my $RPC27_HELPMSG = 'Type "Help" for a list of commands';

64
my %RPC27_CMD =
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
  ("cycle"  => "reboot",
   "on"     => "on",
   "off"    => "off");

sub rpc27status {
    my ($controller, $statusp) = @_;

    my($TIP, $i, $insync);

    #
    # 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";
	return 1;
    }

84
    #
85
    # Send the command.  Try again a few times if there is a retryable error.
86
    #
87 88
    my $status;
    for my $try (1..$ntries) {
89
	$status = syncandsend($controller, $TIP, "status", $statusp);
90 91
	last
	    if $status >= 0;
92
    }
93 94
    close($TIP);
    return $status ? 1 : 0;
95
}
96 97

# Main routine.
98
# usage: rpc27ctrl(cmd, controller, outlet)
99
# cmd = { "cycle" | "on" | "off" | "status" }
100 101
# controller = <node_id>
# outlet = int, 1 <= outlet <= 20
102 103 104
#
# Returns 0 on success. Non-zero on failure.
# 
105
sub rpc27ctrl {
106
    my($cmd, $controller, @outlets) = @_;
107

108 109 110 111 112 113 114
    #
    # Check parameters
    #
    if (!defined($RPC27_CMD{$cmd})) {
	print STDERR "*** Undefined command: '$cmd'\n";
	return 1;
    }
115
    if (grep {$_ < 1 || $_ > 20} @outlets) {
116 117 118 119
	print STDERR "*** Invalid outlet '$outlet': Must be 1-20\n";
	return 1;
    }

120
    #
121 122 123
    # Make a comma-seperated strings of all the outlets to reboot. The RPCs
    # have a buffer limit of 31 characters, which limits us to 8 outlets
    # at a time (assuming the longest command and 2-digit outlet numbers)
124
    #
125 126 127 128 129 130 131 132 133 134 135
    my @outlet_strings = ();
    while (@outlets) {
	my @tmp_outlets = ();
	for (my $i = 0; ($i < 8) && (@outlets); $i++) {
	    push @tmp_outlets,shift(@outlets);
	}
	push @outlet_strings, join(",",@tmp_outlets);
    }
    if ($debug) {
	print "outlet_strings: ", join(" ",map("($_)",@outlet_strings)), "\n";
    }
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160

    #
    # 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 + (15 * scalar(@outlet_strings));
	waitpid($syspid, 0);
	alarm 0;
	my $exitstatus = $?;

	if ($exitstatus == 15) {
	    print STDERR "*** power: $controller is wedged.\n";
	}
	return($exitstatus);
    }
    TBdbfork();

161
    #
162 163 164
    # 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.
165
    #
166 167
    if (! ($TIP = tipconnect($controller))) {
	print STDERR "*** Could not form TIP connection to $controller\n";
168
	exit(1);
169
    }
170 171 172

    foreach my $outlet (@outlet_strings) {
	my $command = "$RPC27_CMD{$cmd} $outlet";
173 174 175
	my $status;
	for my $try (1..$ntries) {
	    $status = syncandsend($controller, $TIP, $command, undef);
176
	    #
177 178 179 180 181
	    # Double check that an off or on command really turned the
	    # outlet(s) off or on.  We assume reliable power off in our
	    # security environment and we have seen cases where powering
	    # off doesn't.  Reliable power on also avoid many unnecessary
	    # failures during firewalled experiment swapout.
182
	    #
183
	    if ($status == 0 && ($cmd eq "off" || $cmd eq "on")) {
184 185 186 187 188 189 190 191 192 193 194
		my %stathash;
		for my $stry (1..$ntries) {
		    $status = syncandsend($controller, $TIP, "status",
					  \%stathash);
		    last
			if $status >= 0;
		}
		if ($status == 0) {
		    my @noutlets = ();
		    for my $o (split(",", $outlet)) {
			if (!defined($stathash{"outlet$o"}) ||
195
			    $stathash{"outlet$o"} !~ /^$cmd$/i) {
196 197 198 199 200 201 202 203 204
			    push(@noutlets, $o);
			}
		    }
		    if (@noutlets != 0) {
			$outlet = join(",", @noutlets);
			$command = "$RPC27_CMD{$cmd} $outlet";
			$status = -1;
			if ($try == $ntries) {
			    print STDERR
205
				"*** Failed to turn $cmd $controller $outlet\n";
206 207 208 209
			}
		    }
		} elsif ($status > 0) {
		    print STDERR
210
			"*** Post-$cmd status command failed on $controller\n";
211 212
		}
	    }
213 214
	    last
		if $status >= 0;
215 216 217
	}
	if ($status) {
	    close($TIP);
218
	    exit(1);
219 220 221
	}
    }
    close($TIP);
222
    exit(0);
223 224 225 226 227 228 229 230
}

#
# 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.
#
231 232 233
# Returns 0 if successful, -1 if the caller should try again,
# 1 on an unexpected error.
#
234 235
sub syncandsend($$$) {
    my ($controller,$TIP,$cmd,$statusp) = @_;
236

237
    #
238
    # Send a newline to get the command prompt, and then wait
239 240
    # 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
241 242
    # gone wrong.
    #
243
    my $insync = 0;
244

245
    for (my $i = 0; $i < 20; $i++) {
246 247
	my $line;

248
	if (syswrite($TIP, "\r") == 0) {
249
	    print STDERR
250
		"*** Power control sync write failed ($controller/$outlet)\n";
251 252 253
	    return 1;
	}

254 255 256 257 258 259
	$line = rpc_readline($TIP);
	if (!defined($line)) {
	    print STDERR
		"*** Power control sync read failed ".
		    "($controller/$outlet)\n";
	    return 1;
260 261 262 263 264 265 266 267 268
	}
	if ($debug) {
	    print "Read: $line";
	}
	if ($line =~ /$RPC27_PROMPT/) {
	    if ($debug) {
		print "Matched prompt '$RPC27_PROMPT'!\n";
	    }
	    $insync = 1;
269 270
	    last;
	}
271
    }
272 273
    if (! $insync) {
	print STDERR "*** Could not sync with power controller! ".
274
	    "($controller)\n";
275 276
	return 1;
    }
277

278 279 280
    #
    # These things have an annoying tendency to fail sometimes by losing
    # the command part of the string (e.g., "6" instead of "reboot 6").
281
    # I think we are overrunning the UART with "\r" since we put out
282 283 284 285 286
    # a pair after every line we read that is not a prompt and when the
    # RPC puts out its banner, it is a good 10 lines before we see the
    # prompt.  So allow some time for the RPC to digest everything before
    # we feed it the command.
    #
287
    sleep(1);
288

289
    if ($debug) {
290
	print "Sending '$cmd' to $controller\n";
291 292 293
    }

    # Okay, got a prompt. Send it the string:
294
    if (syswrite($TIP, "$cmd\r") == 0) {
295 296
    	print STDERR "*** Power control write failed ($controller/$outlet)\n";
    	return 1;
297
    }
298

299 300 301 302 303 304
    #
    # Read and parse all the output until the next prompt to ensure that
    # there was no read error.  We also collect status here if desired.
    #
    my %status = ();
    my $gotcmd = 0;
305
    my $gotstatus = 0;
306 307 308 309
    print "Reading output following command\n"
	if ($debug);
    while (my $line = rpc_readline($TIP)) {
	print "Read: $line"
310
	    if ($debug);
311 312 313 314 315 316 317 318 319
	# skip echoed prompt+command
	if ($line =~ /$cmd/) {
	    $gotcmd = 1;
	    next;
	}
	# didn't recognize our command for some reason, return failure
	if ($line =~ /Input error/) {
	    return -1;
	}
320 321
	#
	# Got the following prompt, all done.
322
	#
323 324 325 326
	# XXX the prompt+command does not always get echoed correctly
	# (e.g. "atatus" or "ststus" instead of "status") so we also
	# exit if we parsed any status data.
	#
327 328 329 330 331 332 333
	# XXX RPC28 units split up the power data into columns for outlets
	# 1-10 and then for outlets 11-21, ala:
	#
	#    RPC28:  True RMS Current:     3.9 Amps      :      4.7 Amps
	#
	# hence the unusual REs for power and current.
	#
334
	if (($gotcmd || $gotstatus) && $line =~ $RPC27_PROMPT) {
335 336 337
	    last;
	}
	if ($statusp) {
338 339
	    if ($line =~ /Temperature:\s+(\d+\.\d+) C/) {
		$status{tempC} = $1;
340
		$gotstatus = 1;
341 342
	    } elsif ($line =~ /Average\ Power:\s+(\d+)\ Watts\s+ 
				(Apparent|\:\s+(\d+)\ Watts)/x) {
343
		$status{power} = $1;
344 345 346
		if ($3) {
		    $status{power} += $3;
		}
347
		$gotstatus = 1;
348 349
	    } elsif ($line =~ /True\ RMS\ Current:\s+(\d+\.\d+)\ Amps\s+
				(Maximum|\:\s+(\d+\.\d+)\ Amps)/x) {
350
		$status{current} = $1;
351 352 353
		if ($3) {
		    $status{current} += $3;
		}
354
		$gotstatus = 1;
355 356 357 358 359 360 361
	    }
	    # note the /g, controllers with 20 ports put two outlets per line
	    elsif (my %ohash = $line =~ /Outlet\s+(\d+)\s+:\s+(On|Off)/g) {
		for my $o (keys(%ohash)) {
		    my $outlet = "outlet$o";
		    $status{$outlet} = $ohash{$o};
		}
362
		$gotstatus = 1;
363 364
	    }
	}
365 366 367
    }

    if ($statusp) {
368 369
	%$statusp = %status;
    }
370
    return 0;
371 372
}

373
#
374 375
# Connect up to the capture process. This should probably be in a library
# someplace.
376
#
377
sub tipconnect($) {
378
    my($controller) = $_[0];
379
    my($server, $portnum, $keylen, $keydata, $capreturn);
380 381 382 383 384
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
385
      DBQueryWarn("select * from tiplines where node_id='$controller'");
386 387 388

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
389
	return 0;
390
    }
391 392 393 394 395 396
    %powerid_row = $query_result->fetchhash();

    $server  = $powerid_row{'server'};
    $portnum = $powerid_row{'portnum'};
    $keylen  = $powerid_row{'keylen'};
    $keydata = $powerid_row{'keydata'};
397 398 399 400 401 402
    $disabled= $powerid_row{'disabled'};

    if ($disabled) {
	print STDERR "*** $controller tipline is disabled\n";
	return 0;
    }
403 404 405 406 407

    if ($debug) {
	print "tipconnect: $server $portnum $keylen $keydata\n";
    }

408 409 410 411 412
    #
    # 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);
413
    my $capret    = pack("i", 0);
414

415 416 417 418 419 420 421 422 423 424
    #
    # 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');

425
    for (my $i = 0; $i < 20; $i++) {
426 427 428 429
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
430

431 432 433
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
434
	    close(TIP);
435 436 437 438
	    return 0;
	}
	TIP->autoflush(1);

439 440 441 442 443 444 445 446 447
	#
	# 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. 
	# 
448 449 450
	if (! syswrite(TIP, $secretkey)) {
	    print STDERR
		"*** Cannot write to $controller on $server($portnum)\n";
451
	    goto again;
452 453 454 455
	}
	if (! sysread(TIP, $capret, length($capret))) {
	    print STDERR
		"*** Cannot read from $controller on $server($portnum)\n";
456
	    goto again;
457 458 459 460 461 462 463
	}

	my $foo = unpack("i", $capret);
	if ($debug) {
	    print "Capture returned $foo\n";
	}
	if ($foo == 0) {
464 465
	    return(*TIP);
	}
466 467 468 469 470
	
      again:
	close(TIP);

	if ($i && (($i % 5) == 0)) {
471 472
	    printf STDERR
		"*** WARNING: $controller on $server($portnum) is busy\n".
473
		"    Waiting a bit before trying again. Pass $i.\n";
474 475
	}
	sleep(5);
476
    }
477
    
478
    print STDERR
479
	"*** $controller on $server($portnum) was busy for too long\n";
480
    return 0;
481 482
}

483 484 485 486 487 488 489 490 491 492
sub rpc_readline($)
{
    my ($TIP) = @_;
    my $line;

    my $cc = 0;
    while (1) {
	if (sysread($TIP, $line, 1, $cc) == 0) {
	    return undef;
	}
493
	print "got: =$line=\n" if ($debug > 1);
494
	$cc++;
495
	last if ($line =~ /\n/ || $line =~ /$RPC27_PROMPT/ || $cc > 1023);
496 497 498 499
    }
    return $line;
}

500
1;