power_rpc27.pm.in 9.52 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 35

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

# Set for more output.
36
my $debug = 0;
37 38

# RPC27 Prompt string
39
my $RPC27_PROMPT = 'RPC-\d+>';
40 41 42 43

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

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

64 65 66 67 68 69
    #
    # Send the command.  Try again one time if there is a retryable error.
    #
    my $status = syncandsend($controller, $TIP, "status", $statusp);
    if ($status == -1) {
	$status = syncandsend($controller, $TIP, "status", $statusp);
70
    }
71 72
    close($TIP);
    return $status ? 1 : 0;
73
}
74 75

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

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

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

    foreach my $outlet (@outlet_strings) {
	my $command = "$RPC27_CMD{$cmd} $outlet";
127 128 129 130 131 132
	my $status = syncandsend($controller,$TIP,$command,undef);
	if ($status == -1) {
	    $status = syncandsend($controller,$TIP,$command,undef);
	}
	if ($status) {
	    close($TIP);
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147
	    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.
#
148 149 150
# Returns 0 if successful, -1 if the caller should try again,
# 1 on an unexpected error.
#
151 152
sub syncandsend($$$) {
    my ($controller,$TIP,$cmd,$statusp) = @_;
153

154
    #
155 156 157
    # 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
158 159
    # gone wrong.
    #
160
    my $insync = 0;
161

162
    for (my $i = 0; $i < 20; $i++) {
163 164 165 166
	my $line;

	if (syswrite($TIP, "\r\n") == 0) {
	    print STDERR
167
		"*** Power control sync write failed ($controller/$outlet)\n";
168 169 170
	    return 1;
	}

171 172 173 174 175 176
	$line = rpc_readline($TIP);
	if (!defined($line)) {
	    print STDERR
		"*** Power control sync read failed ".
		    "($controller/$outlet)\n";
	    return 1;
177 178 179 180 181 182 183 184 185
	}
	if ($debug) {
	    print "Read: $line";
	}
	if ($line =~ /$RPC27_PROMPT/) {
	    if ($debug) {
		print "Matched prompt '$RPC27_PROMPT'!\n";
	    }
	    $insync = 1;
186 187
	    last;
	}
188
    }
189 190 191 192 193
    if (! $insync) {
	print STDERR "*** Could not sync with power controller! ".
	    "($controller/$outlet)\n";
	return 1;
    }
194

195 196 197 198 199 200 201 202 203 204 205
    #
    # 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);

206
    if ($debug) {
207
	print "Sending '$cmd' to $controller\n";
208 209 210
    }

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

216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
    # If status is desired, slurp and parse everything up to the next prompt
    if ($statusp) {
	my %status = ();

	print "Getting status\n"
	    if ($debug);
	while (my $line = rpc_readline($TIP)) {
	    print "Read: $line"
		if ($debug);
	    # skip echoed prompt+command
	    if ($line =~ /status/) {
		next;
	    }
	    # XXX cannot look for final prompt because there is no newline
	    if ($line =~ /$RPC27_HELPMSG/) {
		last;
	    }
	    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};
		}
	    }
247 248 249 250
	    # didn't recognize our command for some reason
	    elsif ($line =~ /Input error/) {
		return -1;
	    }
251 252 253 254 255
	}
	%$statusp = %status;
	print "Returning status\n"
	    if ($debug);
    }
256
    return 0;
257 258
}

259
#
260 261
# Connect up to the capture process. This should probably be in a library
# someplace.
262
#
263
sub tipconnect($) {
264
    my($controller) = $_[0];
265
    my($server, $portnum, $keylen, $keydata, $capreturn);
266 267 268 269 270
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
271
      DBQueryWarn("select * from tiplines where node_id='$controller'");
272 273 274

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
275
	return 0;
276
    }
277 278 279 280 281 282 283 284 285 286 287
    %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";
    }

288 289 290 291 292
    #
    # 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);
293
    my $capret    = pack("i", 0);
294

295 296 297 298 299 300 301 302 303 304
    #
    # 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');

305
    for (my $i = 0; $i < 20; $i++) {
306 307 308 309
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
310

311 312 313
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
314
	    close(TIP);
315 316 317 318
	    return 0;
	}
	TIP->autoflush(1);

319 320 321 322 323 324 325 326 327
	#
	# 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. 
	# 
328 329 330
	if (! syswrite(TIP, $secretkey)) {
	    print STDERR
		"*** Cannot write to $controller on $server($portnum)\n";
331
	    goto again;
332 333 334 335
	}
	if (! sysread(TIP, $capret, length($capret))) {
	    print STDERR
		"*** Cannot read from $controller on $server($portnum)\n";
336
	    goto again;
337 338 339 340 341 342 343
	}

	my $foo = unpack("i", $capret);
	if ($debug) {
	    print "Capture returned $foo\n";
	}
	if ($foo == 0) {
344 345
	    return(*TIP);
	}
346 347 348 349 350
	
      again:
	close(TIP);

	if ($i && (($i % 5) == 0)) {
351 352
	    printf STDERR
		"*** WARNING: $controller on $server($portnum) is busy\n".
353
		"    Waiting a bit before trying again. Pass $i.\n";
354 355
	}
	sleep(5);
356
    }
357
    
358
    print STDERR
359
	"*** $controller on $server($portnum) was busy for too long\n";
360
    return 0;
361 362
}

363 364 365 366 367 368 369 370 371 372
sub rpc_readline($)
{
    my ($TIP) = @_;
    my $line;

    my $cc = 0;
    while (1) {
	if (sysread($TIP, $line, 1, $cc) == 0) {
	    return undef;
	}
373
	print "got: =$line=\n" if ($debug > 1);
374
	$cc++;
375
	last if ($line =~ /\n/ || $line =~ /$RPC27_PROMPT/ || $cc > 1023);
376 377 378 379
    }
    return $line;
}

380
1;