git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@4550 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			837 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			837 lines
		
	
	
		
			20 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
# 
 | 
						|
# © Copyright 2009 Hewlett-Packard Development Company, L.P.
 | 
						|
# EPL license http://www.eclipse.org/legal/epl-v10.html
 | 
						|
#
 | 
						|
 | 
						|
package xCAT_plugin::hpilo;
 | 
						|
BEGIN
 | 
						|
{
 | 
						|
  $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
 | 
						|
}
 | 
						|
use lib "$::XCATROOT/lib/perl";
 | 
						|
use strict;
 | 
						|
use warnings "all";
 | 
						|
use xCAT::GlobalDef;
 | 
						|
 | 
						|
use POSIX qw(ceil floor);
 | 
						|
use Storable qw(store_fd retrieve_fd thaw freeze);
 | 
						|
use xCAT::Utils;
 | 
						|
use xCAT::Usage;
 | 
						|
use Thread qw(yield);
 | 
						|
use Socket;
 | 
						|
use Net::SSLeay qw(die_now die_if_ssl_error);
 | 
						|
use POSIX "WNOHANG";
 | 
						|
my $tfactor = 0;
 | 
						|
my $vpdhash;
 | 
						|
my %bmc_comm_pids;
 | 
						|
my $globalDebug = 0;
 | 
						|
my $outfd;
 | 
						|
my $currnode;
 | 
						|
my $status_noop="XXXno-opXXX";
 | 
						|
 | 
						|
require Exporter;
 | 
						|
our @ISA = qw(Exporter);
 | 
						|
our @EXPORT = qw(
 | 
						|
		hpiloinit
 | 
						|
        hpilocmd
 | 
						|
);
 | 
						|
 | 
						|
sub handled_commands {
 | 
						|
  return {
 | 
						|
    rpower => 'nodehm:power,mgt',
 | 
						|
    rvitals => 'nodehm:mgt',
 | 
						|
    rbeacon => 'nodehm:mgt',
 | 
						|
    reventlog => 'nodehm:mgt'
 | 
						|
  }
 | 
						|
}
 | 
						|
 | 
						|
	
 | 
						|
# These commands do not map directly to iLO commands
 | 
						|
#	boot:
 | 
						|
#		if power is off
 | 
						|
#			power the server on
 | 
						|
#		else
 | 
						|
#			issue a HARD BOOT to the server
 | 
						|
#
 | 
						|
#	cycle:
 | 
						|
#		Issue power off to server
 | 
						|
#		Issue power on to server
 | 
						|
#
 | 
						|
	
 | 
						|
	
 | 
						|
 | 
						|
my $INITIAL_HEADER = '
 | 
						|
<LOCFG VERSION="2.21"/>
 | 
						|
<RIBCL VERSION="2.0">
 | 
						|
<LOGIN USER_LOGIN="AdMiNnAmE" PASSWORD="PaSsWoRd">';
 | 
						|
 | 
						|
 | 
						|
# Command Definitions
 | 
						|
my $GET_HOST_POWER_STATUS = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<GET_HOST_POWER_STATUS/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
# This command enables or disables the Virtual Power Button
 | 
						|
my $SET_HOST_POWER_YES = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<SET_HOST_POWER HOST_POWER="Yes"/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $SET_HOST_POWER_NO = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<SET_HOST_POWER HOST_POWER="No"/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $RESET_SERVER = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<RESET_SERVER/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $PRESS_POWER_BUTTON = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<PRESS_PWR_BTN/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $HOLD_POWER_BUTTON = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<HOLD_PWR_BTN/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $COLD_BOOT_SERVER = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<COLD_BOOT_SERVER/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $WARM_BOOT_SERVER = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<WARM_BOOT_SERVER/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $GET_UID_STATUS = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<GET_UID_STATUS />
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $UID_CONTROL_ON = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<UID_CONTROL UID="YES"/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $UID_CONTROL_OFF = '
 | 
						|
<SERVER_INFO MODE="write">
 | 
						|
<UID_CONTROL UID="NO"/>
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $GET_EMBEDDED_HEALTH = '
 | 
						|
<SERVER_INFO MODE="read">
 | 
						|
<GET_EMBEDDED_HEALTH />
 | 
						|
</SERVER_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $GET_EVENT_LOG = '
 | 
						|
<RIB_INFO MODE = "read" >
 | 
						|
<GET_EVENT_LOG />
 | 
						|
</RIB_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $CLEAR_EVENT_LOG = '
 | 
						|
<RIB_INFO MODE = "write" >
 | 
						|
<CLEAR_EVENT_LOG />
 | 
						|
</RIB_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBCL>';
 | 
						|
 | 
						|
my $IMPORT_SSH_KEY = '
 | 
						|
<RIB_INFO MODE = "write" >
 | 
						|
<IMPORT_SSH_KEY>
 | 
						|
