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

#!/usr/bin/env perl
#
# © Copyright 2009 Hewlett-Packard Development Company, L.P.
# EPL license http://www.eclipse.org/legal/epl-v10.html
#
# Revision history:
#   July, 2010    vallard@sumavi.com comments added.
#   August, 2009	blade.pm adapted to generate hpblade.pm
#
package xCAT_plugin::hpblade;

BEGIN
{
    $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
}
use lib "$::XCATROOT/lib/perl";

use strict;
use xCAT::Table;
use xCAT::Utils;
use xCAT::TableUtils;
use xCAT::ServiceNodeUtils;
use xCAT::Usage;
use IO::Socket;
use Thread 'yield';
use Storable qw(freeze thaw);
use XML::Simple;
use Net::SSLeay qw(die_now die_if_ssl_error);


use Data::Dumper;
use POSIX "WNOHANG";
use Getopt::Long;

#use xCAT::hpoa;	# require this dynamically below instead

sub handled_commands {
    return {
        findme         => 'blade',
        getmacs        => 'nodehm:getmac,mgt',
        rscan          => 'nodehm:mgt',
        rpower         => 'nodehm:power,mgt',
        gethpbladecons => 'hpblade',
        getrvidparms   => 'nodehm:mgt',
        rvitals        => 'nodehm:mgt',
        rinv           => 'nodehm:mgt',
        rbeacon        => 'nodehm:mgt',
        rspreset       => 'nodehm:mgt',
        rspconfig      => 'nodehm:mgt',
        rbootseq       => 'nodehm:mgt',
        reventlog      => 'nodehm:mgt',
        switchblade    => 'nodehm:mgt',
    };
}

my $hpoa;
my $activeOABay;
my $slot;
my ($username, $password);
my %mm_comm_pids;
my %macmap;             #Store responses from rinv for discovery
my $macmaptimestamp;    #reflect freshness of cache
my %oahash;
my $curn;
my $oa;
my $getBladeStatusResponse; # Make this a global here so we can re-use the result
my $status_noop = "XXXno-opXXX";
my $eventHash;
my $globalDebug = 0;
my $ctx;
my @cfgtext;

my %bootdevices = (
    0 => 'IPL_NO_OP',
    1 => 'CD',
    2 => 'FLOPPY',
    3 => 'USB',
    4 => 'HDD',
    5 => 'PXE_NIC1',
    6 => 'PXE_NIC2',
    7 => 'PXE_NIC3',
    8 => 'PXE_NIC4'
);

my %bootnumbers = (
    'none'     => 0,
    'c'        => 1,
    'cd'       => 1,
    'dvd'      => 1,
    'cdrom'    => 1,
    'dvdrom'   => 1,
    'f'        => 2,
    'floppy'   => 2,
    'usb'      => 3,
    'usbflash' => 3,
    'flash'    => 3,
    'h'        => 4,
    'hd'       => 4,
    'hdd'      => 4,
    'hd0'      => 4,
    'harddisk' => 4,
    'eth0'     => 5,
    'nic1'     => 5,
    'net1'     => 5,
    'net'      => 5,
    'n'        => 5,
    'pxe_nic1' => 5,
    'eth1'     => 6,
    'nic2'     => 6,
    'net2'     => 6,
    'pxe_nic2' => 6,
    'eth2'     => 7,
    'nic3'     => 7,
    'net3'     => 7,
    'pxe_nic3' => 7,
    'eth3'     => 8,
    'nic4'     => 8,
    'net4'     => 8,
    'pxe_nic4' => 8
);

my @rscan_attribs = qw(nodetype name id mtm serial mpa groups mgt);
my @rscan_header  = (
    [ "type",          "%-8s" ],
    [ "name",          "" ],
    [ "id",            "%-8s" ],
    [ "type-model",    "%-12s" ],
    [ "serial-number", "%-15s" ],
    [ "address",       "%s\n" ]);

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
        }
    }
}


# Login to the OA using credentials found in the database.
sub oaLogin {
    my $oaName = shift;
    my $result = "";
    my $hopa   = "";
    my $errHash;

    # we need to get the info on the OA. If the specfied OA is NOT the
    # ACTIVE OA then we return failure because we can't get the desired
    # info from a STANDBY OA.

    my ($username, $passwd, $encinfo);

    my $mpatab = xCAT::Table->new('mpa');
    my $ent;
    if (defined($mpatab)) {
        ($ent) = $mpatab->getAttribs({ 'mpa' => $oaName }, 'username', 'password');
        if (defined($ent->{password})) { $password = $ent->{password}; }
        if (defined($ent->{username})) { $username = $ent->{username}; }
    }


    $hpoa = xCAT::hpoa->new('oaAddress' => $oaName);
    my $loginResponse = $hpoa->userLogIn('username' => $username, 'password' => $password);
    if ($loginResponse->fault) {
        $errHash = $loginResponse->fault;
        print Dumper($errHash);
        $result = $loginResponse->oaErrorText;
        if ($loginResponse->fault) {
            return (1, "Error on login attempt");
        }
    }

    my $response = $hpoa->getEnclosureInfo();
    if ($response->fault) {
        return (1, "Error on get Enclosure Info call");
    }
    my $numOABays = $response->result->{oaBays};

    # OK We now know how many oaBays we have in this enclosure. Ask the OAs in each bay
    # if they are active. If they are not, then leave since we can't get what we want
    # from a standby OA
    $activeOABay = 0;

    for (my $oaBay = 1 ; $oaBay <= $numOABays ; $oaBay++) {
        $response = $hpoa->getOaInfo(bayNumber => $oaBay);
        if (!defined $response->result() || $response->result()->{oaRole} eq "OA_ABSENT" ||
            $response->result->{youAreHere} eq "false") {

            # either there is no OA here or this is not the one I am currently
            # communicating with
            next;
        } elsif ($response->result->{youAreHere} eq "true") {
            $activeOABay = $oaBay;
            last;
        }
    }

    if (!$activeOABay) {
        return (1, "Cannot determine active OnBoard Administrator");
    }

    # Last thing. Need to determine if this is the active OA. If not, then we
    # just tell the caller, and they can make the decision as to what they want
    # to do.

    $response = $hpoa->getOaStatus(bayNumber => $activeOABay);
    if ($response->result->{oaRole} ne "ACTIVE") {
        return (-1);
    }

    return ($hpoa);
}

sub oaLogout
{
    my $hpoa = shift;

    my $response = $hpoa->userLogOut();
}

sub convertSlot {
    my $origSlot = shift;

    if ($origSlot =~ /\D/) {
        my $slotNum   = $origSlot;
        my $slotAlpha = $slotNum;

        $slotNum =~ s/\D//;
        $slotAlpha =~ s/\d//;

        my $side;
        if ($slotAlpha eq "a" or $slotAlpha eq "A") {
            $side = 1;
        } elsif ($slotAlpha eq "b" or $slotAlpha eq "B") {
            $side = 2;
        } else {
            return (-1);
        }

        my $returnSlot = $side * 16 + $slotNum;
        return ($returnSlot);
    }
    return ($origSlot);
}

