xcat-core/perl-xCAT/xCAT/PPCscan.pm

728 lines
22 KiB
Perl

# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
package xCAT::PPCscan;
use strict;
use Getopt::Long;
use Socket;
use XML::Simple;
$XML::Simple::PREFERRED_PARSER='XML::Parser';
use xCAT::PPCcli qw(SUCCESS EXPECT_ERROR RC_ERROR NR_ERROR);
use xCAT::PPCdb;
use xCAT::GlobalDef;
use xCAT::Usage;
use xCAT::NetworkUtils;
require xCAT::data::ibmhwtypes;
##############################################
# Globals
##############################################
my @header = (
["type", "%-8s" ],
["name", "placeholder" ],
["id", "%-8s" ],
["type-model", "%-12s" ],
["serial-number", "%-15s" ],
["side", "%-6s\n" ]);
my @attribs = qw(nodetype node id mtm serial side hcp pprofile parent groups mgt cons hwtype);
my %globalnodetype = (
fsp => $::NODETYPE_PPC,
bpa => $::NODETYPE_PPC,
cec => $::NODETYPE_PPC,
frame=> $::NODETYPE_PPC,
lpar =>"$::NODETYPE_PPC,$::NODETYPE_OSI"
);
my %globalhwtype = (
fsp => $::NODETYPE_FSP,
bpa => $::NODETYPE_BPA,
lpar => $::NODETYPE_LPAR,
cec => $::NODETYPE_CEC,
frame=> $::NODETYPE_FRAME,
);
##########################################################################
# Parse the command line for options and operands
##########################################################################
sub parse_args {
my $request = shift;
my %opt = ();
my $cmd = $request->{command};
my $args = $request->{arg};
#############################################
# Responds with usage statement
#############################################
local *usage = sub {
my $usage_string = xCAT::Usage->getUsage($cmd);
return( [ $_[0], $usage_string] );
};
#############################################
# 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(V|verbose u w x z) )){
return( usage() );
}
####################################
# 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() );
}
#############################################
# Check for mutually-exclusive flags
#############################################
if (( exists($opt{u}) + exists($opt{w})) > 1 ) {
return(usage( "Flag -u cannot be used with flag -w"));
}
####################################
# No operands - add command name
####################################
$request->{method} = $cmd;
return( \%opt );
}
##########################################################################
# Returns short-hostname given an IP
##########################################################################
sub getshorthost {
my $ip = shift;
my $host = xCAT::NetworkUtils->gethostname($ip);
if ( $host and !$! ) {
##############################
# Get short-hostname
##############################
if ( $host =~ /([^\.]+)\./ ) {
return($1);
}
}
##################################
# Failed
##################################
return undef;
}
##########################################################################
# Returns I/O bus information
##########################################################################
sub enumerate {
my $exp = shift;
my $hwtype = @$exp[2];
my $server = @$exp[3];
my @values = ();
my %cage = ();
my %hwconn = ();
my $Rc;
my $filter;
#########################################
# Get hardware control point info
#########################################
{
my $hcp = xCAT::PPCcli::lshmc( $exp );
$Rc = shift(@$hcp);
#########################################
# Return error
#########################################
if ( $Rc != SUCCESS ) {
return( @$hcp[0] );
}
#########################################
# Success
#########################################
my ($model,$serial) = split /,/, @$hcp[0];
my $id = "";
my $prof = "";
my $ips = "";
my $bpa = "";
my $side = "";
push @values, join( ",",
$hwtype,$server,$id,$model,$serial,$side,$server,$prof,$bpa,$ips );
}
#########################################
# Save hardware connections
#########################################
if ( $hwtype ne "ivm" ) { #Not applicable for IVM
$filter = "type_model_serial_num,ipaddr,sp,side";
my $conns = xCAT::PPCcli::lssysconn( $exp, "alls", $filter );
$Rc = shift(@$conns);
#########################################
# Return error
#########################################
if ( $Rc != SUCCESS ) {
return( @$conns[0] );
}
foreach my $con ( @$conns ) {
my ($mtms,$ipaddr,$sp,$side) = split /,/,$con;
my $value = undef;
if ( $sp =~ /^primary$/ or $side =~ /^a$/ ) {
$value = "A";
} elsif ($sp =~ /^secondary$/ or $side =~ /^b$/ ) {
$value = "B";
}
$hwconn{$ipaddr} = "$mtms,$value";
}
}
#########################################
# Enumerate frames (IVM has no frame)
#########################################
if ( $hwtype ne "ivm" ) {
$filter = "type_model,serial_num,name,frame_num,ipaddr_a,ipaddr_b";
my $frames = xCAT::PPCcli::lssyscfg( $exp, "bpas", $filter );
$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 ) {
$filter = "cage_num,type_model_serial_num";
foreach my $val ( @$frames ) {
my ($model,$serial) = split /,/, $val;
my $mtms = "$model*$serial";
my $cages = xCAT::PPCcli::lssyscfg($exp,"cage",$mtms,$filter);
$Rc = shift(@$cages);
#############################
# Skip...
# Frame in bad state
#############################
if ( $Rc != SUCCESS ) {
push @values, "# $mtms: ERROR @$cages[0]";
next;
}
#############################
# Success
#############################
foreach ( @$cages ) {
my ($cageid,$mtms) = split /,/;
$cage{$mtms} = "$cageid,$val";
}
}
}
}
#########################################
# Enumerate CECs
#########################################
$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 = "";
my $fname = "";
#####################################
# Get cage CEC is in
#####################################
my $frame = $cage{$mtms};
#####################################
# Save frame information
#####################################
if ( defined($frame) ) {
my ($cage,$model,$serial,$name,$id,$ipa,$ipb) = split /,/, $frame;
my $prof = "";
my $bpa = "";
$cageid = $cage;
$fname = $name;
#######################################
# Convert IP-A to short-hostname.
# If fails, use user-defined FSP name
#######################################
my $host = getshorthost( $ipa );
if ( defined($host) ) {
$fname = $host;
}
#######################################
# Save two sides of BPA seperately
#######################################
#my $bpastr = join( ",","bpa",$fname,$id,$model,$serial,"A",$server,$prof,$bpa,$ipa);
#if ( !grep /^\Q$bpastr\E$/, @values)
#{
# push @values, join( ",",
# "bpa",$fname,$id,$model,$serial,"A",$server,$prof,$bpa,$ipa);
#}
#$bpastr = join( ",","bpa",$fname,$id,$model,$serial,"B",$server,$prof,$bpa,$ipb);
#if ( !grep /^\Q$bpastr\E$/, @values)
#{
# push @values, join( ",",
# "bpa",$fname,$id,$model,$serial,"B",$server,$prof,$bpa,$ipb);
#}
push @values, join( ",",
"frame",$fname,$id,$model,$serial,"",$server,$prof,$bpa,"");
}
#####################################
# Save CEC information
#####################################
my $prof = "";
#######################################
# Convert IP to short-hostname.
# If fails, use user-defined FSP name
#######################################
my $host = getshorthost( $ips );
if ( defined($host) ) {
$fsp = $host;
}
my $mtmss = $hwconn{$ips};
if ( $hwtype ne "ivm" ) { #Not applicable for IVM
my ($mtms,$side) = split /,/, $mtmss;
}
push @values, join( ",",
"cec",$fsp,$cageid,$model,$serial,"",$server,$prof,$fname,"" );
#####################################
# Enumerate LPARs
#####################################
$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 ) {
push @values, "# $mtms: ERROR @$lpars[0]";
next;
}
####################################
# No results found
####################################
if ( $Rc == NR_ERROR ) {
next;
}
foreach ( @$lpars ) {
my ($name,$lparid,$dprof,$curprof) = split /,/;
my $prof = (length($curprof) && ($curprof !~ /^none$/)) ? $curprof : $dprof;
my $ips = "";
my $port = "";
#####################################
# Save LPAR information
#####################################
push @values, join( ",",
"lpar",$name,$lparid,$model,$serial,$port,$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 $hwtype = @$exp[2];
my $max_length = 0;
my $result;
###########################################
# -w flag for write to xCat database
###########################################
if ( exists( $opt->{w} )) {
my $server = @$exp[3];
my $uid = @$exp[4];
my $pw = @$exp[5];
#######################################
# Strip errors for results
#######################################
my @val = grep( !/^#.*: ERROR /, @$values );
xCAT::PPCdb::add_ppc( $hwtype, \@val,'','',"PPC" );
}
###########################################
# -u flag for write to xCat database
###########################################
if ( exists( $opt->{u} )) {
#######################################
# Strip errors for results
#######################################
my @val = grep( !/^#.*: ERROR /, @$values );
$values = xCAT::PPCdb::update_ppc( $hwtype, \@val );
if ( exists( $opt->{x} ) or exists( $opt->{z} ))
{
unshift @$values, "hmc";
}
}
###########################################
# -x flag for xml format
###########################################
if ( exists( $opt->{x} )) {
$result .= format_xml( $hwtype, $values );
}
###########################################
# -z flag for stanza format
###########################################
elsif ( exists( $opt->{z} )) {
$result .= format_stanza( $hwtype, $values );
}
else {
$result = sprintf( "#Updated following nodes:\n") if ( exists( $opt->{u}));
#######################################
# Get longest name for formatting
#######################################
my $nodehash;
my @errmsg;
foreach ( @$values ) {
##############################################
# Skip error message after saving it for last
##############################################
if ( /^#.*: ERROR / ) {
push @errmsg, $_;
next;
}
/([^\,]+),([^\,]+),/;
$nodehash->{$1.$2} = $_;
my $length = length( $2 );
$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 ( sort keys %$nodehash ) {
my @data = split /,/, $nodehash->{$_};
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 );
}
}
#######################################
# Add any error messages
#######################################
foreach ( @errmsg ) {
$result.= "\n$_";
}
}
$output{data} = [$result];
return( [\%output] );
}
##########################################################################
# Stanza formatting
##########################################################################
sub format_stanza {
my $hwtype = shift;
my $values = shift;
my $result;
my $nodehash;
#####################################
# Skip hardware control point
#####################################
shift(@$values);
foreach ( @$values ) {
###################################
# Skip error message
###################################
if ( /^#.*: ERROR / ) {
next;
}
/[^\,]+,([^\,]+),/;
$nodehash->{$1} = $_;
}
foreach ( sort keys %$nodehash ) {
my @data = split /,/, $nodehash->{$_};
my $type = $data[0];
my $i = 0;
#################################
# Node attributes
#################################
$result .= "$data[1]:\n\tobjtype=node\n";
#################################
# Add each attribute
#################################
my $mtm = undef;
foreach ( @attribs ) {
my $d = $data[$i++];
if ( /^node$/ ) {
next;
} elsif ( /^nodetype$/ ) {
$d = $globalnodetype{$type};
} elsif ( /^hwtype$/ ) {
$d = $globalhwtype{$type};
} elsif ( /^groups$/ ) {
next;
#$d = "$type,all";
} elsif ( /^mgt$/ ) {
$d = $hwtype;
} elsif ( /^cons$/ ) {
if ( $type eq "lpar" ) {
$d = $hwtype;
} else {
$d = undef;
}
} elsif ( /^(mtm|serial)$/ ) {
if ( $type eq "lpar" ) {
$d = undef;
} elsif (/^mtm$/) {
$mtm = $d;
}
} elsif (/^side$/) {
unless ( $type =~ /^fsp|bpa$/ ) {
next;
}
}
$result .= "\t$_=$d\n";
}
my $tmp_groups = "$type,all";
if (defined($mtm)) {
my $tmp_pre = xCAT::data::ibmhwtypes::parse_group($mtm);
if (defined($tmp_pre)) {
$tmp_groups .= ",$tmp_pre";
}
}
$result .= "\tgroups=$tmp_groups\n";
}
return( $result );
}
##########################################################################
# XML formatting
##########################################################################
sub format_xml {
my $hwtype = shift;
my $values = shift;
my $xml;
my $nodehash;
#####################################
# Skip hardware control point
#####################################
shift(@$values);
foreach ( @$values ) {
###################################
# Skip error message
###################################
if ( /^#.*: ERROR / ) {
next;
}
/[^\,]+,([^\,]+),/;
$nodehash->{$1} = $_;
}
#####################################
# Create XML formatted attributes
#####################################
foreach ( sort keys %$nodehash ) {
my @data = split /,/, $nodehash->{$_};
my $type = $data[0];
my $i = 0;
#################################
# Initialize hash reference
#################################
my $href = {
Node => { }
};
#################################
# Add each attribute
#################################
my $mtm = undef;
foreach ( @attribs ) {
my $d = $data[$i++];
if ( /^nodetype$/ ) {
$d = $globalnodetype{$type};
} elsif ( /^hwtype$/ ) {
$d = $globalhwtype{$type};
} elsif ( /^groups$/ ) {
next;
#$d = "$type,all";
} elsif ( /^mgt$/ ) {
$d = $hwtype;
} elsif ( /^cons$/ ) {
if ( $type eq "lpar" ) {
$d = $hwtype;
} else {
$d = undef;
}
} elsif ( /^(mtm|serial)$/ ) {
if ( $type eq "lpar" ) {
$d = undef;
} elsif (/^mtm$/){
$mtm = $d;
}
} elsif (/^side$/) {
unless ( $type =~ /^fsp|bpa$/ ) {
next;
}
}
$href->{Node}->{$_} = $d;
}
my $tmp_groups = "$type,all";
if (defined($mtm)) {
my $tmp_pre = xCAT::data::ibmhwtypes::parse_group($mtm);
if (defined($tmp_pre)) {
$tmp_groups .= ",$tmp_pre";
}
}
$href->{Node}->{groups}=$tmp_groups;
#################################
# 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,1]] );
}
###################################
# Success
###################################
my $result = format_output( $request, $exp, $values );
unshift @$result, "FORMATDATA6sK4ci";
return( $result );
}
1;