-----BEGIN SSH KEY -----';
 | 
						|
 | 
						|
my $IMPORT_SSH_KEY_ENDING = '
 | 
						|
</IMPORT_SSH_KEY>
 | 
						|
</RIB_INFO>
 | 
						|
</LOGIN>
 | 
						|
</RIBLC> ';
 | 
						|
 | 
						|
 | 
						|
use Socket;
 | 
						|
use Net::SSLeay qw(die_now die_if_ssl_error) ;
 | 
						|
 | 
						|
my $ctx;   # Make this a global
 | 
						|
 | 
						|
Net::SSLeay::load_error_strings();
 | 
						|
Net::SSLeay::SSLeay_add_ssl_algorithms();
 | 
						|
Net::SSLeay::randomize();
 | 
						|
#
 | 
						|
# opens an ssl connection to port 443 of the passed host
 | 
						|
#
 | 
						|
sub openSSLconnection($)
 | 
						|
{
 | 
						|
	my $host = shift;
 | 
						|
	my ($ssl, $sin, $ip, $nip);
 | 
						|
	if (not $ip = inet_aton($host))
 | 
						|
	{
 | 
						|
		print "$host is a DNS Name, performing lookup\n" if $globalDebug;
 | 
						|
		$ip = gethostbyname($host) or die "ERROR: Host $host notfound. \n";
 | 
						|
	}
 | 
						|
	$nip = inet_ntoa($ip);
 | 
						|
	#print STDERR "Connecting to $nip:443\n";
 | 
						|
	$sin = sockaddr_in(443, $ip);
 | 
						|
	socket (S, &AF_INET, &SOCK_STREAM, 0) or die "ERROR: socket: $!";
 | 
						|
	connect (S, $sin) or die "connect: $!";
 | 
						|
	$ctx = Net::SSLeay::CTX_new() or die_now("ERROR: Failed to create SSL_CTX $! ");
 | 
						|
 | 
						|
	Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL);
 | 
						|
	die_if_ssl_error("ERROR: ssl ctx set options");
 | 
						|
	$ssl = Net::SSLeay::new($ctx) or die_now("ERROR: Failed to create SSL $!");
 | 
						|
 | 
						|
	Net::SSLeay::set_fd($ssl, fileno(S));
 | 
						|
	Net::SSLeay::connect($ssl) and die_if_ssl_error("ERROR: ssl connect");
 | 
						|
	#print STDERR 'SSL Connected ';
 | 
						|
	print 'Using Cipher: ' . Net::SSLeay::get_cipher($ssl) if $globalDebug;
 | 
						|
	#print STDERR "\n\n";
 | 
						|
	return $ssl;
 | 
						|
}
 | 
						|
 | 
						|
sub closeSSLconnection($)
 | 
						|
{
 | 
						|
	my $ssl = shift;
 | 
						|
	
 | 
						|
	Net::SSLeay::free ($ssl);		# Tear down connection
 | 
						|
	Net::SSLeay::CTX_free ($ctx);	
 | 
						|
	close S;
 | 
						|
}
 | 
						|
 | 
						|