sub gethpbladecons {
    my $noderange = shift;
    my $callback  = shift;
    my $mpatab    = xCAT::Table->new('mpa');
    my $passtab   = xCAT::Table->new('passwd');
    my $tmp;
    my $user = "USERID";

    if ($passtab) {
        ($tmp) = $passtab->getAttribs({ 'key' => 'blade' }, 'username');
        if (defined($tmp)) {
            $user = $tmp->{username};
        }
    }
    my $mptab = xCAT::Table->new('mp');
    my $mptabhash = $mptab->getNodesAttribs($noderange, [ 'mpa', 'id' ]);
    foreach my $node (@$noderange) {
        my $rsp = { node => [ { name => [$node] } ] };
        my $ent = $mptabhash->{$node}->[0]; #$mptab->getNodeAttribs($node,['mpa', 'id']);
        if (defined($ent->{mpa})) {
            $oa   = $ent->{mpa};
            $slot = convertSlot($ent->{id});
            if ($slot == 0) {               # want to open a console on the OA
                $rsp->{node}->[0]->{mm} = $oa;
            } else {
                $hpoa = oaLogin($oa);
                my $mpInfoResp = $hpoa->getBladeMpInfo("bayNumber" => $slot);
                if ($mpInfoResp->fault) {
                    $rsp->{node}->[0]->{error}     = ["Error getting MP info"];
                    $rsp->{node}->[0]->{errorcode} = [1];
                    $callback->($rsp);
                    next;
                }
                my $ipaddress = $mpInfoResp->result->{ipAddress};
                $rsp->{node}->[0]->{mm} = $ipaddress;
            }
            ($tmp) = $mpatab->getAttribs({ 'mpa' => $oa }, 'username');
            $user = [ $tmp->{username} ];
            $rsp->{node}->[0]->{username} = $user;
        } else {
            $rsp->{node}->[0]->{error}     = ["no mpa defined"];
            $rsp->{node}->[0]->{errorcode} = [1];
            $callback->($rsp);
            next;
        }
        if (defined($ent->{id})) {
            $rsp->{node}->[0]->{slot} = $ent->{id};
        } else {
            $rsp->{node}->[0]->{slot} = "";
        }

        $callback->($rsp);
    }
}


sub preprocess_request {
    my $request = shift;

    #if ($request->{_xcatdest}) { return [$request]; }    #exit if preprocessed
    if ((defined($request->{_xcatpreprocessed}))
        && ($request->{_xcatpreprocessed}->[0] == 1))
    {
        return [$request];
    }

    my $callback = shift;
    my @requests;

    #display usage statement if -h is present or no noderage is specified
    my $noderange = $request->{node};           #Should be arrayref
    my $command   = $request->{command}->[0];
    my $extrargs  = $request->{arg};
    my @exargs    = ($request->{arg});
    if (ref($extrargs)) {
        @exargs = @$extrargs;
    }

    my $usage_string = xCAT::Usage->parseCommand($command, @exargs);
    if ($usage_string) {
        $callback->({ data => $usage_string });
        $request = {};
        return;
    }

    if (!$noderange) {
        $usage_string = xCAT::Usage->getUsage($command);
        $callback->({ data => $usage_string });
        $request = {};
        return;
    }

    # require SOAP::Lite for hpoa.pm so we can do it dynamically
    my $soapsupport = eval { require SOAP::Lite; };
    unless ($soapsupport) {    #Still no SOAP::Lite module
        $callback->({ error => "SOAP::Lite perl module missing.  Install perl-SOAP-Lite before running HP blade commands.", errorcode => [42] });
        return [];
    }
    require xCAT::hpoa;

    #get the MMs for the nodes for the nodes in order to figure out which service nodes to send the requests to
    my $mptab = xCAT::Table->new("mp");
    unless ($mptab) {
        $callback->({ data => ["Cannot open mp table"] });
        $request = {};
        return;
    }
    my %mpa_hash = ();
    my $mptabhash = $mptab->getNodesAttribs($noderange, [ 'mpa', 'id' ]);
    if ($request->{command}->[0] eq "gethpbladecons") { #Can handle it here and now
        gethpbladecons($noderange, $callback);
        return ();
    }


    foreach my $node (@$noderange) {
        my $ent = $mptabhash->{$node}->[0]; #$mptab->getNodeAttribs($node,['mpa', 'id']);
        if (defined($ent->{mpa})) { push @{ $mpa_hash{ $ent->{mpa} }{nodes} }, $node; }
        else {
            $callback->({ data => ["no mpa defined for node $node"] });
            $request = {};
            return;
        }
        my $tempid;
        if (defined($ent->{id})) {

            #if the ide is defined, we need to see if there is a letter embedded in it. If there is,
            #then we need to convert the id to the correct slot
            $tempid = convertSlot($ent->{id});
            push @{ $mpa_hash{ $ent->{mpa} }{ids} }, $tempid;
        } else {
            push @{ $mpa_hash{ $ent->{mpa} }{ids} }, "";
        }
    }

    # find service nodes for the MMs
    # build an individual request for each service node
    my $service = "xcat";
    my @mms     = keys(%mpa_hash);
    my $sn = xCAT::ServiceNodeUtils->get_ServiceNode(\@mms, $service, "MN");

    # build each request for each service node
    foreach my $snkey (keys %$sn)
    {
        #print "snkey=$snkey\n";
        my $reqcopy = {%$request};
        $reqcopy->{'_xcatdest'} = $snkey;
        my $mms1     = $sn->{$snkey};
        my @moreinfo = ();
        my @nodes    = ();
        foreach (@$mms1) {
            push @nodes, @{ $mpa_hash{$_}{nodes} };
            push @moreinfo, "\[$_\]\[" . join(',', @{ $mpa_hash{$_}{nodes} }) . "\]\[" . join(',', @{ $mpa_hash{$_}{ids} }) . "\]";
        }
        $reqcopy->{node} = \@nodes;

        #print "nodes=@nodes\n";
        $reqcopy->{moreinfo} = \@moreinfo;
        push @requests, $reqcopy;
    }
    return \@requests;
}

sub build_more_info {
    my $noderange = shift;
    my $callback  = shift;
    my $mptab     = xCAT::Table->new("mp");
    my @moreinfo  = ();
    unless ($mptab) {
        $callback->({ data => ["Cannot open mp table"] });
        return @moreinfo;
    }
    my %mpa_hash = ();
    my $mptabhash = $mptab->getNodesAttribs($noderange, [ 'mpa', 'id' ]);
    foreach my $node (@$noderange) {
        my $ent = $mptabhash->{$node}->[0]; #$mptab->getNodeAttribs($node,['mpa', 'id']);
        if (defined($ent->{mpa})) { push @{ $mpa_hash{ $ent->{mpa} }{nodes} }, $node; }
        else {
            $callback->({ data => ["no mpa defined for node $node"] });
            return @moreinfo;
        }
        if (defined($ent->{id})) { push @{ $mpa_hash{ $ent->{mpa} }{ids} }, $ent->{id}; }
        else { push @{ $mpa_hash{ $ent->{mpa} }{ids} }, ""; }
    }

    foreach (keys %mpa_hash) {
        push @moreinfo, "\[$_\]\[" . join(',', @{ $mpa_hash{$_}{nodes} }) . "\]\[" . join(',', @{ $mpa_hash{$_}{ids} }) . "\]";

    }

    return \@moreinfo;
}

sub handle_depend {
    my $request  = shift;
    my $callback = shift;
    my $doreq    = shift;
    my $dp       = shift;
    my %node     = ();
    my $dep      = @$dp[0];
    my $dep_hash = @$dp[1];

    # send all dependencies (along w/ those dependent on nothing)
    # build moreinfo for dependencies
    my %mpa_hash = ();
    my @moreinfo = ();
    my $reqcopy  = {%$request};
    my @nodes    = ();

    foreach my $node (keys %$dep) {
        my $mpa = @{ $dep_hash->{$node} }[0];
        push @{ $mpa_hash{$mpa}{nodes} }, $node;
        push @{ $mpa_hash{$mpa}{ids} },   @{ $dep_hash->{$node} }[1];
    }
    foreach (keys %mpa_hash) {
        push @nodes, @{ $mpa_hash{$_}{nodes} };
        push @moreinfo, "\[$_\]\[" . join(',', @{ $mpa_hash{$_}{nodes} }) . "\]\[" . join(',', @{ $mpa_hash{$_}{ids} }) . "\]";
    }
    $reqcopy->{node}     = \@nodes;
    $reqcopy->{moreinfo} = \@moreinfo;
    process_request($reqcopy, $callback, $doreq, 1);

    my $start = Time::HiRes::gettimeofday();

    # build list of dependent nodes w/delays
    while (my ($name, $h) = each(%$dep)) {
        foreach (keys %$h) {
            if ($h->{$_} =~ /(^\d+$)/) {
                $node{$_} = $1 / 1000.0;
            }
        }
    }

    # send each dependent node as its delay expires
    while (%node) {
        my @noderange = ();
        my $delay     = 0.1;
        my $elapsed   = Time::HiRes::gettimeofday() - $start;

        # sort in ascending delay order
        foreach (sort { $node{$a} <=> $node{$b} } keys %node) {
            if ($elapsed < $node{$_}) {
                $delay = $node{$_} - $elapsed;
                last;
            }
            push @noderange, $_;
            delete $node{$_};
        }
        if (@noderange) {
            %mpa_hash = ();
            foreach my $node (@noderange) {
                my $mpa = @{ $dep_hash->{$node} }[0];
                push @{ $mpa_hash{$mpa}{nodes} }, $node;
                push @{ $mpa_hash{$mpa}{ids} },   @{ $dep_hash->{$node} }[1];
            }

            @moreinfo = ();
            $reqcopy  = {%$request};
            @nodes    = ();

            foreach (keys %mpa_hash) {
                push @nodes, @{ $mpa_hash{$_}{nodes} };
                push @moreinfo, "\[$_\]\[" . join(',', @{ $mpa_hash{$_}{nodes} }) . "\]\[" . join(',', @{ $mpa_hash{$_}{ids} }) . "\]";
            }
            $reqcopy->{node}     = \@nodes;
            $reqcopy->{moreinfo} = \@moreinfo;

            # clear global hash variable
            %oahash = ();
            process_request($reqcopy, $callback, $doreq, 1);
        }

        # millisecond sleep
        Time::HiRes::sleep($delay);
    }
    return 0;
}

