#!/usr/sbin/rsct/perl5/bin/perl
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
#  
#  
# Licensed Materials - Property of IBM 
#  
# (C) COPYRIGHT International Business Machines Corp. 2001,2007 
# 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 

# "@(#)39   1.7   src/rsct/pts/pam/config/linux_gpfs/cthatstune.perl, topology.services, rsct_relgh, relghs001a 6/28/04 00:17:06"

#########################################################################
#                                                                       #
# cthatstune - script to tune the Topology Services Daemon tunables.    #
# Syntax:                                                               #
#     cthatstune [-f [net:][frequency]] [-s [net:][sensitivity]]        #
#                [-p priority] [-l log_length] [-m pin_object]          #
#                [-r] [-v]                                              #
#                [-c clusterinfo_file | -C cluster_info_cmd]            #
#                [-i hats_info_file | -I hats_info_cmd]                 #
#                [-t topology_file | -T topology_cmd]                   #
#                [-d | -D]                                              #
#     cthatstune [-h]                                                   #
#                                                                       #
# Description: change and view Topology Services tunables               #
#                                                                       #
#     options:                                                          #
#     -c text file name containing cluster info in standard format      #
#     -C command name to produce cluster info in standard format        #
#     -d Only difference is output to CCAL. This is the default.        #
#     -D All configuration information, including unchanged items,      #
#        is output to CCAL.                                             #
#     -f frequency. detail see description for network specific option  #
#     -h print usage message                                            #
#     -i hats_info_file: specify the textfile that contains the HATS    #
#         global parameters in the standard format                      #
#     -I hats_info_cmd: specify the executable that produces the HATS   #
#         global parameters to standard output                          #
#     -l maximum log file length. The length should be a positive       #
#        integer, "DEFAULT", or "VIEW".                                 #
#     -m memory pinning. Valid values are: "NONE", "TEXT", "DATA",      #
#        "STACK", "PROC", and "VIEW". Multiple values can be used.      #
#        The final value is the "or" (sum) of all values. e.g. the      #
#        result of "-m NONE,TEXT,DATA" is to pin "TEXT and DATA".       #
#     -p priority. Valid priority values are: a positive integer for    #
#        fixed priority, 0 for regular priority, "DEFAULT" for default  #
#        value, or "VIEW" for viewing the current value.                #
#     -r refresh to make new tunables take effect                       #
#     -s sensitivity. detail see description for network specific option#
#     -t topology_file: specify the text file that contains the HATS    #
#         topology information in the standard format                   #
#     -T topology_cmd: specify the executable that produces the HATS    #
#         topology information to standard output                       #
#     -v verbose. print results for tunable settings too.               #
#                                                                       #
# Network specific option specification:                                #
#     Network specific options, e.g. heartbeat frequency, can be tuned  #
#     or viewed in per-network basis. The format is:                    #
#         -f network:value                                              #
#     where network is the network name or "ALL" and value is the value #
#     to be set, "DEFAULT" for default value or "VIEW" for viewing the  #
#     current value.                                                    #
#     Multiple use of network specific options can be used to change    #
#     multiple network specific options at a time. All options should   #
#     be separated by ','. e.g.                                         #
#         -f network1:value1,network2:value2,...                        #
#                                                                       #
# HATS info and topology options:                                       #
#     cthatstune will retrieve and write back HATS tunables. If a text  #
#     file "filename" is given as the value of "-i" or "-t" option,     #
#     the new setting will be writen to "filename.new". Note that       #
#     "filename.new" contains only the changes.                         #
#     If "-I" or "-T" is used, two commands must be given in the        #
#     following format:                                                 #
#         -I read_cmd:write_cmd                                         #
#     If only one command is given, cthatstune will use read_cmd with   #
#     "-w" option to write the tunable changes.                         #
#                                                                       #
# "hatsctrl" changes HATS tunable default values also. Change default   #
# values in hatsctrl if anything changed in cthatstune.                 #
#                                                                       #
#########################################################################

#=======================================================================#
#                                                                       #
# Main program starts                                                   #
#                                                                       #
#=======================================================================#

die "Requires Perl Version 5, this is Version $]\n" if $] < 5.000;

$|=1; # force a flush after every print
use File::Basename;     # for basename()
use Getopt::Std;        # for getopts()
# External commands. Specify full paths to make sure we run the right commands.
$RSCT_ROOT = "/usr/sbin/rsct";
$RSCT_BIN = "$RSCT_ROOT/bin";
$RSCT_MSGMAP = "$RSCT_ROOT/msgmaps";
$SCRIPT = basename($0);
$TUNE_SFX = "tune";
$CTRL_SFX = "ctrl";
$DFLT_HATS_SUBSYS = "$RSCT_BIN/cthats";
$DFLT_HATS_CTRL = "$RSCT_BIN/cthatsctrl";
$DFLT_CLUSTER_INFO = "$RSCT_BIN/ct_clusterinfo";
# By default, use "ct_hats_info -w" to write back information received
# from "ct_hats_info" and "ct_topology_info -w" to write back information 
# received from "ct_topology_info".
$DFLT_HATS_INFO = "$RSCT_BIN/ct_hats_info";
$DFLT_TOPOLOGY_INFO = "$RSCT_BIN/ct_topology_info";
$DFLT_WRITE_OPTION = " -w";
$SPACE_CHARS = "	 \n";   # space, tab, and carriage return
$CONST_VIEW = "VIEW";           # option string: view value only
$CONST_DEFAULT = "DEFAULT";     # option string: use default value
$CONST_ALL_NET = "ALL";         # option string: for all networks
# We should use 0 for $FULL_WRITE_BACK. However, it may break the cluster
# manager if it doesn't merge the changed items correctly. It may be safer
# to use 1 until we are sure the cluster manager merges changes correctly.
$FULL_WRITE_BACK = 1;           # Write back unchanged items to repository, too
$BOUNCE_CONFIG_INST = 1;        # Increase the value of CONFIG_INST keyword
$DFLT_NUMERIC_VALUE = -1;
$DFLT_STRING_VALUE = "DEFAULT";

# 0: no debug info, 1: brief info, 2: detailed info, 3: very detailed
# Use subroutine name for key and debug level for value. e.g. "main" => 1.
# Please keep this hash in lexical order for human easy search.
%HATS_DBG=(
    "add_action" => 0,
    "apply_unused_action" => 0,
    "argument_syntax_chk" => 0,
    "de_quote" => 0,
    "fatal_error" => 0,
    "get_cluster_info" => 0,
    "get_curr_actions" => 0,
    "get_exit_code" => 0,
    "main" => 0,
    "parse_configure" => 0,
    "path_search" => 0,
    "read_repository" => 0,
    "set_action_list" => 0,
    "take_action" => 0,
    "write_repository" => 0,
    "extra_entry_have_no_trailing_comma" => 0
);

# The following hash contains the tunable attributes.
# The hash contains only avaliable tunables. Check the existence of a 
# variable name in this hash to determine if it is tunable.
%TUNABLE_NAME = (
    "FIXED_PRI"    => "PRIO",
    "LOGFILELEN"   => "LOGL",
    "NETWORK_FREQ" => "NETWORK_FREQ",
    "NETWORK_SENS" => "NETWORK_SENS",
    "PIN"          => "MEMP"
);
# Tunable to command line option mapping
%TUNABLE_OPT_NAME = (
    "FIXED_PRI"    => "p",
    "LOGFILELEN"   => "l",
    "NETWORK_FREQ" => "f",
    "NETWORK_SENS" => "s",
    "PIN"          => "m"
);
# Tunable applies to a specific network : 0: no, 1: yes
%TUNABLE_IS_PER_NET = (
    "FIXED_PRI"    => 0,
    "LOGFILELEN"   => 0,
    "NETWORK_FREQ" => 1,
    "NETWORK_SENS" => 1,
    "PIN"          => 0
);
# Tunable data type : 0: string, 1: numeric
%TUNABLE_IS_NUM = (
    "FIXED_PRI"    => 1,
    "LOGFILELEN"   => 1,
    "NETWORK_FREQ" => 1,
    "NETWORK_SENS" => 1,
    "PIN"          => 0
);

