power_rpc27.pm.in 3.48 KB
Newer Older
1
#!/usr/bin/perl -wT
2 3
#use English;
#use strict;
4 5 6
use Socket;
use IO::Handle;

7 8 9 10 11 12 13 14 15
use lib "@prefix@/lib";
use libdb;

package power_rpc27;
use Exporter;
@ISA = ("Exporter");
@EXPORT = qw( rpc27ctrl );


16 17 18 19 20
# 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"
21
# statement below.
22 23 24 25 26 27 28 29

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

# Set for more output.
my $debug = 1;

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

# Main routine.
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
# usage: rpc27ctrl(cmd, controller, outlet)
# cmd = { "cycle" | "on" | "off" }
# controller = <node_id>
# outlet = int, 1 <= outlet <= 20
sub rpc27ctrl {
  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 "\n";
  for ($i = 0; $i < 5; $i++) {
    my $line = <$TIP>;
    if ($line =~ /^$RPC27_PROMPT/) {
      last;
67 68
    }
    print $TIP "\n";
69
  }
70

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

  if ($debug) {
    print "rpc27ctrl: Sent $cmd command to outlet $outlet on $controller.\n";
  }

  close($TIP);
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
}

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

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

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

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

    if (! connect(TIP, $paddr)) {
	print STDERR
	    "*** Cannot connect to $controller on $server($portnum)\n";
	return 0;
    }
    TIP->autoflush(1);
130

131 132 133 134 135 136 137 138 139 140
    # 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);

    if (! syswrite(TIP, $secretkey)) {
	print STDERR
	    "*** Cannot write key to $controller on $server($portnum)\n";
	return 0;
    }

141
    return(*TIP);
142 143 144
}

1;