sub build_depend {
    my $noderange = shift;
    my $exargs    = shift;
    my $depstab   = xCAT::Table->new('deps');
    my $mptab     = xCAT::Table->new('mp');
    my %dp        = ();
    my %no_dp     = ();
    my %mpa_hash;

    if (!defined($depstab)) {
        return ([ \%dp ]);
    }
    unless ($mptab) {
        return ("Cannot open mp table");
    }

    my $depset = $depstab->getNodesAttribs($noderange, [qw(nodedep msdelay cmd)]);
    foreach my $node (@$noderange) {
        my $delay = 0;
        my $dep;

        my @ent = @{ $depset->{$node} }; #$depstab->getNodeAttribs($node,[qw(nodedep msdelay cmd)]);
        foreach my $h (@ent) {
            if (grep(/^@$exargs[0]$/, split /,/, $h->{cmd})) {
                if (exists($h->{nodedep})) { $dep   = $h->{nodedep}; }
                if (exists($h->{msdelay})) { $delay = $h->{msdelay}; }
                last;
            }
        }
        if (!defined($dep)) {
            $no_dp{$node} = 1;
        }
        else {
            foreach my $n (split /,/, $dep) {
                if (!grep(/^$n$/, @$noderange)) {
                    return ("Missing dependency on command-line: $node -> $n");
                } elsif ($n eq $node) {
                    next;    # ignore multiple levels
                }
                $dp{$n}{$node} = $delay;
            }
        }
    }

    # if there are dependencies, add any non-dependent nodes
    if (scalar(%dp)) {
        foreach (keys %no_dp) {
            if (!exists($dp{$_})) {
                $dp{$_}{$_} = -1;
            }
        }

        # build hash of all nodes in preprocess_request() format
        my @namelist = keys %dp;
        my $mphash = $mptab->getNodesAttribs(\@namelist, [ 'mpa', 'id' ]);
        while (my ($name, $h) = each(%dp)) {
            my $ent = $mphash->{$name}->[0]; #$mptab->getNodeAttribs($name,['mpa', 'id']);
            if (!defined($ent->{mpa})) {
                return ("no mpa defined for node $name");
            }
            my $id = (defined($ent->{id})) ? $ent->{id} : "";
            push @{ $mpa_hash{$name} }, $ent->{mpa};
            push @{ $mpa_hash{$name} }, $id;

            @namelist = keys %$h;
            my $mpsubhash = $mptab->getNodesAttribs(\@namelist, [ 'mpa', 'id' ]);
            foreach (keys %$h) {
                if ($h->{$_} =~ /(^\d+$)/) {
                    my $ent = $mpsubhash->{$_}->[0]; #$mptab->getNodeAttribs($_,['mpa', 'id']);
                    if (!defined($ent->{mpa})) {
                        return ("no mpa defined for node $_");
                    }
                    my $id = (defined($ent->{id})) ? $ent->{id} : "";
                    push @{ $mpa_hash{$_} }, $ent->{mpa};
                    push @{ $mpa_hash{$_} }, $id;
                }
            }
        }
    }
    return ([ \%dp, \%mpa_hash ]);
}


