xcat-core/xCAT-server/lib/xcat/plugins/hpilo.pm

#
# Copyright 2009 Hewlett-Packard Development Company, L.P.
# EPL license http://www.eclipse.org/legal/epl-v10.html
#
# CHANGES:
#	VERSION 1.3 - Adaptive Computing Enterprises Inc <lmsilva@adaptivecomputing.com>
#		(tested with a BladeSystem c3000 running iLO2 (firmware version: 1.50 Mar 14 2008))
#
#		- fixed ssl connection bug by introducing a 15 second sleep between boot commands (stat / on|off) in issuePowerCmd()
#
#	VERSION 1.2 - Adaptive Computing Enterprises Inc <lmsilva@adaptivecomputing.com>
#		(tested with a BladeSystem c3000 running iLO2 (firmware version: 1.50 Mar 13 2008))
#
#		- fixed boot process (to account for different power states)
#		- found a bug in the Net::SSLeay library
#			- it seems we cannot trust the following instructions inside openSSLconnection
#			Net::SSLeay::connect($ssl) and die_if_ssl_error("ERROR: ssl connect")
#			- it seems this problem only happens during several requests at the same time, i believe the iLO service becomes unresponsive
#			- here is how to reproduce it: rpower node01 off ; rpower node01 on ; rpower node01 boot
#			- added a timeout to try and minimize the issue (it can be controlled by changing the $SSL_CONNECT_TIMEOUT variable
#
#	VERSION 1.1 - Adaptive Computing Enterprises Inc <lmsilva@adaptivecomputing.com>
#		(tested with a BladeSystem c3000 running iLO2 (firmware version: 1.50 Mar 12 2008))
#
#		- fixed bug where we tried to use an existing xCAT library (xCAT::Utils->getNodesetStates())
#		- fixed protocol handling logic (sendScript was returning an incorrect value)
#		- fixed processReply sub as it wasn't prepared to handle on/off requests (just STAT or BEACON requests)
#		- added TOGGLE parameter to HOLD_PWR_BTN command. Otherwise requests would not work as expected
#		- changed issuePowerCmd() so that "off" subcommands would use SET_HOST_POWER_NO requests instead of HOLD_PWR_BTN
#		- added CHANGES to module
#
#	VERSION 1.0? - Hewlett-Packard Development Company, L.P.
#		- first version of hpilo.pm module?
#

package xCAT_plugin::hpilo;

BEGIN
{
    $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
}
use lib "$::XCATROOT/lib/perl";
use strict;
use warnings "all";
use xCAT::GlobalDef;

use POSIX qw(ceil floor);
use Storable qw(store_fd retrieve_fd thaw freeze);
use xCAT::Utils;
use xCAT::SvrUtils;
use xCAT::Usage;
use Thread qw(yield);
use Socket;
use Net::SSLeay qw(die_now die_if_ssl_error);
use POSIX "WNOHANG";
my $tfactor = 0;
my $vpdhash;
my %bmc_comm_pids;
my $globalDebug = 0;
my $outfd;
my $currnode;
my $status_noop         = "XXXno-opXXX";
my $SSL_CONNECT_TIMEOUT = 30;

require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw(
  hpiloinit
  hpilocmd
);
our $VERSION = 1.1;

sub handled_commands {
    return {
        rpower    => 'nodehm:power,mgt',
        rvitals   => 'nodehm:mgt',
        rbeacon   => 'nodehm:mgt',
        reventlog => 'nodehm:mgt'
      }
}


# These commands do not map directly to iLO commands
#	boot:
#		if power is off
#			power the server on
#		else
#			issue a HARD BOOT to the server
#
#	cycle:
#		Issue power off to server
#		Issue power on to server
#



my $INITIAL_HEADER = '
<LOCFG VERSION="2.21"/>
<RIBCL VERSION="2.0">
<LOGIN USER_LOGIN="AdMiNnAmE" PASSWORD="PaSsWoRd">';


# Command Definitions
my $GET_HOST_POWER_STATUS = '
<SERVER_INFO MODE="write">
<GET_HOST_POWER_STATUS/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

