# IBM_PROLOG_BEGIN_TAG # This is an automatically generated prolog. # # # # Licensed Materials - Property of IBM # # (C) COPYRIGHT International Business Machines Corp. 2001,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 CRM_cli_utils; # sccsid = "@(#)92 1.40 src/rsct/rm/ConfigRM/cli/pm/CRM_cli_utils.pm.perl, configrmcli, rsct_rady, rady2035a 11/12/15 16:40:25" ###################################################################### # # # Package: CRM_cli_utils.pm # # # # Description: # # This package contains utility/common subroutines for the # # Configuration Resource Manager (ERRM) CLI commands. # # # # Subroutines Available: # # # # error_exit - performs required cleanup and exits with the # # appropriate ConfigRM 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. # # # # get_online_cluster - returns the name of the online cluster, # # if any. No parameters. # # # # get_opstate_by_name - returns a hash keyed by resource Name. # # The hashed value is the opstate. # # Requires the resource class name as input. # # # # get_opstate_by_name_rc - returns a hash keyed by resource Name. # # The hashed value is the opstate. Also returns a return code. # # Requires the resource class name as input. # # # # get_source_node - returns a string that is the cluster node # # name of this node (the node the command is running on). # # No parameters. # # # # check_node_state - returns a boolean True/False to indicate if # # a node is in a desired state. # # Requires the node name, desired state, and hash containing # # nodes/opstates. # # # # check_node_not_state - returns a boolean True/False to indicate # # if a node is not in a specified state. # # Requires the node name, state, and hash containing # # nodes/opstates. # # # # resolve_node_names - uses the perl gethostbyname function to # # resolve a list of node names into two lists, resolved node # # names and unresolved node names. # # Requires an array of node names. # # # # resolve_node_names_ipaddrs - uses the perl gethostbyname and # # gethostbyaddr functions to resolve a list of node names into # # three lists, resolved node names, DNS hash for any IPaddrs, # # and unresolved node names. # # Requires an array of node names (names/ipaddrs). # # # # check_for_nodes - searches a hash with node name as the index # # for nodes from a list and returns two lists, node names in # # the hash and node names not in the hash. # # Requires a hash with node names as the index and an array of # # node names. # # # # check_for_name - searches through a resource class for a resource# # with the name specified. Returns true if the name is found. # # Requires the name and resource class. # # # # lookup_opstate - translates an opstate value into a character # # string that describes the state. # # Requires the opstate. # # # # lookup_mediatype - translates a MediaType value into a character # # string that describes the MediaType. # # Requires the MediaType. # # # # lookup_yesno - translates a 0/1 vaule into "no"/"yes" strings. # # Requires a value to translate. # # # # get_locator_node - returns the resource name and it's locator # # node from a resource name/locator combination. # # Requires the resource name. # # # # process_api_error - extracts and prints errors from the output # # of a c-api command (mkrsrc-api, etc..). # # Requires the command output including STDERR. # # # # process_rmccli_error - extracts and prints errors from the output# # of an rmc cli command (mkrsrc, etc..). # # Requires the command name and its output including STDERR. # # # # remove_api_error - removes error messages from the output of a # # c-api command (mkrsrc-api, etc..). # # Requires the command output including STDERR. # # # # get_nodes_nums_from_file - reads the file specified and returns # # pointers to an array of node names and an array of node # # numbers to pass to ConfigRM. # # Requires the file name to read. # # # # getIMsg - returns the text of a message. Used for NLS. # # Requires the program name and message mnemonic as inputs. # # # # escape_selstr - modify a selection string so that special SQL # # characters are escaped in the string so they do not perform # # special SQL functions (%#_). # # # # 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. # # # # check_quorum_type - changes the quorum type from alpha to # # numeric. # # Requires the initial quorum type value. # # # # form_quorum_attribute - returns an array of integers that will # # make up the quorum attribute to give to ConfigRM. It is # # currently made up of Quorum (Q) and TieBreaker (B). # # Requires the quorum array and tiebreaker array. # # # # get_domain_type - looks up the DomainType attribute in the # # IBM.PeerDomain class. Returns TRUE if the domain type is CAA. # # # # Examples: # # printCEMsg("EMsgCUcliBadOperand", $rsrc_class); # # # #--------------------------------------------------------------------# # Inputs: # # /opt/rsct/msgmaps/configrmcli.configrmcli.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: # # 010806 JAC 75435: Initial design & write. # # 010827 JAC 75436: Updates for phase 2 code delivery. # # 011008 JAC 75442: Updates for phase 3 code delivery. # # 011206 JAC 77315: Updates for comg command rework. # # 020131 JAC 79963: add function to process errors for c-api cmds. # # 020204 JAC 80023: Update get_locator_node function. # # 020206 JAC 80077: Add getIMsg function to return NLS messages. # # 020319 JAC 81245: unescape \n's in process_api_error. # # 020325 JAC 81366: Change get_source_node to return cluster node # # name instead of DNS name. # # 020325 JAC 80304: Add delimiter to get_source_node lsrsrc call. # # 020417 JAC 81859: Move file support to utils. # # 020422 JAC 82248: Changes for renaming commands. # # 020424 JAC 82359: Fix for check_for_name. Need to chomp. # # 020428 JAC 82316: Add process_exit_code function. # # 020503 JAC 82564: Add scope error check to process_api_error. # # 020513 JAC 82449: Add resolve_node_names_ipaddrs. # # 020723 JAC 84621: Modify get_opstate_by_name to work for # # NodeNames attribute when PeerNode class used. # # 021205 JAC 89447: Modify resolve_node_names_ipaddrs to always # # return IP addresses. # # 030203 JAC 89737: Add remove_api_error function. # # 040329 JAC 102042: Add check_quorum_type function. # # 040406 JAC 106712: Add additional function to check_quorum_type. # # 040429 JAC 108194: Add escape_selstr function. # # 050406 JAC 119510: Modify process_api_error to check rc. # # 051216 JAC 131665: Add get_opstate_by_name_rc. # # 071105 JAC 146610: Add tiebreaker support. # # 071127 JAC 147714: Change !QB to !Q!B if B is not specified. # # 100331 NG 165361: Add get_domain_type support # ###################################################################### use Exporter (); @ISA = qw(Exporter); @EXPORT_OK = qw( error_exit printCIMsg printCEMsg get_online_cluster get_opstate_by_name get_opstate_by_name_rc get_source_node check_node_state check_node_not_state resolve_node_names resolve_node_names_ipaddrs check_for_nodes check_for_name lookup_opstate lookup_mediatype lookup_yesno get_locator_node process_api_error process_rmccli_error remove_api_error check_quorum_type get_nodes_nums_from_file getIMsg escape_selstr process_exit_code form_quorum_attribute get_IPv6Support get_domain_type ); use lib "/opt/rsct/pm"; use locale; use CRM_cli_rc qw(CRM_CLI_RMC_ERROR CRM_CLI_ERROR CRM_CLI_BAD_FLAG CRM_CLI_BAD_OPERAND CRM_CLI_USER_ERROR CRM_CLI_NOT_FOUND); use CRM_cli_include qw($CTBINDIR $CTDIR $TRUE $FALSE $RMC_CLI_USER_ERROR $DELIMITER $RMC_OPSTATE_ONLINE $RSCLUSTER $RSNODE $RMC_SCOPE_ERROR $RMC_CLI_RSRC_NOT_FOUND ); #--------------------------------------------------------------------# # Global Variables # #--------------------------------------------------------------------# $MSGCAT = "configrmcli.cat"; # msg catalogue for these cmds $MSGSET = "configrmcli"; # common message set $LSMSG = "$CTBINDIR/ctdspmsg"; # list / display message rtn $ENV{'MSGMAPPATH'} = "$CTDIR/msgmaps"; # msg maps used by $LSMSG #--------------------------------------------------------------------# # Exported Subroutines (with @EXPORT_OK, -> on demand). # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # Common message handling (error, informational) routines: # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # error_exit - performs required cleanup and exits. # # Parameters: # # $badrc in Bad return code - bad enough to exit # # processing of this command. # # Exit: # # 1 CRM_CLI_RMC_ERROR Underlying RMC error. # # 2 CRM_CLI_ERROR Unexpected error in the command script.# # 3 CRM_CLI_BAD_FLAG Input flag error. # # 4 CRM_CLI_BAD_OPERAND Input operand error. # # 5 CRM_CLI_USER_ERROR User error. # # 6 CRM_CLI_NOT_FOUND Cluster not 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) = @_; SWITCH: { ($badrc == CRM_CLI_RMC_ERROR) && exit($badrc); ($badrc == CRM_CLI_ERROR) && exit($badrc); ($badrc == CRM_CLI_BAD_FLAG) && exit($badrc); ($badrc == CRM_CLI_BAD_OPERAND) && exit($badrc); ($badrc == CRM_CLI_USER_ERROR) && exit($badrc); ($badrc == CRM_CLI_NOT_FOUND) && exit($badrc); # At this point all return codes should have been converted to # a valid ConfigRM CLI return code. But if one wasn't write an # error message. printCEMsg("EMsgConfigRMcliBadRC", $badrc); exit(CRM_CLI_ERROR); } # end switch } # end error_exit #--------------------------------------------------------------------# # printCIMsg : Calls $LSMSG to print out the common # # ConfigRM CLI information messages with the required parameters. # # Messages printed to stdout. # # This subroutine is like printIMsg except it is used to print # # the common ConfigRM CLI messages which are in the configrmcli # # message set. # # # # Parameters: # # $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 ConfigRM CLI Message catalog. # # $MSGSET in ConfigRM CLI common message set "configrmcli"# #--------------------------------------------------------------------# 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 # # ConfigRM CLI error messages with the required parameters. # # Messages printed to stderr. # # This subroutine is like printEMsg except it is used to print # # the common ConfigRM CLI messages which are in the configrm # # message set and it prefixes the message with the appropriate # # program name. # # # # Parameters: # # $msg in Message mnemonic / message number in a sense. # # $optargs in Extra arguments/parameters to send to $LSMSG. # # # # Returns: None. # # # # Global Variables: # # $main::PROGNAME in Calling program/command for error message. # # $main::Trace in Prints extra info when trace is on. # # $LSMSG in Path and command to display messages. # # $MSGCAT in ConfigRM CLI Message catalog. # # $MSGSET in ConfigRM CLI common message set "configrmcli"# #--------------------------------------------------------------------# 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 #--------------------------------------------------------------------# # get_online_cluster : Uses the list resource RMC CLI command to # # find the name of the online cluster, if one exists. # # The OpState dynamic attribute is checked until an online one # # is found. Select string is not used since it does not support # # using dynamic attributes at this time. # # # # Parameters: # # None # # # # Returns: # # cluster the name of the online cluster # # "" if no online cluster exists # # # # Global Variables: # # $main::Trace in case trace is on # # $main::PROGNAME for trace message # # $CTBINDIR where list command resides # # $LSNOTFND number of output line for name not found # #--------------------------------------------------------------------# sub get_online_cluster { my $cluster = ""; # cluster name to return my @listout = (); # saves list output my $trace_opt = ""; # pass trace option along my $rc = 0; my $found = 0; # boolean my $i = 0; # counter my $cluster_name = ""; # temp cluster name for search my $op_state = 0; # temp op state for search $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; $main::Trace && ($trace_opt = " -T "); # list the online clusters #@listout = `$CTBINDIR/lsrsrc $trace_opt -x -D $DELIMITER $RSCLUSTER Name OpState`; @listout = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${RSCLUSTER}::::::Name::OpState 2>&1`; $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: lsrsrc-api returned $rc\n"; # show any errors if there was a bad rc if ($rc != 0) { &process_api_error($DELIMITER,$rc,@listout); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR);} # if list command failed, print RMC error message and exit if ($rc != 0) { # printCEMsg("EMsgConfigRMcliUnExpectRMCrc",$rc); exit(CRM_CLI_RMC_ERROR); } # look for any cluster that is online. # there should only be one so take the first one $found = $FALSE; $i = 0; while ((!$found) && ($i <= $#listout)) { ($cluster_name,$op_state) = split /$DELIMITER/, $listout[$i]; if ($op_state == $RMC_OPSTATE_ONLINE) { $found = $TRUE; $cluster = $cluster_name; } $i++; } return ($cluster); } # end of get_online_cluster #--------------------------------------------------------------------# # get_opstate_by_name : Uses the list resource RMC CLI command to # # find the Name and OpState attributes of the specified resource # # class. A hash of resource name and opstate is returned. # # # # Parameters: # # Resource_class the resource class name of the opstates being # # requested # # # # Returns: # # op_states hash of resource name and opstate # # (empty if nothing exists) # # # # Global Variables: # # $main::Trace in case trace is on # # $main::PROGNAME for trace message # # $CTBINDIR where list command resides # #--------------------------------------------------------------------# sub get_opstate_by_name { my $class = ""; # resource class to query my %op_states = (); # hash for node/opstates my @listout = (); # saves list output my @node_list = (); # list of nodes from NodeNames my $line = ""; # one line of listout my $trace_opt = ""; # pass trace option along my $rc = 0; my $name = ""; # temp node name for search my $nl_name = ""; # temp node name my $op_state = 0; # temp op state for search my $lenname = 0; # string length # get resource class $class = shift(@_); $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; $main::Trace && ($trace_opt = " -T "); # list the online clusters #@listout = `$CTBINDIR/lsrsrc $trace_opt -x -D $DELIMITER $class Name OpState`; # use NodeNames instead of Name for PeerNode class if ($class eq $RSNODE) { @listout = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${class}::::::NodeNames::OpState 2>&1`; } else { @listout = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${class}::::::Name::OpState 2>&1`; } $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: lsrsrci-api returned $rc\n"; # show any errors if there was a bad rc if (($rc != 0) && ($rc != $RMC_CLI_RSRC_NOT_FOUND)) { &process_api_error($DELIMITER,$rc,@listout); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR);} # return if there's no resources if ($rc == $RMC_CLI_RSRC_NOT_FOUND) { return (%op_states); } # if list command failed, print RMC error message and exit if ($rc != 0) { # printCEMsg("EMsgConfigRMcliUnExpectRMCrc",$rc); exit(CRM_CLI_RMC_ERROR); } # set up a hash for the opstate info based on class if ($class eq $RSNODE) { foreach $line (@listout) { ($name,$op_state) = split /$DELIMITER/, $line; chomp($op_state); # strip off leading/trailing braces $name =~ s/^\{//; $name =~ s/\}$//; #break up the node names @nodelist = split ",", $name; # set each op state foreach $nl_name (@nodelist) { $op_states{$nl_name} = $op_state; } } } else { foreach $line (@listout) { ($name,$op_state) = split /$DELIMITER/, $line; chomp($op_state); # strip off leading/trailing quotes if (substr($name,0,1) eq "\"") { $lenname = length $name; $name = substr($name,1,$lenname-2); } $op_states{$name} = $op_state; } } return (%op_states); } # end of get_opstate_by_name #--------------------------------------------------------------------# # get_opstate_by_name_rc : Uses the list resource RMC CLI command to# # find the Name and OpState attributes of the specified resource # # class. A hash of resource name and opstate is returned along # # with a rc to show if it worked. No RMC error messages are # # printed if there is a failure. Check the rc to see if it worked. # # # # Parameters: # # Resource_class the resource class name of the opstates being # # requested # # # # Returns: # # rc 0 if successful. !=0 otherwise. # # op_states hash of resource name and opstate # # (empty if nothing exists) # # # # Global Variables: # # $main::Trace in case trace is on # # $main::PROGNAME for trace message # # $CTBINDIR where list command resides # #--------------------------------------------------------------------# sub get_opstate_by_name_rc { my $class = ""; # resource class to query my %op_states = (); # hash for node/opstates my @listout = (); # saves list output my @node_list = (); # list of nodes from NodeNames my $line = ""; # one line of listout my $trace_opt = ""; # pass trace option along my $rc = 0; my $name = ""; # temp node name for search my $nl_name = ""; # temp node name my $op_state = 0; # temp op state for search my $lenname = 0; # string length my $api_rc = 0; # RMC API rc # get resource class $class = shift(@_); $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; $main::Trace && ($trace_opt = " -T "); # list the online clusters #@listout = `$CTBINDIR/lsrsrc $trace_opt -x -D $DELIMITER $class Name OpState`; # use NodeNames instead of Name for PeerNode class if ($class eq $RSNODE) { @listout = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${class}::::::NodeNames::OpState 2>&1`; } else { @listout = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${class}::::::Name::OpState 2>&1`; } $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: lsrsrci-api returned $rc\n"; # return if there's was some error if ($rc !=0 ) { # get the api return code from the error message @error_msg = split /$DELIMITER/, $listout[0]; $api_rc = $error_msg[4]; # return the api return code unless it's 0 if ( $api_rc == 0 ) { $api_rc = $rc; } return ($api_rc, %op_states); } # set up a hash for the opstate info based on class if ($class eq $RSNODE) { foreach $line (@listout) { ($name,$op_state) = split /$DELIMITER/, $line; chomp($op_state); # strip off leading/trailing braces $name =~ s/^\{//; $name =~ s/\}$//; #break up the node names @nodelist = split ",", $name; # set each op state foreach $nl_name (@nodelist) { $op_states{$nl_name} = $op_state; } } } else { foreach $line (@listout) { ($name,$op_state) = split /$DELIMITER/, $line; chomp($op_state); # strip off leading/trailing quotes if (substr($name,0,1) eq "\"") { $lenname = length $name; $name = substr($name,1,$lenname-2); } $op_states{$name} = $op_state; } } return (0, %op_states); } # end of get_opstate_by_name_rc #--------------------------------------------------------------------# # get_source_node : Returns a string that is the cluster node name # # of where the command is running. The node must be online to the # # the cluster or no name is returned. # # # # Parameters: # # None. # # # # Returns: # # local_node Cluster node name of the node the command is # # running on. # # # # Global Variables: # #--------------------------------------------------------------------# sub get_source_node { my @listout = (); # lsrsrc-api output $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; $main::Trace && ($trace_opt = " -T "); # find the cluster node name from the IBM.PeerNode class # this method keeps CT_CONTACT involved @listout = `$CTBINDIR/lsrsrc-api -s IBM.PeerNode::\"NodeIDs|<__NodeID\"::Name 2>&1`; $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: lsrsrci-api returned $rc\n"; # show any errors if there was a bad rc if ($rc != 0) { &process_api_error("::",$rc,@listout); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR);} # if list command failed, print RMC error message and exit if ($rc != 0) { exit(CRM_CLI_RMC_ERROR); } # get the node name $local_node_name = $listout[0]; chomp($local_node_name); # return the cluster node name return($local_node_name); } # end of get_source_node #--------------------------------------------------------------------# # check_node_state : Returns a boolean True/False that indicates if # # the node specified is in the desired state in the hash of nodes/ # # opstates. # # # # Parameters: # # node_name The resolved node name to check. # # state The desired state to check the node for. # # %node_opstates The hash of node/opstates to check. # # # # Returns: # # state_match Boolean. # # True if actual state matched desired state # # False otherwise (doesn't match or doesn't # # exist) # # # # Global Variables: # # $TRUE true result. # # $FALSE false result. # #--------------------------------------------------------------------# sub check_node_state { my $node_name = ""; # node to check my $state = ""; # state to match my %node_opstates = (); # hash of node/opstates my $state_match = $FALSE; # boolean to return my @nodes = (); # nodes in hash my $node = ""; # one node my $found = $FALSE; # search flag my $i = 0; # counter # get parameters $node_name = shift @_; $state = shift @_; %node_opstates = @_; # get a list of nodes in the node/opstate hash @nodes = keys %node_opstates; # make sure the node is in the list $i = 0; $found = $FALSE; while (!$found && ($i <= $#nodes)) { # is it in the list? if ($nodes[$i] eq $node_name) { $found = $TRUE; # is the state the one we want if ($node_opstates{$nodes[$i]} == $state) { $state_match = $TRUE; } } $i++; } # end of while return($state_match); } # end of check_node_state #--------------------------------------------------------------------# # check_node_not_state : Returns a boolean True/False that indicates # # if the node specified is not in the specified state in the hash # # of nodes/opstates. # # # # Parameters: # # node_name The resolved node name to check. # # state The state to check that the node is not in. # # %node_opstates The hash of node/opstates to check. # # # # Returns: # # state_ok Boolean. # # True if actual state is not the specified # # state. # # False if it matches the specified state. # # # # Global Variables: # # $TRUE true result. # # $FALSE false result. # #--------------------------------------------------------------------# sub check_node_not_state { my $node_name = ""; # node to check my $state = ""; # state to match my %node_opstates = (); # hash of node/opstates my $state_ok = $TRUE; # boolean to return my @nodes = (); # nodes in hash my $node = ""; # one node my $found = $FALSE; # search flag my $i = 0; # counter # get parameters $node_name = shift @_; $state = shift @_; %node_opstates = @_; # get a list of nodes in the node/opstate hash @nodes = keys %node_opstates; # make sure the node is in the list $i = 0; $found = $FALSE; while (!$found && ($i <= $#nodes)) { # is it in the list? if ($nodes[$i] eq $node_name) { $found = $TRUE; # is the state the one we don't want if ($node_opstates{$nodes[$i]} == $state) { $state_ok = $FALSE; } } $i++; } # end of while return($state_ok); } # end of check_node_not_state #--------------------------------------------------------------------# # resolve_node_names : Uses the perl gethostbyname function to # # resolve a list of node names. References to two lists are # # returned, one for a list of resolved node names and the other # # for a list of unresolved node names. # # # # Parameters: # # @node_names List of node names. # # # # Returns: # # \@resolved_node_names Reference to a list of resolved node # # names for nodes that could be resolved. # # \@unresolved_node_names Reference to a list of unresolved node # # names for nodes that could not be resolved. # # # # Global Variables: # #--------------------------------------------------------------------# sub resolve_node_names { my @node_names = (); # nodes to be resolved my @resolved_node_names = (); # resolved node names my @unresolved_node_names = (); # unresolved node names my $one_node = ""; # one node name # get input @node_names = @_; # convert names in the nodelist to long name, if possible foreach $one_node (@node_names) { $main::Trace && print STDERR "$main::PROGNAME: calling ct_get_hostname\n"; my $output = `$CTBINDIR/ct_get_hostname -n ${one_node} 2>&1`; my $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: ct_get_hostname returned $rc\n"; if ($rc) { push (@unresolved_node_names, $one_node); } else { my ($resolved_long_hostname, $dns_lookup_key, $dns_lookup_value) = split(/ /, $output); push (@resolved_node_names, $resolved_long_hostname); } } return(\@resolved_node_names, \@unresolved_node_names); } # end of resolve_node_name #--------------------------------------------------------------------# # resolve_node_names_ipaddrs : Uses the perl gethostbyname and # # gethostbyaddr functions to resolve a list of node names. # # References to three lists are returned, one for a list of # # resolved node names, one for a hash of DNS names for an IPaddr # # if the resolved name is an ipaddr (input was ipaddr) or a hash # # of IP addrs if the resolved name is not an IP addr, and the # # other for a list of unresolved node names. # # # # Parameters: # # @node_names List of node names. # # # # Returns: # # \@resolved_node_names Reference to a list of resolved node # # names for nodes that could be resolved. # # \%DNS_IP_names Reference to a hash of DNS names using the IP # # address as the index if node_names are IP addr # # or a hash of IP addrs with the resolved names # # as the index if the node_names are not IP addrs.# # \@unresolved_node_names Reference to a list of unresolved node # # names for nodes that could not be resolved. # # # # Global Variables: # #--------------------------------------------------------------------# sub resolve_node_names_ipaddrs { my @node_names = (); # nodes to be resolved my @resolved_node_names = (); # resolved node names my @unresolved_node_names = (); # unresolved node names my $one_node = ""; # one node name my %DNS_IP_names = (); # DNS names or IP addrs # get input @node_names = @_; # convert names in the nodelist to long name, if possible foreach $one_node (@node_names) { $main::Trace && print STDERR "$main::PROGNAME: calling ct_get_hostname\n"; my $output = `$CTBINDIR/ct_get_hostname -n ${one_node} 2>&1`; my $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: ct_get_hostname returned $rc\n"; if ($rc) { push (@unresolved_node_names, $one_node); } else { my ($resolved_long_hostname, $dns_lookup_key, $dns_lookup_value) = split(/ /, $output); push (@resolved_node_names, $resolved_long_hostname); if ("UNRESOLVED" ne $dns_lookup_value) { $DNS_IP_names{$dns_lookup_key} = $dns_lookup_value; } } } return(\@resolved_node_names, \%DNS_IP_names, \@unresolved_node_names); } # end of resolve_node_name_ipaddrs #--------------------------------------------------------------------# # check_for_nodes : Searches through a hash of node names for a list # # of node names and returns 2 lists of nodes. The first list # # contains all of the nodes from the input node list that are in # # the input hash. The second list contains a list of nodes from # # the input node list that are not in the input hash. # # # # Parameters: # # $node_names Reference to an array of node names. # # $node_hash Reference to a hash contain node names as the # # indices. # # # # Returns: # # /@in_list Reference to a list of nodes from the node # # names input array found to be in the hash # # /@out_list Reference to a list of nodes from the node # # names input array found not to be in the hash # # # # Global Variables: # #--------------------------------------------------------------------# sub check_for_nodes { my $node_names = ""; # reference to array of nodes my $node_hash = ""; # reference to hash of nodes my @in_list = (); # node names in hash my @out_list = (); # node names not in hash my @nodes = (); # node indices my $nodes = ""; # one node from node_names my $found = $FALSE; # search switch my $i = 0; # loop counter # get inputs $node_names = shift @_; $node_hash = shift @_; # get a list of nodes in the node hash @nodes = keys %$node_hash; # if a node from node_names array is in the list, put it in in_list # otherwise put it in out_list foreach $node (@$node_names) { $i = 0; $found = $FALSE; while (!$found && ($i <= $#nodes)) { # is it in the list? if ($nodes[$i] eq $node) { $found = $TRUE; # put in in_list push (@in_list, $node); } $i++; } # end of while # if not found, put in out_list if (!$found) { push (@out_list, $node); } } # end foreach return(\@in_list, \@out_list); } # end of check_for_nodes #--------------------------------------------------------------------# # check_for_name : Searches through a resource class for a resource # # with the name specified. It returns true if it is found, false # # otherwise. # # # # Parameters: # # $name Name to search for. # # $class Resource class to seach. # # # # Returns: # # $found Name found in resource class: # # TRUE - name was found # # FALSE - name was not found # # # # Global Variables: # #--------------------------------------------------------------------# sub check_for_name { my $name = ""; # name to look for my $class = ""; # resource class to look in my $found = $FALSE; # name was found my $i = 0; # counter my @class_names = (); # names in the class my $one_class_name = ""; # a class name my $junk = ""; # junk my $lenname = 0; # length of name my $trace_opt = ""; # trace option for rmc cli # get inputs $name = shift @_; $class = shift @_; # list the names of the resource class $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; $main::Trace && ($trace_opt = " -T "); # list the online clusters #@class_names = `$CTBINDIR/lsrsrc $trace_opt -x -D $DELIMITER $class Name`; @class_names = `$CTBINDIR/lsrsrc-api -D $DELIMITER -o ${class}::::::Name 2>&1`; $rc = $?; $rc = &process_exit_code($rc); $main::Trace && print STDERR "$main::PROGNAME: lsrsrc-api returned $rc\n"; # show any errors if there was a bad rc if ($rc != 0) { &process_api_error($DELIMITER,$rc,@class_names); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR);} # if list command failed, print RMC error message and exit if ($rc != 0) { # printCEMsg("EMsgConfigRMcliUnExpectRMCrc",$rc); exit(CRM_CLI_RMC_ERROR); } # see if this name exists $found = $FALSE; $i = 0; while (!$found && ($i <= $#class_names)) { ($one_class_name,$junk) = split /$DELIMITER/, $class_names[$i]; chomp $one_class_name; # strip off leading/trailing quotes if (substr($one_class_name,0,1) eq "\"") { $lenname = length $one_class_name; $one_class_name = substr($one_class_name,1,$lenname-2); } if ($name eq $one_class_name) { $found = $TRUE } $i++; } return($found); } # end of check_for_name #--------------------------------------------------------------------# # check_quorum_type : Check quorum type passed in with valid values # # from AvailableQuorumTypes. It then converts it to the proper # # numeric value. # # # # Parameters: # # $quorum_type Quorum type to process. # # # # Returns: # # $quorum_value Quorum type value. # # # # Global Variables: # #--------------------------------------------------------------------# sub check_quorum_type { my $quorum_type = ""; # quorum type to check my $quorum_value = ""; # quorum value to set my @lsr_out = (); # lsrsrc-api output my $rc = 0; # lsrsrc-api return code my @available = (); # for types my $junk = ""; # like it says # get input $quorum_type = shift @_; # if the quorum type is a number, pass it on if ($quorum_type =~ /^[0-9]+$/ ) { $quorum_value = $quorum_type; } # translate the value into a number else { # read the AvailableQuorumTypes attribute $main::Trace && print STDERR "$main::PROGNAME: calling lsrsrc-api\n"; @lsr_out = `$CTBINDIR/lsrsrc-api -D $DELIMITER -c IBM.PeerDomain::::::AvailableQuorumTypes 2>&1`; # capture the return code from lsrsrc-api $rc = $?; $rc = process_exit_code($rc); if ($main::Trace) { print STDERR "$main::PROGNAME: lsrsrc-api returned $rc\n"; print STDERR "lsrsrc-api results:\n"; print STDERR "@lsr_out"; } # show any errors if there was a bad rc if ($rc != 0) { process_api_error($DELIMITER,$rc,@lsr_out); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR); } # if lsrsrc failed for something else, print RMC error message and exit if ($rc != 0) { exit(CRM_CLI_RMC_ERROR); } # lsr_out[0] will look like {[Normal,0],[Quick,1],[Override,2],[SANFS,3]} # look for the quorum type specified. Exit with error if not found if ( $lsr_out[0] !~ /$quorum_type/ ) { printCEMsg("EMsgConfigRMcliBadQuorumType", $quorum_type); exit(CRM_CLI_USER_ERROR); } # find the matching quorum value $quorum_type .= ","; @available = split /$quorum_type/, $lsr_out[0]; ($quorum_value, $junk) = split /\]/, $available[1]; } return($quorum_value); } # end of check_quorum_type #--------------------------------------------------------------------# # lookup_opstate : Translates an opstate value (code) into a # # character string that describes the opstate. # # # # Parameters: # # $opstate Opstate to translate. # # # # Returns: # # $descr_state Description of the state. # # # # Global Variables: # #--------------------------------------------------------------------# sub lookup_opstate { my $opstate = 0; # opstate my $descr_state = "?"; # default - don't know my %op_states = (); # hash for opstate descriptions my $found = $FALSE; # boolean flag my $use_quotes = $FALSE; # boolean flag # get inputs $opstate = shift @_; %op_states = @_; # figure out if quotes are needed around strings if ( (defined $ENV{CT_CLI_QUOTE_STRING}) && ($ENV{CT_CLI_QUOTE_STRING} == 1) ) { $use_quotes = $TRUE; } # see if opstate to find exists if (defined $op_states{$opstate}) { $found = $TRUE; } # translate op state if ($found) { $descr_state = $op_states{$opstate}; } else { $descr_state = $op_states{"?"}; } # add quotes if necessary if ($use_quotes) { $descr_state = "\"".$descr_state."\""; } return($descr_state); } # end of lookup_opstate #--------------------------------------------------------------------# # lookup_mediatype : Translates a MediaType value (code) into a # # character string that describes the MediaType. # # # # Parameters: # # $mediatype MediaType to translate. # # # # Returns: # # $descr_mediatype Description of the media type. # # # # Global Variables: # #--------------------------------------------------------------------# sub lookup_mediatype { my $mediatype = 0; # mediatype my $descr_mediatype = "?"; # default - don't know my %media_types = (); # hash for MediaType descriptions # get inputs $mediatype = shift @_; %media_types = @_; # if the MediaType to find exists, translate it if (defined $media_types{$mediatype}) { $descr_mediatype = $media_types{$mediatype}; } else { $descr_mediatype = $media_types{"?"}; } # add quotes if necessary if ( (defined $ENV{CT_CLI_QUOTE_STRING}) && ($ENV{CT_CLI_QUOTE_STRING} == 1) ) { $descr_mediatype = "\"".$descr_mediatype."\""; } return($descr_mediatype); } # end of lookup_mediatype #--------------------------------------------------------------------# # lookup_yesno : Translates a 0 or 1 value into "no" or "yes". # # # # Parameters: # # $trans_value Value to translate. # # @trans_array Values used to translate # # # # Returns: # # $descr "yes" if 1, "no" if 0, "?" otherwise. # # # # Global Variables: # #--------------------------------------------------------------------# sub lookup_yesno { my $trans_value = 0; # value to translate my $descr = "?"; # default - don't know my $use_quotes = $FALSE; # boolean flag my @trans_array =(); # array with the values # get inputs $trans_value = shift @_; @trans_array = @_; # figure out if quotes are needed around strings if ( (defined $ENV{CT_CLI_QUOTE_STRING}) && ($ENV{CT_CLI_QUOTE_STRING} == 1) ) { $use_quotes = $TRUE; } # translate the value if ($trans_value == 0) { $descr = $trans_array[0]; } elsif ($trans_value == 1) { $descr = $trans_array[1]; } else { $descr = $vals[2]; $descr = $trans_array[2]; } # add quotes if necessary if ($use_quotes) { $descr = "\"".$descr."\""; } return($descr); } # end of lookup_yesno #--------------------------------------------------------------------# # get_locator_node : Returns the resource name and locator from a # # resource name/locator combination. Ex. ConditionName:nodeA # # will return ConditionName and nodeA. # # # # Parameters: # # resource_name_in The resource name / locator combination. # # # # Returns: # # resource_name resource name. # # locator locator, if there is one. # # # # Global Variables: # #--------------------------------------------------------------------# sub get_locator_node { my $resource_name_in = shift(@_); # resource/locator combo # split the resource/locator at the first colon (first colon in case # locator is an IPv6 address) my ($resource_name, $locator) = split /:/, $resource_name_in, 2; if (! defined $resource_name) { $resource_name = ""; } if (! defined $locator) { $locator = ""; } return($resource_name, $locator); } # end of get_locator_node #--------------------------------------------------------------------# # 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 = ""; # if the delimiter has a "|", escape it so it's not treated as an "or" if ($delimiter =~ /\|/) { $delimiter =~ s/\|/\\\|/g; } # scan each line for ERROR foreach $line (@command_output) { # does it start with ERROR? if ($line =~ /^ERROR.*/) { # split it apart based on the delimiter # last one should be error message @error_parts = split /$delimiter/, $line; # check for scope error if ($error_parts[$#error_parts -1] == $RMC_SCOPE_ERROR) { printCEMsg("EMsgConfigRMcliNoCluster"); exit(CRM_CLI_USER_ERROR); } # replace any escaped new lines with new lines $error_parts[$#error_parts] =~ s/\\n/\n/g; # 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("EMsgConfigRMcliUnexpectErrorRC",$api_rc); } } # end of process_api_error #--------------------------------------------------------------------# # process_rmccli_error - Scans the @command_output varaible for error# # messages found by the rmc cli, but does not extract messages # # generated by the rmc cli itself. The $command parameter is used # # to decide what stays and what goes. # # # # Parameters: # # $commandt The rmc cli command name. # # @command_output The output from the command. # # # # Returns: # # None. # # # # Global Variables: # #--------------------------------------------------------------------# sub process_rmccli_error { my $command = shift(@_); # command that made output my @command_output = @_; # command output to scan # scan each line for the command name foreach $line (@command_output) { # if it doesn't start with the command name, print it if (!($line =~ /^$command.*/)) { # print it to STDERR. print STDERR $line; } } } # end of process_rmccli_error #--------------------------------------------------------------------# # 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. # # # # Parameters: # # @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 @command_output = @_; # command output to scan my @errorless_output = (); # errors removed # scan each line for ERROR foreach $line (@command_output) { # does it start with ERROR? if (!($line =~ /^ERROR.*/)) { # put it in the errorless array push @errorless_output, $line; } } return (@errorless_output); } # end of remove_api_error #--------------------------------------------------------------------# # get_nodes_nums_from_file - Reads the node names and node numbers # # from a file specified. The file is read on line at a time. The # # first string on the line up to a blank is used as the node name # # for that line. The second string, if present, is the node # # number. The rest of the line is ignored. Any line that is # # blank or starts with a "#" is ignored. Text on a line after a # # "#" is ignored. # # # # Input: # # $file_name The name of the file to use. # # # # Returns: # # /@node_names Reference to a list of node names. # # /@node_numbers Reference to a list of node numbers. # # /@node_quorum_flags Reference to a list of quorum flags. # # /@node_gsgl_flags Reference to a list of # # IsPreferredGSGL flags. # # /@node_tiebreaker_flags Reference to a list of tiebreaker # # flags. # # # #--------------------------------------------------------------------# sub get_nodes_nums_from_file { my @node_names = (); # node names to return my @node_numbers = (); # node numbers to return my @node_quorum_flags = (); # quorum list to return my @node_gsgl_flags = (); # IsPreferredGSGL list to return my @node_tiebreaker_flags = (); # tiebreaker list to return my @node_names_temp = (); # temp list my $node_name_line = ""; # line from file my $one_node_name = ""; # a node name my $one_node_number = ""; # a node number my $one_node_option = ""; # a node option for P,Q specification my $file_error = ""; # when file doesn't open my $error_flag = ""; # error indicator my @error_list = (); # my $value = ""; # temp variable,$value is 1 if P/Q is specified, 0 if !P/!Q is specified my $invalid_options = ""; # temp variable for invalid options # get the file name passed in my $file_name = shift @_; # indicate if hit error $error_flag = 0; # open the file. process if it opens ok if ( open (NODELIST,"$file_name") ) { # read until eof while () { # get a line from the file $node_name_line = $_; # get rid of any new line characters chomp($node_name_line); # get rid of leading spaces $node_name_line =~ s/^\s+//; # take a line unless it's a comment or empty if ( (!($node_name_line =~ /^#/)) && ($node_name_line ne "") ) { $invalid_options = ""; # only worry about up to an "#" (anything after is ignored) $node_name_line =~ s/#.*//; # get the first string on the line @node_names_temp = split /\s+/,$node_name_line; # get the node name and node number $one_node_name = shift @node_names_temp; $one_node_option = shift @node_names_temp; # get the Quorum and PreferredGSGL specification if ( $one_node_option !~ /^@/ ) { $one_node_number = $one_node_option; $one_node_option = shift @node_names_temp; } else { $one_node_number = shift @node_names_temp; } if ( $#node_names_temp != -1 ) { foreach my $iter ( @node_names_temp ) { $error_flag++; $invalid_options = $invalid_options . ' ' . $iter; } } # go to process character followed by '@' my $quorum_flag = -1; #default; there is no quorum specification my $gsgl_flag = -1; #default; there is no PreferredGSGL specification my $tiebreaker_flag = -1; #default; there is no tiebreaker specification # there is control character "@" if ( $one_node_option =~ /^@/ ) { $one_node_option =~ s/^@//; if ( length($one_node_option) == 0 ) { $error_flag++; $invalid_options = '@ ' . $invalid_options; } else { my $node_option_bak = $one_node_option; # process Q/!Q/q/!q $quorum_flag = &parse_flag( \$one_node_option, 'Q' ); # process P/!P/p/!p $gsgl_flag = &parse_flag( \$one_node_option, 'P' ); # process B/!B/b/!b $tiebreaker_flag = &parse_flag( \$one_node_option, 'B' ); # if there is any more characters existing in string $one_node_option # we will consider this is one user input error. if ( length($one_node_option) != 0 ) { $error_flag++; if ( $one_node_option eq $node_option_bak ) { # it means the full $one_node_option is invalid $invalid_options = '@' . $one_node_option . ' ' . $invalid_options; } else { $invalid_options = $one_node_option . ' ' . $invalid_options; } # end of " if ( $one_node_option eq $node_option_bak ) " block } # end of " if ( length($one_node_option) != 0 ) " block } # end of " if ( length($one_node_option) == 0 ) " block } # end of "match /^@/" block elsif ( length($one_node_option) != 0 ) { $error_flag++; $invalid_options = $invalid_options . ' ' . $one_node_option; } # save the node names and node numbers if ($one_node_name ne "") {push(@node_names, $one_node_name);} if ($one_node_number ne "") {push(@node_numbers, $one_node_number);} # save the quorum and preferedgsgl flags if ( $one_node_name ne "" ) { push( @node_quorum_flags, $quorum_flag ); push( @node_gsgl_flags, $gsgl_flag); push( @node_tiebreaker_flags, $tiebreaker_flag); } if ( $error_flag != 0 && length($invalid_options) != 0 ) { &printCEMsg("EMsgConfigRMcliBadNodeFileInput", $one_node_name, $invalid_options); } } } # end of "while not eof" loop # close the file close(NODELIST); # if hit error when parsing node input file # exit directly. if ( $error_flag != 0 ) { exit(CRM_CLI_USER_ERROR); } # check that the number of node names matches the number of node numbers # (don't care if no node numbers were specified) if ( ($#node_numbers >=0) && ($#node_numbers != $#node_names) ) { # print error message and exit &printCEMsg("EMsgConfigRMcliFileBadMatch"); exit(CRM_CLI_USER_ERROR); } # verify Quroum and PreferedGSGL specification lists. # print error message if there is false specification # Give correct P/Q value for those nodes which are not specified P/Q in the file # process Quorum list if ( $#node_quorum_flags >= 0 ){ @error_list = &process_flag_array(\@node_quorum_flags); # process errors; if ( $#error_list >= 0 ) { $error_flag++; foreach $n ( @error_list ) { &printCEMsg("EMsgConfigRMcliBadQuorumSpecified", $file_name, $node_names[$n]); } } } # process PreferredGSGL list if( $#node_gsgl_flags >= 0 ){ @error_list = &process_flag_array(\@node_gsgl_flags); # process errors; if ( $#error_list >= 0 ) { $error_flag++; foreach $n ( @error_list ) { &printCEMsg("EMsgConfigRMcliBadPreferredSpecified", $file_name, $node_names[$n]); } } } # process Tiebreaker list if ( $#node_tiebreaker_flags >= 0 ){ @error_list = &process_flag_array(\@node_tiebreaker_flags); # process errors; if ( $#error_list >= 0 ) { $error_flag++; foreach $n ( @error_list ) { &printCEMsg("EMsgConfigRMcliBadTieBreakerSpecified", $file_name, $node_names[$n]); } } } if ( $error_flag ) { exit(CRM_CLI_USER_ERROR); } } # end of "opened ok" block # the file didn't open successfully else { # get the error $file_error = $!; # print error message and exit &printCEMsg("EMsgConfigRMcliFileError",$file_name,$file_error); exit(CRM_CLI_USER_ERROR); } # return the node names from the file return(\@node_names,\@node_numbers, \@node_quorum_flags, \@node_gsgl_flags, \@node_tiebreaker_flags); } # end get_nodes_nums_from_file #--------------------------------------------------------------------# # getIMsg : calls $LSMSG to print out the message with the # # required parameters, like printIMsg, except the message is # # returned instead of printed. Used for NLS. # # # # Parameters: # # msg in Message mnemonic / message number in a sense. # # optargs in Extra arguments/parameters to send to LSMSG. # # # # Returns: # # msgtext out Array of messages. # # # # Global Variables: # # $main::Trace in Print extra info when trace is on. # # $main::PROGNAME in Calling program/command for error message. # # $main::LSMSG in Path & Command to display messages. # # $main::MSGCAT in The calling commands Message catalogue. # #--------------------------------------------------------------------# sub getIMsg { my ($msg, @optargs) = @_; my ($optarg, $optargs); my @msgtext = (); $main::Trace && print STDERR "$main::LSMSG $main::PROGNAME $main::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) . "'"; if (scalar @optargs > 0) { @msgtext = `$main::LSMSG $main::PROGNAME $main::MSGCAT $msg $optargs`; } else { @msgtext = `$main::LSMSG $main::PROGNAME $main::MSGCAT $msg`; } return (@msgtext); } # end getIMsg #--------------------------------------------------------------------# # escape_selstr: # # Scans a to-be select string respecting multibyte encodings to # # add SQL escapes (#) escapes for %, #, and _ characters so they # # are not interpretted by SQL processing as special characters in # # an rmc select string. # # # # Paramaters: # # $string_in string to check for any needed SQL escapes. # # # # Returns: # # $string_out result. # # # #--------------------------------------------------------------------# sub escape_selstr { use POSIX; use POSIX qw(:stdlib_h); use POSIX qw(mblen); my $string_in = shift(@_); my $string_in2 = ""; my $string_out = ""; my $lenstring = 0; my $lenchar = 0; # get the length of the prospective select string $lenstring = length($string_in); # if there are no %,#,_, skip over checking char-by-char if ($string_in =~ /.*[%#_].*/) { for (my $i=0; $i<$lenstring; $i+=$lenchar) { # form the string of where we're at $string_in2 = substr($string_in,$i); # determine if this is a multibyte encoding (mblen>1) $lenchar = mblen ($string_in2, MB_CUR_MAX); # if it's length is less than 1, treat it as 1 character if (!$lenchar >= 1) { $lenchar = 1;} # if it's not multibyte and it's a backslash, escape it if ( ($lenchar == 1) && ($string_in2 =~ /^[%#_]/) ) { $string_out .= "#" . substr($string_in2,0,1); } # otherwise, just take it as it is else {$string_out .= substr($string_in2,0,$lenchar);} } } # it doesn't have any characters we're worried about so take it as is else {$string_out = $string_in;} return ($string_out); } # end escape_selstr #--------------------------------------------------------------------# # 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 from 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) { 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 #--------------------------------------------------------------------# # parse_flag: process the string that is passed in. This # # is used to match the specific character and give the correct # # value to node's attribute value according to the match result. # # # # Parameter: # # option_handle Referent to the string user input # # char The character to match up # # # # Return: # # flag_value The value according to user's # # specification char # # -1: no char match # # 0: match !char # # 1: match char but not !char # # 2: match both char and !char # # # #--------------------------------------------------------------------# sub parse_flag { my $char = ""; my $flag_value = -1; my $option_handle = ""; $option_handle = shift @_; $char = shift @_; if ( $$option_handle =~ /$char/i ) { if ( $$option_handle =~ /!$char/i ) { if( $$option_handle =~ /[^!]$char/i || $$option_handle =~ /^$char/i ) { $flag_value = 2; #2 stands for both $char and !$char are specified, it is an error $$option_handle =~ s/!$char//ig; $$option_handle =~ s/$char//ig; } else { $flag_value = 0; #0 stands for !$char is specified $$option_handle =~ s/!$char//ig; } } else { $flag_value = 1; #1 stands for $char is specified $$option_handle =~ s/$char//ig; } # end of "match /!$char/i" block } # end of "match /$char/i" block return $flag_value; } # end of parse_flag #--------------------------------------------------------------------# # process_flag_array: process the flag array, the flag array # # contains the value that user specifies for a node's attribute # # This function will check all the values in the array and # # rectify the values accoreding to some rule, will give out error # # message if the value is not correct. # # Following is the value's meaning in the array # # -1 : user didn't specify the attribute for the node # # 0 : user specified the attribute's value as 0; # # 1 : user specified the attribute's value as 1; # # 2 : user didn't correctly specify the attribute's value; # # # # # # Parameter: # # flag_array specific attribute array for the nodes # # # # Return: # # errors The index of false value of the array # # # #--------------------------------------------------------------------# sub process_flag_array { my $array_ref = ""; # the array reference. my @errors = (); # errors my $unset_flag = 0; my $false_flag = 0; my $true_flag = 0; my $coexist_flag = 0; my $n = 0; $array_ref = shift @_; foreach $n ( @$array_ref ) { if ( $n == -1 ) { $unset_flag++; next; } # if no P/Q (!P/!Q) specification, $unset_flag is set; if ( $n == 0 ) { $false_flag++; next; } # if there is !P/!Q specification, $false_flag is set; if ( $n == 1 ) { $true_flag ++; next; } # if there is P/Q specification, $true_flag is set; if ( $n == 2 ) { $coexist_flag++; next; } # if there is both P and !P(or both Q and !Q) # are specified for one node, $coexist_flag is set; } # - if '-1', '0', '1' co-exist in the array, # some nodes are specified Q/P, some nodes are specified !Q/!P, others # are not specified, this is an error. if ( $unset_flag && $true_flag && $false_flag ) { for( $n = 0; $n <= $#$array_ref; $n++ ) { if ( $$array_ref[$n] == -1 ) { push( @errors, $n ); } } } # end of "if ( $unset_flag && $true_flag && $false_flag )" block. # - if '2' exist in the array , # Q and !Q(or P and !P) co-exist for one node,this is an error if( $coexist_flag ){ for( $n = 0; $n <= $#$array_ref; $n++ ) { if ( $$array_ref[$n] == 2 ) { push( @errors, $n ); } } } # end of "if ( $coexist_flag )" block. # replace all unset flags with !set value. if ( $#errors < 0 && $unset_flag ) { if ( !$true_flag && !$false_flag ) { @$array_ref = (); } else { if ( $true_flag ) { $result_value = 0; } if ( $false_flag ) { $result_value = 1; } for ( $n = 0; $n <= $#$array_ref; $n++ ) { if ( $$array_ref[$n] == -1 ) { $$array_ref[$n] = $result_value; } } } } # end of "$error_flag ==0 AND $unset_flag != 0" block return @errors; } # end process_flag_array #--------------------------------------------------------------------# # form_quorum_attribute - This function forms the values for the # # Quorum attribute (not actual name). At present, the value comes # # from the quorum (Q) and tiebreaker (B) specifications in the node# # file. Depending on the values, the overal value needs to be set.# # Both quorum and tiebreaker arrays should not be empty. # # # # Input: # # /@node_quorum_flags Reference to a list of quorum flags. # # /@node_tiebreaker_flags Reference to a list of tiebreaker # # flags. # # # # Returns: # # /@node_quorum_attr_flags Reference to the resulting values for # # the quorum attribute. # # # #--------------------------------------------------------------------# sub form_quorum_attribute { my @node_quorum_attr_flags = (); # quorum attr to return my $quorum_flags = shift @_; my $tiebreaker_flags = shift @_; my $i = 0; # return empty array if both arrays are empty if ( ($#$quorum_flags >= 0) || ($#$tiebreaker_flags >= 0) ) { # if quorum array is empty, fill quorum array from tiebreaker if ($#$quorum_flags <0 ) { # default for quorum is yes, so value depends on tiebreaker # if tiebreaker yes, set to 1. if no, set to 3. for ($i=0; $i<=$#$tiebreaker_flags; $i++) { if ($$tiebreaker_flags[$i] == 0) { $node_quorum_attr_flags[$i] = 3; } else { $node_quorum_attr_flags[$i] = 1; } } } # if tiebreaker array is empty, fill quorum array from quorum elsif ($#$tiebreaker_flags <0) { # default for tiebreaker is yes, so value depends on quorum # if quorum yes, set to 1. if no, set to 2. # defect 147714. If tiebreaker is not specified, it's better to # set a value of 0 instead of 2 if quorum is no for ($i=0; $i<=$#$quorum_flags; $i++) { if ($$quorum_flags[$i] == 0) { $node_quorum_attr_flags[$i] = 0; } else { $node_quorum_attr_flags[$i] = 1; } } } # otherwise both quorum and tiebreaker are not empty else { # q 0 + t 0 = 0, q 1 + t 1 = 1 # q 0 + t 1 = 2, q 1 + t 0 = 3 for ($i=0; $i<=$#$quorum_flags; $i++) { if ( ($$quorum_flags[$i] == 0) && ($$tiebreaker_flags[$i] == 0) ) { $node_quorum_attr_flags[$i] = 0; } elsif ( ($$quorum_flags[$i] == 1) && ($$tiebreaker_flags[$i] == 1) ) { $node_quorum_attr_flags[$i] = 1; } elsif ( ($$quorum_flags[$i] == 0) && ($$tiebreaker_flags[$i] == 1) ) { $node_quorum_attr_flags[$i] = 2; } elsif ( ($$quorum_flags[$i] == 1) && ($$tiebreaker_flags[$i] == 0) ) { $node_quorum_attr_flags[$i] = 3; } # just in case else { $node_quorum_attr_flags[$i] = -1; } } } } # return the quorum attribute values return(\@node_quorum_attr_flags); } # end form_quorum_attribute # # get_IPv6Support - acquire value of IPv6Support # # parameters: # none # # returns: # $TRUE: IPv6Support is 1 # $FALSE: IPv6Support is 0 # # globals: # $main::Trace # sub get_IPv6Support { my $rc = 0; my @lsr_out = (); # check IPv6Support value - if the cluster doesn't support IPv6 then it # must be 0 @lsr_out = `$CTBINDIR/lsrsrc-api -I"$DELIMITER" -c IBM.NetworkInterface${DELIMITER}IPv6Support`; # capture the return code from lsrsrc-api $rc = $?; $rc = process_exit_code($rc); if ($main::Trace) { print STDERR "lsrsrc-api results:\n"; print "@lsr_out"; print STDERR "$PROGNAME: lsrsrc-api returned $rc\n"; } # show any errors if there was a bad rc if ($rc != 0) { process_api_error($DELIMITER,$rc,@lsr_out); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR); } my $IPv6Support = $lsr_out[0]; chomp($IPv6Support); return $IPv6Support == 1 ? $TRUE : $FALSE; } # get_domain_type information - acquire value of DomainType # # parameters: # none # # returns: # $TRUE: DomainType is 1 (Cluster Aware) # $FALSE: DomainType is 0 (Classic RPD) # # globals: # $main::Trace # sub get_domain_type { my $rc = 0; my @lsr_out = (); #check if DomainType exist @lsr_out = `$CTBINDIR/lsrsrcdef-api -r IBM.PeerDomain|grep DomainType`; if (scalar @lsr_out == 0) { return $FALSE; } # check DomainType value @lsr_out = `$CTBINDIR/lsrsrc-api -n -i -s IBM.PeerDomain::::DomainType`; # capture the return code from lsrsrc-api $rc = $?; $rc = process_exit_code($rc); if ($main::Trace) { print STDERR "lsrsrc-api results:\n"; print "@lsr_out"; print STDERR "$PROGNAME: lsrsrc-api returned $rc\n"; } # show any errors if there was a bad rc if ($rc != 0) { process_api_error($DELIMITER,$rc,@lsr_out); } # return ConfigRM CLI user error if it's an RMC CLI user error if ($rc == $RMC_CLI_USER_ERROR) { exit(CRM_CLI_USER_ERROR); } my $domaintype = $lsr_out[0]; chomp($domaintype); ($garb,$domaintype)=split('::',$domaintype); if($domaintype) { return $TRUE;} else { return $FALSE;} } #--------------------------------------------------------------------# # End Exported Subroutines (with @EXPORT_OK, -> on demand). # #--------------------------------------------------------------------# #--------------------------------------------------------------------# # End File. # #--------------------------------------------------------------------#