# Set up PATH so that external commands do not need to use absolute paths.
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin:${RSCT_BIN}";

# Set message catalogue and message set names. 
$MSGSET = "hatstune"; 
$SUBSYS = $SCRIPT;
$SUBSYS =~ s/${TUNE_SFX}//;
$CATFILE = (-r "$RSCT_MSGMAP/$SUBSYS.$MSGSET.map") ? "$SUBSYS.cat" : "hats.cat";
$ENV{MSGMAPPATH} = "$RSCT_MSGMAP";
$MSGCMD = "$RSCT_BIN/ctdspmsg $MSGSET $CATFILE";

    #
    # Main program starts here.
    #
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): $0 starts.\n";
    }

    # Set HATS parameter validation program path. The HATS parameter
    # validation program name is the HATS tuning program name without 
    # trailing "tune." e.g. if the tuning program is cthatstune, the
    # validation program should be cthats. If the validation program
    # does not exist, use the default validation program.
    if ($SCRIPT =~ m/.+${TUNE_SFX}$/) {
        $HATS_SUBSYS = $0;
        $HATS_SUBSYS =~ s/${TUNE_SFX}$//;
        if (! -x $HATS_SUBSYS) {
            $HATS_SUBSYS = $DFLT_HATS_SUBSYS;
            if (! -x $DFLT_HATS_SUBSYS) {
                if (-e $DFLT_HATS_SUBSYS) {
                    #"Command $DFLT_HATS_SUBSYS is not executable"
                    fatal_error(1, "EMSG763", "$SCRIPT", "$DFLT_HATS_SUBSYS");
                } else {
                    #"File $DFLT_HATS_SUBSYS does not exist"
                    fatal_error(1, "EMSG760", "$SCRIPT", "$DFLT_HATS_SUBSYS");
                }
            }
        }
        $HATS_CTRL = $0;
        $HATS_CTRL =~ s/${TUNE_SFX}$/${CTRL_SFX}/;
        if (! -x $HATS_CTRL) {
            $HATS_CTRL = $DFLT_HATS_CTRL;
            if (! -x $DFLT_HATS_CTRL) {
                if (-e $DFLT_HATS_CTRL) {
                    #"Command $DFLT_HATS_CTRL is not executable"
                    fatal_error(1, "EMSG763", "$SCRIPT", "$DFLT_HATS_CTRL");
                } else {
                    #"File $DFLT_HATS_CTRL does not exist"
                    fatal_error(1, "EMSG760", "$SCRIPT", "$DFLT_HATS_CTRL");
                }
            }
        }
    } else {
        # The official name of this program is cthatstune. The execution
        # flow should never get here unless the script is given a different
        # name. This checking is for developers' use only. No need to use
        # print_message() for this message.
        print STDERR "This HATS tuning script must be called xxxxtune\n";
        exit(1);
    }
    if ($HATS_DBG{"main"} >= 1) {
        print STDERR "main(): Using $HATS_SUBSYS for value validation\n";
    }

    if (argument_syntax_chk() != 0) {
        print_usage();
        exit(1);
    }

    # Start option processing.

    # Print brief usage message if -h option is specified.
    if (exists($opts{h}) && $opts{h}) {
        print_usage();
        exit(0);
    }

    # In addition to the changed items, the unchanged items should be
    # written back to repository, too.
    # The default behavior is to write back changed items only unless
    # we are writting back to the text files we got the configuration from.
    $full_write_back_info = (exists($opts{i})) ? 1 : $FULL_WRITE_BACK;
    $full_write_back_topology = (exists($opts{t})) ? 1 : $FULL_WRITE_BACK;
    if (exists($opts{d}) && $opts{d}) {
        $full_write_back_info = 0;
        $full_write_back_topology = 0;
    }
    if (exists($opts{D}) && $opts{D}) {
        $full_write_back_info = 1;
        $full_write_back_topology = 1;
    }

    # Build an action list based on the command line options.
    $user_want_to_change = set_action_list();
    $num_of_change = 0;

    # Cluster info is needed first.
    # get_cluster_info() will fill in the values for $cluster_name,
    # $cluster_id and $node_number.
    if (get_cluster_info($cluster_name, $cluster_id, $node_number) == -1) {
        #"Could not get cluster information from $DFLT_CLUSTER_INFO"
        fatal_error(1, "EMSG785", "$SCRIPT", "$DFLT_CLUSTER_INFO");
    }
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): cluster_name=$cluster_name," .
            " cluster_id=$cluster_id, node_number=$node_number.\n";
    }

    if ($user_want_to_change) {
        # We may need to lock the repository here.
        $repository_locked = 1;
    } else {
        $repository_locked = 0;
    }
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): repository_locked=$repository_locked.\n";
    }

    # Read in the current setting from repository
    read_repository();

    $curr_network = "";         # parsing global section
    $saved_network_name = "";
    %curr_action_list = %action_list_global;
    $full_write_back = $full_write_back_info;
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): global action: " . 
            (join(', ', %curr_action_list))."\n";
    }
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): parsing hats_info file.\n";
    }
    parse_configure(\@hats_info_file, \@hats_info_tune);
    if ($HATS_DBG{"main"}) {
        print STDERR "main(): parsing topology_info file.\n";
    }
    $full_write_back = $full_write_back_topology;
    parse_configure(\@topology_info_file, \@topology_info_tune);

    # List the networks specified by the user but not defined in the repository.
    @undefined_net = keys %action_list_pernet;
    if ($#undefined_net >= 0) {
        foreach $net (@undefined_net) {
            #print STDOUT "Network $net is not defined.\n";
            print_message("I_CTTUNE_NetUndefined", "$net");
        }
    }
    if ($HATS_DBG{"main"}) {
        foreach $net (keys %action_list_pernet) {
            $opt_list = join(', ', keys %{$action_list_pernet{$net}});
            print STDERR "main(): Network $net for $opt_list not defined.\n";
        }
    }
    if ($repository_locked) {
        if ($HATS_DBG{"main"}) {
            print STDERR "main(): writing repository.\n";
        }
        # Do not write back to the repository unless there really is
        # something to write back.
        if ($num_of_change) {
            if (exists($opts{v}) && $opts{v}) {
                #print STDOUT "Updating the changed configuration " .
                #    "to the repository.\n";
                print_message("I_CTTUNE_UpdateConfig");
            }
            write_repository();
            # Configuration changed. Rebuild machines.lst file too.
            $hats_subsys_opts = "";
            foreach $i ("c", "C", "i", "t") {
                if (exists($opts{$i})) {
                    $hats_subsys_opts = $hats_subsys_opts . " -$i $opts{$i}";
                }
            }
            if (exists($opts{I})) {
                $hats_subsys_opts = $hats_subsys_opts . " -I $hats_info_read";
            }
            if (exists($opts{T})) {
                $hats_subsys_opts = $hats_subsys_opts . " -T $topology_info_read";
            }
            `$HATS_SUBSYS -b $hats_subsys_opts`;
        } else {
            #print STDOUT "\nThe specified changes are identical to
            #    the current configuration.\nNothing is updated to
            #    the repository.\n"
            print_message("I_NoChange");
        }
        # We may need to unlock the repository here.
        $repository_locked = 0;
    }

    # Do a refresh if -r is specified.
    if (exists($opts{r}) && $opts{r}) {
        if ($HATS_DBG{"main"}) {
            print STDERR "main(): calling $HATS_CTRL -r to refresh.\n";
        }
        `$HATS_CTRL -r`;
        $rc = get_exit_code($?);
        if ($rc) {
            #"Refresh failed. New tunable values are not propagated
            #to all nodes."
            fatal_error(1, "EMSG786", "$SCRIPT");
        }
    }

    exit(0);    # exit 0 to make sure all exit values are defined.

