hp ilo plugins
git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@4550 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
This commit is contained in:
cridye
parent
e347f8fabb
commit
a79d1dbb96
@ -13,6 +13,7 @@ Prefix: /opt/xcat
|
||||
BuildRoot: /var/tmp/%{name}-%{version}-%{release}-root
|
||||
%ifos linux
|
||||
BuildArch: noarch
|
||||
Requires: perl-SOAP-Lite
|
||||
%endif
|
||||
|
||||
Provides: perl(xCAT) = %{version}
|
||||
|
||||
374
perl-xCAT/xCAT/hpoa.pm
Executable file
374
perl-xCAT/xCAT/hpoa.pm
Executable file
@ -0,0 +1,374 @@
|
||||
#
|
||||
# © Copyright 2009 Hewlett-Packard Development Company, L.P.
|
||||
# EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
#
|
||||
|
||||
## API for talking to HP Onboard Administrator
|
||||
|
||||
## NOTE:
|
||||
## All parameters are passed by name!
|
||||
## For example:
|
||||
## hpoa->new(oaAddress => '16.129.49.209');
|
||||
|
||||
package xCAT::hpoa;
|
||||
|
||||
use strict;
|
||||
|
||||
use SOAP::Lite;
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(SOAP::Lite);
|
||||
|
||||
# Constructor
|
||||
# Input: oaAddress, the IP address of the OA
|
||||
# Output: SOAP::SOM object (SOAP response)
|
||||
sub new {
|
||||
my $class = shift;
|
||||
return $class if ref $class;
|
||||
|
||||
my $self = $class->SUPER::new();
|
||||
|
||||
my %args = @_;
|
||||
|
||||
die "oaAddress is a required parameter"
|
||||
unless defined $args{oaAddress};
|
||||
|
||||
# Some info we'll need
|
||||
$self->{HPOA_HOST} = $args{oaAddress}; # OA IP address
|
||||
$self->{HPOA_KEY} = undef; # oaSessionKey returned by userLogIn
|
||||
$self->{HPOA_SECURITY_XML} = undef; # key placed in proper XML
|
||||
$self->{HPOA_SECURITY_HEADER} = undef; # XML translated to SOAP::Header obj
|
||||
|
||||
bless($self, $class);
|
||||
|
||||
# We contact the OA via this URL:
|
||||
my $proxy = "https://". $self->{HPOA_HOST} . ":443/hpoa";
|
||||
|
||||
# One of the cool things about SOAP::Lite is that almost every
|
||||
# method returns $self. This allows you to string together
|
||||
# as many calls as you need, like this:
|
||||
$self
|
||||
# keep the XML formatted for human readability, in case
|
||||
# we ever have to look at it (unlikely)
|
||||
-> readable(1)
|
||||
|
||||
# Need to tell SOAP about some namespaces. I don't know if they
|
||||
# are all necessary or not, but I got them from the hpoa.wsdl
|
||||
-> ns("http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd", "wsu")
|
||||
-> ns('http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd', "wsse")
|
||||
-> ns('http://www.w3.org/2001/XMLSchema-instance', 'xsi')
|
||||
-> ns('http://www.w3.org/2003/05/soap-encoding', 'SOAP-ENC')
|
||||
-> ns('http://www.w3.org/2003/05/soap-envelope', 'SOAP-ENV')
|
||||
-> ns('http://www.w3.org/2001/XMLSchema', 'xsd')
|
||||
-> default_ns("hpoa.xsd", "hpoa")
|
||||
|
||||
# Inform SOAP of the OA URL
|
||||
-> proxy($proxy);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Method: call
|
||||
# Input: method and a hash of method's input params (see below)
|
||||
# Output: SOAP::SOM object (SOAP response)
|
||||
#
|
||||
# All methods in the OA API end up getting called by this routine,
|
||||
# even though the user invokes them directly using the method name.
|
||||
# For example, code that looks like this:
|
||||
# $hpoa->userLogIn(username=>$name, password=>$pass)
|
||||
# results in this call:
|
||||
# $hpoa->call('userLogIn', username=>$name, password=>$pass)
|
||||
sub call {
|
||||
my ($self, $method, %args) = @_;
|
||||
|
||||
#
|
||||
# Each item of %args is of the form:
|
||||
# ($name => $value).
|
||||
#
|
||||
# $value is usually a scalar and SOAP::Lite infers a type.
|
||||
#
|
||||
# If the value needs to be explicitly typed, the $value should be a
|
||||
# reference to an array of the form:
|
||||
# [ $scalar, $type ]
|
||||
# This should work for any parameter that you want to explicitly
|
||||
# type, but for some reason the OA was not having any of it the
|
||||
# last time I tried.
|
||||
#
|
||||
# If the method calls for an array of values, the $value should be
|
||||
# a reference to an array of the form:
|
||||
# [ $itemName, $itemArrayRef, $itemType ]
|
||||
#
|
||||
# If the method calls for more complicated structure, the $value
|
||||
# should be a reference to a hash of the form:
|
||||
# { name1 => value1, name2 => value2 ... }
|
||||
# The values can themselves be scalars, array refs or hash refs,
|
||||
# which will themselves be processed recursively.
|
||||
#
|
||||
|
||||
# Put the params in a form SOAP likes.
|
||||
my @soapargs = ();
|
||||
while (my ($k, $v) = each %args) {
|
||||
push @soapargs, $self->process_args($k, $v);
|
||||
}
|
||||
# This is required if there are no params, otherwise SOAP::Lite
|
||||
# makes an XML construct that the OA doesn't like.
|
||||
@soapargs = SOAP::Data->type('xml'=> undef)
|
||||
unless @soapargs;
|
||||
|
||||
# Add the security header if it's not the login method.
|
||||
# I'm hoping that the header will be ignored by the few methods
|
||||
# that don't require security.
|
||||
push (@soapargs, $self->{HPOA_SECURITY_HEADER})
|
||||
unless ($method eq 'userLogIn') || !defined $self->{HPOA_SECURITY_HEADER};
|
||||
|
||||
# Make sure we're using the correct version of SOAP, but
|
||||
# don't mess up packages that use a different version.
|
||||
my $version = hpoa->soapversion();
|
||||
hpoa->soapversion('1.2');
|
||||
|
||||
# Call the method and put the response in $r
|
||||
my $r = $self->SUPER::call($method, @soapargs);
|
||||
|
||||
# Reset the SOAP version
|
||||
hpoa->soapversion($version);
|
||||
|
||||
# If this was the login method and it was successful, then extract
|
||||
# the session key and remember it for subsequent calls.
|
||||
if ($method eq 'userLogIn' && !$r->fault) {
|
||||
|
||||
my $key = $r->result()->{oaSessionKey};
|
||||
|
||||
# Got this XML code from the HP Insight Onboard Administrator SOAP
|
||||
# Interface Guide 0.9.7
|
||||
my $xml = '
|
||||
<wsse:Security xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd" SOAP-ENV:mustUnderstand="true">
|
||||
<hpoa:HpOaSessionKeyToken xmlns:hpoa="hpoa.xsd">
|
||||
<hpoa:oaSessionKey>'
|
||||
. $key .
|
||||
'</hpoa:oaSessionKey>
|
||||
</hpoa:HpOaSessionKeyToken>
|
||||
</wsse:Security>';
|
||||
|
||||
$self->{HPOA_KEY} = $key;
|
||||
$self->{HPOA_SECURITY_XML} = $xml;
|
||||
$self->{HPOA_SECURITY_HEADER} = SOAP::Header->type('xml' => $xml);
|
||||
}
|
||||
|
||||
# Return the response
|
||||
return $r;
|
||||
}
|
||||
|
||||
## Create the correct SOAP::Data structure for the given args
|
||||
## $n is the argument name
|
||||
## $v is the value and can be of the following 4 forms:
|
||||
## $scalar
|
||||
## - A scalar value. No further processing takes place.
|
||||
## Produces: <name>value</name>
|
||||
## [ $scalar, $type ]
|
||||
## - An array ref containing a scalar value and type. No further
|
||||
## will take place.
|
||||
## Produces: <name type=aType>value</name>
|
||||
## [ $itemName, $aref, $type ]
|
||||
## - An array ref containing the name for the elements, the elements
|
||||
## themselves in an array ref, and the type for the elements. The
|
||||
## elements themselves can be processed.
|
||||
## Produces: <name>
|
||||
## <item type=aType>value1</item>
|
||||
## <item type=aType>value2</item>
|
||||
## </name>
|
||||
## { $n1 => $v1, $n2 => $v2 ... }
|
||||
## - A hash ref containing name value pairs that can themselves
|
||||
## be processed.
|
||||
## Produces: <name>
|
||||
## <n1>v1</n1>
|
||||
## <n2>v2</n2>
|
||||
## </name>
|
||||
|
||||
sub process_args {
|
||||
my ($self, $n, $v, $t) = @_;
|
||||
print "process args: $n => $v\n" if 0;
|
||||
|
||||
if (!ref $v) { # untyped scalar
|
||||
print "\nUNTYPED SCALAR: $n => $v\n" if 0;
|
||||
return SOAP::Data->new(name => $n, value => $v, type => '');
|
||||
}
|
||||
|
||||
if (ref $v eq 'HASH') { # structure
|
||||
my ($nn, $vv, @ar);
|
||||
while (($nn, $vv) = each %$v) {
|
||||
print "\nSTRUCTURE $n: $nn => $vv\n" if 0;
|
||||
unshift @ar, $self->process_args($nn, $vv);
|
||||
}
|
||||
return SOAP::Data->name($n => \SOAP::Data->value(@ar));
|
||||
}
|
||||
|
||||
if (ref $v eq 'ARRAY') {
|
||||
|
||||
if (scalar @$v == 2) { # typed scalar
|
||||
my ($value, $type) = @$v;
|
||||
print "\nTYPED SCALAR: $n => $value ($type)\n" if 0;
|
||||
return SOAP::Data->new(name => $n, value => $value, type => $type);
|
||||
}
|
||||
|
||||
# Else an array of values
|
||||
my ($itemName, $aref, $type) = @$v;
|
||||
my (@ar, $item);
|
||||
foreach $item (@$aref) {
|
||||
if (ref $item eq 'HASH') {
|
||||
print "\nSUB STRUCTURE $n: $itemName => $item ($type)\n" if 0;
|
||||
unshift @ar, $self->process_args("$itemName", $item);
|
||||
} else {
|
||||
print "\nARRAY $n: $itemName => $item ($type)\n" if 0;
|
||||
unshift @ar, $self->process_args($itemName, [$item, $type]);
|
||||
}
|
||||
}
|
||||
return SOAP::Data->name($n => \SOAP::Data->value(@ar));
|
||||
}
|
||||
|
||||
die "Unexpected input parameter value: $n => $v\n";
|
||||
}
|
||||
|
||||
###
|
||||
### Special fault info for OAs
|
||||
###
|
||||
|
||||
# The OA uses it's own fault data structures. The simple
|
||||
# fault methods provided by SOAP::Lite are usually undef.
|
||||
# The OA's fault data looks like this:
|
||||
# {
|
||||
# 'Detail' => {
|
||||
# 'faultInfo' => {
|
||||
# 'operationName' => 'userLogIn',
|
||||
# 'errorText' => 'The user could not be authenticated.',
|
||||
# 'errorCode' => '150',
|
||||
# 'errorType' => 'USER_REQUEST'
|
||||
# }
|
||||
# },
|
||||
# 'Reason' => {
|
||||
# 'Text' => 'User Request Error'
|
||||
# },
|
||||
# 'Code' => {
|
||||
# 'Value' => 'SOAP-ENV:Sender'
|
||||
# }
|
||||
#}
|
||||
#
|
||||
# In your code, you should generally check that $response->fault
|
||||
# is defined, then print $response->oaErrorMessage.
|
||||
# If you know the codes, you can act on $response->oaErrorCode
|
||||
#
|
||||
|
||||
# The OA's fault structure
|
||||
sub SOAP::SOM::oaFaultInfo {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
return $self->fault->{Detail}->{faultInfo}
|
||||
if (defined $self->fault &&
|
||||
defined $self->fault->{Detail} &&
|
||||
defined $self->fault->{Detail}->{faultInfo});
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# The name of the method producing the fault
|
||||
sub SOAP::SOM::oaOperationName {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $oafi = $self->oaFaultInfo;
|
||||
|
||||
return $oafi->{operationName}
|
||||
if defined $oafi &&
|
||||
defined $oafi->{operationName};
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Text of the OA fault
|
||||
sub SOAP::SOM::oaErrorText {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $oafi = $self->oaFaultInfo;
|
||||
|
||||
return $oafi->{errorText}
|
||||
if defined $oafi &&
|
||||
defined $oafi->{errorText};
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Numeric code of the OA fault
|
||||
sub SOAP::SOM::oaErrorCode {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $oafi = $self->oaFaultInfo;
|
||||
|
||||
if (defined $oafi) {
|
||||
|
||||
return $oafi->{errorCode}
|
||||
if defined $oafi->{errorCode};
|
||||
|
||||
return $oafi->{internalErrorCode}
|
||||
if defined $oafi->{internalErrorCode};
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Bay Number of the OA fault
|
||||
sub SOAP::SOM::oaOperationBayNumber {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $oafi = $self->oaFaultInfo;
|
||||
|
||||
return $oafi->{operationBayNumber}
|
||||
if defined $oafi &&
|
||||
defined $oafi->{operationBayNumber};
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Sometimes there's extra fault information
|
||||
# (Haven't seen any yet!)
|
||||
sub SOAP::SOM::oaExtraFaultData {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $oafi = $self->oaFaultInfo;
|
||||
|
||||
return $oafi->{extraData}
|
||||
if defined $oafi &&
|
||||
defined $oafi->{extraData};
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
# Nicely formatted error message for human consumption.
|
||||
# Tries to use the oaErrorText and oaErrorCode, if defined,
|
||||
# else uses the reason text.
|
||||
sub SOAP::SOM::oaErrorMessage {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my $errorText = $self->oaErrorText;
|
||||
|
||||
# Reason text is either an error message from SOAP (as when
|
||||
# the method or argument doesn't exist), or it's a formatted
|
||||
# form of the faultInfo->errorType enumeration.
|
||||
my $reasonText = $self->fault->{Reason}->{Text};
|
||||
|
||||
return $reasonText
|
||||
unless defined $errorText;
|
||||
|
||||
my $operationName = $self->oaOperationName;
|
||||
my $operationBay = $self->oaOperationBayNumber;
|
||||
my $errorCode = $self->oaErrorCode;
|
||||
my $extraData = $self->oaExtraFaultData;
|
||||
|
||||
my $operation = "'$operationName' call";
|
||||
$operation .= " on bay $operationBay"
|
||||
if $operationBay;
|
||||
|
||||
my $completeText =
|
||||
"$reasonText $errorCode during $operation: $errorText";
|
||||
$completeText .= "\n\t$extraData" if $extraData;
|
||||
|
||||
return $completeText;
|
||||
}
|
||||
|
||||
1;
|
||||
1880
xCAT-server/lib/xcat/plugins/hpblade.pm
Executable file
1880
xCAT-server/lib/xcat/plugins/hpblade.pm
Executable file
File diff suppressed because it is too large
Load Diff
836
xCAT-server/lib/xcat/plugins/hpilo.pm
Executable file
836
xCAT-server/lib/xcat/plugins/hpilo.pm
Executable file
@ -0,0 +1,836 @@
|
||||
#
|
||||
# © Copyright 2009 Hewlett-Packard Development Company, L.P.
|
||||
# EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
#
|
||||
|
||||
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::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";
|
||||
|
||||
require Exporter;
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT = qw(
|
||||
hpiloinit
|
||||
hpilocmd
|
||||
);
|
||||
|
||||
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/>
|
||||
</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));
|
||||
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;
|
||||
}
|
||||
|
||||
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>/) {
|
||||
if($1 eq "0x0000") {
|
||||
#Sprint STDERR "$3\n" if $3;
|
||||
} else {
|
||||
$reply2return = "ERROR: STATUS: $1, MESSAGE: $2\n";
|
||||
}
|
||||
}
|
||||
|
||||
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::Utils->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"/;
|
||||
}
|
||||
} 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 ($reply eq "ON") {
|
||||
$cmdString = $RESET_SERVER;
|
||||
} else {
|
||||
$cmdString = $SET_HOST_POWER_YES;
|
||||
}
|
||||
} else {
|
||||
print STDERR "issuePowerCmd:boot Power status of server failed. \n";
|
||||
return ($rc, $reply);
|
||||
}
|
||||
|
||||
}
|
||||
print "cmdstring is $cmdString \n";
|
||||
|
||||
($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;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user