power_rpc27.pm.in 6.68 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 14 15
use Exporter;
@ISA = ("Exporter");
@EXPORT = qw( rpc27ctrl );

16 17 18 19
use Socket;
use IO::Handle;
use lib "@prefix@/lib";
use libdb;
20

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

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

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

# RPC27 Prompt string
38
my $RPC27_PROMPT = 'RPC-\d+>';
39 40 41 42
my %RPC27_CMD =
  ("cycle"=>"reboot",
   "on"    =>"on",
   "off"   =>"off");
43 44

# Main routine.
45 46 47 48
# usage: rpc27ctrl(cmd, controller, outlet)
# cmd = { "cycle" | "on" | "off" }
# controller = <node_id>
# outlet = int, 1 <= outlet <= 20
49 50 51
#
# Returns 0 on success. Non-zero on failure.
# 
52
sub rpc27ctrl {
53
    my($cmd, $controller, @outlets) = @_;
54 55
    my($TIP, $i, $insync);

56
    if (grep {$_ < 1 || $_ > 20} @outlets) {
57 58 59 60
	print STDERR "*** Invalid outlet '$outlet': Must be 1-20\n";
	return 1;
    }

61
    #
62 63 64
    # 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)
65
    #
66 67 68 69 70 71 72 73 74 75 76 77
    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";
    }
    
78
    #
79 80 81
    # 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.
82
    #
83 84 85 86
    if (! ($TIP = tipconnect($controller))) {
	print STDERR "*** Could not form TIP connection to $controller\n";
	return 1;
    }
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111

    foreach my $outlet (@outlet_strings) {
	my $command = "$RPC27_CMD{$cmd} $outlet";
	if (syncandsend($controller,$TIP,$command)) {
	    #
	    # 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.
#
sub syncandsend($$) {
    my ($controller,$TIP,$cmd) = @_;

112
    #
113 114 115
    # 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
116 117
    # gone wrong.
    #
118
    my $insync = 0;
119

120
    for (my $i = 0; $i < 20; $i++) {
121 122 123 124
	my $line;

	if (syswrite($TIP, "\r\n") == 0) {
	    print STDERR
125
		"*** Power control sync write failed ($controller/$outlet)\n";
126 127 128 129
	    close($TIP);
	    return 1;
	}

130 131 132 133 134 135 136 137 138 139 140
	my $cc = 0;
	while (1) {
	    if (sysread($TIP, $line, 1, $cc) == 0) {
		print STDERR
		    "*** Power control sync read failed ".
			"($controller/$outlet)\n";
		close($TIP);
		return 1;
	    }
	    $cc++;
	    last if ($line =~ /\n/ || $cc > 1023);
141 142 143 144 145 146 147 148 149
	}
	if ($debug) {
	    print "Read: $line";
	}
	if ($line =~ /$RPC27_PROMPT/) {
	    if ($debug) {
		print "Matched prompt '$RPC27_PROMPT'!\n";
	    }
	    $insync = 1;
150 151
	    last;
	}
152
    }
153 154 155 156 157 158
    if (! $insync) {
	print STDERR "*** Could not sync with power controller! ".
	    "($controller/$outlet)\n";
	close($TIP);
	return 1;
    }
159

160
    if ($debug) {
161
	print "Sending '$cmd' to $controller\n";
162 163 164
    }

    # Okay, got a prompt. Send it the string:
165 166 167 168
    if (syswrite($TIP, "$cmd\r\n") == 0) {
    	print STDERR "*** Power control write failed ($controller/$outlet)\n";
    	close($TIP);
    	return 1;
169
    }
170

171
    return 0;
172 173
}

174
#
175 176
# Connect up to the capture process. This should probably be in a library
# someplace.
177
#
178
sub tipconnect($) {
179
    my($controller) = $_[0];
180
    my($server, $portnum, $keylen, $keydata, $capreturn);
181 182 183 184 185
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
186
      DBQueryWarn("select * from tiplines where node_id='$controller'");
187 188 189

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
190
	return 0;
191
    }
192 193 194 195 196 197 198 199 200 201 202
    %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";
    }

203 204 205 206 207
    #
    # 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);
208
    my $capret    = pack("i", 0);
209

210 211 212 213 214 215 216 217 218 219
    #
    # 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');

220
    for (my $i = 0; $i < 20; $i++) {
221 222 223 224
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
225

226 227 228
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
229
	    close(TIP);
230 231 232 233
	    return 0;
	}
	TIP->autoflush(1);

234 235 236 237 238 239 240 241 242
	#
	# 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. 
	# 
243 244 245
	if (! syswrite(TIP, $secretkey)) {
	    print STDERR
		"*** Cannot write to $controller on $server($portnum)\n";
246
	    goto again;
247 248 249 250
	}
	if (! sysread(TIP, $capret, length($capret))) {
	    print STDERR
		"*** Cannot read from $controller on $server($portnum)\n";
251
	    goto again;
252 253 254 255 256 257 258
	}

	my $foo = unpack("i", $capret);
	if ($debug) {
	    print "Capture returned $foo\n";
	}
	if ($foo == 0) {
259 260
	    return(*TIP);
	}
261 262 263 264 265
	
      again:
	close(TIP);

	if ($i && (($i % 5) == 0)) {
266 267
	    printf STDERR
		"*** WARNING: $controller on $server($portnum) is busy\n".
268
		"    Waiting a bit before trying again. Pass $i.\n";
269 270
	}
	sleep(5);
271
    }
272
    
273
    print STDERR
274
	"*** $controller on $server($portnum) was busy for too long\n";
275
    return 0;
276 277 278
}

1;