#=======================================================================#
#                                                                       #
# Main program ends                                                     #
#                                                                       #
#=======================================================================#

#=======================================================================#
#                                                                       #
# Function: argument_syntax_chk                                         #
# Description: Check if the syntax of the given command line options    #
#     are correct.                                                      #
#     We want to find as many syntax errors as possible. Do not use     #
#     fatal_error() to abort execution.                                 #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return:                                                               #
#     0 : successful                                                    #
#     1 : there are some syntax errors                                  #
# Global:                                                               #
#     %opts: option values.                                             #
#                                                                       #
#=======================================================================#

sub argument_syntax_chk {
    my ($ret);
    my ($syntax_err);
    local ($unknown_opt);
    local ($i);

    $ret = getopts('c:C:dDf:hi:I:l:m:p:rs:t:T:v', \%opts);

    # Syntax checking
    if ($ret) {
        $syntax_err = 0;
    } else {
        $syntax_err = 1;
        # getopts() does not print error message for not specifying
        # an argument for a flag that expects one. The cooresponding 
        # variable in %opts will be created but no value is assigned.
        foreach $i (keys %opts) {
            if (! defined($opts{$i})) {
                #print STDERR "Command line option -$i needs an argument\n";
                print_errormsg("EMSG775", "$SCRIPT", "-$i");
            }
        }
    }

    # All options should have been parsed. Anything left is an error.
    if ($#ARGV != -1) {
        $unknown_opt = join(", ", @ARGV);
        #print STDERR "Unrecognized command line options: $unknown_opt\n";
        print_errormsg("EMSG776", "$SCRIPT", "\"$unknown_opt\"");
        $syntax_err = 1;
    }

    $has_useful_opt = (exists($opts{f}) || exists($opts{l}) ||
        exists($opts{m}) || exists($opts{p}) || exists($opts{s}) ||
        exists($opts{v}) || exists($opts{r}));
    # -h is mutually exclusive with all other operational options
    if (exists($opts{h}) && $has_useful_opt) {
        #print STDERR "Option -h is mutually exclusive with all other
        #    options.\n";
        print_errormsg("EMSG777", "$SCRIPT", "-h");
        $syntax_err = 1;
    }

    # Check for conflicts between options providing the same information
    foreach $i ("c", "d", "i", "t") {
        if (exists($opts{$i}) && exists($opts{uc($i)})) {
            #print STDERR "Command line option -$i cannot be used with -" .
            #    uc($i) . ".\n";
            print_errormsg("EMSG778", "$SCRIPT", "-$i", "-" . uc($i));
            $syntax_err = 1;
        }
    }

    # "-i config_file_name" has the highest priority. If -i is not 
    # specified, "-I read_config_cmd:write_config_cmd" is checked.
    # If -I is not specified, use $DFLT_HATS_INFO as the default read
    # configuration command and $DFLT_HATS_INFO with $DFLT_WRITE_OPTION
    # as the default write configuration command.
    if (! exists($opts{i}) || ! $opts{i}) {
        if (exists($opts{I})) {
            ($hats_info_read, $hats_info_write) = split(":", $opts{I}, 2);
        } else {
            $hats_info_read = "";
            $hats_info_write = "";
        }
        if (! defined($hats_info_read) || ! $hats_info_read) {
            $hats_info_read = $DFLT_HATS_INFO;
        }
        if (! defined($hats_info_write) || ! $hats_info_write) {
            $hats_info_write = $hats_info_read . $DFLT_WRITE_OPTION;
        }
    }
    # "-t config_file_name" has the highest priority. If -t is not 
    # specified, "-T read_config_cmd:write_config_cmd" is checked.
    # If -T is not specified, use $DFLT_TOPOLOGY_INFO as the default read
    # configuration command and $DFLT_TOPOLOGY_INFO with $DFLT_WRITE_OPTION
    # as the default write configuration command.
    if (! exists($opts{t}) || ! $opts{t}) {
        if (exists($opts{T})) {
            ($topology_info_read, $topology_info_write) =
                split(":", $opts{T}, 2);
        } else {
            $topology_info_read = "";
            $topology_info_write = "";
        }
        if (! defined($topology_info_read) || ! $topology_info_read) {
            $topology_info_read = $DFLT_TOPOLOGY_INFO;
        }
        if (! defined($topology_info_write) || ! $topology_info_write) {
            $topology_info_write = $topology_info_read . $DFLT_WRITE_OPTION;
        }
    }
    if ($HATS_DBG{"argument_syntax_chk"}) {
        print STDERR "argument_syntax_chk(): hats_info: " .
            ((exists($opts{i}) && $opts{i}) ? "data=$opts{i};" :
                "read=$hats_info_read, write=$hats_info_write;") .
                " topology_info: " . 
                ((exists($opts{t}) && $opts{t}) ? "data=$opts{t};\n" :
                "read=$topology_info_read, write=$topology_info_write;\n");
    }

    # When no useful option is specified, we print usage message.
    if (! $syntax_err && ! exists($opts{h}) && ! $has_useful_opt) {
        $opts{h} = 1;
    }
    return ($syntax_err);
}

#=======================================================================#
#                                                                       #
# Function: print_usage                                                 #
# Description: print the usage message                                  #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub print_usage {
    #print STDERR "cthatstune [-f [[net]:][frequency]] [-s [[net]:][sensitivity]]\n";
    #print STDERR "    [-p priority] [-l log_length] [-m pin_object] [-r] [-v]\n";
    #print STDERR "cthatstune [-h]\n";
    print_message("I_CTTUNE_Usage", "$SCRIPT");
}

#=======================================================================#
#                                                                       #
# Function: set_action_list                                             #
# Description: parse action command line options, check if the value    #
#     is valid and build the action list.                               #
#                                                                       # 
#     $action_list_pernet consists of an array of network names for     #
#     network specific actions. $action_list_allnet consists of the     #
#     default actions to apply to all networks if the actions are not   #
#     specified in $action_list_pernet.                                 #
#                                                                       #
#     The tunables are changed atomically. There is no physical         #
#     change made until all command line options specified by users are #
#     free of data range errors. Errors found by this subroutine use    #
#     fatal_error() to exit the program.                                #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return:                                                               #
#     0 : No value change option is specified.                          #
#     1 : One or more value may be changed.                             #
#                                                                       #
#=======================================================================#