# This command enables or disables the Virtual Power Button
my $SET_HOST_POWER_YES = '
<SERVER_INFO MODE="write">
<SET_HOST_POWER HOST_POWER="Yes"/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $SET_HOST_POWER_NO = '
<SERVER_INFO MODE="write">
<SET_HOST_POWER HOST_POWER="No"/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $RESET_SERVER = '
<SERVER_INFO MODE="write">
<RESET_SERVER/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $PRESS_POWER_BUTTON = '
<SERVER_INFO MODE="write">
<PRESS_PWR_BTN/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $HOLD_POWER_BUTTON = '
<SERVER_INFO MODE="write">
<HOLD_PWR_BTN TOGGLE="Yes"/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $COLD_BOOT_SERVER = '
<SERVER_INFO MODE="write">
<COLD_BOOT_SERVER/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $WARM_BOOT_SERVER = '
<SERVER_INFO MODE="write">
<WARM_BOOT_SERVER/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $GET_UID_STATUS = '
<SERVER_INFO MODE="write">
<GET_UID_STATUS />
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $UID_CONTROL_ON = '
<SERVER_INFO MODE="write">
<UID_CONTROL UID="YES"/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $UID_CONTROL_OFF = '
<SERVER_INFO MODE="write">
<UID_CONTROL UID="NO"/>
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $GET_EMBEDDED_HEALTH = '
<SERVER_INFO MODE="read">
<GET_EMBEDDED_HEALTH />
</SERVER_INFO>
</LOGIN>
</RIBCL>';

my $GET_EVENT_LOG = '
<RIB_INFO MODE = "read" >
<GET_EVENT_LOG />
</RIB_INFO>
</LOGIN>
</RIBCL>';

my $CLEAR_EVENT_LOG = '
<RIB_INFO MODE = "write" >
<CLEAR_EVENT_LOG />
</RIB_INFO>
</LOGIN>
</RIBCL>';

my $IMPORT_SSH_KEY = '
<RIB_INFO MODE = "write" >
<IMPORT_SSH_KEY>
-----BEGIN SSH KEY -----';

my $IMPORT_SSH_KEY_ENDING = '
</IMPORT_SSH_KEY>
</RIB_INFO>
</LOGIN>
</RIBLC> ';


use Socket;
use Net::SSLeay qw(die_now die_if_ssl_error);

my $ctx;    # Make this a global

Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();
#
# opens an ssl connection to port 443 of the passed host
#
sub openSSLconnection($)
{
    my $host = shift;
    my ($ssl, $sin, $ip, $nip);
    if (not $ip = inet_aton($host))
    {
        print "$host is a DNS Name, performing lookup\n" if $globalDebug;
        $ip = gethostbyname($host) or die "ERROR: Host $host notfound. \n";
    }
    $nip = inet_ntoa($ip);

    #print STDERR "Connecting to $nip:443\n";
    $sin = sockaddr_in(443, $ip);
    socket(S, &AF_INET, &SOCK_STREAM, 0) or die "ERROR: socket: $!";
    connect(S, $sin) or die "connect: $!";
    $ctx = Net::SSLeay::CTX_new() or die_now("ERROR: Failed to create SSL_CTX $! ");

    Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL);
    die_if_ssl_error("ERROR: ssl ctx set options");
    $ssl = Net::SSLeay::new($ctx) or die_now("ERROR: Failed to create SSL $!");

    Net::SSLeay::set_fd($ssl, fileno(S));
    eval {
        local $SIG{ALRM} = sub { die "TIMEOUT" };
        alarm $SSL_CONNECT_TIMEOUT;
        Net::SSLeay::connect($ssl) and die_if_ssl_error("ERROR: ssl connect");
        alarm 0;
    };
    if ($@) {
        die "TIMEOUT!" if $@ eq "TIMEOUT";
        die "Caught ssl error!";
    }

    #print STDERR 'SSL Connected ';
    print 'Using Cipher: ' . Net::SSLeay::get_cipher($ssl) if $globalDebug;

    #print STDERR "\n\n";
    return $ssl;
}

sub closeSSLconnection($)
{
    my $ssl = shift;

    Net::SSLeay::free($ssl);    # Tear down connection
    Net::SSLeay::CTX_free($ctx);
    close S;
}

