All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

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

package power_rpc27;
4

5 6 7 8
use Exporter;
@ISA = ("Exporter");
@EXPORT = qw( rpc27ctrl );

9 10 11 12
use Socket;
use IO::Handle;
use lib "@prefix@/lib";
use libdb;
13

14 15 16 17 18
# 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"
19
# statement below.
20 21 22
#
# XXX Note that if someone has already tipped to the power controller 
# in question, this won't work at all.
23 24 25 26 27

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

# Set for more output.
28
my $debug = 0;
29 30

# RPC27 Prompt string
31
my $RPC27_PROMPT = "RPC-27>";
32 33 34 35
my %RPC27_CMD =
  ("cycle"=>"reboot",
   "on"    =>"on",
   "off"   =>"off");
36 37

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

    if ( $outlet < 1 || $outlet > 20 ) {
	print STDERR "*** Invalid outlet '$outlet': Must be 1-20\n";
	return 1;
    }

    #
55 56 57
    # 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.
58
    #
59 60 61 62 63
    if (! ($TIP = tipconnect($controller))) {
	print STDERR "*** Could not form TIP connection to $controller\n";
	return 1;
    }
    
64
    #
65 66 67
    # 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
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
    # gone wrong.
    #
    $insync = 0;

    for ($i = 0; $i < 10; $i++) {
	my $line;

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

	if (sysread($TIP, $line, 1024) == 0) {
	    last;
	}
	if ($debug) {
	    print "Read: $line";
	}
	if ($line =~ /$RPC27_PROMPT/) {
	    if ($debug) {
		print "Matched prompt '$RPC27_PROMPT'!\n";
	    }
	    $insync = 1;
93 94
	    last;
	}
95
    }
96 97 98 99 100 101
    if (! $insync) {
	print STDERR "*** Could not sync with power controller! ".
	    "($controller/$outlet)\n";
	close($TIP);
	return 1;
    }
102

103
    if ($debug) {
104 105 106 107 108 109 110 111
	print "Sending '$RPC27_CMD{$cmd} $outlet' to $controller\n";
    }

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

114
    close($TIP);
115
    return 0;
116 117
}

118
#
119 120
# Connect up to the capture process. This should probably be in a library
# someplace.
121
#
122
sub tipconnect($) {
123 124 125 126 127 128 129
    my($controller) = $_[0];
    my($server, $portnum, $keylen, $keydata);
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
130
      DBQueryWarn("select * from tiplines where node_id='$controller'");
131 132 133

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
134
	return 0;
135
    }
136 137 138 139 140 141 142 143 144 145 146
    %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";
    }

147 148 149 150 151 152
    #
    # 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);

153 154 155 156 157 158 159 160 161 162
    #
    # 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');

163 164 165 166 167 168 169 170 171
    #
    # We have no locking protocol in place for the tiplines. So, loop
    # a small number of time, trying to form a proper connection. 
    #
    for ($i = 0; $i < 10; $i++) {
	if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
	    print STDERR "*** Cannot create socket.\n";
	    return 0;
	}
172

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
	if (! connect(TIP, $paddr)) {
	    print STDERR
		"*** Cannot connect to $controller on $server($portnum)\n";
	    return 0;
	}
	TIP->autoflush(1);

	#
	# If the connect succeeds, but the write fails, it means that the
	# other end dropped the connection cause there was already a tip
	# active (either a person on the tip line, or another power control).
	#
	# I'm not happy about this. We need a more positive action protocol.
	#
	if (syswrite(TIP, $secretkey) > 0) {
	    return(*TIP);
	}
	
191
	print STDERR
192 193 194 195
	    "*** WARNING: Cannot write to $controller on $server($portnum)" .
	    "    Power controller might be busy. Waiting a bit ...\n";
	
	close(TIP);
196
    }
197 198 199
    print STDERR
	"*** Cannot connect to $controller on $server($portnum)\n";
    return 0;
200 201 202
}

1;