xCAT/xcat-core
2
0
Fork 0
mirror of https://github.com/xcat2/xcat-core.git synced 2025-10-31 11:22:27 +00:00
Code Issues Releases Wiki Activity
Files
954ac1543a5a16cab893c8cdf957b4b16bdea17c
xcat-core/perl-xCAT/xCAT/PPCscan.pm
Mark Gurevich 0a3fbd8d51 perltidy all perl files
2016-07-20 11:40:27 -04:00

730 lines
22 KiB
Perl
Raw Blame History

# 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;
Reference in New Issue View Git Blame Copy Permalink