sub process_request {
    $SIG{INT} = $SIG{TERM} = sub {
        foreach (keys %mm_comm_pids) {
            kill 2, $_;
        }
        exit 0;
    };

    my $request   = shift;
    my $callback  = shift;
    my $doreq     = shift;
    my $level     = shift;
    my $noderange = $request->{node};
    my $command   = $request->{command}->[0];
    my @exargs;
    unless ($command) {
        return;    #Empty request
    }

    # require SOAP::Lite for hpoa.pm so we can do it dynamically
    my $soapsupport = eval { require SOAP::Lite; };
    unless ($soapsupport) {    #Still no SOAP::Lite module
        $callback->({ error => "SOAP::Lite perl module missing.  Install perl-SOAP-Lite before running HP blade commands.", errorcode => [42] });
        return [];
    }
    require xCAT::hpoa;

    if (ref($request->{arg})) {
        @exargs = @{ $request->{arg} };
    } else {
        @exargs = ($request->{arg});
    }

    my $moreinfo;
    if ($request->{moreinfo}) { $moreinfo = $request->{moreinfo}; }
    else { $moreinfo = build_more_info($noderange, $callback); }

    #pdu commands will be handled in the pdu plugin
    if ($command eq "rpower" and grep(/^pduon|pduoff|pdureset|pdustat$/, @exargs)) {
        return;
    }

    if ($command eq "rpower" and grep(/^on|off|boot|reset|cycle$/, @exargs)) {

        if (my ($index) = grep($exargs[$_] =~ /^--nodeps$/, 0 .. $#exargs)) {
            splice(@exargs, $index, 1);
        } else {

            # handles 1 level of dependencies only
            if (!defined($level)) {
                my $dep = build_depend($noderange, \@exargs);
                if (ref($dep) ne 'ARRAY') {
                    $callback->({ data => [$dep], errorcode => 1 });
                    return;
                }
                if (scalar(%{ @$dep[0] })) {
                    handle_depend($request, $callback, $doreq, $dep);
                    return 0;
                }
            }
        }
    }

    # only 1 node when changing textid to something other than '*'
    if ($command eq "rspconfig" and grep(/^textid=[^*]/, @exargs)) {
        if (@$noderange > 1) {
            $callback->({ data => ["Single node required when changing textid"],
                    errorcode => 1 });
            return;
        }
    }
    my $bladeuser = 'USERID';
    my $bladepass = 'PASSW0RD';
    my $blademaxp = 64;

    #my $sitetab = xCAT::Table->new('site');
    my $mpatab = xCAT::Table->new('mpa');
    my $mptab  = xCAT::Table->new('mp');
    my $tmp;

    #if ($sitetab) {
    #($tmp)=$sitetab->getAttribs({'key'=>'blademaxp'},'value');
    my @entries = xCAT::TableUtils->get_site_attribute("blademaxp");
    my $t_entry = $entries[0];
    if (defined($t_entry)) { $blademaxp = $t_entry; }

    #}
    my $passtab = xCAT::Table->new('passwd');
    if ($passtab) {
        ($tmp) = $passtab->getAttribs({ 'key' => 'blade' }, 'username', 'password');
        if (defined($tmp)) {
            $bladeuser = $tmp->{username};
            $bladepass = $tmp->{password};
        }
    }
    if ($request->{command}->[0] eq "findme") {
        if (defined($request->{discoverymethod}) and defined($request->{discoverymethod}->[0]) and ($request->{discoverymethod}->[0] ne 'undef')) {

            # The findme request had been processed by other module, just return
            return;
        }
        my $mptab = xCAT::Table->new("mp");
        unless ($mptab) { return 2; }
        my @bladents = $mptab->getAllNodeAttribs([qw(node)]);
        my @blades;
        foreach (@bladents) {
            push @blades, $_->{node};
        }
        my %invreq;
        $invreq{node}    = \@blades;
        $invreq{arg}     = ['mac'];
        $invreq{command} = ['rinv'];
        my $mac;
        my $ip = $request->{'_xcat_clientip'};
        my $arptable;

        if (-x "/usr/sbin/arp") {
            $arptable = `/usr/sbin/arp -n`;
        }
        else {
            $arptable = `/sbin/arp -n`;
        }
        my @arpents = split /\n/, $arptable;
        foreach (@arpents) {
            if (m/^($ip)\s+\S+\s+(\S+)\s/) {
                $mac = $2;
                last;
            }
        }
        unless ($mac) { return }

        #Only refresh the the cache when the request permits and no useful answer
        if ($macmaptimestamp < (time() - 300)) { #after five minutes, invalidate cache
            %macmap = ();
        }

        unless ($request->{cacheonly}->[0] or $macmap{$mac} or $macmaptimestamp > (time() - 20)) { #do not refresh cache if requested not to, if it has an entry, or is recent
            %macmap          = ();
            $macmaptimestamp = time();
            foreach (@{ preprocess_request(\%invreq, \&fillresps) }) {
                %invreq = %$_;
                process_request(\%invreq, \&fillresps);
            }
        }
        unless ($macmap{$mac}) {
            xCAT::MsgUtils->message("S", "xcat.discovery.hpblade: ($request->{_xcat_clientmac}->[0]) Warning: Could not find any nodes using hpblade-based discovery");
            return 1;    #failure
        }

        # The discovered command will update mac table, no need to update here
        #my $mactab = xCAT::Table->new('mac',-create=>1);
        #$mactab->setNodeAttribs($macmap{$mac},{mac=>$mac});
        #$mactab->close();
        #my %request = (
        #  command => ['makedhcp'],
        #  node => [$macmap{$mac}]
        #  );
        #$doreq->(\%request);
        xCAT::MsgUtils->message("S", "xcat.discovery.hpblade: ($request->{_xcat_clientmac}->[0]) Found node: $macmap{$mac}");
        my $req = {%$request};
        $req->{command}   = ['discovered'];
        $req->{noderange} = [ $macmap{$mac} ];
        if (defined($req->{error})) {
            $request->{error}->[0] = '1';
            $request->{error_msg}->[0] = $req->{error_msg}->[0];
        }
        $doreq->($req);
        %{$req} = ();    #Clear request. it is done
                         #undef $mactab;
        return 0;
    }


    my $children = 0;
    $SIG{CHLD} = sub { my $cpid; while ($cpid = waitpid(-1, WNOHANG) > 0) { delete $mm_comm_pids{$cpid}; $children--; } };
    my $inputs = new IO::Select;
    foreach my $info (@$moreinfo) {
        $info =~ /^\[(.*)\]\[(.*)\]\[(.*)\]/;
        my $mpa   = $1;
        my @nodes = split(',', $2);
        my @ids   = split(',', $3);

        #print "mpa=$mpa, nodes=@nodes, ids=@ids\n";
        my $user = $bladeuser;
        my $pass = $bladepass;
        my $ent;
        if (defined($mpatab)) {
            ($ent) = $mpatab->getAttribs({ 'mpa' => $mpa }, 'username', 'password');
            if (defined($ent->{password})) { $pass = $ent->{password}; }
            if (defined($ent->{username})) { $user = $ent->{username}; }
        }
        $oahash{$mpa}->{username} = $user;
        $oahash{$mpa}->{password} = $pass;
        for (my $i = 0 ; $i < @nodes ; $i++) {
            my $node   = $nodes[$i];
            my $nodeid = $ids[$i];
            $oahash{$mpa}->{nodes}->{$node} = $nodeid;


        }
    }
    my $sub_fds = new IO::Select;
    foreach $oa (sort (keys %oahash)) {
        while ($children > $blademaxp) { forward_data($callback, $sub_fds); }
        $children++;
        my $cfd;
        my $pfd;
        socketpair($pfd, $cfd, AF_UNIX, SOCK_STREAM, PF_UNSPEC) or die "socketpair: $!";
        $cfd->autoflush(1);
        $pfd->autoflush(1);
        my $cpid = xCAT::Utils->xfork;
        unless (defined($cpid)) { die "Fork error"; }

        unless ($cpid) {
            close($cfd);
            eval {
                doblade($pfd, $oa, \%oahash, $command, -args => \@exargs);
                exit(0);
            };
            if ($@) { die "$@"; }
            die "blade plugin encountered a general error while communication with $oa";
        }
        $mm_comm_pids{$cpid} = 1;
        close($pfd);
        $sub_fds->add($cfd);
    }
    while ($sub_fds->count > 0 or $children > 0) {
        forward_data($callback, $sub_fds);
    }
    while (forward_data($callback, $sub_fds)) { }
}

my $IMPORT_SSH_KEY_HEADER = '
<LOCFGVERSION="2.21"/>
<RIBCL VERSION="2.0">
<LOGIN USER_LOGIN="AdMiNnAmE" PASSWORD="PaSsWoRd">
<RIB_INFO MODE="write">
<IMPORT_SSH_KEY>
-----BEGIN SSH KEY-----
';

my $IMPORT_SSH_KEY_FOOTER = '
-----END SSH KEY-----
</IMPORT_SSH_KEY>
</RIB_INFO>
</LOGIN>
</RIBCL>';

my $MOD_NETWORK_SETTINGS_HEADER = '
<LOCFGVERSION="2.21"/>
<RIBCL VERSION="2.0">
<LOGIN USER_LOGIN="AdMiNnAmE" PASSWORD="PaSsWoRd">
<RIB_INFO MODE="write">
<MOD_NETWORK_SETTINGS>
';

my $MOD_NETWORK_SETTINGS_FOOTER = '
</MOD_NETWORK_SETTINGS>
</RIB_INFO>
<LOGIN>
</RIBCL>';

my $GET_NETWORK_SETTINGS = '
<LOCFGVERSION="2.21"/>
<RIBCL VERSION="2.0">
<LOGIN USER_LOGIN="AdMiNnAmE" PASSWORD="PaSsWoRd">
<RIB_INFO MODE="read">
<GET_NETWORK_SETTINGS/>
</RIB_INFO>
</LOGIN>
</RIBCL>';


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));
    Net::SSLeay::connect($ssl) and die_if_ssl_error("ERROR: ssl connect");

    #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;
}

# 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";
            }
        }
    }
    print "READ: $lastreply\n" if $globalDebug;
    if ($lastreply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>/) {
        if ($1 eq "0x0000") {

            #Sprint STDERR "$3\n" if $3;
        } else {
            $reply2return = "ERROR: STATUS: $1, MESSAGE: $2";
        }
    }

    closeSSLconnection($ssl);
    return $reply2return;
}

sub extractValue {
    my $inputString = shift;
    my $testString  = shift;

    $testString = "<" . "$testString" . " VALUE=";

    my $start = index($inputString, $testString) + length $testString;
    my $end = index $inputString, "\"", ($start + 1);
    return (substr($inputString, ($start + 1), ($end - $start - 1)));
}