sub set_action_list {
    local ($tunable_changed);
    local ($keyword, $opt_name, $net_name);

    $tunable_changed = 0;
    foreach $keyword (keys %TUNABLE_NAME) {
        $opt_name = $TUNABLE_OPT_NAME{$keyword};
        if ($HATS_DBG{"set_action_list"}) {
            print STDERR "set_action_list(): checking option $opt_name for " .
                "keyword=$keyword.\n";
        }
        if (exists($opts{$opt_name})) {
            $opts{$opt_name} = de_quote($opts{$opt_name});
            $is_per_net = $TUNABLE_IS_PER_NET{$keyword};
            if ($is_per_net) {
                # per-net option. process one network at a time
                $opt_values = $opts{$opt_name};
                while (defined($opt_values) && $opt_values) {
                    ($opt_val, $opt_values) = split(/,/, $opt_values, 2);
                    if ($opt_val =~ /:/) {
                        ($net_name, $opt_val) = split(/:/, $opt_val, 2);
                        if ($net_name eq $CONST_ALL_NET) {
                            $net_name = "";
                        }
                    } else {
                        $net_name = "";
                    }
                    if (add_action($keyword, $opt_val, $net_name, 1) > 0) {
                        $tunable_changed = 1;
                    }
                }
            } else {
                # global option
                $opt_val = $opts{$opt_name};
                if ($opt_val =~ /:/) {
                    #"':' cannot be used with command option -$opt_name"
                    fatal_error(1, "EMSG779", "$SCRIPT", "\\\':\\\'",
                        "-$opt_name");
                }
                $net_name = "";
                if (add_action($keyword, $opt_val, $net_name, 1) > 0) {
                    $tunable_changed = 1;
                }
            }
        }
    }
    if ($HATS_DBG{"set_action_list"}) {
        print STDERR "set_action_list(): returning $tunable_changed\n";
    }
    return ($tunable_changed);
}

#=======================================================================#
#                                                                       #
# Function: add_action                                                  #
# Description: add an action to the action list                         #
#                                                                       #
# Input:                                                                #
#     keyword: keyword name                                             #
#     action: the action to be added                                    #
#     net_name: name of the network or "" for all networks              #
#     check_conflict: if an action has already been set for the target: #
#         TRUE: call fatal_error() to exit                              #
#         FALSE: replace the current action with the new action.        #
#                                                                       #
# Output: None                                                          #
# Return:                                                               #
#     1 : successful, the action will change tunable.                   #
#     0 : successful, the action will not change tunable.               #
#                                                                       #
#=======================================================================#

sub add_action {
    local ($keyword, $action, $net_name, $check_conflict) = @_;
    local ($new_action);
    local ($rc, $return_code);

    if ($HATS_DBG{"add_action"}) {
        print STDERR "add_action(): In, keyword=$keyword, action=$action, " .
            "net_name=$net_name, check_conflict=$check_conflict\n";
    }
    $return_code = 0;
    $is_per_net = $TUNABLE_IS_PER_NET{$keyword};
    # $net_name = "" means the action applies to all networks.
    if ($action eq $CONST_VIEW) {
        $new_action = $CONST_VIEW;
    # Defect 97577
    # $action definitely can have a value of zero (0) 
    ##### } elsif ((! $action) || ($action eq $CONST_DEFAULT)) {
    } elsif ($action eq $CONST_DEFAULT) {
        $new_action = ($TUNABLE_IS_NUM{$keyword})
            ? $DFLT_NUMERIC_VALUE : $DFLT_STRING_VALUE;
        $return_code = 1;
    } else {
        # $action is a new value. Use $HATS_SUBSYS -V to check if the
        # value is valid.
        `$HATS_SUBSYS -V $TUNABLE_NAME{$keyword}:$action > /dev/null`;
        $rc = get_exit_code($?);
        if ($rc == 0) {
            $new_action = $action;
            $return_code = 1;
        } else {
            #"\"$action\" is not a valid value for tunable $keyword"
            fatal_error(2, "EMSG781", "$SCRIPT", "$action", "$keyword");
        }
    }

    if ($is_per_net) {
        if ($net_name) {
            if ($check_conflict &&
                exists(${$action_list_pernet{$net_name}}{$keyword})) {
                #"Per-network tunable \"$keyword\" redefined for
                #network $net_name"
                fatal_error(1, "EMSG783", "$SCRIPT", "$keyword", "$net_name");
            } else {
                ${$action_list_pernet{$net_name}}{$keyword} = $new_action;
            }
        } else {
            if ($check_conflict && exists($action_list_allnet{$keyword})) {
                #"Global tunable \"$keyword\" redefined
                fatal_error(1, "EMSG782", "$SCRIPT", "$keyword");
            } else {
                $action_list_allnet{$keyword} = $new_action;
            }
        }
    } else {
        if ($check_conflict && exists($action_list_global{$keyword})) {
            #"Global tunable \"$keyword\" redefined
            fatal_error(1, "EMSG782", "$SCRIPT", "$keyword");
        } else {
            $action_list_global{$keyword} = $new_action;
        }
    }

    if ($HATS_DBG{"add_action"}) {
        print STDERR "add_action(): set is_per_net=$is_per_net, " .
            "network:$net_name, tunable keyword:$keyword, " .
            "action:$new_action.\n";
    }
    return ($return_code);
}

#=======================================================================#
#                                                                       #
# Function: get_cluster_info                                            #
# Description: get cluster name, cluster id,  and node number from the  #
#     command or text file specified by -c or -C option.                #
#                                                                       #
# Input: None                                                           #
# Output:                                                               #
#     cluster_name: cluster name                                        #
#     cluster_id: cluster ID                                            #
#     node_number: node number                                          #
# Return:                                                               #
#     0 : success                                                       #
#     -1: not success                                                   #
#                                                                       #
#=======================================================================#

