diff --git a/xCAT-server/lib/xcat/plugins/hpblade.pm b/xCAT-server/lib/xcat/plugins/hpblade.pm
new file mode 100755
index 000000000..5d927f80e
--- /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_plugin::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;
+
+
+
diff --git a/xCAT-server/lib/xcat/plugins/hpoa.pm b/xCAT-server/lib/xcat/plugins/hpoa.pm
new file mode 100755
index 000000000..5eb85e4ac
--- /dev/null
+++ b/xCAT-server/lib/xcat/plugins/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_plugin::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/share/xcat/cons/hpblade b/xCAT-server/share/xcat/cons/hpblade
new file mode 100755
index 000000000..eb572075d
--- /dev/null
+++ b/xCAT-server/share/xcat/cons/hpblade
@@ -0,0 +1,118 @@
+#!/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 adapted to generate hpblade
+#
+use Fcntl qw(:DEFAULT :flock);
+sub get_lock {
+ unless (flock(LOCKHANDLE,LOCK_EX|LOCK_NB)) {
+ $| = 1;
+ print "Acquiring startup lock...";
+ flock(LOCKHANDLE,LOCK_EX) or die "Error trying to secure a startup lock";
+ print "done\n";
+ }
+ truncate(LOCKHANDLE,0);
+ print LOCKHANDLE $$."\n";
+}
+
+sub release_lock {
+ truncate(LOCKHANDLE,0);
+ flock(LOCKHANDLE,LOCK_UN);
+}
+
+BEGIN
+{
+ use Time::HiRes qw(sleep);
+ use File::Path;
+ use Fcntl qw(:DEFAULT :flock);
+ $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
+ umask 0077;
+ mkpath("/tmp/xcat/");
+ unless (sysopen(LOCKHANDLE,"/tmp/xcat/consolelock",O_WRONLY | O_CREAT)) {
+ sleep 15;
+ print "Unable to open lock file";
+ exit 0;
+ }
+ get_lock();
+ #my $sleepint=int(rand(10)); #Stagger start to avoid overwhelming conserver/xCATd
+ #print "Opening console in ".(2+(0.5*$sleepint))." seconds...\n";
+ #sleep $sleepint;
+}
+my $sleepint=int(rand(10)); #Stagger start to avoid overwhelming conserver/xCATd
+use lib "$::XCATROOT/lib/perl";
+$ENV{HOME}='/root/';
+require xCAT::Client;
+
+require File::Basename;
+import File::Basename;
+my $scriptname = $0;
+
+#$mptab = xCAT::Table->new('mp');
+#unless ($mptab) {
+ #sleep 5; #Try not to overwhelm logfiles...
+# die "mp table must be configured";
+#}
+#$mpatab = xCAT::Table->new('mpa');
+#$passtab = xCAT::Table->new('passwd');
+
+my $username = "admin";
+my $passsword = "PASSW0RD";
+my $mm;
+my $slot;
+#my $dba;
+#if ($passtab) {
+# ($dba) = $passtab->getAttribs({key=>blade},qw(username password));
+# if ($dba->{username}) {
+# $username = $dba->{username};
+# }
+# if ($dba->{password}) {
+# $password = $dba->{password};
+# }
+#}
+
+#$dba = $mptab->getNodeAttribs($ARGV[0],[qw(mpa id)]);
+#$mm = $dba->{mpa};
+#$slot = $dba->{id};
+#if ($mpatab) {
+# ($dba) = $mpatab->getAttribs({mpa=>$mm},qw(username password));
+# if ($dba) {
+# if ($dba->{username}) { $username = $dba->{username}; }
+# if ($dba->{password}) { $password = $dba->{password}; }
+# }
+#}
+#xCAT::Utils::close_all_dbhs;
+#sleep 5; #Slow start, I know, but with exec, can't return
+sub getans {
+ my $rsp = shift;
+ if ($rsp->{node}) {
+ $mm = $rsp->{node}->[0]->{mm}->[0];
+ $username = $rsp->{node}->[0]->{username}->[0];
+ $slot = $rsp->{node}->[0]->{slot}->[0];
+ }
+}
+my $cmdref={
+ command=>"gethpbladecons",
+ arg=>"text",
+ noderange=>$ARGV[0]
+};
+xCAT::Client::submit_request($cmdref,\&getans);
+until ($mm and $username and $slot) {
+ release_lock(); #Let other clients have a go
+ $sleepint=10+int(rand(20)); #Stagger to minimize lock collisions, but no big deal when it does happen
+ print "Console not ready, retrying in $sleepint seconds (Hit Ctrl-E,c,o to skip delay)\n";
+ sleep $sleepint;
+ get_lock();
+ xCAT::Client::submit_request($cmdref,\&getans);
+}
+release_lock(); #done with xcatd, can run with near impunity
+$sleepint=10+int(rand(30)); #Stagger sleep to take it easy on AMM/hosting server
+exec "ssh -t $username"."@"."$mm";
+my $pathtochild= dirname($scriptname). "/";
+#exec $pathtochild."hpblade.expect";
+
+#SECURITY: In this case, the authentication is expected to be done using the script user's ssh keys. As such,
+#this script does not receive any particularly sensitive data from the xCAT server.
+
diff --git a/xCAT-server/share/xcat/cons/hpblade.expect b/xCAT-server/share/xcat/cons/hpblade.expect
new file mode 100755
index 000000000..99ff947bb
--- /dev/null
+++ b/xCAT-server/share/xcat/cons/hpblade.expect
@@ -0,0 +1,17 @@
+#!/usr/bin/expect -f
+#
+# © Copyright 2009 Hewlett-Packard Development Company, L.P.
+# EPL license http://www.eclipse.org/legal/epl-v10.html
+#
+
+set send_slow {1 0.02}
+
+expect ""
+sleep 5
+
+send -s "vsp"
+sleep 1
+
+send "\r"
+
+exit 0