# IBM_PROLOG_BEGIN_TAG
# This is an automatically generated prolog.
#
#
#
# Licensed Materials - Property of IBM
#
# (C) COPYRIGHT International Business Machines Corp. 1999,2019
# All Rights Reserved
#
# US Government Users Restricted Rights - Use, duplication or
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp.
#
# IBM_PROLOG_END_TAG
package MC_cli_utils;
# sccsid = "@(#)49 1.62 src/rsct/rmc/cli/pm/MC_cli_utils.pm.perl, rmccli, rsct_rady, rady2035a 1/18/19 17:00:38"
######################################################################
# #
# Package: MC_cli_utils.pm #
# #
# Description: #
# This package contains utility/common subroutines for the PERL #
# Cluster Resource Monitoring and Control (RMC) CLI commands. #
# #
# Subroutines Available: #
# #
# init_session - initializes a session with RMC. #
# #
# term_session - terminates a session with RMC. #
# #
# enumerate_resources - enumerates the resources of a resource #
# class using attribute selection. In simpler terms it builds #
# an array of all the resource handles for the specified #
# resource class that correspond to the specified selection #
# string. Convenient way of calling mc_enumerate_resources_bp #
# used by lsrsrc, rmrsrc, etc. #
# #
# qdef_resource_class - queries the definition of a resource #
# class. Convenient way of calling mc_qdef_resource_class_bp #
# used by lsrsrc, lsrsrcdef, lsactdef, etc. #
# #
# qdef_resource_class_id - queries definition of a resource class #
# based on class ID, then builds a hash of class names keyed by #
# class id's. Calls qdef_resource_class. #
# #
# get_p_attr_defs - function to get this resource's persistent #
# attribute definitions using mc_qdef_p_attributes_bp and build #
# a hash indexible via the attribute program name with the #
# attributes property and data_type definition stored as data. #
# Which attributes are returned is also control using the #
# req_attributes and req_properties paramaters. #
# #
# get_p_attr_defs_api - function to get this resource's persistent #
# attribute definitions using lsrsrcdef-api and build #
# a hash indexible via the attribute program name with the #
# attributes property and data_type definition stored as data. #
# Which attributes are returned is also controlled using the #
# req_attributes and req_properties paramaters. #
# #
# get_d_attr_defs - function to get this resource's dynamic #
# attribute definitions using mc_qdef_d_attributes_bp and build #
# a hash indexible via the attribute program name with the #
# attributes property and data_type definition stored as data. #
# Which attributes are returned is also control using the #
# req_attributes and req_properties paramaters. #
# #
# required_attr - function that returns whether the specified #
# attribute name is required. A required attribute has one #
# of the specified properties or is in the list of required #
# attributes (the attributes entered via the command line). #
# #
# validate_rsrc_hndl - funtion to validate the specified resource #
# handle. The resource handle is copied into a list of rsrc #
# handles (list of one) since that is what the mc_validate_rsrc #
# _hndl_bp function expects. A resource handle is valid if #
# the resource to which it is linked is still defined to the #
# subsystem (resource manager). #
# #
# build_HoAttr - build Hash of Attributes (complex structure). #
# Give it one element of an attribute at a time. #
# This is the format required by MC_cli_display_utils.pm. #
# #
# get_local_node - returns a string that is the resolved node #
# name of this node (the node the command is running on). #
# No parameters. #
# #
# translate_lsAOpt - takes @ARGV passed to a command and looks for #
# the old -a attribute specification. If one is found, it is #
# changed to -A. #
# #
# error_exit - performs required cleanup and exits with the #
# appropriate RMC CLI error exit code. #
# #
# printCIMsg - print common informational message to STDOUT. #
# Requires the program name and message mnemonic as inputs. #
# #
# printCEMsg - print common error message to STDERR. #
# Requires the program name and message mnemonic as inputs. #
# #
# process_exit_code - returns either 0, the signal exit code, #
# or the process error code for the called process. #
# Requires the exit code to examine. #
# #
# process_api_error - extracts and prints errors from the output #
# of a c-api command (mkrsrc-api, etc..). #
# Requires the command output including STDERR. #
# #
# remove_api_error - removes error messages from the output of a #
# c-api command (mkrsrc-api, etc..). Also replaces escaped new #
# lines with the new line. #
# Requires the command output including STDERR and the delimiter.#
# #
# read_from_Stdin - creates a file based on the Stdin content #
# #
# Examples: #
# ($rc $session) = init_session(); #
# $rc = term_session($session); #
# printCEMsg("EMsgCUcliBadOperand", $rsrc_class); #
# #
#--------------------------------------------------------------------#
# Inputs: #
# /opt/rsct/msgmaps/mccli.mcucli.map - message mapping #
# #
# Outputs: #
# stdout - common informational messages that get displayed. #
# stderr - common error messages that get displayed. #
# #
# External References: #
# Commands: ctdspmsg #
# #
# Tab Settings: #
# 4 and tabs should be expanded to spaces before saving this file. #
# in vi: (:set ts=4 and :%!expand -4) #
# #
# Change Activity: #
# 990528 SAB 48419: Initial design & write. #
# 001115 GTM 67900: Add qdef_resource_class_id #
# 010213 SAB 70842: Changes to contact list for CT_CONTACT support.#
# 010406 SAB 71892: error_exit support new rc MC_CLI_NO_RSRC_FOUND.#
# 010406 SAB 72722: init_session support for CT_LOCAL_SCOPE. #
# 011126 JAC 78604: add rmc management scope environment vars. #
# 011214 JAC 77349: add get_local_node for rmcapi version 2 update #
# 020109 JAC 78200: modify required_attr for when req_attr is F's #
# 020716 JAC 84819: add translate_lsAOpt subroutine. #
# 020822 JAC 88082: add api processing functions. #
# 021106 JAC 88083: add additional functions for api processing. #
# 021203 JAC 88085: add additional function. #
# 021211 JAC 88086: add additional function. #
# 030205 JAC 91280: convert escaped new lines in remove_api_error. #
# 030211 JAC 89941: modify string_to_value_api/string_to_array_api #
# to check for odd number of binary digits. #
# 030219 JAC 91964: modify string_to_value_api/string_to_array_api #
# to remove extra 0x's on long values. #
# 030228 JAC 92317: allow 0 as input in string_to_rsrc_handle_api. #
# 030303 JAC 92407: check for quote and comma in SD strings. #
# 030305 JAC 92430: allow 0X in addition to 0x. #
# 030306 JAC 92311: move formatting to here from lsrsrc/lsrsrcdef. #
# 030709 JAC 96745: change remove_api_error and process_api_error #
# for when STDOUT and STDERR collide. #
# 040408 JAC 105863: Use unescape_chars for \\\" to \". #
# 050609 JAC 123591: Add TRUE/FALSE/CTDIR/CTBINDIR to export list. #
# 070608 JAC 144354: Add MTYPE global variables. #
# 080104 JAC 148354: Don't export get_local_node. #
# 080718 JAC 152239: add RMC_CLASS_CAN_DEF_UNDEF. #
######################################################################
use Exporter ();
@ISA = qw(Exporter);
@EXPORT_OK = qw(
qdef_resource_class_api
get_p_attr_defs_api
get_d_attr_defs_api
get_arg_defs_api
get_sd_defs_api
build_cmd_arg_sd_api
get_class_from_rsrc_hndl_api
required_attr
build_HoAttr
translate_lsAOpt
error_exit
printCIMsg
printCEMsg
process_exit_code
process_api_error
remove_api_error
convert_input_value_api
format_value_for_display
read_from_Stdin
$RMC_RSRC_PATTR_REQD_FOR_DEFINE
$RMC_RSRC_PATTR_OPTION_FOR_DEFINE
$RMC_RSRC_PATTR_PUBLIC
$TRUE $FALSE
$CTDIR $CTBINDIR
$RMC_CLASS_MTYPE_SUBD
$RMC_CLASS_MTYPE_GLOBAL
$RMC_CLASS_CAN_DEF_UNDEF
);
use lib "/opt/rsct/pm";
use locale;
use MC_cli_rc qw(:return_codes);
use CT_cli_input_utils qw(
trim_hex_value
string_to_binary_hash
strip_quotes
escape_chars
unescape_chars
);
use constant;
#--------------------------------------------------------------------#
# Global Variables #
#--------------------------------------------------------------------#
$TRUE = 1;
$FALSE = 0;
$MSGCAT = "mccli.cat"; # msg catalogue for this cmd
$MSGSET = "mccli"; # common message set
$MSGCAT_SAVED = ""; # used if we have to switch
$MSGSET_SAVED = ""; # used if we have to switch
$CTDIR = "/opt/rsct"; # RSCT root directory
$CTBINDIR = "$CTDIR/bin"; # Cluster Bin directory path
$LSMSG = "$CTBINDIR/ctdspmsg"; # list / display message rtn
$ENV{'MSGMAPPATH'} = "$CTDIR/msgmaps"; # msg maps used by $LSMSG
#--------------------------------------------------------------------#
# Define global constants #
#--------------------------------------------------------------------#
$RMC_RSRC_PATTR_REQD_FOR_DEFINE = 0x0002;
$RMC_RSRC_PATTR_OPTION_FOR_DEFINE = 0x0008;
$RMC_RSRC_PATTR_PUBLIC = 0x0020;
$DELIMITER = "tvrtvrtvr";
$RMC_CLASS_MTYPE_SUBD = "mtype_subdivided";
$RMC_CLASS_MTYPE_GLOBAL = "mtype_globalized";
$RMC_CLASS_CAN_DEF_UNDEF = "can_define_undefine";
#--------------------------------------------------------------------#
# Exported Subroutines (with @EXPORT_OK, -> on demand). #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# Common message handling (error, informational) routines: #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# qdef_resource_class_api - function to call lsrsrcdef-api to get #
# class information. #
# #
# Parameters: #
# $class input name of the class we want the defn #
# for if blank we want a list of all #
# resource classes defined in the system.#
# $req_desc in TRUE - descriptions requested #
# #
# Return #
# $rc return code. #
# $rLoClass out lsrsrcdef-api output. #
# #
# Global References: #
# $Opt_All input TRUE if display def & description. #
#--------------------------------------------------------------------#
sub qdef_resource_class_api
{
my ($class, $req_desc) = @_;
my $rc = 0;
my @lsr_out = ();
my $cmd_flg = "";
# print display and description?
if ($req_desc) { $cmd_flg = " -q ";}
if ($main::Trace) { print STDERR "$PROGNAME: calling lsrsrcdef-api\n";}
@lsr_out = `$CTBINDIR/lsrsrcdef-api -I $DELIMITER -D $DELIMITER ${cmd_flg} -c $class 2>&1`;
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error($DELIMITER,$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error($DELIMITER,@lsr_out);
return ($rc, \@lsr_out);
} # end qdef_resource_class_api
#--------------------------------------------------------------------#
# get_p_attr_defs_api - function to get this resource's persistent #
# attribute definitions using lsrsrcdef-api and build #
# a hash indexible via the attribute program name with the #
# attributes property and data_type definition stored as data. #
# Only attributes that have the required properties (input) are #
# returned except required attributes (input) are always returned #
# if they are found regardless of their properties. #
# The list of required attributes may contain both persistent, #
# dynamic, and even invalid names. We have to get the persistent #
# attribute definitions so that we can determine which attributes #
# in the list of required attributes are persistent attributes. #
# #
# Parameters: #
# $resource input name of the resource that we wish to #
# create an instance of. #
# $get_class input TRUE - get class resources defs. #
# FALSE - get resource defs. #
# $req_properties input Only return the definition for attr #
# that have these properties. #
# @$r_req_attributes input Reference to list of required attrs #
# that should be returned even if they #
# do not have the required property. #
# @$rLoPAttr in/out Reference to persistent attribute #
# names in order returned from RMC. #
# %$rHoPAttrDefs in/out Reference to the hash of persistent #
# attribute definitions. #
# Return #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub get_p_attr_defs_api
{
my ($resource, $get_class, $req_properties,
$r_req_attributes, $rLoPAttr, $rHoPAttrDefs) = @_;
my $rc = 0;
my @attributes = ();
my @lsr_out = ();
my $cmd_flg = "";
my $attr_name2 = "";
my $attr_list = "";
# set flag for lsrsrcdef-api for class or resource
if ($get_class) {
$cmd_flg = "-c";
}
else {
$cmd_flg = "-r";
}
# build attr list for lsrsrcdef
#if ($#$r_req_attributes >= 0) {
# foreach $attr_name2 (@$r_req_attributes) {
# $attr_list .= $DELIMITER . $attr_name2;
# }
#}
# Need to make sure this resource is defined and get various info
# associated with the persistent attributes.
$resource= escape_chars($resource);
# call lsrsrcdef-api
if ($main::Trace) { print STDERR "$main::PROGNAME: calling lsrsrcdef-api\n";}
@lsr_out = `$CTBINDIR/lsrsrcdef-api -I $DELIMITER -D $DELIMITER $cmd_flg "${resource}${attr_list}${DELIMITER}*p${req_properties}" 2>&1`;
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$main::PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error($DELIMITER,$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error($DELIMITER,@lsr_out);
# Format the Query Definition Persistent Attributes into
# a hash where you can quickly lookup by attribute name, the
# attributes definition (data type, default value, properties, id).
# Filter out the attributes that don't have the required property
# unless that attribute name is also in the list of required
# attributes, always return required attributes if they are found.
my %elements = ();
my @attr_info = ();
my $line = "";
my $attr_name = "";
foreach $line (@lsr_out) {
# start fresh
%elements = ();
# split off the attribute information
@attr_info = split /$DELIMITER/, $line;
$attr_name = $attr_info[0];
# Filter out any attribute that does not have the required
# (requested) properties - unless that attribute is listed
# in the list of required (requested) attributes.
#(required_attr($attr_name, $response->properties($r),
# $r_req_attributes, $req_properties)) || next;
$elements{at_name} = $attr_name;
$elements{at_id} = $attr_info[5];
$elements{at_properties} = $attr_info[3];
$elements{at_dtype} = $attr_info[7];
$elements{at_dvalue} = $attr_info[10];
push @$rLoPAttr, $attr_name;
$$rHoPAttrDefs{$attr_name} = { %elements };
} # end for responses
return($rc);
} # end get_p_attr_defs_api
#--------------------------------------------------------------------#
# get_d_attr_defs_api - function to get this resource's dynamic #
# attribute definitions using lsrsrcdef-api and build #
# a hash indexible via the attribute program name with the #
# attributes property and data_type definition stored as data. #
# Only attributes that have the required properties (input) are #
# returned except required attributes (input) are always returned #
# if they are found regardless of their properties. #
# The list of required attributes may contain both dynamic, #
# dynamic, and even invalid names. We have to get the dynamic #
# attribute definitions so that we can determine which attributes #
# in the list of required attributes are dynamic attributes. #
# #
# Parameters: #
# $resource input name of the resource that we wish to #
# create an instance of. #
# $get_class input TRUE - get class resources defs. #
# FALSE - get resource defs. #
# $req_properties input Only return the definition for attr #
# that have these properties. #
# @$r_req_attributes input Reference to list of required attrs #
# that should be returned even if they #
# do not have the required property. #
# @$rLoDAttr in/out Reference to dynamic attribute #
# names in order returned from RMC. #
# %$rHoDAttrDefs in/out Reference to the hash of dynamic #
# attribute definitions. #
# Return #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub get_d_attr_defs_api
{
my ($resource, $get_class, $req_properties,
$r_req_attributes, $rLoDAttr, $rHoDAttrDefs) = @_;
my $rc = 0;
my @attributes = ();
my @lsr_out = ();
my $cmd_flg = "";
my $attr_list = "";
my $attr_name2 = "";
# set flag for lsrsrcdef-api for class or resource
if ($get_class) {
$cmd_flg = "-c";
}
else {
$cmd_flg = "-r";
}
# build attr list for lsrsrcdef
#if ($#$r_req_attributes >= 0) {
# foreach $attr_name2 (@$r_req_attributes) {
# $attr_list .= $DELIMITER . $attr_name2;
# }
#}
# Need to make sure this resource is defined and get various info
# associated with the persistent attributes.
# call lsrsrcdef-api
if ($main::Trace) { print STDERR "$main::PROGNAME: calling lsrsrcdef-api\n";}
@lsr_out = `$CTBINDIR/lsrsrcdef-api -I $DELIMITER -D $DELIMITER $cmd_flg ${resource}${attr_list}${DELIMITER}"*d${req_properties}" 2>&1`;
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$main::PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error($DELIMITER,$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error($DELIMITER,@lsr_out);
# Format the Query Definition Dynamic Attributes into
# a hash where you can quickly lookup by attribute name, the
# attributes definition (data type, properties, id).
# Filter out the attributes that don't have the required property
# unless that attribute name is also in the list of required
# attributes, always return required attributes if they are found.
my %elements = ();
my @attr_info = ();
my $line = "";
my $attr_name = "";
foreach $line (@lsr_out) {
# start fresh
%elements = ();
# split off the attribute information
@attr_info = split /$DELIMITER/, $line;
$attr_name = $attr_info[0];
# Filter out any attribute that does not have the required
# (requested) properties - unless that attribute is listed
# in the list of required (requested) attributes.
#(required_attr($attr_name, $response->properties($r),
# $r_req_attributes, $req_properties)) || next;
# Filter out any attribute that is a Quantum
# (has a data_type of CT_NONE) since we can't qurey the
# attr values - RMC complains.
($attr_info[7] =~ /NONE/) && next;
$elements{at_name} = $attr_name;
$elements{at_id} = $attr_info[5];
$elements{at_properties} = $attr_info[3];
$elements{at_dtype} = $attr_info[7];
push @$rLoDAttr, $attr_name;
$$rHoDAttrDefs{$attr_name} = { %elements };
} # end for responses
return($rc);
} # end get_d_attr_defs_api
#--------------------------------------------------------------------#
# required_attr - function to determine if the attribute name #
# is in the list of required attributes or if the attribute #
# has one of the required properties. #
# 78200- If $attr_properties is 0 there's never a match against #
# $req_properties (ANDed together). So if $req_properties is #
# x"FFFF" (set by user specifying -p0 to get all attributes), #
# include the attribute. #
# #
# #
# Parameters: #
# $attr_name input The name of the attribute that we wish #
# to see if it is required. #
# $attr_properties input The attribute's properties. #
# @$r_req_attributes input Reference to list of required attrs #
# that should be returned even if they #
# do not have the required property. #
# $req_properties input The attributes that have any of these #
# required properties is required. #
# #
# Return #
# $TRUE The attribute is required. #
# $FALSE The attribute is not required. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub required_attr {
my ($attr_name, $attr_properties, $r_req_attributes,
$req_properties) = @_;
my $req_attr_name;
my $attr_required = $FALSE;
foreach $req_attr_name (@$r_req_attributes) {
if ($req_attr_name eq $attr_name) {
$attr_required = $TRUE;
last;
}
}
# This if-statement is for 78200.
# if user specified -p0 (return attribute regardless of property)
# return the attribute (command parse sets all F's value)
if ($req_properties == hex("0xFFFF")) {
$attr_required = $TRUE;
}
# Filter out any attribute that does not have the required
# (requested) properties - unless that attribute is listed
# in the list of required (requested) attributes.
($attr_required || $attr_properties & $req_properties)
? return($TRUE)
: return($FALSE);
} # end required_attr
#--------------------------------------------------------------------#
# get_class_from_rsrc_hndl_api - validates the resource handle and #
# as long as it is valid it returns the class name associated #
# with this resource handle. #
# #
# Parameters: #
# $r_rsrc_handle input Reference to a resource handle. #
# #
# Return: #
# $rc return code. #
# $resource resource class. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub get_class_from_rsrc_hndl_api
{
my ($r_rsrc_handle) = @_;
my $resource = "";
my $rc = 0;
my $rest = "";
my @lsr_out = ();
# get the class name for the handle
# call lsrsrc-api
if ($main::Trace) { print STDERR "$main::PROGNAME: calling lsrsrc-api\n";}
@lsr_out = `$CTBINDIR/lsrsrc-api -mr "${r_rsrc_handle}" 2>&1`;
# capture the return code from lsrsrc-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "$main::PROGNAME: lsrsrc-api results:\n";
print STDERR "@lsr_out";
print STDERR "lsrsrc-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
#process_api_error("::",$rc,@lsr_out);
$r_rsrc_handle = "\"" . $r_rsrc_handle . "\"";
printCEMsg("EMsgMCcliInvalidRsrcHandle", $r_rsrc_handle);
return(MC_CLI_ERROR);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error("::",@lsr_out);
# first thing returned is the class
($resource, $rest) = split /::/, $lsr_out[0];
return ($rc, $resource);
} # end get_class_from_rsrc_hndl_api
#--------------------------------------------------------------------#
# build_HoAttr - Build the hash of attributes one attribute name - #
# set of attribute elements at a time. #
# #
# Parameters: #
# $attr_name in Name of the attribute to which you #
# want to add a new field (row of #
# attribute elements. #
# @$rLoAttrNames in/out Reference to an ordered list of #
# attribute names. $attr_name will be #
# added to this list if its not there. #
# %$rHoAttr in/out Reference to a hash of attributes. #
# If $attr_name is not already in this #
# hash it is added. The elements that #
# make up this attribute are pushed onto #
# the array that make up the fields #
# associated with this attribute name. #
# %$rHoAtElements in Reference to hash of an attribute's #
# elements, all these elements make up #
# one attribute: #
# {at_name} => (mc_at_name) #
# {at_id} => (mc_at_id) #
# {at_dtype} => (mc_at_dtype) #
# {at_value} => (mc_at_value) #
# $rnum in Response number, different responses #
# for same resource may have different #
# # attributes, so may need to add empty #
# entries as placeholders. #
# #
# Return: #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub build_HoAttr
{
my ($attr_name, $rLoAttrNames, $rHoAttr, $rHoAtElements, $rnum) = @_;
# Build the list of ordered attributes (@$rLoAttrNames) and a
# hash of attributes (%$rHoAttr). We need both. The list to maintain
# the order from RMC and the hash for faster and more convenient
# searching. This gets slightly more complicated since because of
# "Variety", RMC may not always return us all the attributes we ask
# for. So we will need to fill empty array entries in the hash for
# a particular attribute with elements of type CT_NONE.
#
# Build the hash of attributes
# @HoAttr = {
# <at_name> => [
# {at_name => $string, at_id => $int,
# at_dtype => $ct_data_type_t, at_value => $scalar_reference},
# {at_name => $string, at_id => $int,
# at_dtype => $ct_data_type_t, at_value => $scalar_reference},
# ...
# ],
# }
#
# For debugging to reference one element
# $rHoAttr->{$attr_name}[$row]{at_value}
my $rc = 0;
if (!(exists $$rHoAttr{$attr_name})) {
# add the new attribute to the list of ordered
# attributes
push @$rLoAttrNames, $attr_name;
# Add an empty array for this new attr name which will eventually
# hold the hashes representing the values for this attribute.
my @fields = ();
$$rHoAttr{$attr_name} = [ @fields ];
}
# We may need to add some blank entries onto the array before this
# one, if the #entries in array is not equal to the response we are
# processing. This can happen when all the responses from a query
# do not return the same exact attribute names (Variety).
# Get the #elements/attributes that have this $attr_name
# scalar($$rHoPAttr{$attr_name}) does not work
my %elements = ();
my $rLoAttr = $$rHoAttr{$attr_name};
if ($#$rLoAttr + 1 < $rnum) {
$elements{at_name} = $attr_name;
$elements{at_dtype} = CT_NONE;
for ($j = $#$rLoAttr + 1; $j < $rnum; $j++) {
push @{$$rHoAttr{$attr_name}}, { %elements };
# TODO remove this next print after testing.
# print "$main::PROGNAME, build_HoAttr: WARNING attribute consistency problem detected, executing untested code path.\n";
}
}
# Now really add this attribute's value to the HoAttr for this
# particular response.
%elements = %$rHoAtElements;
push @{$$rHoAttr{$attr_name}}, { %elements };
return $rc;
} # end build_HoAttr
#--------------------------------------------------------------------#
# get_arg_defs_api - function to get this resource's #
# structured data element definitions and build a hash indexable #
# by the element name with the element name, data type, #
# index, and value stored as data. #
# #
# Parameters: #
# $resource input Resource class name. #
# $name input An action name or attribute name or #
# empty string. Doing a qdef on an #
# action requires an action name or #
# more than one may be returned. Doing #
# a qdef_sd on a command argument usage #
# does not require a name. #
# $sd_usage input define, undefine, online, ... #
# $hash_by_name input 1 - True - Level 1 of hash should be #
# the SD element name. #
# 0 - False - Level 1 of hash should be #
# the SD element index. #
# %$rHoSDEleDef in/out Reference to a hash of an SD #
# definition. #
# key = element_name #
# data = hash #
# sd_dtype = value #
# sd_index = value #
# sd_element_name = value #
# sd_value = (undefined a place holder #
# value entered via command line) #
# @$LoSDArgNames in/out Reference to an array of SD argument #
# names. #
# #
# Return: #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub get_arg_defs_api
{
my ($resource, $name, $sd_usage, $hash_by_name, $rHoSDEleDefs,
$LoSDArgNames) = @_;
my $rc = 0;
my $i = 0;
my @lsr_out = ();
my @names = ();
if (defined $name && $name ne "") {
push @names, $name;
}
# call lsrsrcdef-api to get SD Arg info
if ($main::Trace) { print STDERR "$main::PROGNAME: calling lsrsrcdef-api\n";}
@lsr_out = `$CTBINDIR/lsrsrcdef-api -I $DELIMITER -D $DELIMITER -o ${resource}${DELIMITER}${sd_usage} 2>&1`;
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$main::PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error($DELIMITER,$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error($DELIMITER,@lsr_out);
# format the hash
my %elements = ();
my @attr_info = ();
my $line = "";
my $attr_name = "";
foreach $line (@lsr_out) {
# start fresh
%elements = ();
chomp $line;
# split off the attribute information
@attr_info = split /$DELIMITER/, $line;
$element_name = $attr_info[1];
${$LoSDArgNames}[$i] = $attr_info[1];
$i++;
$element_index = $attr_info[3];
$elements{sd_name} = $element_name;
$elements{sd_index} = $element_index;
$elements{sd_dtype} = $attr_info[2];
if ($hash_by_name) {
$$rHoSDEleDefs{$element_name} = { %elements };
}
else {
$$rHoSDEleDefs{$element_index} = { %elements };
}
} # end for each element
return $rc;
} # end get_arg_defs_api
#--------------------------------------------------------------------#
# get_sd_defs_api - function to get this resource's #
# structured data element definitions and build a hash indexable #
# by the element name with the element name, data type, #
# index, and value stored as data. #
# #
# Parameters: #
# $resource input Resource class name. #
# $class_flag input True if getting SD defs for rsrc class.#
# @$rname input Reference to the list of attribute #
# names to obtain SD infomation on. #
# %$rHoSDEleDef in/out Reference to a hash of an SD #
# definition. #
# key = element_name #
# data = hash #
# sd_dtype = value #
# sd_index = value #
# sd_element_name = value #
# sd_value = (undefined a place holder #
# value entered via command line) #
# #
# Return: #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub get_sd_defs_api
{
my ($resource, $class_flag, $name, $rHoSDEleDefs) = @_;
my $rc = 0;
my $one_name = "";
my @lsr_out = ();
my $cmd_flg = "";
my $name_opt = "";
foreach $one_name (@$name) {
$name_opt .= $DELIMITER . $one_name;
}
# use -C option for class attrs and -S for resource attrs
if ($class_flag) { $cmd_flg = "-S";}
else { $cmd_flg = "-s";}
# call lsrsrcdef-api to get SD Arg info
if ($main::Trace) { print STDERR "$main::PROGNAME: calling lsrsrcdef-api\n";}
@lsr_out = `$CTBINDIR/lsrsrcdef-api -I $DELIMITER -D $DELIMITER $cmd_flg ${resource}${name_opt} 2>&1`;
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($main::Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$main::PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error($DELIMITER,$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error($DELIMITER,@lsr_out);
# format the hash
my %elements = ();
my @attr_info = ();
my $line = "";
my $prevSDAttr = "";
my $attr_name = "";
my $attr_index = "";
foreach $line (@lsr_out) {
# split off the attribute information
chomp $line;
@attr_info = split /$DELIMITER/, $line;
$attr_name = $attr_info[0];
# start over if new attribute name
if ($attr_name ne $prevSDAttr) {
# start fresh
$$rHoSDEleDefs{$attr_name} = ();
$prevSDAttr = $attr_name;
}
%elements = ();
$elements{sd_name} = $attr_info[1];
$elements{sd_index} = $attr_info[5];
$elements{sd_dtype} = $attr_info[2];
$elements{sd_value} = $attr_info[1];
$rHoSDEleDefs->{$attr_name}->{$elements{sd_name}} =
{ %elements };
} # end for each element
return $rc;
} # end get_sd_defs_api
#--------------------------------------------------------------------#
# convert_input_value_api #
# Takes a scalar value and converts it into a format suited for #
# passing to the CT (or SR or RMC...) extensions. #
# Calls string_to_array or string_to_value_api as appropriate #
# based on the data type passed in. #
# #
# Parameters: #
# $data_type - type of the data to be converted. #
# $input_scalar - data value (scalar) to be converted. #
# $sd_definitions - reference to an array of SD definitions. Used #
# only if $data_type is an SD_PTR or #
# SD_PTR_ARRAY. #
# #
# Returns: #
# $local_rc - 0 if ok, non-zero otherwise. #
# $output_value - converted data value - could be an HV or AV ref, #
# or a 'normal' value (int, float, etc...) #
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub convert_input_value_api
{
my $data_type = shift;
my $input_scalar = shift;
# This could be either a single SD definition,
# or an array of definitions, and is only used for SD_PTR or
# SD_PTR_ARRAY
my $sd_definitions = shift;
$main::Trace5 &&
print STDERR "Entered MC_cli_utils::convert_input_value_api($data_type, $input_scalar)\n";
my $local_rc = 0;
my $output_value = 0;
if ( $data_type !~ /ARRAY/ ){
($local_rc, $output_value) =
string_to_value_api($data_type, $input_scalar, $sd_definitions);
}
elsif ( $data_type =~ /ARRAY/ ) {
($local_rc, $output_value) =
string_to_array_api($data_type, $input_scalar, $sd_definitions);
}
else {
if (!defined($data_type)) {$data_type = "<undefined>";}
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidDataType", '"'.$data_type.'"');
msgvar_restore();
return MC_CLI_USER_ERROR;
}
$main::Trace5 &&
print STDERR "Leaving MC_cli_utils::convert_input_value_api($output_value)\n";
return ($local_rc, $output_value);
} # end convert_input_value_api
#--------------------------------------------------------------------#
# build_cmd_arg_sd_api - builds the command argument SD in value_t #
# format. The format the Perl to C extensions expect based on #
# what the RMC C API expects. Verifies that each SD element in #
# the HoSDEleDefs has a value then builds in element index order #
# the value_t representation of the SD. #
# SD is represented in Perl as a complex structure. A list of #
# hashes. Where each hash represents one SD element, and it #
# contains 2 hashes representing the type and value. #
# #
# Parameters: #
# $resource input Resource name. #
# $rNameValue input Reference to array of name,value pairs.#
# $rHoSDDef input Reference to hash of command SD #
# argument element definitions for this #
# command. #
# #
# Return: #
# $rc return code. #
# @LoSD Structured data complex hash. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub build_cmd_arg_sd_api
{
my ($resource, $rNameValue, $rHoSDDef) = @_;
my ($new_element, $data_type);
my ($element_name, $element_value);
my $badrc = 0;
my $rc = 0;
my $i = 0;
foreach $new_element (@{$rNameValue->[1]}) {
$element_name = $new_element->[0];
# first check to make sure this is a valid sd element name
if (!defined($$rHoSDDef{$element_name})) {
printCEMsg("EMsgMCcliInvalidCmdArg", $element_name,
$resource, '"' . $rNameValue->[0] . '"');
$badrc = MC_CLI_USER_ERROR;
next; # continue validating rest of input
}
# Get the elements value
$data_type = $rHoSDDef->{$element_name}{sd_dtype};
# An SD cannot contain an SD
if ($data_type =~ /^CT_SD_PTR$/ || $data_type =~ /^CT_SD_PTR_ARRAY$/) {
printCEMsg("EMsgMCcliInvalidArgDataType", $resource,
$element_name, $data_type);
$rc = MC_CLI_USER_ERROR;
}
($rc, $element_value) = convert_input_value_api($data_type,
$new_element->[1]);
if ($rc != 0) {
printCEMsg("EMsgMCcliBadArgValue", $element_name,
$new_element->[1]);
if ($badrc == 0) {$badrc = $rc; }
next;
}
$rHoSDDef->{$element_name}{sd_value} = $element_value;
}
# Get the list of all the input element names in element index
# order. No guarantee that we got them from RMC in correct order
# but we have to make sure we give them to RMC in the correct order.
# Also even if RMC gave them in the correct order we stored them
# in a hash and a hash does not guarantee any order.
#my @required_element_names = get_sd_element_names($rHoSDDef);
# Make sure that all of the required elements are being
# defined.
#foreach $element_name (@required_element_names) {
# if (!defined($$rHoSDDef{$element_name}{sd_value})) {
# printCEMsg("EMsgMCcliMissingReqArg", $element_name,
# $resource, $main::PROGNAME);
# $badrc = MC_CLI_USER_ERROR;
# }
#}
# Create the structured data structure (an array of hashes
# with the type and value - with one hash representing each
# element in the SD. Make sure the order is correct.)
my @LoSD = (); # Create the array
my @required_element_names = ();
for ($i=0; $i<=$#{$rNameValue->[1]}; $i++){
push @required_element_names, ${${$rNameValue->[1]}[$i]}[0];
}
# by-pass creating @LoSD if no args specified
if ($#{$rNameValue->[1]} >=0) {
foreach $element_name (@required_element_names) {
my %element = ();
$element{type} = $$rHoSDDef{$element_name}{sd_dtype};
$element{value} = $$rHoSDDef{$element_name}{sd_value};
$element{name} = $element_name;
push @LoSD, { %element };
}
}
return($badrc, @LoSD);
} # end build_cmd_arg_sd_api
#--------------------------------------------------------------------#
# get_local_node : Returns a string that is the resolved node name #
# of where the command is running. #
# #
# Paramaters: #
# None. #
# #
# Returns: #
# local_node Resolved name of the node the command is #
# running on. #
# #
# Global Variables: #
#--------------------------------------------------------------------#
sub get_local_node
{
my $local_node = ""; # node command runs on
my $hname = ""; # used by gethost
my $haliases = ""; # used by gethost
my $haddrtype = ""; # used by gethost
my $hlength = 0; # used by gethost
my @haddrs = (); # used by gethost
# get the name of the node you're on
$local_node = `/bin/hostname`;
chomp($local_node);
# resolve the name
($hname, $haliases, $haddrtype, $hlength, @haddrs) = gethostbyname($local_node);
$local_node = $hname;
# return the resolved name
return($local_node);
} # end of get_local_node
#--------------------------------------------------------------------#
# translate_lsAOpt - look at @ARGV and translate old -a attribute #
# option to the new attribute -A option by modifying the contents. #
# #
# Parameters: in/out command ARGV. #
#--------------------------------------------------------------------#
sub translate_lsAOpt
{
my @cmd_args = (); # commands args
my $cmd_part = ""; # part of command
my $i=0;
# get command args passed in
@cmd_args = @_;
# look through the original command arguments
for ($i=0;$i <= $#cmd_args; $i++) {
# change a -a with a p,d, or b operand to -A with the operand
if ($cmd_args[$i] =~ /^-a[pdb]$/) {
#$cmd_args[$i] = "-A" . substr($cmd_args[$i],2,length $cmd_args[$i]);
$cmd_args[$i] =~ s/-a/-A/;
}
# see if a -a alone is followed by a p,d, or b. Change to -A if it does
else {
if (($cmd_args[$i] =~ /^-a$/) && ($i < $#cmd_args)) {
if ($cmd_args[$i+1] =~ /^[pdb]$/) {
$cmd_args[$i] = "-A";
}
}
}
}
# return the (changed) @ARGV
return (@cmd_args);
} # end of translate_lsAOpt
#--------------------------------------------------------------------#
# error_exit - performs required cleanup and exits. #
# Parameters: #
# $badrc in Bad return code - bad enough to exit #
# processing of this command. #
# Exit: #
# 1 MC_CLI_RMC_ERROR Underlying RMC error. #
# 2 MC_CLI_ERROR Unexpected error in the command script.#
# 3 MC_CLI_BAD_FLAG Input flag error. #
# 4 MC_CLI_BAD_OPERAND Input operand error. #
# 5 MC_CLI_USER_ERROR User error. #
# 6 MC_CLI_NO_RSRC_FOUND No resources found. #
# #
# Global References: #
# $main::Cleanup. in Hash indicating what needs to be #
# cleaned up. #
# if {Session} defined - value is #
# session that must terminate. #
# terminate. #
#--------------------------------------------------------------------#
sub error_exit
{
my ($badrc) = @_;
# If a session with RMC was initialized terminate it
# we do not care about the term_session return code since we
# already had an error that is bad enough we are exiting
if ($main::Cleanup{Session}) {
my $rc = term_session($main::Cleanup{Session});
}
SWITCH: {
($badrc == MC_CLI_RMC_ERROR) && exit($badrc);
($badrc == MC_CLI_ERROR) && exit($badrc);
($badrc == MC_CLI_BAD_FLAG) && exit($badrc);
($badrc == MC_CLI_BAD_OPERAND) && exit($badrc);
($badrc == MC_CLI_USER_ERROR) && exit($badrc);
($badrc == MC_CLI_NO_RSRC_FOUND) && exit($badrc);
# At this point all return codes should have been converted to
# a valid RMC CLI return code. But if one wasn't write an
# error message.
printCEMsg("EMsgMCcliBadRC", $badrc);
exit(MC_CLI_ERROR);
} # end switch
} # end error_exit
#--------------------------------------------------------------------#
# printCIMsg : Calls $LSMSG to print out the common cluster #
# RMC CLI information messages with the required paramaters. #
# Messages printed to stdout. #
# This subroutine is like printIMsg except it is used to print #
# the common MC CLI messages which are in the mccli message set. #
# #
# Paramaters: #
# $msg in Message mnemonic / message number in a sense. #
# $optargs in Extra arguments/parameters to send to $LSMSG. #
# #
# Returns: None. #
# #
# Global Variables: #
# $main::Trace in Prints extra info when trace is on. #
# $LSMSG in Path & Command to display messages. #
# $MSGCAT in MC CLI Message catalogue. #
# $MSGSET in MC CLI common message set "mccli". #
#--------------------------------------------------------------------#
sub printCIMsg
{
my ($msg, @optargs) = @_;
my ($optarg, $optargs);
$main::Trace &&
print STDERR "$LSMSG $MSGSET $MSGCAT $msg @optargs\n";
# Keep the args to LSMSG separate by separating with single quotes
# but must replace internal single quotes with blanks or get an error.
# Must escape internal double quotes for the system call.
foreach $optarg (@optargs) {
$optarg =~ s/'/\<U\+0027\>/g;
$optarg =~ s/"/\\"/g;
}
$optargs = "'" . join("' '",@optargs) . "'";
(scalar @optargs > 0) ?
system "$LSMSG $MSGSET $MSGCAT $msg $optargs | /bin/sed \"s/\<U\+0027\>/'/g\"" :
system "$LSMSG $MSGSET $MSGCAT $msg";
return;
} # end printCIMsg
#--------------------------------------------------------------------#
# printCEMsg : Calls $LSMSG to print out the common cluster #
# RMC CLI error messages with the required paramaters. #
# Messages printed to stderr. #
# This subroutine is like printEMsg except it is used to print #
# the common MC CLI messages which are in the mccli message set #
# and it prefixes the message with the appropriate program name. #
# #
# Paramaters: #
# $msg in Message mnemonic / message number in a sense. #
# $optargs in Extra arguments/parameters to send to $LSMSG. #
# #
# Returns: None. #
# #
# Global Variables: #
# $main::Trace in Prints extra info when trace is on. #
# $main::PROGNAME in Calling program/command for error message. #
# $LSMSG in Path and command to display messages. #
# $MSGCAT in CU CLI Message catalogue. #
# $MSGSET in CU CLI common message set "cucli". #
#--------------------------------------------------------------------#
sub printCEMsg
{
my ($msg, @optargs) = @_;
my ($optarg, $optargs);
$main::Trace &&
print STDERR "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME @optargs\n";
# Keep the args to LSMSG separate by separating with single quotes
# but must replace internal single quotes with blanks or get an error.
# Must escape internal double quotes for the system call.
foreach $optarg (@optargs) {
$optarg =~ s/'/\<U\+0027\>/g;
$optarg =~ s/"/\\"/g;
}
$optargs = "'" . join("' '",@optargs) . "'";
(scalar @optargs > 0) ?
system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME $optargs | /bin/sed \"s/\<U\+0027\>/'/g\" 1>&2" :
system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME 1>&2";
return;
} # end printCEMsg
#--------------------------------------------------------------------#
# process_exit_code: returns 0, the signal exit code, or the process #
# exit code from the called process. This is used to examine the #
# exit codes that perl uses for called processes. #
# The exit value of the subprocess is in the high byte (>>8) #
# The low byte has the signal the process died from (if any)(& 127)#
# To be complete, core dumps are indicated with (& 128) (not used) #
# #
# Parameters: #
# exit_code The exit code to be examined. #
# #
# Returns: #
# process_exit_code 0, signal, or process exit code. #
# #
# Global Variables: #
#--------------------------------------------------------------------#
sub process_exit_code
{
my $exit_code = shift(@_); # the exit code to check
my $process_signal_exit_code = 0; # signal exit code, if any
my $process_exit_code = 0; # what to return
# if it's 0, wonderful.
if ($exit_code == 0) { return (0);};
# check for signal process died from, if any
$process_signal_exit_code = $exit_code & 127;
# if there was a signal, return it
if ($process_signal_exit_code > 0) {
printCEMsg("EMsgMCcliBadRC",$process_signal_exit_code);
return ($process_signal_exit_code);
}
# otherwise return the process exit code
$process_exit_code = $exit_code >> 8;
return ($process_exit_code);
} # end process_exit_code
#--------------------------------------------------------------------#
# remove_api_error - Scans the input varaible for error messages #
# found by the c-api command. The c-api command errors are #
# found by searching each output line for "ERROR" at the #
# beginning of the line. An array is returned that is the same as #
# the input array except that the error messages are removed. #
# In scanning through the output, any escaped new lines are #
# replaced with new lines (91280). #
# #
# Parameters: #
# $delimiter The delimiter used in the error string. #
# @command_output The output from the command. #
# #
# Returns: #
# @errorless_output The original @command_output array contents #
# with the errors removed. #
# #
# Global Variables: #
#--------------------------------------------------------------------#
sub remove_api_error
{
my $delimiter = shift(@_); # output delimiter
my @command_output = @_; # command output to scan
my @errorless_output = (); # errors removed
my $line = "";
my $junk = "";
my $partial_data = ""; # for split data
my $need_data = $FALSE; # for split data
# scan each line for ERROR
foreach $line (@command_output) {
# replace any escaped new line with a new line
$line =~ s/\\n/\n/g;
# if it doesn't start with ERROR, save it
if (!($line =~ /^ERROR${delimiter}.*/)) {
# it could be all data or if STDERR and STDOUT collided
# it may be data with error message in it or partial data
# completing a previous data line
# does an error message exist in the data?
if ($line =~ /ERROR${delimiter}/) {
# error message within the data
# take it out and remember to look for the rest
($partial_data, $junk) = split /ERROR${delimiter}/, $line;
$need_data = $TRUE;
}
else {
# it's all data or it's partial data
if ($need_data){
# it's data that started previously
$partial_data .= $line;
push @errorless_output, $partial_data;
$need_data = $FALSE;
}
else {
# it's all data
# put it in the errorless array
push @errorless_output, $line;
$need_data = $FALSE;
}
}
}
}
return (@errorless_output);
} # end of remove_api_error
#--------------------------------------------------------------------#
# process_api_error - Scans the input varaible for error messages #
# found by the c-api command. The c-api command errors are #
# found by searching each output line for "ERROR" at the #
# beginning of the line. The error message printed is the last #
# double colon delimited string. #
# #
# Parameters: #
# $delimiter The delimiter used in the error string. #
# $rc The return code from the c-api call. #
# @command_output The output from the command. #
# #
# Returns: #
# None. #
# #
# Global Variables: #
#--------------------------------------------------------------------#
sub process_api_error
{
my $delimiter = shift(@_); # output delimiter
my $api_rc = shift(@_); # rc from c-api call
my @command_output = @_; # command output to scan
my $error_count = 0; # number of error messages
my $line = "";
my $line2 = "";
# scan each line for ERROR
foreach $line (@command_output) {
# does it start with ERROR?
if ($line =~ /^ERROR.*/) {
# split it apart based on double colons
# last one should be error message
@error_parts = split /$delimiter/, $line;
# replace any escaped new lines with new lines
$error_parts[$#error_parts] =~ s/\\n/\n/g;
# get rid of any beginning/ending quote that comes from
# having CT_CLI_QUOTE_STRING turned on (sometimes)
if ( defined $ENV{CT_CLI_QUOTE_STRING} && $ENV{CT_CLI_QUOTE_STRING}==1) {
$error_parts[$#error_parts] =~ s/^\"//;
$error_parts[$#error_parts] =~ s/\"$//;
#$error_parts[$#error_parts] =~ s/\\\"/\"/g;
$error_parts[$#error_parts] = unescape_chars($error_parts[$#error_parts]);
}
# last one should be error message. print it to STDERR.
print STDERR $error_parts[$#error_parts];
$error_count++;
}
else {
# does it have ERROR in it somewhere (in case STDERR/STDOUT collided) ?
if ($line =~ /ERROR${delimiter}/) {
# get rid of the beginning part up to ERROR
$line =~ s/.*ERROR${delimiter}/ERROR${delimiter}/;
# now do same stuff as above for error messages
# split it apart based on double colons
# last one should be error message
@error_parts = split /$delimiter/, $line;
# replace any escaped new lines with new lines
$error_parts[$#error_parts] =~ s/\\n/\n/g;
# get rid of any beginning/ending quote that comes from
# having CT_CLI_QUOTE_STRING turned on (sometimes)
if ( defined $ENV{CT_CLI_QUOTE_STRING} && $ENV{CT_CLI_QUOTE_STRING}==1) {
$error_parts[$#error_parts] =~ s/^\"//;
$error_parts[$#error_parts] =~ s/\"$//;
#$error_parts[$#error_parts] =~ s/\\\"/\"/g;
$error_parts[$#error_parts] = unescape_chars($error_parts[$#error_parts]);
}
# last one should be error message. print it to STDERR.
print STDERR $error_parts[$#error_parts];
$error_count++;
}
}
}
# print unexpected error if api rc was not 0 and no messages were displayed
if (($error_count == 0) && ($api_rc != 0)) {
printCEMsg("EMsgMCcliBadRC",$api_rc);
}
} # end of process_api_error
#--------------------------------------------------------------------#
# End Exported Subroutines (with @EXPORT_OK, -> on demand). #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# error_check - checks the return code from the RMC function and #
# the error response return code. If an error is detected #
# appropriate error messages will be displayed. #
# #
# Parameters: #
# $rmc_function in Name of the rmc function that was #
# called and whose error code we are #
# checking. #
# $rmc_class in The rmc resource class name. #
# $response in RMC response. #
# $rmc_rc in The rmc function return code. #
# $error in The error response. #
# #
# Return: #
# $rc return code. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub error_check
{
my ($rmc_function, $rmc_class, $response, $rmc_rc, $error) = @_;
my $rc = 0;
my $err_rc = $error->errnum();
if ($rmc_rc != 0) {
if ($rmc_rc == MC_ESESSREFUSED) {
my $rmc_contact = $ENV{CT_CONTACT};
# TODO: In future use a unique message for this problem
# allowing for proper NLS translation of "local_node"
# or display the error message via ct_cu.h error structure
if (!defined $rmc_contact) {
$rmc_contact = "\"local_node\"";
}
elsif ($rmc_contact ne "") {
$rmc_contact = "CT_CONTACT=" . $rmc_contact;
}
else {
$rmc_contact = "CT_CONTACT=\"\"";
}
printCEMsg("EMsgMCcliInvalidSess", $rmc_contact);
$rc = MC_CLI_USER_ERROR;
}
elsif ($rmc_rc == MC_EAUTHENTICATE) {
printCEMsg("EMsgMCcliNotAuthenticated");
$rc = MC_CLI_USER_ERROR;
}
elsif ($rmc_rc == MC_EAUTHORIZATION) {
printCEMsg("EMsgMCcliNotAuthorized");
$rc = MC_CLI_USER_ERROR;
}
else {
if ($rmc_function eq "mc_enumerate_resources_bp") {
printCEMsg("EMsgMCcliEnumRsrcError", $rmc_class);
}
my $rmc_rc_hex = sprintf "0x%8.8lx", $rmc_rc;
printCEMsg("EMsgMCcliMCFunctionFailure", $rmc_function,
$rmc_rc, $rmc_rc_hex);
$rc = MC_CLI_RMC_ERROR;
return $rc;
}
}
# Check the errnum in each of the RMC responses
for (my $r = 0; $r < $response->array_count; $r++) {
if ($r > 0) {
$response->error($error, $r);
$err_rc = $error->errnum();
}
if ($err_rc != 0) {
if ($err_rc == CT::MCerr::RMC_ECLASSNOTDEFINED) {
printCEMsg("EMsgMCcliClassNotDef", $rmc_class);
$rc = MC_CLI_USER_ERROR;
}
elsif ($err_rc == CT::MCerr::RMC_EBADRSRCHANDLE ||
$err_rc == CT::RM::RM_EINVRESHANDLE ||
$err_rc == CT::RM::RM_EINVALIDHANDLE) {
printCEMsg("EMsgMCcliInvalidRsrcHandle", $rmc_class);
$rc = MC_CLI_USER_ERROR;
}
elsif ($err_rc == CT::MCerr::RMC_EACCESS) {
print STDERR $error->error_msg;
$rc = MC_CLI_USER_ERROR;
}
elsif ($err_rc >= 0x60000 && $err_rc <= 0x6ffff) {
# Selection string errors are in this range
printCEMsg("EMsgMCcliSelectStrError");
print STDERR $error->error_msg;
$rc = MC_CLI_USER_ERROR;
}
else {
if ($rmc_function eq "mc_enumerate_resources_bp") {
printCEMsg("EMsgMCcliEnumRsrcError", $rmc_class);
}
my $err_rc_hex = sprintf "0x%8.8lx", $err_rc;
printCEMsg("EMsgMCcliMCFunctionFailure", $rmc_function,
$err_rc, $err_rc_hex);
print STDERR $error->error_msg;
$rc = MC_CLI_RMC_ERROR;
}
} # end if
} # end for
return $rc;
} # end error_check
#--------------------------------------------------------------------#
# format_p_attr_defs - formats the persistent attributes definitions #
# into a complex hash (%rHoPAttrDefs). This hash can be used to #
# quickly lookup whether a particular attribute name is a #
# persistent attribute. In addition if more specific definition #
# information is needed for this attribute such as its data type, #
# id, properties or default value - they are all stored in the #
# hash. #
# Use the following syntax to access the persistent attribute #
# definitions for a resource. #
# for each $attribute @$rLoPAttrDefs { #
# $HoPAttrDefs{$attribute}{at_id} - attribute id. #
# $HoPAttrDefs{$attribute}{at_dtype} - attribute data type. #
# $HoPAttrDefs{$attribute}{at_properties} - attr properties. #
# $HoPAttrDefs{$attribute}{at_dvalue} - attr default value. #
# } #
# #
# Parameters: #
# $resource input Resource Name #
# $response input Response data structure. #
# $req_properties input Requested properties - only put the #
# attributes in the hash that have these #
# requested properties. #
# @$r_req_attributes input Reference to list of required attrs #
# that should be returned even if they #
# do not have the required property. #
# $rLoPAttr in/out The list of ordered persistent attr #
# names in order returned in responses. #
# $rHoPAttrDefs in/out The hash of persistent attribute defs. #
# #
# Return: #
# None. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub format_p_attr_defs
{
my($resource, $response, $req_properties, $r_req_attributes,
$rLoPAttr, $rHoPAttrDefs) = @_;
my($attr_name, $r);
# format each of the attributes in the response (after filtering)
# into a complex hash of attribute names and definitions. Allowing
# easier access to the data...
my %elements = ();
my $response_cnt = $response->array_count;
for ($r = 0; $r < $response_cnt; $r++) {
%elements = ();
my $attr_name = $response->program_name($r);
# Filter out any attribute that does not have the required
# (requested) properties - unless that attribute is listed
# in the list of required (requested) attributes.
(required_attr($attr_name, $response->properties($r),
$r_req_attributes, $req_properties)) || next;
$elements{at_name} = $attr_name;
$elements{at_id} = $response->attribute_id($r);
$elements{at_properties} = $response->properties($r);
$elements{at_dtype} = $response->data_type($r);
$elements{at_dvalue} = $response->default_value($r);
push @$rLoPAttr, $attr_name;
$$rHoPAttrDefs{$attr_name} = { %elements };
} # end for responses
return;
} # end of format_p_attr_defs
#--------------------------------------------------------------------#
# format_d_attr_defs - formats the dynamic attributes definitions #
# into a complex hash (%rHoDAttrDefs). This hash can be used to #
# quickly lookup whether a particular attribute name is a #
# dynamic attribute. In addition if more specific definition #
# information is needed for this attribute such as its data type, #
# id, properties - they are all stored in the hash. #
# Use the following syntax to access the dynamic attribute #
# definitions for a resource. #
# for each $attribute @$rLoDAttrDefs { #
# $HoDAttrDefs{$attribute}{at_id} - attribute id. #
# $HoDAttrDefs{$attribute}{at_dtype} - attribute data type. #
# $HoDAttrDefs{$attribute}{at_properties} - attr properties. #
# } #
# #
# Parameters: #
# $resource input Resource Name #
# $response input Response data structure. #
# $req_properties input Requested properties - only put the #
# attributes in the hash that have these #
# requested properties. #
# @$r_req_attributes input Reference to list of required attrs #
# that should be returned even if they #
# do not have the required property. #
# $rLoDAttr in/out The list of ordered dynamic attr #
# names in order returned in responses. #
# $rHoDAttrDefs in/out The hash of dynamic attribute defs. #
# #
# Return: #
# None. #
# #
# Global References: #
# None. #
#--------------------------------------------------------------------#
sub format_d_attr_defs
{
my($resource, $response, $req_properties, $r_req_attributes,
$rLoDAttr, $rHoDAttrDefs) = @_;
my($attr_name, $r);
# format each of the attributes in the response (after filtering)
# into a complex hash of attribute names and definitions. Allowing
# easier access to the data...
my %elements = ();
my $response_cnt = $response->array_count;
for ($r = 0; $r < $response_cnt; $r++) {
%elements = ();
my $attr_name = $response->program_name($r);
# Filter out any attribute that does not have the required
# (requested) properties - unless that attribute is listed
# in the list of required (requested) attributes.
(required_attr($attr_name, $response->properties($r),
$r_req_attributes, $req_properties)) || next;
# Filter out any attribute that is a Quantum
# (has a data_type of CT_NONE) since we can't qurey there
# attr values - RMC complains.
($response->data_type($r) == CT_NONE) && next;
$elements{at_name} = $attr_name;
$elements{at_id} = $response->attribute_id($r);
$elements{at_properties} = $response->properties($r);
$elements{at_dtype} = $response->data_type($r);
push @$rLoDAttr, $attr_name;
$$rHoDAttrDefs{$attr_name} = { %elements };
} # end for responses
return;
} # end of format_d_attr_defs
#--------------------------------------------------------------------#
# string_to_value_api #
# Takes a scalar and converts it to one of the simple #
# ct_data_type_t types. #
# #
# Parameters: #
# $data_type - type of scalar to be converted. #
# $in_scalar - scalar to be converted. #
# $sd_definition - array of SD definitions, only used if #
# $data_type is a CT_SD_PTR. #
# #
# Returns: #
# $local_rc - 0 if success, nonzero otherwise. #
# $output_value - converted scalar or reference to converted value.#
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub string_to_value_api
{
my ($data_type, $in_scalar, $sd_definition) = @_;
$main::Trace5 &&
print STDERR "Entered MC_cli_utils::string_to_value_api($data_type, $in_scalar)\n";
my $local_rc = 0;
my $output_value;
my $strlen = 0; # 72970
SWITCH: {
# Convert the value according to it's type
if ($data_type =~ /^CT_RSRC_HANDLE_PTR$/) {
($local_rc, $output_value) =
string_to_rsrc_handle_api($in_scalar);
last SWITCH;
}
if ($data_type =~ /^CT_BINARY_PTR$/) {
# change any 0X to 0x
$in_scalar =~ s/0X/0x/g;
($local_rc, $output_value) =
string_to_binary_hash($in_scalar);
$in_scalar =~ s/^\"//;
$in_scalar =~ s/\"$//;
# get rid of extra 0x's if more than one word
$in_scalar =~ s/ +0x//g;
# put in left 0 if there's an odd number of digits
if (length($in_scalar)%2) {
$in_scalar =~ s/^0x/0x0/;
}
$output_value = $in_scalar;
last SWITCH;
}
#if ( (($data_type =~ /^CT_INT64$/) or ($data_type =~ /^CT_UINT64$/))
# and ($in_scalar !~ /^-*\d+$/) ) {
# $local_rc = MC_CLI_USER_ERROR;
# msgvar_save_CT();
# printCEMsg("EMsgCTcliInvalid64BitNum", $in_scalar);
# msgvar_restore();
# last SWITCH;
#}
if ( (($data_type =~ /^CT_UINT32$/) or ($data_type =~ /^CT_UINT64$/))
and ($in_scalar < 0) ) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidUnsignedNum", $in_scalar);
msgvar_restore();
$local_rc = MC_CLI_USER_ERROR;
last SWITCH;
}
if ($data_type =~ /^CT_SD_PTR$/) {
($local_rc, $output_value) = string_to_sd_api($in_scalar,
$sd_definition);
last SWITCH;
}
if ($data_type =~ /^CT_SBS_PTR$/) {
$local_rc = MC_CLI_ERROR;
# TODO: This message may be removed if the data type ever is
$main::Trace5 && print "$main::PROGNAME: CT_SBS_PTR not supported by the CLI\n";
last SWITCH;
}
if ($data_type =~ /^CT_NONE$/) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidDataType", "CT_NONE");
msgvar_restore();
return MC_CLI_USER_ERROR;
}
if ($data_type =~ /^CT_UNKNOWN$/) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidDataType", "CT_UNKNOWN");
msgvar_restore();
return MC_CLI_USER_ERROR;
}
if ($data_type =~ /^CT_CHAR_PTR$/) {
# if there's a comma in the string, make sure the whole thing
# has quotes around it
if ( ($in_scalar =~ /,/ ) || ($in_scalar =~ /'/ ) ) {
if ($in_scalar !~ /^\"/) {$in_scalar =~ s/^/\"/;}
if ($in_scalar !~ /\"$/) {$in_scalar =~ s/$/\"/;}
}
else {
# remove leading/trailing double quotes
if (($in_scalar =~ /^\"/) && ($in_scalar =~ /\"$/)) {
$in_scalar =~ s/^\"//;
$in_scalar =~ s/\"$//;
}
}
$output_value = $in_scalar;
last SWITCH;
}
# Default - return the basic value with no conversion;
# $output_value = $in_scalar; # removed by 72970
$strlen = length $in_scalar; # 72970
# remove leading/trailing double quotes # 72970
if (($in_scalar =~ /^\"/) && ($in_scalar =~ /\"$/)) { # 72970
$output_value = substr($in_scalar,1,$strlen-2); # 72970
} # 72970
else { # 72970
$output_value = $in_scalar; # 72970
} # 72970
}
$main::Trace5 &&
print STDERR "Leaving MC_cli_utils::string_to_value_api($local_rc, $output_value)\n";
# Return only the $local_rc if it's set to something other than 0.
($local_rc == 0) ?
return ($local_rc, $output_value):
return ($local_rc);
} # end string_to_value_api
#--------------------------------------------------------------------#
# string_to_rsrc_handle_api: #
# Given an input string of up to 6 hexadecimal values, checks that #
# the values appear to be in a valid resource handle format. #
# #
# Individual hex entries that are shorter than the required number #
# digits for that position are buffered to the left by '00' to the #
# left by '00.' Longer than 8 digits are considered an error. #
# #
# Parameters: #
# $handle resource handle to be put to an array #
# #
# Returns: #
# $local_rc 0 if success, 1 if invalid hex value. #
# $RH_string resource handle. #
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub string_to_rsrc_handle_api
{
my ($handle) = @_;
# Set up local variables
my @output_array = ();
my $local_rc = 0;
my $value = "";
my $entry ="";
my $i = 0;
$main::Trace5 &&
print STDERR "Entered CT_cli_input_utils::string_to_rsrc_handle($handle)\n";
# change any 0X to 0x
$handle =~ s/0X/0x/g;
# get rid of any leading/trailing quotes
$handle =~ s/^[\"\']//;
$handle =~ s/[\"\']$//;
# If the input parameter is undefined, then exit immediately
if (!defined($handle)) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidRsrcHndl");
msgvar_restore();
$main::Trace5 &&
print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n";
return MC_CLI_USER_ERROR;
}
# in case someone had a zero, change it to 0x0000 0x0000 ..... for mkrsrc-api
if ($handle =~ /^0$/) {
$handle = "0x0000 0x0000 0x00000000 0x00000000 0x00000000 0x00000000";
}
if ($handle =~ / /) {
@output_array = split / /, $handle;
}
else { @output_array = $handle; }
if (scalar(@output_array) <= 6) {
for ($i=scalar(@output_array); $i<6; $i++) {
$output_array[$i] = 0;
}
}
else {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidRsrcHndl");
msgvar_restore();
$main::Trace5 &&
print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n";
return MC_CLI_USER_ERROR;
}
$i=0;
foreach $entry (@output_array) {
# Trim and check the string contains only hexadecimal values
($local_rc, $entry) = trim_hex_value($entry);
($local_rc == 0) || last;
if (($i == 0 || $i == 1) && (length($entry) > 4)) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidRsrcHndl");
msgvar_restore();
$local_rc = MC_CLI_USER_ERROR;
last;
}
elsif (length($entry) > 8) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidRsrcHndl");
msgvar_restore();
$local_rc = MC_CLI_USER_ERROR;
last;
}
$output_array[$i] = hex $output_array[$i];
$i++;
}
$main::Trace5 &&
print STDERR "Leaving CT_cli_input_utils::string_to_rsrc_handle\n";
# Return the array if there were no errors
($local_rc != 0) ? return $local_rc :
return ($local_rc, $handle);
} # end string_to_rhandle_api
#--------------------------------------------------------------------#
# string_to_array_api: #
# Takes a scalar and converts it to one of the array #
# ct_data_type_t types. #
# #
# Parameters: #
# $data_type - type of scalar to be converted. #
# $in_scalar - scalar to be converted. #
# $sd_definition_array - array of SD definitions, only used if #
# $data_type is a CT_SD_PTR_ARRAY. #
# #
# Returns: #
# $local_rc - 0 if success, nonzero otherwise. #
# \@output_array - array from converted scalar input. #
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub string_to_array_api
{
my ($data_type, $in_scalar, $sd_definition_array) = @_;
$main::Trace5 &&
print STDERR "Entered MC_cli_utils::string_to_array_api($data_type)\n";
my $local_rc = 0;
my $work_scalar;
my @work_array = ();
my @output_array = ();
my @output_array2 = (); # 72970
my @output_arrayb = ();
my $ind = 0;
my $split_up = 1;
my $new_entry = ""; # 72970
my $strlen = 0; # 72970
# Check to see if an array or single string was passed in
if (($in_scalar =~ /^{/) && ($in_scalar =~ /}$/)) {
# Strip off the outer braces:
$in_scalar =~ s/\s*$//;
$work_scalar = substr($in_scalar, 1, length($in_scalar) - 2);
}
else {
$split_up = 0;
}
SWITCH: {
# Convert the value according to it's type
if ($data_type =~ /^CT_RSRC_HANDLE_PTR_ARRAY$/ ) {
# Can split on the comma still, then pass the
if ($split_up == 1) {
@work_array = split /\s*,\s*/, $work_scalar;
}
else {
# Values are coming in array format already
@work_array = @$in_scalar;
}
$ind = 0;
foreach $entry (@work_array) {
($local_rc, $output_array[$ind++]) =
string_to_rsrc_handle_api($entry);
# Return immediately if there was an error
# Error messages handled in string_to_rsrc_handle
if ($local_rc != 0) { return $local_rc; }
}
last SWITCH;
}
if ($data_type =~ /^CT_BINARY_PTR_ARRAY$/ ) {
if ($split_up == 1) {
@work_array = split /\s*,\s*/, $work_scalar;
}
else {
# Values are coming in array format already
@work_array = @$in_scalar;
}
foreach $entry (@work_array) {
# change any 0X to 0x
$entry =~ s/0X/0x/g;
($local_rc, $output_arrayb[$ind]) =
string_to_binary_hash($entry);
# if it's ok, use original format
# but remove quotes
$output_array[$ind] = $work_array[$ind];
$output_array[$ind] =~ s/^\"//;
$output_array[$ind] =~ s/\"$//;
# get rid of extra 0x's if more than one word
$output_array[$ind] =~ s/ +0x//g;
# put in left 0 if there's an odd number of digits
if (length($output_array[$ind])%2) {
$output_array[$ind] =~ s/^0x/0x0/;
}
$ind++;
# Return immediately if there was an error
if ($local_rc != 0) { return $local_rc; }
}
last SWITCH;
}
if ($data_type =~ /^CT_CHAR_PTR_ARRAY$/ ) {
# @output_array = string_to_str_array($work_scalar);
if ($split_up == 1) {
# @output_array = parse_line(",", 1, $work_scalar);
@output_array2 = parse_line(",", 1, $work_scalar); # 72970
foreach $entry (@output_array2) { # 72970
$strlen = length $entry; # 72970
# if there's a comma in the string, make sure the whole thing
# has quotes around it
if ( ($entry =~ /,/ ) || ($entry =~ /'/ ) ) {
if ($entry !~ /^\"/) {$entry =~ s/^/\"/;}
if ($entry !~ /\"$/) {$entry =~ s/$/\"/;}
push (@output_array, $entry);
}
else {
# remove leading/trailing double quotes # 72970
if (($entry =~ /^\"/) && ($entry =~ /\"$/)) { # 72970
$new_entry = substr($entry,1,$strlen-2); # 72970
push (@output_array, $new_entry); # 72970
} # 72970
else { # 72970
push (@output_array, $entry); # 75144
} # 72970
}
} # end foreach # 72970
}
else {
@output_array = @$in_scalar;
}
last SWITCH;
}
if ($data_type =~ /^CT_SD_PTR_ARRAY$/ ) {
# This will never come in as an array.
($local_rc, @output_array) = string_to_sd_array_api(
$work_scalar, $sd_definition_array);
last SWITCH;
}
# if ($data_type == CT_SBS_PTR_ARRAY) {
# $local_rc = CT_CLI_ERROR;
# $main::Trace5 && print "$main::PROGNAME: CT_SBS_PTR_ARRAY not supported by the CLI\n";
# last SWITCH;
# }
# Default - this will work for any type that doesn't
# contain nested braces, brackets or double quotation marks
# For int, uint, float 32/64 types.
if ($split_up == 1) {
@output_array = split /\s*,\s*/, $work_scalar;
}
else {
if (scalar(@$in_scalar) > 0) {
# Values are coming in array format already
@output_array = @$in_scalar;
}
else {
# Have single entry array
@output_array = $in_scalar;
}
}
my $ind = 0;
# Check the UINT status
if (($data_type =~ /^CT_UINT32_ARRAY$/ ) || ($data_type =~ /^CT_UINT64_ARRAY$/ ) ){
for ($ind = 0; $ind < (scalar(@output_array)); $ind++) {
if ($output_array[$ind] < 0) {
msgvar_save_CT();
printCEMsg("EMsgCTcliInvalidUnsignedNum", $output_array[$ind]);
msgvar_restore();
return MC_CLI_USER_ERROR;
}
}
}
}
$main::Trace5 &&
print STDERR "Leaving MC_cli_utils::string_to_array_api($local_rc)\n";
# Return only the $local_rc if it's set to something other than 0.
($local_rc == 0) ?
return ($local_rc, \@output_array):
return ($local_rc);
} # end string_to_array_api
#--------------------------------------------------------------------#
# string_to_sd_api: #
# Takes an input SD (minus the outer []) in the form of a string #
# and another comma-delimited list of the data types of each SD #
# entry, converts the values in the string to the appropriate #
# Perl data types via convert_input_value, then creates an array #
# of hashes containing the SD elements. #
# #
# The $sd_defn value is currently expected to contain the enum #
# value from ct_data_type_t. Use CT_cli_utils::string_to_data_type #
# to convert the values before passing them in to this sub. #
# #
# Each SD entry looks like: #
# %sd_entry = {"type"=>data type, "value"=>data value}; #
# #
# Parameters: #
# $input_sd - string containing the SD to be converted. #
# $sd_defn - reference to an array of SD data types. #
# #
# Returns: #
# $local_rc - 0 if success, nonzero otherwise. #
# \@sd_output - SD data converted from the input string. #
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested. #
#--------------------------------------------------------------------#
sub string_to_sd_api
{
my ($input_sd, $sd_defn) = @_;
use Text::ParseWords;
$main::Trace5 &&
print STDERR "Entered MC_cli_utils::string_to_sd_api($input_sd, $sd_defn)\n";
# Set up local variables
my @sd_output = ();
my $temp_str = "";
my $local_rc = 0;
my $ind = 0;
my ($chr, $temp_string, $converted_value);
$input_sd =~ s/^\s*\[//;
$input_sd =~ s/\]\s*$//;
# Check to see if there are any arrays in the SD. If not,
# then use Text::ParseWords, parse_line
if ($input_sd !~ /{.*}/) {
# The '0' is to strip off outer quotation marks
my @temp_array = parse_line(",", 1, $input_sd);
foreach $token ( @temp_array) {
($local_rc, $converted_string) =
convert_input_value_api($sd_defn->[$ind], $token);
$sd_output[$ind++] = {"type"=>$sd_defn->[$ind],
"value"=>$converted_string};
}
}
else {
# Split out all the {} entries.
# This and quotation marks are the only thing expected in an SD.
# parse_line takes care of the quotation marks
my $offset = 0;
# The /s allows '.' to match a newline character
my $temp = [$input_sd =~ /(.*?)(\{.*?})(.*)/s];
foreach $entry (@$temp) {
if ($entry =~ /^{.*?}$/) {
$offset++;
next;
}
if ($entry =~ /{.*?}/) {
my $entry_temp = [$entry =~ /(.*?)(\{.*?})(.*)/s];
my $temp_len = scalar(@$temp);
splice(@$temp, $offset, $temp_len-$offset, @$entry_temp);
$offset++;
}
else { $offset++; }
}
$ind = 0;
foreach $entry (@$temp) {
# Remove any leading or trailing ','
$entry =~ s/^,\s*//;
$entry =~ s/,\s*$//;
if ($entry eq "") { next; }
if ($entry =~ /{.*?}/) {
($local_rc, $converted_value) =
convert_input_value_api($sd_defn->[$ind], $entry);
$sd_output[$ind++] = {"type"=>$sd_defn->[$ind],
"value"=>$converted_value};
}
else {
# The '0' is to keep the outer quotation marks
# Why? because if there are 2 sets (ie, one set is
# supposed to be there,) then they should be kept
my @temp_array = parse_line(",", 1, $entry);
foreach $token ( @temp_array ) {
# $token = strip_quotes($token);
($local_rc, $converted_value) =
convert_input_value_api($sd_defn->[$ind], $token);
$sd_output[$ind++] = {"type"=>$sd_defn->[$ind],
"value"=>$converted_value};
}
}
}
} # end if.. else
return ($local_rc, \@sd_output);
} # end string_to_sd_api
#--------------------------------------------------------------------#
# string_to_sd_array_api: #
# Takes a string that represents an array of SDs, and translates #
# it into the correct Perl structure. An array of sd definitions #
# is also passed in - these are arrays of arrays of data types, #
# corresponding to the data types in each entry of each SD. #
# #
# The $sd_def_array value is currently expected to contain the enum#
# value from ct_data_type_t. Use CT_cli_utils::string_to_data_type #
# to convert the values before passing them in to this sub. #
# #
# Parameters: #
# $input_sd_array - string containing an array of SDs to be #
# converted. #
# $sd_def_array - reference to an array of SD definitions. #
# #
# Returns: #
# $local_rc - 0 if success, nonzero otherwise. #
# @output_sd_array - array of SDs converted from the input string. #
# Note: an array is returned, not a reference. #
# #
# Global Variables: #
# $main::Trace5 - to print trace information if requested #
#--------------------------------------------------------------------#
sub string_to_sd_array_api
{
my ($input_sd_array, $sd_def_array) = @_;
$main::Trace5 &&
print STDERR "Entered MC_cli_utils::string_to_sd_array_api($input_sd_array)\n";
# Set up local variables
my @output_sd_array = ();
my $index = 0;
my $local_rc = 0;
# Remove the outer [] from the string
$input_sd_array =~ s/^\[//;
$input_sd_array =~ s/\]$//;
# Split up the input SD for parsing
my @sd_array = split /\]\s*,\s*\[/, $input_sd_array;
foreach $sd (@sd_array) {
($local_rc, $output_sd_array[$index]) =
string_to_sd_api($sd, $sd_def_array);
$index++;
if ($local_rc != 0) {return $local_rc;}
}
$main::Trace5 &&
print STDERR "Leaving MC_cli_utils::string_to_sd_array_api($local_rc)\n";
return($local_rc, @output_sd_array);
} # end string_to_sd_array_api
#--------------------------------------------------------------------#
# msgvar_save_CT #
# Save the values of $MSGSET and $MSGCAT to $MSGSET_SAVED and #
# $MSGCAT_SAVED, so they can be changed and restored later. #
#--------------------------------------------------------------------#
sub msgvar_save_CT
{
$MSGSET_SAVED = $MSGSET;
$MSGCAT_SAVED = $MSGCAT;
$MSGCAT = "ctcli.cat"; # msg catalogue for CT
$MSGSET = "ctcli"; # common message set for CT
}
#--------------------------------------------------------------------#
# msgvar_restore: #
# Copy the values of $MSGSET_SAVED and $MSGCAT_SAVED back to #
# $MSGSET and $MSGCAT. #
#--------------------------------------------------------------------#
sub msgvar_restore
{
$MSGSET = $MSGSET_SAVED;
$MSGCAT = $MSGCAT_SAVED;
}
#--------------------------------------------------------------------#
# format_value_for_display - modifies an attribute value so it is #
# displayed properly according to it's type. #
# #
# Parameters: #
# $value input Original value. #
# $name input Attribute name. #
# $type input Attribute type. #
# $class input Attribute class. #
# $class_flg input TRUE is class display. #
# $SD_def_retr input TRUE if SD definitions already #
# retrieved. FALSE otherwise. #
# $rLoAttrs input Reference to a list of attributes for #
# use for SD retrieval. #
# $rSDdefs in/out Reference to hash for data types. #
# #
# Returns: #
# $new_value output Displayable value. #
# $new_SD_def_retr output TRUE if SD definitions retrieved. #
# FALSE otherwise. #
# #
# Global References: #
#--------------------------------------------------------------------#
sub format_value_for_display
{
my($value, $name, $type, $class, $class_flg, $SD_def_retr,
$rLoAttrs, $rSDdefs) = @_;
my @temp_str_array = ();
my $temp_str = "";
my $temp_str2 = "";
my $comma = "";
my $y = 0;
# put quotes around the resource handles and binaries
# since lsrsrc-api doesn't
if ( ($type =~ /^CT_RSRC_HANDLE_PTR$/) ||
($type =~ /^CT_BINARY_PTR$/) ) {
# make binary strings into groups of 8's
if ( ($type =~ /^CT_BINARY_PTR$/) && (length($value)>10) ) {
$value = split_bin_8($value);
}
# put quotes around value
$value = "\"".$value."\"";
}
if ( ( ($type =~ /^CT_RSRC_HANDLE_PTR_ARRAY$/) ||
($type =~ /^CT_BINARY_PTR_ARRAY$/) ) &&
(length $value > 2) ) {
# make binary strings into groups of 8's
if ($type =~ /^CT_BINARY_PTR_ARRAY$/) {
# get rid of beginning and ending {} and any 0x
$value =~ s/^\{//;
$value =~ s/\}$//;
$value =~ s/^0x//;
$value =~ s/,0x/,/g;
# get the separate binary values by splitting on commas
@temp_str_array = split (/,/, $value);
# process each binary value
$temp_str = "";
$comma = "";
for ($y=0; $y<=$#temp_str_array; $y++) {
# format the binary string
$temp_str2 = split_bin_8($temp_str_array[$y]);
# build the array back
$temp_str .= $comma . $temp_str2;
$comma = ",";
}
# put {} back around it and assign back to original variable
$value = "{" . $temp_str . "}";
}
# put quotes around value
$value =~ s/\{0/\{\"0/;
$value =~ s/,/\",\"/g;
$value =~ s/\}/\"\}/;
}
# look in SDs for any binary or RH values
if ( ($type =~ /^CT_SD_PTR$/) ||
($type =~ /^CT_SD_PTR_ARRAY$/) ) {
# retrieve SD info if not already retrieved
if (!$SDdef_retr) {
# get SD definitions
$rc = get_SD_types($rLoAttrs, $class, $rSDdefs, $class_flg);
$SDdef_retr = $TRUE;
}
# add quotes to the SD value if needed
# format of sub call is (name,value,datatype,SDinfo)
$value = add_SD_quotes($name, $value, $type, $rSDdefs);
}
return ($value, $SDdef_retr);
} # end format_value_for_display
#--------------------------------------------------------------------#
# get_SD_types - obtain the SD definitions for attibutes of this #
# class and return a hash based on the attribute names that #
# contains the data types in the hash. #
# #
# Parameters: #
# $rattributes input Reference to the array of attr names. #
# $class_name input class name. #
# $rSDdefs in/out Reference to hash for data types. #
# $class input TRUE if class query. FALSE for resource#
# #
# Returns: #
# $rc 0 - if success, otherwise failure. #
# #
# Global References: #
#--------------------------------------------------------------------#
sub get_SD_types
{
my($rattributes, $class_name, $rSDdefs, $class) = @_;
my $at_name = ""; # attribute names
my $list_attrs = ""; # list of attribute names
my @lsr_out = (); # lsrsrcdef-api output
my @SD_info = (); # SD info array
my @type_array = (); # arrays for data types
my $rc = 0;
my $r = 0;
# build list to use for lsrsrcdef-api
foreach $at_name (@$rattributes) {
$list_attrs .= "::${at_name}";
}
# call lsrsrcdef-api to get the SD information
if ($Trace) { print STDERR "$PROGNAME: calling lsrsrcdef-api\n";}
# check if to get class or resource info
if (!$class) {
@lsr_out = `$CTBINDIR/lsrsrcdef-api -s ${class_name}${list_attrs} 2>&1`;
}
else {
@lsr_out = `$CTBINDIR/lsrsrcdef-api -S ${class_name}${list_attrs} 2>&1`;
}
# capture the return code from lsrsrcdef-api
$rc = $?;
$rc = process_exit_code($rc);
if ($Trace) { print STDERR "lsrsrcdef-api results:\n";
print STDERR "@lsr_out";
print STDERR "$PROGNAME: lsrsrcdef-api returned $rc\n";}
# show any errors if there was a bad rc
if ($rc != 0) {
process_api_error("::",$rc,@lsr_out);
}
# remove any error messages from the output to display
@lsr_out = remove_api_error("::",@lsr_out);
# go through lsrsrcdef-api output making array of data types for each SD attr
# format of output is: SDattrname::SDelementname::datatype::?::?::elementindex
@type_array = ();
for ($r = 0; $r <= $#lsr_out; $r++) {
chomp($lsr_out[$r]);
@SD_info = split (/::/, $lsr_out[$r]);
# put data type for this element in array
push @type_array, $SD_info[2];
# if next one is new SD attr, save array in hash for this SD attr
if ( ($r == $#lsr_out) || ($lsr_out[$r+1] =~ /::0\n$/) ) {
$SD_info[0] =~ s/\"//g;
$$rSDdefs{$SD_info[0]} = [ @type_array ];
@type_array = ();
}
}
return ($rc);
} # end get_SD_types
#--------------------------------------------------------------------#
# add_SD_quotes - add quotes to binary and RH data in an SD if they #
# are present. #
# #
# Parameters: #
# $attr_name input Attribute name. #
# $attr_value input Attribute value. #
# $attr_type input Attribute type. #
# $rSDdefs input Reference to hash for SD data types. #
# #
# Returns: #
# $out_SD_value output Modified SD value. #
# #
# Global References: #
#--------------------------------------------------------------------#
sub add_SD_quotes
{
use Text::ParseWords;
my($name, $value, $type, $rSDdefs) = @_;
my @sd_value_split = (); # array of elements from SD
my @sd_array_split = (); # array of elements from SD array
my $original_value = ""; # original SD value passed in
my $original_sd_value = ""; # original SD value (one SD)
my $tmp_value = ""; # intermediate SD value
my $tmp_array_val = ""; # used for splitting
my $tmp_split_val = ""; # used for splitting
my $out_value = ""; # output SD value
my $modified = 0; # set if change made to original
my $i = 0; # loop index
my $j = 0; # loop index
my $y = 0; # loop index
my $comma = ""; # comma for delimiter in SD
my @temp_str_array = (); # for reformatting values
my $temp_str = ""; # for reformatting values
my $temp_str2 = ""; # for reformatting values
my @parse_split = (); # for reformatting values
my $tmp_len = 0; # for reformatting values
# save the original value
$original_value = $value;
# see if it's an SD array (or just SD)
if ($type =~ /CT_SD_PTR_ARRAY$/) {
# create array of SD's from the SD array
# get rid of outside {}
$value =~ s/^{//;
$value =~ s/}$//;
# split the SD array into an array of SDs (based on commas and brackets)
@sd_array_split = split (/\],\[/, $value);
# @sd_array_split now has array of SDs
}
# else it's an SD (not SD array)
else {
# make this SD look like a SD array of 1 SD
push (@sd_array_split, $value);
# @sd_array_split now has array of 1 SDs
}
# process each SD whether array or not
for ($j=0; $j<=$#sd_array_split; $j++) {
# save original value
$original_sd_value = $sd_array_split[$j];
# get rid of outside []
$sd_array_split[$j] =~ s/^\[//;
$sd_array_split[$j] =~ s/\]$//;
# split the SD into it's parts (based on commas)
# [a,b,c,d,e,f,g,h] or [a,b,c,{d,e,f},g,h]
# keep in mind, may not have values for entire SD
#@sd_value_split = split (/,/, $sd_array_split[$j]);
@sd_value_split = ();
$tmp_array_val = $sd_array_split[$j];
while ( (defined($tmp_array_val)) && ($tmp_array_val !~ /^$/) ) {
# split either on an entry or an array
if ( $tmp_array_val =~ /^{/ ) {
($tmp_split_val,$tmp_array_val) = split (/\},/, $tmp_array_val,2);
if ($tmp_split_val !~ /\}$/) {
$tmp_split_val .= "}";
}
}
else {
#($tmp_split_val,$tmp_array_val) = split (/,/, $tmp_array_val,2);
@parse_split = parse_line(",",1,$tmp_array_val);
$tmp_split_val = $parse_split[0];
if ($tmp_array_val eq $tmp_split_val) {
$tmp_array_val = "";
}
else {
$tmp_len = length($tmp_split_val);
$tmp_array_val = substr $tmp_array_val,$tmp_len;
$tmp_array_val =~ s/^,//;
}
}
push (@sd_value_split, $tmp_split_val);
}
# go through SD checking types for BINARYs and RHs
for ($i=0; $i <= $#sd_value_split; $i++) {
# check type
#print ("type is ${$$rSDdefs{$name}}[$i]\n");
# need to look for CT_BINARY_PTR, CT_BINARY_PTR_ARRAY, CT_RSRC_HANDLE_PTR,
# CT_RSRC_HANDLE_PTR_ARRAY
if ( (${$$rSDdefs{$name}}[$i] =~ /^CT_BINARY_PTR$/) ||
(${$$rSDdefs{$name}}[$i] =~ /^CT_RSRC_HANDLE_PTR$/) ) {
# split up binary values that are bigger than 8 chars
if ( (${$$rSDdefs{$name}}[$i] =~ /^CT_BINARY_PTR$/) &&
(length($sd_value_split[$i])>10) ) {
$sd_value_split[$i] = split_bin_8($sd_value_split[$i]);
}
# put quotes around the single value
$sd_value_split[$i] = "\"".$sd_value_split[$i]."\"";
$modified = 1;
}
if ( (${$$rSDdefs{$name}}[$i] =~ /^CT_BINARY_PTR_ARRAY$/) ||
(${$$rSDdefs{$name}}[$i] =~ /^CT_RSRC_HANDLE_PTR_ARRAY$/) ) {
# make binary strings into groups of 8's
if (${$$rSDdefs{$name}}[$i] =~ /^CT_BINARY_PTR_ARRAY$/) {
# get rid of beginning and ending {} and any 0x
$sd_value_split[$i] =~ s/^\{//;
$sd_value_split[$i] =~ s/\}$//;
$sd_value_split[$i] =~ s/^0x//;
$sd_value_split[$i] =~ s/,0x/,/g;
# get the separate binary values by splitting on commas
@temp_str_array = split (/,/, $sd_value_split[$i]);
# process each binary value
$temp_str = "";
$comma = "";
for ($y=0; $y<=$#temp_str_array; $y++) {
# format the binary string
$temp_str2 = split_bin_8($temp_str_array[$y]);
# build the array back
$temp_str .= $comma . $temp_str2;
$comma = ",";
}
# put {} back around it and assign back to original variable
$sd_value_split[$i] = "{" . $temp_str . "}";
}
# put quotes at the beginning and end
$sd_value_split[$i] =~ s/^{/{\"/;
$sd_value_split[$i] =~ s/}$/\"}/;
# put quotes around beginning and end of each element in array
$sd_value_split[$i] =~ s/,/\",\"/g;
$modified = 1;
}
}
# if there was a change to the SD value, put it back together
if ($modified) {
# put beginning bracket on
$tmp_value = "[";
$comma = "";
# put each split value on $out_value
for ($i=0; $i <= $#sd_value_split; $i++) {
$tmp_value .= $comma . $sd_value_split[$i];
$comma = ",";
}
# put ending bracket on
$tmp_value .= "]";
# assign in back to the array of SDs
$sd_array_split[$j] = $tmp_value;
}
else {
# use original value
$sd_array_split[$j] = $original_sd_value;
}
} # end of for-loop for each SD array element
# now check for overall changes to SD
# if the was a change to the SD value, put it back together
if ($modified) {
# if an array, need to put the {} back on
if ($type =~ /CT_SD_PTR_ARRAY$/) {
# put beginning bracket on
$out_value = "{";
$comma = "";
# put each SD value on $out_value
for ($j=0; $j<=$#sd_array_split; $j++) {
$out_value .= $comma . $sd_array_split[$j];
$comma = ",";
}
# put ending bracket on
$out_value .= "}";
}
# else it's an SD (not array). there's only one
else {
$out_value = $sd_array_split[0];
}
}
else {
# use original value
$out_value = $original_value;
}
return ($out_value);
} # end add_SD_quotes
#--------------------------------------------------------------------#
# split_bin_8 - takes a binary type value and splits it up so it's #
# in strings of 8. 0x01234567890a becomes 0x01234567 0x890a. #
# #
# Parameters: #
# $value input Binary type value. #
# #
# Returns: #
# $out_value output Modified value. #
# #
# Global References: #
#--------------------------------------------------------------------#
sub split_bin_8
{
my $value = shift @_;
my $out_value = ""; # result
my $temp_str = ""; # temp place to play
my $z = 0;
# get rid of the original 0x at the beginning
$value =~ s/^0x//;
# breakup into groups of 8
$temp_str = "";
# loop through the string making groups of 8
for ($z=0; $z<length($value);$z+=8){
$temp_str .= "0x" . substr($value,$z,8) . " ";
}
# get anything left over
#$temp_str .= substr($value,$z);
# get rid of any trailing blanks
$temp_str =~ s/ +$//;
# return new (maybe) value
$out_value = $temp_str;
return ($out_value);
} # end split_bin_8
#--------------------------------------------------------------------#
# read_from_Stdin - tries to create a file containing a list of #
# nodes obtained by Stdin. #
# #
# Parameters: #
# None input None. #
# #
# Returns: #
# $node_file_name output The name of the created file. #
# #
# Global References: #
#--------------------------------------------------------------------#
sub read_from_Stdin
{
my $mk_pid = $$;
my $mk_time = time();
my $mytmpdir = `/opt/rsct/bin/cttmpdir`;
chomp $mytmpdir;
my $cttmpdir_exit = $?;
if ($cttmpdir_exit != 0) {
$mytmpdir = "/tmp";
}
my $node_file_name= "$mytmpdir/${main::PROGNAME}_file_input.${mk_pid}.${mk_time}";
if (! open(MYFILE, ">$node_file_name"))
{
printCEMsg(EMsgMCcliInputFileError, $node_file_name);
exit MC_CLI_ERROR;
}
print MYFILE (<STDIN>);
close (MYFILE);
return $node_file_name;
} # end read_from_Stdin
#--------------------------------------------------------------------#
# End File #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# End Non Exported Subroutines - only used within this pm. #
#--------------------------------------------------------------------#
#--------------------------------------------------------------------#
# End File. #
#--------------------------------------------------------------------#