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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
3 4
#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2002, 2005 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6 7 8 9
# All rights reserved.
#


10
package power_rpc27;
11

12 13
use Exporter;
@ISA = ("Exporter");
14
@EXPORT = qw( rpc27status rpc27ctrl );
15

16 17 18 19
use Socket;
use IO::Handle;
use lib "@prefix@/lib";
use libdb;
20
use POSIX qw(strftime);
21

22 23 24 25 26
# 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"
27
# statement below.
28 29 30
#
# XXX Note that if someone has already tipped to the power controller 
# in question, this won't work at all.
31 32 33 34

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

35 36 37
# Number of times to try sending command in the face of "Input error"
my $ntries = 3;

38
# Set for more output.
39
my $debug = 0;
40 41

# RPC27 Prompt string
42
my $RPC27_PROMPT = 'RPC-\d+>';
43 44 45 46

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

47
my %RPC27_CMD =
48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  ("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;
    }

67
    #
68
    # Send the command.  Try again a few times if there is a retryable error.
69
    #
70 71
    my $status;
    for my $try (1..$ntries) {
72
	$status = syncandsend($controller, $TIP, "status", $statusp);
73 74
	last
	    if $status >= 0;
75
    }
76 77
    close($TIP);
    return $status ? 1 : 0;
78
}
79 80

# Main routine.
81
# usage: rpc27ctrl(cmd, controller, outlet)
82
# cmd = { "cycle" | "on" | "off" | "status" }
83 84
# controller = <node_id>
# outlet = int, 1 <= outlet <= 20
85 86 87
#
# Returns 0 on success. Non-zero on failure.
# 
88
sub rpc27ctrl {
89
    my($cmd, $controller, @outlets) = @_;
90

91 92 93 94 95 96 97
    #
    # Check parameters
    #
    if (!defined($RPC27_CMD{$cmd})) {
	print STDERR "*** Undefined command: '$cmd'\n";
	return 1;
    }
98
    if (grep {$_ < 1 || $_ > 20} @outlets) {
99 100 101 102
	print STDERR "*** Invalid outlet '$outlet': Must be 1-20\n";
	return 1;
    }

103
    #
104 105 106
    # 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)
107
    #
108 109 110 111 112 113 114 115 116 117 118 119
    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";
    }
    
120
    #
121 122 123
    # 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.
124
    #
125 126 127 128
    if (! ($TIP = tipconnect($controller))) {
	print STDERR "*** Could not form TIP connection to $controller\n";
	return 1;
    }
129 130 131

    foreach my $outlet (@outlet_strings) {
	my $command = "$RPC27_CMD{$cmd} $outlet";
132 133 134
	my $status;
	for my $try (1..$ntries) {
	    $status = syncandsend($controller, $TIP, $command, undef);
135 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 161 162 163 164 165 166 167 168 169
	    #
	    # Double check that an off command really turned the outlet(s)
	    # off.  We assume reliable power off in our security environment
	    # and we have seen cases where powering off doesn't.
	    #
	    if ($status == 0 && $cmd eq "off") {
		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"}) ||
			    $stathash{"outlet$o"} !~ /^off$/i) {
			    push(@noutlets, $o);
			}
		    }
		    if (@noutlets != 0) {
			$outlet = join(",", @noutlets);
			$command = "$RPC27_CMD{$cmd} $outlet";
			$status = -1;
			if ($try == $ntries) {
			    print STDERR
				"*** Failed to turn off $controller $outlet\n";
			}
		    }
		} elsif ($status > 0) {
		    print STDERR
			"*** Post-off status command failed on $controller\n";
		}
	    }
170 171
	    last
		if $status >= 0;
172 173 174
	}
	if ($status) {
	    close($TIP);
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189
	    return 1;
	}
    }

    close($TIP);
    return 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.