sub waitforack {
    my $sock   = shift;
    my $select = new IO::Select;
    $select->add($sock);
    my $str;
    if ($select->can_read(10)) { # Continue after 10 seconds, even if not acked...
        if ($str = <$sock>) {
        } else {
            $select->remove($sock);    #Block until parent acks data
        }
    }
}



# usage: sendscript(host, script)
# sends the xmlscript script to host, returns reply
sub sendScript($$)
{
    my $host   = shift;
    my $script = shift;
    my ($ssl, $reply, $lastreply, $res, $n);
    $ssl = openSSLconnection($host);

    # write header
    $n = Net::SSLeay::ssl_write_all($ssl, '<?xml version="1.0"?>' . "\r\n");
    print "Wrote $n\n" if $globalDebug;
    $n = Net::SSLeay::ssl_write_all($ssl, '<LOCFG version="2.21"/>' . "\r\n");
    print "Wrote $n\n" if $globalDebug;

    # write script
    $n = Net::SSLeay::ssl_write_all($ssl, $script);
    print "Wrote $n\n$script\n" if $globalDebug;
    $reply     = "";
    $lastreply = "";
    my $reply2return;
  READLOOP:
    while (1) {
        $n++;
        $lastreply = Net::SSLeay::read($ssl);
        die_if_ssl_error("ERROR: ssl read");
        if ($lastreply eq "") {
            sleep(2);    # wait 2 sec for more text.
            $lastreply = Net::SSLeay::read($ssl);
            die_if_ssl_error("ERROR: ssl read");
            last READLOOP if ($lastreply eq "");
        }
        $reply .= $lastreply;
        print "lastreply  $lastreply \b" if $globalDebug;

        # Check response to see if a error was returned.
        if ($lastreply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>/) {
            if ($1 eq "0x0000") {

                #print STDERR "$3\n" if $3;
            } else {
                $reply2return = "ERROR: STATUS: $1, MESSAGE: $2\n";
            }
        }
    }
    print "READ: $lastreply\n" if $globalDebug;
    if ($lastreply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>\n/) {
        if ($1 eq "0x0000") {

            #Sprint STDERR "$3\n" if $3;
        } else {
            $reply2return = "ERROR: STATUS: $1, MESSAGE: $2\n";
        }
    }
    else
    {
        $reply2return = $reply;
    }
    closeSSLconnection($ssl);
    return $reply2return;
}