sub get_cluster_info {
    local ($cluster_name, $cluster_id, $node_number);
    local (@ct_clusterinfo);
    local ($return_code, $i);

    $return_code = 0;
    # Initialize important configuration variables.
    if (exists($opts{c}) && $opts{c}) {             # 1'st choice: -c
        if (-r $opts{c}) {
            @ct_clusterinfo = `cat $opts{c}`;
        } else {
            #print STDERR "$opts{c} is not readable.\n";
            print_errormsg("EMSG761", "$SCRIPT", "$opts{c}");
            $return_code = -1;
        }
    } elsif (exists($opts{C}) && $opts{C}) {        # 2'nd choice: -C
        if (-x $opts{C}) {
            @ct_clusterinfo = `$opts{C}`;
        } else {
            #print STDERR "$opts{C} is not executable.\n";
            print_errormsg("EMSG763", "$SCRIPT", "$opts{C}");
            $return_code = -1;
        }
    } else {                    # default: ct_clusterinfo
        if (-x $DFLT_CLUSTER_INFO) {
            @ct_clusterinfo = `$DFLT_CLUSTER_INFO`;
        } else {
            #print STDERR "$DFLT_CLUSTER_INFO is not executable.\n";
            print_errormsg("EMSG763", "$SCRIPT", "$DFLT_CLUSTER_INFO");
            $return_code = -1;
        }
    }

    # We have cluster info in "standard" format. Parse it to get
    # cluster name, cluster ID, and port number.
    # The standard format looks like:
    # CLUSTER_NAME  IW
    # CLUSTER_ID    7d2ce04c-fee0-4f47-a4c2-ada54f782cde
    # NODE_NUMBER   1
    if ($return_code == 0) {
        chomp(@ct_clusterinfo);     # chop trailing '\n'
        foreach $i (@ct_clusterinfo) {
            ($keyword, $keyvalue, $junk) = split(/[$SPACE_CHARS]+/, $i, 3);
            if (defined($junk)) {
                #print STDERR "Extra parameter \"$junk\" in tunable $keyword.\n";
                print_errormsg("EMSG780", "\"$junk\"", "$keyword");
            }
            if (! defined($keyvalue) || ! $keyvalue) {
                $return_code = -1;
            } else {
                SWITCH_CT_CLUSTERINFO: {
                    if ($keyword eq "CLUSTER_NAME") {
                        $cluster_name = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                    if ($keyword eq "CLUSTER_ID") {
                        $cluster_id = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                    if ($keyword eq "NODE_NUMBER") {
                        $node_number = $keyvalue;
                        last SWITCH_CT_CLUSTERINFO;
                    }
                }   # end SWITCH_CT_CLUSTERINFO
            }
        }           # end foreach
    }
    if (($return_code == 0) && $cluster_name && $cluster_id && $node_number) {
        $_[0] = $cluster_name;
        $_[1] = $cluster_id;
        $_[2] = $node_number;
    } else {
        $return_code = -1;
    }
    if ($HATS_DBG{"get_cluster_info"}) {
        print STDERR "get_cluster_info(): cluster_name=$cluster_name, " .
            "cluster_id=$cluster_id, node_number=$node_number.\n";
    }
    return ($return_code);
}

#=======================================================================#
#                                                                       #
# Function: read_repository                                             #
# Description: read the settings from the repository or config files.   #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
# Global:                                                               #
#     The global configuration is kept in the global list array         #
#     @hats_info_file. The topology configuration is kept in            #
#     $topology_info_file.                                              #
#                                                                       #
#=======================================================================#

sub read_repository {
    local ($rc, $i);

    if (exists($opts{i}) && $opts{i}) {
        if (-r $opts{i}) {
            open(FP, "< $opts{i}");
            @hats_info_file = <FP>;
            close(FP);
        } else {
            #"File $opts{i} is not readable"
            fatal_error(1, "EMSG761", "$SCRIPT", "$opts{i}");
        }
    } else {
        @hats_info_file = `$hats_info_read`;
        $rc = get_exit_code($?);
        if ($rc) {
            #"\"$hats_info_read\" command exits with exit code=$rc"
            fatal_error(1, "EMSG764", "$SCRIPT", "$hats_info_read", "$rc");
        }
    }

    if (exists($opts{t}) && $opts{t}) {
        if (-r $opts{t}) {
            open(FP, "< $opts{t}");
            @topology_info_file = <FP>;
            close(FP);
        } else {
            #"File $opts{t} is not readable"
            fatal_error(1, "EMSG761", "$SCRIPT", "$opts{t}");
        }
    } else {
        @topology_info_file = `$topology_info_read`;
        $rc = get_exit_code($?);
        if ($rc) {
            #"\"$topology_info_read\" command exits with exit code=$rc"
            # Defect 81109 - New error message for "CCAL" commands, indicating
            # that likely cause of failure is offline cluster
            fatal_error(1, "EMSG771", "$SCRIPT", "$topology_info_read", "$rc");
        }
    }
    # chop the '\n' character.
    chomp @hats_info_file;
    chomp @topology_info_file;
    if ($HATS_DBG{"read_repository"} >= 2) {
        print STDERR "read_repository(): in-core hats_info file:\n";
        foreach $i (@hats_info_file) {
            print STDERR "=>$i<=\n";
        }
        print STDERR "read_repository(): in-core topology_info file:\n";
        foreach $i (@topology_info_file) {
            print STDERR "=>$i<=\n";
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: write_repository                                            #
# Description: write the changed HATS configuration in global list      #
#     @hats_info_tune and @hats_topology_tune back to the repository    #
#     or config files.                                                  #
#     If the configuration file was used when reading the configuration #
#     ($opts{"i"} or $opts{"t"} is specified), the configuration file   #
#     is renamed to $opts{"i"}.bak or $opts{"t"}.bak before the changed #
#     HATS configuration is written back to the configuration file.     #
#     If the configuration was read in by command $hats_info_read or    #
#     $hats_topology_read, then $hats_info_write or $hats_topology_write#
#     is used to write back the configuration.                          #
#                                                                       #
# Input: None                                                           #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub write_repository {
    local ($i);
    local ($rc);

    if ($HATS_DBG{"write_repository"} >= 2) {
        print STDERR "write_repository(): in-core hats_info file:\n";
        foreach $i (@hats_info_tune) {
            print STDERR "=>$i<=\n";
        }
        print STDERR "write_repository(): in-core topology_info file:\n";
        foreach $i (@topology_info_tune) {
            print STDERR "=>$i<=\n";
        }
    }

    if (exists($opts{i}) && $opts{i}) {
        if ($HATS_DBG{"write_repository"}) {
            print STDERR "Renaming $opts{i} to $opts{i}.bak\n";
        }
        $rc = rename($opts{i}, "$opts{i}.bak");
        if (!$rc) {
            #"Cannot rename file $opts{i} to $opts{i}.bak"
            fatal_error(3, "EMSG770", "$SCRIPT",
                "$opts{i}", "$opts{i}.bak");
        }
        $rc = open(FP, "> $opts{i}");
        if (!$rc) {
            #"Cannot open file $opts{i} for write"
            fatal_error(3, "EMSG765", "$SCRIPT", "$opts{i}");
        }
        foreach $i (@hats_info_tune) {
            $rc = print FP "$i\n";
            if (!$rc) {
                #"Cannot write data to $opts{i}\n"
                fatal_error(3, "EMSG766", "$SCRIPT", "$opts{i}");
            }
        }
        $rc = close(FP);
        if (!$rc) {
            #"Cannot close file $opts{i}"
            fatal_error(3, "EMSG769", "$SCRIPT", "$opts{i}");
        }
    } else {
        if ($HATS_DBG{"write_repository"}) {
            print STDERR "Running $hats_info_write to write back hats_info\n";
        }
        $rc = open(FP, "| $hats_info_write");
        if (!$rc) {
            #"Cannot open pipe to $hats_info_write"
            fatal_error(3, "EMSG767", "$SCRIPT", "$hats_info_write");
        }
        foreach $i (@hats_info_tune) {
            $rc = print FP "$i\n";
            if (!$rc) {
                #"Cannot pipe data to $hats_info_write"
                fatal_error(3, "EMSG768", "$SCRIPT", "$hats_info_write");
            }
        }
        $rc = close(FP);
        # Status of pipe goes into $?
        # ct_hats_info -w returns '!= 0' in case of error
        if ($? != 0) {
            # ctdspmsg does not handle arguments with ' ' chars in it,
            # so the options used in $hats_info_write are not displayed
            $cmd = $hats_info_write;
            $cmd =~ s/ .*$//;
            fatal_error(3, "EMSG771", "$SCRIPT", $cmd, $?);
        }
    }
    if (exists($opts{t}) && $opts{t}) {
        if ($HATS_DBG{"write_repository"}) {
            print STDERR "Renaming $opts{t} to $opts{t}.bak\n";
        }
        $rc = rename($opts{t}, "$opts{t}.bak");
        if (!$rc) {
            #"Cannot rename file $opts{t} to $opts{t}.bak"
            fatal_error(3, "EMSG770", "$SCRIPT",
                "$opts{t}", "$opts{t}.bak");
        }
        $rc = open(FP, "> $opts{t}");
        if (!$rc) {
            #"Cannot open file $opts{t} for write"
            fatal_error(3, "EMSG765", "$SCRIPT", "$opts{t}");
        }
        foreach $i (@topology_info_tune) {
            $rc = print FP "$i\n";
            if (!$rc) {
                #"Cannot write data to $opts{t}"
                fatal_error(3, "EMSG766", "$SCRIPT", "$opts{t}");
            }
        }
        $rc = close(FP);
        if (!$rc) {
            #"Cannot close file $opts{t}
            fatal_error(3, "EMSG769", "$SCRIPT", "$opts{t}");
        }
    } else {
        if ($HATS_DBG{"write_repository"}) {
            print STDERR "Running $topology_info_write to write back topology_info\n";
        }
        $rc = open(FP, "| $topology_info_write");
        if (!$rc) {
            #"Cannot open pipe to $topology_info_write"
            fatal_error(3, "EMSG767", "$SCRIPT", "$topology_info_write");
        }
        foreach $i (@topology_info_tune) {
            $rc = print FP "$i\n";
            if (!$rc) {
                #"Cannot pipe data to $topology_info_write"
                fatal_error(3, "EMSG768", "$SCRIPT", "$topology_info_write");
            }
        }
        $rc = close(FP);
        # Status of pipe goes into $?
        # ct_topology_info -w returns '!= 0' in case of error
        if ($? != 0) {
            # ctdspmsg does not handle arguments with ' ' chars on it,
            # so the options used in $hats_info_write are not displayed
            $cmd = $topology_info_write;
            $cmd =~ s/ .*$//;
            fatal_error(3, "EMSG771", "$SCRIPT", $cmd, $?);
        }
    }
}

#=======================================================================#
#                                                                       #
# Function: parse_configure                                             #
# Description: parse configuration kept in the reference of list        #
#     conf_file_in, which is read from the repository or configuration  #
#     file, and apply the actions specified in the command line options #
#     to each configuration keyword/value. The changed configuration    #
#     is stored in the reference of list conf_file_out.                 #
#     The actions are deleted from the global and network specific      #
#     action lists action_list_global and action_list_pernet after      #
#     applied to the target configuration. The actions stored in        #
#     action_list_allnet are the default actions that apply to all      #
#     networks. They are not deleted.                                   #
#     Note $conf_file_in and $conf_file_out are references of lists,    #
#     not scalar variables.                                             #
#                                                                       #
# Input:                                                                #
#     conf_file_in: reference of list that contains the contents of     #
#         the configuration file                                        #
#     conf_file_out: reference of list that contains the contents of    #
#         the updated configuration file                                #
#                                                                       #
# Output:                                                               #
#     The contents of the lists referenced by conf_file_in and          #
#         conf_file_out, i.e. the input configuration and the changed   #
#         configuration, are updated.                                   #
# Return: None                                                          #
# Global:                                                               #
#     curr_network: name of the current network                         #
#                                                                       #
#=======================================================================#

sub parse_configure {
    local ($conf_file_in, $conf_file_out) = @_;
    local ($current_line, $current_line_save);
    local ($new_value);
    local ($val_changed);

    while ($#$conf_file_in >= 0) {
        $current_line = shift(@$conf_file_in);
        if (exists($opts{v}) && $opts{v}) {
            # The following statement prints the content of current input
            # line. No need to use print_message().
            print STDOUT "    $current_line\n";
        }
        $current_line_save = $current_line;
        $current_line =~ s/^[$SPACE_CHARS]*//;  # Remove leading spaces
        ($current_line, $comment) = split(/#/, $current_line, 2);
        # Empty line may cause $current_line to be undefined. Assign ""
        # to avoid Perl -w warnning.
        if (! defined($comment)) {
            $comment = "";
            if (! defined($current_line)) {
                $current_line = "";
            }
        }
        $current_line =~ s/[$SPACE_CHARS]*$//;  # Remove trailing spaces
        ($keyword, $keyvalue) = split(/[$SPACE_CHARS]+/, $current_line, 2);
        if (! defined($keyvalue)) {
            $keyvalue = "";
            if (! defined($keyword)) {
                $keyword = "";
            }
        }
        $keyvalue =~ s/[$SPACE_CHARS]*$//;      # Remove trailing spaces
        if ($HATS_DBG{"parse_configure"} >= 2) {
            print STDERR "parse_configure(): parsing=>$current_line<=, " .
                "kword=$keyword, value=$keyvalue, comment=>$comment<=\n";
        }

        $val_changed = 0;
        if (exists($TUNABLE_NAME{$keyword})) {
            # A tunable
            $val_changed = take_action($keyword, $keyvalue, \$new_value);
            if ($val_changed) {
                $num_of_change++;
            }
        } elsif ($keyword eq "CONFIG_INST") {
            # Current CCAL scaffold mode implementation does not allow
            # CONFIG_INST to be written back. We need to deal with it as a
            # special case.
            # CONFIG_INST is used in debugging and scaffold mode only.
            # We must be in scaffold mode if CONFIG_INST exists but
            # neither -t nor -T option is specified.
            if (! exists($opts{t}) && ! exists($opts{T})) {
                # Erase the CONFIG_INST line.
                $current_line_save = "";
                if ($HATS_DBG{"parse_configure"} >= 2) {
                    print STDERR "parse_configure(): In scaffold mode. " .
                        "CONFIG_INST line erased\n";
                }
            } else {
                if ($BOUNCE_CONFIG_INST) {
                    # Instance number is bounced only when something changed.
                    if ($user_want_to_change) {
                        $new_value = $keyvalue + 1;     # bounce Instance number
                        $val_changed = 1;
                        # The following statement prints the keyword and
                        # its value before and after change. No need to
                        # use pint_message().
                        print STDOUT "$keyword: $keyvalue => $new_value\n";
                    }
                }
                if ($HATS_DBG{"parse_configure"} >= 2) {
                    print STDERR "parse_configure(): ===>CONFIG_INST: " .
                        ($val_changed) ? "$keyvalue=>$new_value\n" :
                            "unchanged\n";
                }
            }
        } elsif ($keyword eq "NETWORK_NAME") {
            # NETWORK_NAME keyword indicates a network session begins
            # (also the current network or the global session ends).
            #
            # Apply actions specified by the user but the corresponding
            # keyword is not defined in the configuration. The reference
            # of the configuration list is passed in to apply_unused_action()
            # as a reference so apply_unused_action() can add them to
            # the changed configuration list conf_file_out directly.
            apply_unused_action($curr_network, $saved_network_name,
                $conf_file_out);
            $curr_network = $keyvalue;
            $saved_network_name = $current_line_save;
            get_curr_actions($curr_network);
            if ($HATS_DBG{"parse_configure"} >= 2) {
                print STDERR "parse_configure(): ===>new network name: " .
                    "$curr_network<=\n";
            }
        }
        # All other non-tunable keywords pass through. No special action.

        if ($val_changed) {
            if (! $full_write_back) {
                # NETWORK_NAME is not output until a configuration change
                # on the network is found.
                $is_per_net = $TUNABLE_IS_PER_NET{$keyword};
                if ($is_per_net && $saved_network_name) {
                    if ($HATS_DBG{"parse_configure"} >= 2) {
                        print STDERR "parse_configure(): output net name " .
                            "=>$saved_network_name<=\n";
                    }
                    push(@$conf_file_out, $saved_network_name);
                    $saved_network_name = "";
                }
            }
            $current_line = "$keyword $new_value";
            if ($comment) {
                $current_line = $current_line . "\t#$comment";
            }
            if ($HATS_DBG{"parse_configure"} >= 2) {
                print STDERR "parse_configure(): output new " .
                    "=>$current_line<=\n";
            }
            push(@$conf_file_out, $current_line);
        } else {
            if ($full_write_back) {
                if ($HATS_DBG{"parse_configure"} >= 2) {
                    print STDERR "parse_configure(): output old " .
                        "=>$current_line_save<=\n";
                }
                push(@$conf_file_out, $current_line_save);
            }
        }
    }           # end while
    # Check if there are actions not executed in the global session
    # ($curr_network = "") or the last network session ($curr_network != "").
    # e.g. user specifies -l option but LOGFILELEN keyword is not defined
    # in the repository.
    apply_unused_action($curr_network, $saved_network_name, $conf_file_out);
}

#=======================================================================#
#                                                                       #
# Function: take_action                                                 #
# Description: take action (view/change value) specified in             #
#     $curr_action_list for a keyword. The current value is printed for #
#     VIEW action. The current and new values are printed and the new   #
#     value is returned if the action changes the current value of the  #
#     keyword. The action is deleted from $curr_action_list after the   #
#     action is performed.                                              #
#                                                                       #
# Input:                                                                #
#     keyword: keyword                                                  #
#     keyvalue: key value                                               #
# Output:                                                               #
#     new_value: reference to the new value if a new value is assigned  #
# Return:                                                               #
#     0 : key value was not changed                                     #
#     1 : key value was changed                                         #
# Global:                                                               #
#     curr_network: name of the current network                         #
#                                                                       #
#=======================================================================#

sub take_action {
    local ($keyword, $keyvalue, $new_value) = @_;
    local ($action);
    local ($is_per_net, $is_num, $has_new_value);

    # This subroutine is called only when the keyword is tunable.
    # No need to check if the keyword exists in %TUNABLE_XXXX or not.
    $is_num = $TUNABLE_IS_NUM{$keyword};
    $is_per_net = $TUNABLE_IS_PER_NET{$keyword};
    if ($is_per_net && (! $curr_network)) {
        #"Network name must be specified before per-network
        #tunable $keyword can be set"
        fatal_error(1, "EMSG784", "$SCRIPT", "$keyword");
    }
    $has_new_value = 0;
    if (exists($curr_action_list{$keyword})) {
        $action = $curr_action_list{$keyword};
        delete($curr_action_list{$keyword});
        if ($HATS_DBG{"take_action"} >= 2) {
            print STDERR "take_action():kword=$keyword, value=$keyvalue, " .
                "action is =>$action<=\n";
        }

        if ($action eq $CONST_VIEW) {
            # The following statement prints the keyword and value 
            # of a tunable. No need to use print_message().
            print STDOUT (($is_per_net) ? "$curr_network." : "") . 
                "$keyword: $keyvalue\n";
        } else {
            if (($is_num && ($action == $keyvalue)) || 
                (!$is_num && ($action eq $keyvalue))) {
                # Current value equals new value. No change.
                # The following statement prints the keyword and value 
                # of a tunable. No need to use print_message().
                print STDOUT (($is_per_net) ? "$curr_network." : "") .
                    "$keyword: $keyvalue == $keyvalue\n";
            } else {
                # New value is given.
                # The following statement prints the keyword and value 
                # of a tunable. No need to use print_message().
                print STDOUT (($is_per_net) ? "$curr_network." : "") .
                    "$keyword: $keyvalue => $action\n";
                $$new_value = $action;  # pass back $new_value to the caller
                $has_new_value = 1;
            }
        }
    }
    if ($HATS_DBG{"take_action"} >= 2) {
        print STDERR "take_action(): has_new_value=$has_new_value" .
            (($has_new_value) ? ", new value is =>$$new_value<=\n" : "\n");
    }
    return($has_new_value);
}

#=======================================================================#
#                                                                       #
# Function: get_curr_actions                                            #
# Description: get the action list for current network.                 #
#     This subroutine makes $curr_action_list from $action_list_pernet  #
#     and $action_list_allnet. The actions copied to $curr_action_list  #
#     are deleted from $action_list_pernet but not $action_list_global. #
#                                                                       #
# Input:                                                                #
#     net_name: the network name to get the actions for.                #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub get_curr_actions {
    local ($net_name) = @_;
    local ($keyword);
    
    if ($HATS_DBG{"get_curr_actions"}) {
        print STDERR "get_curr_actions(): allnet: " .
            (join(', ', %action_list_allnet)) . "\n";
        if ($net_name) {
            print STDERR "get_curr_actions(): net $net_name: " .
                (join(', ', %{$action_list_pernet{$net_name}})) . "\n";
        }
    }
    %curr_action_list = %action_list_allnet;
    if ($net_name) {
        if (exists($action_list_pernet{$net_name})) {
            foreach $keyword (keys %{$action_list_pernet{$net_name}}) {
                $curr_action_list{$keyword} =
                    $action_list_pernet{$net_name}{$keyword};
                delete($action_list_pernet{$net_name}{$keyword});
            }
            delete($action_list_pernet{$net_name});
        }
    }
    if ($HATS_DBG{"get_curr_actions"}) {
        print STDERR "get_curr_actions():".(join(', ', %curr_action_list))."\n";
    }
}

#=======================================================================#
#                                                                       #
# Function: apply_unused_action                                         #
# Description: apply unused actions. Sometimes the repository may not   #
#     contain all keywords. This subroutine handles the tunables        #
#     users want to view/change but not currently kept in the           #
#     repository. For example, NETWORK_SENS may not exist for network   #
#     en_net_0. If the user wants to view the tunable, we should say    #
#     it is not set in the repository. If the user wants to change the  #
#     value, we should use the value given by the user to add a new     #
#     NETWORK_SENS entry.                                               #
#                                                                       #
# Input:                                                                #
#     net_name: the network name the unused actions should apply to or  #
#         "" for global tunables.                                       #
#     saved_network_name:                                               #
#         ""    : the actions are global or the NETWORK_NAME entry has  #
#                 been output previously.                               #
#         non-"": the actions are per-network and the NETWORK_NAME      #
#                 has not been output previously. $saved_network_name   #
#                 needs to be output to the @conf_file_out list if      #
#                 there is a configuration change needs to be output    #
#                 to the @conf_file_out list.                           #
#     conf_file_out: reference of list that contains updated            #
#         configuration file                                            #
# Output: None                                                          #
# Return: None                                                          #
#                                                                       #
#=======================================================================#

sub apply_unused_action {
    local ($net_name, $saved_network_name, $conf_file_out) = @_;

    foreach $keyword (keys %curr_action_list) {
        if ($HATS_DBG{"apply_unused_action"}) {
            print STDERR "apply_unused_action(): keyword=$keyword, " .
                "net_name=$net_name, action=$curr_action_list{$keyword}\n";
        }
        if ($curr_action_list{$keyword} eq $CONST_VIEW) {
            # The following statement prints the keyword and undefined value 
            # of a tunable. No need to use print_message().
            print STDOUT (($net_name) ? "$net_name." : "") . "$keyword: ???\n";
        } else {
            # The following statement prints the keyword and undefined value 
            # of a tunable. No need to use print_message().
            print STDOUT (($net_name) ? "$net_name." : "") .
                "$keyword: ??? => $curr_action_list{$keyword}\n";
            # We have a configuration change. Output network name if
            # the NETWORK_NAME entry has not output yet.
            if ($saved_network_name && (! $full_write_back)) {
                push(@$conf_file_out, $saved_network_name);
                $saved_network_name = "";
            }
            # Action has been checked before added to %action_list_xxx. No
            # need to check it again.
            push(@$conf_file_out, "$keyword\t$curr_action_list{$keyword}");
            $num_of_change++;
        }
        delete($curr_action_list{$keyword});
    }
}

#=======================================================================#
#                                                                       #
# Utilities                                                             #
#                                                                       #
#=======================================================================#

#=======================================================================#
#                                                                       #
# Function: path_search                                                 #
# Description: search the given file in the specified paths.            #
#                                                                       #
# Input:                                                                #
#     file: file name to be searched                                    #
#     path: optional. If given, the paths to be searched. The paths are #
#           ":" separated. Environment variable PATH is used if this    #
#           parameter is not given.                                     #
#                                                                       #
# Return:                                                               #
#     path/file: if success                                             #
#     ""       : if not success                                         #
#                                                                       #
#=======================================================================#

sub path_search {
    local ($file, $path) = @_;
    local ($searchpath);
    local ($path_not_found);

    if (! $path) {
        $path = $ENV{"PATH"};
    }
    $path_not_found = 1;
    if (index($file, "/") >= 0) {
        # The given file name contains "/". It is already in an absolute
        # or relative path format. We don't check it against the path
        # given in the second parameter.
        if (-e $file) {
            $path_not_found = 0;
            $searchpath = $file;
        }
    } else {
        while ($path && $path_not_found) {
            # Find the ":" separator. If there are ":" in $path, there are
            # more than one path to parse, and the first path is from the
            # first character of $path to the character before the first ":".
            # Otherwise, $path contains only one path.
            $pos = index($path, ":");
            if ($pos >= 0) {
                $searchpath = ($pos == 0) ? "" : substr($path, 0, $pos);
                $path = substr($path, $pos + 1);
            } else {
                $searchpath = $path;
                $path = "";
            }
            # This check is needed for empty paths. e.g "::::/bin:/usr/bin:".
            if ($searchpath) {
                # Remove trailing "/" if the search path has one.
                # This also takes care of the case that $searchpath eq "/".
                $searchpath =~ s/\/$//;
                $searchpath = $searchpath . "/" . $file;
                if (-e $searchpath) {
                    $path_not_found = 0;
                }
            }
        }
    }
    return (($path_not_found) ? "" : $searchpath);
}

#=======================================================================#
#                                                                       #
# Function: fatal_error                                                 #
# Description: print error message in error log and exit with the given #
#     exit code.                                                        #
#                                                                       #
# Input:                                                                #
#     exit_code: exit code                                              #
#     err_msg: a list of message label and variable number of arguments #
#         of the error message                                          #
# Output: None                                                          #
# Return: This subroutine causes the whole program to exit. No return.  #
#                                                                       #
#=======================================================================#

sub fatal_error {
    local ($exit_code, @err_msg);

    ($exit_code, @err_msg) = @_;
    if ($repository_locked) {
        # We may need to unlock the repository here.
        $repository_locked = 0;
    }
    print STDERR get_cat_msg("", @err_msg);

    exit $exit_code;
}

#=======================================================================#
#                                                                       #
# Function: get_exit_code                                               #
# Description: get the exit code of an external command.                #
#     The $? variable in Perl is the status word returned by the wait() #
#     system call. The exit value of the subprocess is actually         #
#     ($? >> 8), and $? & 127 gives which signal, if any, the process   #
#     died from, and $? & 128 reports whether there was a core dump.    #
#     Currently, we return a negative signal number and ignore exit     #
#     code if it is interrupted by a signal. We don't report core dump  #
#     status either.                                                    #
#                                                                       #
# Input:                                                                #
#     exit_code: the exit code to be checked                            #
# Output: None                                                          #
# Return:                                                               #
#     n <  0 : the external command was interrupted by signal -n.       #
#     n >= 0 : the external command exited with exit code n.            #
#                                                                       #
#=======================================================================#

sub get_exit_code {
    local ($exit_code) = @_;
    local ($return_code);

    if ($exit_code & 127) {
        $return_code = ($exit_code & 127) * -1;
    } else {
        $return_code = ($exit_code >> 8);
    }
    if ($HATS_DBG{"get_exit_code"}) {
        print STDERR "get_exit_code(): returns $return_code.\n";
    }
    return ($return_code);
}

#=======================================================================#
#                                                                       #
# Function: de_quote                                                    #
# Description: remove quotation marks from both ends of a string if the #
#     same quotation mark appears on both ends. The recognized          #
#     quotation marks are '"' and '''.                                  #
#                                                                       #
# Input:                                                                #
#     in_str: the string to be de-quoted.                               #
# Output:                                                               #
# Return:                                                               #
#     The de-quoted string.                                             #
#                                                                       #
#=======================================================================#

sub de_quote {
    local ($in_str) = @_;
    local ($recognized_quote_marks, $quote_mark);
    local ($out_str);

    $recognized_quote_marks = "'\"";
    $quote_mark = substr($in_str, 0, 1);
    $out_str = $in_str;
    if (length($out_str) >= 2) {
        if (index($recognized_quote_marks, $quote_mark) >= 0) {
            if (substr($in_str, -1, 1) eq $quote_mark) {
                # Remove quotation marks on both ends and "un-escape" the
                # escaped quotation marks in the middle of the string.
                $out_str = substr($in_str, 1, -1);
                $out_str =~ s/\\$quote_mark/$quote_mark/g;
            }
        }
    }
    if ($HATS_DBG{"de_quote"}) {
        print STDERR "de_quote(): =>$in_str<=>>$out_str<=\n";
    }
    return ($out_str);
}

#=======================================================================#
#                                                                       #
# Subroutine: print_message                                             #
# Description:                                                          #
#       Print NL messages.                                              #
# Input:                                                                #
#       message_label: the message label defined in message catalog.    #
#       argument: variable number of arguments for message.             #
# Global:                                                               #
#       Locale environment variables.                                   #
#                                                                       #
#=======================================================================#

sub print_message {
    printf(STDOUT "%s", get_cat_msg("", @_));
}

#=======================================================================#
#                                                                       #
# Subroutine: print_errormsg                                            #
# Description:                                                          #
#       Print NL error messages.                                        #
# Input:                                                                #
#       errormsg_label: the message label defined in message catalog.   #
#       argument: variable number of arguments for message.             #
# Global:                                                               #
#       Locale environment variables.                                   #
#                                                                       #
#=======================================================================#

sub print_errormsg {
    printf(STDERR "%s", get_cat_msg("", @_));
}

#=======================================================================#
#                                                                       #
# Subroutine: get_cat_msg                                               #
# Description: call /usr/sbin/rsct/bin/ctdspmsg to get NL messages from #
#       a specific locale.                                              #
# Input:                                                                #
#       locale: if locale is "", use the current locale settings in     #
#               locale environment variables to get the message.        #
#               if locale is not "", use locale to get the message from #
#               message catalog.                                        #
#       message_label: the message label defined in message catalog.    #
#       argument: variable number of arguments for message.             #
# Global:                                                               #
#       Locale environment variables.                                   #
#       MSGCMD: "/usr/sbin/rsct/bin/ctdspmsg script hats.cat"           #
#                                                                       #
#=======================================================================#

sub get_cat_msg {
    local (@args);
    local ($command, $rc, $msg);
    local ($lc_all_exist, $lc_all_save);

    @args = @_;
    $locale = shift(@args);
    # form command line for ctdspmsg command

    # enclose arguments with " ", so that ctdspmsg does not interpret a space
    # in the msg as another parameter
    for ($i=0; $i <= $#args ;$i++) {
        $args[$i] = "\"".$args[$i]."\"";
    }

    $command = join(' ', "$MSGCMD", @args);
    # use ctdspmsg command to get an NL message.

    # Temporarily change locale to get NL message.
    if ($locale) {
        # Save LC_ALL
        if (exists($ENV{LC_ALL})) {
            $lc_all_exist = 1;
            $lc_all_save = $ENV{LC_ALL};
        } else {
            $lc_all_exist = 0;
        }
        $ENV{LC_ALL}=$locale;
    }
    $msg = `$command`;
    if ($rc) {
        # $MSGCMD exits with an error. The message facility must be broken.
        # Use a hard-coded message for the error.
        $msg = "Cannot get message using: $command. Check if $MSGCMD " .
            "is executable and message map is up-to-date.\n";
    }

    # if got an empty message, try to fall back to C locale
    if(!defined($msg) || ($msg eq '')) {
        $ENV{LC_ALL}="C";
        $msg = `$command`;
    }

    if ($locale) {
        # Restore LC_ALL
        if ($lc_all_exist) {
            $ENV{LC_ALL} = $lc_all_save;
        } else {
            delete($ENV{LC_ALL});
        }
    }
    return($msg);
}