#
190 191 192
# Returns 0 if successful, -1 if the caller should try again,
# 1 on an unexpected error.
#
193 194
sub syncandsend($$$) {
    my ($controller,$TIP,$cmd,$statusp) = @_;
195

196
    #
197 198 199
    # Send a couple of newlines 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
200 201
    # gone wrong.
    #
202
    my $insync = 0;
203

204
    for (my $i = 0; $i < 20; $i++) {
205 206 207 208
	my $line;

	if (syswrite($TIP, "\r\n") == 0) {
	    print STDERR
209
		"*** Power control sync write failed ($controller/$outlet)\n";
210 211 212
	    return 1;
	}

213 214 215 216 217 218
	$line = rpc_readline($TIP);
	if (!defined($line)) {
	    print STDERR
		"*** Power control sync read failed ".
		    "($controller/$outlet)\n";
	    return 1;
219 220 221 222 223 224 225 226 227
	}
	if ($debug) {
	    print "Read: $line";
	}
	if ($line =~ /$RPC27_PROMPT/) {
	    if ($debug) {
		print "Matched prompt '$RPC27_PROMPT'!\n";
	    }
	    $insync = 1;
228 229
	    last;
	}
230
    }
231 232
    if (! $insync) {
	print STDERR "*** Could not sync with power controller! ".
233
	    "($controller)\n";
234 235
	return 1;
    }
236

237 238 239 240 241 242 243 244 245 246 247
    #
    # These things have an annoying tendency to fail sometimes by losing
    # the command part of the string (e.g., "6" instead of "reboot 6").
    # I think we are overrunning the UART with "\r\n" since we put out
    # 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.
    #
    sleep(1);

248
    if ($debug) {
249
	print "Sending '$cmd' to $controller\n";
250 251 252
    }

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

258 259 260 261 262 263 264 265 266 267
    #
    # 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;
    print "Reading output following command\n"
	if ($debug);
    while (my $line = rpc_readline($TIP)) {
	print "Read: $line"
268
	    if ($debug);
269 270 271 272 273 274 275 276 277 278 279 280 281 282
	# 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;
	}
	# got the following prompt, all done
	if ($gotcmd && $line =~ $RPC27_PROMPT) {
	    last;
	}
	if ($statusp) {
283 284 285 286 287 288 289 290 291 292 293 294 295 296 297
	    if ($line =~ /Temperature:\s+(\d+\.\d+) C/) {
		$status{tempC} = $1;
	    } elsif ($line =~ /Average Power:\s+(\d+) Watts/) {
		$status{power} = $1;
	    } elsif ($line =~ /True RMS Current:\s+(\d+\.\d+) Amps/) {
		$status{current} = $1;
	    }
	    # 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};
		}
	    }
	}
298 299 300
    }

    if ($statusp) {
301 302
	%$statusp = %status;
    }
303
    return 0;
304 305
}

306
#
307 308
# Connect up to the capture process. This should probably be in a library
# someplace.
309
#
310
sub tipconnect($) {
311
    my($controller) = $_[0];
312
    my($server, $portnum, $keylen, $keydata, $capreturn);
313 314 315 316 317
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
318
      DBQueryWarn("select * from tiplines where node_id='$controller'");
319 320 321

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
322
	return 0;
323
    }
324 325 326 327 328 329 330 331 332 333 334
    %powerid_row = $query_result->fetchhash();

    $server  = $powerid_row{'server'};
    $portnum = $powerid_row{'portnum'};
    $keylen  = $powerid_row{'keylen'};
    $keydata = $powerid_row{'keydata'};

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

335 336 337 338 339
    #
    # 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);
340
    my $capret    = pack("i", 0);
341

342 343 344 345 346 347 348 349 350 351
    #
    # 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');

352
    for (my $i = 0; $i < 20; $i++) {
353 354 355 356
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
357

358 359 360
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
361
	    close(TIP);
362 363 364 365
	    return 0;
	}
	TIP->autoflush(1);

366 367 368 369 370 371 372 373 374
	#
	# 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. 
	# 
375 376 377
	if (! syswrite(TIP, $secretkey)) {
	    print STDERR
		"*** Cannot write to $controller on $server($portnum)\n";
378
	    goto again;
379 380 381 382
	}
	if (! sysread(TIP, $capret, length($capret))) {
	    print STDERR
		"*** Cannot read from $controller on $server($portnum)\n";
383
	    goto again;
384 385 386 387 388 389 390
	}

	my $foo = unpack("i", $capret);
	if ($debug) {
	    print "Capture returned $foo\n";
	}
	if ($foo == 0) {
391 392
	    return(*TIP);
	}
393 394 395 396 397
	
      again:
	close(TIP);

	if ($i && (($i % 5) == 0)) {
398 399
	    printf STDERR
		"*** WARNING: $controller on $server($portnum) is busy\n".
400
		"    Waiting a bit before trying again. Pass $i.\n";
401 402
	}
	sleep(5);
403
    }
404
    
405
    print STDERR
406
	"*** $controller on $server($portnum) was busy for too long\n";
407
    return 0;
408 409
}

410 411 412 413 414 415 416 417 418 419
sub rpc_readline($)
{
    my ($TIP) = @_;
    my $line;

    my $cc = 0;
    while (1) {
	if (sysread($TIP, $line, 1, $cc) == 0) {
	    return undef;
	}
420
	print "got: =$line=\n" if ($debug > 1);
421
	$cc++;
422
	last if ($line =~ /\n/ || $line =~ /$RPC27_PROMPT/ || $cc > 1023);
423 424 425 426
    }
    return $line;
}

427
1;