sub iloconfig {

    my $oa     = shift;
    my $user   = shift;
    my $pass   = shift;
    my $node   = shift;
    my $nodeid = shift;
    my $parameter;
    my $value;
    my $assignment;
    my $returncode = 0;
    my $textid     = 0;
    @cfgtext = ();

    # Before we get going, lets get the info on the MP (iLO)
    $slot = convertSlot($nodeid);
    my $mpInfoResp = $hpoa->getBladeMpInfo("bayNumber" => $slot);
    if ($mpInfoResp->fault) {
        my $errorText = "Error getting MP info";
        next;
    }
    my $ipaddress = $mpInfoResp->result->{ipAddress};

    foreach $parameter (@_) {
        $assignment = 0;
        $value      = undef;
        if ($parameter =~ /=/) {
            $assignment = 1;
            ($parameter, $value) = split /=/, $parameter, 2;
        }
        if ($parameter =~ /^sshcfg$/) {
            my $fname = "/root/.ssh/id_dsa.pub";
            if (!-s $fname) {

                # Key file specified does not exist. Error!
                push @cfgtext, "rspconfig:key file does not exist";
                next;
            }
            open(KEY, "$fname");
            my $key = readline(KEY);
            close(KEY);
            my $script = "$IMPORT_SSH_KEY_HEADER" . "$key" . "$IMPORT_SSH_KEY_FOOTER";
            $script =~ s/AdMiNnAmE/$user/;
            $script =~ s/PaSsWoRd/$pass/;
            my $reply = sendScript($ipaddress, $script);
            push @cfgtext, $reply;
            next;
        }
        if ($parameter =~ /^network$/) {
            if ($value) {

                # If value is set, then the user wans us to set these values
                my ($newip, $newhostname, $newgateway, $newmask) = split /,/, $value;
                my $script = "$MOD_NETWORK_SETTINGS_HEADER";
                $script = $script . "<IP_ADDRESS VALUE=\"$newip\"\/>" if ($newip);
                $script = $script . "<GATEWAY_IP_ADDRESS VALUE=\"$newgateway\"\/>" if ($newgateway);
                $script = $script . "<SUBNET_MASK VALUE=\"$newmask\"\/>" if ($newmask);
                $script = $script . "$MOD_NETWORK_SETTINGS_FOOTER";
                $script =~ s/AdMiNnAmE/$user/;
                $script =~ s/PaSsWoRd/$pass/;
                my $reply = sendScript($ipaddress, $script);
                if ($newip)      { push @cfgtext, "iLO IP: $newip"; }
                if ($newgateway) { push @cfgtext, "Gateway: $newgateway"; }
                if ($newmask)    { push @cfgtext, "Subnet Mask: $newmask"; }
                push @cfgtext, $reply;

            } else {
                my $script = "$GET_NETWORK_SETTINGS";
                $script =~ s/AdMiNnAmE/$user/;
                $script =~ s/PaSsWoRd/$pass/;
                my $reply = sendScript($ipaddress, $script);
                my $readipaddress = extractValue($reply, "IP_ADDRESS");
                my $gateway       = extractValue($reply, "GATEWAY_IP_ADDRESS");
                my $netmask       = extractValue($reply, "SUBNET_MASK");
                push @cfgtext, "iLO IP: $readipaddress";
                push @cfgtext, "Gateway: $gateway";
                push @cfgtext, "Subnet mask: $netmask";
                push @cfgtext, $reply;
            }
        }
    }
    return 0, @cfgtext;
}

sub getmacs
{
    (my $code, my @macs) = inv('mac');
    my $mkey;
    my $nic2Find;
    my $nrtab = xCAT::Table->new('noderes');
    if ($nrtab) {
        my $nent = $nrtab->getNodeAttribs($curn, [ 'primarynic', 'installnic' ]);
        if ($nent) {
            if (defined $nent->{installnic}) {    #Prefer the install nic
                $mkey = "installnic";
            } elsif (defined $nent->{primarynic}) {  #see if primary nic was set
                $mkey = "primarynic";
            }
            $nic2Find = $nent->{$mkey};
        }
    }

    # We now have the nic2Find, so we need to convert this to the NIC format
    # Strip away the "eth"
    my $interface = $nic2Find;
    $nic2Find =~ s/eth//;
    my $numberPxeNic = $nic2Find + 1;
    my $pxeNic       = "NIC " . $numberPxeNic;

    if ($code == 0) {
        my $mac;
        my @allmacs;
        foreach my $macEntry (@macs) {
            if ($macEntry =~ /MAC ADDRESS $pxeNic/) {
                $mac = $macEntry;
                $mac =~ s/MAC ADDRESS $pxeNic: //;
                $mac = lc $mac;
                last;
            }
        }
        if (!$mac) {
            return 1, "Unable to retrieve MAC address for interface $pxeNic from OnBoard Administrator";
        }

        my $mactab = xCAT::Table->new('mac', -create => 1);
        $mactab->setNodeAttribs($curn, { mac => $mac }, { interface => $interface });
        $mactab->close;
        return 0, ":mac.mac set to $mac";
    } else {
        return $code, $macs[0];
    }
}

sub inv {
    my @invitems;
    my @output;
    foreach (@_) {
        push @invitems, split(/,/, $_);
    }
    my $item;
    unless (scalar(@invitems)) {
        @invitems = ("all");
    }

    # Before going off to handle the items, issue a getBladeInfo, getBladeMpInfo, and getOaInfo
    my $getBladeInfoResult = $hpoa->getBladeInfo("bayNumber" => $slot);
    if ($getBladeInfoResult->fault) {
        return (1, "getBladeInfo on node $curn failed");
    }
    my $getBladeMpInfoResult = $hpoa->getBladeMpInfo("bayNumber" => $slot);
    if ($getBladeMpInfoResult->fault) {
        return (1, "getBladeMpInfo on node $curn fault");
    }
    my $getOaInfoResult = $hpoa->getOaInfo("bayNumber" => $activeOABay);
    if ($getOaInfoResult->fault) {
        my $errHash = $getOaInfoResult->fault;
        return (1, "getOaInfo failed");
    }

    while (my $item = shift @invitems) {
        if ($item =~ /^all/) {
            push @invitems, (qw(mtm serial mac firm));
            next;
        }

        if ($item =~ /^firm/) {
            push @invitems, (qw(bladerom mprom oarom));
        }
        if ($item =~ /^bladerom/) {
            push @output, "BladeFW: " . $getBladeInfoResult->result->{romVersion};
        }
        if ($item =~ /^mprom/) {
            push @output, "iLOFW: " . $getBladeMpInfoResult->result->{fwVersion};
        }
        if ($item =~ /~oarom/) {
            push @output, "OA FW: " . $getOaInfoResult->result->{fwVersion};
        }

        if ($item =~ /^model/ or $item =~ /^mtm/) {
            push @output, "Machine Type/Model: " . $getBladeInfoResult->result->{partNumber};
        }
        if ($item =~ /^serial/) {
            push @output, "Serial Number: " . $getBladeInfoResult->result->{serialNumber};
        }
        if ($item =~ /^mac/) {
            my $numberOfNics = $getBladeInfoResult->result->{numberOfNics};
            for (my $i = 0 ; $i < $numberOfNics ; $i++) {
                my $mac = $getBladeInfoResult->result->{nics}->{bladeNicInfo}[$i]->{macAddress};
                my $port = $getBladeInfoResult->result->{nics}->{bladeNicInfo}[$i]->{port};
                push @output, "MAC ADDRESS " . $port . ": " . $mac;

                #push@output, "MAC Address ".($_+1).": ".$getBladeInfoResult->result->{nics}->{bladeNicInfo}[$i]->{macAddress};
            }
        }
    }
    return (0, @output);
}


sub CtoF {
    my $Ctemp = shift;
    return ((($Ctemp * 9) / 5) + 32);
}

my %chassiswidevitals;

