# 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 => $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 = "";} 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/'/\/g; $optarg =~ s/"/\\"/g; } $optargs = "'" . join("' '",@optargs) . "'"; (scalar @optargs > 0) ? system "$LSMSG $MSGSET $MSGCAT $msg $optargs | /bin/sed \"s/\/'/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/'/\/g; $optarg =~ s/"/\\"/g; } $optargs = "'" . join("' '",@optargs) . "'"; (scalar @optargs > 0) ? system "$LSMSG $MSGSET $MSGCAT $msg $main::PROGNAME $optargs | /bin/sed \"s/\/'/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$node_file_name")) { printCEMsg(EMsgMCcliInputFileError, $node_file_name); exit MC_CLI_ERROR; } print MYFILE (); close (MYFILE); return $node_file_name; } # end read_from_Stdin #--------------------------------------------------------------------# # End File # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # End Non Exported Subroutines - only used within this pm. # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # End File. # #--------------------------------------------------------------------#