hp ilo plugins

git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@4546 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd

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 = '
+<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;
+
+	
+		

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 = '
+<wsse:Security xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd" SOAP-ENV:mustUnderstand="true">
+  <hpoa:HpOaSessionKeyToken xmlns:hpoa="hpoa.xsd">
+     <hpoa:oaSessionKey>'
+       . $key .
+    '</hpoa:oaSessionKey>
+  </hpoa:HpOaSessionKeyToken>
+</wsse:Security>';
+
+    $self->{HPOA_KEY} 		  = $key;
+    $self->{HPOA_SECURITY_XML} 	  = $xml;
+    $self->{HPOA_SECURITY_HEADER} = SOAP::Header->type('xml' => $xml);
+  }
+
+  # Return the response
+  return $r;
+}
+
+## Create the correct SOAP::Data structure for the given args
+## $n is the argument name
+## $v is the value and can be of the following 4 forms:
+##   $scalar
+##	- A scalar value.  No further processing takes place.
+##	  Produces: <name>value</name>
+##   [ $scalar, $type ]
+##	- An array ref containing a scalar value and type.  No further
+##	  will take place.
+##	  Produces: <name type=aType>value</name>
+##   [ $itemName, $aref, $type ]
+##	- An array ref containing the name for the elements, the elements
+##	  themselves in an array ref, and the type for the elements.  The
+##	  elements themselves can be processed.
+##	  Produces: <name>
+##		      <item type=aType>value1</item>
+##		      <item type=aType>value2</item>
+##		    </name>
+##   { $n1 => $v1, $n2 => $v2 ... }
+##	- A hash ref containing name value pairs that can themselves
+##	  be processed.
+##	  Produces: <name>
+##		      <n1>v1</n1>
+##		      <n2>v2</n2>
+##	 	    </name>
+
+sub process_args {
+  my ($self, $n, $v, $t) = @_;
+  print "process args: $n => $v\n"					if 0;
+
+  if (!ref $v) {		# untyped scalar
+    print "\nUNTYPED SCALAR: $n => $v\n"				if 0;
+    return SOAP::Data->new(name => $n, value => $v, type => '');
+  }
+
+  if (ref $v eq 'HASH') {	# structure
+    my ($nn, $vv, @ar);
+    while (($nn, $vv) = each %$v) {
+      print "\nSTRUCTURE $n: $nn => $vv\n"				if 0;
+      unshift @ar, $self->process_args($nn, $vv);
+    }
+    return SOAP::Data->name($n => \SOAP::Data->value(@ar));
+  }
+
+  if (ref $v eq 'ARRAY') {
+
+    if (scalar @$v == 2) {	# typed scalar
+      my ($value, $type) = @$v;
+      print "\nTYPED SCALAR: $n => $value ($type)\n"			if 0;
+      return SOAP::Data->new(name => $n, value => $value, type => $type);
+    }
+
+    # Else an array of values
+    my ($itemName, $aref, $type) = @$v;
+    my (@ar, $item);
+    foreach $item (@$aref) {
+      if (ref $item eq 'HASH') {
+	print "\nSUB STRUCTURE $n: $itemName => $item ($type)\n"	if 0;
+	unshift @ar, $self->process_args("$itemName", $item);
+      } else {
+	print "\nARRAY $n: $itemName => $item ($type)\n"		if 0;
+	unshift @ar, $self->process_args($itemName, [$item, $type]);
+      }
+    }
+    return SOAP::Data->name($n => \SOAP::Data->value(@ar));
+  }
+
+  die "Unexpected input parameter value: $n => $v\n";
+}
+
+###
+### Special fault info for OAs
+###
+
+# The OA uses it's own fault data structures.  The simple
+# fault methods provided by SOAP::Lite are usually undef.
+# The OA's fault data looks like this:
+# {
+#   'Detail' => {
+#      'faultInfo' => {
+#         'operationName' => 'userLogIn',
+#         'errorText' => 'The user could not be authenticated.',
+#         'errorCode' => '150',
+#         'errorType' => 'USER_REQUEST'
+#      }
+#   },
+#   'Reason' => {
+#      'Text' => 'User Request Error'
+#   },
+#   'Code' => {
+#      'Value' => 'SOAP-ENV:Sender'
+#   }
+#}
+#
+# In your code, you should generally check that $response->fault
+# is defined, then print $response->oaErrorMessage.
+# If you know the codes, you can act on $response->oaErrorCode
+#
+
+# The OA's fault structure
+sub SOAP::SOM::oaFaultInfo {
+  my ($self, @args) = @_;
+
+  return $self->fault->{Detail}->{faultInfo}
+    if (defined $self->fault &&
+	defined $self->fault->{Detail} &&
+	defined $self->fault->{Detail}->{faultInfo});
+
+  return undef;
+}
+
+# The name of the method producing the fault
+sub SOAP::SOM::oaOperationName {
+  my ($self, @args) = @_;
+
+  my $oafi = $self->oaFaultInfo;
+
+  return $oafi->{operationName}
+    if defined $oafi &&
+      defined $oafi->{operationName};
+
+  return undef;
+}
+
+# Text of the OA fault
+sub SOAP::SOM::oaErrorText {
+  my ($self, @args) = @_;
+
+  my $oafi = $self->oaFaultInfo;
+
+  return $oafi->{errorText}
+    if defined $oafi &&
+      defined $oafi->{errorText};
+
+  return undef;
+}
+
+# Numeric code of the OA fault
+sub SOAP::SOM::oaErrorCode {
+  my ($self, @args) = @_;
+
+  my $oafi = $self->oaFaultInfo;
+
+  if (defined $oafi) {
+
+    return $oafi->{errorCode}
+      if defined $oafi->{errorCode};
+
+    return $oafi->{internalErrorCode}
+      if defined $oafi->{internalErrorCode};
+  }
+
+  return undef;
+}
+
+# Bay Number of the OA fault
+sub SOAP::SOM::oaOperationBayNumber {
+  my ($self, @args) = @_;
+
+  my $oafi = $self->oaFaultInfo;
+
+  return $oafi->{operationBayNumber}
+    if defined $oafi &&
+      defined $oafi->{operationBayNumber};
+
+  return undef;
+}
+
+# Sometimes there's extra fault information
+# (Haven't seen any yet!)
+sub SOAP::SOM::oaExtraFaultData {
+  my ($self, @args) = @_;
+
+  my $oafi = $self->oaFaultInfo;
+
+  return $oafi->{extraData}
+    if defined $oafi &&
+      defined $oafi->{extraData};
+
+  return undef;
+}
+
+# Nicely formatted error message for human consumption.
+# Tries to use the oaErrorText and oaErrorCode, if defined,
+# else uses the reason text.
+sub SOAP::SOM::oaErrorMessage {
+  my ($self, @args) = @_;
+
+  my $errorText  = $self->oaErrorText;
+
+  # Reason text is either an error message from SOAP (as when
+  # the method or argument doesn't exist), or it's a formatted
+  # form of the faultInfo->errorType enumeration.
+  my $reasonText = $self->fault->{Reason}->{Text};
+
+  return $reasonText
+    unless defined $errorText;
+
+  my $operationName = $self->oaOperationName;
+  my $operationBay  = $self->oaOperationBayNumber;
+  my $errorCode     = $self->oaErrorCode;
+  my $extraData     = $self->oaExtraFaultData;
+
+  my $operation = "'$operationName' call";
+  $operation .= " on bay $operationBay"
+    if $operationBay;
+
+  my $completeText =
+    "$reasonText $errorCode during $operation: $errorText";
+  $completeText .= "\n\t$extraData" if $extraData;
+
+  return $completeText;
+}
+
+1;

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.
+

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 "</<hpiLO->"
+sleep 5
+
+send -s "vsp"
+sleep 1
+
+send "\r"
+
+exit 0