sub waitforack {
 | 
						|
    my $sock = shift;
 | 
						|
    my $select = new IO::Select;
 | 
						|
    $select->add($sock);
 | 
						|
    my $str;
 | 
						|
    if ($select->can_read(10)) { # Continue after 10 seconds, even if not acked...
 | 
						|
        if ($str = <$sock>) {
 | 
						|
        } else {
 | 
						|
           $select->remove($sock); #Block until parent acks data
 | 
						|
        }
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
 | 
						|
# usage: sendscript(host, script)
 | 
						|
# sends the xmlscript script to host, returns reply
 | 
						|
sub sendScript($$)
 | 
						|
{
 | 
						|
	my $host = shift;
 | 
						|
	my $script = shift;
 | 
						|
	my ($ssl, $reply, $lastreply, $res, $n);
 | 
						|
	$ssl = openSSLconnection($host);
 | 
						|
	# write header
 | 
						|
	$n = Net::SSLeay::ssl_write_all($ssl, '<?xml version="1.0"?>'."\r\n");
 | 
						|
	print "Wrote $n\n" if $globalDebug;
 | 
						|
	$n = Net::SSLeay::ssl_write_all($ssl, '<LOCFG version="2.21"/>'."\r\n");
 | 
						|
	print "Wrote $n\n" if $globalDebug;
 | 
						|
 | 
						|
	# write script
 | 
						|
	$n = Net::SSLeay::ssl_write_all($ssl, $script);
 | 
						|
	print "Wrote $n\n$script\n" if $globalDebug;
 | 
						|
	$reply = "";
 | 
						|
	$lastreply = "";
 | 
						|
	my $reply2return;
 | 
						|
	READLOOP:
 | 
						|
	while(1) {
 | 
						|
		$n++;
 | 
						|
		$lastreply = Net::SSLeay::read($ssl);
 | 
						|
		die_if_ssl_error("ERROR: ssl read");
 | 
						|
		if($lastreply eq "") {
 | 
						|
			sleep(2); # wait 2 sec for more text.
 | 
						|
			$lastreply = Net::SSLeay::read($ssl);
 | 
						|
			die_if_ssl_error("ERROR: ssl read");
 | 
						|
			last READLOOP if($lastreply eq "");
 | 
						|
		}
 | 
						|
		$reply .= $lastreply;
 | 
						|
		print "lastreply  $lastreply \b" if $globalDebug;
 | 
						|
		
 | 
						|
		# Check response to see if a error was returned.
 | 
						|
		if($lastreply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>/) {
 | 
						|
			if($1 eq "0x0000") {
 | 
						|
				#print STDERR "$3\n" if $3;
 | 
						|
			} else {
 | 
						|
				$reply2return = "ERROR: STATUS: $1, MESSAGE: $2\n";
 | 
						|
			}
 | 
						|
		}
 | 
						|
	}
 | 
						|
	print "READ: $lastreply\n" if $globalDebug;
 | 
						|
	if($lastreply =~ m/STATUS="(0x[0-9A-F]+)"[\s]+MESSAGE='(.*)'[\s]+\/>[\s]*(([\s]|.)*?)<\/RIBCL>/) {
 | 
						|
		if($1 eq "0x0000") {
 | 
						|
			#Sprint STDERR "$3\n" if $3;
 | 
						|
		} else {
 | 
						|
			$reply2return =  "ERROR: STATUS: $1, MESSAGE: $2\n";
 | 
						|
		}
 | 
						|
	}
 | 
						|
 | 
						|
	closeSSLconnection($ssl);
 | 
						|
	return $$reply2return;
 | 
						|
}
 | 
						|
 | 
						|
sub process_request {
 | 
						|
	my $request = shift;
 | 
						|
	my $callback = shift;
 | 
						|
	my $noderange = $request->{node}; #Should be arrayref
 | 
						|
	my $command = $request->{command}->[0];
 | 
						|
	my $extrargs = $request->{arg};
 | 
						|
	my @exargs=($request->{arg});
 | 
						|
	my $ipmimaxp = 64;
 | 
						|
	if (ref($extrargs)) {
 | 
						|
		@exargs=@$extrargs;
 | 
						|
	}
 | 
						|
	my $ipmitab = xCAT::Table->new('ipmi');
 | 
						|
 | 
						|
	my $ilouser = "USERID";
 | 
						|
	my $ilopass = "PASSW0RD";
 | 
						|
	# Go to the passwd table to see if usernames and passwords are defined
 | 
						|
	my $passtab = xCAT::Table->new('passwd');
 | 
						|
	if ($passtab) {
 | 
						|
		my ($tmp)=$passtab->getAttribs({'key'=>'ipmi'},'username','password');
 | 
						|
		if (defined($tmp)) {
 | 
						|
			$ilouser = $tmp->{username};
 | 
						|
			$ilopass = $tmp->{password};
 | 
						|
		}
 | 
						|
	}
 | 
						|
	
 | 
						|
	my @donargs = ();
 | 
						|
	my $ipmihash = $ipmitab->getNodesAttribs($noderange,['bmc','username','password']);
 | 
						|
	foreach(@$noderange) { 
 | 
						|
		my $node=$_;
 | 
						|
		my $nodeuser=$ilouser;
 | 
						|
		my $nodepass=$ilopass;
 | 
						|
		my $nodeip = $node;
 | 
						|
		my $ent;
 | 
						|
		if (defined($ipmitab)) {
 | 
						|
			$ent=$ipmihash->{$node}->[0];
 | 
						|
			if (ref($ent) and defined $ent->{bmc}) { $nodeip = $ent->{bmc}; }
 | 
						|
			if (ref($ent) and defined $ent->{username}) { $nodeuser = $ent->{username}; }
 | 
						|
			if (ref($ent) and defined $ent->{password}) { $nodepass = $ent->{password}; }
 | 
						|
		}
 | 
						|
		push @donargs,[$node,$nodeip,$nodeuser,$nodepass];
 | 
						|
	}
 | 
						|
 | 
						|
	#get new node status
 | 
						|
	my %nodestat=();
 | 
						|
	my $check=0;
 | 
						|
	my $newstat;
 | 
						|
	if ($command eq 'rpower') {
 | 
						|
		if (($extrargs->[0] ne 'stat') && ($extrargs->[0] ne 'status') && ($extrargs->[0] ne 'state')) {
 | 
						|
			$check=1;
 | 
						|
			my @allnodes;
 | 
						|
			foreach (@donargs) { push(@allnodes, $_->[0]); }
 | 
						|
 | 
						|
			if ($extrargs->[0] eq 'off') { $newstat=$::STATUS_POWERING_OFF; }
 | 
						|
			else { $newstat=$::STATUS_BOOTING;}
 | 
						|
 | 
						|
			foreach (@allnodes) { $nodestat{$_}=$newstat; }
 | 
						|
 | 
						|
			if ($extrargs->[0] ne 'off') {
 | 
						|
				#get the current nodeset stat
 | 
						|
				if (@allnodes>0) {
 | 
						|
					my $nsh={};
 | 
						|
					my ($ret, $msg)=xCAT::Utils->getNodesetStates(\@allnodes, $nsh);
 | 
						|
					if (!$ret) {
 | 
						|
						foreach (keys %$nsh) {
 | 
						|
							my $currstate=$nsh->{$_};
 | 
						|
							$nodestat{$_}=xCAT_monitoring::monitorctrl->getNodeStatusFromNodesetState($currstate, "rpower");
 | 
						|
						}
 | 
						|
					}
 | 
						|
				}
 | 
						|
			}
 | 
						|
		}
 | 
						|
	}
 | 
						|
	
 | 
						|
	# fork off separate processes to handle the requested command on each node.
 | 
						|
	my $children = 0;
 | 
						|
	$SIG{CHLD} = sub {my $kpid; do { $kpid = waitpid(-1, &WNOHANG); if ($kpid > 0) { delete $bmc_comm_pids{$kpid}; $children--; } } while $kpid > 0; };
 | 
						|
	my $sub_fds = new IO::Select;
 | 
						|
	foreach (@donargs) {
 | 
						|
		while ($children > $ipmimaxp) {
 | 
						|
			my $errornodes={};
 | 
						|
			forward_data($callback,$sub_fds,$errornodes);
 | 
						|
			#update the node status to the nodelist.status table
 | 
						|
			if ($check) {
 | 
						|
				updateNodeStatus(\%nodestat, $errornodes);
 | 
						|
			}
 | 
						|
		}
 | 
						|
		$children++;
 | 
						|
		my $cfd;
 | 
						|
		my $pfd;
 | 
						|
		socketpair($pfd, $cfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
 | 
						|
		$cfd->autoflush(1);
 | 
						|
		$pfd->autoflush(1);
 | 
						|
		my $child = xCAT::Utils->xfork();
 | 
						|
		unless (defined $child) { die "Fork failed" };
 | 
						|
		if ($child == 0) {
 | 
						|
			close($cfd);
 | 
						|
			my $rrc=execute_cmd($pfd,$_->[0],$_->[1],$_->[2],$_->[3],$command,-args=>\@exargs);
 | 
						|
			close($pfd);
 | 
						|
			exit(0);
 | 
						|
		}
 | 
						|
		$bmc_comm_pids{$child}=1;
 | 
						|
		close ($pfd);
 | 
						|
		$sub_fds->add($cfd)
 | 
						|
	}
 | 
						|
	while ($sub_fds->count > 0 and $children > 0) {
 | 
						|
		my $errornodes={};
 | 
						|
		forward_data($callback,$sub_fds,$errornodes);
 | 
						|
		#update the node status to the nodelist.status table
 | 
						|
		if ($check) {
 | 
						|
			updateNodeStatus(\%nodestat, $errornodes);
 | 
						|
		}
 | 
						|
	}
 | 
						|
 | 
						|
	#Make sure they get drained, this probably is overkill but shouldn't hurt
 | 
						|
	#my $rc=1;
 | 
						|
	#while ( $rc > 0 ) {
 | 
						|
		#my $errornodes={};
 | 
						|
		#$rc=forward_data($callback,$sub_fds,$errornodes);
 | 
						|
		#update the node status to the nodelist.status table
 | 
						|
		#if ($check ) {
 | 
						|
			#updateNodeStatus(\%nodestat, $errornodes);
 | 
						|
		#}
 | 
						|
	#}
 | 
						|
}
 | 
						|
 | 
						|
sub updateNodeStatus {
 | 
						|
	my $nodestat=shift;
 | 
						|
	my $errornodes=shift;
 | 
						|
	my %node_status=();
 | 
						|
	foreach my $node (keys(%$errornodes)) {
 | 
						|
		if ($errornodes->{$node} == -1) { next;} #has error, not updating status
 | 
						|
		my $stat=$nodestat->{$node};
 | 
						|
		if (exists($node_status{$stat})) {
 | 
						|
			my $pa=$node_status{$stat};
 | 
						|
			push(@$pa, $node);
 | 
						|
		}else {
 | 
						|
			$node_status{$stat}=[$node];
 | 
						|
		}
 | 
						|
	}
 | 
						|
	xCAT_monitoring::monitorctrl::setNodeStatusAttributes(\%node_status, 1);
 | 
						|
}
 | 
						|
 | 
						|
sub processReply 
 | 
						|
{
 | 
						|
	
 | 
						|
	
 | 
						|
	my $command = shift;
 | 
						|
	my $subcommand = shift;
 | 
						|
	my $reply = shift;   # This is the returned xml string from the iLO that we will now parse
 | 
						|
	my $replyToReturn = "";
 | 
						|
	my $rc = 0;
 | 
						|
	
 | 
						|
	if ($command eq "power" ) {
 | 
						|
		if($subcommand =~ m/stat/) {
 | 
						|
			# Process power status command
 | 
						|
			$replyToReturn = "ON" if $reply =~ m/HOST_POWER="ON"/;
 | 
						|
			$replyToReturn = "OFF" if $reply =~ m/HOST_POWER="OFF"/;
 | 
						|
		}
 | 
						|
	} elsif ($command eq "beacon") {
 | 
						|
		if($subcommand =~ m/stat/) {
 | 
						|
			$replyToReturn = "ON" if $reply =~ /GET_UID_STATUS UID="ON"/;
 | 
						|
			$replyToReturn = "OFF" if $reply =~ /GET_UID_STATUS UID="OFF"/;
 | 
						|
		}
 | 
						|
	}
 | 
						|
	
 | 
						|
	if (! $replyToReturn) {
 | 
						|
		$rc = -1;
 | 
						|
	}
 | 
						|
	
 | 
						|
	return ($rc, $replyToReturn);
 | 
						|
}
 | 
						|
 | 
						|
sub makeGEHXML
 | 
						|
{
 | 
						|
	my $inputreply = shift;
 | 
						|
	# process response
 | 
						|
	my $geh_output = "";
 | 
						|
 | 
						|
	my @lines = split/^/, $inputreply;
 | 
						|
	my $capture = 0;
 | 
						|
 | 
						|
	foreach my $line (@lines) {
 | 
						|
		if ($capture == 0 && $line =~ m/GET_EMBEDDED_HEALTH_DATA/) {
 | 
						|
                $capture = 1;
 | 
						|
        } elsif ($capture == 1 && $line =~ m/GET_EMBEDDED_HEALTH_DATA/) {
 | 
						|
                $geh_output .= $line;
 | 
						|
                last;
 | 
						|
        }
 | 
						|
        $geh_output .= $line if $capture;
 | 
						|
	}
 | 
						|
	return ($geh_output);
 | 
						|
}
 | 
						|
	
 | 
						|
 | 
						|
sub processGEHReply
 | 
						|
{
 | 
						|
	my $subcommand = shift;
 | 
						|
	my $reply = shift ;
 | 
						|
	
 | 
						|
	use XML::Simple;
 | 
						|
	
 | 
						|
	# Process the reply from the ilo. Parse out all the untereting
 | 
						|
	# stuff so we then have some XML which represents only the output of the GEH command.
 | 
						|
	
 | 
						|
	my $gehXML = makeGEHXML($reply);
 | 
						|
	my $gehOutput = "";
 | 
						|
	
 | 
						|
	# Now use XML::Simple to build a perl hash representation of the output
 | 
						|
	my $gehHash =XMLin($gehXML);
 | 
						|
	
 | 
						|
	# We now have the reply in a format which is easy to parse. Now we 
 | 
						|
	# figure out what the user wants and return it.
 | 
						|
	
 | 
						|
	my $numoftemps = $#{$gehHash->{TEMPERATURE}->{TEMP}};
 | 
						|
	
 | 
						|
	if($subcommand eq "temp" || $subcommand eq "all") {
 | 
						|
		
 | 
						|
		for my $index (0 .. $numoftemps) {
 | 
						|
			my $location = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION}->{VALUE};
 | 
						|
			my $temperature = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{VALUE};
 | 
						|
			my $unit = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{UNIT};
 | 
						|
			$gehOutput .= "$location "."Temperature: "."$temperature $unit \n";
 | 
						|
		}
 | 
						|
	}
 | 
						|
 | 
						|
	if($subcommand eq "cputemp" || $subcommand eq "ambtemp") {
 | 
						|
		my $temp2look4 = "CPU" if ($subcommand eq "cputemp");
 | 
						|
		$temp2look4 = "Ambient" if ($subcommand eq "ambtemp");
 | 
						|
		for my $index (0 .. $numoftemps) {
 | 
						|
			if($gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION} =~ m/$temp2look4/) {
 | 
						|
				my $location = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{LOCATION}->{VALUE};
 | 
						|
				my $temperature = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{VALUE};
 | 
						|
				my $unit = $gehHash->{TEMPERATURE}->{TEMP}[$index]->{CURRENTREADING}->{UNIT};
 | 
						|
				$gehOutput .= " $location "."Temperature: "."$temperature $unit \n";
 | 
						|
			}
 | 
						|
		}
 | 
						|
	}
 | 
						|
	
 | 
						|
	
 | 
						|
	if($subcommand eq "fanspeed" || $subcommand eq "all") {
 | 
						|
		foreach my $fan (keys %{$gehHash->{FANS}}) {
 | 
						|
			my $fanLabel = $gehHash->{FANS}->{$fan}->{LABEL}->{VALUE};
 | 
						|
			my $fanStatus = $gehHash->{FANS}->{$fan}->{STATUS}->{VALUE};
 | 
						|
			my $fanZone = $gehHash->{FANS}->{$fan}->{ZONE}->{VALUE};
 | 
						|
			my $fanUnit = $gehHash->{FANS}->{$fan}->{SPEED}->{UNIT};
 | 
						|
			my $fanSpeedValue = $gehHash->{FANS}->{$fan}->{SPEED}->{VALUE};
 | 
						|
		
 | 
						|
			if($fanUnit eq "Percentage") {
 | 
						|
				$fanUnit = "%";
 | 
						|
			}
 | 
						|
		
 | 
						|
			$gehOutput .= "Fan Status $fanStatus Fan Speed: $fanSpeedValue $fanUnit Label - $fanLabel Zone - $fanZone";
 | 
						|
	
 | 
						|
		}
 | 
						|
	}
 | 
						|
 | 
						|
	return(0, $gehOutput);
 | 
						|
	
 | 
						|
}
 | 
						|
	
 | 
						|
 | 
						|
sub execute_cmd {
 | 
						|
	$outfd = shift;
 | 
						|
	my $node = shift;
 | 
						|
	$currnode= $node;
 | 
						|
	my $iloip = shift;
 | 
						|
	my $user = shift;
 | 
						|
	my $pass = shift;
 | 
						|
	my $command = shift;
 | 
						|
	my %namedargs = @_;
 | 
						|
	my $extra=$namedargs{-args};
 | 
						|
	my @exargs=@$extra;
 | 
						|
 | 
						|
	
 | 
						|
	my $subcommand = $exargs[0];
 | 
						|
	
 | 
						|
	my ($rc, @reply);
 | 
						|
	
 | 
						|
	if($command eq "rpower" ) {   # THe almighty power command
 | 
						|
	
 | 
						|
		($rc, @reply) = issuePowerCmd($iloip, $user, $pass, $subcommand);
 | 
						|
	
 | 
						|
	} elsif ($command eq "rvitals" ) {
 | 
						|
	
 | 
						|
		($rc, @reply) = issueEmbHealthCmd($iloip, $user, $pass, $subcommand);
 | 
						|
		
 | 
						|
	} elsif ($command eq "rbeacon") {
 | 
						|
		
 | 
						|
		($rc, @reply) = issueUIDCmd($iloip, $user, $pass, $subcommand);
 | 
						|
		
 | 
						|
	} elsif ($command eq "reventlog") {
 | 
						|
	
 | 
						|
		($rc, @reply) = issueEventLogCmd($iloip, $user, $pass, $subcommand);
 | 
						|
	
 | 
						|
	}
 | 
						|
	
 | 
						|
	sendoutput($rc, @reply);
 | 
						|
	
 | 
						|
	return $rc;
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
sub issueUIDCmd 
 | 
						|
{
 | 
						|
	my $ipaddr = shift;
 | 
						|
	my $username = shift;
 | 
						|
	my $password = shift;
 | 
						|
	my $subcommand = shift;
 | 
						|
	
 | 
						|
	my $cmdString;
 | 
						|
	
 | 
						|
	if($subcommand eq "on") {
 | 
						|
		$cmdString = $UID_CONTROL_ON;
 | 
						|
	} elsif ($subcommand eq "off") {
 | 
						|
		$cmdString = $UID_CONTROL_OFF;
 | 
						|
	} elsif ($subcommand eq "stat") {
 | 
						|
		$cmdString = $GET_UID_STATUS;
 | 
						|
	} else { # anything else is not supported by the ilo
 | 
						|
		return(-1, "not supported");
 | 
						|
	}
 | 
						|
	
 | 
						|
	# All figured out.... send the command
 | 
						|
	my ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $cmdString);
 | 
						|
	
 | 
						|
	my $condensedReply = processReply("beacon", $subcommand, $reply);
 | 
						|
	
 | 
						|
	return ($rc, $condensedReply);
 | 
						|
}
 | 
						|
 | 
						|
sub issuePowerCmd {
 | 
						|
	my $ipaddr = shift;
 | 
						|
	my $username = shift;
 | 
						|
	my $password = shift;
 | 
						|
	my $subcommand = shift;
 | 
						|
	
 | 
						|
	my $cmdString = "";
 | 
						|
	my ($rc, $reply);
 | 
						|
	
 | 
						|
	if ($subcommand eq "on") {
 | 
						|
		$cmdString = $SET_HOST_POWER_YES;
 | 
						|
	} elsif($subcommand eq "off") {
 | 
						|
		# $cmdString = $SET_HOST_POWER_NO;
 | 
						|
		$cmdString = $HOLD_POWER_BUTTON;
 | 
						|
	} elsif ($subcommand eq "stat" || $subcommand eq "state") {
 | 
						|
		$cmdString = $GET_HOST_POWER_STATUS;
 | 
						|
	} elsif ($subcommand eq "reset") {
 | 
						|
		$cmdString = $RESET_SERVER;
 | 
						|
	} elsif ($subcommand eq "softoff") {
 | 
						|
		$cmdString = $HOLD_POWER_BUTTON;
 | 
						|
	# Handle two special cases here. For these commands we will need to issue a series of
 | 
						|
	# commands to the ilo to emulate the desired operation
 | 
						|
	} elsif ($subcommand eq "cycle") {
 | 
						|
		($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $SET_HOST_POWER_NO);
 | 
						|
		sleep 15;
 | 
						|
		if ($rc != 0) {
 | 
						|
			print STDERR "issuePowerCmd:cycle Command to power down server failed. \n";
 | 
						|
			return ($rc, $reply);
 | 
						|
		}
 | 
						|
		$cmdString = $SET_HOST_POWER_YES;
 | 
						|
		
 | 
						|
	} elsif ($subcommand eq "boot") {
 | 
						|
		# Determine the current power status of the server
 | 
						|
		($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_HOST_POWER_STATUS);
 | 
						|
		if ($rc == 0) {
 | 
						|
			my $powerstatus = processReply("power", "status", $reply);
 | 
						|
			
 | 
						|
			if ($reply eq "ON") {
 | 
						|
				$cmdString = $RESET_SERVER;
 | 
						|
			} else {
 | 
						|
				$cmdString = $SET_HOST_POWER_YES;
 | 
						|
			}
 | 
						|
		} else {
 | 
						|
			print STDERR "issuePowerCmd:boot Power status of server failed. \n";
 | 
						|
			return ($rc, $reply);
 | 
						|
		}
 | 
						|
		
 | 
						|
	}
 | 
						|
	print "cmdstring is $cmdString \n";
 | 
						|
	
 | 
						|
	($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $cmdString);
 | 
						|
	
 | 
						|
	my $condensedReply = processReply("power", $subcommand, $reply);
 | 
						|
	
 | 
						|
	return ($rc, $condensedReply);
 | 
						|
}
 | 
						|
 | 
						|
 | 
						|
sub issueEmbHealthCmd {
 | 
						|
	my $ipaddr = shift;
 | 
						|
	my $username = shift;
 | 
						|
	my $password = shift;
 | 
						|
	my $subcommand = shift;
 | 
						|
	
 | 
						|
	my ($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_EMBEDDED_HEALTH);
 | 
						|
	
 | 
						|
	my $condensedReply = processGEHReply($subcommand, $reply);
 | 
						|
	
 | 
						|
	return ($rc, $condensedReply);
 | 
						|
}
 | 
						|
 | 
						|
sub issueEventLogCmd {
 | 
						|
	my $ipaddr = shift;
 | 
						|
	my $username = shift;
 | 
						|
	my $password = shift;
 | 
						|
	my $subcommand = shift;
 | 
						|
	
 | 
						|
	my $numberOfEntries = "";
 | 
						|
	my $errorLogOutput;
 | 
						|
	my ($rc, $reply);
 | 
						|
	
 | 
						|
	if($subcommand eq "clear") {
 | 
						|
		($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $CLEAR_EVENT_LOG);
 | 
						|
		return($rc, $reply);
 | 
						|
	}
 | 
						|
	
 | 
						|
	if(! $subcommand =~ /\D/) {
 | 
						|
		$numberOfEntries = $subcommand;
 | 
						|
	}
 | 
						|
	
 | 
						|
	if($subcommand eq "all" || $numberOfEntries) {
 | 
						|
		($rc, $reply) = iloCmd($ipaddr, $username, $password, 0, $GET_EVENT_LOG);
 | 
						|
		
 | 
						|
		if ($rc != 0) {
 | 
						|
			print STDERR "issueEventLogCmd: Failed get error log \n";
 | 
						|
		}
 | 
						|
		$errorLogOutput = processErrorLogReply($reply);
 | 
						|
	}
 | 
						|
	
 | 
						|
	return ($rc, $errorLogOutput);
 | 
						|
}
 | 
						|
		
 | 
						|
	
 | 
						|
 | 
						|
sub iloCmd {
 | 
						|
	my $ipaddr = shift;
 | 
						|
	my $username = shift;
 | 
						|
	my $password = shift;
 | 
						|
	my $localdebug = shift;
 | 
						|
	my $command = shift;
 | 
						|
	
 | 
						|
	# Before we open the connection to the iLO, build the command we are going
 | 
						|
	# to send
 | 
						|
	
 | 
						|
	my $cmdToSend = $INITIAL_HEADER;
 | 
						|
	$cmdToSend =~ s/AdMiNnAmE/$username/;
 | 
						|
	$cmdToSend =~ s/PaSsWoRd/$password/;
 | 
						|
	$cmdToSend = "$cmdToSend"."$command";
 | 
						|
	
 | 
						|
	if($localdebug) {
 | 
						|
		print STDERR "Command built. Command is $cmdToSend \n";
 | 
						|
	}
 | 
						|
	
 | 
						|
	my $reply = sendScript($ipaddr, $cmdToSend);
 | 
						|
	
 | 
						|
	return(0, $reply);
 | 
						|
}
 | 
						|
 | 
						|
sub forward_data { #unserialize data from pipe, chunk at a time, use magic to determine end of data structure
 | 
						|
	my $callback = shift;
 | 
						|
	my $fds = shift;
 | 
						|
	my $errornodes=shift;
 | 
						|
 | 
						|
	my @ready_fds = $fds->can_read(1);
 | 
						|
	my $rfh;
 | 
						|
 	my $rc = @ready_fds;
 | 
						|
 	foreach $rfh (@ready_fds) {
 | 
						|
		my $data;
 | 
						|
		if ($data = <$rfh>) {
 | 
						|
			while ($data !~ /ENDOFFREEZE6sK4ci/) {
 | 
						|
				$data .= <$rfh>;
 | 
						|
			}
 | 
						|
			print $rfh "ACK\n";
 | 
						|
			my $responses=thaw($data);
 | 
						|
			foreach (@$responses) {
 | 
						|
				#save the nodes that has errors and the ones that has no-op for use by the node status monitoring
 | 
						|
				my $no_op=0;
 | 
						|
				if (exists($_->{node}->[0]->{errorcode})) { $no_op=1; }
 | 
						|
				else {
 | 
						|
					my $text=$_->{node}->[0]->{data}->[0]->{contents}->[0];
 | 
						|
					#print "data:$text\n";
 | 
						|
					if (($text) && ($text =~ /$status_noop/)) {
 | 
						|
						$no_op=1;
 | 
						|
						#remove the symbols that meant for use by node status
 | 
						|
						$_->{node}->[0]->{data}->[0]->{contents}->[0] =~ s/ $status_noop//;
 | 
						|
					}
 | 
						|
				}
 | 
						|
				#print "data:". $_->{node}->[0]->{data}->[0]->{contents}->[0] . "\n";
 | 
						|
				if ($no_op) {
 | 
						|
					if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=-1; }
 | 
						|
				} else {
 | 
						|
					if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=1; }
 | 
						|
				}
 | 
						|
				$callback->($_);
 | 
						|
			}
 | 
						|
		} else {
 | 
						|
			$fds->remove($rfh);
 | 
						|
			close($rfh);
 | 
						|
		}
 | 
						|
	}
 | 
						|