sub vitals {
    my @output;
    my $tmp;
    my @vitems;

    if ($#_ == 0 && $_[0] eq '') { pop @_; push @_, "all" } #-- default is all if no argument given

    if (defined $slot and $slot > 0) {                      #-- blade query
        foreach (@_) {
            if ($_ eq 'all') {

                # push @vitems,qw(temp voltage wattage summary fan);
                push @vitems, qw(cpu_temp memory_temp system_temp ambient_temp summary fanspeed);
                push @vitems, qw(led power);
            } elsif ($_ =~ '^led') {
                push @vitems, qw(led);
            } else {
                push @vitems, split(/,/, $_);
            }
        }
    } else {    #-- chassis query
        foreach (@_) {
            if ($_ eq 'all') {

                # push @vitems,qw(voltage wattage power summary);
                push @vitems, qw(cpu_temp memory_temp system_temp ambient_temp summary fanspeed);

                # push @vitems,qw(errorled beaconled infoled templed);
                push @vitems, qw(led power);
            } elsif ($_ =~ '^led') {
                push @vitems, qw(led);
            } elsif ($_ =~ '^cool') {
                push @vitems, qw(fanspeed);
            } elsif ($_ =~ '^temp') {
                push @vitems, qw(ambient_temp);
            } else {
                push @vitems, split(/,/, $_);
            }
        }
    }

    my @vitals;
    if (defined $slot and $slot > 0) {    #-- querying some blade
        if (grep /temp/, @vitems) {
            my $tempResponse = $hpoa->getBladeThermalInfoArray("bayNumber" => $slot);

            if ($tempResponse->fault) {
                push @output, "Request to get Temperature info on slot $slot failed";
            }
            elsif (!$tempResponse->result) {

                # If is the case then the temperature data is not yet available.
                push @output, "Temperature data not available.";
            } else {

                # We have data so go process it....
                my @tempdata = $tempResponse->result->{bladeThermalInfo};
                my $lastElement = $tempResponse->result->{bladeThermalInfo}[-1]->{sensorNumber};
                if (grep /cpu_temp/, @vitems) {
                    my $index = -1;
                    do {
                        $index++;
                        if (grep /CPU/, $tempResponse->result->{bladeThermalInfo}[$index]->{description}) {
                            my $Ctemp = $tempResponse->result->{bladeThermalInfo}[$index]->{temperatureC};
                            my $desc = $tempResponse->result->{bladeThermalInfo}[$index]->{description};
                            my $Ftemp = CtoF($Ctemp);
                            push @output, "$desc Temperature: $Ctemp C \( $Ftemp F \)";
                        }
                    } until $tempResponse->result->{bladeThermalInfo}[$index]->{sensorNumber} eq $lastElement;
                }
                if (grep /memory_temp/, @vitems) {
                    my $index = -1;
                    do {
                        $index++;
                        if (grep /Memory/, $tempResponse->result->{bladeThermalInfo}[$index]->{description}) {
                            my $Ctemp = $tempResponse->result->{bladeThermalInfo}[$index]->{temperatureC};
                            my $desc = $tempResponse->result->{bladeThermalInfo}[$index]->{description};
                            my $Ftemp = CtoF($Ctemp);
                            push @output, "$desc Temperature: $Ctemp C \( $Ftemp F \)";
                        }
                    } until $tempResponse->result->{bladeThermalInfo}[$index]->{sensorNumber} eq $lastElement;
                }
                if (grep /system_temp/, @vitems) {
                    my $index = -1;
                    do {
                        $index++;
                        if (grep /System/, $tempResponse->result->{bladeThermalInfo}[$index]->{description}) {
                            my $Ctemp = $tempResponse->result->{bladeThermalInfo}[$index]->{temperatureC};
                            my $desc = $tempResponse->result->{bladeThermalInfo}[$index]->{description};
                            my $Ftemp = CtoF($Ctemp);
                            push @output, "$desc Temperature: $Ctemp C \( $Ftemp F \)";
                        }
                    } until $tempResponse->result->{bladeThermalInfo}[$index]->{sensorNumber} eq $lastElement;
                }
                if (grep /ambient_temp/, @vitems) {
                    my $index = -1;
                    do {
                        $index++;
                        if (grep /Ambient/, $tempResponse->result->{bladeThermalInfo}[$index]->{description}) {
                            my $Ctemp = $tempResponse->result->{bladeThermalInfo}[$index]->{temperatureC};
                            my $desc = $tempResponse->result->{bladeThermalInfo}[$index]->{description};
                            my $Ftemp = CtoF($Ctemp);
                            push @output, "$desc Temperature: $Ctemp C \( $Ftemp F \)";
                        }
                    } until $tempResponse->result->{bladeThermalInfo}[$index]->{sensorNumber} eq $lastElement;
                }
            }
        }

        if (grep /fanspeed/, @vitems) {
            my $fanInfoResponse = $hpoa->getFanInfo("bayNumber" => $slot);
            if ($fanInfoResponse->fault) {
                push @output, "Request to get Fan Info from slot $slot failed ";
            } elsif (!$fanInfoResponse->result) {
                push @output, "No Fan Information";
            } else {
                my $fanStatus  = $fanInfoResponse->result->{operationalStatus};
                my $fanMax     = $fanInfoResponse->result->{maxFanSpeed};
                my $fanCur     = $fanInfoResponse->result->{fanSpeed};
                my $fanPercent = ($fanCur / $fanMax) * 100;
                push @output, "Fan status: $fanStatus  Percent of max: $fanPercent\%";
            }
        }

        if (grep /led/, @vitems) {
            my $currstat = $getBladeStatusResponse->result->{uid};

            if ($currstat eq "UID_ON") {
                push @output, "Current UID Status On";
            } elsif ($currstat eq "UID_OFF") {
                push @output, "Current UID Status Off";
            } elsif ($currstat eq "UID_BLINK") {
                push @output, "Current UID Status Blinking";
            }
        }

        if (grep /power/, @vitems) {
            my $currPowerStat = $getBladeStatusResponse->result->{powered};
            if ($currPowerStat eq "POWER_ON") {
                push @output, "Current Power Status On";
            } elsif ($currPowerStat eq "POWER_OFF") {
                push @output, "Current Power Status Off";
            }
        }
    }
    return (0, @output);
}

sub buildEventHash {
    my $logText       = shift;
    my $eventLogFound = 0;
    my $eventFound    = 0;
    my $eventNumber   = 0;

    my @lines = split /^/, $logText;
    foreach my $line (@lines) {
        if (!$eventLogFound) {
            if (!$line =~ m/EVENT_LOG/) {
                next;
            } elsif ($line =~ m/EVENT_LOG/) {
                $eventLogFound = 1;
                next;
            }
        }

        if (!$eventFound && $line =~ m/\<EVENT/) {
            $eventFound = 1;
            next;
        } elsif ($eventFound && $line =~ m/\/\>/) {
            $eventNumber++;
            $eventFound = 0;
            next;
        }

        # We have a good line. Need to split it up and build the hash.
        my ($desc, $value) = split /=/, $line;
        for ($desc) {
            s/^\s+//;
            s/\s+$//;
            s/\"//g;
            s/\\n//;
        }
        for ($value) {
            s/^\s+//;
            s/\"//g;
            s/\s+$//;
            s/\\n//;
        }
        $eventHash->{event}->{$eventNumber}->{$desc} = $value;
        next;
    }
    return $eventNumber;
}

sub eventlog {
    my $subcommand = shift;

    my @output;

    $subcommand = "all" if $subcommand eq "";

    if ($subcommand eq "all" or $subcommand =~ /\d+/) {
        my $mpEventLogResponse = $hpoa->getBladeMpEventLog("bayNumber" => $slot, "maxsize" => 640000);
        if ($mpEventLogResponse->fault) {
            return (1, "Attempt to retrieve Event Log faulted");
        }
        my $logText   = $mpEventLogResponse->result->{logContents};
        my $numEvents = buildEventHash($logText);

        my $recCount = 0;
        $eventHash->{'event'} = {
            map {
                $recCount++ => $_->[1]
              } sort {
                $a->[0] <=> $b->[0]
              } map {
                (defined $_->{LAST_UPDATE} && $_->{LAST_UPDATE} ne '[NOT SET]')
                  ? [ &extractDate($_->{LAST_UPDATE}), $_ ]
                  : [ $_->{SELID}, $_ ]
              } map {
                $eventHash->{'event'}{$_}{SELID} = $_;
                $eventHash->{'event'}{$_};
              } grep {
                defined $eventHash->{'event'}{$_}
              } keys %{ $eventHash->{'event'} }
        };

        my $limitEvents = ($subcommand eq "all" ? $recCount : $subcommand);

        for (my $index = 0 ; $index < $limitEvents ; $index++) {
            --$recCount;

            my $class    = $eventHash->{event}->{$recCount}->{CLASS};
            my $severity = $eventHash->{event}->{$recCount}->{SEVERITY};
            my $dateTime = $eventHash->{event}->{$recCount}->{LAST_UPDATE};
            my $desc     = $eventHash->{event}->{$recCount}->{DESCRIPTION};
            unshift @output, "$class $severity:$dateTime $desc";
        }
        return (0, @output);
    } elsif ($subcommand eq "clear") {
        return (1, "Command not supported");
    } else {
        return (1, "Command '$subcommand' not supported");
    }
}


sub rscan {
    my $args = shift;
    my @values;
    my $result;
    my %opt;

    @ARGV                     = @$args;
    $Getopt::Long::ignorecase = 0;
    Getopt::Long::Configure("bundling");

    local *usage = sub {
        my $usage_string = xCAT::Usage->getUsage("rscan");
        return (join('', ($_[0], $usage_string)));
    };

    if (!GetOptions(\%opt, qw(V|Verbose w x z))) {
        return (1, usage());
    }
    if (defined($ARGV[0])) {
        return (1, usage("Invalid argument: @ARGV\n"));
    }
    if (exists($opt{x}) and exists($opt{z})) {
        return (1, usage("-x and -z are mutually exclusive\n"));
    }

    my $encInfo = $hpoa->getEnclosureInfo();
    if ($encInfo->fault) {
        return (1, "Attempt tp get enclosure information has failed");
    }

    my $numBays = $encInfo->result->{bladeBays};
    my $calcBladeBays = $numBays * 3;    # Need to worry aboyt casmir blades

    my $encName   = $encInfo->result->{enclosureName};
    my $enctype   = $encInfo->result->{name};
    my $encmodel  = $encInfo->result->{partNumber};
    my $encserial = $encInfo->result->{serialNumber};

    push @values, join(",", "hpoa", $encName, 0, "$enctype-$encmodel", $encserial, $oa);
    my $max = length($encName);

    for (my $i = 1 ; $i <= $calcBladeBays ; $i++) {
        my $bayInfo = $hpoa->getBladeInfo("bayNumber" => $i);
        if ($bayInfo->fault) {
            return (1, "Attempt to get blade info from bay $i has failed");
        }
        if ($bayInfo->result->{presence} eq "ABSENT") {

            # no blade in the bya
            next;
        }

        my $name   = $bayInfo->result->{serverName};
        my $bayNum = $i;
        my $type   = $bayInfo->result->{bladeType};
        my $model  = $bayInfo->result->{name};
        my $serial = $bayInfo->result->{serialNumber};

        push @values, join(",", "hpblade", $name, $bayNum, "$type-$model", $serial, "");
    }

    my $format = sprintf "%%-%ds", ($max + 2);
    $rscan_header[1][1] = $format;

    if (exists($opt{x})) {
        $result = rscan_xml($oa, \@values);
    }
    elsif (exists($opt{z})) {
        $result = rscan_stanza($oa, \@values);
    }
    else {
        foreach (@rscan_header) {
            $result .= sprintf @$_[1], @$_[0];
        }
        foreach (@values) {
            my @data = split /,/;
            my $i    = 0;

            foreach (@rscan_header) {
                $result .= sprintf @$_[1], $data[ $i++ ];
            }
        }
    }
    if (!exists($opt{w})) {
        return (0, $result);
    }
    my @tabs = qw(mp nodehm nodelist);
    my %db   = ();

    foreach (@tabs) {
        $db{$_} = xCAT::Table->new($_, -create => 1, -autocommit => 0);
        if (!$db{$_}) {
            return (1, "Error opening '$_'");
        }
    }
    foreach (@values) {
        my @data = split /,/;
        my $name = $data[1];

        my ($k1, $u1);
        $k1->{node} = $name;
        $u1->{mpa}  = $oa;
        $u1->{id}   = $data[2];
        $db{mp}->setAttribs($k1, $u1);
        $db{mp}{commit} = 1;

        my ($k2, $u2);
        $k2->{node} = $name;
        $u2->{mgt}  = "hpblade";
        $db{nodehm}->setAttribs($k2, $u2);
        $db{nodehm}{commit} = 1;

        my ($k3, $u3);
        $k3->{node}   = $name;
        $u3->{groups} = "blade,all";
        $db{nodelist}->setAttribs($k3, $u3);
        $db{nodelist}{commit} = 1;
    }
    foreach (@tabs) {
        if (exists($db{$_}{commit})) {
            $db{$_}->commit;
        }
    }
    return (0, $result);
}

sub rscan_xml {

    my $mpa    = shift;
    my $values = shift;
    my $xml;

    foreach (@$values) {
        my @data = split /,/;
        my $i    = 0;

        my $href = {
            Node => {}
        };
        foreach (@rscan_attribs) {
            my $d    = $data[ $i++ ];
            my $type = $data[0];

            if (/^name$/) {
                next;
            } elsif (/^nodetype$/) {
                $d = $type;
            } elsif (/^groups$/) {
                $d = "$type,all";
            } elsif (/^mgt$/) {
                $d = "blade";
            } elsif (/^mpa$/) {
                $d = $mpa;
            }
            $href->{Node}->{$_} = $d;
        }
        $xml .= XMLout($href, NoAttr => 1, KeyAttr => [], RootName => undef);
    }
    return ($xml);
}

sub rscan_stanza {

    my $mpa    = shift;
    my $values = shift;
    my $result;

    foreach (@$values) {
        my @data = split /,/;
        my $i    = 0;
        my $type = $data[0];
        $result .= "$data[1]:\n\tobjtype=node\n";

        foreach (@rscan_attribs) {
            my $d = $data[ $i++ ];

            if (/^name$/) {
                next;
            } elsif (/^nodetype$/) {
                $d = $type;
            } elsif (/^groups$/) {
                $d = "$type,all";
            } elsif (/^mgt$/) {
                $d = "blade";
            } elsif (/^mpa$/) {
                $d = $mpa;
            }
            $result .= "\t$_=$d\n";
        }
    }
    return ($result);
}




sub beacon {
    my $subcommand = shift;

    if ($subcommand eq "stat") {
        my $currstat = $getBladeStatusResponse->result->{uid};
        if ($currstat eq "UID_ON") {
            return (0, "on");
        } elsif ($currstat eq "UID_OFF") {
            return (0, "off");
        } elsif ($currstat eq "UID_BLINK") {
            return (0, "blink");
        }
    }
    my $response;
    if ($subcommand eq "on") {
        $response = $hpoa->setBladeUid('bayNumber' => $slot, 'uid' => "UID_CMD_ON");
        if ($response->fault) {
            my $errHash = $response->fault;
            my $result  = $response->oaErrorText;
            print "result is $result \n";
            return ("1", "Uid On failed");
        } else {
            return ("0", "");
        }
    } elsif ($subcommand eq "off") {
        $response = $hpoa->setBladeUid('bayNumber' => $slot, 'uid' => "UID_CMD_OFF");
        if ($response->fault) {
            my $errHash = $response->fault;
            my $result  = $response->oaErrorText;
            print "result is $result \n";
            return ("1", "Uid Off failed");
        } else {
            return ("0", "");
        }
    } elsif ($subcommand eq "blink") {
        $response = $hpoa->setBladeUid('bayNumber' => $slot, 'uid' => "UID_CMD_BLINK");
        if ($response->fault) {
            my $errHash = $response->fault;
            my $result  = $response->oaErrorText;
            print "result is $result \n";
            return ("1", "Uid Blink failed");
        } else {
            return ("0", "");
        }
    } else {
        return (1, "subcommand unsupported");
    }

    return (1, "subcommand unsupported");
}

sub bootseq {
    my @args = @_;
    my $data;
    my @order = ();

    if ($args[0] eq "list" or $args[0] eq "stat") {

        # Before going off to handle the items, issue a getBladeInfo and getOaInfo
        my $getBladeBootInfoResult = $hpoa->getBladeBootInfo("bayNumber" => $slot);
        if ($getBladeBootInfoResult->fault) {
            return (1, "getBladeBootInfo on node $curn failed");
        }

        # Go through the the IPL Array from the last call to GetBladeStatus
        my $numberOfIpls = $getBladeBootInfoResult->result->{numberOfIpls};
        foreach (my $i = 0 ; $i < $numberOfIpls ; $i++) {
            foreach (my $j = 0 ; $j <= 7 ; $j++) {
                if ($getBladeBootInfoResult->result->{ipls}->{ipl}[$j]->{bootPriority} eq ($i + 1)) {
                    push(@order, $getBladeBootInfoResult->result->{ipls}->{ipl}[$j]->{iplDevice});
                    last;
                }
            }
        }

        return (0, lc join(',', @order));
    } else {
        foreach (@args) {
            my @neworder = (split /,/, $_);
            push @order, @neworder;
        }
        my $number = @order;
        if ($number > 5) {
            return (1, "Only five boot sequence entries allowed");
        }
        my $nonespecified = 0;
        my $foundnic      = 0;
        foreach (@order) {
            if (($bootnumbers{$_} > 4)) {
                if ($foundnic == 1) {

                    # only one nic allowed. error out
                    return (1, "Only one Eth/Nic device permitted.");
                } else {
                    $foundnic = 1;
                }
            }
            unless (defined($bootnumbers{$_})) { return (1, "Unsupported device $_"); }
            unless ($bootnumbers{$_}) { $nonespecified = 1; }
            if ($nonespecified and $bootnumbers{$_}) { return (1, "Error: cannot specify 'none' before a device"); }
        }
        unless ($bootnumbers{ $order[0] }) {
            return (1, "Error: cannot specify 'none' as first device");
        }

        # Build array to be sent to the blade here
        my @ipl;
        my $i = 1;
        foreach my $dev (@order) {
            push @ipl, { "bootPriority" => "$i", "iplDevice" => "$bootdevices{$bootnumbers{$order[$i - 1]}}" };
            $i++;
        }

        my $setiplResponse = $hpoa->setBladeIplBootPriority("bladeIplArray" => [ 'ipl', \@ipl, "" ], "bayNumber" => $slot);
        if ($setiplResponse->fault) {
            my $errHash = $setiplResponse->fault;
            my $result  = $setiplResponse->oaErrorText;
            print "result is $result \n";
            return (1, "Error on slot $slot setting ipl");
        }

        return bootseq('list');
    }
}


sub power {
    my $subcommand = shift;
    my $command2Send;
    my $currPowerStat;
    my $returnState;

    $returnState   = "";
    $currPowerStat = $getBladeStatusResponse->result->{powered};

    if ($subcommand eq "stat" || $subcommand eq "state") {
        if ($currPowerStat eq "POWER_ON") {
            return (0, "on");
        } elsif ($currPowerStat eq "POWER_OFF") {
            return (0, "off");
        }
    }

    if ($subcommand eq "on") {
        if ($currPowerStat eq "POWER_OFF") {
            $command2Send = "MOMENTARY_PRESS";
            $returnState  = "on";
        } else {
            return (0, "on");
        }
    } elsif ($subcommand eq "off") {
        if ($currPowerStat eq "POWER_ON") {
            $command2Send = "PRESS_AND_HOLD";
            $returnState  = "off";
        } else {
            return (0, "off");
        }
    } elsif ($subcommand eq "reset") {
        $command2Send = "RESET";
    } elsif ($subcommand eq "cycle") {
        if ($currPowerStat eq "POWER_ON") {
            power("off");
        }
        $command2Send = "MOMENTARY_PRESS";
    } elsif ($subcommand eq "boot") {
        if ($currPowerStat eq "POWER_OFF") {
            $command2Send = "MOMENTARY_PRESS";
            $returnState  = "off on";
        } else {
            $command2Send = "COLD_BOOT";
            $returnState  = "on reset";
        }
    } elsif ($subcommand eq "softoff") {
        if ($currPowerStat eq "POWER_ON") {
            $command2Send = "MOMENTARY_PRESS";
        }
    }

    #If we got here with a command to send, do it, otherwise just return
    if ($command2Send) {
        my $pwrResult = $hpoa->setBladePower('bayNumber' => $slot, 'power' => $command2Send);
        if ($pwrResult->fault) {
            return (1, "Node $curn - Power command failed");
        }
        return (0, $returnState);
    }
}



sub bladecmd {
    my $oa   = shift;
    my $node = shift;
    $slot = shift;
    my $user    = shift;
    my $pass    = shift;
    my $command = shift;
    my @args    = @_;
    my $error;

    if ($slot > 0) {
        $getBladeStatusResponse = $hpoa->getBladeStatus('bayNumber' => $slot);
        if ($getBladeStatusResponse->fault) {
            my $errHash = $getBladeStatusResponse->fault;
            my $result  = $getBladeStatusResponse->oaErrorText;
        }
        if ($getBladeStatusResponse->result->{presence} ne "PRESENT") {
            return (1, "Target bay empty");
        }
    }

    if ($command eq "rbeacon") {
        return beacon(@args);
    } elsif ($command eq "rpower") {
        return power(@args);
    } elsif ($command eq "rvitals") {
        return vitals(@args);
    } elsif ($command =~ /r[ms]preset/) {
        return resetmp(@args);
    } elsif ($command eq "rspconfig") {
        return iloconfig($oa, $user, $pass, $node, $slot, @args);
    } elsif ($command eq "rbootseq") {
        return bootseq(@args);
    } elsif ($command eq "switchblade") {
        return switchblade(@args);
    } elsif ($command eq "getmacs") {
        return getmacs(@args);
    } elsif ($command eq "rinv") {
        return inv(@args);
    } elsif ($command eq "reventlog") {
        return eventlog(@args);
    } elsif ($command eq "rscan") {
        return rscan(\@args);
    }

    return (1, "$command not a supported command by blade method");
}


sub forward_data {
    my $callback  = shift;
    my $fds       = 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) {
                $callback->($_);
            }
        } else {
            $fds->remove($rfh);
            close($rfh);
        }
    }
    yield;    #Try to avoid useless iterations as much as possible
    return $rc;
}



