power_rpc27.pm.in 3.75 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 42
# usage: rpc27ctrl(cmd, controller, outlet)
# cmd = { "cycle" | "on" | "off" }
# controller = <node_id>
# outlet = int, 1 <= outlet <= 20
sub rpc27ctrl {
43 44 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 70 71
    my($cmd, $controller, $outlet) = @_;
    my($TIP, $i);
    
    # 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 ( $outlet < 1 || $outlet > 20 ) {
	print STDERR "*** Invalid outlet '$outlet': Must be 1-20\n";
	return 1;
    }

    # 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
    # gone wrong/
    print $TIP "\r\n";
    for ($i = 0; $i < 5; $i++) {
	my $line = <$TIP>;
	if ($debug) { print "Read: $line"; }
	if ($line =~ /^$RPC27_PROMPT/) {
	    if ($debug) { print "Matched prompt '$RPC27_PROMPT'!\n"; }
	    last;
	}
	print $TIP "\r\n";
72 73
    }

74 75
    # Okay, got a prompt. Send it the string:
    print $TIP "$RPC27_CMD{$cmd} $outlet\r\n";
76

77 78 79 80
    if ($debug) {
	print "Sending '$RPC27_CMD{$cmd} $outlet'...\n";
	print "rpc27ctrl: Sent $cmd command to outlet $outlet on $controller.\n";
    }
81

82
    close($TIP);
83 84 85 86
}

# Connect up to the capture process. This should probably be in a library
# someplace.
87
sub tipconnect($) {
88 89 90 91 92 93 94
    my($controller) = $_[0];
    my($server, $portnum, $keylen, $keydata);
    my($inetaddr, $paddr, $proto);
    my(%powerid_row);
    local *TIP;

    my $query_result =
95
      DBQueryWarn("select * from tiplines where node_id='$controller'");
96 97 98 99

    if ($query_result->numrows < 1) {
	print STDERR "*** No such tipline: $controller\n";
	return 1;
100
    }
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121
    %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";
    }

    #
    # 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');

122
    if (! socket(TIP, PF_INET, SOCK_STREAM, $proto)) {
123 124 125 126 127 128
	print STDERR "*** Cannot create socket.\n";
	return 0;
    }

    if (! connect(TIP, $paddr)) {
	print STDERR
129
	  "*** Cannot connect to $controller on $server($portnum)\n";
130 131 132
	return 0;
    }
    TIP->autoflush(1);
133
    
134 135 136
    # Okay, we got a connection. 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);
137
    
138 139
    if (! syswrite(TIP, $secretkey)) {
	print STDERR
140
	  "*** Cannot write key to $controller on $server($portnum)\n";
141 142 143
	return 0;
    }

144
    return(*TIP);
145 146 147
}

1;