sub process_request {
    my $request   = shift;
    my $callback  = shift;
    my $noderange = $request->{node};           #Should be arrayref
    my $command   = $request->{command}->[0];
    my $extrargs  = $request->{arg};
    my @exargs    = ($request->{arg});
    my $ipmimaxp  = 64;
    if (ref($extrargs)) {
        @exargs = @$extrargs;
    }
    my $ipmitab = xCAT::Table->new('ipmi');

    my $ilouser = "USERID";
    my $ilopass = "PASSW0RD";

    # Go to the passwd table to see if usernames and passwords are defined
    my $passtab = xCAT::Table->new('passwd');
    if ($passtab) {
        my ($tmp) = $passtab->getAttribs({ 'key' => 'ipmi' }, 'username', 'password');
        if (defined($tmp)) {
            $ilouser = $tmp->{username};
            $ilopass = $tmp->{password};
        }
    }

    my @donargs = ();
    my $ipmihash = $ipmitab->getNodesAttribs($noderange, [ 'bmc', 'username', 'password' ]);
    foreach (@$noderange) {
        my $node     = $_;
        my $nodeuser = $ilouser;
        my $nodepass = $ilopass;
        my $nodeip   = $node;
        my $ent;
        if (defined($ipmitab)) {
            $ent = $ipmihash->{$node}->[0];
            if (ref($ent) and defined $ent->{bmc}) { $nodeip = $ent->{bmc}; }
            if (ref($ent) and defined $ent->{username}) { $nodeuser = $ent->{username}; }
            if (ref($ent) and defined $ent->{password}) { $nodepass = $ent->{password}; }
        }
        push @donargs, [ $node, $nodeip, $nodeuser, $nodepass ];
    }

    #get new node status
    my %nodestat = ();
    my $check    = 0;
    my $newstat;
    if ($command eq 'rpower') {
        if (($extrargs->[0] ne 'stat') && ($extrargs->[0] ne 'status') && ($extrargs->[0] ne 'state')) {
            $check = 1;
            my @allnodes;
            foreach (@donargs) { push(@allnodes, $_->[0]); }

            if ($extrargs->[0] eq 'off') { $newstat = $::STATUS_POWERING_OFF; }
            else                         { $newstat = $::STATUS_BOOTING; }

            foreach (@allnodes) { $nodestat{$_} = $newstat; }

            if ($extrargs->[0] ne 'off') {

                #get the current nodeset stat
                if (@allnodes > 0) {
                    my $nsh = {};
                    my ($ret, $msg) = xCAT::SvrUtils->getNodesetStates(\@allnodes, $nsh);
                    if (!$ret) {
                        foreach (keys %$nsh) {
                            my $currstate = $nsh->{$_};
                            $nodestat{$_} = xCAT_monitoring::monitorctrl->getNodeStatusFromNodesetState($currstate, "rpower");
                        }
                    }
                }
            }
        }
    }

    # fork off separate processes to handle the requested command on each node.
    my $children = 0;
    $SIG{CHLD} = sub { my $kpid; do { $kpid = waitpid(-1, &WNOHANG); if ($kpid > 0) { delete $bmc_comm_pids{$kpid}; $children--; } } while $kpid > 0; };
    my $sub_fds = new IO::Select;
    foreach (@donargs) {
        while ($children > $ipmimaxp) {
            my $errornodes = {};
            forward_data($callback, $sub_fds, $errornodes);

            #update the node status to the nodelist.status table
            if ($check) {
                updateNodeStatus(\%nodestat, $errornodes);
            }
        }
        $children++;
        my $cfd;
        my $pfd;
        socketpair($pfd, $cfd, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die "socketpair: $!";
        $cfd->autoflush(1);
        $pfd->autoflush(1);
        my $child = xCAT::Utils->xfork();
        unless (defined $child) { die "Fork failed" }

        if ($child == 0) {
            close($cfd);
            my $rrc = execute_cmd($pfd, $_->[0], $_->[1], $_->[2], $_->[3], $command, -args => \@exargs);
            close($pfd);
            exit(0);
        }
        $bmc_comm_pids{$child} = 1;
        close($pfd);
        $sub_fds->add($cfd)
    }
    while ($sub_fds->count > 0 and $children > 0) {
        my $errornodes = {};
        forward_data($callback, $sub_fds, $errornodes);

        #update the node status to the nodelist.status table
        if ($check) {
            updateNodeStatus(\%nodestat, $errornodes);
        }
    }

    #Make sure they get drained, this probably is overkill but shouldn't hurt
    #my $rc=1;
    #while ( $rc > 0 ) {
    #my $errornodes={};
    #$rc=forward_data($callback,$sub_fds,$errornodes);
    #update the node status to the nodelist.status table
    #if ($check ) {
    #updateNodeStatus(\%nodestat, $errornodes);
    #}
    #}
}

sub updateNodeStatus {
    my $nodestat    = shift;
    my $errornodes  = shift;
    my %node_status = ();
    foreach my $node (keys(%$errornodes)) {
        if ($errornodes->{$node} == -1) { next; } #has error, not updating status
        my $stat = $nodestat->{$node};
        if (exists($node_status{$stat})) {
            my $pa = $node_status{$stat};
            push(@$pa, $node);
        } else {
            $node_status{$stat} = [$node];
        }
    }
    xCAT_monitoring::monitorctrl::setNodeStatusAttributes(\%node_status, 1);
}

sub processReply
{
    my $command    = shift;
    my $subcommand = shift;
    my $reply = shift; # This is the returned xml string from the iLO that we will now parse
    my $replyToReturn = "";
    my $rc            = 0;

    if ($command eq "power") {
        if ($subcommand =~ m/stat/) {

            # Process power status command
            $replyToReturn = "on"       if $reply =~ m/HOST_POWER="ON"/;
            $replyToReturn = "off"      if $reply =~ m/HOST_POWER="OFF"/;
            $replyToReturn = "timeout!" if $reply =~ m/ERROR: timed out/;
        }
        elsif (($subcommand =~ /on/) || ($subcommand =~ /off/) || ($subcommand =~ /reset/))
        {
            # Power commands do not actually return anything we can use
            # so we have to check for error RESPONSE STATUS!
            my $error_check = 0;
            while ($reply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>/g) {
                if ($1 ne "0x0000") {
                    $error_check = 1;
                    last;
                }
            }
            if (!$error_check) {
                return lc($subcommand);
            }
            else {
                return "could not process command!\n";
            }
        }
    } elsif ($command eq "beacon") {
        if ($subcommand =~ m/stat/) {
            $replyToReturn = "on"  if $reply =~ /GET_UID_STATUS UID="ON"/;
            $replyToReturn = "off" if $reply =~ /GET_UID_STATUS UID="OFF"/;
        }
    }

    if (!$replyToReturn) {
        $rc = -1;
    }

    return ($rc, $replyToReturn);
}

sub makeGEHXML
{
    my $inputreply = shift;

    # process response
    my $geh_output = "";

    my @lines = split /^/, $inputreply;
    my $capture = 0;

    foreach my $line (@lines) {
        if ($capture == 0 && $line =~ m/GET_EMBEDDED_HEALTH_DATA/) {
            $capture = 1;
        } elsif ($capture == 1 && $line =~ m/GET_EMBEDDED_HEALTH_DATA/) {
            $geh_output .= $line;
            last;
        }
        $geh_output .= $line if $capture;
    }
    return ($geh_output);
}


sub processGEHReply
{
    my $subcommand = shift;
    my $reply      = shift;

    use XML::Simple;

    # Process the reply from the ilo. Parse out all the untereting
    # stuff so we then have some XML which represents only the output of the GEH command.

    my $gehXML    = makeGEHXML($reply);
    my $gehOutput = "";

    # Now use XML::Simple to build a perl hash representation of the output
    my $gehHash = XMLin($gehXML);

    # We now have the reply in a format which is easy to parse. Now we
    # figure out what the user wants and return it.

    my $numoftemps = $#{ $gehHash->{TEMPERATURE}->{TEMP} };

    if ($subcommand eq "temp" || $subcommand eq "all") {

        for my $index (0 .. $numoftemps) {
            my $location = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION}->{VALUE};
            my $temperature = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{VALUE};
            my $unit = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{UNIT};
            $gehOutput .= "$location " . "Temperature: " . "$temperature $unit \n";
        }
    }

    if ($subcommand eq "cputemp" || $subcommand eq "ambtemp") {
        my $temp2look4 = "CPU" if ($subcommand eq "cputemp");
        $temp2look4 = "Ambient" if ($subcommand eq "ambtemp");
        for my $index (0 .. $numoftemps) {
            if ($gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION} =~ m/$temp2look4/) {
                my $location = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION}->{VALUE};
                my $temperature = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{VALUE};
                my $unit = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{UNIT};
                $gehOutput .= " $location " . "Temperature: " . "$temperature $unit \n";
            }
        }
    }


    if ($subcommand eq "fanspeed" || $subcommand eq "all") {
        foreach my $fan (keys %{ $gehHash->{FANS} }) {
            my $fanLabel      = $gehHash->{FANS}->{$fan}->{LABEL}->{VALUE};
            my $fanStatus     = $gehHash->{FANS}->{$fan}->{STATUS}->{VALUE};
            my $fanZone       = $gehHash->{FANS}->{$fan}->{ZONE}->{VALUE};
            my $fanUnit       = $gehHash->{FANS}->{$fan}->{SPEED}->{UNIT};
            my $fanSpeedValue = $gehHash->{FANS}->{$fan}->{SPEED}->{VALUE};

            if ($fanUnit eq "Percentage") {
                $fanUnit = "%";
            }

            $gehOutput .= "Fan Status $fanStatus Fan Speed: $fanSpeedValue $fanUnit Label - $fanLabel Zone - $fanZone";

        }
    }

    return (0, $gehOutput);

}


