git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@50 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
This commit is contained in:
sakolish
parent
04631e79b6
commit
c4f6fd4bae
630
perl-xCAT-2.0/xCAT/PPC.pm
Normal file
630
perl-xCAT-2.0/xCAT/PPC.pm
Normal file
@ -0,0 +1,630 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPC;
|
||||
use strict;
|
||||
use xCAT::Table;
|
||||
use POSIX "WNOHANG";
|
||||
use Storable qw(freeze thaw);
|
||||
use Time::HiRes qw(gettimeofday);
|
||||
use IO::Select;
|
||||
use xCAT::PPCcli;
|
||||
use xCAT::PPCfsp;
|
||||
|
||||
|
||||
##########################################
|
||||
# Globals
|
||||
##########################################
|
||||
my %modules = (
|
||||
rinv => "xCAT::PPCinv",
|
||||
rpower => "xCAT::PPCpower",
|
||||
rvitals => "xCAT::PPCvitals",
|
||||
rscan => "xCAT::PPCscan",
|
||||
mkvm => "xCAT::PPCvm",
|
||||
rmvm => "xCAT::PPCvm",
|
||||
lsvm => "xCAT::PPCvm",
|
||||
chvm => "xCAT::PPCvm",
|
||||
rnetboot => "xCAT::PPCboot",
|
||||
getmacs => "xCAT::PPCmac",
|
||||
reventlog => "xCAT::PPClog"
|
||||
);
|
||||
|
||||
##########################################
|
||||
# Database errors
|
||||
##########################################
|
||||
my %errmsg = (
|
||||
NODE_UNDEF =>"Node not defined in '%s' database",
|
||||
NO_ATTR =>"'%s' not defined in '%s' database",
|
||||
DB_UNDEF =>"'%s' database not defined"
|
||||
);
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Invokes the callback with the specified message
|
||||
##########################################################################
|
||||
sub send_msg {
|
||||
|
||||
my $request = shift;
|
||||
my %output;
|
||||
|
||||
#################################################
|
||||
# Called from child process - send to parent
|
||||
#################################################
|
||||
if ( exists( $request->{pipe} )) {
|
||||
my $out = $request->{pipe};
|
||||
|
||||
$output{data} = \@_;
|
||||
print $out freeze( [\%output] );
|
||||
}
|
||||
#################################################
|
||||
# Called from parent - invoke callback directly
|
||||
#################################################
|
||||
elsif ( exists( $request->{callback} )) {
|
||||
my $callback = $request->{callback};
|
||||
|
||||
$output{data} = \@_;
|
||||
$callback->( \%output );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Fork child to execute remote commands
|
||||
##########################################################################
|
||||
sub process_command {
|
||||
|
||||
my $request = shift;
|
||||
my $maxp = 64;
|
||||
my %nodes = ();
|
||||
my $callback = $request->{callback};
|
||||
my $start;
|
||||
|
||||
if ( exists( $request->{verbose} )) {
|
||||
$start = Time::HiRes::gettimeofday();
|
||||
}
|
||||
#######################################
|
||||
# Group nodes based on command
|
||||
#######################################
|
||||
my $nodes = preprocess_nodes( $request );
|
||||
if ( !defined( $nodes )) {
|
||||
return(1);
|
||||
}
|
||||
#######################################
|
||||
# Fork process
|
||||
#######################################
|
||||
my $children = 0;
|
||||
$SIG{CHLD} = sub { while (waitpid(-1, WNOHANG) > 0) { $children--; } };
|
||||
my $fds = new IO::Select;
|
||||
|
||||
foreach ( @$nodes ) {
|
||||
while ( $children > $maxp ) {
|
||||
sleep(0.1);
|
||||
}
|
||||
my $pipe = fork_cmd( @$_[0], @$_[1], $request );
|
||||
if ( $pipe ) {
|
||||
$fds->add( $pipe );
|
||||
$children++;
|
||||
}
|
||||
}
|
||||
#######################################
|
||||
# Process responses from children
|
||||
#######################################
|
||||
while ( $children > 0 ) {
|
||||
child_response( $callback, $fds );
|
||||
}
|
||||
if ( exists( $request->{verbose} )) {
|
||||
my $elapsed = Time::HiRes::gettimeofday() - $start;
|
||||
printf STDERR "Total Elapsed Time: %.3f sec\n", $elapsed;
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Send response from child process back to xCAT client
|
||||
##########################################################################
|
||||
sub child_response {
|
||||
|
||||
my $callback = shift;
|
||||
my $fds = shift;
|
||||
my @ready_fds = $fds->can_read(1);
|
||||
|
||||
foreach my $rfh (@ready_fds) {
|
||||
my $data;
|
||||
|
||||
#################################
|
||||
# Read from child
|
||||
#################################
|
||||
while (<$rfh>) {
|
||||
$data.= $_;
|
||||
}
|
||||
#################################
|
||||
# Command results
|
||||
#################################
|
||||
my $responses = thaw($data);
|
||||
foreach (@$responses) {
|
||||
$callback->($_);
|
||||
}
|
||||
$fds->remove($rfh);
|
||||
close($rfh);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Group nodes depending on command
|
||||
##########################################################################
|
||||
sub preprocess_nodes {
|
||||
|
||||
my $request = shift;
|
||||
my $noderange = $request->{node};
|
||||
my $method = $request->{method};
|
||||
my %nodehash = ();
|
||||
my @nodegroup = ();
|
||||
my %tabs = ();
|
||||
|
||||
########################################
|
||||
# Special cases
|
||||
# rscan - Nodes are hardware control pts
|
||||
# Direct-attached FSP
|
||||
########################################
|
||||
if (( $request->{command} eq "rscan" ) or
|
||||
( $request->{hwtype} eq "fsp" )) {
|
||||
|
||||
my $tab = ($request->{hwtype} eq "fsp") ? "ppcDirect" : "ppchcp";
|
||||
my $db = xCAT::Table->new( $tab );
|
||||
|
||||
if ( !defined( $db )) {
|
||||
send_msg( $request, sprintf( $errmsg{DB_UNDEF}, $tab ));
|
||||
return undef;
|
||||
}
|
||||
####################################
|
||||
# Process each node
|
||||
####################################
|
||||
foreach ( @$noderange ) {
|
||||
my ($ent) = $db->getAttribs( {hcp=>$_},"hcp" );
|
||||
|
||||
if ( !defined( $ent )) {
|
||||
my $msg = sprintf( "$_: $errmsg{NODE_UNDEF}", $tab );
|
||||
send_msg( $request, $msg );
|
||||
next;
|
||||
}
|
||||
################################
|
||||
# Save values
|
||||
################################
|
||||
push @nodegroup,[$_];
|
||||
}
|
||||
return( \@nodegroup );
|
||||
}
|
||||
|
||||
##########################################
|
||||
# Open databases needed
|
||||
##########################################
|
||||
foreach ( qw(ppc vpd nodelist) ) {
|
||||
$tabs{$_} = xCAT::Table->new($_);
|
||||
|
||||
if ( !exists( $tabs{$_} )) {
|
||||
send_msg( $request, sprintf( $errmsg{DB_UNDEF}, $_ ));
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
##########################################
|
||||
# Group nodes
|
||||
##########################################
|
||||
foreach my $node ( @$noderange ) {
|
||||
my $d = resolve( $request, $node, \%tabs );
|
||||
|
||||
######################################
|
||||
# Error locating node attributes
|
||||
######################################
|
||||
if ( ref($d) ne 'ARRAY' ) {
|
||||
send_msg( $request,"$node: $d");
|
||||
next;
|
||||
}
|
||||
######################################
|
||||
# Get data values
|
||||
######################################
|
||||
my $hcp = @$d[3];
|
||||
my $mtms = @$d[2];
|
||||
|
||||
$nodehash{$hcp}{$mtms}{$node} = $d;
|
||||
}
|
||||
##########################################
|
||||
# Group the nodes - we will fork one
|
||||
# process per nodegroup array element.
|
||||
##########################################
|
||||
|
||||
##########################################
|
||||
# These commands are grouped on an
|
||||
# LPAR-by-LPAR basis - fork one process
|
||||
# per LPAR.
|
||||
##########################################
|
||||
if ( $method =~ /^getmacs|rnetboot$/ ) {
|
||||
while (my ($hcp,$hash) = each(%nodehash) ) {
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
while (my ($lpar,$d) = each(%$h)) {
|
||||
push @$d, $lpar;
|
||||
push @nodegroup,[$hcp,$d];
|
||||
}
|
||||
}
|
||||
}
|
||||
return( \@nodegroup );
|
||||
}
|
||||
##########################################
|
||||
# Power control commands are grouped
|
||||
# by CEC which is the smallest entity
|
||||
# that commands can be sent to in parallel.
|
||||
# If commands are sent in parallel to a
|
||||
# single CEC, the CEC itself will serialize
|
||||
# them - fork one process per CEC.
|
||||
##########################################
|
||||
elsif ( $method =~ /^powercmd/ ) {
|
||||
while (my ($hcp,$hash) = each(%nodehash) ) {
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
push @nodegroup,[$hcp,$h];
|
||||
}
|
||||
}
|
||||
return( \@nodegroup );
|
||||
}
|
||||
##########################################
|
||||
# All other commands are grouped by
|
||||
# hardware control point - fork one
|
||||
# process per hardware control point.
|
||||
##########################################
|
||||
while (my ($hcp,$hash) = each(%nodehash) ) {
|
||||
push @nodegroup,[$hcp,$hash];
|
||||
}
|
||||
return( \@nodegroup );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Findis attributes for given node is various databases
|
||||
##########################################################################
|
||||
sub resolve {
|
||||
|
||||
my $request = shift;
|
||||
my $node = shift;
|
||||
my $tabs = shift;
|
||||
my @attribs = qw(id profile mgt hcp);
|
||||
my @values = ();
|
||||
|
||||
#################################
|
||||
# Get node type
|
||||
#################################
|
||||
my ($ent) = $tabs->{nodelist}->getAttribs({'node'=>$node}, "nodetype" );
|
||||
if ( !defined( $ent )) {
|
||||
return( sprintf( $errmsg{NODE_UNDEF}, "nodelist" ));
|
||||
}
|
||||
#################################
|
||||
# Check for type
|
||||
#################################
|
||||
if ( !exists( $ent->{nodetype} )) {
|
||||
return( sprintf( $errmsg{NO_ATTR}, $ent->{nodetype}, "nodelist" ));
|
||||
}
|
||||
#################################
|
||||
# Check for valid "type"
|
||||
#################################
|
||||
if ( $ent->{nodetype} !~ /^fsp|bpa|osi$/ ) {
|
||||
return( "Invalid node type: $ent->{nodetype}" );
|
||||
}
|
||||
my $type = $ent->{nodetype};
|
||||
|
||||
#################################
|
||||
# Get attributes
|
||||
#################################
|
||||
my ($att) = $tabs->{ppc}->getAttribs({'node'=>$node}, @attribs );
|
||||
|
||||
if ( !defined( $att )) {
|
||||
return( sprintf( $errmsg{NODE_UNDEF}, "ppc" ));
|
||||
}
|
||||
#################################
|
||||
# Special lpar processing
|
||||
#################################
|
||||
if ( $type =~ /^osi$/ ) {
|
||||
$att->{bpa} = 0;
|
||||
$att->{type} = "lpar";
|
||||
$att->{node} = $att->{mgt};
|
||||
|
||||
if ( !exists( $att->{mgt} )) {
|
||||
return( sprintf( $errmsg{NO_ATTR}, "mgt", "ppc" ));
|
||||
}
|
||||
#############################
|
||||
# Get BPA (if any)
|
||||
#############################
|
||||
if (( $request->{command} eq "rvitals" ) &&
|
||||
( $request->{method} =~ /^all|temp$/ )) {
|
||||
my ($ent) = $tabs->{ppc}->getAttribs({'node'=>$att->{mgt}}, "mgt" );
|
||||
|
||||
#############################
|
||||
# Find MTMS in vpd database
|
||||
#############################
|
||||
if (( defined( $ent )) && exists( $ent->{mgt} )) {
|
||||
my @attrs = qw(mtm serial);
|
||||
my ($vpd) = $tabs->{vpd}->getAttribs({node=>$ent->{mgt}},@attrs );
|
||||
|
||||
if ( !defined( $vpd )) {
|
||||
return( sprintf( $errmsg{NO_UNDEF}, "vpd" ));
|
||||
}
|
||||
########################
|
||||
# Verify attributes
|
||||
########################
|
||||
foreach ( @attrs ) {
|
||||
if ( !exists( $vpd->{$_} )) {
|
||||
return( sprintf( $errmsg{NO_ATTR}, $_, "vpd" ));
|
||||
}
|
||||
}
|
||||
$att->{bpa} = "$vpd->{mtm}*$vpd->{serial}";
|
||||
}
|
||||
}
|
||||
}
|
||||
#################################
|
||||
# Optional and N/A fields
|
||||
#################################
|
||||
elsif ( $type =~ /^fsp$/ ) {
|
||||
$att->{profile} = 0;
|
||||
$att->{id} = 0;
|
||||
$att->{fsp} = 0;
|
||||
$att->{node} = $node;
|
||||
$att->{type} = $type;
|
||||
$att->{mgt} = exists($att->{mgt}) ? $att->{mgt} : 0;
|
||||
$att->{bpa} = $att->{mgt};
|
||||
}
|
||||
elsif ( $type =~ /^bpa$/ ) {
|
||||
$att->{profile} = 0;
|
||||
$att->{id} = 0;
|
||||
$att->{bpa} = 0;
|
||||
$att->{mgt} = 0;
|
||||
$att->{fsp} = 0;
|
||||
$att->{node} = $node;
|
||||
$att->{type} = $type;
|
||||
}
|
||||
#################################
|
||||
# Find MTMS in vpd database
|
||||
#################################
|
||||
my @attrs = qw(mtm serial);
|
||||
my ($vpd) = $tabs->{vpd}->getAttribs({node=>$att->{node}}, @attrs );
|
||||
|
||||
if ( !defined( $vpd )) {
|
||||
return( sprintf( $errmsg{NODE_UNDEF}, "vpd" ));
|
||||
}
|
||||
################################
|
||||
# Verify both vpd attributes
|
||||
################################
|
||||
foreach ( @attrs ) {
|
||||
if ( !exists( $vpd->{$_} )) {
|
||||
return( sprintf( $errmsg{NO_ATTR}, $_, "vpd" ));
|
||||
}
|
||||
}
|
||||
$att->{fsp} = "$vpd->{mtm}*$vpd->{serial}";
|
||||
|
||||
#################################
|
||||
# Verify required attributes
|
||||
#################################
|
||||
foreach my $at ( @attribs ) {
|
||||
if ( !exists( $att->{$at} )) {
|
||||
return( sprintf( $errmsg{NO_ATTR}, $at, "ppc" ));
|
||||
}
|
||||
}
|
||||
#################################
|
||||
# Build array of data
|
||||
#################################
|
||||
foreach ( qw(id profile fsp hcp type bpa) ) {
|
||||
push @values, $att->{$_};
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Forks a process to run the ssh command
|
||||
##########################################################################
|
||||
sub fork_cmd {
|
||||
|
||||
my $host = shift;
|
||||
my $nodes = shift;
|
||||
my $request = shift;
|
||||
|
||||
#######################################
|
||||
# Pipe childs output back to parent
|
||||
#######################################
|
||||
my $parent;
|
||||
my $child;
|
||||
pipe $parent, $child;
|
||||
my $pid = fork;
|
||||
|
||||
if ( !defined($pid) ) {
|
||||
###################################
|
||||
# Fork error
|
||||
###################################
|
||||
send_msg( $request, "Fork error: $!" );
|
||||
return undef;
|
||||
}
|
||||
elsif ( $pid == 0 ) {
|
||||
###################################
|
||||
# Child process
|
||||
###################################
|
||||
close( $parent );
|
||||
$request->{pipe} = $child;
|
||||
|
||||
invoke_cmd( $host, $nodes, $request );
|
||||
exit(0);
|
||||
}
|
||||
else {
|
||||
###################################
|
||||
# Parent process
|
||||
###################################
|
||||
close( $child );
|
||||
return( $parent );
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Run the command, process the response, and send to parent
|
||||
##########################################################################
|
||||
sub invoke_cmd {
|
||||
|
||||
my $host = shift;
|
||||
my $nodes = shift;
|
||||
my $request = shift;
|
||||
my $hwtype = $request->{hwtype};
|
||||
my $verbose = $request->{verbose};
|
||||
my @exp;
|
||||
my @outhash;
|
||||
|
||||
########################################
|
||||
# Direct-attached FSP handler
|
||||
########################################
|
||||
if ( $hwtype eq "fsp" ) {
|
||||
my $result = xCAT::PPCfsp::handler( $host, $request );
|
||||
|
||||
my $out = $request->{pipe};
|
||||
print $out freeze( $result );
|
||||
return;
|
||||
}
|
||||
########################################
|
||||
# Connect to list of remote servers
|
||||
########################################
|
||||
foreach ( split /,/, $host ) {
|
||||
@exp = xCAT::PPCcli::connect( $hwtype, $_, $verbose );
|
||||
|
||||
####################################
|
||||
# Successfully connected
|
||||
####################################
|
||||
if ( ref($exp[0]) eq "Expect" ) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
########################################
|
||||
# Error connecting
|
||||
########################################
|
||||
if ( ref($exp[0]) ne "Expect" ) {
|
||||
send_msg( $request, $exp[0] );
|
||||
return;
|
||||
}
|
||||
########################################
|
||||
# Process specific command
|
||||
########################################
|
||||
my $result = runcmd( $request, $nodes, \@exp );
|
||||
|
||||
########################################
|
||||
# Close connection to remote server
|
||||
########################################
|
||||
xCAT::PPCcli::disconnect( \@exp );
|
||||
|
||||
########################################
|
||||
# Return error
|
||||
########################################
|
||||
if ( ref($result) ne 'ARRAY' ) {
|
||||
send_msg( $request, $result );
|
||||
return;
|
||||
}
|
||||
########################################
|
||||
# Send result back to parent process
|
||||
########################################
|
||||
if ( @$result[0] eq "FORMATTED_DATA" ) {
|
||||
shift(@$result);
|
||||
my $out = $request->{pipe};
|
||||
print $out freeze( [@$result] );
|
||||
return;
|
||||
}
|
||||
########################################
|
||||
# Format and send back to parent
|
||||
########################################
|
||||
foreach ( @$result ) {
|
||||
my %output;
|
||||
$output{node}->[0]->{name}->[0] = @$_[0];
|
||||
$output{node}->[0]->{data}->[0]->{contents}->[0] = @$_[1];
|
||||
push @outhash, \%output;
|
||||
}
|
||||
my $out = $request->{pipe};
|
||||
print $out freeze( [@outhash] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Run the command method specified
|
||||
##########################################################################
|
||||
sub runcmd {
|
||||
|
||||
my $request = shift;
|
||||
my $cmd = $request->{command};
|
||||
my $method = $request->{method};
|
||||
my $modname = $modules{$cmd};
|
||||
|
||||
######################################
|
||||
# Load specific module
|
||||
######################################
|
||||
unless ( eval "require $modname" ) {
|
||||
return( ["Can't locate $modname"] );
|
||||
}
|
||||
######################################
|
||||
# Invoke method
|
||||
######################################
|
||||
no strict 'refs';
|
||||
my $result = ${$modname."::"}{$method}->($request,@_);
|
||||
use strict;
|
||||
|
||||
return( $result );
|
||||
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Process request from xCat daemon
|
||||
##########################################################################
|
||||
sub process_request {
|
||||
|
||||
my $package = shift;
|
||||
my $req = shift;
|
||||
my $callback = shift;
|
||||
|
||||
####################################
|
||||
# Get hwtype
|
||||
####################################
|
||||
$package =~ s/xCAT_plugin:://;
|
||||
|
||||
####################################
|
||||
# Build hash to pass around
|
||||
####################################
|
||||
my %request;
|
||||
$request{command} = $req->{command}->[0];
|
||||
$request{arg} = $req->{arg};
|
||||
$request{node} = $req->{node};
|
||||
$request{stdin} = $req->{stdin}->[0];
|
||||
$request{hwtype} = $package;
|
||||
$request{callback} = $callback;
|
||||
$request{method} = "parse_args";
|
||||
|
||||
####################################
|
||||
# Process command-specific options
|
||||
####################################
|
||||
my $opt = runcmd( \%request );
|
||||
|
||||
####################################
|
||||
# Return error
|
||||
####################################
|
||||
if ( ref($opt) eq 'ARRAY' ) {
|
||||
send_msg( \%request, @$opt );
|
||||
return(1);
|
||||
}
|
||||
####################################
|
||||
# Option -V for verbose output
|
||||
####################################
|
||||
if ( exists( $opt->{V} )) {
|
||||
$request{verbose} = 1;
|
||||
}
|
||||
####################################
|
||||
# Process remote command
|
||||
####################################
|
||||
$request{opt} = $opt;
|
||||
process_command( \%request );
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
1;
|
||||
170
perl-xCAT-2.0/xCAT/PPCboot.pm
Normal file
170
perl-xCAT-2.0/xCAT/PPCboot.pm
Normal file
@ -0,0 +1,170 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCboot;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rnetboot -h|--help",
|
||||
"rnetboot -v|--version",
|
||||
"rnetboot [-V|--verbose] noderange -S server -G gateway -C client -m MAC-address",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -C IP of the partition to network boot",
|
||||
" -G Gateway IP of the partition specified",
|
||||
" -S IP of the machine to retrieve network boot image",
|
||||
" -m MAC address of network adapter to use for network boot",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return( usage() );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt,
|
||||
qw(h|help V|Verbose v|version C=s G=s S=s m=s ))) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Option -m required
|
||||
####################################
|
||||
if ( !exists($opt{m}) ) {
|
||||
return(usage( "Missing option: -m" ));
|
||||
}
|
||||
####################################
|
||||
# Options -C -G -S required
|
||||
####################################
|
||||
foreach ( qw(C G S) ) {
|
||||
if ( !exists($opt{$_}) ) {
|
||||
return(usage( "Missing option: -$_" ));
|
||||
}
|
||||
}
|
||||
my $result = validate_ip( $opt{C}, $opt{G}, $opt{S} );
|
||||
if ( @$result[0] ) {
|
||||
return(usage( @$result[1] ));
|
||||
}
|
||||
####################################
|
||||
# Set method to invoke
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Validate list of IPs
|
||||
##########################################################################
|
||||
sub validate_ip {
|
||||
|
||||
foreach (@_) {
|
||||
my $ip = $_;
|
||||
|
||||
###################################
|
||||
# Length is 4 for IPv4 addresses
|
||||
###################################
|
||||
my (@octets) = /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
|
||||
if ( scalar(@octets) != 4 ) {
|
||||
return( [1,"Invalid IP address: $ip"] );
|
||||
}
|
||||
foreach my $octet ( @octets ) {
|
||||
if (( $octet < 0 ) or ( $octet > 255 )) {
|
||||
return( [1,"Invalid IP address: $ip"] );
|
||||
}
|
||||
}
|
||||
}
|
||||
return([0]);
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Get LPAR MAC addresses
|
||||
##########################################################################
|
||||
sub rnetboot {
|
||||
|
||||
my $request = shift;
|
||||
my $d = shift;
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my $opt = $request->{opt};
|
||||
my @output;
|
||||
|
||||
#####################################
|
||||
# Get node data
|
||||
#####################################
|
||||
my $type = @$d[4];
|
||||
my $name = @$d[6];
|
||||
|
||||
#####################################
|
||||
# Invalid target hardware
|
||||
#####################################
|
||||
if ( $type !~ /^lpar$/ ) {
|
||||
return( [[$name,"Not supported"]] );
|
||||
}
|
||||
my $result = xCAT::PPCcli::lpar_netboot(
|
||||
$exp,
|
||||
$name,
|
||||
$d,
|
||||
$opt->{S},
|
||||
$opt->{G},
|
||||
$opt->{C},
|
||||
$opt->{m} );
|
||||
|
||||
my $Rc = shift(@$result);
|
||||
return( [[$name,@$result[0]]] );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
808
perl-xCAT-2.0/xCAT/PPCcli.pm
Normal file
808
perl-xCAT-2.0/xCAT/PPCcli.pm
Normal file
@ -0,0 +1,808 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCcli;
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(SUCCESS RC_ERROR EXPECT_ERROR NR_ERROR);
|
||||
use strict;
|
||||
use xCAT::PPCdb;
|
||||
use Expect;
|
||||
|
||||
|
||||
#############################################
|
||||
# Removes Ctrl characters from term output
|
||||
#############################################
|
||||
$ENV{'TERM'} = "vt100";
|
||||
|
||||
##############################################
|
||||
# Constants
|
||||
##############################################
|
||||
use constant {
|
||||
SUCCESS => 0,
|
||||
RC_ERROR => 1,
|
||||
EXPECT_ERROR => 2,
|
||||
NR_ERROR => 3
|
||||
};
|
||||
|
||||
##############################################
|
||||
# lssyscfg supported formats
|
||||
##############################################
|
||||
my %lssyscfg = (
|
||||
fsp =>"lssyscfg -r sys -m %s -F %s",
|
||||
fsps =>"lssyscfg -r sys -F %s",
|
||||
node =>"lssyscfg -r lpar -m %s -F %s --filter lpar_ids=%s",
|
||||
lpar =>"lssyscfg -r lpar -m %s -F %s",
|
||||
bpa =>"lssyscfg -r frame -e %s -F %s",
|
||||
bpas =>"lssyscfg -r frame -F %s",
|
||||
prof =>"lssyscfg -r prof -m %s --filter lpar_ids=%s",
|
||||
cprof =>"lssyscfg -r prof -m %s",
|
||||
cage =>"lssyscfg -r cage -e %s -F %s"
|
||||
);
|
||||
|
||||
##############################################
|
||||
# Power control supported formats
|
||||
##############################################
|
||||
my %powercmd = (
|
||||
hmc => {
|
||||
reset =>"hmcshutdown -t now -r" },
|
||||
ivm => {
|
||||
reset =>"reboot" },
|
||||
lpar => {
|
||||
on =>"chsysstate -r %s -m %s -o on -b norm --id %s -f %s",
|
||||
of =>"chsysstate -r %s -m %s -o on --id %s -f %s -b of",
|
||||
reset =>"chsysstate -r %s -m %s -o shutdown --id %s --immed --restart",
|
||||
off =>"chsysstate -r %s -m %s -o shutdown --id %s --immed",
|
||||
boot =>"undetermined" },
|
||||
sys => {
|
||||
reset =>"chsysstate -r %s -m %s -o off --immed --restart",
|
||||
on =>"chsysstate -r %s -m %s -o on",
|
||||
off =>"chsysstate -r %s -m %s -o off",
|
||||
boot =>"undetermined" }
|
||||
);
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Logon to remote server
|
||||
##########################################################################
|
||||
sub connect {
|
||||
|
||||
my $hwtype = shift;
|
||||
my $server = shift;
|
||||
my $verbose = shift;
|
||||
my $pwd_prompt = 'assword: $';
|
||||
my $continue = 'continue connecting (yes/no)?';
|
||||
my $timeout = 10;
|
||||
my $success = 0;
|
||||
my $pwd_sent = 0;
|
||||
|
||||
##################################################
|
||||
# Shell prompt regexp based on HW Type
|
||||
##################################################
|
||||
my %prompt = (
|
||||
hmc => "~> \$",
|
||||
ivm => "\\\$ \$"
|
||||
);
|
||||
##################################################
|
||||
# Get userid/password based on Hardware Conrol Pt
|
||||
##################################################
|
||||
my @cred = xCAT::PPCdb::credentials( $server, $hwtype );
|
||||
|
||||
##################################################
|
||||
# ssh to remote host
|
||||
##################################################
|
||||
my $parameters = "$cred[0]\@$server";
|
||||
my $ssh = new Expect;
|
||||
|
||||
##################################################
|
||||
# raw_pty() disables command echoing and CRLF
|
||||
# translation and gives a more pipe-like behaviour.
|
||||
# Note that this must be set before spawning
|
||||
# the process. Unfortunately, this does not work
|
||||
# with AIX (IVM). stty(qw(-echo)) will at least
|
||||
# disable command echoing on all platforms but
|
||||
# will not suppress CRLF translation.
|
||||
##################################################
|
||||
#$ssh->raw_pty(1);
|
||||
$ssh->slave->stty(qw(sane -echo));
|
||||
|
||||
##################################################
|
||||
# exp_internal(1) sets exp_internal debugging.
|
||||
# This is similar in nature to its Tcl counterpart
|
||||
##################################################
|
||||
if ( $verbose ) {
|
||||
$ssh->exp_internal(1);
|
||||
}
|
||||
##################################################
|
||||
# log_stdout(0) disables logging to STDOUT. This
|
||||
# corresponds to the Tcl log_user variable.
|
||||
##################################################
|
||||
if ( !$verbose ) {
|
||||
$ssh->log_stdout(0);
|
||||
}
|
||||
unless ( $ssh->spawn( "ssh", $parameters )) {
|
||||
return( "Unable to spawn ssh connection to server" );
|
||||
}
|
||||
##################################################
|
||||
# -re $continue
|
||||
# "The authenticity of host can't be established
|
||||
# RSA key fingerprint is ....
|
||||
# Are you sure you want to continue connecting (yes/no)?"
|
||||
#
|
||||
# -re pwd_prompt
|
||||
# If the keys have already been transferred, we
|
||||
# may already be at the command prompt without
|
||||
# sending the password.
|
||||
#
|
||||
##################################################
|
||||
my @result = $ssh->expect( $timeout,
|
||||
[ $continue,
|
||||
sub {
|
||||
$ssh->send( "yes\r" );
|
||||
$ssh->clear_accum();
|
||||
$ssh->exp_continue();
|
||||
} ],
|
||||
[ $pwd_prompt,
|
||||
sub {
|
||||
if ( ++$pwd_sent == 1 ) {
|
||||
$ssh->send( "$cred[1]\r" );
|
||||
$ssh->exp_continue();
|
||||
}
|
||||
} ],
|
||||
[ $prompt{$hwtype},
|
||||
sub {
|
||||
$success = 1;
|
||||
} ]
|
||||
);
|
||||
##########################################
|
||||
# Expect error
|
||||
##########################################
|
||||
if ( defined( $result[1] )) {
|
||||
$ssh->hard_close();
|
||||
return( expect_error(@result) );
|
||||
}
|
||||
##########################################
|
||||
# Successful logon....
|
||||
# Return:
|
||||
# Expect
|
||||
# HW Shell Prompt regexp
|
||||
# HW Type (hmc/ivm)
|
||||
# Server hostname
|
||||
# UserId
|
||||
# Password
|
||||
##########################################
|
||||
if ( $success ) {
|
||||
return( $ssh,
|
||||
$prompt{$hwtype},
|
||||
$hwtype,
|
||||
$server,
|
||||
$cred[0],
|
||||
$cred[1] );
|
||||
}
|
||||
##########################################
|
||||
# Failed logon - kill ssh process
|
||||
##########################################
|
||||
$ssh->hard_close();
|
||||
return( "Invalid userid/password" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Logoff to remote server
|
||||
##########################################################################
|
||||
sub disconnect {
|
||||
|
||||
my $exp = shift;
|
||||
my $ssh = @$exp[0];
|
||||
|
||||
$ssh->send( "exit\r" );
|
||||
$ssh->hard_close();
|
||||
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# List attributes for resources (lpars, managed system, etc)
|
||||
##########################################################################
|
||||
sub lssyscfg {
|
||||
|
||||
my $exp = shift;
|
||||
my $res = shift;
|
||||
my $d1 = shift;
|
||||
my $d2 = shift;
|
||||
my $d3 = shift;
|
||||
|
||||
###################################
|
||||
# Select command
|
||||
###################################
|
||||
my $cmd = sprintf( $lssyscfg{$res}, $d1, $d2, $d3 );
|
||||
|
||||
###################################
|
||||
# Send command
|
||||
###################################
|
||||
my $result = send_cmd( $exp, $cmd );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Changes a logical partition configuration data
|
||||
##########################################################################
|
||||
sub chsyscfg {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
my $cfgdata = shift;
|
||||
my $timeout = 60;
|
||||
|
||||
#####################################
|
||||
# Command only support on LPARs
|
||||
#####################################
|
||||
if ( @$d[4] ne "lpar" ) {
|
||||
return( [RC_ERROR,"Command not supported"] );
|
||||
}
|
||||
#####################################
|
||||
# Format command based on CEC name
|
||||
#####################################
|
||||
my $cmd = "chsyscfg -r prof -m @$d[2] -i \"$cfgdata\"";
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd, $timeout );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Creates a logical partition on the managed system
|
||||
##########################################################################
|
||||
sub mksyscfg {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
my $cfgdata = shift;
|
||||
my $timeout = 60;
|
||||
|
||||
#####################################
|
||||
# Command only support on LPARs
|
||||
#####################################
|
||||
if ( @$d[4] ne "lpar" ) {
|
||||
return( [RC_ERROR,"Command not supported"] );
|
||||
}
|
||||
#####################################
|
||||
# Format command based on CEC name
|
||||
#####################################
|
||||
my $cmd = "mksyscfg -r lpar -m @$d[2] -i \"$cfgdata\"";
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd, $timeout );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Removes a logical partition on the managed system
|
||||
##########################################################################
|
||||
sub rmsyscfg {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
my $timeout = 60;
|
||||
|
||||
#####################################
|
||||
# Command only supported on LPARs
|
||||
#####################################
|
||||
if ( @$d[4] ne "lpar" ) {
|
||||
return( [RC_ERROR,"Command not supported"] );
|
||||
}
|
||||
#####################################
|
||||
# Format command based on CEC name
|
||||
#####################################
|
||||
my $cmd = "rmsyscfg -r lpar -m @$d[2] --id @$d[0]";
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd, $timeout );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Lists environmental information
|
||||
##########################################################################
|
||||
sub lshwinfo {
|
||||
|
||||
my $exp = shift;
|
||||
my $res = shift;
|
||||
my $frame = shift;
|
||||
my $filter = shift;
|
||||
|
||||
#####################################
|
||||
# Format command based on CEC name
|
||||
#####################################
|
||||
my $cmd = "lshwinfo -r $res -e $frame -F $filter";
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Changes the state of a partition or managed system
|
||||
##########################################################################
|
||||
sub chsysstate {
|
||||
|
||||
my $exp = shift;
|
||||
my $op = shift;
|
||||
my $d = shift;
|
||||
|
||||
#####################################
|
||||
# Format command based on CEC name
|
||||
#####################################
|
||||
my $cmd = power_cmd( $op, $d );
|
||||
if ( !defined( $cmd )) {
|
||||
return( [RC_ERROR,"'$op' command not supported"] );
|
||||
}
|
||||
#####################################
|
||||
# Special case - return immediately
|
||||
#####################################
|
||||
if ( $cmd =~ /^hmcshutdown|reboot/ ) {
|
||||
my $ssh = @$exp[0];
|
||||
|
||||
$ssh->send( "$cmd\r" );
|
||||
return( [SUCCESS,"Success"] );
|
||||
}
|
||||
#####################################
|
||||
# Increase timeout for power command
|
||||
#####################################
|
||||
my $timeout = 15;
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd, $timeout );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Opens a virtual terminal session
|
||||
##########################################################################
|
||||
sub mkvterm {
|
||||
|
||||
my $exp = shift;
|
||||
my $type = shift;
|
||||
my $lparid = shift;
|
||||
my $mtms = shift;
|
||||
my $ssh = @$exp[0];
|
||||
my $hwtype = @$exp[2];
|
||||
my $failed = 0;
|
||||
my $timeout = 3;
|
||||
|
||||
##########################################
|
||||
# Format command based on HW Type
|
||||
##########################################
|
||||
my %mkvt = (
|
||||
hmc =>"mkvterm --id %s -m %s",
|
||||
ivm =>"mkvt -id %s"
|
||||
);
|
||||
##########################################
|
||||
# HMC returns:
|
||||
# "A terminal session is already open
|
||||
# for this partition. Only one open
|
||||
# session is allowed for a partition.
|
||||
# Exiting...."
|
||||
#
|
||||
# HMCs may also return:
|
||||
# "The open failed.
|
||||
# "-The session may already be open on
|
||||
# another management console"
|
||||
#
|
||||
# But Expect (for some reason) sees each
|
||||
# character preceeded with \000 (blank??)
|
||||
#
|
||||
##########################################
|
||||
my $ivm_open = "Virtual terminal is already connected";
|
||||
my $hmc_open = "\000o\000p\000e\000n\000 \000f\000a\000i\000l\000e\000d";
|
||||
my $hmc_open2 =
|
||||
"\000a\000l\000r\000e\000a\000d\000y\000 \000o\000p\000e\000n";
|
||||
|
||||
##########################################
|
||||
# Set command based on HW type
|
||||
# mkvterm -id lparid -m cecmtms
|
||||
##########################################
|
||||
my $cmd = sprintf( $mkvt{$hwtype}, $lparid, $mtms );
|
||||
if ( $type ne "lpar" ) {
|
||||
return( [RC_ERROR,"Command not supported"] );
|
||||
}
|
||||
##########################################
|
||||
# For IVM, console sessions must explicitly
|
||||
# be closed after each open using rmvt
|
||||
# or they will remain open indefinitely.
|
||||
# For example, if the session is opened
|
||||
# using xterm and closed with the [x] in
|
||||
# the windows upper-right corner, we will
|
||||
# not be able to catch (INT,HUP,QUIT,TERM)
|
||||
# before the window closes in order to
|
||||
# send an rmvt - so force any IVM sessions
|
||||
# closed before we start.
|
||||
#
|
||||
# For HMC, apparently, once the console
|
||||
# session connection is broken, the HMC
|
||||
# closes the session. Therefore, it is not
|
||||
# necessary to explicitly close the session.
|
||||
#
|
||||
##########################################
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
rmvterm( $exp, $lparid, $mtms );
|
||||
sleep 1;
|
||||
}
|
||||
##########################################
|
||||
# Send command
|
||||
##########################################
|
||||
$ssh->clear_accum();
|
||||
$ssh->send( "$cmd\r" );
|
||||
|
||||
##########################################
|
||||
# Expect result
|
||||
##########################################
|
||||
my @result = $ssh->expect( $timeout,
|
||||
[ "$hmc_open|$hmc_open2|$ivm_open",
|
||||
sub {
|
||||
$failed = 1;
|
||||
} ]
|
||||
);
|
||||
|
||||
if ( $failed ) {
|
||||
$ssh->hard_close();
|
||||
return( [RC_ERROR,"Virtual terminal is already connected"] );
|
||||
}
|
||||
|
||||
##########################################
|
||||
# Success...
|
||||
# Give control to the user and intercept
|
||||
# the Ctrl-X (\030), and "~." sequences.
|
||||
##########################################
|
||||
my $escape = "\030|~.";
|
||||
$ssh->send( "\r" );
|
||||
$ssh->interact( \*STDIN, $escape );
|
||||
|
||||
##########################################
|
||||
# Close session
|
||||
##########################################
|
||||
rmvterm( $exp, $lparid, $mtms );
|
||||
$ssh->hard_close();
|
||||
|
||||
return( [SUCCESS,"Success"] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Force close a virtual terminal session
|
||||
##########################################################################
|
||||
sub rmvterm {
|
||||
|
||||
my $exp = shift;
|
||||
my $lparid = shift;
|
||||
my $mtms = shift;
|
||||
my $ssh = @$exp[0];
|
||||
my $hwtype = @$exp[2];
|
||||
|
||||
#####################################
|
||||
# Format command based on HW Type
|
||||
#####################################
|
||||
my %rmvt = (
|
||||
hmc =>"rmvterm --id %s -m %s",
|
||||
ivm =>"rmvt -id %s"
|
||||
);
|
||||
#####################################
|
||||
# Set command based on HW type
|
||||
# rmvt(erm) -id lparid -m cecmtms
|
||||
#####################################
|
||||
my $cmd = sprintf( $rmvt{$hwtype}, $lparid, $mtms );
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
$ssh->clear_accum();
|
||||
$ssh->send( "$cmd\r" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Lists the hardware resources of a managed system
|
||||
##########################################################################
|
||||
sub lshwres {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
my $mtms = shift;
|
||||
my $cmd = "lshwres -r @$d[1] -m $mtms -F @$d[2]";
|
||||
my $level = @$d[0];
|
||||
|
||||
#####################################
|
||||
# level may be "sys" or "lpar"
|
||||
#####################################
|
||||
if ( defined( $level )) {
|
||||
$cmd .=" --level $level";
|
||||
}
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Retrieve MAC-address from network adapter or network boots an LPAR
|
||||
##########################################################################
|
||||
sub lpar_netboot {
|
||||
|
||||
my $exp = shift;
|
||||
my $name = shift;
|
||||
my $d = shift;
|
||||
my $server = shift;
|
||||
my $gateway = shift;
|
||||
my $client = shift;
|
||||
my $mac = shift;
|
||||
my $timeout = 300;
|
||||
my $cmd = "lpar_netboot -t ent";
|
||||
|
||||
#####################################
|
||||
# Get MAC-address or network boot
|
||||
#####################################
|
||||
$cmd.= (defined( $mac )) ? " -m $mac" : " -M -n";
|
||||
|
||||
#####################################
|
||||
# Command only supported on LPARs
|
||||
#####################################
|
||||
if ( @$d[4] ne "lpar" ) {
|
||||
return( [RC_ERROR,"Command not supported"] );
|
||||
}
|
||||
#####################################
|
||||
# Network specified (-D ping test)
|
||||
#####################################
|
||||
if ( defined( $server )) {
|
||||
$cmd.= (!defined( $mac )) ? " -D" : "";
|
||||
$cmd.= " -s auto -d auto -S $server -G $gateway -C $client";
|
||||
}
|
||||
#####################################
|
||||
# Add lpar name, profile, CEC name
|
||||
#####################################
|
||||
$cmd.= " \"$name\" \"@$d[1]\" \"@$d[2]\"";
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd, $timeout );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# List Hardware Management Console configuration information
|
||||
##########################################################################
|
||||
sub lshmc {
|
||||
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my $timeout = 10;
|
||||
|
||||
#####################################
|
||||
# Format command based on HW Type
|
||||
#####################################
|
||||
my %cmd = (
|
||||
hmc =>"lshmc -v",
|
||||
ivm =>"lsivm"
|
||||
);
|
||||
|
||||
#####################################
|
||||
# Send command
|
||||
#####################################
|
||||
my $result = send_cmd( $exp, $cmd{$hwtype}, $timeout );
|
||||
|
||||
#####################################
|
||||
# Return error
|
||||
#####################################
|
||||
if ( @$result[0] != SUCCESS ) {
|
||||
return( $result );
|
||||
}
|
||||
#####################################
|
||||
# IVM returns:
|
||||
# 9133-55A,10B7D1G,1
|
||||
#
|
||||
# HMC returns:
|
||||
# "vpd=*FC ????????
|
||||
# *VC 20.0
|
||||
# *N2 Mon Sep 24 13:54:00 GMT 2007
|
||||
# *FC ????????
|
||||
# *DS Hardware Management Console
|
||||
# *TM 7310-CR4
|
||||
# *SE 1017E6B
|
||||
# *MN IBM
|
||||
# *PN Unknown
|
||||
# *SZ 1058721792
|
||||
# *OS Embedded Operating Systems
|
||||
# *NA 9.114.222.111
|
||||
# *FC ????????
|
||||
# *DS Platform Firmware
|
||||
# *RM V7R3.1.0.1
|
||||
#####################################
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
my ($model,$serial,$lparid) = split /,/, @$result[1];
|
||||
return( [SUCCESS,"$model,$serial"] );
|
||||
}
|
||||
my @values;
|
||||
my $vpd = join( ",", @$result );
|
||||
|
||||
#####################################
|
||||
# Type-Model may be in the formats:
|
||||
# "eserver xSeries 336 -[7310CR3]-"
|
||||
# "7310-CR4"
|
||||
#####################################
|
||||
if ( $vpd =~ /\*TM ([^,]+)/ ) {
|
||||
my $temp = $1;
|
||||
my $model = ($temp =~ /\[(.*)\]/) ? $1 : $temp;
|
||||
push @values, $model;
|
||||
}
|
||||
#####################################
|
||||
# Serial number
|
||||
#####################################
|
||||
if ( $vpd =~ /\*SE ([^,]+)/ ) {
|
||||
push @values, $1;
|
||||
}
|
||||
return( [SUCCESS,join( ",",@values)] );
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Sends command and waits for response
|
||||
##########################################################################
|
||||
sub send_cmd {
|
||||
|
||||
my $exp = shift;
|
||||
my $cmd = shift;
|
||||
my $timeout = shift;
|
||||
my $ssh = @$exp[0];
|
||||
my $prompt = @$exp[1];
|
||||
|
||||
##########################################
|
||||
# Set default Expect timeout
|
||||
##########################################
|
||||
if ( !defined( $timeout )) {
|
||||
$timeout = 10;
|
||||
}
|
||||
##########################################
|
||||
# Send command
|
||||
##########################################
|
||||
$ssh->clear_accum();
|
||||
$ssh->send( "$cmd; echo Rc=\$\?\r" );
|
||||
|
||||
##########################################
|
||||
# The first element is the number of the
|
||||
# pattern or string that matched, the
|
||||
# same as its return value in scalar
|
||||
# context. The second argument is a
|
||||
# string indicating why expect returned.
|
||||
# If there were no error, the second
|
||||
# argument will be undef. Possible errors
|
||||
# are 1:TIMEOUT, 2:EOF, 3:spawn id(...)died,
|
||||
# and "4:..." (see Expect (3) manpage for
|
||||
# the precise meaning of these messages)
|
||||
# The third argument of expects return list
|
||||
# is the string matched. The fourth argument
|
||||
# is text before the match, and the fifth
|
||||
# argument is text after the match.
|
||||
##########################################
|
||||
my @result = $ssh->expect( $timeout, "-re", "(.*$prompt)" );
|
||||
|
||||
##########################################
|
||||
# Expect error
|
||||
##########################################
|
||||
if ( defined( $result[1] )) {
|
||||
return( [EXPECT_ERROR,expect_error( @result )] );
|
||||
}
|
||||
##########################################
|
||||
# Extract error code
|
||||
##########################################
|
||||
if ( $result[3] =~ s/Rc=([0-9])+\r\n// ) {
|
||||
if ( $1 != 0 ) {
|
||||
return( [RC_ERROR,$result[3]] );
|
||||
}
|
||||
}
|
||||
##########################################
|
||||
# No data found - return error
|
||||
##########################################
|
||||
if ( $result[3] =~ /No results were found/ ) {
|
||||
return( [NR_ERROR,"No results were found"] );
|
||||
}
|
||||
##########################################
|
||||
# If no command output, return "Success"
|
||||
##########################################
|
||||
if ( length( $result[3] ) == 0 ) {
|
||||
$result[3] = "Success";
|
||||
}
|
||||
##########################################
|
||||
# Success
|
||||
##########################################
|
||||
my @values = ( SUCCESS );
|
||||
push @values, split /\r\n/, $result[3];
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Return Expect error
|
||||
##########################################################################
|
||||
sub expect_error {
|
||||
|
||||
my @error = @_;
|
||||
|
||||
##########################################
|
||||
# The first element is the number of the
|
||||
# pattern or string that matched, the
|
||||
# same as its return value in scalar
|
||||
# context. The second argument is a
|
||||
# string indicating why expect returned.
|
||||
# If there were no error, the second
|
||||
# argument will be undef. Possible errors
|
||||
# are 1:TIMEOUT, 2:EOF, 3:spawn id(...)died,
|
||||
# and "4:..." (see Expect (3) manpage for
|
||||
# the precise meaning of these messages)
|
||||
# The third argument of expects return list
|
||||
# is the string matched. The fourth argument
|
||||
# is text before the match, and the fifth
|
||||
# argument is text after the match.
|
||||
##########################################
|
||||
if ( $error[1] eq "1:TIMEOUT" ) {
|
||||
return( "Timeout waiting for prompt" );
|
||||
}
|
||||
if ( $error[1] eq "2:EOF" ) {
|
||||
if ( $error[3] ) {
|
||||
return( $error[3] );
|
||||
}
|
||||
return( "ssh connection terminated unexpectedly" );
|
||||
}
|
||||
return( "Logon failed" );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns built command based on CEC/LPAR action
|
||||
##########################################################################
|
||||
sub power_cmd {
|
||||
|
||||
my $op = shift;
|
||||
my $d = shift;
|
||||
my $type = @$d[4];
|
||||
|
||||
##############################
|
||||
# Build command
|
||||
##############################
|
||||
my $cmd = $powercmd{$type}{$op};
|
||||
|
||||
if ( defined( $cmd )) {
|
||||
return( sprintf( $cmd, $type, @$d[2],@$d[0],@$d[1] ));
|
||||
}
|
||||
##############################
|
||||
# Command not supported
|
||||
##############################
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
1;
|
||||
178
perl-xCAT-2.0/xCAT/PPCdb.pm
Normal file
178
perl-xCAT-2.0/xCAT/PPCdb.pm
Normal file
@ -0,0 +1,178 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCdb;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::Table;
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Adds an LPAR to the xCAT databases
|
||||
##########################################################################
|
||||
sub add_ppc {
|
||||
|
||||
my $hwtype = shift;
|
||||
my $values = shift;
|
||||
my @tabs = qw(ppc vpd nodehm nodelist);
|
||||
my %db = ();
|
||||
|
||||
###################################
|
||||
# Open database needed
|
||||
###################################
|
||||
foreach ( @tabs ) {
|
||||
$db{$_} = xCAT::Table->new( $_, -create=>1, -autocommit=>0 );
|
||||
if ( !$db{$_} ) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
###################################
|
||||
# Update tables
|
||||
###################################
|
||||
foreach ( @$values ) {
|
||||
my ($type,
|
||||
$name,
|
||||
$id,
|
||||
$model,
|
||||
$serial,
|
||||
$server,
|
||||
$profile,
|
||||
$mgt,
|
||||
$ips ) = split /,/;
|
||||
|
||||
|
||||
###############################
|
||||
# Update ppc table
|
||||
###############################
|
||||
if ( $type =~ /^fsp|bpa|lpar$/ ) {
|
||||
my ($k,$u);
|
||||
$k->{node} = $name;
|
||||
$u->{hcp} = $server;
|
||||
$u->{id} = $id;
|
||||
$u->{profile} = $profile;
|
||||
$u->{mgt} = $mgt;
|
||||
$db{ppc}->setAttribs( $k, $u );
|
||||
$db{ppc}{commit} = 1;
|
||||
|
||||
###########################
|
||||
# Update nodelist table
|
||||
###########################
|
||||
my ($k1,$u1);
|
||||
my %nodetype = (
|
||||
fsp => "fsp",
|
||||
bpa => "bpa",
|
||||
lpar => "osi"
|
||||
);
|
||||
$k1->{node} = $name;
|
||||
$u1->{groups} = lc($hwtype).",all";
|
||||
$u1->{nodetype} = $nodetype{$type};
|
||||
$db{nodelist}->setAttribs( $k1,$u1 );
|
||||
$db{nodelist}{commit} = 1;
|
||||
|
||||
###########################
|
||||
# Update nodehm table
|
||||
###########################
|
||||
my ($k2,$u2);
|
||||
$k2->{node} = $name;
|
||||
$u2->{mgt} = $hwtype;
|
||||
$db{nodehm}->setAttribs( $k2,$u2 );
|
||||
$db{nodehm}{commit} = 1;
|
||||
}
|
||||
###############################
|
||||
# Update vpd table
|
||||
###############################
|
||||
if ( $type =~ /^fsp|bpa$/ ) {
|
||||
my ($k,$u);
|
||||
$k->{node} = $name;
|
||||
$u->{serial} = $serial;
|
||||
$u->{mtm} = $model;
|
||||
$db{vpd}->setAttribs( $k,$u );
|
||||
$db{vpd}{commit} = 1;
|
||||
}
|
||||
}
|
||||
|
||||
###################################
|
||||
# Commit changes
|
||||
###################################
|
||||
foreach ( @tabs ) {
|
||||
if ( exists( $db{$_}{commit} )) {
|
||||
$db{$_}->commit;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Adds a hardware control point to the xCAT database
|
||||
##########################################################################
|
||||
sub add_ppch {
|
||||
|
||||
my $hwtype = shift;
|
||||
my $uid = shift;
|
||||
my $pw = shift;
|
||||
my $name = shift;
|
||||
my $k;
|
||||
my $u;
|
||||
|
||||
###################################
|
||||
# Update HWCtrl Point table
|
||||
###################################
|
||||
my $tab = xCAT::Table->new( 'ppch', -create=>1, -autocommit=>0 );
|
||||
if ( !$tab ) {
|
||||
return;
|
||||
}
|
||||
$k->{hcp} = $name;
|
||||
$u->{username} = $uid;
|
||||
$u->{password} = $pw;
|
||||
|
||||
$tab->setAttribs( $k, $u );
|
||||
$tab->commit;
|
||||
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Get userids and passwords from tables
|
||||
##########################################################################
|
||||
sub credentials {
|
||||
|
||||
my $server = shift;
|
||||
my $hwtype = shift;
|
||||
my %db = (
|
||||
hmc => "ppchcp",
|
||||
ivm => "ppchcp",
|
||||
fsp => "ppcDirect"
|
||||
);
|
||||
|
||||
###########################################
|
||||
# Get userid/password based on HwCtrl Pt
|
||||
###########################################
|
||||
my $tab = xCAT::Table->new( $db{$hwtype} );
|
||||
if ( $tab ) {
|
||||
my ($ent) = $tab->getAttribs({'hcp'=>$server},'username','password');
|
||||
if ( defined( $ent ) ) {
|
||||
return( $ent->{username},$ent->{password} );
|
||||
}
|
||||
}
|
||||
###########################################
|
||||
# Get userid/password based on type
|
||||
###########################################
|
||||
$tab = xCAT::Table->new( 'passwd' );
|
||||
if ( $tab ) {
|
||||
my ($ent) = $tab->getAttribs({'key'=>$hwtype},'username','password');
|
||||
if ( defined( $ent ) ) {
|
||||
return( $ent->{username},$ent->{password} );
|
||||
}
|
||||
}
|
||||
###########################################
|
||||
# Use factory defaults
|
||||
###########################################
|
||||
my %logon = (
|
||||
hmc => ["hscroot","abc123"],
|
||||
ivm => ["padmin", "padmin"],
|
||||
fsp => ["dev", "FipSdev"]
|
||||
);
|
||||
return( @{$logon{$hwtype}}[0], @{$logon{$hwtype}}[1] );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
568
perl-xCAT-2.0/xCAT/PPCfsp.pm
Normal file
568
perl-xCAT-2.0/xCAT/PPCfsp.pm
Normal file
@ -0,0 +1,568 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCfsp;
|
||||
use strict;
|
||||
use LWP;
|
||||
use HTTP::Cookies;
|
||||
|
||||
|
||||
##########################################
|
||||
# Globals
|
||||
##########################################
|
||||
my %cmds = (
|
||||
rpower => {
|
||||
state => ["Power On/Off System", \&state],
|
||||
on => ["Power On/Off System", \&on],
|
||||
off => ["Power On/Off System", \&off],
|
||||
reset => ["System Reboot", \&reset],
|
||||
boot => ["Power On/Off System", \&boot] },
|
||||
reventlog => {
|
||||
all => ["Error/Event Logs", \&all],
|
||||
all_clear => ["Error/Event Logs", \&all_clear],
|
||||
entries => ["Error/Event Logs", \&entries],
|
||||
clear => ["Error/Event Logs", \&clear] }
|
||||
);
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# FSP command handler through HTTP interface
|
||||
##########################################################################
|
||||
sub handler {
|
||||
|
||||
my $server = shift;
|
||||
my $request = shift;
|
||||
my $command = $request->{command};
|
||||
my $verbose = $request->{verbose};
|
||||
my $method = $request->{method};
|
||||
my $start;
|
||||
|
||||
##################################
|
||||
# Check command
|
||||
##################################
|
||||
if ( !exists( $cmds{$command}{$method} )) {
|
||||
my %output;
|
||||
$output{node}->[0]->{name}->[0] = $server;
|
||||
$output{node}->[0]->{data}->[0]->{contents}->[0]= "Unsupported command";
|
||||
return( [\%output] );
|
||||
}
|
||||
##################################
|
||||
# Start timer
|
||||
##################################
|
||||
if ( $verbose ) {
|
||||
$start = Time::HiRes::gettimeofday();
|
||||
}
|
||||
##################################
|
||||
# Connect to remote FSP
|
||||
##################################
|
||||
my @exp = xCAT::PPCfsp::connect( $server, $verbose );
|
||||
|
||||
if ( ref($exp[0]) ne "LWP::UserAgent" ) {
|
||||
my %output;
|
||||
$output{node}->[0]->{name}->[0] = $server;
|
||||
$output{node}->[0]->{data}->[0]->{contents}->[0] = $exp[0];
|
||||
return( [\%output] );
|
||||
}
|
||||
##################################
|
||||
# Process FSP command
|
||||
##################################
|
||||
my $result = process_cmd( \@exp, $request );
|
||||
|
||||
my %output;
|
||||
$output{node}->[0]->{name}->[0] = $server;
|
||||
$output{node}->[0]->{data}->[0]->{contents}->[0] = $result;
|
||||
|
||||
##################################
|
||||
# Disconnect from FSP
|
||||
##################################
|
||||
xCAT::PPCfsp::disconnect( \@exp );
|
||||
|
||||
##################################
|
||||
# Record Total time
|
||||
##################################
|
||||
if ( $verbose ) {
|
||||
my $elapsed = Time::HiRes::gettimeofday() - $start;
|
||||
my $total = sprintf( "Total Elapsed Time: %.3f sec\n", $elapsed );
|
||||
print STDERR $total;
|
||||
}
|
||||
return( [\%output] );
|
||||
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Logon through remote FSP HTTP-interface
|
||||
##########################################################################
|
||||
sub connect {
|
||||
|
||||
my $server = shift;
|
||||
my $verbose = shift;
|
||||
|
||||
##################################
|
||||
# Get userid/password
|
||||
##################################
|
||||
my @cred = xCAT::PPCdb::credentials( $server, "fsp" );
|
||||
|
||||
##################################
|
||||
# Turn on tracing
|
||||
##################################
|
||||
if ( $verbose ) {
|
||||
LWP::Debug::level( '+' );
|
||||
}
|
||||
##################################
|
||||
# Create cookie
|
||||
##################################
|
||||
my $cookie = HTTP::Cookies->new();
|
||||
$cookie->set_cookie( 0,'asm_session','0','cgi-bin','','443',0,0,3600,0 );
|
||||
|
||||
##################################
|
||||
# Create UserAgent
|
||||
##################################
|
||||
my $ua = LWP::UserAgent->new();
|
||||
|
||||
##################################
|
||||
# Set options
|
||||
##################################
|
||||
my $url = "https://$server/cgi-bin/cgi?form=2";
|
||||
$ua->cookie_jar( $cookie );
|
||||
$ua->timeout(30);
|
||||
|
||||
##################################
|
||||
# Submit logon
|
||||
##################################
|
||||
my $res = $ua->post( $url,
|
||||
[ user => $cred[0],
|
||||
password => $cred[1],
|
||||
lang => "0",
|
||||
submit => "Log in"
|
||||
]
|
||||
);
|
||||
|
||||
##################################
|
||||
# Logon failed
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
##################################
|
||||
# To minimize number of GET/POSTs,
|
||||
# if we successfully logon, we should
|
||||
# get back a valid cookie:
|
||||
# Set-Cookie: asm_session=3038839768778613290
|
||||
#
|
||||
##################################
|
||||
|
||||
if ( $res->as_string =~ /Set-Cookie: asm_session=(\d+)/ ) {
|
||||
##############################
|
||||
# Successful logon....
|
||||
# Return:
|
||||
# UserAgent
|
||||
# Server hostname
|
||||
# UserId
|
||||
##############################
|
||||
return( $ua,
|
||||
$server,
|
||||
$cred[0] );
|
||||
}
|
||||
##############################
|
||||
# Logon error
|
||||
##############################
|
||||
$res = $ua->get( $url );
|
||||
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
##############################
|
||||
# Check for specific failures
|
||||
##############################
|
||||
my @error = (
|
||||
"Invalid user ID or password",
|
||||
"Too many users"
|
||||
);
|
||||
foreach ( @error ) {
|
||||
if ( $res->content =~ /$_/i ) {
|
||||
return( $_ );
|
||||
}
|
||||
}
|
||||
return( "Logon failure" );
|
||||
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Logoff through remote FSP HTTP-interface
|
||||
##########################################################################
|
||||
sub disconnect {
|
||||
|
||||
my $exp = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
my $uid = @$exp[2];
|
||||
|
||||
##################################
|
||||
# POST Logoff
|
||||
##################################
|
||||
my $res = $ua->post(
|
||||
"https://$server/cgi-bin/cgi?form=1",
|
||||
[submit => "Log out"]);
|
||||
|
||||
##################################
|
||||
# Logoff failed
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Execute FSP command
|
||||
##########################################################################
|
||||
sub process_cmd {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
my $uid = @$exp[2];
|
||||
my $command = $request->{command};
|
||||
my $method = $request->{method};
|
||||
my %menu = ();
|
||||
|
||||
##################################
|
||||
# We have to expand the main
|
||||
# menu since unfortunately, the
|
||||
# the forms numbers are not the
|
||||
# same across FSP models/firmware
|
||||
# versions.
|
||||
##################################
|
||||
my $url = "https://$server/cgi-bin/cgi";
|
||||
my $res = $ua->post( $url,
|
||||
[form => "2",
|
||||
e => "1" ]
|
||||
);
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
##################################
|
||||
# Build hash of expanded menus
|
||||
##################################
|
||||
foreach ( split /\n/, $res->content ) {
|
||||
if ( /form=(\d+).*window.status='(.*)'/ ) {
|
||||
$menu{$2} = $1;
|
||||
}
|
||||
}
|
||||
##################################
|
||||
# Get form id
|
||||
##################################
|
||||
my $form = $menu{$cmds{$command}{$method}[0]};
|
||||
|
||||
if ( !defined( $form )) {
|
||||
return( "Cannot find '$cmds{$command}{$method}[0]' menu" );
|
||||
}
|
||||
##################################
|
||||
# Run command
|
||||
##################################
|
||||
my $result = $cmds{$command}{$method}[1]($exp, $request, $form, \%menu);
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns current power state
|
||||
##########################################################################
|
||||
sub state {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
|
||||
##################################
|
||||
# Get current power status
|
||||
##################################
|
||||
my $res = $ua->get( "https://$server/cgi-bin/cgi?form=$form" );
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
##################################
|
||||
# Get power state
|
||||
##################################
|
||||
if ( $res->content =~ /Current system power state: (.*)<br>/) {
|
||||
return( $1 );
|
||||
}
|
||||
return( "unknown" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Powers FSP On
|
||||
##########################################################################
|
||||
sub on {
|
||||
return( power(@_,"on","on") );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Powers FSP Off
|
||||
##########################################################################
|
||||
sub off {
|
||||
return( power(@_,"off","of") );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Powers FSP On/Off
|
||||
##########################################################################
|
||||
sub power {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $state = shift;
|
||||
my $button = shift;
|
||||
my $command = $request->{command};
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
|
||||
##################################
|
||||
# Send Power On command
|
||||
##################################
|
||||
my $res = $ua->post( "https://$server/cgi-bin/cgi",
|
||||
[form => $form,
|
||||
sp => "255", # System boot speed: Fast
|
||||
is => "1", # Firmware boot side for the next boot: Temporary
|
||||
om => "4", # System operating mode: Normal
|
||||
ip => "2", # Boot to system server firmware: Running
|
||||
plt => "3", # System power off policy: Stay on
|
||||
$button => "Save settings and power $state"]
|
||||
);
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
if ( $res->content =~
|
||||
/(Powering on or off not allowed: invalid system state)/) {
|
||||
|
||||
##############################
|
||||
# Check current power state
|
||||
##############################
|
||||
my $state = xCAT::PPCfsp::state(
|
||||
$exp,
|
||||
$request,
|
||||
$menu->{$cmds{$command}{state}[0]},
|
||||
$menu );
|
||||
|
||||
if ( $state eq $state ) {
|
||||
return( "Success" );
|
||||
}
|
||||
return( $1 );
|
||||
}
|
||||
##################################
|
||||
# Success
|
||||
##################################
|
||||
if ( $res->content =~ /(Operation completed successfully)/ ) {
|
||||
return( $1 );
|
||||
}
|
||||
return( "Unknown error" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Reset FSP
|
||||
##########################################################################
|
||||
sub reset {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
|
||||
##################################
|
||||
# Send Reset command
|
||||
##################################
|
||||
my $res = $ua->post( "https://$server/cgi-bin/cgi",
|
||||
[form => $form,
|
||||
submit => "Continue" ]
|
||||
);
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success()) {
|
||||
print STDERR $res->status_line();
|
||||
return;
|
||||
}
|
||||
if ( $res->content =~
|
||||
/(This feature is only available when the system is powered on)/ ) {
|
||||
return( $1 );
|
||||
}
|
||||
##################################
|
||||
# Success
|
||||
##################################
|
||||
if ( $res->content =~ /(Operation completed successfully)/ ) {
|
||||
return( $1 );
|
||||
}
|
||||
return( "Unknown error" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Boots FSP (Off->On, On->Reset)
|
||||
##########################################################################
|
||||
sub boot {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $command = $request->{command};
|
||||
|
||||
##################################
|
||||
# Check current power state
|
||||
##################################
|
||||
my $state = xCAT::PPCfsp::state(
|
||||
$exp,
|
||||
$request,
|
||||
$menu->{$cmds{$command}{state}[0]},
|
||||
$menu );
|
||||
|
||||
if ( $state !~ /^on|off$/ ) {
|
||||
return( "Unable to boot in state: '$state'" );
|
||||
}
|
||||
##################################
|
||||
# Get command
|
||||
##################################
|
||||
my $method = ($state eq "on") ? "reset" : "off";
|
||||
|
||||
##################################
|
||||
# Get command form id
|
||||
##################################
|
||||
$form = $menu->{$cmds{$command}{$method}[0]};
|
||||
|
||||
##################################
|
||||
# Run command
|
||||
##################################
|
||||
my $result = $cmds{$method}[1]( $exp, $state, $form );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Clears Error/Event Logs
|
||||
##########################################################################
|
||||
sub clear {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
|
||||
##################################
|
||||
# Send Clear command
|
||||
##################################
|
||||
my $url = "https://$server/cgi-bin/cgi";
|
||||
my $res = $ua->post( $url,
|
||||
[form => $form,
|
||||
submit => "Clear all error/event log entries" ]
|
||||
);
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
return( "Success" );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Gets the number of Error/Event Logs entries specified
|
||||
##########################################################################
|
||||
sub entries {
|
||||
|
||||
my $exp = shift;
|
||||
my $request = shift;
|
||||
my $form = shift;
|
||||
my $menu = shift;
|
||||
my $ua = @$exp[0];
|
||||
my $server = @$exp[1];
|
||||
my $opt = $request->{opt};
|
||||
my $count = (exists($opt->{e})) ? $opt->{e} : 9999;
|
||||
my $result;
|
||||
my $i = 1;
|
||||
|
||||
##################################
|
||||
# Get log entries
|
||||
##################################
|
||||
my $url = "https://$server/cgi-bin/cgi?form=$form";
|
||||
my $res = $ua->get( $url );
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( !$res->is_success() ) {
|
||||
return( $res->status_line );
|
||||
}
|
||||
my @entries = split /\n/, $res->content;
|
||||
|
||||
##################################
|
||||
# Prepend header
|
||||
##################################
|
||||
$result = (@entries) ?
|
||||
"#Log ID Time Failing subsystem Severity SRC\n" :
|
||||
"No entries";
|
||||
|
||||
##################################
|
||||
# Parse log entries
|
||||
##################################
|
||||
foreach ( @entries ) {
|
||||
if ( /tabindex=[\d]+><\/td><td>(.*)<\/td><td / ) {
|
||||
my $values = $1;
|
||||
$values =~ s/<\/td><td>/ /g;
|
||||
$result.= "$values\n";
|
||||
|
||||
if ( $i++ == $count ) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Gets all Error/Event Logs entries
|
||||
##########################################################################
|
||||
sub all {
|
||||
return( entries(@_) );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Gets all Error/Event Logs entries then clears the logs
|
||||
##########################################################################
|
||||
sub all_clear {
|
||||
|
||||
my $result = entries( @_ );
|
||||
clear( @_);
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
527
perl-xCAT-2.0/xCAT/PPCinv.pm
Normal file
527
perl-xCAT-2.0/xCAT/PPCinv.pm
Normal file
@ -0,0 +1,527 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCinv;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my $args = $request->{arg};
|
||||
my %opt = ();
|
||||
my @rinv = qw(bus config model serial all);
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rinv -h|--help",
|
||||
"rinv -v|--version",
|
||||
"rinv [-V|--verbose] noderange " . join( '|', @rinv ),
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return(usage( "No command specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Unsupported command
|
||||
####################################
|
||||
my ($cmd) = grep(/^$ARGV[0]$/, @rinv );
|
||||
if ( !defined( $cmd )) {
|
||||
return(usage( "Invalid command: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
shift @ARGV;
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Set method to invoke
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns VPD (model-type,serial-number)
|
||||
##########################################################################
|
||||
sub enumerate_vpd {
|
||||
|
||||
my $exp = shift;
|
||||
my $mtms = shift;
|
||||
my $hash = shift;
|
||||
my $filter = shift;
|
||||
my $cecname;
|
||||
my @vpd;
|
||||
|
||||
my ($name) = keys %{$hash->{$mtms}};
|
||||
my $type = @{$hash->{$mtms}->{$name}}[4];
|
||||
|
||||
######################################
|
||||
# HMCs and IVMs
|
||||
######################################
|
||||
if ( $type =~ /^hmc|ivm$/ ) {
|
||||
my $hcp = xCAT::PPCcli::lshmc( $exp );
|
||||
my $Rc = shift(@$hcp);
|
||||
|
||||
##############################
|
||||
# Return error
|
||||
##############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$hcp[0]] );
|
||||
}
|
||||
##############################
|
||||
# Success
|
||||
##############################
|
||||
@vpd = split /,/, @$hcp[0];
|
||||
}
|
||||
######################################
|
||||
# BPAs
|
||||
######################################
|
||||
elsif ( $type =~ /^bpa$/ ) {
|
||||
my $filter = "type_model,serial_num";
|
||||
my $frame = xCAT::PPCcli::lssyscfg( $exp, $type, $mtms, $filter );
|
||||
my $Rc = shift(@$frame);
|
||||
|
||||
##############################
|
||||
# Return error
|
||||
##############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$frame[0]] );
|
||||
}
|
||||
##############################
|
||||
# Success
|
||||
##############################
|
||||
@vpd = split /,/, @$frame[0];
|
||||
}
|
||||
######################################
|
||||
# CECs and LPARs
|
||||
######################################
|
||||
else {
|
||||
##############################
|
||||
# Send command for CEC only
|
||||
##############################
|
||||
my $cec = xCAT::PPCcli::lssyscfg( $exp, "fsp", $mtms, $filter );
|
||||
my $Rc = shift(@$cec);
|
||||
|
||||
##############################
|
||||
# Return error
|
||||
##############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$cec[0]] );
|
||||
}
|
||||
##############################
|
||||
# Success
|
||||
##############################
|
||||
@vpd = split /,/, @$cec[0];
|
||||
}
|
||||
my %outhash = (
|
||||
model => $vpd[0],
|
||||
serial => $vpd[1]
|
||||
);
|
||||
return( [SUCCESS,\%outhash] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns memory/processor information for CEC/LPARs
|
||||
##########################################################################
|
||||
sub enumerate_cfg {
|
||||
|
||||
my $exp = shift;
|
||||
my $mtms = shift;
|
||||
my $hash = shift;
|
||||
my %outhash = ();
|
||||
my $sys = 0;
|
||||
my @cmds = (
|
||||
[ "sys", "proc", "installed_sys_proc_units" ],
|
||||
[ "sys", "mem", "installed_sys_mem" ],
|
||||
[ "lpar","proc", "lpar_name,curr_procs" ],
|
||||
[ "lpar","mem", "lpar_name,curr_mem" ]
|
||||
);
|
||||
my $cecname;
|
||||
|
||||
my ($name) = keys %{$hash->{$mtms}};
|
||||
my $type = @{$hash->{$mtms}->{$name}}[4];
|
||||
|
||||
######################################
|
||||
# Invalid target hardware
|
||||
######################################
|
||||
if ( $type !~ /^fsp|lpar$/ ) {
|
||||
return( [RC_ERROR,"Information only available for CEC/LPAR"] );
|
||||
}
|
||||
######################################
|
||||
# Check for CECs in list
|
||||
######################################
|
||||
while (my ($name,$d) = each(%{$hash->{$mtms}}) ) {
|
||||
if ( @$d[4] eq "fsp" ) {
|
||||
$cecname = $name;
|
||||
last;
|
||||
}
|
||||
}
|
||||
######################################
|
||||
# No CECs - Skip command for CEC
|
||||
######################################
|
||||
if ( !defined( $cecname )) {
|
||||
shift @cmds;
|
||||
shift @cmds;
|
||||
}
|
||||
######################################
|
||||
# No LPARs - Skip command for LPAR
|
||||
######################################
|
||||
if (( keys %{$hash->{$mtms}} == 1 ) and ( scalar(@cmds) == 4 )) {
|
||||
pop @cmds;
|
||||
pop @cmds;
|
||||
}
|
||||
|
||||
foreach my $cmd( @cmds ) {
|
||||
my $result = xCAT::PPCcli::lshwres( $exp, $cmd, $mtms );
|
||||
my $Rc = shift(@$result);
|
||||
|
||||
##################################
|
||||
# Expect error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$result[0]] );
|
||||
}
|
||||
##################################
|
||||
# Success...
|
||||
# lshwres does not return CEC name
|
||||
# For CEC commands, insert name
|
||||
##################################
|
||||
if ( @$cmd[0] eq "sys" ) {
|
||||
foreach ( @$result[0] ) {
|
||||
s/(.*)/$cecname,$1/;
|
||||
}
|
||||
}
|
||||
##################################
|
||||
# Save by CEC/LPAR name
|
||||
##################################
|
||||
foreach ( @$result ) {
|
||||
my ($name,$value) = split /,/;
|
||||
push @{$outhash{ $name }}, $value;
|
||||
}
|
||||
}
|
||||
return( [SUCCESS,\%outhash] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns I/O bus information
|
||||
##########################################################################
|
||||
sub enumerate_bus {
|
||||
|
||||
my $exp = shift;
|
||||
my $mtms = shift;
|
||||
my $hash = shift;
|
||||
my $filter = shift;
|
||||
my %outhash = ();
|
||||
my @res = qw(lpar);
|
||||
my @cmds = (
|
||||
undef,
|
||||
"io --rsubtype slot",
|
||||
$filter
|
||||
);
|
||||
my $cecname;
|
||||
|
||||
my ($name) = keys %{$hash->{$mtms}};
|
||||
my $type = @{$hash->{$mtms}->{$name}}[4];
|
||||
|
||||
##################################
|
||||
# Invalid target hardware
|
||||
##################################
|
||||
if ( $type !~ /^fsp|lpar$/ ) {
|
||||
return( [RC_ERROR,"Bus information only available for CEC/LPAR"] );
|
||||
}
|
||||
##################################
|
||||
# Send command for CEC only
|
||||
##################################
|
||||
my $cecs = xCAT::PPCcli::lshwres( $exp, \@cmds, $mtms );
|
||||
my $Rc = shift(@$cecs);
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$cecs[0]] );
|
||||
}
|
||||
##################################
|
||||
# Success
|
||||
##################################
|
||||
my @bus = @$cecs;
|
||||
|
||||
##################################
|
||||
# Check for CECs in list
|
||||
##################################
|
||||
foreach ( keys %{$hash->{$mtms}} ) {
|
||||
if ( @{$hash->{$mtms}->{$_}}[4] eq "fsp" ) {
|
||||
$cecname = $_;
|
||||
last;
|
||||
}
|
||||
}
|
||||
##################################
|
||||
# Get LPAR names
|
||||
##################################
|
||||
my $lpars = xCAT::PPCcli::lssyscfg( $exp, "lpar", $mtms, "name" );
|
||||
$Rc = shift(@$lpars);
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$lpars[0]] );
|
||||
}
|
||||
##################################
|
||||
# Save LPARs by name
|
||||
##################################
|
||||
foreach ( @$lpars ) {
|
||||
$outhash{$_} = \@bus;
|
||||
}
|
||||
##################################
|
||||
# Save CEC by name too
|
||||
##################################
|
||||
if ( defined( $cecname )) {
|
||||
$outhash{$cecname} = \@bus;
|
||||
}
|
||||
return( [SUCCESS,\%outhash] );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns I/O bus information
|
||||
##########################################################################
|
||||
sub bus {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my @result = ();
|
||||
my $filter = "drc_name,bus_id,description";
|
||||
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
#####################################
|
||||
# Get information for this CEC
|
||||
#####################################
|
||||
my $bus = enumerate_bus( $exp, $mtms, $hash, $filter );
|
||||
my $Rc = shift(@$bus);
|
||||
my $data = @$bus[0];
|
||||
|
||||
while (my ($name) = each(%$h) ) {
|
||||
#################################
|
||||
# Output header
|
||||
#################################
|
||||
push @result, [$name,"I/O Bus Information"];
|
||||
|
||||
#################################
|
||||
# Output error
|
||||
#################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @result, [$name,@$bus[0]];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Node not found
|
||||
#################################
|
||||
if ( !exists( $data->{$name} )) {
|
||||
push @result, [$name,"Node not found"];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Output values
|
||||
#################################
|
||||
foreach ( @{$data->{$name}} ) {
|
||||
s/,/:/;
|
||||
push @result, [$name,$_];
|
||||
}
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns VPD information
|
||||
##########################################################################
|
||||
sub vpd {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my @cmds = $request->{method};
|
||||
my @result = ();
|
||||
my $filter = "type_model,serial_num";
|
||||
my %prefix = (
|
||||
model => ["Machine Type/Model",0],
|
||||
serial => ["Serial Number", 1]
|
||||
);
|
||||
|
||||
#########################################
|
||||
# Convert "all"
|
||||
#########################################
|
||||
if ( $cmds[0] eq "all" ) {
|
||||
@cmds = qw( model serial );
|
||||
}
|
||||
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
#####################################
|
||||
# Get information for this CEC
|
||||
#####################################
|
||||
my $vpd = enumerate_vpd( $exp, $mtms, $hash, $filter );
|
||||
my $Rc = shift(@$vpd);
|
||||
my $data = @$vpd[0];
|
||||
|
||||
while (my ($name) = each(%$h) ) {
|
||||
foreach ( @cmds ) {
|
||||
#############################
|
||||
# Output error
|
||||
#############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @result, [$name,"@{$prefix{$_}}[0]: @$vpd[0]"];
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# Output value
|
||||
#############################
|
||||
my $value = "@{$prefix{$_}}[0]: $data->{$_}";
|
||||
push @result, [$name,$value];
|
||||
}
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns memory/processor information
|
||||
##########################################################################
|
||||
sub config {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my @result = ();
|
||||
my @prefix = (
|
||||
"Number of Processors: %s",
|
||||
"Total Memory (MB): %s"
|
||||
);
|
||||
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
#####################################
|
||||
# Get information for this CEC
|
||||
#####################################
|
||||
my $cfg = enumerate_cfg( $exp, $mtms, $hash );
|
||||
my $Rc = shift(@$cfg);
|
||||
my $data = @$cfg[0];
|
||||
|
||||
while (my ($name) = each(%$h) ) {
|
||||
#################################
|
||||
# Output header
|
||||
#################################
|
||||
push @result, [$name,"Machine Configuration Info"];
|
||||
my $i;
|
||||
|
||||
foreach ( @prefix ) {
|
||||
#############################
|
||||
# Output error
|
||||
#############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
my $value = sprintf( "$_", $data );
|
||||
push @result, [$name,$value];
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# Node not found
|
||||
#############################
|
||||
if (!exists( $data->{$name} )) {
|
||||
push @result, [$name,"Node not found"];
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# Output value
|
||||
#############################
|
||||
my $value = sprintf( $_, @{$data->{$name}}[$i++] );
|
||||
push @result, [$name,$value];
|
||||
}
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns serial-number
|
||||
##########################################################################
|
||||
sub serial {
|
||||
return( vpd(@_) );
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
# Returns machine-type-model
|
||||
##########################################################################
|
||||
sub model {
|
||||
return( vpd(@_) );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns all inventory information
|
||||
##########################################################################
|
||||
sub all {
|
||||
|
||||
my @result = (
|
||||
@{vpd(@_)},
|
||||
@{bus(@_)},
|
||||
@{config(@_)}
|
||||
);
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
109
perl-xCAT-2.0/xCAT/PPClog.pm
Normal file
109
perl-xCAT-2.0/xCAT/PPClog.pm
Normal file
@ -0,0 +1,109 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPClog;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my $args = $request->{arg};
|
||||
my %opt = ();
|
||||
my @reventlog = qw(clear all all_clear);
|
||||
my @VERSION = qw( 2.0 );
|
||||
my $cmd;
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"reventlog -h|--help",
|
||||
"reventlog -v|--version",
|
||||
"reventlog [-V|--verbose] noderange " . join( '|', @reventlog ),
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output",
|
||||
" -e Reads number of entries specified, starting with first"])
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return(usage( "No command specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version e=s) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for non-zero integer
|
||||
####################################
|
||||
if ( exists( $opt{e} )) {
|
||||
if ( $opt{e} !~ /^[1-9]{1}$|^[1-9]{1}[0-9]+$/ ) {
|
||||
return(usage( "Invalid entry: $opt{e}" ));
|
||||
}
|
||||
$cmd = "entries";
|
||||
}
|
||||
else {
|
||||
################################
|
||||
# Unsupported commands
|
||||
################################
|
||||
($cmd) = grep(/^$ARGV[0]$/, @reventlog );
|
||||
if ( !defined( $cmd )) {
|
||||
return(usage( "Invalid command: $ARGV[0]" ));
|
||||
}
|
||||
shift @ARGV;
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Set method to invoke
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
227
perl-xCAT-2.0/xCAT/PPCmac.pm
Normal file
227
perl-xCAT-2.0/xCAT/PPCmac.pm
Normal file
@ -0,0 +1,227 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCmac;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"getmacs -h|--help",
|
||||
"getmacs -v|--version",
|
||||
"getmacs [-V|--verbose] noderange [-S server -G gateway -C client]",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -C IP of the partition",
|
||||
" -G Gateway IP of the partition specified",
|
||||
" -S Server IP to ping",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version C=s G=s S=s) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# If one specified, all required
|
||||
####################################
|
||||
my @network;
|
||||
foreach ( qw(C G S) ) {
|
||||
if ( exists($opt{$_}) ) {
|
||||
push @network, $_;
|
||||
}
|
||||
}
|
||||
if ( @network ) {
|
||||
if ( scalar(@network) != 3 ) {
|
||||
return( usage() );
|
||||
}
|
||||
my $result = validate_ip( $opt{C}, $opt{G}, $opt{S} );
|
||||
if ( @$result[0] ) {
|
||||
return(usage( @$result[1] ));
|
||||
}
|
||||
}
|
||||
####################################
|
||||
# Set method to invoke
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Validate list of IPs
|
||||
##########################################################################
|
||||
sub validate_ip {
|
||||
|
||||
foreach my $ip (@_) {
|
||||
###################################
|
||||
# Length is 4 for IPv4 addresses
|
||||
###################################
|
||||
my (@octets) = /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
|
||||
if ( scalar(@octets) != 4 ) {
|
||||
return( [1,"Invalid IP address: $ip"] );
|
||||
}
|
||||
foreach my $octet ( @octets ) {
|
||||
if (( $octet < 0 ) or ( $octet > 255 )) {
|
||||
return( [1,"Invalid IP address: $ip"] );
|
||||
}
|
||||
}
|
||||
}
|
||||
return([0]);
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# IVM get LPAR MAC addresses
|
||||
##########################################################################
|
||||
sub ivm_getmacs {
|
||||
|
||||
my $request = shift;
|
||||
my $d = shift;
|
||||
my $exp = shift;
|
||||
my $name = shift;
|
||||
|
||||
return( [[RC_ERROR,"Not Implemented"]] );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Get LPAR MAC addresses
|
||||
##########################################################################
|
||||
sub getmacs {
|
||||
|
||||
my $request = shift;
|
||||
my $d = shift;
|
||||
my $exp = shift;
|
||||
my $opt = $request->{opt};
|
||||
my $hwtype = @$exp[2];
|
||||
my @output;
|
||||
|
||||
#########################################
|
||||
# Get node data
|
||||
#########################################
|
||||
my $type = @$d[4];
|
||||
my $name = @$d[6];
|
||||
|
||||
#########################################
|
||||
# Invalid target hardware
|
||||
#########################################
|
||||
if ( $type ne "lpar" ) {
|
||||
return( [[$name,"Node must be LPAR"]] );
|
||||
}
|
||||
#########################################
|
||||
# IVM does not have lpar_netboot command
|
||||
# so we have to manually collect MAC
|
||||
# addresses.
|
||||
#########################################
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
return( ivm_getmacs( $request, $d, $exp, $name ));
|
||||
}
|
||||
my $result = xCAT::PPCcli::lpar_netboot(
|
||||
$exp,
|
||||
$name,
|
||||
$d,
|
||||
$opt->{S},
|
||||
$opt->{G},
|
||||
$opt->{C} );
|
||||
|
||||
my $Rc = shift(@$result);
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [[$name,@$result]] );
|
||||
}
|
||||
##################################
|
||||
# Success - verbose output
|
||||
##################################
|
||||
my $data = join( '',@$result );
|
||||
|
||||
if ( exists($request->{verbose}) ) {
|
||||
return( [[$name,$data]] );
|
||||
}
|
||||
##################################
|
||||
# lpar_netboot returns:
|
||||
#
|
||||
# Connecting to lpar4\r\n
|
||||
# Connected\r\n
|
||||
# Checking for power off.\r\n
|
||||
# Power off complete.\r\n
|
||||
# Power on lpar4 to Open Firmware.\r\n
|
||||
# Power on complete.\r\n
|
||||
# Getting adapter location codes.\r\n
|
||||
# Type\t Location Code\t MAC Address\t Full Path Name\t
|
||||
# Ping Result\t Device Type\r\nent U9117.MMA.10F6F3D-V5-C3-T1
|
||||
# 1e0e122a930d /vdevice/l-lan@30000003 virtual\r\n
|
||||
#####################################
|
||||
$data =~ /Device Type(.*)/;
|
||||
my $values;
|
||||
|
||||
foreach ( split /\r\n/, $1 ) {
|
||||
if ( /ent ([^\s]+) ([^\s]+)/ ) {
|
||||
$values.= "$1:".uc($2);
|
||||
}
|
||||
}
|
||||
return( [[$name,$values]] );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
331
perl-xCAT-2.0/xCAT/PPCpower.pm
Normal file
331
perl-xCAT-2.0/xCAT/PPCpower.pm
Normal file
@ -0,0 +1,331 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCpower;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my $args = $request->{arg};
|
||||
my %opt = ();
|
||||
my @rpower = qw(on off stat state reset boot of);
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rpower -h|--help",
|
||||
"rpower -v|--version",
|
||||
"rpower [-V|--verbose] noderange " . join( '|', @rpower ),
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return(usage( "No command specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Unsupported commands
|
||||
####################################
|
||||
my ($cmd) = grep(/^$ARGV[0]$/, @rpower );
|
||||
if ( !defined( $cmd )) {
|
||||
return(usage( "Invalid command: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
shift @ARGV;
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Change "stat" to "state"
|
||||
####################################
|
||||
$request->{op} = $cmd;
|
||||
$cmd =~ s/^stat$/state/;
|
||||
|
||||
####################################
|
||||
# Power commands special case
|
||||
####################################
|
||||
if ( $cmd ne "state" ) {
|
||||
$cmd = ($cmd eq "boot") ? "powercmd_boot" : "powercmd";
|
||||
}
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Builds a hash of CEC/LPAR information returned from HMC/IVM
|
||||
##########################################################################
|
||||
sub enumerate {
|
||||
|
||||
my $exp = shift;
|
||||
my $node = shift;
|
||||
my $mtms = shift;
|
||||
my $filter = shift;
|
||||
my %outhash = ();
|
||||
my %cmds = ();
|
||||
|
||||
######################################
|
||||
# Check for CEC/LPAR/BPAs in list
|
||||
######################################
|
||||
while (my ($name,$d) = each(%$node) ) {
|
||||
if ( @$d[4] =~ /^fsp|lpar|bpa$/ ) {
|
||||
$cmds{@$d[4]} = 1;
|
||||
}
|
||||
}
|
||||
######################################
|
||||
# Check for HMC/IVMs in list
|
||||
######################################
|
||||
my ($name) = keys %$node;
|
||||
my $type = @{$node->{$name}}[4];
|
||||
|
||||
if ( $type =~ /^hmc|ivm$/ ) {
|
||||
$outhash{$name} = "Running";
|
||||
}
|
||||
|
||||
foreach ( keys %cmds ) {
|
||||
my $values = xCAT::PPCcli::lssyscfg( $exp, $_, $mtms, $filter );
|
||||
my $Rc = shift(@$values);
|
||||
|
||||
##################################
|
||||
# Return error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [$Rc,@$values[0]] );
|
||||
}
|
||||
##################################
|
||||
# Save LPARs by name
|
||||
##################################
|
||||
foreach ( @$values ) {
|
||||
my ($name,$state) = split /,/;
|
||||
$outhash{ $name } = $state;
|
||||
}
|
||||
}
|
||||
return( [SUCCESS,\%outhash] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Performs boot operation (Off->On, On->Reset)
|
||||
##########################################################################
|
||||
sub powercmd_boot {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $filter = "name,state";
|
||||
my @output = ();
|
||||
|
||||
######################################
|
||||
# Power commands are grouped by CEC
|
||||
# not Hardware Control Point
|
||||
######################################
|
||||
|
||||
######################################
|
||||
# Get CEC MTMS
|
||||
######################################
|
||||
my ($name) = keys %$hash;
|
||||
my $mtms = @{$hash->{$name}}[2];
|
||||
|
||||
######################################
|
||||
# Build CEC/LPAR information hash
|
||||
######################################
|
||||
my $stat = enumerate( $exp, $hash, $mtms, $filter );
|
||||
my $Rc = shift(@$stat);
|
||||
my $data = @$stat[0];
|
||||
|
||||
while (my ($name,$d) = each(%$hash) ) {
|
||||
##################################
|
||||
# Output error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @output, [$name,$data];
|
||||
next;
|
||||
}
|
||||
##################################
|
||||
# Node not found
|
||||
##################################
|
||||
if ( !exists( $data->{$name} )) {
|
||||
push @output, [$name,"Node not found"];
|
||||
next;
|
||||
}
|
||||
##################################
|
||||
# Convert state to on/off
|
||||
##################################
|
||||
my $state = power_status($data->{$name});
|
||||
my $op = ($state =~ /^Off|Not Activated$/) ? "on" : "reset";
|
||||
|
||||
##############################
|
||||
# Send power command
|
||||
##############################
|
||||
my $result = xCAT::PPCcli::chsysstate(
|
||||
$exp,
|
||||
$op,
|
||||
$d );
|
||||
push @output, [$name,@$result[1]];
|
||||
}
|
||||
return( \@output );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Performs power control operations (on,off,reboot,etc)
|
||||
##########################################################################
|
||||
sub powercmd {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my @result = ();
|
||||
|
||||
####################################
|
||||
# Power commands are grouped by CEC
|
||||
# not Hardware Control Point
|
||||
####################################
|
||||
|
||||
while (my ($name,$d) = each(%$hash) ) {
|
||||
################################
|
||||
# Send command to each LPAR
|
||||
################################
|
||||
my $values = xCAT::PPCcli::chsysstate(
|
||||
$exp,
|
||||
$request->{op},
|
||||
$d );
|
||||
my $Rc = shift(@$values);
|
||||
|
||||
################################
|
||||
# Return result
|
||||
################################
|
||||
push @result, [$name,@$values[0]];
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Queries CEC/LPAR power status (On or Off)
|
||||
##########################################################################
|
||||
sub power_status {
|
||||
|
||||
my @states = (
|
||||
"Operating",
|
||||
"Running",
|
||||
"Open Firmware"
|
||||
);
|
||||
foreach ( @states ) {
|
||||
if ( /^$_[0]$/ ) {
|
||||
return("on");
|
||||
}
|
||||
}
|
||||
return("off");
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Queries CEC/LPAR power state
|
||||
##########################################################################
|
||||
sub state {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $prefix = shift;
|
||||
my $convert = shift;
|
||||
my $filter = "name,state";
|
||||
my @result = ();
|
||||
|
||||
if ( !defined( $prefix )) {
|
||||
$prefix = "";
|
||||
}
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
######################################
|
||||
# Build CEC/LPAR information hash
|
||||
######################################
|
||||
my $stat = enumerate( $exp, $h, $mtms, $filter );
|
||||
my $Rc = shift(@$stat);
|
||||
my $data = @$stat[0];
|
||||
|
||||
while (my ($name,$d) = each(%$h) ) {
|
||||
##################################
|
||||
# Output error
|
||||
##################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @result, [$name, "$prefix$data"];
|
||||
next;
|
||||
}
|
||||
##################################
|
||||
# Node not found
|
||||
##################################
|
||||
if ( !exists( $data->{$name} )) {
|
||||
push @result, [$name, $prefix."Node not found"];
|
||||
next;
|
||||
}
|
||||
##################################
|
||||
# Output value
|
||||
##################################
|
||||
my $value = $data->{$name};
|
||||
|
||||
##############################
|
||||
# Convert state to on/off
|
||||
##############################
|
||||
if ( defined( $convert )) {
|
||||
$value = power_status( $value );
|
||||
}
|
||||
push @result, [$name,"$prefix$value"];
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
488
perl-xCAT-2.0/xCAT/PPCscan.pm
Normal file
488
perl-xCAT-2.0/xCAT/PPCscan.pm
Normal file
@ -0,0 +1,488 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCscan;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use XML::Simple;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
use xCAT::PPCdb;
|
||||
|
||||
##############################################
|
||||
# Globals
|
||||
##############################################
|
||||
my @header = (
|
||||
["type", "%-8s" ],
|
||||
["name", "placeholder" ],
|
||||
["id", "%-8s" ],
|
||||
["type-model", "%-12s" ],
|
||||
["serial-number", "%-15s" ],
|
||||
["address", "%s\n" ]);
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rscan -h",
|
||||
"rscan -v|--version",
|
||||
"rscan [-V|--verbose] noderange [-w][-x]",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output",
|
||||
" -w writes output to xCat database",
|
||||
" -x xml formatted output",
|
||||
" -z stanza formatted output." ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version w x z) )){
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
#############################################
|
||||
# Check for mutually-exclusive formatting
|
||||
#############################################
|
||||
if (( exists($opt{x}) + exists($opt{z})) > 1 ) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# No operands - add command name
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns I/O bus information
|
||||
##########################################################################
|
||||
sub enumerate {
|
||||
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my $server = @$exp[3];
|
||||
my @values = ();
|
||||
my %cage = ();
|
||||
|
||||
#####################################################
|
||||
# Cache all type information as:
|
||||
# type,name,id,model,serial,hcp,profile,frame,ips
|
||||
#####################################################
|
||||
|
||||
#########################################
|
||||
# Get hardware control point info
|
||||
#########################################
|
||||
my $hcp = xCAT::PPCcli::lshmc( $exp );
|
||||
my $Rc = shift(@$hcp);
|
||||
|
||||
#########################################
|
||||
# Return error
|
||||
#########################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( @$hcp[0] );
|
||||
}
|
||||
#########################################
|
||||
# Success
|
||||
#########################################
|
||||
my ($model,$serial) = split /,/, @$hcp[0];
|
||||
my ($prof,$id,$ips,$bpa) = undef;
|
||||
|
||||
push @values, join( ",",
|
||||
$hwtype,$server,$id,$model,$serial,$server,$prof,$bpa,$ips );
|
||||
|
||||
#########################################
|
||||
# Enumerate frames (IVM has no frame)
|
||||
#########################################
|
||||
if ( $hwtype ne "ivm" ) {
|
||||
my $filter = "type_model,serial_num,name,frame_num,ipaddr_a,ipaddr_b";
|
||||
my $frames = xCAT::PPCcli::lssyscfg( $exp, "bpas", $filter );
|
||||
my $Rc = shift(@$frames);
|
||||
|
||||
#####################################
|
||||
# Expect error
|
||||
#####################################
|
||||
if ( $Rc == EXPECT_ERROR ) {
|
||||
return( @$frames[0] );
|
||||
}
|
||||
#####################################
|
||||
# CLI error
|
||||
#####################################
|
||||
if ( $Rc == RC_ERROR ) {
|
||||
return( @$frames[0] );
|
||||
}
|
||||
#####################################
|
||||
# If frames found, enumerate cages
|
||||
#####################################
|
||||
if ( $Rc != NR_ERROR ) {
|
||||
my $filter = "cage_num,type_model_serial_num";
|
||||
|
||||
foreach my $values ( @$frames ) {
|
||||
my ($model,$serial) = split /,/, $values;
|
||||
my $mtms = "$model*$serial";
|
||||
|
||||
my $cages = xCAT::PPCcli::lssyscfg($exp,"cage",$mtms,$filter);
|
||||
$Rc = shift(@$cages);
|
||||
|
||||
#############################
|
||||
# Return error
|
||||
#############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( @$cages[0] );
|
||||
}
|
||||
#############################
|
||||
# Success
|
||||
#############################
|
||||
foreach ( @$cages ) {
|
||||
my ($cageid,$mtms) = split /,/;
|
||||
$cage{$mtms} = "$cageid,$values";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#########################################
|
||||
# Enumerate CECs
|
||||
#########################################
|
||||
my $filter = "name,type_model,serial_num,ipaddr";
|
||||
my $cecs = xCAT::PPCcli::lssyscfg( $exp, "fsps", $filter );
|
||||
$Rc = shift(@$cecs);
|
||||
|
||||
#########################################
|
||||
# Return error
|
||||
#########################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( @$cecs[0] );
|
||||
}
|
||||
foreach ( @$cecs ) {
|
||||
#####################################
|
||||
# Get CEC information
|
||||
#####################################
|
||||
my ($fsp,$model,$serial,$ips) = split /,/;
|
||||
my $mtms = "$model*$serial";
|
||||
my $cageid = undef;
|
||||
|
||||
#####################################
|
||||
# Get cage CEC is in
|
||||
#####################################
|
||||
my $frame = $cage{$mtms};
|
||||
|
||||
#####################################
|
||||
# Save frame information
|
||||
#####################################
|
||||
if ( defined($frame)) {
|
||||
my ($cage,$model,$serial,$fname,$id,$ipa,$ipb) = split /,/, $frame;
|
||||
my $prof = undef;
|
||||
my $bpa = undef;
|
||||
my $ips = "$ipa $ipb";
|
||||
$cageid = $cage;
|
||||
$frame = $fname;
|
||||
|
||||
push @values, join( ",",
|
||||
"bpa",$fname,$id,$model,$serial,$server,$prof,$bpa,$ips );
|
||||
}
|
||||
#####################################
|
||||
# Save CEC information
|
||||
#####################################
|
||||
my $prof = undef;
|
||||
|
||||
push @values, join( ",",
|
||||
"fsp",$fsp,$cageid,$model,$serial,$server,$prof,$frame,$ips );
|
||||
|
||||
#####################################
|
||||
# Enumerate LPARs
|
||||
#####################################
|
||||
my $filter = "name,lpar_id,default_profile,curr_profile";
|
||||
my $lpars = xCAT::PPCcli::lssyscfg( $exp, "lpar", $mtms, $filter );
|
||||
$Rc = shift(@$lpars);
|
||||
|
||||
####################################
|
||||
# Expect error
|
||||
####################################
|
||||
if ( $Rc == EXPECT_ERROR ) {
|
||||
return( @$lpars[0] );
|
||||
}
|
||||
####################################
|
||||
# Skip...
|
||||
# CEC could be "Incomplete" state
|
||||
####################################
|
||||
if ( $Rc == RC_ERROR ) {
|
||||
next;
|
||||
}
|
||||
####################################
|
||||
# No results found
|
||||
####################################
|
||||
if ( $Rc == NR_ERROR ) {
|
||||
next;
|
||||
}
|
||||
foreach ( @$lpars ) {
|
||||
my ($name,$lparid,$dprof,$curprof) = split /,/;
|
||||
my $prof = (length($curprof)) ? $curprof : $dprof;
|
||||
my $ips = undef;
|
||||
|
||||
#####################################
|
||||
# Save LPAR information
|
||||
#####################################
|
||||
push @values, join( ",",
|
||||
"lpar",$name,$lparid,$serial,$model,$server,$prof,$fsp,$ips );
|
||||
}
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Format responses
|
||||
##########################################################################
|
||||
sub format_output {
|
||||
|
||||
my $request = shift;
|
||||
my $exp = shift;
|
||||
my $values = shift;
|
||||
my $opt = $request->{opt};
|
||||
my %output = ();
|
||||
my $max_length = 0;
|
||||
my $result;
|
||||
|
||||
###########################################
|
||||
# -w flag for write to xCat database
|
||||
###########################################
|
||||
if ( exists( $opt->{w} )) {
|
||||
my $hwtype = @$exp[2];
|
||||
my $server = @$exp[3];
|
||||
my $uid = @$exp[4];
|
||||
my $pw = @$exp[5];
|
||||
|
||||
xCAT::PPCdb::add_ppc( $hwtype, $values );
|
||||
}
|
||||
###########################################
|
||||
# -x flag for xml format
|
||||
###########################################
|
||||
if ( exists( $opt->{x} )) {
|
||||
$result = format_xml( $values );
|
||||
}
|
||||
###########################################
|
||||
# -z flag for schema format
|
||||
###########################################
|
||||
elsif ( exists( $opt->{z} )) {
|
||||
$result = format_schema( $values );
|
||||
}
|
||||
else {
|
||||
#######################################
|
||||
# Get longest name for formatting
|
||||
#######################################
|
||||
foreach ( @$values ) {
|
||||
/[^\,]+,([^\,]+),/;
|
||||
my $length = length( $1 );
|
||||
$max_length = ($length > $max_length) ? $length : $max_length;
|
||||
}
|
||||
my $format = sprintf "%%-%ds", ($max_length + 2 );
|
||||
$header[1][1] = $format;
|
||||
|
||||
#######################################
|
||||
# Add header
|
||||
#######################################
|
||||
foreach ( @header ) {
|
||||
$result .= sprintf @$_[1], @$_[0];
|
||||
}
|
||||
#######################################
|
||||
# Add node information
|
||||
#######################################
|
||||
foreach ( @$values ) {
|
||||
my @data = split /,/;
|
||||
my $i = 0;
|
||||
|
||||
foreach ( @header ) {
|
||||
my $d = $data[$i++];
|
||||
|
||||
###############################
|
||||
# Use IPs instead of
|
||||
# hardware control address
|
||||
###############################
|
||||
if ( @$_[0] eq "address" ) {
|
||||
if ( $data[0] !~ /^hmc|ivm$/ ) {
|
||||
$d = $data[8];
|
||||
}
|
||||
}
|
||||
$result .= sprintf @$_[1], $d;
|
||||
}
|
||||
}
|
||||
}
|
||||
$output{data} = [$result];
|
||||
return( [\%output] );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Schema formatting
|
||||
##########################################################################
|
||||
sub format_schema {
|
||||
|
||||
my $values = shift;
|
||||
my $result;
|
||||
|
||||
foreach ( @$values ) {
|
||||
my @data = split /,/;
|
||||
my $i = 0;
|
||||
|
||||
#################################
|
||||
# Node attributes
|
||||
#################################
|
||||
$result .= "$data[1]:\n\tobjtype=node\n";
|
||||
|
||||
#################################
|
||||
# Add each attribute
|
||||
#################################
|
||||
foreach ( @header ) {
|
||||
my $d = $data[$i++];
|
||||
|
||||
if ( @$_[0] eq "name" ) {
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# Use IPs instead of
|
||||
# hardware control address
|
||||
#############################
|
||||
if ( @$_[0] eq "address" ) {
|
||||
if ( $data[0] !~ /^hmc|ivm$/ ) {
|
||||
$d = $data[8];
|
||||
}
|
||||
}
|
||||
$result .= "\t@$_[0]=$d\n";
|
||||
}
|
||||
}
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# XML formatting
|
||||
##########################################################################
|
||||
sub format_xml {
|
||||
|
||||
my $values = shift;
|
||||
my $xml;
|
||||
|
||||
#####################################
|
||||
# Create XML formatted attributes
|
||||
#####################################
|
||||
foreach ( @$values ) {
|
||||
my @data = split /,/;
|
||||
my $i = 0;
|
||||
|
||||
#################################
|
||||
# Initialize hash reference
|
||||
#################################
|
||||
my $href = {
|
||||
Node => { }
|
||||
};
|
||||
#################################
|
||||
# Add each attribute
|
||||
#################################
|
||||
foreach ( @header ) {
|
||||
my $d = $data[$i++];
|
||||
|
||||
#############################
|
||||
# Use IPs instead of
|
||||
# hardware control address
|
||||
#############################
|
||||
if ( @$_[0] eq "address" ) {
|
||||
if ( $data[0] !~ /^hmc|ivm$/ ) {
|
||||
$d = $data[8];
|
||||
}
|
||||
}
|
||||
$href->{Node}->{@$_[0]} = $d;
|
||||
}
|
||||
#################################
|
||||
# XML encoding
|
||||
#################################
|
||||
$xml.= XMLout($href,
|
||||
NoAttr => 1,
|
||||
KeyAttr => [],
|
||||
RootName => undef );
|
||||
}
|
||||
return( $xml );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns I/O bus information
|
||||
##########################################################################
|
||||
sub rscan {
|
||||
|
||||
my $request = shift;
|
||||
my $dummy = shift;
|
||||
my $exp = shift;
|
||||
my $args = $request->{arg};
|
||||
my $server = @$exp[3];
|
||||
|
||||
###################################
|
||||
# Enumerate all the hardware
|
||||
###################################
|
||||
my $values = enumerate( $exp );
|
||||
if ( ref($values) ne 'ARRAY' ) {
|
||||
return( [[$server,$values]] );
|
||||
}
|
||||
###################################
|
||||
# Success
|
||||
###################################
|
||||
my $result = format_output( $request, $exp, $values );
|
||||
unshift @$result, "FORMATTED_DATA";
|
||||
return( $result );
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
329
perl-xCAT-2.0/xCAT/PPCvitals.pm
Normal file
329
perl-xCAT-2.0/xCAT/PPCvitals.pm
Normal file
@ -0,0 +1,329 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCvitals;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
use xCAT::PPCpower;
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my $args = $request->{arg};
|
||||
my %opt = ();
|
||||
my @rvitals = qw(temp voltage power state all);
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rvitals -h|--help",
|
||||
"rvitals -v|--version",
|
||||
"rvitals [-V|--verbose] noderange " . join( '|', @rvitals ),
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return(usage( "No command specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Unsupported command
|
||||
####################################
|
||||
my ($cmd) = grep(/^$ARGV[0]$/, @rvitals );
|
||||
if ( !defined( $cmd )) {
|
||||
return(usage( "Invalid command: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
shift @ARGV;
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# Set method to invoke
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns Frame voltages/currents
|
||||
##########################################################################
|
||||
sub enumerate_volt {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
|
||||
my $mtms = @$d[2];
|
||||
my $volt = xCAT::PPCcli::lshwinfo( $exp, "frame", $mtms );
|
||||
my $Rc = shift(@$volt);
|
||||
|
||||
####################################
|
||||
# Return error
|
||||
####################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [RC_ERROR, @$volt[0]] );
|
||||
}
|
||||
####################################
|
||||
# Success - return voltages
|
||||
####################################
|
||||
return( [SUCCESS, @$volt[0]] );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns cage temperatures
|
||||
##########################################################################
|
||||
sub enumerate_temp {
|
||||
|
||||
my $exp = shift;
|
||||
my $frame = shift;
|
||||
my %outhash = ();
|
||||
|
||||
####################################
|
||||
# Get cage information for frame
|
||||
####################################
|
||||
my $filter = "type_model_serial_num,temperature";
|
||||
my $cages = xCAT::PPCcli::lshwinfo( $exp, "sys", $frame, $filter );
|
||||
my $Rc = shift(@$cages);
|
||||
|
||||
####################################
|
||||
# Expect error
|
||||
####################################
|
||||
if ( $Rc == EXPECT_ERROR ) {
|
||||
return( [$Rc,@$cages[0]] );
|
||||
}
|
||||
####################################
|
||||
# Save frame by CEC MTMS in cage
|
||||
####################################
|
||||
foreach ( @$cages ) {
|
||||
my ($mtms,$temp) = split /,/;
|
||||
$outhash{$mtms} = $temp;
|
||||
}
|
||||
return( [SUCCESS,\%outhash] );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns voltages/currents
|
||||
##########################################################################
|
||||
sub voltage {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my @result = ();
|
||||
my $text = "Frame Voltages: ";
|
||||
my @prefix = (
|
||||
"Frame Voltage (Vab): %sV",
|
||||
"Frame Voltage (Vbc): %sV",
|
||||
"Frame Voltage (Vca): %sV",
|
||||
"Frame Current (Ia): %sA",
|
||||
"Frame Current (Ib): %sA",
|
||||
"Frame Current (Ic): %sA",
|
||||
);
|
||||
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
while (my ($name,$d) = each(%$h) ) {
|
||||
#################################
|
||||
# No frame command on IVM
|
||||
#################################
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
push @result, [$name,"$text Not available"];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Voltages available in frame
|
||||
#################################
|
||||
if ( @$d[4] ne "bpa" ) {
|
||||
push @result, [$name,"$text Only available for BPA"];
|
||||
next;
|
||||
}
|
||||
my $volt = enumerate_volt( $exp, $d );
|
||||
my $Rc = shift(@$volt);
|
||||
|
||||
#################################
|
||||
# Output error
|
||||
#################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @result, [$name,"$text @$volt[0]"];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Output value
|
||||
#################################
|
||||
my @values = split /,/, @$volt[0];
|
||||
my $i = 0;
|
||||
|
||||
foreach ( @prefix ) {
|
||||
my $value = sprintf($_, $values[$i++]);
|
||||
push @result, [$name,$value];
|
||||
}
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns temperatures for CEC
|
||||
##########################################################################
|
||||
sub temp {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my @result = ();
|
||||
my %frame = ();
|
||||
my $prefix = "System Temperature:";
|
||||
|
||||
#########################################
|
||||
# Group by frame
|
||||
#########################################
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
while (my ($name,$d) = each(%$h) ) {
|
||||
my $mtms = @$d[5];
|
||||
|
||||
#################################
|
||||
# No frame commands for IVM
|
||||
#################################
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
push @result, [$name,"$prefix Not available (No BPA)"];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Temperatures not available
|
||||
#################################
|
||||
if ( @$d[4] !~ /^fsp|lpar$/ ) {
|
||||
my $text = "$prefix Only available for CEC/LPAR";
|
||||
push @result, [$name,$text];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Error - No frame
|
||||
#################################
|
||||
if ( $mtms eq "0" ) {
|
||||
push @result, [$name,"$prefix Not available (No BPA)"];
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Save node
|
||||
#################################
|
||||
$frame{$mtms}{$name} = $d;
|
||||
}
|
||||
}
|
||||
|
||||
while (my ($mtms,$h) = each(%frame) ) {
|
||||
#################################
|
||||
# Get temperatures this frame
|
||||
#################################
|
||||
my $temp = enumerate_temp( $exp, $mtms );
|
||||
my $Rc = shift(@$temp);
|
||||
my $data = @$temp[0];
|
||||
|
||||
while (my ($name,$d) = each(%$h) ) {
|
||||
my $mtms = @$d[2];
|
||||
|
||||
#############################
|
||||
# Output error
|
||||
#############################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @result, [$name,"$prefix $data"];
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# CEC not in frame
|
||||
#############################
|
||||
if ( !exists( $data->{$mtms} )) {
|
||||
push @result, [$name,"$prefix CEC '$mtms' not found"];
|
||||
next;
|
||||
}
|
||||
#############################
|
||||
# Output value
|
||||
#############################
|
||||
my $cel = $data->{$mtms};
|
||||
my $fah = ($cel * 1.8) + 32;
|
||||
my $value = "$prefix $cel C ($fah F)";
|
||||
push @result, [$name,$value];
|
||||
}
|
||||
}
|
||||
return( \@result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns system power status (on or off)
|
||||
##########################################################################
|
||||
sub power {
|
||||
return( xCAT::PPCpower::state(@_,"Current Power Status: ",1));
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
# Returns system state
|
||||
##########################################################################
|
||||
sub state {
|
||||
return( xCAT::PPCpower::state(@_,"System State: "));
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Returns all vitals
|
||||
##########################################################################
|
||||
sub all {
|
||||
|
||||
my @values = (
|
||||
@{temp(@_)},
|
||||
@{voltage(@_)},
|
||||
@{state(@_)},
|
||||
@{power(@_)}
|
||||
);
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
824
perl-xCAT-2.0/xCAT/PPCvm.pm
Normal file
824
perl-xCAT-2.0/xCAT/PPCvm.pm
Normal file
@ -0,0 +1,824 @@
|
||||
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
|
||||
|
||||
package xCAT::PPCvm;
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
|
||||
use xCAT::PPCdb;
|
||||
|
||||
|
||||
##############################################
|
||||
# Globals
|
||||
##############################################
|
||||
my %method = (
|
||||
mkvm => \&mkvm_parse_args,
|
||||
lsvm => \&lsvm_parse_args,
|
||||
rmvm => \&rmvm_parse_args,
|
||||
chvm => \&chvm_parse_args
|
||||
);
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the command line for options and operands
|
||||
##########################################################################
|
||||
sub parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my $cmd = $request->{command};
|
||||
|
||||
###############################
|
||||
# Invoke correct parse_args
|
||||
###############################
|
||||
my $result = $method{$cmd}( $request );
|
||||
return( $result );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the chvm command line for options and operands
|
||||
##########################################################################
|
||||
sub chvm_parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"chvm -h|--help",
|
||||
"chvm -v|--version",
|
||||
"chvm [-V|--verbose] noderange",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
####################################
|
||||
# Configuration file required
|
||||
####################################
|
||||
if ( !exists( $request->{stdin} ) ) {
|
||||
return(usage( "Configuration file not specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# No operands - add command name
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the mkvm command line for options and operands
|
||||
##########################################################################
|
||||
sub mkvm_parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"mkvm -h|--help",
|
||||
"mkvm -v|--version",
|
||||
"mkvm [-V|--verbose] singlenode -i id -n name",
|
||||
"mkvm [-V|--verbose] singlecec -c cec",
|
||||
" -h writes usage information to standard output",
|
||||
" -c target cec",
|
||||
" -i new partition numeric id",
|
||||
" -n new partition name",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
return(usage( "No command specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Only 1 node allowed
|
||||
#############################################
|
||||
if ( scalar( @{$request->{node}} ) > 1) {
|
||||
return(usage( "multiple nodes specified" ));
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version i=s n=s c=s) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for non-zero integer
|
||||
####################################
|
||||
if ( exists( $opt{i} )) {
|
||||
if ( $opt{i} =~ /^[1-9]{1}$|^[1-9]{1}[0-9]+$/ ) {
|
||||
return(usage( "Invalid entry: $opt{i}" ));
|
||||
}
|
||||
}
|
||||
####################################
|
||||
# -i and -n not valid with -c
|
||||
####################################
|
||||
if ( exists( $opt{c} ) ) {
|
||||
if ( exists($opt{i}) or exists($opt{n})) {
|
||||
return( usage() );
|
||||
}
|
||||
}
|
||||
####################################
|
||||
# If -i and -n, both required
|
||||
####################################
|
||||
elsif ( !exists($opt{n}) or !exists($opt{i})) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# No operands - add command name
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the rmvm command line for options and operands
|
||||
##########################################################################
|
||||
sub rmvm_parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"rmvm -h|--help",
|
||||
"rmvm -v|--version",
|
||||
"rmvm [-V|--verbose] noderange",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# No operands - add command name
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Parse the lsvm command line for options and operands
|
||||
##########################################################################
|
||||
sub lsvm_parse_args {
|
||||
|
||||
my $request = shift;
|
||||
my %opt = ();
|
||||
my $cmd = $request->{command};
|
||||
my $args = $request->{arg};
|
||||
my @VERSION = qw( 2.0 );
|
||||
|
||||
#############################################
|
||||
# Responds with usage statement
|
||||
#############################################
|
||||
local *usage = sub {
|
||||
return( [ $_[0],
|
||||
"lsvm -h|--help",
|
||||
"lsvm -v|--version",
|
||||
"lsvm [-V|--verbose] noderange",
|
||||
" -h writes usage information to standard output",
|
||||
" -v displays command version",
|
||||
" -V verbose output" ]);
|
||||
};
|
||||
#############################################
|
||||
# Process command-line arguments
|
||||
#############################################
|
||||
if ( !defined( $args )) {
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
#############################################
|
||||
# Checks case in GetOptions, allows opts
|
||||
# to be grouped (e.g. -vx), and terminates
|
||||
# at the first unrecognized option.
|
||||
#############################################
|
||||
@ARGV = @$args;
|
||||
$Getopt::Long::ignorecase = 0;
|
||||
Getopt::Long::Configure( "bundling" );
|
||||
|
||||
if ( !GetOptions( \%opt, qw(h|help V|Verbose v|version) )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -h for Help
|
||||
####################################
|
||||
if ( exists( $opt{h} )) {
|
||||
return( usage() );
|
||||
}
|
||||
####################################
|
||||
# Option -v for version
|
||||
####################################
|
||||
if ( exists( $opt{v} )) {
|
||||
return( \@VERSION );
|
||||
}
|
||||
####################################
|
||||
# Check for "-" with no option
|
||||
####################################
|
||||
if ( grep(/^-$/, @ARGV )) {
|
||||
return(usage( "Missing option: -" ));
|
||||
}
|
||||
####################################
|
||||
# Check for an extra argument
|
||||
####################################
|
||||
if ( defined( $ARGV[0] )) {
|
||||
return(usage( "Invalid Argument: $ARGV[0]" ));
|
||||
}
|
||||
####################################
|
||||
# No operands - add command name
|
||||
####################################
|
||||
$request->{method} = $cmd;
|
||||
return( \%opt );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Clones all the partitions from one CEC to another
|
||||
##########################################################################
|
||||
sub clone {
|
||||
|
||||
my $cfgdata = shift;
|
||||
my $d = shift;
|
||||
my $exp = shift;
|
||||
my $opt = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my $target = $opt->{c};
|
||||
my @values = ();
|
||||
my $cecname;
|
||||
|
||||
#####################################
|
||||
# Always one source CEC specified
|
||||
#####################################
|
||||
my $lparid = @$d[0];
|
||||
my $mtms = @$d[2];
|
||||
my $type = @$d[4];
|
||||
|
||||
if ( $type ne "fsp" ) {
|
||||
return( ["Node must be an FSP"] );
|
||||
}
|
||||
#####################################
|
||||
# Enumerate CECs
|
||||
#####################################
|
||||
my $cecs = xCAT::PPCcli::lssyscfg( $exp, "fsps", "name" );
|
||||
my $Rc = shift(@$cecs);
|
||||
|
||||
#####################################
|
||||
# Return error
|
||||
#####################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [@$cecs[0]] );
|
||||
}
|
||||
#####################################
|
||||
# Find target CEC
|
||||
#####################################
|
||||
foreach ( @$cecs ) {
|
||||
if ( $target eq $_ ) {
|
||||
$cecname = $_;
|
||||
last;
|
||||
}
|
||||
}
|
||||
#####################################
|
||||
# Target CEC not found
|
||||
#####################################
|
||||
if ( !defined( $cecname )) {
|
||||
return( ["CEC '$target' not found"] );
|
||||
}
|
||||
#####################################
|
||||
# Modify read-back profile:
|
||||
# - Rename "name" to "profile_name"
|
||||
# - Rename "lpar_name" to "name"
|
||||
# - Delete "virtual_serial_adapters"
|
||||
# completely, these adapters are
|
||||
# created automatically.
|
||||
# - Preceed all double-quotes with
|
||||
# backslashes.
|
||||
#
|
||||
#####################################
|
||||
foreach ( @$cfgdata ) {
|
||||
s/^name=([^,]+)/profile_name=$1/;
|
||||
s/lpar_name=/name=/;
|
||||
s/\"virtual_serial_adapters=[^\"]+\",//;
|
||||
s/\"/\\"/g;
|
||||
my $name = $1;
|
||||
|
||||
/lpar_id=([^,]+)/;
|
||||
$lparid = $1;
|
||||
|
||||
#################################
|
||||
# Create new LPAR
|
||||
#################################
|
||||
my @temp = @$d;
|
||||
$temp[0] = $lparid;
|
||||
|
||||
my $result = xCAT::PPCcli::mksyscfg( $exp, \@temp, $_ );
|
||||
$Rc = shift(@$result);
|
||||
|
||||
#################################
|
||||
# Success - add LPAR to database
|
||||
#################################
|
||||
if ( $Rc == SUCCESS ) {
|
||||
xCATdB( "mkvm", $d, $lparid, $name, $hwtype );
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Error - Save error
|
||||
#################################
|
||||
push @values, @$result[0];
|
||||
}
|
||||
if ( !scalar(@values) ) {
|
||||
@values = qw(Success);
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Removes logical partitions
|
||||
##########################################################################
|
||||
sub remove {
|
||||
|
||||
my $exp = shift;
|
||||
my $d = shift;
|
||||
my $lpar = shift;
|
||||
my $lparid = @$d[0];
|
||||
my $mtms = @$d[2];
|
||||
my $type = @$d[4];
|
||||
my @lpars = ();
|
||||
my @values = ();
|
||||
|
||||
####################################
|
||||
# This is a single LPAR
|
||||
####################################
|
||||
if ( $type eq "lpar" ) {
|
||||
$lpars[0] = "$lpar,$lparid";
|
||||
}
|
||||
####################################
|
||||
# This is a CEC - remove all LPARs
|
||||
####################################
|
||||
else {
|
||||
my $filter = "name,lpar_id";
|
||||
my $result = xCAT::PPCcli::lssyscfg( $exp, "lpar", $mtms, $filter );
|
||||
my $Rc = shift(@$result);
|
||||
|
||||
################################
|
||||
# Expect error
|
||||
################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
return( [@$result[0]] );
|
||||
}
|
||||
################################
|
||||
# Success - save LPARs
|
||||
################################
|
||||
foreach ( @$result ) {
|
||||
push @lpars, $_;
|
||||
}
|
||||
}
|
||||
####################################
|
||||
# Remove the LPARs
|
||||
####################################
|
||||
foreach ( @lpars ) {
|
||||
my ($name,$id) = split /,/;
|
||||
my $mtms = @$d[2];
|
||||
|
||||
################################
|
||||
# id profile mtms hcp type frame
|
||||
################################
|
||||
my @d = ( $id,0,$mtms,0,"lpar",0 );
|
||||
|
||||
################################
|
||||
# Send remove command
|
||||
################################
|
||||
my $result = xCAT::PPCcli::rmsyscfg( $exp, \@d );
|
||||
my $Rc = shift(@$result);
|
||||
|
||||
################################
|
||||
# Remove LPAR from database
|
||||
################################
|
||||
if ( $Rc == SUCCESS ) {
|
||||
xCATdB( "rmvm", $name );
|
||||
}
|
||||
push @values, @$result[0];
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Changes the configuration of an existing partition
|
||||
##########################################################################
|
||||
sub chcfg {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $name = @{$request->{node}}[0];
|
||||
my $cfgdata = $request->{stdin};
|
||||
my @values;
|
||||
|
||||
#######################################
|
||||
# Remove "node: " in case the
|
||||
# configuration file was created as
|
||||
# the result of an "lsvm" command.
|
||||
# "lpar9: name=lpar9, lpar_name=..."
|
||||
#######################################
|
||||
$cfgdata =~ s/^[\w]+: //;
|
||||
|
||||
if ( $cfgdata !~ /^name=/ ) {
|
||||
my $text = "Invalid file format: must begin with 'name='";
|
||||
return( [[$name,$text]] );
|
||||
}
|
||||
#######################################
|
||||
# Preceed double-quotes with '\'
|
||||
#######################################
|
||||
$cfgdata =~ s/\"/\\"/g;
|
||||
$cfgdata =~ s/\n//g;
|
||||
|
||||
while (my ($cec,$h) = each(%$hash) ) {
|
||||
while (my ($lpar,$d) = each(%$h) ) {
|
||||
|
||||
###############################
|
||||
# Change configuration
|
||||
###############################
|
||||
my $result = xCAT::PPCcli::chsyscfg( $exp, $d, $cfgdata );
|
||||
my $Rc = shift(@$result);
|
||||
|
||||
push @values, [$lpar,@$result[0]];
|
||||
return( [[$lpar,@$result[0]]] );
|
||||
}
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Creates/Removes/Lists logical partitions
|
||||
##########################################################################
|
||||
sub vm {
|
||||
|
||||
my $request = shift;
|
||||
my $hash = shift;
|
||||
my $exp = shift;
|
||||
my $hwtype = @$exp[2];
|
||||
my $opt = $request->{opt};
|
||||
my $cmd = $request->{command};
|
||||
my @values = ();
|
||||
my $result;
|
||||
|
||||
while (my ($mtms,$h) = each(%$hash) ) {
|
||||
while (my ($lpar,$d) = each(%$h) ) {
|
||||
my $lparid = @$d[0];
|
||||
my $mtms = @$d[2];
|
||||
my $type = @$d[4];
|
||||
|
||||
#####################################
|
||||
# Must be CEC or LPAR
|
||||
#####################################
|
||||
if ( $type !~ /^lpar|fsp$/ ) {
|
||||
push @values, [$lpar,"Node must be LPAR or CEC"];
|
||||
next;
|
||||
}
|
||||
#####################################
|
||||
# Remove LPAR
|
||||
#####################################
|
||||
if ( $cmd eq "rmvm" ) {
|
||||
$result = remove( $exp, $d, $lpar );
|
||||
|
||||
#################################
|
||||
# Return result
|
||||
#################################
|
||||
foreach ( @$result ) {
|
||||
push @values, [$lpar, $_];
|
||||
}
|
||||
next;
|
||||
}
|
||||
#####################################
|
||||
# Get source LPAR profile
|
||||
#####################################
|
||||
my $prof = xCAT::PPCcli::lssyscfg(
|
||||
$exp,
|
||||
($lparid) ? "prof" : "cprof",
|
||||
$mtms,
|
||||
$lparid );
|
||||
my $Rc = shift(@$prof);
|
||||
|
||||
#####################################
|
||||
# Return error
|
||||
#####################################
|
||||
if ( $Rc != SUCCESS ) {
|
||||
push @values, [$lpar, @$prof[0]];
|
||||
next;
|
||||
}
|
||||
#####################################
|
||||
# List LPAR profile
|
||||
#####################################
|
||||
if ( $cmd eq "lsvm" ) {
|
||||
my $text = join "\n\n", @$prof[0];
|
||||
push @values, [$lpar, $text];
|
||||
next;
|
||||
}
|
||||
#####################################
|
||||
# Clone all the LPARs on CEC
|
||||
#####################################
|
||||
if ( exists( $opt->{c} )) {
|
||||
if ( $hwtype eq "ivm" ) {
|
||||
push @values, [$lpar, "Not supported for IVM"];
|
||||
}
|
||||
else {
|
||||
my $result = clone( $prof, $d, $exp, $opt );
|
||||
foreach ( @$result ) {
|
||||
push @values, [$lpar, $_];
|
||||
}
|
||||
}
|
||||
next;
|
||||
}
|
||||
#################################
|
||||
# Get command-line options
|
||||
#################################
|
||||
my $id = $opt->{i};
|
||||
my $name = $opt->{n};
|
||||
my $cfgdata = @$prof[0];
|
||||
|
||||
if ( $hwtype eq "hmc" ) {
|
||||
#####################################
|
||||
# Modify read-back profile. See
|
||||
# HMC mksyscfg man page for valid
|
||||
# attributes:
|
||||
#
|
||||
# - Rename "name" to "profile_name"
|
||||
# - Rename "lpar_name" to "name"
|
||||
# - Delete "virtual_serial_adapters"
|
||||
# completely, these adapters are
|
||||
# created automatically.
|
||||
# - Preceed all double-quotes with
|
||||
# backslashes.
|
||||
#
|
||||
#####################################
|
||||
$cfgdata =~ s/^name=[^,]+/profile_name=$name/;
|
||||
$cfgdata =~ s/lpar_name=[^,]+/name=$name/;
|
||||
$cfgdata =~ s/lpar_id=[^,]+/lpar_id=$id/;
|
||||
$cfgdata =~ s/\"virtual_serial_adapters=[^\"]+\",//;
|
||||
$cfgdata =~ s/\"/\\"/g;
|
||||
}
|
||||
elsif ( $hwtype eq "ivm" ) {
|
||||
#####################################
|
||||
# Modify read-back profile. See
|
||||
# IVM mksyscfg man page for valid
|
||||
# attributes:
|
||||
#
|
||||
# - Delete
|
||||
# lpar_name
|
||||
# virtual_serial_adapters
|
||||
# lpar_name
|
||||
# os_type
|
||||
# all_resources
|
||||
# lpar_io_pool_ids
|
||||
# conn_monitoring
|
||||
# power_ctrl_lpar_ids
|
||||
# - Preceed all double-quotes with
|
||||
# backslashes.
|
||||
#
|
||||
#####################################
|
||||
$cfgdata =~ s/^name=[^,]+/name=$name/;
|
||||
$cfgdata =~ s/lpar_id=[^,]+/lpar_id=$id/;
|
||||
$cfgdata =~ s/lpar_name=[^,]+,//;
|
||||
$cfgdata =~ s/os_type=/lpar_env=/;
|
||||
$cfgdata =~ s/all_resources=[^,]+,//;
|
||||
$cfgdata =~ s/\"virtual_serial_adapters=[^\"]+\",//;
|
||||
$cfgdata =~ s/lpar_io_pool_ids=[^,]+,//;
|
||||
$cfgdata =~ s/virtual_scsi_adapters=[^,]+,//;
|
||||
$cfgdata =~ s/conn_monitoring=[^,]+,//;
|
||||
$cfgdata =~ s/,power_ctrl_lpar_ids=.*$//;
|
||||
$cfgdata =~ s/\"/\\"/g;
|
||||
}
|
||||
#####################################
|
||||
# Create target LPAR
|
||||
#####################################
|
||||
$result = xCAT::PPCcli::mksyscfg( $exp, $d, $cfgdata );
|
||||
$Rc = shift(@$result);
|
||||
|
||||
#####################################
|
||||
# Add new LPAR to database
|
||||
#####################################
|
||||
if ( $Rc == SUCCESS ) {
|
||||
xCATdB( $cmd, $name, $id, $d, $hwtype );
|
||||
}
|
||||
push @values, [$name,@$result[0]];
|
||||
}
|
||||
}
|
||||
return( \@values );
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Adds/removes LPARs from the xCAT database
|
||||
##########################################################################
|
||||
sub xCATdB {
|
||||
|
||||
my $cmd = shift;
|
||||
my $name = shift;
|
||||
my $lparid = shift;
|
||||
my $d = shift;
|
||||
my $hwtype = shift;
|
||||
|
||||
#######################################
|
||||
# Remove entry
|
||||
#######################################
|
||||
if ( $cmd eq "rmvm" ) {
|
||||
xCAT::PPCdb::rm_ppchardware( $name );
|
||||
}
|
||||
#######################################
|
||||
# Add entry
|
||||
#######################################
|
||||
else {
|
||||
my ($model,$serial) = split /\*/,@$d[2];
|
||||
my $prof = $name;
|
||||
my $frame = @$d[4];
|
||||
my $server = @$d[3];
|
||||
|
||||
my $values = join( ",",
|
||||
"lpar",
|
||||
$name,
|
||||
$lparid,
|
||||
$model,
|
||||
$serial,
|
||||
$server,
|
||||
$prof,
|
||||
$frame );
|
||||
|
||||
xCAT::PPCdb::add_ppc( $hwtype, [$values] );
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Creates logical partitions
|
||||
##########################################################################
|
||||
sub mkvm {
|
||||
return( vm(@_) );
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
# Change logical partition
|
||||
##########################################################################
|
||||
sub chvm {
|
||||
return( chcfg(@_) );
|
||||
}
|
||||
|
||||
|
||||
##########################################################################
|
||||
# Removes logical partitions
|
||||
##########################################################################
|
||||
sub rmvm {
|
||||
return( vm(@_) );
|
||||
}
|
||||
|
||||
##########################################################################
|
||||
# Lists logical partition profile
|
||||
##########################################################################
|
||||
sub lsvm {
|
||||
return( vm(@_) );
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
Loading…
x
Reference in New Issue
Block a user