sub doblade {
    my $out = shift;
    $oa = shift;
    my $oahash    = shift;
    my $command   = shift;
    my %namedargs = @_;
    my @exargs    = @{ $namedargs{-args} };
    my $node;
    my $args = \@exargs;

    $hpoa = oaLogin($oa);

    # We are now logged into the OA and have a pointer to the OA session. Process
    # the command.

    #get new node status
    my %nodestat = ();
    my $check    = 0;
    my $nsh      = {};

    foreach $node (sort (keys %{ $oahash->{$oa}->{nodes} })) {
        $curn = $node;
        my ($rc, @output) = bladecmd($oa, $node, $oahash->{$oa}->{nodes}->{$node}, $oahash->{$oa}->{username}, $oahash->{$oa}->{password}, $command, @$args);

        foreach (@output) {
            my %output;

            if ($command eq "rscan") {
                $output{errorcode} = $rc;
                $output{data}      = [$_];
            }
            else {
                (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]->{errorcode}                  = $rc;
                $output{node}->[0]->{name}->[0]                  = $node;
                $output{node}->[0]->{data}->[0]->{contents}->[0] = $text;
            }
            print $out freeze([ \%output ]);
            print $out "\nENDOFFREEZE6sK4ci\n";
            yield;
            waitforack($out);
        }
        yield;
    }

    #update the node status to the nodelist.status table
    if ($check) {
        my %node_status = ();

        #foreach (keys %nodestat) { print "node=$_,status=" . $nodestat{$_} ."\n"; } #Ling:remove

        foreach my $node (keys %nodestat) {
            my $stat = $nodestat{$node};
            if ($stat eq "no-op") { next; }
            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);

    }

    #my $msgtoparent=freeze(\@outhashes); # = XMLout(\%output,RootName => 'xcatresponse');
    #print $out $msgtoparent; #$node.": $_\n";
}

sub extractDate {
    use Time::Local;
    my $date = shift;

    return 0 unless $date =~ m/(\d{1,2})\/(\d{1,2})\/(\d{4}) (\d{1,2}):(\d{1,2})/;

    return timegm(0, $5, $4, $2, $1, $3);
}

1;