2008-11-07 13:34:21 +00:00
# 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 ;
use xCAT::Usage ;
use xCAT::NodeRange ;
##############################################
# 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 } ;
#############################################
# 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 p=s ) ) ) {
return ( usage ( ) ) ;
}
####################################
# Check for "-" with no option
####################################
if ( grep ( /^-$/ , @ ARGV ) ) {
return ( usage ( "Missing option: -" ) ) ;
}
####################################
# Check for an extra argument
####################################
if ( defined ( $ ARGV [ 0 ] ) ) {
2009-02-27 14:19:35 +00:00
$ opt { a } = [ @ ARGV ] ;
for my $ attr ( @ { $ opt { a } } )
{
if ( $ attr !~ /(\w+)=(\w*)/ )
{
return ( usage ( "Invalid argument or attribute: $attr" ) ) ;
}
}
2008-11-07 13:34:21 +00:00
}
####################################
# Configuration file required
####################################
2009-02-27 14:19:35 +00:00
if ( ! exists ( $ opt { p } ) and ! exists ( $ opt { a } ) ) {
2008-11-07 13:34:21 +00:00
if ( ! defined ( $ request - > { stdin } ) ) {
2009-02-27 14:19:35 +00:00
return ( usage ( "Configuration file or attributes not specified" ) ) ;
2008-11-07 13:34:21 +00:00
}
}
####################################
2009-02-27 14:19:35 +00:00
# Both configuration file and
# attributes are specified
####################################
if ( exists ( $ opt { p } ) and exists ( $ opt { a } ) ) {
return ( usage ( "Flag -p cannot be used together with attribute list" ) ) ;
}
####################################
2008-11-07 13:34:21 +00:00
# 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 ;
2009-04-02 15:37:19 +00:00
2008-11-07 13:34:21 +00:00
my % opt = ( ) ;
2009-05-14 08:13:41 +00:00
my $ cmd = $ request - > { command } ;
2008-11-07 13:34:21 +00:00
my $ args = $ request - > { arg } ;
2009-04-02 15:37:19 +00:00
#############################################
# Responds with usage statement
#############################################
2008-11-07 13:34:21 +00:00
local * usage = sub {
my $ usage_string = xCAT::Usage - > getUsage ( $ cmd ) ;
return ( [ $ _ [ 0 ] , $ usage_string ] ) ;
} ;
2009-04-02 15:37:19 +00:00
#############################################
# Process command-line arguments
#############################################
2008-11-07 13:34:21 +00:00
if ( ! defined ( $ args ) ) {
return ( usage ( "No command specified" ) ) ;
}
2009-04-02 15:37:19 +00:00
#############################################
# Checks case in GetOptions, allows opts
# to be grouped (e.g. -vx), and terminates
# at the first unrecognized option.
#############################################
2008-11-07 13:34:21 +00:00
@ ARGV = @$ args ;
$ Getopt:: Long:: ignorecase = 0 ;
Getopt::Long:: Configure ( "bundling" ) ;
2009-12-31 04:46:42 +00:00
if ( ! GetOptions ( \ % opt , qw( V|verbose ibautocfg ibacap=s i=s l=s c=s p=s full ) ) ) {
2008-11-07 13:34:21 +00:00
return ( usage ( ) ) ;
}
2009-04-02 15:37:19 +00:00
####################################
# Check for "-" with no option
####################################
2008-11-07 13:34:21 +00:00
if ( grep ( /^-$/ , @ ARGV ) ) {
return ( usage ( "Missing option: -" ) ) ;
}
2009-04-15 17:02:11 +00:00
#############################################################
# Check if only ibacap or ibautocfg specified with the other
#############################################################
# if ( exists $opt{ibautocfg} and ! exists $opt{ibacap})
# {
# return(usage( "Missing option ibacap when ibautocfg is specified"));
# }
# elsif ( exists $opt{ibacap} and !exists $opt{ibautocfg})
# {
# return(usage( "Missing option ibautocfg when ibacap is specified"));
# }
# if ( $opt{ibacap} ne '1' and $opt{ibacap} ne '2' and $opt{ibacap} ne '3' and $opt{ibacap} ne '4')
# {
# return(usage( "IB adapter virtual capability (option --ibacap) can only be number 1,2,3,4. \n\t 1 means 'Low utilization': 6.25% of HCA resources (1/16 of an HCA); \n\t 2 means 'Medium utilization': 12.5% of HCA resources (1/8 of an HCA); \n\t 3 means 'High utilization': 25% of HCA resources (1/4 of an HCA);\n\t 4 means 'Dedicated HCA': 100% of HCA resources (complete HCA).\n"));
# }
2009-04-02 15:37:19 +00:00
####################################
# Check for non-zero integer
####################################
2008-11-07 13:34:21 +00:00
if ( exists ( $ opt { i } ) ) {
if ( $ opt { i } !~ /^([1-9]{1}|[1-9]{1}[0-9]+)$/ ) {
return ( usage ( "Invalid entry: $opt{i}" ) ) ;
}
}
2009-04-02 15:37:19 +00:00
####################################
# -i and -l not valid with -c
####################################
2008-11-07 13:34:21 +00:00
if ( exists ( $ opt { c } ) ) {
2009-12-31 04:46:42 +00:00
if ( exists ( $ opt { i } ) or exists ( $ opt { l } ) or exists ( $ opt { full } ) ) {
2009-04-02 15:37:19 +00:00
return ( usage ( ) ) ;
}
####################################
# -p is required for -c
####################################
if ( ! exists ( $ opt { p } ) ) {
2008-11-07 13:34:21 +00:00
return ( usage ( ) ) ;
}
}
2009-04-02 15:37:19 +00:00
####################################
2009-12-31 04:46:42 +00:00
# -i, -l and -c not valid with -f
####################################
elsif ( exists ( $ opt { full } ) ) {
if ( exists ( $ opt { c } ) or exists ( $ opt { i } ) or exists ( $ opt { l } ) ) {
return ( usage ( ) ) ;
}
}
####################################
2009-04-02 15:37:19 +00:00
# If -i and -l, both required
####################################
elsif ( ! exists ( $ opt { l } ) or ! exists ( $ opt { i } ) ) {
2008-11-07 13:34:21 +00:00
return ( usage ( ) ) ;
}
2009-04-02 15:37:19 +00:00
####################################
# Check for an extra argument
####################################
2008-11-07 13:34:21 +00:00
if ( defined ( $ ARGV [ 0 ] ) ) {
return ( usage ( "Invalid Argument: $ARGV[0]" ) ) ;
}
2009-04-02 15:37:19 +00:00
####################################
# Expand -l noderange
####################################
if ( exists ( $ opt { l } ) ) {
my @ noderange = xCAT::NodeRange:: noderange ( $ opt { l } , 0 ) ;
2008-11-07 13:34:21 +00:00
if ( ! @ noderange ) {
2009-04-02 15:37:19 +00:00
return ( usage ( "Invalid noderange: '$opt{l}'" ) ) ;
2008-11-07 13:34:21 +00:00
}
2009-04-14 11:58:06 +00:00
@ noderange = sort @ noderange ;
2009-04-02 15:37:19 +00:00
$ opt { lpar } = \ @ noderange ;
2008-11-07 13:34:21 +00:00
}
2009-04-02 15:37:19 +00:00
####################################
# Expand -c noderange
####################################
if ( exists ( $ opt { c } ) ) {
my @ noderange = xCAT::NodeRange:: noderange ( $ opt { c } , 0 ) ;
if ( ! @ noderange ) {
return ( usage ( "Invalid noderange: '$opt{l}'" ) ) ;
}
$ opt { cec } = \ @ noderange ;
}
#################################################
# Swap the targets to be processed in PPC.pm
#################################################
$ opt { target } = [ @ { $ request - > { node } } ] ;
if ( $ opt { l } )
{
$ request - > { node } = [ @ { $ opt { lpar } } ] ;
$ request - > { noderange } = $ opt { l } ;
}
if ( $ opt { c } )
{
$ request - > { node } = [ @ { $ opt { cec } } ] ;
$ request - > { noderange } = $ opt { c } ;
}
#############################################
# Only 1 node allowed
#############################################
2009-12-31 04:46:42 +00:00
if ( ! exists ( $ opt { full } ) && scalar ( @ { $ request - > { node } } ) > 1 ) {
2009-04-02 15:37:19 +00:00
return ( usage ( "Multiple source specified" ) ) ;
}
2009-12-31 04:46:42 +00:00
################################################
# Check if the multiple nodes of the same CEC are specified with -f
################################################
if ( ( exists ( $ opt { full } ) ) && ( scalar ( @ { $ opt { target } } ) > 1 ) ) {
my $ lparparent ;
my $ ppctab = xCAT::Table - > new ( 'ppc' ) ;
foreach my $ vnode ( @ { $ opt { target } } ) {
my $ vcon = $ ppctab - > getAttribs ( { node = > $ vnode } , ( 'node' , 'parent' ) ) ;
if ( $ vcon and $ vcon - > { "node" } and $ vcon - > { "parent" } ) {
my $ lparent = $ vcon - > { "parent" } ;
$ lparparent - > { $ lparent } - > { $ vnode } = $ vnode ;
}
}
$ ppctab - > close ;
my $ cbmsg = "mkvm: multiple LPAR nodes which belong to the same CEC have been defined.\n" ;
my $ sameflag = 0 ;
foreach my $ iparent ( keys %$ lparparent ) {
if ( scalar ( keys % { $ lparparent - > { $ iparent } } ) > 1 ) {
$ sameflag = 1 ;
$ cbmsg = $ cbmsg . $ iparent . ":" . "\t" ;
foreach my $ inode ( keys % { $ lparparent - > { $ iparent } } ) {
$ cbmsg = $ cbmsg . $ inode . "," ;
}
}
$ cbmsg =~ s/,$/ / ;
$ cbmsg = $ cbmsg . "\n" ;
}
if ( $ sameflag ) {
return ( usage ( $ cbmsg ) ) ;
}
}
2009-04-02 15:37:19 +00:00
####################################
# Read and check profile
####################################
if ( exists ( $ opt { p } ) ) {
2009-05-20 10:04:04 +00:00
$ opt { p } = $ request - > { cwd } - > [ 0 ] . '/' . $ opt { p } if ( $ opt { p } !~ /^\// ) ;
2009-04-02 15:37:19 +00:00
return ( usage ( "Profile $opt{p} cannot be found" ) ) if ( ! - f $ opt { p } ) ;
open ( PROFFILE , "<$opt{p}" ) or return ( usage ( "Cannot open profile $opt{p}" ) ) ;
my @ cfgdata = ( ) ;
while ( <PROFFILE> )
{
chomp ;
/\w+/ or next ;
if ( /name=/ and /lpar_name/ and /lpar_id/ and /lpar_env/ )
{
push @ cfgdata , $ _ ;
}
else
{
s/^[^,]*:\s*(name=.*)$/$1/ ;
return ( usage ( "Invalid line in profile: $_" ) ) ;
}
}
return ( usage ( "No valid line was found in profile $opt{p}." ) ) if ( scalar ( @ cfgdata ) < 1 ) ;
2009-05-14 08:13:41 +00:00
my @ lpars = @ { $ opt { target } } ;
my $ min_lpar_num = scalar ( @ cfgdata ) ;
if ( scalar ( @ cfgdata ) > scalar ( @ lpars ) )
{
xCAT::MsgUtils - > message ( 'W' , "Warning: Lpar configuration number in profile is greater than lpars in command line. Only first " . scalar ( @ lpars ) . " lpars will be created.\n" ) ;
$ min_lpar_num = scalar ( @ lpars ) ;
}
elsif ( scalar ( @ cfgdata ) < scalar ( @ lpars ) )
{
my $ lparlist = join "," , @ lpars [ 0 .. ( $ min_lpar_num - 1 ) ] ;
xCAT::MsgUtils - > message ( 'W' , "Warning: Lpar number in command line is greater than lpar configuration number in profile. Only lpars " . $ lparlist . " will be created.\n" ) ;
}
2009-04-02 15:37:19 +00:00
$ opt { profile } = \ @ cfgdata ;
}
####################################
2008-11-07 13:34:21 +00:00
# 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 } ;
#############################################
# 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" ) ;
2010-02-01 03:50:36 +00:00
if ( ! GetOptions ( \ % opt , qw( V|verbose service r ) ) ) {
2008-11-07 13:34:21 +00:00
return ( usage ( ) ) ;
}
####################################
# 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 } ;
#############################################
# 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 a|all ) ) ) {
return ( usage ( ) ) ;
}
####################################
# 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 LPARs from one CEC to another (must be on same HMC)
##########################################################################
sub clone {
2009-04-02 15:37:19 +00:00
my $ request = shift ;
2008-11-07 13:34:21 +00:00
my $ exp = shift ;
2009-04-02 15:37:19 +00:00
my $ targets = shift ;
my $ profile = shift ;
my $ destd = shift ;
my $ destname = shift ;
2008-11-07 13:34:21 +00:00
my $ hwtype = @$ exp [ 2 ] ;
my $ server = @$ exp [ 3 ] ;
my @ values = ( ) ;
2009-04-02 15:37:19 +00:00
my @ lpars = @$ targets ;
2008-11-07 13:34:21 +00:00
my $ destcec ;
2009-04-14 11:58:06 +00:00
my $ opt = $ request - > { opt } ;
2008-11-07 13:34:21 +00:00
2009-04-02 15:37:19 +00:00
#####################################
# Always one source CEC specified
#####################################
my $ lparid = @$ destd [ 0 ] ;
my $ mtms = @$ destd [ 2 ] ;
my $ type = @$ destd [ 4 ] ;
#####################################
# Not supported on IVM
#####################################
2008-11-07 13:34:21 +00:00
if ( $ hwtype eq "ivm" ) {
return ( [ [ RC_ERROR , "Not supported for IVM" ] ] ) ;
}
2009-04-02 15:37:19 +00:00
#####################################
# Source must be CEC
#####################################
2008-11-07 13:34:21 +00:00
if ( $ type ne "fsp" ) {
return ( [ [ RC_ERROR , "Node must be an FSP" ] ] ) ;
}
2009-04-02 15:37:19 +00:00
#####################################
# Attributes not found
#####################################
if ( ! $ mtms ) {
return ( [ [ RC_ERROR , "Cannot found serial and mtm for $destname" ] ] ) ;
2008-11-07 13:34:21 +00:00
}
2009-04-02 15:37:19 +00:00
#####################################
# Enumerate CECs
#####################################
2008-11-07 13:34:21 +00:00
my $ filter = "type_model,serial_num" ;
my $ cecs = xCAT::PPCcli:: lssyscfg ( $ exp , "fsps" , $ filter ) ;
my $ Rc = shift ( @$ cecs ) ;
2009-04-02 15:37:19 +00:00
#####################################
# Return error
#####################################
2008-11-07 13:34:21 +00:00
if ( $ Rc != SUCCESS ) {
return ( [ [ $ Rc , @$ cecs [ 0 ] ] ] ) ;
}
2009-04-14 11:58:06 +00:00
#####################################
# Get HCA info
#####################################
my $ unassigned_iba = undef ;
2009-04-15 17:02:11 +00:00
my $ iba_replace_pair = undef ;
2009-04-14 11:58:06 +00:00
if ( exists $ opt - > { ibautocfg } )
{
$ unassigned_iba = get_unassigned_iba ( $ exp , $ mtms , $ opt - > { ibacap } ) ;
}
else
{
$ unassigned_iba = get_unassigned_iba ( $ exp , $ mtms , undef ) ;
2009-04-15 17:02:11 +00:00
$ iba_replace_pair = get_iba_replace_pair ( $ unassigned_iba , $ profile ) ;
2009-04-14 11:58:06 +00:00
}
2009-04-02 15:37:19 +00:00
#####################################
# Find source/dest CEC
#####################################
2008-11-07 13:34:21 +00:00
foreach ( @$ cecs ) {
s/(.*),(.*)/$1*$2/ ;
if ( $ _ eq $ mtms ) {
2009-04-02 15:37:19 +00:00
$ destcec = $ _ ;
2008-11-07 13:34:21 +00:00
}
}
2009-04-02 15:37:19 +00:00
#####################################
# Destination CEC not found
#####################################
2008-11-07 13:34:21 +00:00
if ( ! defined ( $ destcec ) ) {
2009-04-02 15:37:19 +00:00
return ( [ [ RC_ERROR , "Destination CEC '$destname' not found on '$server'" ] ] ) ;
2008-11-07 13:34:21 +00:00
}
2009-04-02 15:37:19 +00:00
#####################################
# Modify read back profile
#####################################
my $ min_lpar_num = scalar ( @$ profile ) < scalar ( @$ targets ) ? scalar ( @$ profile ) : scalar ( @$ targets ) ;
my $ i ;
for ( $ i = 0 ; $ i < $ min_lpar_num ; $ i + + )
{
my $ cfg = $ profile - > [ $ i ] ;
$ cfg =~ s/^[^,]*:\s*(name=.*)$/$1/ ;
2008-11-07 13:34:21 +00:00
$ cfg =~ s/^name=([^,]+|$)/profile_name=$1/ ;
my $ profile = $ 1 ;
2009-04-02 15:37:19 +00:00
$ cfg =~ s/\blpar_name=([^,]+|$)/name=$targets->[$i]/ ;
2008-11-07 13:34:21 +00:00
$ cfg = strip_profile ( $ cfg , $ hwtype ) ;
$ cfg =~ /lpar_id=([^,]+)/ ;
$ lparid = $ 1 ;
2009-04-02 15:37:19 +00:00
2009-04-14 11:58:06 +00:00
if ( exists $ opt - > { ibautocfg } )
{
2009-04-15 17:02:11 +00:00
$ cfg = hcaautoconf ( $ cfg , $ unassigned_iba ) ;
2009-04-14 11:58:06 +00:00
}
else
{
2009-04-15 17:02:11 +00:00
$ cfg = hcasubst ( $ cfg , $ iba_replace_pair ) ;
2009-04-14 11:58:06 +00:00
}
2009-04-02 15:37:19 +00:00
#################################
# Create new LPAR
#################################
my @ temp = @$ destd ;
2008-11-07 13:34:21 +00:00
$ temp [ 0 ] = $ lparid ;
$ temp [ 2 ] = $ destcec ;
2009-02-24 10:39:18 +00:00
$ temp [ 4 ] = 'lpar' ;
2008-11-07 13:34:21 +00:00
my $ result = xCAT::PPCcli:: mksyscfg ( $ exp , "lpar" , \ @ temp , $ cfg ) ;
$ Rc = shift ( @$ result ) ;
2009-04-02 15:37:19 +00:00
#################################
# Success - add LPAR to database
#################################
2008-11-07 13:34:21 +00:00
if ( $ Rc == SUCCESS ) {
my $ err = xCATdB (
2009-04-02 15:37:19 +00:00
"mkvm" , $ targets - > [ $ i ] , $ profile , $ lparid , $ destd , $ hwtype , $ targets - > [ $ i ] , $ destname ) ;
2008-11-07 13:34:21 +00:00
if ( defined ( $ err ) ) {
push @ values , [ $ err , RC_ERROR ] ;
}
next ;
}
2009-04-02 15:37:19 +00:00
#################################
# Error - Save error
#################################
2008-11-07 13:34:21 +00:00
push @ values , [ @$ result [ 0 ] , $ Rc ] ;
}
if ( ! scalar ( @ values ) ) {
return ( [ [ SUCCESS , "Success" ] ] ) ;
}
return ( \ @ values ) ;
}
##########################################################################
# Removes logical partitions
##########################################################################
sub remove {
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
2010-01-04 04:34:44 +00:00
my $ opt = $ request - > { opt } ;
2008-11-07 13:34:21 +00:00
my @ lpars = ( ) ;
my @ values = ( ) ;
2009-12-31 04:46:42 +00:00
2008-11-07 13:34:21 +00:00
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" , RC_ERROR ] ;
next ;
}
####################################
# 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 ) {
push @ values , [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
next ;
}
################################
# Success - save LPARs
################################
foreach ( @$ result ) {
push @ lpars , $ _ ;
}
}
####################################
# Remove the LPARs
####################################
foreach ( @ lpars ) {
2009-12-31 04:46:42 +00:00
my $ lparinfo = shift ( @ lpars ) ;
my ( $ name , $ id ) = split /,/ , $ lparinfo ;
2008-11-07 13:34:21 +00:00
my $ mtms = @$ d [ 2 ] ;
2009-12-31 04:46:42 +00:00
2010-01-04 03:55:09 +00:00
if ( $ opt - > { service } ) {
###############################################
# begin to retrieve the CEC's service lpar id
###############################################
my $ service_lparid = xCAT::PPCcli:: lssyscfg (
$ exp ,
"fsp" ,
$ mtms ,
"service_lpar_id" ) ;
my $ Rc = shift ( @$ service_lparid ) ;
#####################################################
# Change the CEC's state to standby and set it's service lpar id to none
#####################################################
if ( $ Rc == SUCCESS ) {
my $ cfgdata = @$ service_lparid [ 0 ] ;
if ( ( $ id == $ cfgdata ) && ( $ cfgdata !~ /none/ ) ) {
$ cfgdata = "service_lpar_id=none" ;
2010-03-04 09:38:44 +00:00
my $ result = xCAT::PPCcli:: chsyscfg ( $ exp , "fsp" , $ d , $ cfgdata ) ;
2010-01-04 03:55:09 +00:00
$ Rc = shift ( @$ result ) ;
if ( $ Rc != SUCCESS ) {
return ( [ [ $ lpar , @$ service_lparid [ 0 ] , $ Rc ] ] ) ;
}
}
}
}
2009-12-31 04:46:42 +00:00
################################
2008-11-07 13:34:21 +00:00
# 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
################################
2010-02-01 03:50:36 +00:00
if ( $ Rc == SUCCESS and ! exists ( $ opt - > { r } ) ) {
2008-11-07 13:34:21 +00:00
my $ err = xCATdB ( "rmvm" , $ name ) ;
if ( defined ( $ err ) ) {
push @ values , [ $ lpar , $ err , RC_ERROR ] ;
next ;
}
}
push @ values , [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
}
}
}
return ( \ @ values ) ;
}
##########################################################################
# Finds the partition profile specified by examining all CECs
##########################################################################
sub getprofile {
my $ exp = shift ;
my $ name = shift ;
###############################
# Get all CECs
###############################
my $ cecs = xCAT::PPCcli:: lssyscfg ( $ exp , "fsps" , "name" ) ;
###############################
# Return error
###############################
if ( @$ cecs [ 0 ] != NR_ERROR ) {
if ( @$ cecs [ 0 ] != SUCCESS ) {
return ( $ cecs ) ;
}
my $ Rc = shift ( @$ cecs ) ;
###########################
# List profiles for CECs
###########################
foreach my $ mtms ( @$ cecs ) {
my $ prof = xCAT::PPCcli:: lssyscfg (
$ exp ,
"prof" ,
$ mtms ,
"profile_names=$name" ) ;
my $ Rc = shift ( @$ prof ) ;
if ( $ Rc == SUCCESS ) {
return ( [ SUCCESS , $ mtms , @$ prof [ 0 ] ] ) ;
}
}
}
return ( [ RC_ERROR , "The partition profile named '$name' was not found" ] ) ;
}
##########################################################################
# Changes the configuration of an existing partition
##########################################################################
sub modify {
2009-02-27 14:19:35 +00:00
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
return modify_by_prof ( $ request , $ hash , $ exp ) if ( $ request - > { opt } - > { p } ) ;
return modify_by_attr ( $ request , $ hash , $ exp ) ;
}
##########################################################################
# Changes the configuration of an existing
# partition based on the attributes specified
##########################################################################
sub modify_by_attr {
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
my $ hwtype = @$ exp [ 2 ] ;
my $ name = @ { $ request - > { node } } [ 0 ] ;
my $ opt = $ request - > { opt } ;
my $ attrstr = $ opt - > { a } ;
my @ values ;
2010-09-07 07:38:03 +00:00
# attrstr will be in stdin for "cat vmdef | chvm nodename"
if ( ! defined ( $ attrstr ) && defined ( $ request - > { stdin } ) ) {
my $ tempattr = $ request - > { stdin } ;
$ tempattr =~ s/\s+$// ;
$ tempattr =~ s/^[\w]+: // ;
my $ newcfg = strip_profile ( $ tempattr , $ hwtype ) ;
$ newcfg =~ s/,*lpar_env=[^,]+|$// ;
$ newcfg =~ s/,*all_resources=[^,]+|$// ;
$ newcfg =~ s/,*lpar_name=[^,]+|$// ;
$ newcfg =~ s/\\\"/\"/g ;
my @ cfgarray = split /,/ , $ newcfg ;
##########################################
# Repair those lines splitted incorrectly
##########################################
my @ newcfgarray ;
my $ full_line ;
while ( my $ line = shift ( @ cfgarray ) )
{
if ( ! $ full_line )
{
$ full_line = $ line ;
}
else
{
$ full_line = "$full_line,$line" ;
}
if ( $ full_line =~ /^[^\"]/ or $ full_line =~ /^\".+\"$/ )
{
$ full_line =~ s/^\"(.+)\"$/$1/ ;
push @ newcfgarray , $ full_line ;
$ full_line = undef ;
next ;
}
}
$ attrstr = \ @ newcfgarray ;
}
2009-02-27 14:19:35 +00:00
if ( defined ( $ attrstr ) ) {
###################################
# Get LPAR active profiles
###################################
while ( my ( $ cec , $ h ) = each ( %$ hash ) ) {
while ( my ( $ lpar , $ d ) = each ( %$ h ) ) {
###########################
# Get current profile
###########################
my $ cfg_res = xCAT::PPCcli:: lssyscfg (
$ exp ,
"node" ,
$ cec ,
'curr_profile' ,
@$ d [ 0 ] ) ;
my $ Rc = shift ( @$ cfg_res ) ;
if ( $ Rc != SUCCESS ) {
push @ values , [ $ lpar , @$ cfg_res [ 0 ] , $ Rc ] ;
next ;
}
2009-05-20 10:37:00 +00:00
##############################################
# If there is no curr_profile, which means no
# profile has been applied yet (before first
# boot?), use the default_profile
##############################################
2009-10-13 07:59:05 +00:00
if ( ( ! @$ cfg_res [ 0 ] ) || ( @$ cfg_res [ 0 ] =~ /^none$/ ) )
2009-05-20 10:37:00 +00:00
{
$ cfg_res = xCAT::PPCcli:: lssyscfg (
$ exp ,
"node" ,
$ cec ,
'default_profile' ,
@$ d [ 0 ] ) ;
$ Rc = shift ( @$ cfg_res ) ;
if ( $ Rc != SUCCESS ) {
push @ values , [ $ lpar , @$ cfg_res [ 0 ] , $ Rc ] ;
next ;
}
}
2009-02-27 14:19:35 +00:00
my $ prof = xCAT::PPCcli:: lssyscfg (
$ exp ,
"prof" ,
$ cec ,
"lpar_ids=@$d[0],profile_names=@$cfg_res[0]" ) ;
$ Rc = shift ( @$ prof ) ;
if ( $ Rc != SUCCESS ) {
push @ values , [ $ lpar , @$ prof [ 0 ] , $ Rc ] ;
next ;
}
my $ cfgdata = @$ prof [ 0 ] ;
###########################
# Modify profile
###########################
$ cfgdata = strip_profile ( $ cfgdata , $ hwtype ) ;
$ cfgdata =~ s/,*lpar_env=[^,]+|$// ;
$ cfgdata =~ s/,*all_resources=[^,]+|$// ;
$ cfgdata =~ s/,*lpar_name=[^,]+|$// ;
my $ err_msg ;
( $ Rc , $ err_msg , $ cfgdata ) = subst_profile ( $ cfgdata , $ attrstr ) ;
if ( $ Rc != SUCCESS ) {
push @ values , [ $ lpar , $ err_msg , $ Rc ] ;
next ;
}
2009-09-10 02:57:36 +00:00
my $ result = xCAT::PPCcli:: chsyscfg ( $ exp , "prof" , $ d , $ cfgdata ) ;
2009-02-27 14:19:35 +00:00
$ Rc = shift ( @$ result ) ;
push @ values , [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
}
}
}
return ( \ @ values ) ;
}
##########################################################################
# Substitue attributes-value pairs in profile
##########################################################################
sub subst_profile
{
my $ cfgdata = shift ;
my $ attrlist = shift ;
2009-02-28 01:14:35 +00:00
$ cfgdata =~ s/\\\"/\"/g ;
2009-02-27 14:19:35 +00:00
my @ cfgarray = split /,/ , $ cfgdata ;
##########################################
# Repair those lines splitted incorrectly
##########################################
my @ newcfgarray ;
my $ full_line ;
while ( my $ line = shift ( @ cfgarray ) )
{
if ( ! $ full_line )
{
$ full_line = $ line ;
}
else
{
$ full_line = "$full_line,$line" ;
}
if ( $ full_line =~ /^[^\"]/ or $ full_line =~ /^\".+\"$/ )
{
$ full_line =~ s/^\"(.+)\"$/$1/ ;
push @ newcfgarray , $ full_line ;
$ full_line = undef ;
next ;
}
}
2008-11-07 13:34:21 +00:00
2009-02-27 14:19:35 +00:00
##########################################
# Substitute attributes in new array
##########################################
my @ final_array ;
my @ attrs = @$ attrlist ;
for my $ cfgline ( @ newcfgarray )
{
for ( my $ i = 0 ; $ i < scalar ( @ attrs ) ; $ i + + )
{
my $ av_pair = $ attrs [ $ i ] ;
next if ( ! $ av_pair ) ;
#assuming there will not be too many attributes to be changed
my ( $ attr , $ value ) = $ av_pair =~ /^\s*(\S+?)\s*=\s*(\S+)\s*$/ ;
if ( $ cfgline =~ /^$attr=/ )
{
$ cfgline = "$attr=$value" ;
delete $ attrs [ $ i ] ;
last ;
}
}
if ( $ cfgline =~ /,/ )
{
2009-02-28 01:14:35 +00:00
$ cfgline = "\\\"$cfgline\\\"" ;
2009-02-27 14:19:35 +00:00
}
push @ final_array , $ cfgline ;
}
$ cfgdata = join ',' , @ final_array ;
##########################################
# Get not found attribute list
##########################################
my % not_found = ( ) ;
for ( @ attrs )
{
if ( $ _ )
{
my ( $ a ) = split /=/ ;
$ not_found { $ a } = 1 ;
}
}
my $ Rc = scalar ( keys % not_found ) ;
my $ incorrect_attrs = join ',' , ( keys % not_found ) ;
return ( $ Rc , "Incorrect attribute(s) $incorrect_attrs" , $ cfgdata ) ;
}
##########################################################################
# Changes the configuration of an existing
# partition based on the profile specified
##########################################################################
sub modify_by_prof {
2008-11-07 13:34:21 +00:00
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
my $ hwtype = @$ exp [ 2 ] ;
my $ name = @ { $ request - > { node } } [ 0 ] ;
my $ opt = $ request - > { opt } ;
my $ cfgdata = $ request - > { stdin } ;
my $ profile = $ opt - > { p } ;
my @ values ;
#######################################
# -p flag, find profile specified
#######################################
if ( defined ( $ profile ) ) {
my $ prof = getprofile ( $ exp , $ profile ) ;
###################################
# Return error
###################################
my $ Rc = shift ( @$ prof ) ;
if ( $ Rc != SUCCESS ) {
return ( [ [ $ name , @$ prof , RC_ERROR ] ] ) ;
}
$ cfgdata = @$ prof [ 1 ] ;
my $ mtms = @$ prof [ 0 ] ;
###################################
# Check if LPAR profile exists
###################################
while ( my ( $ cec , $ h ) = each ( %$ hash ) ) {
while ( my ( $ lpar , $ d ) = each ( %$ h ) ) {
###########################
# Get LPAR profiles
###########################
my $ prof = xCAT::PPCcli:: lssyscfg (
$ exp ,
"prof" ,
$ cec ,
"lpar_ids=@$d[0],profile_names=$profile" ) ;
my $ Rc = shift ( @$ prof ) ;
###########################
# Already has that profile
###########################
if ( $ Rc == SUCCESS ) {
push @ values , [ $ lpar , "Success" , $ Rc ] ;
xCATdB ( "chvm" , $ lpar , $ profile ) ;
delete $ h - > { $ lpar } ;
}
}
}
}
#######################################
# 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 , RC_ERROR ] ] ) ;
}
my $ cfg = strip_profile ( $ cfgdata , $ hwtype ) ;
$ cfg =~ s/,*lpar_env=[^,]+|$// ;
$ cfg =~ s/,*all_resources=[^,]+|$// ;
$ cfg =~ s/,*lpar_name=[^,]+|$// ;
#######################################
# Send change profile command
#######################################
while ( my ( $ cec , $ h ) = each ( %$ hash ) ) {
while ( my ( $ lpar , $ d ) = each ( %$ h ) ) {
###############################
# Only valid for LPARs
###############################
if ( @$ d [ 4 ] ne "lpar" ) {
push @ values , [ $ lpar , "Command not supported on '@$d[4]'" , RC_ERROR ] ;
next ;
}
###############################
# Change LPAR Id
###############################
$ cfg =~ s/lpar_id=[^,]+/lpar_id=@$d[0]/ ;
#################################
2009-02-27 14:19:35 +00:00
# Modify SCSI/LHEA adapters
2008-11-07 13:34:21 +00:00
#################################
if ( exists ( $ opt - > { p } ) ) {
if ( $ cfg =~ /virtual_scsi_adapters=(\w+)/ ) {
if ( $ 1 !~ /^none$/i ) {
$ cfg = scsi_adapter ( $ cfg ) ;
}
}
2009-02-27 14:19:35 +00:00
if ( $ cfg =~ /lhea_logical_ports=(\w+)/ ) {
if ( $ 1 !~ /^none$/i ) {
$ cfg = lhea_adapter ( $ cfg ) ;
}
}
2008-11-07 13:34:21 +00:00
}
###############################
# Send command
###############################
if ( defined ( $ profile ) ) {
my $ result = xCAT::PPCcli:: mksyscfg ( $ exp , "prof" , $ d , $ cfg ) ;
my $ Rc = shift ( @$ result ) ;
############################
# Update database
############################
if ( $ Rc == SUCCESS ) {
xCATdB ( "chvm" , $ lpar , $ profile ) ;
}
push @ values , [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
}
else {
2009-09-10 02:57:36 +00:00
my $ result = xCAT::PPCcli:: chsyscfg ( $ exp , "prof" , $ d , $ cfg ) ;
2008-11-07 13:34:21 +00:00
my $ Rc = shift ( @$ result ) ;
push @ values , [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
}
}
}
return ( \ @ values ) ;
}
##########################################################################
# Lists logical partitions
##########################################################################
sub list {
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
2009-10-13 08:50:05 +00:00
my $ args = $ request - > { opt } ;
my $ values = ( ) ;
my @ value = ( ) ;
2008-11-07 13:34:21 +00:00
my @ lpars = ( ) ;
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 ] ;
my $ pprofile ;
####################################
# Must be CEC or LPAR
####################################
if ( $ type !~ /^(lpar|fsp)$/ ) {
2009-10-13 08:50:05 +00:00
$ values - > { $ lpar } = [ $ lpar , "Node must be LPAR or CEC" , RC_ERROR ] ;
2008-11-07 13:34:21 +00:00
next ;
}
####################################
# This is a single LPAR
####################################
if ( $ type eq "lpar" ) {
$ lpars [ 0 ] = "$lpar,$lparid" ;
}
####################################
# This is a CEC
####################################
else {
my $ filter = "name,lpar_id" ;
my $ result = xCAT::PPCcli:: lssyscfg (
$ exp ,
"lpar" ,
$ mtms ,
$ filter ) ;
my $ Rc = shift ( @$ result ) ;
################################
# Expect error
################################
if ( $ Rc != SUCCESS ) {
2009-10-13 08:50:05 +00:00
$ values - > { $ lpar } = [ $ lpar , @$ result [ 0 ] , $ Rc ] ;
2008-11-07 13:34:21 +00:00
next ;
}
################################
# Success - save LPARs
################################
foreach ( @$ result ) {
push @ lpars , $ _ ;
}
}
####################################
# Get LPAR profile
####################################
2009-04-14 11:58:06 +00:00
foreach ( sort @ lpars ) {
2008-11-07 13:34:21 +00:00
my ( $ name , $ id ) = split /,/ ;
#################################
# Get source LPAR profile
#################################
my $ prof = xCAT::PPCcli:: lssyscfg (
$ exp ,
"prof" ,
$ mtms ,
"lpar_ids=$id" ) ;
my $ Rc = shift ( @$ prof ) ;
#################################
# Return error
#################################
if ( $ Rc != SUCCESS ) {
2009-10-13 08:50:05 +00:00
$ values - > { $ lpar } = [ $ lpar , @$ prof [ 0 ] , $ Rc ] ;
2008-11-07 13:34:21 +00:00
next ;
}
#################################
# List the default LPAR profile,
# or all the profiles if option
# -a|--all is assigned
#################################
if ( exists ( $ args - > { a } ) ) {
my $ count = 0 ;
foreach ( @$ prof ) {
$ pprofile . = "@$prof[$count]\n\n" ;
$ count + + ;
}
} else {
$ pprofile . = "@$prof[0]\n\n" ;
}
}
2009-10-13 08:50:05 +00:00
$ values - > { $ lpar } = [ $ lpar , $ pprofile , SUCCESS ] ;
2008-11-07 13:34:21 +00:00
}
}
2009-10-13 08:50:05 +00:00
foreach ( sort keys %$ values ) {
push @ value , $ values - > { $ _ } ;
}
return ( \ @ value ) ;
2008-11-07 13:34:21 +00:00
}
2009-04-14 11:58:06 +00:00
##########################################################################
# Increments hca adapter in partition profile
##########################################################################
2009-04-02 15:37:19 +00:00
sub hca_adapter {
my $ cfgdata = shift ;
2009-10-13 08:50:05 +00:00
#########################################
# Increment HCA adapters if present
# "23001eff/2550010250300/2,23001eff/2550010250400/2"
# Increment the last 2 number of 2550010250300 and
# 2550010250400 in example above.
#########################################
2009-04-02 15:37:19 +00:00
if ( $ cfgdata =~ /(\"*hca_adapters)/ ) {
2009-10-13 08:50:05 +00:00
#####################################
# If double-quoted, has comma-
# seperated list of adapters
#####################################
2009-04-02 15:37:19 +00:00
my $ delim = ( $ 1 =~ /^\"/ ) ? "\\\\\"" : "," ;
$ cfgdata =~ /hca_adapters=([^$delim]+)|$/ ;
my @ hcas = split "," , $ 1 ;
my $ adapters = "hca_adapters=" ;
for my $ hca ( @ hcas )
{
my @ hcainfo = split /\// , $ hca ;
######################################################
# split it to 2 part, only increase the last 2 number
# otherwise it can overflow if change it to dec
######################################################
my $ portlen = length ( $ hcainfo [ 1 ] ) ;
my $ portprefix = substr ( $ hcainfo [ 1 ] , 0 , $ portlen - 2 ) ;
my $ portpostfix = substr ( $ hcainfo [ 1 ] , $ portlen - 2 ) ;
my $ portnum = hex $ portpostfix ;
$ portnum + + ;
$ portpostfix = sprintf '%x' , $ portnum ;
if ( length ( $ portpostfix ) == 1 )
{
$ portpostfix = '0' . $ portpostfix ;
}
$ hcainfo [ 1 ] = $ portprefix . $ portpostfix ;
$ adapters = $ adapters . join ( "/" , @ hcainfo ) . ',' ;
}
$ adapters =~ s/^(.*),$/$1/ ;
$ cfgdata =~ s/hca_adapters=[^$delim]+/$adapters/ ;
}
return ( $ cfgdata ) ;
}
2009-04-14 11:58:06 +00:00
##########################################################################
# Get unassigned hca guid
##########################################################################
sub get_unassigned_iba
{
my $ exp = shift ;
my $ mtms = shift ;
my $ ibacap = shift ;
my $ max_ib_num = 0 ;
if ( ! $ ibacap )
{
$ ibacap = '1' ;
}
if ( $ ibacap eq '1' )
{
$ max_ib_num = 16 ;
}
elsif ( $ ibacap eq '2' )
{
$ max_ib_num = 8 ;
}
elsif ( $ ibacap eq '3' )
{
$ max_ib_num = 4 ;
}
elsif ( $ ibacap eq '4' )
{
$ max_ib_num = 1 ;
}
else
{
return undef ;
}
my $ hwres = xCAT::PPCcli:: lshwres ( $ exp , [ 'sys' , 'hca' , 'adapter_id:phys_loc:unassigned_guids' ] , $ mtms ) ;
my $ Rc = shift ( @$ hwres ) ;
if ( $ Rc == SUCCESS )
{
my @ unassigned_ibas ;
my $ ib_hash = { } ;
for my $ hca_info ( @$ hwres )
{
chomp $ hca_info ;
if ( $ hca_info =~ /^(.+):(.+):(.+)$/ )
{
my $ adapter_id = $ 1 ;
my $ phys_loc = $ 2 ;
my $ unassigned_guids = $ 3 ;
2010-03-25 13:58:13 +00:00
if ( $ phys_loc =~ /C65$/ or $ phys_loc =~ /C66$/ or $ phys_loc =~ /C7$/ )
2009-04-14 11:58:06 +00:00
{
my @ guids = split /,/ , $ unassigned_guids ;
$ max_ib_num = scalar ( @ guids ) if ( scalar ( @ guids ) < $ max_ib_num ) ;
for ( my $ i = 0 ; $ i < $ max_ib_num ; $ i + + )
{
my $ guid = @ guids [ $ i ] ;
$ guid =~ s/\s*(\S+)\s*/$1/ ;
unshift @ { $ ib_hash - > { $ phys_loc } - > { $ adapter_id } } , "$adapter_id/$guid/$ibacap" ;
}
}
}
}
for my $ loc ( sort keys %$ ib_hash )
{
my $ min_guid_num = - 1 ;
for my $ id ( keys % { $ ib_hash - > { $ loc } } )
{
if ( $ min_guid_num == - 1 or $ min_guid_num > scalar ( @ { $ ib_hash - > { $ loc } - > { $ id } } ) )
{
$ min_guid_num = scalar ( @ { $ ib_hash - > { $ loc } - > { $ id } } ) ;
}
}
for ( my $ i = 0 ; $ i < $ min_guid_num ; $ i + + )
{
my $ unassigned_iba = undef ;
for my $ adp_id ( sort keys % { $ ib_hash - > { $ loc } } )
{
my $ iba = $ ib_hash - > { $ loc } - > { $ adp_id } - > [ $ i ] ;
$ unassigned_iba . = ",$iba" ;
}
if ( $ unassigned_iba )
{
$ unassigned_iba =~ s/^,// ;
push @ unassigned_ibas , $ unassigned_iba ;
}
}
}
return \ @ unassigned_ibas ;
}
else
{
return undef ;
}
}
2009-04-15 17:02:11 +00:00
##########################################################################
# get iba replacement pair (from source profile to target)
##########################################################################
sub get_iba_replace_pair
{
my $ unassigned_iba = shift ;
my $ profile = shift ;
2009-10-13 08:50:05 +00:00
#############################
# Get hca info from profile
#############################
2009-04-15 17:02:11 +00:00
my @ oldhca_prefixes ;
for my $ cfg ( @$ profile )
{
if ( $ cfg =~ /(\"*hca_adapters)/ )
{
my $ delim = ( $ 1 =~ /^\"/ ) ? "\\\\\"" : "," ;
$ cfg =~ /hca_adapters=([^$delim]+)|$/ ;
my $ oldhca = $ 1 ;
my @ oldhcas = split /,/ , $ oldhca ;
for my $ oldhca_entry ( @ oldhcas )
{
if ( $ oldhca_entry =~ /(.+\/.+)..\/\d+/ )
{
my $ oldhca_prefix = $ 1 ;
if ( ! grep /\Q$oldhca_prefix\E/ , @ oldhca_prefixes )
{
push @ oldhca_prefixes , $ oldhca_prefix ;
}
}
}
}
}
2009-10-13 08:50:05 +00:00
###########################################
# Get hca info from unasigned hca array
###########################################
2009-04-15 17:02:11 +00:00
my @ newhca_prefixes ;
for my $ newhca ( @$ unassigned_iba )
{
my @ newhcas = split /,/ , $ newhca ;
for my $ newhca_entry ( @ newhcas )
{
if ( $ newhca_entry =~ /(.+\/.+)..\/\d+/ )
{
my $ newhca_prefix = $ 1 ;
if ( ! grep /\Q$newhca_prefix\E/ , @ newhca_prefixes )
{
push @ newhca_prefixes , $ newhca_prefix ;
}
}
}
}
2009-10-13 08:50:05 +00:00
#############################
# Create replacement pair
#############################
2009-04-15 17:02:11 +00:00
my % pair_hash ;
for ( my $ i = 0 ; $ i < scalar @ oldhca_prefixes ; $ i + + )
{
$ pair_hash { @ oldhca_prefixes [ $ i ] } = @ newhca_prefixes [ $ i ] ;
}
return \ % pair_hash ;
}
2009-04-14 11:58:06 +00:00
##########################################################################
# Substitue hca info
##########################################################################
sub hcasubst
2009-04-15 17:02:11 +00:00
{
my $ cfgdata = shift ;
my $ replace_hash = shift ;
if ( $ cfgdata =~ /(\"*hca_adapters)/ ) {
for my $ oldhca_prefix ( keys %$ replace_hash )
{
$ cfgdata =~ s/\Q$oldhca_prefix\E/$replace_hash->{$oldhca_prefix}/g ;
}
}
return $ cfgdata ;
}
##########################################################################
# Automatically configure HCA adapters
##########################################################################
sub hcaautoconf
2009-04-14 11:58:06 +00:00
{
my $ cfgdata = shift ;
my $ unassignedhca = shift ;
$ unassignedhca = [] if ( ! $ unassignedhca ) ;
2008-11-07 13:34:21 +00:00
2009-04-14 11:58:06 +00:00
if ( $ cfgdata =~ /(\"*hca_adapters)/ ) {
#####################################
# If double-quoted, has comma-
# seperated list of adapters
#####################################
my $ delim = ( $ 1 =~ /^\"/ ) ? "\\\\\"" : "," ;
$ cfgdata =~ /hca_adapters=([^$delim]+)|$/ ;
my $ oldhca = $ 1 ;
my $ newhca ;
2009-04-15 17:02:11 +00:00
$ newhca = shift @$ unassignedhca ;
2009-04-14 11:58:06 +00:00
my $ adapters = undef ;
if ( $ newhca )
{
$ adapters = "hca_adapters=$newhca" ;
}
else
{
$ adapters = "hca_adapters=none" ;
}
if ( $ adapters =~ /,/ and $ delim ne "\\\\\"" )
{
$ adapters = "\\\\\"" . $ adapters . "\\\\\"" ;
}
$ cfgdata =~ s/hca_adapters=[^$delim]+/$adapters/ ;
}
2009-04-15 17:02:11 +00:00
return $ cfgdata ;
2009-04-14 11:58:06 +00:00
}
2008-11-07 13:34:21 +00:00
2009-02-13 09:42:26 +00:00
##########################################################################
# Increments virtual lhea adapter in partition profile
##########################################################################
sub lhea_adapter {
my $ cfgdata = shift ;
#########################################
# Increment LHEA adapters if present
# 23000000/2/1/7/none,23000008/2/1/4/none
# Increment 7 and 4 in example above.
#########################################
if ( $ cfgdata =~ /(\"*lhea_logical_ports)/ ) {
#####################################
# If double-quoted, has comma-
# seperated list of adapters
#####################################
my $ delim = ( $ 1 =~ /^\"/ ) ? "\\\\\"" : "," ;
$ cfgdata =~ /lhea_logical_ports=([^$delim]+)|$/ ;
my @ lhea = split "," , $ 1 ;
foreach ( @ lhea ) {
if ( /(\w+)\/(\w+)$/ ) {
my $ id = ( $ 1 =~ /(\d+)/ ) ? $ 1 + 1 : $ 1 ;
s/(\w+)\/(\w+)$/$id\/$2/ ;
}
}
my $ adapters = "lhea_logical_ports=" . join ( "," , @ lhea ) ;
$ cfgdata =~ s/lhea_logical_ports=[^$delim]+/$adapters/ ;
}
return ( $ cfgdata ) ;
}
2008-11-07 13:34:21 +00:00
##########################################################################
# Increments virtual scsi adapter in partition profile
##########################################################################
sub scsi_adapter {
my $ cfgdata = shift ;
#########################################
# Increment SCSI adapters if present
# 15/server/6/1ae0-node1/11/1,
# 14/server/5/1ae0-ms04/12/1,
# 20/server/any//any/1
# Increment 11 and 12 in example above.
#########################################
if ( $ cfgdata =~ /(\"*virtual_scsi_adapters)/ ) {
#####################################
# If double-quoted, has comma-
# seperated list of adapters
#####################################
my $ delim = ( $ 1 =~ /^\"/ ) ? "\\\\\"" : "," ;
$ cfgdata =~ /virtual_scsi_adapters=([^$delim]+)|$/ ;
my @ scsi = split "," , $ 1 ;
foreach ( @ scsi ) {
if ( /(\w+)\/(\w+)$/ ) {
my $ id = ( $ 1 =~ /(\d+)/ ) ? $ 1 + 1 : $ 1 ;
s/(\w+)\/(\w+)$/$id\/$2/ ;
}
}
my $ adapters = "virtual_scsi_adapters=" . join ( "," , @ scsi ) ;
$ cfgdata =~ s/virtual_scsi_adapters=[^$delim]+/$adapters/ ;
}
return ( $ cfgdata ) ;
}
##########################################################################
# Creates/changes logical partitions
##########################################################################
sub create {
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
my $ hwtype = @$ exp [ 2 ] ;
my $ opt = $ request - > { opt } ;
my @ values = ( ) ;
my $ result ;
my $ lpar ;
my $ d ;
my $ lparid ;
my $ mtms ;
my $ type ;
my $ profile ;
#####################################
# Get source node information
#####################################
while ( my ( $ cec , $ h ) = each ( %$ hash ) ) {
while ( my ( $ name , $ data ) = each ( %$ h ) ) {
$ d = $ data ;
$ lparid = @$ d [ 0 ] ;
$ mtms = @$ d [ 2 ] ;
$ type = @$ d [ 4 ] ;
$ lpar = $ name ;
}
}
#####################################
# Must be CEC or LPAR
#####################################
if ( $ type !~ /^(lpar|fsp)$/ ) {
return ( [ [ $ lpar , "Node must be LPAR or CEC" , RC_ERROR ] ] ) ;
}
#####################################
# Clone all the LPARs on CEC
#####################################
if ( exists ( $ opt - > { c } ) ) {
2009-04-02 15:37:19 +00:00
my $ result = clone ( $ request ,
$ exp ,
$ opt - > { target } ,
$ opt - > { profile } ,
$ d ,
$ request - > { node } - > [ 0 ]
) ;
2008-11-07 13:34:21 +00:00
foreach ( @$ result ) {
my $ Rc = shift ( @$ _ ) ;
push @ values , [ $ opt - > { c } , @$ _ [ 0 ] , $ Rc ] ;
}
return ( \ @ values ) ;
}
#####################################
# Get source LPAR profile
#####################################
my $ prof = xCAT::PPCcli:: lssyscfg (
$ exp ,
"prof" ,
$ mtms ,
"lpar_ids=$lparid" ) ;
my $ Rc = shift ( @$ prof ) ;
#####################################
# Return error
#####################################
if ( $ Rc != SUCCESS ) {
return ( [ [ $ lpar , @$ prof [ 0 ] , $ Rc ] ] ) ;
}
#####################################
# Get source node pprofile attribute
#####################################
my $ pprofile = @$ d [ 1 ] ;
#####################################
# Find pprofile on source node
#####################################
my ( $ prof ) = grep /^name=$pprofile\,/ , @$ prof ;
if ( ! $ prof ) {
return ( [ [ $ lpar , "'pprofile=$pprofile' not found on '$lpar'" , RC_ERROR ] ] ) ;
}
#####################################
# Get command-line options
#####################################
my $ id = $ opt - > { i } ;
my $ cfgdata = strip_profile ( $ prof , $ hwtype ) ;
#####################################
# Set profile name for all LPARs
#####################################
if ( $ hwtype eq "hmc" ) {
$ cfgdata =~ s/^name=([^,]+|$)/profile_name=$1/ ;
$ profile = $ 1 ;
$ cfgdata =~ s/lpar_name=/name=/ ;
}
2009-04-02 15:37:19 +00:00
foreach my $ name ( @ { $ opt - > { target } } ) {
2008-11-07 13:34:21 +00:00
#################################
# Modify read-back profile.
# See HMC or IVM mksyscfg man
# page for valid attributes.
#
#################################
$ cfgdata =~ s/\blpar_id=[^,]+|$/lpar_id=$id/ ;
$ cfgdata =~ s/\bname=[^,]+|$/name=$name/ ;
2009-02-13 09:42:26 +00:00
#################################
# Modify LHEA adapters
#################################
if ( $ cfgdata =~ /lhea_logical_ports=(\w+)/ ) {
if ( $ 1 !~ /^none$/i ) {
$ cfgdata = lhea_adapter ( $ cfgdata ) ;
}
}
2008-11-07 13:34:21 +00:00
#################################
2009-04-02 15:37:19 +00:00
# Modify HCA adapters
#################################
if ( $ cfgdata =~ /hca_adapters=(\w+)/ ) {
if ( $ 1 !~ /^none$/i ) {
$ cfgdata = hca_adapter ( $ cfgdata ) ;
}
}
#################################
2008-11-07 13:34:21 +00:00
# Modify SCSI adapters
#################################
if ( $ cfgdata =~ /virtual_scsi_adapters=(\w+)/ ) {
if ( $ 1 !~ /^none$/i ) {
$ cfgdata = scsi_adapter ( $ cfgdata ) ;
}
}
#################################
# Create new LPAR
#################################
$ result = xCAT::PPCcli:: mksyscfg ( $ exp , "lpar" , $ d , $ cfgdata ) ;
$ Rc = shift ( @$ result ) ;
#################################
# Add new LPAR to database
#################################
if ( $ Rc == SUCCESS ) {
my $ err = xCATdB ( "mkvm" , $ name , $ profile , $ id , $ d , $ hwtype , $ lpar ) ;
if ( defined ( $ err ) ) {
push @ values , [ $ name , $ err , RC_ERROR ] ;
$ id + + ;
next ;
}
}
push @ values , [ $ name , @$ result [ 0 ] , $ Rc ] ;
$ id + + ;
}
return ( \ @ values ) ;
}
##########################################################################
# Strips attributes from profile not valid for creation
##########################################################################
sub strip_profile {
my $ cfgdata = shift ;
my $ hwtype = shift ;
#####################################
# Modify read-back profile. See
# HMC mksyscfg man page for valid
# attributes.
#####################################
if ( $ hwtype eq "hmc" ) {
$ cfgdata =~ s/,*\"virtual_serial_adapters=[^\"]+\"// ;
$ cfgdata =~ s/,*electronic_err_reporting=[^,]+|$// ;
$ cfgdata =~ s/,*shared_proc_pool_id=[^,]+|$// ;
$ cfgdata =~ s/,*lpar_proc_compat_mode=[^,]+|$// ;
$ cfgdata =~ s/\"/\\"/g ;
$ cfgdata =~ s/\n//g ;
return ( $ cfgdata ) ;
}
#####################################
# Modify read-back profile. See
# IVM mksyscfg man page for valid
# attributes.
#####################################
$ 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/,*conn_monitoring=[^,]+|$// ;
$ cfgdata =~ s/,*power_ctrl_lpar_ids=[^,]+|$// ;
$ cfgdata =~ s/\"/\\"/g ;
return ( $ cfgdata ) ;
}
##########################################################################
# Adds/removes LPARs from the xCAT database
##########################################################################
sub xCATdB {
my $ cmd = shift ;
my $ name = shift ;
my $ profile = shift ;
my $ lparid = shift ;
my $ d = shift ;
my $ hwtype = shift ;
my $ lpar = shift ;
2009-02-24 10:39:18 +00:00
my $ parent = shift ;
2008-11-07 13:34:21 +00:00
#######################################
# Remove entry
#######################################
if ( $ cmd eq "rmvm" ) {
return ( xCAT::PPCdb:: rm_ppc ( $ name ) ) ;
}
#######################################
# Change entry
#######################################
elsif ( $ cmd eq "chvm" ) {
my $ ppctab = xCAT::Table - > new ( "ppc" , - create = > 1 , - autocommit = > 1 ) ;
###################################
# Error opening ppc database
###################################
if ( ! defined ( $ ppctab ) ) {
return ( "Error opening 'ppc' database" ) ;
}
$ ppctab - > setNodeAttribs ( $ name , { pprofile = > $ profile } ) ;
}
#######################################
# Add entry
#######################################
else {
if ( ! defined ( $ profile ) ) {
$ profile = $ name ;
}
my ( $ model , $ serial ) = split /\*/ , @$ d [ 2 ] ;
my $ server = @$ d [ 3 ] ;
my $ fsp = @$ d [ 2 ] ;
2009-12-31 04:46:42 +00:00
###################################
2008-11-07 13:34:21 +00:00
# Find FSP name in ppc database
###################################
my $ tab = xCAT::Table - > new ( "ppc" ) ;
###################################
# Error opening ppc database
###################################
if ( ! defined ( $ tab ) ) {
return ( "Error opening 'ppc' database" ) ;
}
###################################
2009-02-24 10:39:18 +00:00
# If there is no parent provided
# this lpar should be the cloned
# in the same cec
# Otherwise it should be cloned
# between cecs
2008-11-07 13:34:21 +00:00
###################################
2009-02-24 10:39:18 +00:00
if ( ! $ parent )
{
my ( $ ent ) = $ tab - > getNodeAttribs ( $ lpar , [ 'parent' ] ) ;
###################################
# Node not found
###################################
if ( ! defined ( $ ent ) ) {
return ( "'$lpar' not found in 'ppc' database" ) ;
}
###################################
# Attributes not found
###################################
if ( ! exists ( $ ent - > { parent } ) ) {
return ( "'parent' attribute not found in 'ppc' database" ) ;
}
$ parent = $ ent - > { parent } ;
2008-11-07 13:34:21 +00:00
}
2009-12-31 04:46:42 +00:00
2008-11-07 13:34:21 +00:00
my $ values = join ( "," ,
"lpar" ,
$ name ,
$ lparid ,
$ model ,
$ serial ,
2009-12-31 04:46:42 +00:00
"" ,
2008-11-07 13:34:21 +00:00
$ server ,
$ profile ,
2009-02-24 10:39:18 +00:00
$ parent ) ;
2008-11-07 13:34:21 +00:00
return ( xCAT::PPCdb:: add_ppc ( $ hwtype , [ $ values ] ) ) ;
}
return undef ;
}
2009-12-31 04:46:42 +00:00
##########################################################################
# The mkfulllpar function is written in ksh, and used to create a full
# system partition for each CECs Managed by the HMC. It will use ssh to
# login the HMC with the hscroot userid in order to rename the CECs based
# on a certain pattern specified through command line and create full
# partition for all the CECs.
##########################################################################
sub mkfulllpar {
my $ request = shift ;
my $ hash = shift ;
my $ exp = shift ;
my $ hwtype = @$ exp [ 2 ] ;
my $ opt = $ request - > { opt } ;
my @ values = ( ) ;
my $ result ;
my $ lpar ;
my $ d ;
my $ lparid ;
my $ mtms ;
my $ type ;
my $ profile ;
my $ ppctab = xCAT::Table - > new ( 'ppc' ) ;
#####################################
# Get source node information
#####################################
while ( my ( $ cec , $ h ) = each ( %$ hash ) ) {
my ( $ name , $ data ) = each ( %$ h ) ;
$ d = $ data ;
$ lparid = @$ d [ 0 ] ;
$ mtms = @$ d [ 2 ] ;
$ type = @$ d [ 4 ] ;
$ lpar = $ name ;
#####################################
# Must be CEC or LPAR
#####################################
if ( $ type !~ /^(lpar|fsp)$/ ) {
return ( [ [ $ lpar , "Node must be LPAR or CEC" , RC_ERROR ] ] ) ;
}
my $ ppctab = xCAT::Table - > new ( 'ppc' ) ;
#####################################
# Check if a existing with requested LPAR ID has existed
#####################################
my $ value = xCAT::PPCcli:: lssyscfg (
$ exp ,
"profs" ,
$ mtms ,
"all_resources" ,
"lpar_ids=$lparid" ) ;
my $ Rc = shift ( @$ value ) ;
#######################################
# make how to handle according to the result of lssyscfg
#######################################
if ( $ Rc == SUCCESS ) {
# close the DB handler of the ppc table
$ ppctab - > close ;
# change the lpar's attribute before removing it.
my $ all_res_flag = @$ value [ 0 ] ;
if ( $ all_res_flag != 1 ) {
return ( [ [ $ lpar , "The LPAR ID has been occupied" , RC_ERROR ] ] ) ;
}
else {
return ( [ [ $ lpar , "This full LPAR has been created" , RC_ERROR ] ] ) ;
}
}
#################################
# Create the new full LPAR's configure data
#################################
my ( $ lpar_id , $ profname ) ;
my $ vcon = $ ppctab - > getAttribs ( { node = > $ name } , ( 'id' , 'pprofile' ) ) ;
if ( $ vcon ) {
if ( $ vcon - > { "id" } ) {
$ lpar_id = $ vcon - > { "id" } ;
} else {
$ lpar_id = 1 ;
}
if ( $ vcon - > { "pprofile" } ) {
$ profname = $ vcon - > { "pprofile" } ;
} else {
$ profname = $ name ;
}
} else {
$ lpar_id = 1 ;
$ profname = $ name ;
}
my $ cfgdata = "name=$name,profile_name=$profname,lpar_id=$lpar_id,lpar_env=aixlinux,all_resources=1,boot_mode=norm,conn_monitoring=0" ;
#################################
# Create a new full LPAR
#################################
$ result = xCAT::PPCcli:: mksyscfg ( $ exp , "lpar" , $ d , $ cfgdata ) ;
$ Rc = shift ( @$ result ) ;
###########################################
# Set the CEC's service_lpar_id to the lpar_id of the full LPAR
###########################################
if ( $ Rc == SUCCESS ) {
$ cfgdata = "service_lpar_id=$lpar_id" ;
2010-03-04 09:38:44 +00:00
$ result = xCAT::PPCcli:: chsyscfg ( $ exp , "fsp" , $ d , $ cfgdata ) ;
2009-12-31 04:46:42 +00:00
$ Rc = shift ( @$ result ) ;
if ( $ Rc != SUCCESS ) {
$ ppctab - > close ;
return ( [ [ $ lpar , @$ result [ 0 ] , $ Rc ] ] ) ;
}
}
#################################
# Add a new full LPAR to database
#################################
if ( $ Rc == SUCCESS ) {
$ profile = $ profname ;
my $ id = $ lpar_id ;
my $ err = xCATdB ( "mkvm" , $ name , $ profile , $ id , $ d , $ hwtype , $ lpar ) ;
if ( defined ( $ err ) ) {
push @ values , [ $ name , $ err , RC_ERROR ] ;
next ;
}
}
push @ values , [ $ name , @$ result [ 0 ] , $ Rc ] ;
}
$ ppctab - > close ;
return ( \ @ values ) ;
}
2008-11-07 13:34:21 +00:00
##########################################################################
# Creates logical partitions
##########################################################################
sub mkvm {
2009-12-31 04:46:42 +00:00
my $ request = $ _ [ 0 ] ;
my $ opt = $ request - > { opt } ;
# decide if issuing mkvm with the option '-f'.
# if yes, mklpar will be invoked to
# create a full system partition for each CECs managed by the HMC.
if ( exists ( $ opt - > { full } ) ) {
return ( mkfulllpar ( @ _ ) ) ;
}
else {
# if no, it will execute the original function.
2008-11-07 13:34:21 +00:00
return ( create ( @ _ ) ) ;
2009-12-31 04:46:42 +00:00
}
2008-11-07 13:34:21 +00:00
}
##########################################################################
# Change logical partition
##########################################################################
sub chvm {
return ( modify ( @ _ ) ) ;
}
##########################################################################
# Removes logical partitions
##########################################################################
sub rmvm {
return ( remove ( @ _ ) ) ;
}
##########################################################################
# Lists logical partition profile
##########################################################################
sub lsvm {
return ( list ( @ _ ) ) ;
}
1 ;
2009-10-13 08:50:05 +00:00