sub execute_cmd {
    $outfd = shift;
    my $node = shift;
    $currnode = $node;
    my $iloip     = shift;
    my $user      = shift;
    my $pass      = shift;
    my $command   = shift;
    my %namedargs = @_;
    my $extra     = $namedargs{-args};
    my @exargs    = @$extra;


    my $subcommand = $exargs[0];

    my ($rc, @reply);

    if ($command eq "rpower") {    # THe almighty power command

        ($rc, @reply) = issuePowerCmd($iloip, $user, $pass, $subcommand);

    } elsif ($command eq "rvitals") {

        ($rc, @reply) = issueEmbHealthCmd($iloip, $user, $pass, $subcommand);

    } elsif ($command eq "rbeacon") {

        ($rc, @reply) = issueUIDCmd($iloip, $user, $pass, $subcommand);

    } elsif ($command eq "reventlog") {

        ($rc, @reply) = issueEventLogCmd($iloip, $user, $pass, $subcommand);

    }

    sendoutput($rc, @reply);

    return $rc;

}

sub issueUIDCmd
{
    my $ipaddr     = shift;
    my $username   = shift;
    my $password   = shift;
    my $subcommand = shift;

    my $cmdString;

    if ($subcommand eq "on") {
        $cmdString = $UID_CONTROL_ON;
    } elsif ($subcommand eq "off") {
        $cmdString = $UID_CONTROL_OFF;
    } elsif ($subcommand eq "stat") {
        $cmdString = $GET_UID_STATUS;
    } else {    # anything else is not supported by the ilo
        return (-1, "not supported");
    }

    # All figured out.... send the command
    my ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $cmdString);

    my $condensedReply = processReply("beacon", $subcommand, $reply);

    return ($rc, $condensedReply);
}

