power_rpc27.pm.in 9.14 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 64 65 66 67 68 69
  ("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;
    }

    if (syncandsend($controller, $TIP, "status", $statusp)) {
	return 1;
    }

    return 0;
}
70 71

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

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

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

    foreach my $outlet (@outlet_strings) {
	my $command = "$RPC27_CMD{$cmd} $outlet";
123
	if (syncandsend($controller,$TIP,$command,undef)) {
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
	    #
	    # On failure, syncandsend has already closed $TIP
	    #
	    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.
#
142 143
sub syncandsend($$$) {
    my ($controller,$TIP,$cmd,$statusp) = @_;
144

145
    #
146 147 148
    # 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
149 150
    # gone wrong.
    #
151
    my $insync = 0;
152

153
    for (my $i = 0; $i < 20; $i++) {
154 155 156 157
	my $line;

	if (syswrite($TIP, "\r\n") == 0) {
	    print STDERR
158
		"*** Power control sync write failed ($controller/$outlet)\n";
159 160 161 162
	    close($TIP);
	    return 1;
	}

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

189 190 191 192 193 194 195 196 197 198 199
    #
    # 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);

200
    if ($debug) {
201
	print "Sending '$cmd' to $controller\n";
202 203 204
    }

    # Okay, got a prompt. Send it the string:
205 206 207 208
    if (syswrite($TIP, "$cmd\r\n") == 0) {
    	print STDERR "*** Power control write failed ($controller/$outlet)\n";
    	close($TIP);
    	return 1;
209
    }
210

211 212 213 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};
		}
	    }
	}
	%$statusp = %status;
	print "Returning status\n"
	    if ($debug);
    }
247
    return 0;
248 249
}

250
#
251 252
# Connect up to the capture process. This should probably be in a library
# someplace.
253
#
254
sub tipconnect($) {
255
    my($controller) = $_[0];
256
    my($server, $portnum, $keylen, $keydata, $capreturn);
257 258 259 260 261
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
262
      DBQueryWarn("select * from tiplines where node_id='$controller'");
263 264 265

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
266
	return 0;
267
    }
268 269 270 271 272 273 274 275 276 277 278
    %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";
    }

279 280 281 282 283
    #
    # 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);
284
    my $capret    = pack("i", 0);
285

286 287 288 289 290 291 292 293 294 295
    #
    # 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');

296
    for (my $i = 0; $i < 20; $i++) {
297 298 299 300
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
301

302 303 304
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
305
	    close(TIP);
306 307 308 309
	    return 0;
	}
	TIP->autoflush(1);

310 311 312 313 314 315 316 317 318
	#
	# 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. 
	# 
319 320 321
	if (! syswrite(TIP, $secretkey)) {
	    print STDERR
		"*** Cannot write to $controller on $server($portnum)\n";
322
	    goto again;
323 324 325 326
	}
	if (! sysread(TIP, $capret, length($capret))) {
	    print STDERR
		"*** Cannot read from $controller on $server($portnum)\n";
327
	    goto again;
328 329 330 331 332 333 334
	}

	my $foo = unpack("i", $capret);
	if ($debug) {
	    print "Capture returned $foo\n";
	}
	if ($foo == 0) {
335 336
	    return(*TIP);
	}
337 338 339 340 341
	
      again:
	close(TIP);

	if ($i && (($i % 5) == 0)) {
342 343
	    printf STDERR
		"*** WARNING: $controller on $server($portnum) is busy\n".
344
		"    Waiting a bit before trying again. Pass $i.\n";
345 346
	}
	sleep(5);
347
    }
348
    
349
    print STDERR
350
	"*** $controller on $server($portnum) was busy for too long\n";
351
    return 0;
352 353
}

354 355 356 357 358 359 360 361 362 363
sub rpc_readline($)
{
    my ($TIP) = @_;
    my $line;

    my $cc = 0;
    while (1) {
	if (sysread($TIP, $line, 1, $cc) == 0) {
	    return undef;
	}
364
	print "got: =$line=\n" if ($debug > 1);
365
	$cc++;
366
	last if ($line =~ /\n/ || $line =~ /$RPC27_PROMPT/ || $cc > 1023);
367 368 369 370
    }
    return $line;
}

371
1;