diff --git a/perl-xCAT/perl-xCAT.spec b/perl-xCAT/perl-xCAT.spec index 2a2cea8ec..3772b31b4 100644 --- a/perl-xCAT/perl-xCAT.spec +++ b/perl-xCAT/perl-xCAT.spec @@ -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} diff --git a/perl-xCAT/xCAT/hpoa.pm b/perl-xCAT/xCAT/hpoa.pm new file mode 100755 index 000000000..21a240b61 --- /dev/null +++ b/perl-xCAT/xCAT/hpoa.pm @@ -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 = ' + + + ' + . $key . + ' + +'; + + $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: value +## [ $scalar, $type ] +## - An array ref containing a scalar value and type. No further +## will take place. +## Produces: value +## [ $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: +## value1 +## value2 +## +## { $n1 => $v1, $n2 => $v2 ... } +## - A hash ref containing name value pairs that can themselves +## be processed. +## Produces: +## v1 +## v2 +## + +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; diff --git a/xCAT-server/lib/xcat/plugins/hpblade.pm b/xCAT-server/lib/xcat/plugins/hpblade.pm new file mode 100755 index 000000000..43578c92b --- /dev/null +++ b/xCAT-server/lib/xcat/plugins/hpblade.pm @@ -0,0 +1,1880 @@ +#!/usr/bin/env perl +# +# © Copyright 2009 Hewlett-Packard Development Company, L.P. +# EPL license http://www.eclipse.org/legal/epl-v10.html +# +# Revision history: +# 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::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; + +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, + 'h' => 4, + 'hd' => 4, + 'hdd' => 4, + 'harddisk' => 4, + 'eth0' => 5, + 'nic1' => 5, + 'pxe_nic1' => 5, + 'eth1' => 6, + 'nic2' => 6, + 'pxe_nic2' => 6, + 'eth2' => 7, + 'nic3' => 7, + 'pxe_nic3' => 7, + 'eth3' => 8, + 'nic4' => 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 = 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 + 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; + } + + #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::Utils->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 + } + 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);} + + 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'); + if (defined($tmp)) { $blademaxp=$tmp->{value}; } + } + 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") { + 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 = `/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}) { + return 1; #failure + } + 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); + $request->{command}=['discovered']; + $request->{noderange} = [$macmap{$mac}]; + $doreq->($request); + %{$request}=(); #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 = ' + + + + + +-----BEGIN SSH KEY----- +'; + +my $IMPORT_SSH_KEY_FOOTER = ' +-----END SSH KEY----- + + + +'; + +my $MOD_NETWORK_SETTINGS_HEADER = ' + + + + + +'; + +my $MOD_NETWORK_SETTINGS_FOOTER = ' + + + +'; + +my $GET_NETWORK_SETTINGS = ' + + + + + + + +'; + + +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, ''."\r\n"); + print "Wrote $n\n" if $globalDebug; + $n = Net::SSLeay::ssl_write_all($ssl, ''."\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."" if ($newip); + $script = $script."" if($newgateway); + $script = $script."" 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://; + 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/\/) { + $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; +} + +sub eventlog { + my $subcommand= shift; + + my @output; + + my $numEntries = $subcommand; + + if($subcommand eq "all" | $subcommand eq "clear" ) { + return(1, "Command not supported"); + } elsif ($subcommand =~ /\D/) { + return(1, "Command not supported"); + } else { + my $mpEventLogResponse = $hpoa->getBladeMpEventLog("bayNumber"=>$slot, "maxsize"=>640000); + if($mpEventLogResponse->fault) { + return(1, "Attempt to retreive Event Log faulted"); + } + my $logText = $mpEventLogResponse->result->{logContents}; + buildEventHash($logText, $numEntries); + + for (my $index = 0; $index < $numEntries; $index++) { + my $class = $eventHash->{event}->{$index}->{CLASS}; + my $severity = $eventHash->{event}->{$index}->{SEVERITY}; + my $dateTime = $eventHash->{event}->{$index}->{LAST_UPDATE}; + my $desc = $eventHash->{event}->{$index}->{DESCRIPTION}; + + unshift @output,"$class $severity:$dateTime $desc"; + } + return(0, @output); + + } +} + + +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,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; + + $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"; + } else { + return(0, ""); + } + } elsif ($subcommand eq "off") { + if($currPowerStat eq "POWER_ON") { + $command2Send = "PRESS_AND_HOLD"; + } else { + return(0, ""); + } + } 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"; + } else { + $command2Send = "COLD_REBOOT"; + } + } 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, ""); + } +} + + + +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"; +} +1; + + + + + + + + + + diff --git a/xCAT-server/lib/xcat/plugins/hpilo.pm b/xCAT-server/lib/xcat/plugins/hpilo.pm new file mode 100755 index 000000000..4cb29bb09 --- /dev/null +++ b/xCAT-server/lib/xcat/plugins/hpilo.pm @@ -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 = ' + + +'; + + +# Command Definitions +my $GET_HOST_POWER_STATUS = ' + + + + +'; + +# This command enables or disables the Virtual Power Button +my $SET_HOST_POWER_YES = ' + + + + +'; + +my $SET_HOST_POWER_NO = ' + + + + +'; + +my $RESET_SERVER = ' + + + + +'; + +my $PRESS_POWER_BUTTON = ' + + + + +'; + +my $HOLD_POWER_BUTTON = ' + + + + +'; + +my $COLD_BOOT_SERVER = ' + + + + +'; + +my $WARM_BOOT_SERVER = ' + + + + +'; + +my $GET_UID_STATUS = ' + + + + +'; + +my $UID_CONTROL_ON = ' + + + + +'; + +my $UID_CONTROL_OFF = ' + + + + +'; + +my $GET_EMBEDDED_HEALTH = ' + + + + +'; + +my $GET_EVENT_LOG = ' + + + + +'; + +my $CLEAR_EVENT_LOG = ' + + + + +'; + +my $IMPORT_SSH_KEY = ' + + +-----BEGIN SSH KEY -----'; + +my $IMPORT_SSH_KEY_ENDING = ' + + + + '; + + +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, ''."\r\n"); + print "Wrote $n\n" if $globalDebug; + $n = Net::SSLeay::ssl_write_all($ssl, ''."\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; + + +