sub issuePowerCmd {
    my $ipaddr     = shift;
    my $username   = shift;
    my $password   = shift;
    my $subcommand = shift;

    my $cmdString = "";
    my ($rc, $reply);

    if ($subcommand eq "on") {
        $cmdString = $SET_HOST_POWER_YES;
    } elsif ($subcommand eq "off") {
        $cmdString = $SET_HOST_POWER_NO;

        #$cmdString = $HOLD_POWER_BUTTON;
    } elsif ($subcommand eq "stat" || $subcommand eq "state") {
        $cmdString = $GET_HOST_POWER_STATUS;
    } elsif ($subcommand eq "reset") {
        $cmdString = $RESET_SERVER;
    } elsif ($subcommand eq "softoff") {
        $cmdString = $HOLD_POWER_BUTTON;

        # Handle two special cases here. For these commands we will need to issue a series of
        # commands to the ilo to emulate the desired operation
    } elsif ($subcommand eq "cycle") {
        ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $SET_HOST_POWER_NO);
        sleep 15;
        if ($rc != 0) {
            print STDERR "issuePowerCmd:cycle Command to power down server failed. \n";
            return ($rc, $reply);
        }
        $cmdString = $SET_HOST_POWER_YES;

    } elsif ($subcommand eq "boot") {

        # Determine the current power status of the server
        ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_HOST_POWER_STATUS);
        if ($rc == 0) {
            my $powerstatus = processReply("power", "status", $reply);

            if ($powerstatus eq "on") {
                $subcommand = "on reset";
                $cmdString  = $RESET_SERVER;
            } else {
                $subcommand = "on";
                $cmdString  = $SET_HOST_POWER_YES;
            }

            # iLO doesn't seem to handle several connections in a small amount of time
            # so let's just wait a few seconds...
            sleep(15);
        } else {
            print STDERR "issuePowerCmd:boot Power status of server failed. \n";
            return ($rc, $reply);
        }

    }

    ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $cmdString);

    my $condensedReply = processReply("power", $subcommand, $reply);

    return ($rc, $condensedReply);
}


sub issueEmbHealthCmd {
    my $ipaddr     = shift;
    my $username   = shift;
    my $password   = shift;
    my $subcommand = shift;

    my ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_EMBEDDED_HEALTH);

    my $condensedReply = processGEHReply($subcommand, $reply);

    return ($rc, $condensedReply);
}