yield; #Avoid useless loop iterations by giving children a chance to fill pipes  return $rc;
 | 
						|
}
 | 
						|
 | 
						|
	
 | 
						|
 | 
						|
sub sendoutput {
 | 
						|
	my $rc=shift;
 | 
						|
	foreach (@_) {
 | 
						|
		my %output;
 | 
						|
		(my $desc,my $text) = split(/:/,$_,2);
 | 
						|
		unless ($text) {
 | 
						|
			$text=$desc;
 | 
						|
		} else {
 | 
						|
			$desc =~ s/^\s+//;
 | 
						|
			$desc =~ s/\s+$//;
 | 
						|
			if ($desc) {
 | 
						|
				$output{node}->[0]->{data}->[0]->{desc}->[0]=$desc;
 | 
						|
			}
 | 
						|
		}
 | 
						|
		$text =~ s/^\s+//;
 | 
						|
		$text =~ s/\s+$//;
 | 
						|
		$output{node}->[0]->{name}->[0]=$currnode;
 | 
						|
		$output{node}->[0]->{data}->[0]->{contents}->[0]=$text;
 | 
						|
		if ($rc) {
 | 
						|
			$output{node}->[0]->{errorcode}=[$rc];
 | 
						|
		}
 | 
						|
		#push @outhashes,\%output; #Save everything for the end, don't know how to be slicker with Storable and a pipe
 | 
						|
		print $outfd freeze([\%output]);
 | 
						|
		print $outfd "\nENDOFFREEZE6sK4ci\n";
 | 
						|
		yield;
 | 
						|
		waitforack($outfd);
 | 
						|
	}
 | 
						|
}
 | 
						|
 | 
						|
1;
 | 
						|
 | 
						|
	
 | 
						|
		
 |