sub issueEventLogCmd {
    my $ipaddr     = shift;
    my $username   = shift;
    my $password   = shift;
    my $subcommand = shift;

    my $numberOfEntries = "";
    my $errorLogOutput;
    my ($rc, $reply);

    if ($subcommand eq "clear") {
        ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $CLEAR_EVENT_LOG);
        return ($rc, $reply);
    }

    if (!$subcommand =~ /\D/) {
        $numberOfEntries = $subcommand;
    }

    if ($subcommand eq "all" || $numberOfEntries) {
        ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_EVENT_LOG);

        if ($rc != 0) {
            print STDERR "issueEventLogCmd: Failed get error log \n";
        }
        $errorLogOutput = processErrorLogReply($reply);
    }

    return ($rc, $errorLogOutput);
}



sub iloCmd {
    my $ipaddr     = shift;
    my $username   = shift;
    my $password   = shift;
    my $localdebug = shift;
    my $command    = shift;

    # Before we open the connection to the iLO, build the command we are going
    # to send

    my $cmdToSend = $INITIAL_HEADER;
    $cmdToSend =~ s/AdMiNnAmE/$username/;
    $cmdToSend =~ s/PaSsWoRd/$password/;
    $cmdToSend = "$cmdToSend" . "$command";

    if ($localdebug) {
        print STDERR "Command built. Command is $cmdToSend \n";
    }

    my $reply = sendScript($ipaddr, $cmdToSend);

    return (0, $reply);
}

sub forward_data { #unserialize data from pipe, chunk at a time, use magic to determine end of data structure
    my $callback   = shift;
    my $fds        = shift;
    my $errornodes = shift;

    my @ready_fds = $fds->can_read(1);
    my $rfh;
    my $rc = @ready_fds;
    foreach $rfh (@ready_fds) {
        my $data;
        if ($data = <$rfh>) {
            while ($data !~ /ENDOFFREEZE6sK4ci/) {
                $data .= <$rfh>;
            }
            print $rfh "ACK\n";
            my $responses = thaw($data);
            foreach (@$responses) {

                #save the nodes that has errors and the ones that has no-op for use by the node status monitoring
                my $no_op = 0;
                if (exists($_->{node}->[0]->{errorcode})) { $no_op = 1; }
                else {
                    my $text = $_->{node}->[0]->{data}->[0]->{contents}->[0];

                    #print "data:$text\n";
                    if (($text) && ($text =~ /$status_noop/)) {
                        $no_op = 1;

                        #remove the symbols that meant for use by node status
                        $_->{node}->[0]->{data}->[0]->{contents}->[0] =~ s/ $status_noop//;
                    }
                }

                #print "data:". $_->{node}->[0]->{data}->[0]->{contents}->[0] . "\n";
                if ($no_op) {
                    if ($errornodes) { $errornodes->{ $_->{node}->[0]->{name}->[0] } = -1; }
                } else {
                    if ($errornodes) { $errornodes->{ $_->{node}->[0]->{name}->[0] } = 1; }
                }
                $callback->($_);
            }
        } else {
            $fds->remove($rfh);
            close($rfh);
        }
    }
    yield; #Avoid useless loop iterations by giving children a chance to fill pipes  return $rc;
}



sub sendoutput {
    my $rc = shift;
    foreach (@_) {
        my %output;
        (my $desc, my $text) = split(/:/, $_, 2);
        unless ($text) {
            $text = $desc;
        } else {
            $desc =~ s/^\s+//;
            $desc =~ s/\s+$//;
            if ($desc) {
                $output{node}->[0]->{data}->[0]->{desc}->[0] = $desc;
            }
        }
        $text =~ s/^\s+//;
        $text =~ s/\s+$//;
        $output{node}->[0]->{name}->[0] = $currnode;
        $output{node}->[0]->{data}->[0]->{contents}->[0] = $text;
        if ($rc) {
            $output{node}->[0]->{errorcode} = [$rc];
        }

        #push @outhashes,\%output; #Save everything for the end, don't know how to be slicker with Storable and a pipe
        print $outfd freeze([ \%output ]);
        print $outfd "\nENDOFFREEZE6sK4ci\n";
        yield;
        waitforack($outfd);
    }
}

1;