#!/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. 1997,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 

# "@(#)29   1.94   src/rsct/pts/pam/config/topsvcs.pl, topology.services, rsct_relgh, relghs001a 6/11/07 18:10:34"

use Socket; # inet_aton() and inet_ntoa()

###############################################################################
#   The following  subroutines are used to generate machines.lst file
#      numeric();
#      DaisyTable (Serial nodes,Serial nets,Serial table[nodes,nets]);
#      Daisychain(Daisy Table, Total number of nodes, Table);
#      PrintSerial(array of Elements,Table,element number);
#      Lookupservice(Network Type, Network Name); 
#      Lookupstanby(Network Type,Network Name);
#      Printtable(Network type, Network name, IP tabl,  Mtype);
#      GetSDRTS();
#      findCwsAddresses(); 
#      inetatoi(IP in Dotted format);
#      GetSDR();
#      GetODM(); 
#      handle_aliased();
#      getrealhost()
#      MachineSub()   this subroutine calls GetSDRTS() ,  GETODM()
#      printTunables() retrieves and print per-offset tunables
###############################################################################
#
#      Main Program  calls MachineSub() and generates the  machines.lst file
############################################################################## 
#########################################################################
#									#
# Developer's note:							#
#	Topology Services is not in the same developing process with	#
#	HACMP. They may ship in different schedule. It is possible to	#
#	have older Topology Services scripts running with newer HACMP	#
#	or vice versa. We need to ensure any change in Topology Services#
#	keep backward compatibility for at least a few releases.	#
#									#
#	The new NLS changes may cause some backward compatibility	#
#	problem due to the new code relying on Perl NL support which	#
#	does not exist at the time (Aug. 1999) we implement NLS for	#
#	Topology Services. Perl does not support setlocale() until	#
#	5.004. The current Perl shipped with HACMP is 5.001. We need to	#
#	develop our NLS without using setlocale().			#
#									#
#	Fortunately, Topology Services Perl script does not use any	#
#	locale specific function except for printing messages from a	#
#	message catalog. An RSCT command hadspmsg can be used to get	#
#	messages from a message catalog. Since hadspmsg is an external	#
#	command, its behavior is controlled by the locale settings in	#
#	the locale environment variables instead of the locale settings	#
#	in Perl program. To keep backward compatibility, we will run	#
#	the Perl script in its default locale ("C"). The message	#
#	printing subroutines will use the locale settings in the locale	#
#	environment variables to print messages in user locale.		#
#									#
#########################################################################
#########################################################################
#									#
# Developer's note:							#
#	The following external commands are used:			#
#									#
#	cllstopsvcs	 						#
#	cllsnim -c							#
#	SDRGetObjects -x -d ':' Adapter node_number adapter_type netaddr#
#	clhandle -ac and clhandle -c					#
#	cllsclstr -Sc							#
#	cllsif -Sc							#
#	ifconfig css0 arp						#
#	/usr/sbin/rsct/bin/hadspmsg					#
#									#
#########################################################################

# The following message cannot use message catalog since all required
# variables are not set yet.
die "Requires Perl Version 5, this is Version $]\n" if $] < 5.000;

#To sort the array numerically
sub numeric {
    $a <=> $b;
}
### This functions returns the real hostname for the aliases
sub getrealhost{
    local($hostname)=@_;
    local($name,$ali,$add,$length,@addr,$a,$c,$b,$d,$add);
    ($name,$ali,$add,$length,@addr)=gethostbyname($hostname);
    return $name;
}

### Try to find the path to a HACMP utility
### Look first for the clrsctinfo utility (introduced in HACMP 5.1) and if
### found return that with the program name as a parameter. If clrsctinfo
### does not exist, look for the named utility first in the "es" directory.
### if not there, look in the Hacmp dir
sub findHacmpPath {
    local($name)=@_;

    if (-x "$HacmpESUtilPath/clrsctinfo")  {
        return "$HacmpESUtilPath/clrsctinfo -p $name";
    }

    if (-x "$HacmpESUtilPath/$name")  {
        return "$HacmpESUtilPath/$name";
    }

    if (-x "$HacmpUtilPath/$name")  {
        return "$HacmpUtilPath/$name";
    }

    # if we get here then we could not find the location of the HACMP utility
    ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
                "$name");
    print_message("EMSG661", $SCRIPT, $name);
    my_exit(1);
} 

################################################################################
#                                                                              #
# Subroutine DaisyTable                                                        #
#   Given a set of two-node non-IP networks of a specific type (rs232,         #
#   tmscsi, tmssa), This subroutine attempts to find the maximum sets of       #
#   connected networks.                                                        #
#                                                                              #
#   Arguments:                                                                 #
#   - @nodes: an array containing names of all nodes that are on non-IP        #
#     networks of a specific type.                                             #
#     example: nodes[0] = c176h501                                             #
#              nodes[1] = c176h502                                             #
#   - @nets: an array containing names of all non-IP networks of a             #
#     specific type.                                                           #
#     example: nets[0] = ssa_c176h501                                          #
#              nets[0] = ssa_c176h505                                          #
#   - %serialtable: a table indexed by {$node name, $network name}.            #
#     If $serialtable{$node,$network} == "v", then there exits a two-node      #
#     network with name $network, and one of the end node is $node.            #
#     example: serialtable{c176h501,ssa_c176h501}=v                            #
#              serialtable{c176h501,ssa_c176h505}=v                            #
#                                                                              #
#   Returns:                                                                   #
#   - @DaisyTab: an array storing node and network information of the          #
#     connected sets. Each entry in @DaisyTab is a four-tuple consisting of    #
#       (node name at one end, node name at the other end, network name,       #
#        set number)                                                           #
#     The 'set number' denotes the connected set a network belongs to.         #
#     example: DaisyTab[0] = c176h501,c176h505,ssa_c176h505,0                  #
#              DaisyTab[1] = c176h501,c176h502,ssa_c176h501,0                  #
#                                                                              #
################################################################################
sub DaisyTable {

    # (nodes,nets,serialtable) -> (node names, network names, table
    #  indexed by nodes and nets, indicating valid {node, net} pair)
    local(*nodes,*nets,*serialtable)=@_;
    local(@nodenumber1,$value,$i,$j,$k,$Form,$Part,@RSsort,%Daisy,%NumtoName);
    local($D,$header,$headerval,$flag,$group);
    local(%temp,$t,$validnet);
    local(@DaisyTab,$Var);

    # converts the node names into numbers and sorts the array numerically
    # and subsequently converts back to the node names. 
   
    print STDERR "DaisyTable: Nets " if exists $debug{Daisy};
    print STDERR @nets if exists $debug{Daisy};
    print STDERR "\n" if exists $debug{Daisy};
    foreach $i (0 ... $#nodes) {
        $value=0;
        $value=$NametoNum{$nodes[$i]};
        $nodenumber1[$i]=$value;
        $NumtoName{$value}=$nodes[$i];
    }
    # sort @nodes according to node numbers (not node names)
    @nodes = sort { $NametoNum{$a} <=> $NametoNum{$b} } @nodes;

    print STDERR "DaisyTable: Nodes (after sorting) " if exists $debug{Daisy};
    print STDERR @nodes if exists $debug{Daisy};
    print STDERR "\n" if exists $debug{Daisy};

    # Go through array of nodes, if a 'node' is part of a network 'net',
    # place 'net' in @RSsort once.  Note that the order of 'net' in @RSsort
    # is sorted by node number of the nodes involved, since @nodes is sorted
    # by node number.
    #
    # Total number of valid networks is stored in $validnet. If there is
    # no valid network found, returns with a NULL $DaisyTab array.

    $validnet=0;
    foreach $i ( 0 ... $#nodes) {
        foreach $j (0 ... $#nets) {
                $t=$temp{$nets[$j]};
           if ( $serialtable{$nodes[$i],$nets[$j]} eq "v" && $t != 1 ) {
               print STDERR "serialtable{$nodes[$i],$nets[$j]}=$serialtable{$nodes[$i],$nets[$j]}\n" if exists $debug{Daisy};
                $temp{$nets[$j]}=1; 
                $validnet++;
                push(@RSsort,$nets[$j]);
            }
        }
    }
    if ( $validnet == 0 ) {
        return @DaisyTab=();
    }

    # The following piece of code attempts to find maximum sets of
    # connected two-node non-IP networks.  The algorithm expands a set
    # of connected networks by adding network, one at a time, to the
    # set. The network and connected set information is stored in an
    # array @DaisyTab, which is returned to caller at the end of this
    # subroutine. 
    #
    # Note that the networks are assumed to be daisy-chained; a set of
    # connected networks has only two "free" end-nodes (called
    # 'previousnode' and 'header' in the code), on which new networks
    # can be added to the set. The algorithm attempts to expand from one
    # end-node, then the other.
    #
    # For each network, a four-tuple consisting of
    #   (1st node name, 2nd node name, network name, set number)
    # is entered the @DaisyTab array, note that the set a network belongs
    # to is denoted by the 'set number' in the four-tuple.
    #
    # The ordering the networks in @DaisyTab is such that, for networks
    # in the same connected set, the first and second networks have one
    # node in common, the second and third networks have one node in
    # common, and so on until the last network in the set.
    #
    # If the networks are in other configuration (mesh, star), this
    # approach may result in a set that is "multi-pronged" and has more
    # than two end-nodes.
    #
    # Ideally, a new set of networks is created only when all remaining
    # unclassified networks are not connected in any way to any networks
    # in existing sets. However, there are constraints in the algorithm
    # that forces some networks to be in different sets even though those
    # networks may be connected to existing sets.

    $count=0;
    $D=0;	# The number of connected sets of networks
    $flag=0;
    $loop=0;

    while ( $count < $validnet ) {
         $previous=0;
         $headerval=0;
         $first=0;
         $group=0;
         if ( $flag == 1 ) { 
             $D++;
             $flag=0;
         }
         if ( $loop == $validnet ) {
             $count=$validnet;
             next;
         }
         foreach $i (0 ... $#RSsort) {
             if ( $i == 0 ) {
                 $loop++; 
             }
             foreach $j (0 ... $#nodes) {
                 if ( $previous == 1 ) {
                     $node=$previousnode;
                 }
                 else {
                     $node=$nodes[$j];
                 }
                 $Ret=$serialtable{$node,$RSsort[$i]}; 
                 $Ret1=$Daisy{$node,$RSsort[$i]};
                 if ( $Ret eq "v" && $Ret1 != 1 ) {
                      foreach $k (0 ... $#nodes ) {
                          $Ret=$serialtable{$nodes[$k],$RSsort[$i]}; 
                          $Ret1=$Daisy{$nodes[$k],$RSsort[$i]};
                          if ( $Ret eq "v" && $Ret1 != 1 && $node ne $nodes[$k]  ) {
                              $Daisy{$node,$RSsort[$i]}=1;
                              $Daisy{$nodes[$k],$RSsort[$i]}=1;
                              $Var="$node,$nodes[$k],$RSsort[$i],$D";
                              #printf("%s\n",$Var);
                              push(@DaisyTab,$Var);
                              $previous=1;
                              $count++;
                              $previousnode=$nodes[$k];
                              if ( $first == 0 ) {
                                  $header=$node;
                                  $headerval=1;
                                  $flag=1;
                                  $group=1;
                                  $first++;
                              }
                              last;
                           }    
                      } 
                 }
                 else {
                       if ( $headerval > 0 ) {
                          $Ret=$serialtable{$header,$RSsort[$i]}; 
                          $Ret1=$Daisy{$header,$RSsort[$i]};
                          if ( $Ret eq "v" && $Ret1 != 1 ) {
                              foreach $k (0 ... @nodes ) {
                                 $Ret=$serialtable{$nodes[$k],$RSsort[$i]}; 
                                 $Ret1=$Daisy{$nodes[$k],$RSsort[$i]};
                                 if ( $Ret eq "v" && $Ret1 != 1 && $header ne $nodes[$k] ) {
                                     $Daisy{$header,$RSsort[$i]}=1;
                                     $Daisy{$nodes[$k],$RSsort[$i]}=1;
                                     $Var="$header,$nodes[$k],$RSsort[$i],$D";
                                     #printf("unshift ... %s\n",$Var);
                                     if ( $previousnode eq $nodes[$k] ) {  
                                          push(@DaisyTab,$Var);
                                     }
                                     else {
                                          #printf("Unshift is in progress\n");
                                          unshift @DaisyTab,$Var;
                                     }
                                     $header=$nodes[$k];
                                     $count++;
                                     $group=1;
                                     last;
                                 }
                              } 
                          }
                       } 
                 }
                 if ( $group == 1 ) {
                     $group=0;
                     last;
                 }
             }
        } 
    }
    # $Total is a global variable which contains total number of Daisy tables
    $Total=$D;
    return @DaisyTab;
}


################################################################################
#                                                                              #
# Subroutine NonStandardDaisyTable                                             #
#   Similar to DaisyTable(), but called for "non-standard" networks,           #
#   that is, networks with adapters and NIMs defined by the user.              #
#                                                                              #
#   Note that "non-standard" networks don't use the "daisy chain" algorithm    #
#   for deriving the heartbeat rings.                                          #
#                                                                              #
#   Arguments:                                                                 #
#   - %serialtable1: a table indexed by {$node name, $network name}.           #
#     If $serialtable{$node,$network} == "v", then there exits a two-node      #
#     network with name $network, and one of the end node is $node.            #
#     example: serialtable1{c176h501,ssa_c176h501}=v                           #
#              serialtable1{c176h501,ssa_c176h505}=v                           #
#   - $nettype: network type                                                   #
#                                                                              #
#   Returns:                                                                   #
#   - @DaisyTab: an array storing node and network information of the          #
#     connected sets. Each entry in @DaisyTab is a four-tuple consisting of    #
#       (node name at one end, node name at the other end, network name,       #
#        set number)                                                           #
#     The 'set number' denotes the connected set a network belongs to.         #
#     example: DaisyTab[0] = c176h501,c176h505,ssa_c176h505,0                  #
#              DaisyTab[1] = c176h501,c176h502,ssa_c176h501,0                  #
#                                                                              #
################################################################################

sub NonStandardDaisyTable {
    # (serialtable1, nettype) -> (node names, network names, table
    #  indexed by nodes and nets, indicating valid {node, net} pair)

    local(*serialtable1, $nettype)=@_;
    my(@DaisyTab,$DaisyTab_entry);

    my($GivenNtype,$Ntype,$Type,$Net,$Node,$Dev,$IP);
    my($key, $adapter_entry);
    my(%nodeInNet);

    # traverse all the adapters in the table, but pick only those
    # that have type nettype
    while (($key,$adapter_entry) = each %serialtable1) {
        ($GivenNtype,$Ntype,$Type,$Net,$Node,$Dev,$IP)=
                                                    split(',',$adapter_entry);

        print STDERR "NonStandardDaisyTable: Found net $Net IP $IP\n"
                               if exists $debug{Daisy};

        next unless $Ntype eq $nettype;

        # the first time we see a network, we create an entry in
        # nodeInNet with that first node. The second time we see it,
        # we have our 2-node network and we can add an entry into
        # DaisyTab
        if(!exists($nodeInNet{$Net})) {
            $nodeInNet{$Net} = $Node;
        }
        else {

            $DaisyTab_entry="$nodeInNet{$Net},$Node,$Net,0";
            push(@DaisyTab,$DaisyTab_entry);
            delete $nodeInNet{$Net};
        }

    } # foreach adapter_entry
    

# must handle "no networks" ??

    return @DaisyTab;
}



################################################################################
#                                                                              #
# Subroutine seen_before                                                       #
#   Given a two-node non-IP network and an offset, this subroutine             #
#   determines if either one of the two nodes has been previously              #
#   assigned to the offset.                                                    #
#                                                                              #
#   Arguments:                                                                 #
#   - $offset: the offset into which we want to see if the nodes in            #
#     $subgroup have previously been assigned.                                 #
#   - $subgroup: a literal of the format: "node1, node2, network name"         #
#     that represents a two-node network.                                      #
#     example: c176h501,c176h505,ssa_c176h505                                  #
#                                                                              #
#   Returns:                                                                   #
#   - $seen: 1, if a node in $subgroup is already assigned to $offset.         #
#            0, otherwise.                                                     #
#                                                                              #
################################################################################
sub seen_before {
    my ($offset, $subgroup) = @_;
    my $seen = 0;
    ($node1,$node2,$net) = split /,/, $subgroup;
    for $node ("$node1", "$node2") {
        if (defined $offset_node_hash{$offset}{$node}) {
            print STDOUT "$node previously seen in offset: $offset\n"
                if exists $debug{Daisy};
            $seen = 1;
        } else {
            $offset_node_hash{$offset}{$node} = $node;
        }
    }
    return $seen;
}

################################################################################
#                                                                              #
# Subroutine greedy                                                            #
#   Given a set of two-node non-IP networks of a specific type (rs232,         #
#   tmscsi, tmssa), This subroutine attempts to fit those networks into        #
#   Topology Services offsets. The constraint is that each node should         #
#   appear at most once in an offset.                                          #
#                                                                              #
#   Under normal operation, Daisychain() is used to assign networks to         #
#   offsets.  Subroutine greedy() is invoked by Daisychain() only when the     #
#   algorithm in Daisychain() has put a node in the same offset more           #
#   than once.                                                                 #
#                                                                              #
#   Subroutine greedy() is provided for co-existence.  In an HACMP             #
#   cluster, each node is responsible for generating its own copy of           #
#   machines list. There are several possible situations.                      #
#   - If Daisychain() provides correct assignment, the result from             #
#     Daisychain() will be used.                                               #
#   - If Daisychain() does not provide correct assignment, then                #
#     - if the cluster contains only nodes at older releases (script without   #
#       the greedy() algorithm), the topsvcs daemons will not come up;         #
#     - if the cluster contains only nodes at newer releases, greedy()         #
#       will be used to assign non-IP networks;                                #
#     - if the cluster is a mixture of newer (with greedy()) and older         #
#       (without greedy()) releases, the topsvcs daemons on older              #
#       release nodes will not come up. It does not matter how machines        #
#       list is generated on newer release nodes.                              #
#                                                                              #
#   This subroutine will assign networks to offsets from scratch using         #
#   a greedy algorithm. A two-node network is assigned to the first            #
#   offset that does not have either node present.                             #
#                                                                              #
#   Arguments:                                                                 #
#   - @DTable: the array returned by DaisyTable subroutine. This array         #
#     specifies, for each network, which connected set this network            #
#     belongs to, and the nodes that are on the network.                       #
#     example: DTable[0] = c176h501,c176h505,ssa_c176h505,0                    #
#              DTable[1] = c176h501,c176h502,ssa_c176h501,0                    #
#   - %table1: a table indexed by {$node_name ,$network_name}.                 #
#     Each entry in the table is a list containing information about           #
#     network $network_name.                                                   #
#     example:                                                                 #
#     table1{c176h501, ssa_c176h501} = tmssa,tmssa,service,ssa_c176h501,       #
#                                      c176h501,/dev/tmssa2,255.255.2.0,---    #
#     table1{c176h501, ssa_c176h505} = tmssa,tmssa,service,ssa_c176h505,       #
#                                      c176h501,/dev/tmssa5,255.255.2.1,---    #
#                                                                              #
#   Returns:                                                                   #
#     None                                                                     #
#                                                                              #
#   Side effect:                                                               #
#     Information about non-IP networks are grouped into offsets and printed   #
#     in machines.lst.                                                         #
#                                                                              #
################################################################################
sub greedy {
    local (*DTable, *table1) = @_;
    my $set = 0;
    my $j = 0;
    # Sort @DTable by default string comparison order. This is to
    # give the greedy algorithm a uniform starting point.
    @DTable_sorted = sort @DTable;
    foreach $one_net (@DTable_sorted) {
        ($node1, $node2, $net) = split /,/, $one_net;
        $j = 0;
        while (((defined $offsets_nodes{"$j"}{$node1}) ||
                (defined $offsets_nodes{"$j"}{$node2})) &&
               ($j < $set + 1)) {
            $j++;
        }
        push @{$all_offsets[$j]}, "$node1,$node2,$net";
        $offsets_nodes{"$j"}{$node1} = $node1;
        $offsets_nodes{"$j"}{$node2} = $node2;
        $set = ($j > $set) ? $j : $set;
    }
    $j = 0;
    for $one_offset (@all_offsets) {
        print STDOUT "offset[$j] @$one_offset\n" if exists $debug{Daisy};
        PrintSerial($one_offset, *table1, $j++);
    }
    # Get ready for next non-IP type.
    undef @all_offsets;
    undef %offsets_nodes;
}

################################################################################
#                                                                              #
# Subroutine offset_limit                                                      #
#   Print an error message when number of configured offsets exceeds the       #
#   maximum allowed (currently 48).                                            #
#                                                                              #
#   Argument:                                                                  #
#   - $name: Name of network whose assigned offset exceeds maximum allowed.    #
#                                                                              #
################################################################################
sub offset_limit {
    my ($name) = @_;
    if (++$num_offsets > $HB_MAX_ADAPTERS_PER_NODE) {
        print_message("EMSG665", $SCRIPT, $HB_MAX_ADAPTERS_PER_NODE, $name);
        if ($VERIFY == 1) {
            $VERIFY_RC = -1;
        }
    }

    print STDERR "MachList:Network Name $name      # offsets: $num_offsets\n"
          if exists $debug{MachList};

}

################################################################################
#                                                                              #
# Subroutine Daisychain                                                        #
#   Given a set of two-node non-IP networks of a specific type (rs232,         #
#   tmscsi, tmssa), This subroutine attempts to fit those networks into        #
#   Topology Services offsets. The constraint is that each node should appear  #
#   at most once in an offset.                                                 #
#                                                                              #
#   Arguments:                                                                 #
#   - @DTable: the array returned by DaisyTable subroutine. This array         #
#     specifies, for each network, which connected set this network            #
#     belongs to, and the nodes that are on the network.                       #
#     example: DTable[0] = c176h501,c176h505,ssa_c176h505,0                    #
#              DTable[1] = c176h501,c176h502,ssa_c176h501,0                    #
#   - $Tot: total number of sets of connected networks,                        #
#   - %table1: a table indexed by {$node_name ,$network_name}.                 #
#     Each entry in the table is a list containing information about           #
#     network $network_name.                                                   #
#     example:                                                                 #
#     table1{c176h501, ssa_c176h501} = tmssa,tmssa,service,ssa_c176h501,       #
#                                      c176h501,/dev/tmssa2,255.255.2.0,---    #
#     table1{c176h501, ssa_c176h505} = tmssa,tmssa,service,ssa_c176h505,       #
#                                      c176h501,/dev/tmssa5,255.255.2.1,---    #
#                                                                              #
#   Returns:                                                                   #
#     None                                                                     #
#                                                                              #
#   Side effect:                                                               #
#     Information about non-IP networks are grouped into offsets and printed   #
#     in machines.lst.                                                         #
#                                                                              #
################################################################################

sub Daisychain {
    local(*DTable,$Tot,*table1)=@_;
    local(@first)=();
    local(@second)=();
    local(@third)=();
    my $duplicated = 0;

    for($i=0;$i<=$Tot;$i++) {
        local(@Subgroup,$var,$elements);
        @Subgroup=();
        local($node1,$node2,$daisy,$net,$Odd,$node3,$node4);
        $var=0;
        local(%nodecount);

        # Determine total number of distinct nodes in set $i, put result
        # in $var.
        #
        # Place all networks belonging to set $i into array @Subgroup.
        # The order of networks in @Subgroup is the same as that in
        # @DaisyTab from the DaisyTable subroutine. The assumption is that
        # networks that are not adjacent in the ordering do not share common
        # nodes.
        #
        # If the total number of nodes is even, place all even-indexed (0, 2, 4,
        # etc) networks of @Subgroup in 'first', If total number of nodes
        # is odd, place even-indexed networks except the last one in
        # 'first', and place the last network in 'third'.  This is necessary
        # because if number of nodes is odd, the first and last networks
        # will have one common node and must be placed in separate offsets.
        # All odd-indexed (1, 3, 5, etc) networks of @Subgroup will be
        # placed in 'second'.

        for($j=0;$j<=$#DTable;$j++) {
            ($node1,$node2,$net,$daisy)=split(",",$DTable[$j]);
            if ( $daisy  == $i ) {
                if ( $nodecount{$node1} != 1 ) {
                     $nodecount{$node1}=1;
                     $var++;
                }
                if ( $nodecount{$node2} != 1 ) {
                     $nodecount{$node2}=1;
                     $var++;
                }
                $elements="$node1,$node2,$net";
                push(@Subgroup,$elements);
            }
        }
        $Last=0;
        #printf("Total number of nodes:-> %d\n",$var);

        $Odd=$var % 2;
        if ( $Odd != 0 ) {
            $Last=1;
        }

        # The following code is commented out for 73623. The change
        # breaks the co-existence because nodes running the code without
        # this fix will generate a single serial network in a 2-node
        # cluster, while nodes with the fix will generate two.
        # Keep the code to remind us this could be the problem if the
        # older nodes do not talk to newer nodes in HACMP migration.
        #
        ## Special case for one network only
        #if ( $var == 2 ) {
        #    ($node1,$node2,$net)=split(",",$Subgroup[$#Subgroup]);
        #    $temp="$node1,$node2,$net";
        #    push(@first,$temp);
        #    $duplicated |= seen_before("first", $temp);
        #    #&PrintSerial(*first,*table1,0);
        #    next;
        #}
           
        # If total number of nodes is even number,
        if ( $Last == 0 ) {
            for($n=0;$n<=$#Subgroup;$n=$n+2) {
                push(@first,$Subgroup[$n]);
                $duplicated |= seen_before("first", $Subgroup[$n]);
            }
            for($n=1;$n<=$#Subgroup;$n=$n+2) {
                push(@second,$Subgroup[$n]);
                $duplicated |= seen_before("second", $Subgroup[$n]);
            }
        }
        if ( $Last == 1 ) { # if total number of nodes is an odd number
            if ( $hacmp_version422 ) {
                for($n=1;$n<=$#Subgroup;$n=$n+2) {
                    push(@first,$Subgroup[$n]);
                    $duplicated |= seen_before("first", $Subgroup[$n]);
                }
                for($n=2;$n<=$#Subgroup;$n=$n+2) {
                    push(@second,$Subgroup[$n]);
                    $duplicated |= seen_before("second", $Subgroup[$n]);
                }
                ($node1,$node2,$net)=split(",",$Subgroup[0]);
                $temp="$node1,$node2,$net";
                push(@third,$temp);
                $duplicated |= seen_before("third", $temp);
            } else {
                for($n=0;$n< $#Subgroup;$n=$n+2) {
                    push(@first,$Subgroup[$n]);
                    $duplicated |= seen_before("first", $Subgroup[$n]);
                }
                for($n=1;$n<=$#Subgroup;$n=$n+2) {
                    push(@second,$Subgroup[$n]);
                    $duplicated |= seen_before("second", $Subgroup[$n]);
                }
                if ($#Subgroup%2 == 0) {
                    ($node1,$node2,$net)=split(",",$Subgroup[$#Subgroup]);
                    $temp="$node1,$node2,$net";
                    push(@third,$temp);
                    $duplicated |= seen_before("third", $temp);
                }
            }
            next;
        }
    }
    if ($duplicated > 0) {
        # if $duplicated > 0, then the algorithm above has put a node in
        # the same offset more than once. Call greedy to correct it.
        greedy (*DTable, *table1);
    } else {
        &PrintSerial(*first,*table1,0);
        &PrintSerial(*second,*table1,1);
        &PrintSerial(*third,*table1,2);
    }
    # Get ready for next non-IP type.
    undef %offset_node_hash;
}

################################################################################
#                                                                              #
# Subroutine PrintSerial                                                       #
#   Given a set of two-node non-IP networks of a specific type (rs232,         #
#   tmscsi, tmssa, diskhb) that could be placed in the same offset, This       #
#   subroutine organizes the network information in correct format and put it  #
#   in machines.lst file.                                                      #
#                                                                              #
#   Arguments:                                                                 #
#   - @group: the arrays 'first', 'second', or 'third' from Daisychain         #
#     subroutine; the entries are networks that could be in the same offset.   #
#     example: group[0] = c176h501,c176h505,ssa_c176h505                       #
#              group[1] = c176h502,c176h503,ssa_c176h502                       #
#   - %table1: a table indexed by {$node_name ,$network_name}.                 #
#     Each entry in the table is a list containing information about           #
#     network $network_name.                                                   #
#     example:                                                                 #
#     table1{c176h501, ssa_c176h501} = tmssa,tmssa,service,ssa_c176h501,       #
#                                      c176h501,/dev/tmssa2,255.255.2.0,---    #
#     table1{c176h501, ssa_c176h505} = tmssa,tmssa,service,ssa_c176h505,       #
#                                      c176h501,/dev/tmssa5,255.255.2.1,---    #
#   - $step: the offset number                                                 #
#                                                                              #
#   Returns:                                                                   #
#     None                                                                     #
#                                                                              #
#   Side effect:                                                               #
#     Information about non-IP networks in a specific offset is printed in     #
#     machines.lst.                                                            #
#                                                                              #
################################################################################
sub PrintSerial {
    local(*group,*table1,$step)=@_;
    local($GivenNtype,$Ntype,$Type,$Net,$Node,$Dev,$IP)=();
    foreach $i (0 ... @group-1) {
       ($node1,$node2,$net)=split(",",$group[$i]);
       ($GivenNtype,$Ntype,$Type,$Net,$Node,$Dev,$IP)=split(',',$table1{$node1,$net});
       if ( $i == 0 ) {
           $temp="_";
	    # The Network Name of non-IP networks used to be something
	    # like "rs232_0", "tmscsi_1" or "tmssa_2". We keep the old
	    # naming convention for backward compatibility. It also
	    # distinguishs Geo_Secondary non-IP network names from 
	    # regular non-IP network names.
	    if ($GivenNtype eq "Geo_Secondary") {
		print STDERR "MachList:Network Name $Net$temp$step\n"
		    if exists $debug{MachList};
		print FP "Network Name $Net$temp$step\n";
	    } else {
		print STDERR "MachList:Network Name $Ntype$temp$step\n"
		    if exists $debug{MachList};
		print FP "Network Name $Ntype$temp$step\n";
	    }
           print STDERR "MachList:Network Type $Ntype\n" if exists $debug{MachList};
           print FP "Network Type $Ntype\n";
           if ( ! $hacmp_version422 ) {
               &printTunables($GivenNtype);
           }
           print STDERR "MachList:*\nMachList:*Node Type Address\n"
		if exists $debug{MachList};
           print FP "*\n";
           print FP "*Node Type Address\n";
           offset_limit("$Ntype$temp$step");
       }
       if ( $Ntype eq "tmscsi" || $Ntype eq "tmssa" ) {
           $Type1=substr($Dev,rindex($Dev,"/")+3);
       }
       else {
           $Type1=substr($Dev,rindex($Dev,"/")+1);
       }

       # Defect 143177
       # check for malformed device names. The name needs
       # to start with '/dev/'
       if($Dev !~ /^\/dev\//) {
           print_message("EMSG898", $SCRIPT, $Dev);
           if ($VERIFY == 1) {
               $VERIFY_RC = -1;
           }
       }
       # for multi-node non-IP networks, issue a new IP address, to
       # allow each connection to a different destination to have its own
       # IP address
       if($Ntype eq "diskhbmulti") {
           $IP = get_next_fake_address($Ntype);
           push(@IPtable,$lIP);

           # compute slot offset -- it's the same for both ends of the
           # connection. GetSlotOffsetForMultiNodeNonIPNetwork() takes node
           # numbers, not names, as parameter
           $slot_off = GetSlotOffsetForMultiNodeNonIPNetwork(
                                               $NametoNum{$node1},
                                               $NametoNum{$node2});

           ($Dev, $Type1) = diskhbmulti_get_device($Dev,
                                                   $Type1,
                                                   $node1,
                                                   $node2,
                                                   $slot_off);
       }

       # Defect 143177: Check on max device name length
       if (length($Dev) >= $HB_MAX_DEV_NAME_LEN) {
           print_message("EMSG897", $SCRIPT, $Dev, $HB_MAX_DEV_NAME_LEN);
           if ($VERIFY == 1) {
               $VERIFY_RC = -1;
           }
       }

       print STDERR sprintf("MachList: %4d %-4s %-14s %-10s\n",$NametoNum{$Node},$Type1,$IP,$Dev)
	    if exists $debug{MachList};
       print FP sprintf(" %4d %-4s %-14s %-10s\n",$NametoNum{$Node},$Type1,$IP,$Dev);
       ($GivenNtype,$Ntype,$Type,$Net,$Node,$Dev,$IP)=split(',',$table1{$node2,$net});
       if ( $Ntype eq "tmscsi" || $Ntype eq "tmssa" ) {
           $Type1=substr($Dev,rindex($Dev,"/")+3);
       }
       else {
           $Type1=substr($Dev,rindex($Dev,"/")+1);
       }

       # for multi-node non-IP networks, issue a new IP address, to
       # allow each connection to a different destination to have its own
       # IP address
       if($Ntype eq "diskhbmulti") {
           $IP = get_next_fake_address($Ntype);
           push(@IPtable,$IP);

           # $slot_off was computed just above
           ($Dev, $Type1) = diskhbmulti_get_device($Dev,
                                                   $Type1,
                                                   $node2,
                                                   $node1,
                                                   $slot_off);
       }

       print STDERR sprintf("MachList: %4d %-4s %-14s %-10s\n",$NametoNum{$Node},$Type1,$IP,$Dev)
	    if exists $debug{MachList};
       print FP sprintf(" %4d %-4s %-14s %-10s\n",$NametoNum{$Node},$Type1,$IP,$Dev);
    }
}


################################################################################
#                                                                              #
# GetSlotOffsetForMultiNodeNonIPNetwork                                        #
#                                                                              #
#    Get the slot offset that corresponds to a given pair of nodes. The        #
#    slot offset is computed by (instanceNum % NR) * M + n, where              #
#                                                                              #
#        instanceNum is the instance number collected from cllstopsvcs         #
#        NR: number of disk HB ranges                                          #
#        M: maximum number of slots used                                       #
#        n: slot offset index based on the 2 node numbers                      #
#           (see below how 'n' is computed)                                    #
#                                                                              #
#    The goals of the offset assignment are:                                   #
#                                                                              #
#        * It should be deterministic                                          #
#        * It can be computed based on the given pair of node numbers          #
#        * Upon a refresh, ensure that the slot lands on an area of the disk   #
#          not in use by the nodes just before the refresh.                    #
#                                                                              #
# Arguments:                                                                   #
#                                                                              #
#    $node_number1 - node number of one of the nodes in the connection         #
#                                                                              #
#    $node_number2 - node number of the other node in the connection           #
#                                                                              #
#                                                                              #
# Results:                                                                     #
#                                                                              #
# Returns: Slot offset                                                         #
#          -1 if given node numbers are not part of the cluster                #
#                                                                              #
################################################################################

sub GetSlotOffsetForMultiNodeNonIPNetwork {
    my($node_number1, $node_number2) = @_;
    my($temp_nodes_file);
    my($index1, $index2);
    my($offset_index);
    my($number_of_nodes);
    my($slotOffset);
    my($rangeNumber);


    # In case this is being invoked via the -dhb_slot option then
    # data such as the instance number or the list of node numbers will
    # not have been loaded -- so load them now
    # For normal executions (startup, refresh) these will have already
    # been read.
    if(!defined($TSinstance)) {

        $TSinstance = GetInstanceNumber();
    }


    $rangeNumber = $TSinstance % $MULTINODE_DHB_NUMRANGES;

    # Also for when -dhb_slot is being used: retrieve node numbers from
    # the ODM. In normal flows, node number information would already be
    # available via an earlier call to GetNodeNameAndNumbersFromGODM()
    if(!defined(%NodeNumberIndex)) {
        $temp_nodes_file = "/tmp/$SUBSYS"."_nodes_$$";
        GetNodeNameAndNumbersFromGODM($temp_nodes_file);
        unlink($temp_nodes_file);
    }


    # get node indices for the 2 nodes; make sure $index1 has the smaller
    # value

    print STDERR "GetSlotOffset n1: $node_number1 n2: $node_number2\n"
                                                   if exists $debug{DHBMulti};

    if(!exists($NodeNumberIndex{$node_number1}) ||
       !exists($NodeNumberIndex{$node_number2})) {
        # invalid node number (not in the cluster)
        print STDERR "GetSlotOffset Invalid node number\n"
                                                   if exists $debug{DHBMulti};
        return -1;
    }
    if($node_number1 == $node_number2) {
        # no connection between a node and itself
        print STDERR "GetSlotOffset Duplicated node number\n"
                                                   if exists $debug{DHBMulti};
        return -1;
    }

    $index1 = $NodeNumberIndex{$node_number1};
    $index2 = $NodeNumberIndex{$node_number2};

    if($index1 > $index2) {
        # swap indices to ensure $index1 is smaller
        ($index1, $index2) = ($index2, $index1);
    }

    # compute number of nodes: it's the number of elements in the
    # %NodeNumberIndex hash
    $number_of_nodes = scalar keys %NodeNumberIndex;

    # compute an "offset index" based on the indices for the 2 nodes.
    # ($number_of_nodes - 1) indices are needed for $index1 == 0.
    # The number of such indices decreases by 1 for each $index1.
    # Since sum (1 ... N) == N(N+1)/2, the total number of indices used
    # for a given value of $index1 is
    #        ($index1 * $number_of_nodes) - $index1 * ($index1 + 1) / 2.
    # For a given value of $index1, there are $index2 - $index1 - 1 indices
    # used for values of the 2nd index that are smaller than $index2 
    $offset_index = $index1 * $number_of_nodes -
                    $index1 * ($index1 + 1) / 2 +
                    $index2 - $index1 - 1;

    # The slot offset is computed by taking the offset index computed above
    # and adding it to a "range offset". The latter is used so that at each
    # configuration refresh the slot "lands" on a different range of
    # offsets.
    $slotOffset = ($rangeNumber * $MULTINODE_DHB_SLOTS_PER_RANGE) +
                   $offset_index;
                   
    print STDERR
        "GetSlotOffset # Nodes: $number_of_nodes Range: $rangeNumber " .
        "Offset $slotOffset  \n"     if exists $debug{DHBMulti};

    return $slotOffset;
}

################################################################################
#                                                                              #
# GetInstanceNumber                                                            #
#                                                                              #
#     Get instance number by extracting the configuration instance from        #
#           /usr/es/sbin/cluster/utilities/clrsctinfo -p cllstopsvcs           #
#                                                                              #
#     Normally the instance number is extracted by GetSDRTS() when generating  #
#     the machines.lst. This function is called only for occasions where the   #
#     machines.lst file is not being generated.                                #
#                                                                              #
#     The logic comes from GetSDRTS().                                         #
#                                                                              #
#                                                                              #
# Returns: Instance number                                                     #
#          -1 in case of error                                                 #
#                                                                              #
################################################################################

sub GetInstanceNumber {
    my ($file);
    my ($instNum);
    my ($Odmfile, $rc);
    my ($header);
    my ($attr,$eqsign,$value);

    # temp file name
    $file = "/tmp/$SUBSYS"."_instance_$$";

    if (exists($overRide{'HACMPtopsvcs'})) {
        `cat $overRide{'HACMPtopsvcs'} > $file`;
    } else {
        #`$ODMDIR odmget HACMPtopsvcs  > $file`;
        # Defect 104569
        # The direction for getting information from HACMP has been AWAY from
        # calls to odmget. There was a command created called cllstopsvcs that
        # was intended to replace the call to retreive HACMPtopsvcs.    And now
        # there is clrsctinfo, which consolidates everything.  The idea is now
        # try that and then cllstopsvcs.  The output from  these commands is
        # different than that from the odmget call.
        $Odmfile=&findHacmpPath("cllstopsvcs");
        run_cmd_in_locale("en_US", "$ODMDIR $Odmfile > $file");
        $rc = get_exit_code($?);
        if ( $rc != 0 ) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                        "ALPHA,DEC", "96,4", "$ODMDIR $Odmfile > $file", $rc);
            print_message("EMSG660", $SCRIPT, $Odmfile);
            return -1;
        }
    }

    if (! open(FPT,$file)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            "$file");
        print_message("EMSG663", $SCRIPT, $file);
        my_exit(-1);
    }

    $instNum = -1;

    $header="=";
    while (<FPT>) {
        # Defect 104569
        # Even though we do not need to support the direct output of the
        # 'odmget HACMPtopsvcs' call, it may be useful to allow either format
        # for a manually specified input file.  At least for a little while.
        # The old format was: runFixedPri = 1
        # The new is: runFixedPri:    1 (except for instanceNum for some reason)
        if (/=/) {
            # An equal sign means it's the old format
            ($attr,$eqsign,$value)=split(' ',$_,3);
        } else {
            # No equal sign, split on the white space
            ($attr,$value)=split(' ',$_,2);
            # In all but one case, there will be a colon to remove
            $attr =~ s/://;
        }
        next if $attr eq "HACMPtopsvcs:" ||  $attr eq '';

        if ( $attr eq "instanceNum") {
            $instNum=$value;
            last;
        }
    }
    unlink $file;

    return $instNum;
}



################################################################################
#                                                                              #
# GetNodeNameAndNumbersFromGODM                                                #
#                                                                              #
#     Get node names and node numbers from the Global ODM                      #
#                                                                              #
# Arguments:                                                                   #
#                                                                              #
#     $temp_file - file where the output of clhandle is sent to                #
#                                                                              #
#                                                                              #
# Side-effects: Produces the following:                                        #
#                                                                              #
#     $NametoNum: hash for Node Names => Node Numbers                          #
#                                                                              #
#     $NodeNumbers: list of node numbers                                       #
#                                                                              #
#     $NodeNumberIndex: hash for Node Numbers => index                         #
#                                                                              #
#                                                                              #
################################################################################

sub GetNodeNameAndNumbersFromGODM {
    my($temp_file) = @_;
    my($cmd_name, $rc);
    my($node, $i);

    if (exists($overRide{'clhandle'})) {
        `cat $overRide{'clhandle'} > $temp_file`;
    } else {
        $cmd_name = &findHacmpPath("clhandle");
        run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -ac > $temp_file");
        $rc = get_exit_code($?);
        if ( $rc != 0 ) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                "ALPHA,DEC", "96,4", "$ODMDIR $cmd_name -ac > $temp_file", $rc);
                #print " Unable to execute clhandle \n";
                print_message("EMSG660", $SCRIPT, "clhandle");
                my_exit(-1);
        }
    }
    if (! open(NH, $temp_file)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            $temp_file);
        print_message("EMSG663", $SCRIPT, $temp_file);
        my_exit(-1);
    }
    while ( <NH> ) {
        chop($_);
        print STDERR "Node handle = $_ \n" if exists $debug{NodeNumber};
        ($nodeNumber, $nodeName) = split(':',$_,2);
        if (($nodeName ne '') && $NametoNum{$nodeName} eq '' ) {
            $NametoNum{$nodeName} = $nodeNumber;
            push(@NodeNumbers, $nodeNumber);
        }
    }

    # sort list of node numbers numerically
    sort numeric @NodeNumbers;

    # assign indices, starting from 0, to each node
    $i = 0;
    foreach $node (@NodeNumbers) {
        $NodeNumberIndex{$node} = $i;
        $i++;
    }

}


################################################################################
#                                                                              #
# diskhbmulti_get_device                                                       #
#                                                                              #
#   Implements special processing for device and interface name for multi-node #
#   non-IP networks: embded the node numbers for the local and remote nodes,   #
#   and also the slot offset for the given pair of nodes                       #
#                                                                              #
#   The device pathname has the following format:                              #
#                                                                              #
#         <local node number>_<remote node number>_<Slot Offset>/dev/[...]     #
#                                                                              #
#   The device interface name has the following format:                        #
#                                                                              #
#         <device base name>_<local node number>_<remote node number>          #
#                                                                              #
# Arguments:                                                                   #
#                                                                              #
#    $device_pathname: complete device pathname                                #
#                                                                              #
#    $device_intfcname: device "interface name" (device name without the       #
#        "/dev/")                                                              #
#                                                                              #
#    $local_node: name of local node in the connection                         #
#                                                                              #
#    $remote_node: name of local node in the connection                        #
#                                                                              #
#    $slot_offset: slot offset computed by a call to                           #
#                  GetSlotOffsetForMultiNodeNonIPNetwork()                     #
#                                                                              #
# Returns:                                                                     #
#                                                                              #
#    $return_device_pathname: composite device pathname                        #
#                                                                              #
#    $return_device_intfcname: composite device interface name                 #
#                                                                              #
################################################################################

sub diskhbmulti_get_device {
    my($device_pathname, $device_intfcname, $local_node, $remote_node, 
       $slot_offset) = @_;
    my($return_device_pathname, $return_device_intfcname);
    my($local_remote_string);

    $local_remote_string = "$NametoNum{$local_node}_$NametoNum{$remote_node}";

    $return_device_pathname = $local_remote_string .
                              "_" . "$slot_offset" .
                              $device_pathname;

    $return_device_intfcname = $device_intfcname . "." . $local_remote_string;

    return ($return_device_pathname, $return_device_intfcname);
}



################################################################################
#                                                                              #
# AddAdapterToMultiNodeNonIPNetwork                                            #
#                                                                              #
# Adds an adapter to MultiNodeNonIPNetwork, which contains lists of adapters   #
# for each network. Only the multi-node non-IP networks are represented        #
#                                                                              #
# Arguments:                                                                   #
#                                                                              #
#    $adapter - information about a given adapter                              #
#          ("$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In")           #
#                                                                              #
#    $netname - network name to which this adapter belongs                     #
#                                                                              #
# Results: MultiNodeNonIPNetwork: a hash (by network name) of adapter lists.   #
#                                                                              #
#                                                                              #
# Returns: <nothing>                                                           #
#                                                                              #
################################################################################


sub AddAdapterToMultiNodeNonIPNetwork {
    my($adapter, $netname) = @_;
    my(@adapters);

    if(!defined($MultiNodeNonIPNetwork{$netname})) {
        @adapters = ($adapter);
    }
    else {
        @adapters = @ {$MultiNodeNonIPNetwork{$netname}};
        push(@adapters, $adapter);
    }
    $MultiNodeNonIPNetwork{$netname} = [ @adapters ];

}

################################################################################
#                                                                              #
# MultiNodeNonIPDaisyTable                                                     #
#                                                                              #
# Given a list of multi-node non-IP networks, produces a set of point-to-point #
# networks that correspond to an all-to-all mapping of all the nodes in each   #
# network. The resulting data structures are suitable to be processed by       #
# greedy() and PrintSerial().                                                  #
#                                                                              #
# For each network in MultiNodeNonIPNetwork, this subroutine creates all the   #
# pairs of point-to-point connections.                                         #
#                                                                              #
#                                                                              #
# Globals: MultiNodeNonIPNetwork: a list multi-node non-IP networks,           #
#          and the adapters that belong to them (produced via calls to         #
#          AddAdapterToMultiNodeNonIPNetwork())                                #
#                                                                              #
# Arguments:                                                                   #
#                                                                              #
#    $DaisyRef: a "by reference" return argument: contains a "daisy" list      #
#               (see NonStandardDaisyTable(), for example) with the multiple   #
#               point-to-point networks that correspond to the multi-node      #
#               networks                                                       #
#                                                                              #
#                                                                              #
#    $SerialTableRef: a "by reference" return argument: contains a "serial"    #
#               table (like the one passed as parameter to                     #
#               NonStandardDaisyTable()), which is  a table indexed by         #
#               a node and the network to which it belongs.                    #
#                                                                              #
#                                                                              #
#                                                                              #
################################################################################

sub MultiNodeNonIPDaisyTable {

   my($DaisyRef, $SerialTableRef) = @_;
   my($i, $j);
   my($fake_netname);
   my($netcounter) = 0;
   my($DaisyTab_entry);
   my($GivenNtype_i,$NetType_i,$Type_i,$Net_i,$Node_i, $Att_i,$IP_i,$In_i);
   my($GivenNtype_j,$NetType_j,$Type_j,$Net_j,$Node_j, $Att_j,$IP_j,$In_j);

   # break each multi-node network into pairs of point-to-point networks

   # "sort" MultiNodeNonIPNetwork by network name to ensure all nodes get
   # the network in the same order

   foreach $netname (sort (keys(%MultiNodeNonIPNetwork))) {
      $net = $MultiNodeNonIPNetwork{$netname};

   ## while(($netname, $net) = each %MultiNodeNonIPNetwork)
   ##

      @adapters = @ {$net};

      # sort list of adapters, also to ensure all nodes get the adapters in
      # the same order
      @adapters = sort @adapters;

      foreach $i (0 ... $#adapters) {

          foreach $j (($i + 1) ... $#adapters) {

              $adapter_i = $adapters[$i];
              $adapter_j = $adapters[$j];

              ($GivenNtype_i,$NetType_i,$Type_i,$Net_i,$Node_i,
               $Att_i,$IP_i,$In_i)= split(",",$adapter_i);

              ($GivenNtype_j,$NetType_j,$Type_j,$Net_j,$Node_j,
               $Att_j,$IP_j,$In_j)= split(",",$adapter_j);

              $fake_netname = $netname.$netcounter;
              $netcounter++;

              print STDERR
         "MultiNodeNonIPNetwork: Net $netname Nodes $Node_i, $Node_j\n"
                                               if exists $debug{DHBMulti};

              print STDERR
         "        -- placed in network $fake_netname\n"
                                               if exists $debug{DHBMulti};

              # fill "serial table entries"
              $$SerialTableRef{$Node_i, $fake_netname} = $adapter_i;
              $$SerialTableRef{$Node_j, $fake_netname} = $adapter_j;
         
              # Create "daisy table" entries
              $DaisyTab_entry="$Node_i,$Node_j,$fake_netname,0";
              push(@$DaisyRef,$DaisyTab_entry);

          } # foreach $j

      } # foreach $i

   } # while each MultiNodeNonIPNetwork


   # $DaisyRef  and $SerialTableRef  are returned "by reference"

}





### Lookupservice groups the elements in $Mytable1 with respect to Types of adapter.There are three types such as boot,service and standby. Lookupservice groups the  nodes with boot , without service  AND  service without Boot.

sub Lookupservice {

    local ($type, $name, @Mytable1) = @_;
    local($i,$temp,@ServiceIP,%Bootadd,%Serviceadd,$m);
    local(@BootIP,%checknode,@multiple)=();
    local($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP);

    foreach $i (0 ... $#Mytable1) {


        ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP)=split(",",$Mytable1[$i]);
        if ( $NetType eq $type && $Net eq $name ) {
            print STDERR "Lookupservice:->$Mytable1[$i] \n" if exists $debug{Mytable};
            if ( $Type eq "boot") {
                push(@BootIP,$IP);
                $Bootadd{$Node}=$Node;
                print STDERR "Lookupservices: Bootadd{$Node}=$Bootadd{$Node} \n" if exists $debug{IntName};
            }
            elsif ( $Type eq "service" ) {
                push(@ServiceIP,$IP);
                $Serviceadd{$IP}=$Node;
                print STDERR "Lookupservices: Serviceadd{$IP}= $Serviceadd{$IP}\n" if exists $debug{IntName};
            }
        } else {
            print STDERR "Lookupservices:  $Mytable1[$i]\n" if exists $debug{Mytable};
        }
    }
    if ( $#ServiceIP != -1 ) {
        # If a service has a boot or its a floating service(node name is null)
        # then it goes into the service list. Like wise if it is a service
        # without a boot then it goes into the boot list.
        foreach $i (0 ... $#ServiceIP) {
            $Node=$Serviceadd{$ServiceIP[$i]};
            print STDERR "Lookupservices: ServiceIP[$i]=$ServiceIP[$i]\n" if exists $debug{IntName};
            print STDERR "Lookupservices: Serviceadd{$ServiceIP[$i]}=$Node\n" if exists $debug{IntName};
            if ( $Node eq '' ) { # floating service label
                push(@ServiceList, $ServiceIP[$i]);
            } else {
                $temp= $Bootadd{$Node};
                if ( $temp eq '' ) { # Service without a boot
                    if ( $checknode{$Node} ne $Node ) { 
                        push(@BootIP,$ServiceIP[$i]); 
                        $checknode{$Node}=$Node;
                    }
                    else {
                        $multiple[$m++]=$Table{$ServiceIP[$i]}; 
                    }
                } else {            # It has a boot, put it on the Service List
                    push(@ServiceList, $ServiceIP[$i]);
                }
            }
        }
    }
    print STDERR "Lookupservices: BootIP=@BootIP \n" if exists $debug{IntName};
    print STDERR "Lookupservices: ServiceIP=@ServiceIP \n" if exists $debug{IntName};
    print STDERR "Lookupservices: @ServiceList \n" if exists $debug{IntName};
    if ( $#BootIP != -1 ) {
        print STDERR "MachList:Network Name ${name}_$netnum\n" if exists $debug{MachList};
        print FP "Network Name ${name}_$netnum\n";
        print STDERR "MachList:Network Type $type\n" if exists $debug{MachList};
        print FP "Network Type $type\n";
        if ( ! $hacmp_version422 ) {
            &printTunables($type);
        }
        print STDERR "MachList:*\nMachList:*Node Type Address\n"
	    if exists $debug{MachList};
        print FP "*\n";
        print FP "*Node Type Address\n";
        &PrintTable ($type, $name, @BootIP);

        if ( $#ServiceList != -1 ) {
            &PrintService($type, $name, *ServiceList);
        }
        $netnum++;
        offset_limit("${name}_$netnum");
    }
     
    return  @multiple;
}




### Lookupstandby groups  the standby adapters and stores each IP addr into @Stanby array. And also it stores the @Mytable1 values into @multiple array to evaluate multiple stanbys 
 

sub Lookupstandby {

    local ($type, $name, @Mytable1) = @_;
    local(@Standby);
    local(%checknode);
    local($i,$temp,$m,@multiple);
    local($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP);
    foreach $i (0 ... $#Mytable1) {

        print STDERR "Lookupstandby: $Mytable1[$i] \n" if exists $debug{IntName};

        ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(",",$Mytable1[$i]);
        if ( $NetType eq $type && $Net eq $name ) {
            if ( $Type eq "standby") {
                if ( $checknode{$Node} ne $Node) { 
                     push(@Standby,$IP);
                     $checknode{$Node}=$Node;
                }
                else {
                     $multiple[$m++]=$Mytable1[$i];
                } 
             
            }
        }
        
    }
    if ( $#Standby != -1 ) {
        print STDERR "MachList:Network Name ${name}_$netnum\n" if exists $debug{MachList};
        print FP "Network Name ${name}_$netnum\n";
        print STDERR "MachList:Network Type $type\n" if exists $debug{MachList};
        print FP "Network Type $type\n";
        if ( ! $hacmp_version422 ) {
            &printTunables($type);
        }
        print STDERR "MachList:*\nMachList:*Node Type Address\n"
	    if exists $debug{MachList};
        print FP "*\n";
        print FP "*Node Type Address\n";
        &PrintTable ($type, $name, @Standby); 

        $netnum++;
        offset_limit("${name}_$netnum");
    }
    return @multiple;
}

################################################################################
#                                                                              #
# Subroutine: printTunables                                                    #
#   This subroutine retrieves the per-offset tunables from the odm class       #
#   HACMPnim via cllsnim -c, and output the values to the machines.lst file.   #
#                                                                              #
################################################################################
sub printTunables {
    local($type) = @_;
    my($name,$desc,$addrtype,$path,$para,$grace,$hbrate,$cycle,$custom_hbrate);
    my($gratarp,$entry_type,$next_generic_type,$next_generic_name,$src_routing);

    seek (FPNIM,0,0);    # rewind the FPNIM file, which contains
    while (<FPNIM>) {    # the result of `cllsnim`
        ($name,$desc,$addrtype,$path,$para,$grace,$hbrate,$cycle,
         $custom_hbrate,$gratarp,$entry_type,$next_generic_type,
         $next_generic_name,$src_routing) = split(':',$_);

        if ($name eq $type) {
            chomp($src_routing);

			# disable source routing in Linux
            if ("Linux" eq $OSname) {
                $src_routing = "0";
            }

            if($PLUGGABLE_NIM_SUPPORT) {
                # if the HACMP version does not support pluggable modules then
                # the contents of "path" are likely to be either NULL or
                # not valid
                if($path) {
                    print FP "*!NIM_pathname=$path\n";
                    print STDERR "MachList:*!NIM_pathname=$path\n"
                        if exists $debug{MachList};

                    # print path and version information
                    # version information is printed when -v option is used
                    print STDERR "Type: $type. NIM: $path\n";
                    # Defect 81658
                    # While the DMS kernel extension is loaded before this
                    # under most circumstances, it is not for refresh and 
                    # verification.  For those conditions, the version check
                    # is skipped.
                    if(!exists($NIMVersionPrinted{$path})) {
                        if ( (-x $path) && (!$REFRESH && !$VERIFY) ) {
                            $v = `$path -v`;
                            print STDERR "    $v";
                        }
                        $NIMVersionPrinted{$path} = 1;
                    }

                }
                if ( ($src_routing eq "1") || ($src_routing eq "0") ) {
                    print FP "*!NIM_Src_Routing=$src_routing\n";
                    print STDERR "MachList:*!NIM_Src_Routing=$src_routing\n"
                        if exists $debug{MachList};
                    if ($src_routing eq "1") {
                        $source_routing=1;
                    }
                }
            } else {
                # pluggable modules not supported, which means that
                # HACMPnim does not have the correct pathnames for
                # the NIMs. These have to be hardcoded.
                switch_type: {
                    if($type eq "rs232") {
                        $p = "/usr/sbin/rsct/bin/hats_rs232_nim";
                        last switch_type;
                    }
                    if($type eq "tmscsi") {
                        $p = "/usr/sbin/rsct/bin/hats_scsi_nim";
                        last switch_type;
                    }
                    if($type eq "tmssa") {
                        $p = "/usr/sbin/rsct/bin/hats_ssa_nim";
                        last switch_type;
                    }
                    if($type eq "diskhb") {
                        $p = "/usr/sbin/rsct/bin/hats_diskhb_nim";
                        last switch_type;
                    }
                    # default
                    $p = "/usr/sbin/rsct/bin/hats_nim";
                } # switch_type

                print FP "*!NIM_pathname=$p\n";
                print STDERR "MachList:*!NIM_pathname=$p\n"
                    if exists $debug{MachList};

                # print path and version information
                # version information is printed when -v option is used
                print STDERR "Type: $type. NIM: $p\n";
                # Defect 81658
                # While the DMS kernel extension is loaded before this under
                # most circumstances, it is not for refresh and verification.
                # For those conditions, the version check is skipped.
                if(!exists($NIMVersionPrinted{$p})) {
                    if ( (-x $p) && (!$REFRESH && !$VERIFY) ) {
                        $v = `$p -v`;
                        print STDERR "    $v";
                    }
                    $NIMVersionPrinted{$p} = 1;
                }
            } # pluggable modules not supported

            emit_frequency($type,$custom_hbrate);

            # $custom_hbrate = int ($custom_hbrate + 0.5);
            # if ($custom_hbrate > 0) {
            #     print STDERR sprintf("MachList:*!TS_Frequency=%d\n",
            #                          $custom_hbrate)
            #         if exists $debug{MachList};
            #     print FP sprintf("*!TS_Frequency=%d\n", $custom_hbrate)
            # }

            $cycle = int ($cycle + 0.5);
            if ($cycle >= 3) {
                print STDERR "MachList:*!TS_Sensitivity=$cycle\n"
                    if exists $debug{MachList};
                print FP "*!TS_Sensitivity=$cycle\n";
            }
            if ($para) {
                print STDERR "MachList:*!NIM_parameters=$para\n"
                    if exists $debug{MachList};
                print FP "*!NIM_parameters=$para\n";
            }
            verify_options ($type, $custom_hbrate, $cycle, $para, $grace);
        }
    }
} # sub printTunables ends


################################################################################
#                                                                              #
# Subroutine emit_frequency                                                    #
#   Print to the machines.lst the value of "frequency". The following needs    #
#   to be taken into account:                                                  #
#       - prior to HACMP 5.2, [[   clrsctinfo -p ]]  cllsnim produces hbrate   #
#         in seconds                                                           #
#       - starting with HACMP 5.2, the command above produces hbrate in        #
#         microseconds                                                         #
#       - values of hbrate that seem to be incompatible with their expected    #
#         unit need to be "adjusted"                                           #
#                                                                              #
#  Arguments:                                                                  #
#    $type   - Adapter type                                                    #
#    $hbrate - HB period, as given by cllsnim                                  #
#                                                                              #
################################################################################

sub emit_frequency {
    my ($type, $hbrate) = @_;
    my ($usecs);

    if($FAST_HB_SUPPORT) {
        # HACMP must be running at a level that supports fast HB, so hbrate
        # should be in microseconds

        if ($hbrate > 0) {

            if($hbrate < $USEC_SEC_VALUE_THRESHOLD) {
                # assume that the value must be in seconds, so convert to usecs
                print_message("I_TopsvcsHBrateConvertToUsecs",
                              $SCRIPT, $type, $hbrate);
                $hbrate *= $SECS_TO_USECS;  # convert to usecs
            }

            print STDERR sprintf("MachList:*!TS_Frequency=%d\n",
                                  $hbrate / $SECS_TO_USECS)
                if exists $debug{MachList};
            print FP sprintf("*!TS_Frequency=%d\n", $hbrate / $SECS_TO_USECS);

            $usecs = $hbrate % $SECS_TO_USECS;
            if($usecs > 0) {
                print STDERR sprintf("MachList:*!TS_FrequencyFraction=%d\n", 
                                      $usecs)
                    if exists $debug{MachList};
                print FP sprintf("*!TS_FrequencyFraction=%d\n", $usecs);
            }

        } # $hbrate > 0


    } # FAST_HB_SUPPORT
    else {
        # assume that HACMP does NOT support fast HB tunables (unless
        # the hbrate value seems too high to be in seconds)

        if ($hbrate > 0) {

            if($hbrate >= $USEC_SEC_VALUE_THRESHOLD) {
                # assume that the value must be in microseconds
                print_message("I_TopsvcsHBrateInUsecs",
                              $SCRIPT, $type, $hbrate);

                print STDERR sprintf("MachList:*!TS_Frequency=%d\n",
                                      $hbrate / $SECS_TO_USECS)
                    if exists $debug{MachList};
                print FP sprintf("*!TS_Frequency=%d\n",
                                 $hbrate / $SECS_TO_USECS);

                $usecs = $hbrate % $SECS_TO_USECS;
                if($usecs > 0) {
                    print STDERR sprintf("MachList:*!TS_FrequencyFraction=%d\n",
                                          $usecs)
                        if exists $debug{MachList};
                    print FP sprintf("*!TS_FrequencyFraction=%d\n", $usecs);
                }
            }
            else {  # hbrate value is in seconds
                print STDERR sprintf("MachList:*!TS_Frequency=%d\n", $hbrate)
                    if exists $debug{MachList};
                print FP sprintf("*!TS_Frequency=%d\n", $hbrate);
            }

        } # $hbrate > 0

    } # FAST_HB_SUPPORT

} # end of emit_frequency


################################################################################
#                                                                              #
# Subroutine verify_options                                                    #
#   Print an error message when any of several situations occurs:              #
#   $custom_hbrate is not between 1 and 10, inclusive                          #
#   $cycle is not between 4 and 75, inclusive                                  #
#   $para is not 9600, 19200, or 38400, or has the -r flag that is not         #
#     followed by one of the three valid rates (for rs232 only)                #
#   $grace is not between 30 and 360, inclusive                                #
#                                                                              #
#   Argument:                                                                  #
#   - $type: Type of network being checked (only important if rs232).          #
#   - $custom_hbrate: The heartbeat rate.                                      #
#   - $cycle: The failure cycle.                                               #
#   - $para: The parameters (only used for rs232)                              #
#   - $grace: The grace period.                                                #
#                                                                              #
#   $VERIFY_RC is set to -1 if any error is detected                           #
#                                                                              #
# Note: this function is now being called to verify tunable values passed      #
#       via arguments to topsvcs (-V option). This means that this function    #
#       cannot count on any "environment" (like log/run dirs or ODM) being     #
#       present.                                                               #
#                                                                              #
################################################################################
sub verify_options {
    my ($type, $custom_hbrate, $cycle, $para, $grace) = @_;
    my $rc = 0;
    my $baud = "9600";
    my $debug_level = "0";

    return if ( exists ($VerifyNetHash{$type}) );

    $VerifyNetHash{$type} = "1";


    # check hbrate. Need to take into account that prior to HACMP 5.2, hbrate
    # is specified in seconds, while with HACMP 5.2, hbrate is specified in
    # microseconds. See emit_frequency()

    $error_hb_rate = 0;
    $low_limit = $MIN_CUSTOM_HBRATE;
    $high_limit = $MAX_CUSTOM_HBRATE;

    if($custom_hbrate <= 0) {
        $error_hb_rate = 1;
    }
    else {
        # 1 == secs, 2 == usecs
        $unit = ($custom_hbrate >= $USEC_SEC_VALUE_THRESHOLD)? 2:1;
    }
    
    if(! $error_hb_rate) {

        if($unit == 1) {   # in seconds
            if(($custom_hbrate < $MIN_CUSTOM_HBRATE) ||
               ($custom_hbrate > $MAX_CUSTOM_HBRATE)) {
                $error_hb_rate = 1;
            }
        }
        else {             # in microseconds

            $high_limit = $MAX_CUSTOM_HBRATE * $SECS_TO_USECS;

            # type-specific limit checking
            switch_type_ver: {
                if($type eq "rs232") {
                    $low_limit = $MIN_CUSTOM_HBRATE_FAST_RS232_US;
                    last switch_type_ver;
                }
                if(($type eq "diskhb") || ($type eq "diskhbmulti")) {
                    $low_limit = $MIN_CUSTOM_HBRATE_FAST_DISKHB_US;
                    last switch_type_ver;
                }
                # default: IP or other "fast" type
                $low_limit = $MIN_CUSTOM_HBRATE_FAST_IP_US;
            } # switch_type_ver

            if(($custom_hbrate < $low_limit) ||
               ($custom_hbrate > $high_limit)) {
                $error_hb_rate = 1;
            }
        } # in microseconds

    } # no error so far

    if($error_hb_rate) {
        print_message("EMSG890", $SCRIPT, $type, $custom_hbrate,
                      $low_limit, $high_limit);
        $rc = 1;
    }

    # End of custom_hbrate checking


    unless ( ($cycle >= $MIN_CYCLE) && ($cycle <= $MAX_CYCLE) ){
        print_message("EMSG891", $SCRIPT, $type,$cycle, $MIN_CYCLE, $MAX_CYCLE);
        $rc = 1;
    }

    if ($type eq "rs232") {
        # If no parameters are given, we skip the entire check.
        if ($para ne "") {
            # For whichever pattern is matched, set $baud and $debug_level
            # for evaluation following this if clause.
            # If any are not specified, the values preset at the beginning
            # of this subroutine will keep those checks from failing.

            if ( $para =~ /^\s*(\d+)(a?)\s*$/ ) {
                # Any number, optionally followed by an "a", is a baud rate.
                # It might have white space before/after but nothing else.
                $baud = $1;
            } elsif ( $para =~ /^\s*-l\s*(\d+)\s*$/ ) {
                # The -l flag with a number is the debug level.
                # It might have white space before/after but nothing else.
                $debug_level = $1;
            } elsif ( $para =~ /^\s*-l\s*(\d+)\s+(\d+)(a?)\s*$/ ) {
                # The -l debug level followed by a baud rate were found.
                # They might have white space before/after but nothing else,
                # and must be in this order.
                $debug_level = $1;
                $baud = $2;
            } else {
                # Input string did not match any of the previous patterns.
                # Issue an explicit error here.
                print_message("EMSG895", $SCRIPT, $type);
                $rc = 1;
            }

            if (($debug_level eq "9600") || ($debug_level eq "19200")
               || ($debug_level eq "38400")) {
                print_message("EMSG896", $SCRIPT, $type, $debug_level);
                $rc = 1;
            }
            if (($baud ne "9600") && ($baud ne "19200") && ($baud ne "38400")) {
                print_message("EMSG892", $SCRIPT, $type, $baud);
                $rc = 1;
            }
        }
    }  # End of rs232 $para checking

    unless ( ($grace >= $MIN_GRACE) && ($grace <= $MAX_GRACE) ){
        print_message("EMSG893", $SCRIPT, $type,$grace, $MIN_GRACE, $MAX_GRACE);
        $rc = 1;
    }
    $VERIFY_RC = -1 if ( (($VERIFY == 1) || ($VERIFY_DATA_ENTRY == 1)) &&
                         ($rc == 1) );
}


sub PrintTable   {

    local ($type, $name, @IP) = @_;
    local($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$k);
    foreach $k (0 ... @IP) {

        print STDERR "PrintTable: $Table{$IP[$k]} \n" if exists $debug{IntName};

        ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(',',$Table{$IP[$k]});
        
        if ( $In eq '' ) {
            $In = "---";
        }

        if ( $NetType eq $type && $Net eq $name ) {
            # Defect 102065 - Check for missing interface names
            if ( ($In eq "---") && ($VERIFY == 1)) {
                print_message("EMSG894", $SCRIPT, $Net, $IP[$k]);
                $VERIFY_RC = -1;
            }
            print STDERR sprintf("MachList: %4d %-4s %-15s\n",
                                 $NametoNum{$Node},$In,$IP[$k])
		if exists $debug{MachList};
            print FP sprintf(" %4d %-4s %-15s\n",
                             $NametoNum{$Node},$In,$IP[$k]);
        }
    }
}

sub PrintService {
    local($type, $name, *IP)=@_;
    local($GivenNtype, $NetType, $Type, $Net, $Node, $Att, $IP, $k, $In);
    foreach $k (0 ... @IP) {
        print STDERR "PrintService: $Table{$IP[$k]} \n" if exists $debug{IntName};
        ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(',',$Table{$IP[$k]});
        if ( $In eq '' ) {
            $In = "---";
        }

        if ( $NetType eq $type && $Net eq $name ) {
            print STDERR sprintf("MachList:*!Service Address=%-15s\n",$IP[$k])
		if exists $debug{MachList};
            print FP sprintf("*!Service Address=%-15s\n",$IP[$k]);

            # Print node number for this service address.
            # This is used in the Force Down logic to determine whether
            # an adapter has a local service address 
            # or a remote -- cascading takeover -- address.
            if($Node ne '') {
                $node_num = $NametoNum{$Node};
            }
            else {
                $node_num = -1;
            }
            print STDERR sprintf(
                "MachList:*!Node of Service Address=%d\n",$node_num)
                if exists $debug{MachList};
            print FP sprintf(
                 "*!Node of Service Address=%d\n",$node_num);

        }
    }
}

sub GetSDRTS  {
    ### This subroutine executes cllstopsvcs and gets the frequency,
    ### Sensitivitity, Fixed priority. If it is not defined , it will take the
    ### default values. 
 
    local($DFLTfreq,$DFLTsens,$DFLTfix,$DFLTpri,$TIMESTAMP,$file);
    local($TSfreq,$TSsens,$TSfix,$TSpri,$header,$first,$second); 	
    local ($rc);
    ###  default  values

    $DFLTfreq=1;
    $DFLTsens=4;
    $DFLTfix=1;
    $DFLTpri=38;
    $DFLTlength=5000;

    ###
 
    if ($VERIFY == 1) {
        $file="$HB_RUNDIR/$login.txt.v";
    } else {
        $file="$HB_RUNDIR/$login.txt";
    }
    if (exists($overRide{'HACMPtopsvcs'})) {
	`cat $overRide{'HACMPtopsvcs'} > $file`;
    } else {
	#`$ODMDIR odmget HACMPtopsvcs  > $file`;
        # Defect 104569
        # The direction for getting information from HACMP has been AWAY from
        # calls to odmget. There was a command created called cllstopsvcs that
        # was intended to replace the call to retreive HACMPtopsvcs.    And now
        # there is clrsctinfo, which consolidates everything.  The idea is now
        # try that and then cllstopsvcs.  The output from  these commands is
        # different than that from the odmget call.
        $Odmfile=&findHacmpPath("cllstopsvcs");
        run_cmd_in_locale("en_US", "$ODMDIR $Odmfile > $file");
        $rc = get_exit_code($?);
        if ( $rc != 0 ) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                        "ALPHA,DEC", "96,4", "$ODMDIR $Odmfile > $file", $rc);
            print_message("EMSG660", $SCRIPT, $Odmfile);
            return -1;
        }
    }
    #open(FPT,$file) || die "Unable to open file $file";
    if (! open(FPT,$file)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            "$file");
        print_message("EMSG663", $SCRIPT, $file);
        my_exit(-1);
    }
    $header="=";
    while (<FPT>) {
        # Defect 104569
        # Even though we do not need to support the direct output of the
        # 'odmget HACMPtopsvcs' call, it may be useful to allow either format
        # for a manually specified input file.  At least for a little while.
        # The old format was: runFixedPri = 1
        # The new is: runFixedPri:    1 (except for instanceNum for some reason)
        if (/=/) {
            # An equal sign means it's the old format               
            ($attr,$eqsign,$value)=split(' ',$_,3);
        } else {
            # No equal sign, split on the white space
            ($attr,$value)=split(' ',$_,2);
            # In all but one case, there will be a colon to remove 
            $attr =~ s/://;
        }
        next if $attr eq "HACMPtopsvcs:" ||  $attr eq '';
        if ( $attr eq "hbInterval") {
            $TSfreq=$value;
        }
        if ( $attr eq "fibrillateCount" ) {
            $TSsens=$value;
        }
        if ( $attr eq "runFixedPri") {
            $TSfix=$value;
        }
        if ( $attr eq "fixedPriLevel") {
            $TSpri=$value;
        }
        if ( $attr eq "tsLogLength") {
            $LogLength=$value;
        }
        if ( $attr eq "instanceNum") {
            $TSinstance=$value;
        }
    }  
    eval `rm -f $file`;

    if ( $TSinstance eq '' ) {
        print STDERR "MachList:*InstanceNumber=1\n" if exists $debug{MachList};
        print FP "*InstanceNumber=1\n";
    } else {
        print STDERR "MachList:*InstanceNumber=$TSinstance" if exists $debug{MachList};
        print FP"*InstanceNumber=$TSinstance";
    }
    print STDERR "MachList:*configId=$configId\n" if exists $debug{MachList};
    print STDERR "MachList:*!TS_realm=HACMP\n" if exists $debug{MachList};
    print STDERR "MachList:*!TS_EnableIPAT\n" if exists $debug{MachList};
    print STDERR "MachList:*!TS_PinText\n" if exists $debug{MachList};
    print STDERR "MachList:*!TS_PinData\n" if exists $debug{MachList};
    if ("Linux" eq $OSname) {
        print STDERR "MachList:*!TS_PinStack\n" if exists $debug{MachList};
    }
    print FP "*configId=$configId\n";
    print FP "*!TS_realm=HACMP\n";
    print FP "*!TS_EnableIPAT\n";

    print FP "*!TS_PinText\n";
    print FP "*!TS_PinData\n";
    if ("Linux" eq $OSname) {
        print FP "*!TS_PinStack\n";
    }

    # In the future, it may be necessary to pass to the daemon information
    # regarding from which version to which version HACMP is migrating.
    if($MIGRATION_REFRESH == 1) {
        print STDERR "MachList:*!TS_MigrateToShiloh\n" if exists $debug{MachList};
        print FP "*!TS_MigrateToShiloh\n";
    }

    # this entry is going to be used by the daemon when it gets a migration
    # refresh.
    print STDERR "MachList:*!TS_HACMP_version=$hacmp_ver\n" if exists $debug{MachList};
    print FP "*!TS_HACMP_version=$hacmp_ver\n";

    if  ( $TSfreq eq '' ) {
	print STDERR "MachList:TS_Frequency=$DFLTfreq\n" 
            if exists $debug{MachList};
	print FP "TS_Frequency=$DFLTfreq\n"; 
    }
    else {
        if($TSfreq < 1) {
            $TSfreq = $DFLTfreq;
        }
	print STDERR sprintf("MachList:TS_Frequency=%d\n",$TSfreq)
	    if exists $debug{MachList};
	print FP sprintf("TS_Frequency=%d\n",$TSfreq); 
    }
    # Defect 104569
    # For consistency, we're going to print a default version of the
    # sensitivity.
    if ( $TSsens eq '' ) {
        print STDERR "MachList:TS_Sensitivity=${DFLTsens}\n"
            if exists $debug{MachList};
        print FP "TS_Sensitivity=${DFLTsens}\n";
    }
    else {
        if($TSsens < $DFLTsens) {
            $TSsens = $DFLTsens;
        }
        print STDERR sprintf("MachList:TS_Sensitivity=%d\n",$TSsens)
	    if exists $debug{MachList};
        print FP sprintf("TS_Sensitivity=%d\n",$TSsens);
    }
    
    if ( $TSfix != 0 || $DFLTfix != 0 ) {
        if ( $TSpri < 38 || $DFLTpri < 0 ) {
	   print STDERR "MachList:TS_FixedPriority=38\n" if exists $debug{MachList};
	   print FP  "TS_FixedPriority=38\n";
    	}
 	else {
	   print STDERR sprintf("MachList:TS_FixedPriority=%d\n",$TSpri)
		if exists $debug{MachList};
	   print FP sprintf("TS_FixedPriority=%d\n",$TSpri);
    	}
     }
    if ( $LogLength eq '' ) {
        print STDERR sprintf("MachList:TS_LogLength=%d\n",$DFLTlength)
	    if exists $debug{MachList};
        print FP sprintf("TS_LogLength=%d\n",$DFLTlength);
    }
    else {
        if($LogLength < 5000) {
            $LogLength = 5000;
        }
        print STDERR sprintf("MachList:TS_LogLength=%d\n",$LogLength)
	    if exists $debug{MachList};
        print FP sprintf("TS_LogLength=%d\n",$LogLength);
    }
        
return 1;
}

# Subroutine to sort an array of Node Names by Node Number
# Node Name to Number mapping kept in a Hash called NametoNum
sub NodeNameByNumber {
    $NametoNum{$a} <=> $NametoNum{$b}
}

###  This subroutine will execute  splstdata  to get the SDR values and  cllsif to get the ODM values. 

sub GetODM {

    local($number,$Atype,$Netaddr,$Netmask,$Hostname,$Type,$Rate);
    local($tmp,$a,$remain,$file,$SP,$Hostname,$Odmfile);

    local ($Net);
    local ($subnet, $Alias);
    ##########################################################################
    #                                                                        #
    # %AliasHash has net name key and value indicating if alias is on        #
    # %IPtoSub has IP address key and value of corresponding subnet          #
    # %SubnetHash has subnet key and value of number of nodes in the subnet  #
    # %NetToNetType has net name key and value corresponding to the net type #
    # @AliasList is a list of addresses for networks using aliasing          #
    # @Subnets is a list of all of the subnets                               #
    #                                                                        #
    ##########################################################################
    local (%AliasHash, %IPtoSub, %SubnetHash, %NetToNetType, @AliasList, @Subnets);
    local $UseAlias = 0;
    # Minimum HACMP version (as returned by clmixver) needed to support aliasing
    local $MIN_ALIAS_VER = 5;
    local ($rc);

    if ($VERIFY == 1) {
        $file="$HB_RUNDIR/$login.sp.v";
    } else {
        $file="$HB_RUNDIR/$login.sp";
    }
    if ( $hacmp_version422 ) {
        #`SDRGetObjects -x -d ':' Adapter node_number adapter_type netaddr  > $file`;
        run_cmd_in_locale("en_US", "SDRGetObjects -x -d ':' Adapter node_number adapter_type netaddr  > $file");
        $rc = get_exit_code($?);
        if ( $rc != 0){
            ffdc_errlog("ERRID_TS_SDR_ER", __LINE__, "", "", "");
            #print " Unable to execute SDRGetObjects \n";
	    #"%1$s: 2523-639 ERROR: Unable to retrieve %2$s from SDR\n"
	    print_message("EMSG639", $SCRIPT, "Adapter");
            my_exit(-1);
        }
	#open SP, $file  or die "Unable to open file $file";
        if (! open(SP, $file)) {
            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
                "$file");
            print_message("EMSG663", $SCRIPT, $file);
            my_exit(-1);
        }

### From $file , It collects the en* interfaces and maintain  a hash array with IP addresses, Hostnames ->  Node Number   , IP Address -> Node number. if the adapter type = csso , Then it generatas Node number to IP address hash array.

        while (<SP>) {
            ($number,$Atype,$Netaddr)=split(':',$_);
            chop $Netaddr;
            ### New changes as per 06/17/97
            if ( $Atype=~ /^en0/ ) {
                $etheradapip{$Netaddr}=$Netaddr;
            }

            # Convert from ascii to packed network address (inet_aton!!!)
            $paddr=pack "C4", split('\.',$Netaddr);

            # Use the packed address to find the host name
            # NOTE: the 2 in the second parameter for gethostbyaddr is the
            # value for AF_INET.
            ($Hostname,$dummyAlias,$dummyType,$dummyLength,@dummyAddrs) = gethostbyaddr $paddr, 2;

            # find the short name
            $pos=index($Hostname,".",0);
            if ( $pos != -1 ) {
                $Hostname=substr($Hostname,0,$pos);
            }
            
            if ( $NametoNum{$Hostname} eq '' ){
                $NametoNum{$Hostname}=$number;
                $IptoNum{$Netaddr}=$number;
            }
            if ( $HPSboot{$number} eq '' && $Atype eq "css0") {
                $HPSboot{$number}=$Netaddr;
            }
        }
    } else {                    # No longer in migration

        # read lsit of nodes from GODM and produce $NametoNum
        GetNodeNameAndNumbersFromGODM($file);

#	if (exists($overRide{'clhandle'})) {
#	    `cat $overRide{'clhandle'} > $file`;
#	} else {
#	    $cmd_name = &findHacmpPath("clhandle");
#	    #`$ODMDIR $cmd_name -ac > $file`;
#	    run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -ac > $file");
#            $rc = get_exit_code($?);
#	    if ( $rc != 0 ) {
#                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
#                    "ALPHA,DEC", "96,4", "$ODMDIR $cmd_name -ac > $file", $rc);
#		#print " Unable to execute clhandle \n";
#		print_message("EMSG660", $SCRIPT, "clhandle");
#		my_exit(-1);
#	    }
#	}
#	#open NH, $file or die "Unable to open file $file";
#        if (! open(NH, $file)) {
#            ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
#                $file);
#            print_message("EMSG663", $SCRIPT, $file);
#            my_exit(-1);
#        }
#
#        while ( <NH> ) {
#            chop($_);
#            print STDERR "Node handle = $_ \n" if exists $debug{NodeNumber};
#            ($nodeNumber, $nodeName) = split(':',$_,2);
#            if ( $NametoNum{$nodeName} eq '' ) {
#                $NametoNum{$nodeName} = $nodeNumber;
#            }
#        }

     }
    if ($VERIFY == 1) {
        eval `rm -f $file`;
    }

    if ($VERIFY == 1)
    {
        $nwfile="$HB_RUNDIR/cllsnw.log.v";
    } # END if
    else
    {
        $nwfile="$HB_RUNDIR/cllsnw.log";
    } # END else
    if (exists($overRide{'cllsnw'}))
    {
        `cat $overRide{'cllsnw'} > $nwfile`;
    } # END if
    else
    {
        $cmd_name = &findHacmpPath("cllsnw");
        run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -Sc > $nwfile");
        $rc = get_exit_code($?);
        if ( $rc != 0 )
        {
          ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC", "96,4",
              "$ODMDIR $cmd_name -Sc > $nwfile", $rc);
          print_message("EMSG660", $SCRIPT, "cllsnw");
          my_exit(-1);
        } # END if
    } # END else
    if (! open(ALIAS, $nwfile)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            "$nwfile");
        print_message("EMSG663", $SCRIPT, $nwfile);
        my_exit(-1);
    }
    ##########################################################################
    #                                                                        #
    # "cllsnw -Sc" has output of the form:                                   #
    #   netname:attr:alias:node1:adapter11:adapter12:node2:adapter21...      #
    # For the purposes of this script, only the netname, attr, and alias     #
    # attributes are important or even looked at.                            #
    #                                                                        #
    ##########################################################################
    while ( defined ($tmp = <ALIAS>) )
    {
        ($Net, $Type, $Alias) = split (':', $tmp);
        # $UseAlias is true if any networks use aliasing
        $AliasHash{$Net} = ( ($Alias eq "true") ? 1 : 0 );
        $UseAlias = ( $UseAlias || ($Alias eq "true") );
        print STDERR "Network $Net alias attribute = $Alias\n"
            if exists ($debug{Alias});
    } # END while
    $UseAlias = ($UseAlias && ($hacmp_ver >= $MIN_ALIAS_VER) );
    if ($VERIFY == 1)
    {
        eval `rm -f $nwfile`;
    } # END if
 
    if ( exists $overRide{'cllsifList'} ) {
        $Out_file=$overRide{'cllsifList'};
    } else {
        $Odmfile=&findHacmpPath("cllsif");
        if ($VERIFY == 1) {
            $Out_file="$HB_RUNDIR/cllsif.log.v";
        } else {
            $Out_file="$HB_RUNDIR/cllsif.log";
        }

        # 89745: check is done in findHacmpPath() now
        # if ( ! -x $Odmfile ) {
        #    ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
        #        $Odmfile);
        #    #printf("$Odmfile does not exist or is not executable.\n");
        #    print_message("EMSG661", $SCRIPT, $Odmfile);
        #    return -9;
        # }

        #`$ODMDIR $Odmfile -Sc > $Out_file`;
        run_cmd_in_locale("en_US", "$ODMDIR $Odmfile -Sc > $Out_file");
        $rc = get_exit_code($?);
        if ( $rc != 0 ) {
            ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__,
                "ALPHA,DEC", "96,4", "$ODMDIR $Odmfile -Sc > $Out_file", $rc);
            #printf("Unable to execute %s \n",$Odmfile);
	    print_message("EMSG660", $SCRIPT, $Odmfile);
            return -9;
        }
    }
    #open FP1, $Out_file or die "Unable to open file $Out_file";
    if (! open(FP1, $Out_file)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            $Out_file);
        print_message("EMSG663", $SCRIPT, $Out_file);
        my_exit(-1);
    }

    #local($j)=0; local($k)=0; local($l)=0; local($m)=0;
    local($j)=0; local($k)=0; local($l)=0;
    local($Adap,$Type,$GivenNtype,$Ntype,$Att,$Node,$IP,$Ha,$In);
    local(%Temp1,%Temp2,%Temp3,%Temp4,%Temp5,$NMask);

    # $GivenNtype : The network type from "nettype" field of the
    #      output of cllsif. e.g. Geo_Primary, ether.
    # $Ntype : The real network type. It is the same as $GivenNtype
    #      except for Geo_Secondary. Geo_Secondary can be IP based networks
    #      or non-IP networks. The network type of Geo_Secondary is 
    #      the real network type if it is non-IP based and "Geo_Secondary"
    #      if it is IP based. The real network type refers to the real
    #      non-IP based network used for heartbeating. Possible non-IP
    #      networks are "rs232", "tmscsi", "tmssa", and "diskhb".
    # $Type : Service type. e.g. "service" or "standby".
    # $Net : Network name. The "network" (3'rd) field of the output
    #      of cllsif.
    # $IP : The "ipaddr" (7'th) field of the output of cllsif. It is
    #      the IP address (e.g. 12.34.56.78) for IP based adapters and
    #      the device name (e.g. /dev/tty2) for non-IP based adapters.

###  
# Added the variable $GNet to pickup the Global Network Name field if
# it exists. Networks with the same Global Network name will be GLOMMED
# together into the same heartbeat ring.
    while(<FP1>) {
        chop($_);
        print STDERR "GetODM: $_ \n" if exists $debug{IntName};

        ($Adap,$Type,$Net,$GivenNtype,$Att,$Node,$IP,$Ha,$In,$GNet,$NMask) = 
            split(':',$_);

        if ( $In eq '' ) {
            $In = "---";
        }

        if ( ! $hacmp_version422 ) {
            if ( $GNet ne '' ) {
                $Net=$GNet;
            }
        }

        next if $Net eq '';
        next if $IP eq '';

        # This was replaced by add_to_TypeOrder(), which will return 0
        # if the type is not valid
        next if ! add_to_TypeOrder($GivenNtype, ! is_non_ip_addr("$IP"));

        # next if ! exists $TypeOrder{$GivenNtype};


        if ( $hacmp_version422 ) {
            next if $Node eq '';
            ###  gets the real hostname for the aliases
            $a=&getrealhost($Node);
            $pos=index($a,".",0);
            $Node=$a;
            if ( $pos != -1 ) {
                $Node=substr($a,0,$pos);
            }
        }
        ###########################################

	# Topology Services daemon treats all IP based adapters the
	# same way. The daemon doesn't pay attention to the net type.
	# Net type can be anything except for the types used for 
	# non-IP adapters. Currently, Topology Services daemon
        # supports "rs232", "tmscsi", "tmssa", and "diskhb" non-IP adapters.
	#

	# Skip invalid network types.
	next if ! ($Ntype = get_real_nettype("$GivenNtype", "$IP"));

        # If Ntype = rs232, then we create dummy ip addresses like
        # 255.255.0.n  We store all the dummy addresses into @IPtable array.
        # Also we create a second hash array $RStable1{$Node,$net}=
        # (Net type, Type, netname, Node name, device name, Serial IP add)  
        #
        if ( $Ntype eq "rs232" ) {
            $SerialIP="255.255.0.";
            $SerialIP="$SerialIP$j";
            push(@IPtable,$SerialIP);
            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
	    $Table{$SerialIP}=$reminder;
	    if ($GivenNtype eq "Geo_Secondary") {
		$RStableGEO{$Node,$Net}="v";
		$RStable1GEO{$Node,$Net}=$reminder;
		if ( ! exists $RSnodeHashGEO{$Node} ) {
		    $RSnodeHashGEO{$Node}=$Node;
		    push(@RSnodesGEO,$Node);
		}
		if ( ! exists $RSNetHashGEO{$Net} ) {
		    $RSNetHashGEO{$Net}=$Net;
		    push(@RSnetsGEO,$Net);
		}
	    } else {
		$RStable{$Node,$Net}="v";
		$RStable1{$Node,$Net}=$reminder;
		$Table{$SerialIP}=$reminder;
		if ( ! exists $RSnodeHash{$Node} ) {
		    $RSnodeHash{$Node}=$Node;
		    push(@RSnodes,$Node);
		}
		if ( ! exists $RSNetHash{$Net} ) {
		    $RSNetHash{$Net}=$Net;
		    push(@RSnets,$Net);
		}
	    }
            $j=$j+1;
            if ( ! exists $NetTypeHash{$GivenNtype} ) { # put "rs232" in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;       # defect 37332 
                push(@NetType,$GivenNtype);
            }
            next;
        }
 
        # If Ntype = tmscsi, then we create dummy ip addresses like 255.255.1.n.
        # We store all the dummy addresses into @IPtable array. Also we create
        # a second hash array $SCtable1{Node name, the net name}=(Net type,
        # Type, netname,Node name,device name,Serial IP add)  
     
        if ( $Ntype eq "tmscsi" ) {
            $SerialIP="255.255.1.";
            $SerialIP="$SerialIP$k";
            push(@IPtable,$SerialIP);
            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
            $Table{$SerialIP}=$reminder;
	    if ($GivenNtype eq "Geo_Secondary") {
		$SCtableGEO{$Node,$Net}="v";
		$SCtable1GEO{$Node,$Net}=$reminder;
		if ( ! exists $SCnodeHashGEO{$Node} ) {
		    $SCnodeHashGEO{$Node}=$Node;
		    push(@SCnodesGEO,$Node);
		}
		if ( ! exists $SCnetHashGEO{$Net} ) {
		    $SCnetHashGEO{$Net}=$Net;
		    push(@SCnetsGEO,$Net);
		}
	    } else {
		$SCtable{$Node,$Net}="v";
		$SCtable1{$Node,$Net}=$reminder;
		if ( ! exists $SCnodeHash{$Node} ) {
		    $SCnodeHash{$Node}=$Node;
		    push(@SCnodes,$Node);
		}
		if ( ! exists $SCnetHash{$Net} ) {
		    $SCnetHash{$Net}=$Net;
		    push(@SCnets,$Net);
		}
	    }
            $k=$k+1;
            if ( ! exists $NetTypeHash{$GivenNtype} ) { # put "tmscsi" in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;        # defect 37332
                push(@NetType,$GivenNtype);
            }
            next;
        }
        # If Ntype = tmssa, then we create dummy ip addresses like
        # 255.255.2.n. All the dummy addresses are put into @IPtable array.
        # Also we create a second hash array $SStable1{Node name , the net name}=
        # (Net type, Type, netname,Node name,device name,Serial IP add)  
  
     
        if ( $Ntype eq "tmssa" ) {
            $SerialIP="255.255.2.";
            $SerialIP="$SerialIP$l";
            push(@IPtable,$SerialIP);
            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
            $Table{$SerialIP}=$reminder;
	    if ($GivenNtype eq "Geo_Secondary") {
		$SStableGEO{$Node,$Net}="v";
		$SStable1GEO{$Node,$Net}=$reminder;
		if ( ! exists $SSnodeHashGEO{$Node} ) {
		    $SSnodeHashGEO{$Node}=$Node;
		    push(@SSnodesGEO,$Node);
		}
		if ( ! exists $SSnetHashGEO{$Net} ) {
		    $SSnetHashGEO{$Net}=$Net;
		    push(@SSnetsGEO,$Net);
		}
	    } else {
		$SStable{$Node,$Net}="v";
		$SStable1{$Node,$Net}=$reminder;
		if ( ! exists $SSnodeHash{$Node} ) {
		    $SSnodeHash{$Node}=$Node;
		    push(@SSnodes,$Node);
		}
		if ( ! exists $SSnetHash{$Net} ) {
		    $SSnetHash{$Net}=$Net;
		    push(@SSnets,$Net);
		}
	    }
            $l=$l+1;
            if ( ! exists $NetTypeHash{$GivenNtype} ) { # put "tmssa" in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;       
                push(@NetType,$GivenNtype);
            }
            next;
        }


        # If Ntype = diskhb, then we create dummy ip addresses using 
        # get_next_fake_address(). All the dummy addresses are put into 
        # @IPtable array.  Also we create a second hash array 
        # $HBtable1{Node name , the net name}=
        # (Net type, Type, netname,Node name,device name,Serial IP add)  
  
     
        if ( $Ntype eq "diskhb" ) {
            # Defect 91992
            # To avoid issues if the number of adapters exceeds 256, we use 
            # the better get_next_fake_address function to assign the fake
            # addresses.
            #$SerialIP="255.255.3.";
            #$SerialIP="$SerialIP$m";
            $SerialIP = get_next_fake_address($Ntype);
            push(@IPtable,$SerialIP);

            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
            $Table{$SerialIP}=$reminder;
#            if ($GivenNtype eq "Geo_Secondary") {
#                $HBtableGEO{$Node,$Net}="v";
#                $HBtable1GEO{$Node,$Net}=$reminder;
#                if ( ! exists $HBnodeHashGEO{$Node} ) {
#                    $HBnodeHashGEO{$Node}=$Node;
#                    push(@HBnodesGEO,$Node);
#                }
#                if ( ! exists $HBnetHashGEO{$Net} ) {
#                    $HBnetHashGEO{$Net}=$Net;
#                    push(@HBnetsGEO,$Net);
#                }
#            } else {
                $HBtable{$Node,$Net}="v";
                $HBtable1{$Node,$Net}=$reminder;
                if ( ! exists $HBnodeHash{$Node} ) {
                    $HBnodeHash{$Node}=$Node;
                    push(@HBnodes,$Node);
                }
                if ( ! exists $HBnetHash{$Net} ) {
                    $HBnetHash{$Net}=$Net;
                    push(@HBnets,$Net);
                }
#            }
            #$m=$m+1;
            if ( ! exists $NetTypeHash{$GivenNtype} ) { # put "diskhb" in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;       
                push(@NetType,$GivenNtype);
            }
            next;
        }


        # multi-node diskhb
        # get_next_fake_address() is used to get the fake IP addresses
        # A list of adapters per network is built

        if ( $Ntype eq "diskhbmulti" ) {

            # $SerialIP = get_next_fake_address($Ntype);
            # push(@IPtable,$SerialIP);
            # For "diskhbmulti" networks, the IP address is only assigned
            # when the networks are added to the machines.lst, since each
            # local adapter is "replicated" to form the point-to-point
            # connection to each of the remote nodes.
            $SerialIP = "Not yet assigned";

            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
            $Table{$SerialIP}=$reminder;

            # build MultiNodeNonIPNetwork
            AddAdapterToMultiNodeNonIPNetwork($reminder, $Net);

            if ( ! exists $HBnodeHash{$Node} ) {
                $HBnodeHash{$Node}=$Node;
                push(@HBnodes,$Node);
            }
            if ( ! exists $HBnetHash{$Net} ) {
                $HBnetHash{$Net}=$Net;
                push(@HBnets,$Net);
            }

            if ( ! exists $NetTypeHash{$GivenNtype} ) {
                                        # put "diskhbmulti" in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;       
                push(@NetType,$GivenNtype);
            }
            next;
        }


        # handle non-IP types other than those supported
        if(is_non_ip_addr("$IP") && is_non_standard_non_ip("$IP")) {

            print STDERR "Non-standard non-IP adapter: $IP\n"
                                               if exists $debug{Daisy};

            # get fake IP address
            $SerialIP = get_next_fake_address($Ntype);

            push(@IPtable,$SerialIP);
            $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$IP,$SerialIP,$In";
            $Table{$SerialIP}=$reminder;

            $NonStandardRStable1{$Node,$Net}=$reminder;

            # $NonStandardNets{}: each element is list of network names for each
            # of the non-stardard non-IP network types
            if(!defined ($NonStandardNets{$Ntype})) {
                @nets = ($Net);
            }
            else {
                @nets = @ {$NonStandardNets{$Ntype}};
                push(@nets, $Net);
            }
            $NonStandardNets{$Ntype} = [ @nets ];

            if ( ! exists $NetTypeHash{$GivenNtype} ) {
                                     # put network type in @NetType
                $NetTypeHash{$GivenNtype}=$GivenNtype;
                push(@NetType,$GivenNtype);
            }

            next;
        } # non-standard non-IP types

        # Build Net-to-NetType table
        $NetToNetType{$Net} = $GivenNtype unless exists ($NetToNetType{$Net});
        if ($UseAlias)
        {
            chomp ($NMask);
            $subnet = SubFilter ($NMask, $IP);
            unless ( exists ( $SubnetHash{$subnet} ) )
            {
                $SubnetHash{$subnet} = 1;
                push (@Subnets, $subnet);
            } # END if
            else
            {
                $SubnetHash{$subnet}++;
            } # END else
            # Build IP-to-subnet table
            $IPtoSub{$IP} = $subnet;
        } # END if

        ### Storing the Network type into NetType array
        if ( ! exists $NetTypeHash{$GivenNtype} ) {
            $NetTypeHash{$GivenNtype}=$GivenNtype;
            push(@NetType,$GivenNtype);
        }
#######################################################
        if ( $hacmp_version422 ) { 
            if ( $etheradapip{$IP} eq $IP ) {
                $hanet{$Net}=$Net;
            }
        }
#######################################################
        if ( ! exists $NetNameHash{$Net} ) {
            $NetNameHash{$Net}=0;
            push(@Netname,$Net);
        }

        if ( $Node ne '' ) {
            if ( ! exists $NodesPerNet{$Net}{$Node} ) {
                $NodesPerNet{$Net}{$Node} = $Node;
                $NetNameHash{$Net} += 1;
            }
        }

### stores the All  IP addresses into  @IPtable and forms a Hash table with IP address ,which maps to (Network type, Netname,Node name , Attribute,Ip address); 


# This skips non boot hps adapters, and changes the boot address for
# HPS adapters to what was found in the SDR.
        if ( $hacmp_version422 ) {
            print STDERR "GODM: In migration\n";
            if ( $Ntype ne "hps" || $Type eq "boot" ) {
                if ( $Ntype eq "hps" && ($GotHPSAdapter{$Node} ne "got") ) {
                    $IP = $HPSboot{$NametoNum{$Node}};
                    push(@IPtable,$IP);
                    $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$Att,$IP,$In";
                    $Table{$IP}=$reminder;
                    $GotHPSAdapter{$Node}="got";
                }
                else {
                    if ($Ntype ne "hps") {
                        push(@IPtable,$IP);
                        $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$Att,$IP,$In";
                        $Table{$IP}=$reminder;
                    }
                }
            }
            else {
                if ($GotHPSAdapter{$Node} ne "got") {
                    $IP = $HPSboot{$NametoNum{$Node}};
                    push(@IPtable,$IP);
                    $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$Att,$IP,$In";
                    $Table{$IP}=$reminder;
                    $GotHPSAdapter{$Node}="got";
                }
            }
        } else {
            if ( ! exists $uniqIP{$IP} ) {
                $uniqIP{$IP} = $IP;
                push(@IPtable,$IP);
                $reminder="$GivenNtype,$Ntype,$Type,$Net,$Node,$Att,$IP,$In";
                $Table{$IP}=$reminder;
            }
        }
    
    }
    close(FP1);
    if ( $hacmp_version422 ) {
        $count=0;
        print STDERR "Netname array = @Netname \n" if exists $debug{NetName};
#################################################################
        foreach $i (0 ... $#IPtable)  {
            print STDERR "GetODM2: $Table{$IPtable[$i]} \n" if exists $debug{IntName};
            ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(",",$Table{$IPtable[$i]});
            if ( $NetType eq "ether" ) {
                $count=0;
                foreach $ha (keys(%hanet)) {
                    $count++;
                    if ( $ha eq $Net ) {
                        $ethercount=0;
                        $adapnum=$IptoNum{$IPtable[$i]};
                        $dummy=1;
                        while($dummy) {
                            if ( $findhost{$adapnum,$ethercount} ne $adapnum ) {
                                $Net="Spnet_$ethercount";
                                if ( ! exists $NetNameHash{$Net} &&
                                    exists $NetNameHash{$ha} ) {
                                    $NetNameHash{$Net} = $NetNameHash{$ha};
                                    delete $NetNameHash{$ha};
                                }
                                $findhost{$adapnum,$ethercount}=$adapnum;
                                $Spnet{$Net}=$Net;
                                $dummy=0;
                                $Table{$IPtable[$i]}="$GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In";
                                foreach $j (0 ... $#Netname) {
                                    if ( $ha eq $Netname[$j] ) {
                                        $Netname[$j]=$Net;
                                    }
                                }
                            }
                            $ethercount++;
                        }
                    }
                }
            }
        }

        foreach $i ( 0 ... $#Netname) {
            
            if ( $Netname[$i] =~  /^Spnet/ ) {
            } else {
                push(@NewNetname,$Netname[$i]);
            }
	
        }
        foreach $a (reverse(keys(%Spnet)) ) {
            unshift @NewNetname,$a;
        }
        @Netname=@NewNetname;
    }
    print STDERR "After rename Netname list = @Netname\n" if exists $debug{NetName};
    print STDERR "Contents of Config Table:\n" if exists $debug{ConfigTable};
    foreach $i (0 ... $#IPtable)  {
        print STDERR "GetODM2: $Table{$IPtable[$i]} \n" if exists $debug{ConfigTable};
    }
##################################################################


#Sorting by Network type &  network name in order to  maintain the sequence


    # @NetType = sort { $TypeOrder{$a} <=> $TypeOrder{$b} } @NetType;
    # sorting is not done using by_type_order()
    @NetType = sort by_type_order @NetType;
    print STDERR "Sorted List of Net Types = @NetType \n" if exists $debug{NetType};

    print STDERR "IPtable=@IPtable\n" if exists $debug{IPaddrs};

    local(@Nodelist, %NodelistHash);
    foreach $j (0 ... $#IPtable) {
        print STDERR "GetODM3: $Table{$IPtable[$j]} \n" if exists $debug{IntName};
        ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$In)=split(",",$Table{$IPtable[$j]});
        # Entries with empty hostname should not enter Nodelist (d. 43936)
        if ( ! exists $NodelistHash{$Node} && $Node ne '' ) {
            $NodelistHash{$Node}=$Node;
            push(@Nodelist,$Node);
        }
    }

    print STDERR "Node List before sort=@Nodelist\n" if exists $debug{NodeList};
    @Nodelist = sort { $NametoNum{$a} <=> $NametoNum{$b} } @Nodelist;
    print STDERR "Node List after sort=@Nodelist\n" if exists $debug{NodeList};
        
    foreach $i (0 ... $#NetType) {
        local(@nodes,@nodenumber,$value,%NumtoName,%Temp1,%picknode);

        ### Converting the node names to node numbers and sorting the node numbers numerically. Subsequently, it converts back to the node names and stores the sorted list in @Mytable array. 
   

#        foreach $n (0 ... $#Nodelist) {
#            $value=$NametoNum{$Nodelist[$n]};
#            $nodenumber[$n]=$value;
#            $NumtoName{$value,$Nodelist[$n]}=$Nodelist[$n];
#        }
#        @nodenumber = sort numeric @nodenumber;
#        foreach $n (0 ... $#nodenumber) {
#            foreach $m ( 0 ... $#Nodelist ) {
#                if ( $NametoNum{$Nodelist[$m]} == $nodenumber[$n]  &&  $picknode{$Nodelist[$m]} eq '' ) {
#                    $picknode{$Nodelist[$m]}="$m"; 
#                    $nodes[$n]=$NumtoName{$nodenumber[$n],$Nodelist[$m]};
#                    last;
#                }
#            }
#        }

        foreach $k (0 ... $#Nodelist)  {
            foreach $j (0 ... $#IPtable) {
                ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(",",$Table{$IPtable[$j]});
                if ( $NetType[$i] eq $NetType && $Nodelist[$k] eq $Node ) {
                    $reminder="$GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IPtable[$j],$In";
                    print STDERR "GetODM4: Mytable=$reminder \n" if exists $debug{Mytable};
                    push(@Mytable,$reminder);
                }
            }
        }

        foreach $j (0 ... $#IPtable) {
            ($GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IP,$In)=split(",",$Table{$IPtable[$j]});
            if ( $NetType[$i] eq $NetType && $Node eq '' ) {
                $reminder="$GivenNtype,$NetType,$Type,$Net,$Node,$Att,$IPtable[$j],$In";
                print STDERR "GetODM4: Mytable=$reminder \n" if exists $debug{Mytable};
                push(@Mytable,$reminder);
            }
        }
    }

    if ($hacmp_ver >= $MIN_ALIAS_VER)
    {
        if ($UseAlias)
        {
            # Order @Subnets by nodes per subnet
            @Subnets = sort { $SubnetHash{$b} <=> $SubnetHash{$a} } @Subnets;
            print STDERR "IP aliasing supported and used\n" if $debug{Alias};
            ##################################################################
            #                                                                #
            # The following loops go through @Subnets, which is ordered by   #
            # the number of nodes in each subnet, highest to lowest,         #
            # through @Nodelist, which is ordered in numerical order, 1, 2,  #
            # 3, etc, and then through @Mytable.  The effect is to create    #
            # @AliasList so that it is grouped by subnet, fullest first, and #
            # within each subnet, nodes are in numerical order.              #
            # @AliasList will have any interfaces from all networks that use #
            # IP aliasing in the order just described.  The removal of these #
            # from @Mytable are the only changes to @Mytable.                #
            # @Mytable will contain interface data for all of the interfaces #
            # on networks not using IP aliasing, in the same order they were #
            # given above - i.e. by network type accoring to %TypeOrder and  #
            # in numerical node number order within each network type.       #
            # Other than floating service addresses which are after all      #
            # other addresses and in the %TypeOrder order.                   #
            #                                                                #
            ##################################################################
            foreach $i (0 ... $#Subnets)
            {
                foreach $j (0 ... $#Nodelist)
                {
                    for ($k = 0; $k <= $#Mytable; $k++)
                    {
                        $reminder = $Mytable[$k];
                        ($GivenNtype, $NType, $Type, $Net, $Node, $Att, $IP, $In) =
                        split (',', $reminder);
                        # Match subnet and node name (not floating service)
                        if ( ($Subnets[$i] eq $IPtoSub{$IP}) && ($Nodelist[$j] eq $Node) )
                        {
                            # Check that it's on a aliased network
                            if ($AliasHash{$Net} == 1)
                            {
                                print STDERR "GetODM5: AliasList=$reminder \n"
                                  if exists $debug{Alias};
                                #############################################
                                #                                           #
                                # The current interface is going to be      #
                                # pushed onto @AliasList.  Since it is      #
                                # removed from @Mytable at this point, $k   #
                                # is decremented to reflect that we have    #
                                # one less element.                         #
                                #                                           #
                                #############################################
                                splice (@Mytable, $k, 1);
                                push (@AliasList, $reminder);
                                $k--;
                                next;
                            } # END if
                        } # END if
                    } # END for
                } # END foreach
            } # END foreach
        } # END if
        else
        {
            print STDERR "IP aliasing supported but unused.\n"
                if exists $debug{Alias};
        } # END else
    } # END if
    else
    {
        print STDERR "No IP aliasing support.\n" if exists $debug{Alias};
    }

### The @TypeSeq has got 8 types("ether","hps","token","fddi","atm","rs232",
### "tmscsi","diskhb") For the types, rs232, tmscsi, it will
### evaluate the Daisy chains. For diskhb, the more generic greedy algorithm is
### used.  Then it will call Lookupservice and Lookupstanby subroutines.

    if ($VERIFY == 1) {
        $nimfile="$HB_RUNDIR/$login.nim.v";
    } else {
        $nimfile="$HB_RUNDIR/$login.nim";
    }
    if (exists($overRide{'cllsnim'})) {
        `cat $overRide{'cllsnim'} > $nimfile`;
    } else {
        $cmd_name = &findHacmpPath("cllsnim");
        run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -c > $nimfile");
    }
    $rc = get_exit_code($?);
    if ( $rc != 0 ) {
        ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC", "96,4",
            "$ODMDIR $cmd_name -c > $nimfile", $rc);
        print_message("EMSG660", $SCRIPT, "cllsnim");
        return -1;
    }
    #open(FPNIM,$nimfile) || die "Unable to open file $nimfile";
    if (! open(FPNIM,$nimfile)) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            $nimfile);
        print_message("EMSG663", $SCRIPT, $nimfile);
        my_exit(-1);
    }

    # Sort Network names in reverse order by the number of nodes that
    # each one contains. This is to make networks that span the Entire
    # cluster or more of it than any other network the first network.
    # This has the benefit that route calculation will be cheaper and
    # more routes will be single hop routes.
        
    print STDERR "Netname list before sort by number of nodes = @Netname\n" if exists $debug{NetName};
    foreach $i ( keys %NetNameHash ) {
        print STDERR "Netname=$i Number of Nodes=$NetNameHash{$i}\n" if exists $debug{NetName};
    }
    @Netname = sort { $NetNameHash{$b} <=> $NetNameHash{$a} } @Netname;
    print STDERR "Netname list after sort by number of nodes = @Netname\n" if exists $debug{NetName};
        
    foreach $i (0 ... $#NetType) {
        local(@retvalue);
        local($netnum, $realNtype);
        $netnum=0;
        print STDERR "Looking for type=$NetType[$i]\n" if exists $debug{NetType};
	# The real_ntype_table table is created in get_real_nettype()
	# in the beginning of parsing adapter information of cllsif command.
	$realNtype = $real_ntype_table{$NetType[$i]};

        if ( $realNtype eq "rs232" ) {
            print STDERR "Found NetType=$NetType[$i]\n" if exists $debug{NetType};
	    $Total=1;
	    if ($NetType[$i] eq "Geo_Secondary") {
		@Daisyrs232=&DaisyTable(*RSnodesGEO,*RSnetsGEO,*RStableGEO);
		if ( $#Daisyrs232 != -1) {
		    &Daisychain(*Daisyrs232,$Total,*RStable1GEO);
		}
	    } else {
		@Daisyrs232=&DaisyTable(*RSnodes,*RSnets,*RStable);
		if ( $#Daisyrs232 != -1) {
		    &Daisychain(*Daisyrs232,$Total,*RStable1);
		}
	    }
	    next;
        }
        if ( $realNtype eq "tmscsi" ) {
            print STDERR "Found NetType=$NetType[$i]\n" if exists $debug{NetType};
            $Total=1;
	    if ($NetType[$i] eq "Geo_Secondary") {
		@Daisyscsi=&DaisyTable(*SCnodesGEO,*SCnetsGEO,*SCtableGEO);
		if ( $#Daisyscsi != -1) {
		    &Daisychain(*Daisyscsi,$Total,*SCtable1GEO);
		}
	    } else {
		@Daisyscsi=&DaisyTable(*SCnodes,*SCnets,*SCtable);
		if ( $#Daisyscsi != -1) {
		    &Daisychain(*Daisyscsi,$Total,*SCtable1);
		}
	    }
            next;
        }
        if ( $realNtype eq "tmssa" ) {
            print STDERR "Found NetType=$NetType[$i]\n" if exists $debug{NetType};
            $Total=1;
	    if ($NetType[$i] eq "Geo_Secondary") {
		@Daisyssa=&DaisyTable(*SSnodesGEO,*SSnetsGEO,*SStableGEO);
		if ( $#Daisyssa != -1) {
		    &Daisychain(*Daisyssa,$Total,*SStable1GEO);
		}
	    } else {
		@Daisyssa=&DaisyTable(*SSnodes,*SSnets,*SStable);
		if ( $#Daisyssa != -1) {
		    &Daisychain(*Daisyssa,$Total,*SStable1);
		}
	    }
            next;
        }
        if ( $realNtype eq "diskhb" ) {
            print STDERR "Found NetType=$NetType[$i]\n" if exists $debug{NetType};
#            $Total=1;
#            if ($NetType[$i] eq "Geo_Secondary") {
#                @Daisydhb=&DaisyTable(*HBnodesGEO,*HBnetsGEO,*HBtableGEO);
#                if ( $#Daisydhb != -1) {
#                    &Daisychain(*Daisydhb,$Total,*HBtable1GEO);
#                }
#            } else {
#                @Daisydhb=&DaisyTable(*HBnodes,*HBnets,*HBtable);
                @Daisydhb = NonStandardDaisyTable(*HBtable1, $realNtype);
                if ( $#Daisydhb != -1) {
# For disk heartbeating, Daisychain() is not used because of its limitation to 
# a literal ring topology.  greedy() is more general.
#                    &Daisychain(*Daisydhb,$Total,*HBtable1);
                    greedy (*Daisydhb, *HBtable1);
                }
#            }
            next;
        }


        if ( $realNtype eq "diskhbmulti" ) {
            print STDERR "Found NetType=$NetType[$i]\n"
                                     if exists $debug{NetType};

            # invoke MultiNodeNonIPDaisyTable() to build the point-to-point
            # networks corresponding to each multi-node network.
            # @DaisyMultiNodeNonIP and %NonIPTable are produced in a format
            # that can be "consumed" by greedy()
            @DaisyMultiNodeNonIP = ();
            %NonIPTable = ();
            MultiNodeNonIPDaisyTable(\@DaisyMultiNodeNonIP, \%NonIPTable);

            if ( $#DaisyMultiNodeNonIP != -1) {
                greedy (*DaisyMultiNodeNonIP, *NonIPTable);
            }
            next;
        }


        # check if this is one of the non-standard non-IP network types
        if(exists($NonStandardNets{$realNtype})) {
            print STDERR 
              "Non-standard non-IP network type $realNtype\n"
                                            if exists $debug{NetName};

            # get the network names for this type
            # @nets = @{$NonStandardNets{$realNtype}};
            # not needed ??

            @Daisy = NonStandardDaisyTable(*NonStandardRStable1,$realNtype);
            if($#Daisy != -1) {
                greedy (*Daisy, *NonStandardRStable1);
            }
            next;
        } # a non-standard non-IP type


        print STDERR "Lookup loop Netname list = @Netname\n" if exists $debug{NetName};

    ##########################################################################
    #                                                                        #
    # At this point, the network type must not be any of the ones in which   #
    # HAGEO comes into play - i.e. non-IP types.                             #
    # Now we skim through each network of the type $NetType[$i] and call the #
    # appropriate routine to create the heartbeat rings for each network -   #
    # either handle_aliased() if that network uses IP aliases or a           #
    # combination of Lookupservice() and Lookupstandby() for traditional     #
    # networks.                                                              #
    #                                                                        #
    ##########################################################################
        foreach $j (0 ... $#Netname)
        {
            # Skip ahead if $Netname[$j] isn't of type $NetType[$i]
            next unless ($NetToNetType{$Netname[$j]} eq $NetType[$i]);

            $netnum=0;
            print STDERR "Looking for type=$NetType[$i] and Name=$Netname[$j]\n"
                if exists $debug{NetName};
            # If HACMP version is high enough and network uses aliasing
            if ($AliasHash{$Netname[$j]} == 1)
            {
                if ($hacmp_ver >= $MIN_ALIAS_VER)
                {
                    @retvalue = handle_aliased ($NetType[$i], $Netname[$j], @AliasList);
                    # Loop if nodes had multiple interfaces in same subnet
                    while ($#retvalue != -1)
                    {
                        @retvalue = handle_aliased ($NetType[$i], $Netname[$j], @retvalue);
                    } # END ewhile
                } # END if
                else
                {
                    print STDERR "Skipped $Netname[$j]: No HACMP IP alias support\n"
                        if exists $debug{Alias};
                } # END else
            } # END if
            # If HACMP version is too low or no aliasing used
            else
            {
                @retvalue = Lookupservice ($NetType[$i], $Netname[$j], @Mytable);
                while ($#retvalue != -1)
                {
                    @retvalue = Lookupservice ($NetType[$i], $Netname[$j], @retvalue);
                } # END while
                @retvalue = Lookupstandby ($NetType[$i], $Netname[$j], @Mytable);
                while ($#retvalue != -1)
                {
                    @retvalue = Lookupstandby ($NetType[$i], $Netname[$j], @retvalue);
                } # END while
            } # END else
        } # END foreach
    }


    # Finally add information about adapter-card NIMs and local adapters
    if($PLUGGABLE_NIM_SUPPORT) {
        generate_local_adapter_info();
    }

    eval `rm -f $nimfile`;
} # sub GetODM


sub handle_aliased
#############################################################################
#                                                                           #
# Subroutine: handle_aliased                                                #
# Description: Given a network type and network name, plus a list of        #
#   eligible interfaces, this subroutine creates networks (heartbeat rings) #
#   based on subnet, such that in each new network, a node is represented   #
#   only once.                                                              #
#                                                                           #
#   Arguments:                                                              #
#   - $type: network type                                                   #
#     example: $type = ether                                                #
#              $type = token                                                #
#   - $name: network name                                                   #
#     example: $name = SPethernet                                           #
#              $name = switch                                               #
#   - @alias_list: Array of interfaces on networks using aliasing           #
#     Order is by subnet, and in numerical node order for each subnet       #
#     Each entry is the given network type, the real network type, type of  #
#      address (boot, service), network name, node name, public or private, #
#      and the IP address                                                   #
#     example:                                                              #
#       $alias_list[0] = "ether,ether,boot,SPethernet,c47n01,public,1.2.3.4"#
#       $alias_list[0] = "hps,hps,boot,switch,c47n02,public,24.25.44.45"    #
#                                                                           #
#   Returns:                                                                #
#   - @multiple: An array storing the same type of entries as @alias_list   #
#     All interfaces for which a boot address for a particular node already #
#      exists for the current network in the machines list are placed in    #
#      here to create new ones in a later pass                              #
#     example:                                                              #
#        $multiple[0] = "ether,ether,boot,SPethernet,c47n01,public,1.2.3.5" #
#                                                                           #
#############################################################################
{
  local ($type, $name, @alias_list) = @_;
  local ($i, %Bootadd, $m);
  local (@BootIP, @multiple) = ();
  local ($GivenNtype, $NetType, $Type, $Net, $Node, $Att, $IP);
  local ($savedGivenNtype) = "ether";  # used for tunable values

  foreach $i (0 ... $#alias_list)
  {
    ($GivenNtype, $NetType, $Type, $Net, $Node, $Att, $IP) =
      split (",", $alias_list[$i]);
    if ( ($NetType eq $type) && ($Net eq $name) )
    {
      $savedGivenNtype = $GivenNtype;
      print STDERR "handle_aliased:->$alias_list[$i] \n"
        if exists $debug{Alias};
      if ( $Type eq "boot")
      {
        # Ensure one address per node for a ring
        unless ( defined ($Bootadd{$Node}) )
        {
          push (@BootIP, $IP);
          $Bootadd{$Node} = $Node;
          print STDERR "handle_aliased: Bootadd{$Node}=$Bootadd{$Node} \n"
            if exists $debug{IntName};
        } # END unless
        # Already have one interface, save it for new network
        else
        {
          push (@multiple, $alias_list[$i]);
        } # END else
      } # END if
    } # END if
    else
    {
      print STDERR "handle_aliased:  $alias_list[$i]\n" if exists $debug{Alias};
    } # END else
  } # END foreach
  print STDERR "handle_aliased: BootIP=@BootIP \n" if exists $debug{IntName};
  if ( $#BootIP != -1 )
  {
    print STDERR "MachList:Network Name ${name}_$netnum\n"
      if exists $debug{MachList};
    print FP "Network Name ${name}_$netnum\n";
    print STDERR "MachList:Network Type $type\n"
      if exists $debug{MachList};
    print FP "Network Type $type\n";
    print STDERR "MachList:*\nMachList:*Node Type Address\n"
      if exists $debug{MachList};
    &printTunables($savedGivenNtype);
    print FP "*\n";
    print FP "*Node Type Address\n";
    PrintTable ($type, $name, @BootIP);
    $netnum++;
    offset_limit ("${name}_$netnum");
  } # END if
  return @multiple;
} # END handle_aliased


sub SubFilter
#############################################################################
#                                                                           #
# Subroutine: SubFilter                                                     #
# Description: Given an IP address and a subnet mask, both in dotted        #
#   decimal format, produces the subnet of that IP adress.                  #
#                                                                           #
# Developer's note: pack "CCCC", split(/\./, $_[0]); is equal to            #
#     inet_aton($_[0]);. We use the former one because:                     #
#     - In case $_[0] is empty, inet_aton() returns undef instead of a      #
#         4-byte opaque string. This causes inet_ntoa() to fail.            #
#     - In case $_[0] contains less than 4 .-separated numbers inet_aton()  #
#         does not behave as we expect, e.g. 255.255.255 is treated as      #
#         255.255.0.255.                                                    #
#                                                                           #
#   Arguments:                                                              #
#   - $subnetmask: A subnet mask in dotted decimal form                     #
#     example: $subnetmask = 255.255.255.0                                  #
#              $subnetmask = 255.255.255.128                                #
#   - $ip  : An IP address in dotted decimal form                           #
#     example: $ip = 128.117.27.5                                           #
#              $ip = 9.117.10.34                                            #
#                                                                           #
#   Returns:                                                                #
#   - The subnet of the the given IP address in dotted deicmal              #
#     example:                                                              #
#        return (9.117.10.0)                                                #
#                                                                           #
#############################################################################
{
  my $subnetmask = pack "CCCC", split(/\./, $_[0]);
  my $ip = pack "CCCC", split(/\./, $_[1]);

  return ( inet_ntoa ($subnetmask & $ip) );
} # END SubFilter

### [ Machine list subroutine ]

sub MachineSub {
    local($home,$machine,$instNum,$cksum,$ret);
    $machine= $ENV{'HB_MACHINES_LIST'};
    if ( $hacmp_version422 ) {
        print STDERR "HB_MACHINES_LIST_REL1=$HB_MACHINES_LIST_REL1\n";
	# output of cksum is a number, doesn't need NLS
        $cksum=`exec echo "$HB_MACHINES_LIST_REL1" | cksum`;
    } else {
	# output of cksum is a number, doesn't need NLS
        $cksum= `exec echo "$machine" | cksum`;
    }
    ($configId, $bytes) = split(" ",$cksum);
    $instNum=time;
    
    #open(FP, ">$machine")  || die "Unable to open file $machine";
    if (! open(FP, ">$machine")) {
        ffdc_errlog("ERRID_TS_FILE_ACCESS_ER", __LINE__, "ALPHA", "100",
            "$machine");
        print_message("EMSG663", $SCRIPT, $machine);
        my_exit(-1);
    }

    print STDERR "Generating the machine list file in $machine\n";
    
    $ret=&GetSDRTS();
    if ($ret == -1 ) {
	#print "   Error occured while executing GetSDRTS \n";
        return -1;	
    }
    $ret=&GetODM();
    if ( $ret == -1 || $ret == -2 || $ret == -3) {
        #print "   Error occured while executing GetODM   \n";
        return -1;
    }
    if ( $ret == -9 ) {
        #print "Node is not in Hacmp mode \n";
	print_message("EMSG664", $SCRIPT);
    }
 
    close(FP);
}

#########################################################################
#									#
# Subroutine: get_real_nettype						#
# Description: Check if the input network type is IP based and find	#
#     the real type if it is non-IP based.				#
#									#
#     Network types like Geo_Primary exist in the HACMPnim class so that#
#     special tuning values can be associated with this type of network.#
#     Topology Services needs to know the real network type associated 	#
#     with networks Geo_Primary and Geo_Secondary, in order for the 	#
#     daemon can communicate through the network. For example, if a 	#
#     Geo_secondary network is implemented by an RS-232 link then the	#
#     network type in the machines.lst file must be "rs232".		#
#									#
#     We use "identifier" field of odm object HACMPadapter ("ipaddr" of	#
#     the output of command cllsif) to determine if an adapter is IP 	#
#     based. An IP based adapter will contain an IP address in this 	#
#     field while a non-IP based adapter will contain a device file	#
#     name (e.g. /dev/tty0) in this field. The device file name can be	#
#     used to find the real type of the HAGEO nettype.			#
#									#
#     This subroutine is used for HAGEO support. Only Geo_Secondary is	#
#     checked currently. We should test if HAGEO_SUPPORT is enabled	#
#     before processing. However, the subroutine is not called because	#
#     Geo_xxxx are not in %TypeOrder table if HAGEO is not supported.	#
#									#
# Input:								#
#     GivenNtype : the network type whose real type must be found.	#
#     ip : IP address (IP based) or device file name (non-IP based)	#
# Return:                                                          	#
#       The same as nettype if the network is IP based.			#
#       The real type if the network is non-IP based.			#
#									#
#########################################################################

sub get_real_nettype {
    local ($GivenNtype, $ip) = @_;
    local ($nothing, $devprefix, $devname, $returnval);

    # GivenNtype "IP" (generic IP) is by definition IP based.
    # GivenNtype "Geo_Primary" must be IP based networks to run
    # HAGEO communication. "IP" and "Geo_Primary" do not need
    # special treatment. GivenNtype "Geo_Secondary" can be either
    # IP or non-IP based. If it is IP based, no special treatment.
    # The Ntype will be "Geo_Secondary". If it is non-IP based,
    # we need to find out the real type of device and use it
    # as the Ntype.
    
    if ($GivenNtype eq "Geo_Secondary") {
	# A device file looks like "/dev/tty2".
	# As of AIX 4.3.3, tty device names are /dev/tty[0-9]+.
	# e.g. /dev/tty123. Do not mix up tty with ttyp[0-9,a-f].
	# No information about tmscsi and tmssa devices. But they
	# are unlikely to have more than 10 devices on one machine.
	($nothing, $devprefix, $devname) = split(/\//, $ip);
    	if (($nothing eq "") && ($devprefix eq "dev")) {
	    # chop off the trailing decimal digits (device count).
	    $devname =~ s/([0-9])+$//;
	    if (exists($NonIPType{$devname})) {
		$returnval = $NonIPType{$devname};
	    } else {
		# Device is not found in supported non-IP based adapter table.
                # With the NIM support, this is OK.
		print STDERR "Adapter $devname used by non-IP based network $GivenNtype is not supported.\n" if exists $debug{NetType};
		$returnval = $GivenNtype;
	    }
	} else {
	    # Check if is a valid IP address: nn.nn.nn.nn
	    if ($ip =~ m/^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
		# IP based adapter. Any type is allowed. Just return
		# the same net type.
		$returnval = $GivenNtype;
	    } else {
		# The ipaddr field of the output of cllsif command is
		# either a device name for a non-IP based network or
		# a valid IP address for an IP based network. It is
		# an HACMP configuration error if ipaddr field is not
		# a device name or an IP address.
		print STDERR "The ipaddr field of the output of cllsif \"$ip\" must be an IP address or a device name.\n";
		$returnval = "";
	    }
	}
    } else {
	$returnval = $GivenNtype;
    }
    if (exists($real_ntype_table{$GivenNtype})) {
	if ($real_ntype_table{$GivenNtype} ne $returnval) {
	    # The current Ntype differs from the previously registered one.
	    # There is a Ntype inconsistent problem.
	    # This should not happen unless a network type is specified
	    # twice with different real network type.
	    print STDERR "Network of type $GivenNtype has heterogeneous types: $real_ntype_table{$GivenNtype} and $returnval\n";
	    $returnval = "";
	}
    } else {
	# New Ntype. Add it to real_ntype_table.
	$real_ntype_table{$GivenNtype} = $returnval;
    }
    return($returnval);
}

#########################################################################
#                                                                       #
# Subroutine: is_non_ip_addr                                            #
# Description: Determine whether the given "address" is an IP address   #
#     or a non-IP device name.                                          #
#                                                                       #
# Input:                                                                #
#     ip : IP address (IP based) or device file name (non-IP based)     #
# Return:                                                               #
#     1 if non-IP device name                                           #
#     0 if IP address                                                   #
#                                                                       #
#########################################################################

sub is_non_ip_addr {
    my ($ip) = @_;

    # Check if is a valid IP address: nn.nn.nn.nn
    if ($ip =~ m/^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
        return 0;
    }
    else {
        # note that for now we are not restricting the format of the
        # non-IP address. It could be /dev/xxx, but it really does not
        # have to be. Let the non-IP NIM interpret the address/device.
        return 1;
    }
}

#########################################################################
#                                                                       #
# Subroutine: is_non_standard_non_ip                                    #
# Description: Determine whether the given non-IP network type is one   #
#     of the supported types. (if it is not then it is assumed that     #
#     that the user is providing a NIM for that type)                   #
#                                                                       #
#     It is assumed this function is being called for a non-IP type     #
#                                                                       #
# Input:                                                                #
#     addr: non-IP device name                                          #
# Return:                                                               #
#     1 if a non-supported non-IP network type                          #
#     0 otherwise                                                       #
#                                                                       #
#########################################################################

sub is_non_standard_non_ip {
    my($addr) = @_;
    my($nothing, $devprefix, $devname, $returnval);

    $returnval = 1;  # start assuming this is a non-supported type

    ($nothing, $devprefix, $devname) = split(/\//, $addr);

    if (($nothing eq "") && ($devprefix eq "dev")) {
        # the supported types all have device name /dev/xxxx[0-9]+

        # chop off the trailing decimal digits (device count).
        $devname =~ s/([0-9])+$//;
        if (exists($NonIPType{$devname})) {
            $returnval = 0; # one of the supported types
        }
    }

    return $returnval;
}


#########################################################################
#									#
# Subroutine: is_english_locale						#
# Description: Check if the current locale is English. Special locale   #
#     POSIX and C are considered English.                               #
# Note:									#
#	Since we use external command /usr/sbin/rsct/bin/hadspmsg to 	#
#	display messages, the locale environment variables, not the 	#
#	locale setting in this Perl script, are the ones that control	#
#	the behavior of message displaying.				#
# Return code:                                                          #
#       0 : current locale is not an English locale                     #
#       1 : current locale is an English locale                         #
#									#
#########################################################################

sub is_english_locale {
    local ($curr_locale);
    local ($rc);

    # Priority: LC_ALL > LC_MESSAGES > LANG > default ("C").
    $curr_locale = "C";
    if (exists($ENV{LANG}) && $ENV{LANG}) {
	$curr_locale = $ENV{LANG};
    }
    if (exists($ENV{LC_MESSAGES}) && $ENV{LC_MESSAGES}) {
	$curr_locale = $ENV{LC_MESSAGES};
    }
    if (exists($ENV{LC_ALL}) && $ENV{LC_ALL}) {
	$curr_locale = $ENV{LC_ALL};
    }
    # C and POSIX and considered English locales.
    if ($curr_locale eq "C" || $curr_locale eq "POSIX") {
	$rc = 1;
    } else {
	# Get first 2 characters and translate them into upper case.
	$curr_locale = substr($curr_locale, 0, 2);
	$curr_locale =~ tr/A-Z/a-z/;
	if ($curr_locale eq "en") {
	    $rc = 1;
	} else {
	    $rc = 0;
	}
    }
    return ($rc);
}

#########################################################################
#									#
# Subroutine: run_cmd_in_locale						#
# Description: run an external command in specified locale.		#
# Developers' note:							#
#	It is handy to use "`LC_ALL=en_US $command`" to print English	#
#	message. Unfortunately, it appears that the command $command is #
#	executed, but the output is not sent back to the caller. Hence	#
#	we need to save/change/restore environment variable LC_ALL to	#
#	get the output string from $command.				#
# Developers' note: "`VAR=val command`" works incorrectly if	        #
#       environment name contains '_'. eg. LC_ALL. Otherwise, it works  #
#       correctly. A Perl5 bug?						#
# 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.                                        #
#       command : external command to be run and its parameters packed  #
#               in a single string                                      #
# Return:                                                               #
#       The output (STDOUT) of the command.                             #
#       Since Perl sets $? only for the last pipe close, backtick (``)  #
#       command, or system() operator, $? will be set when the external #
#       command is run and keep unchanged through the end of this       #
#       subroutine. The caller will receive the $? returned by the      #
#       execution of the external command.                              #
#                                                                       #
#########################################################################

sub run_cmd_in_locale {
    local ($locale, $command) = @_;
    local ($lc_all_exist);
    local ($lc_all_save);
    local (@output);

    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;
    }
    @output = `$command`;
    if ($locale) {
	# Restore LC_ALL
	if ($lc_all_exist) {
	    $ENV{LC_ALL} = $lc_all_save;
	} else {
	    delete($ENV{LC_ALL});
	}
    }
    return (@output);
}

#########################################################################
#									#
# Subroutine: get_cat_msg						#
# Description: call /usr/sbin/rsct/bin/hadspmsg 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.					#
#	msg: the message label defined in message catalog and variable  #
#               number of arguments for the message.                    #
# Global:								#
#	Locale environment variables. 					#
#	MSGCMD: "/usr/sbin/rsct/bin/hadspmsg script hats.cat"		#
#									#
#########################################################################

sub get_cat_msg {
    local ($locale, @msg) = @_;
    local ($command, $rc, $msg_string);

    # form command line for hadspmsg command
    $command = "$MSGCMD " . join(' ', @msg);
    # use hadspmsg command to get an NL message.
    $msg_string = join('', run_cmd_in_locale($locale, $command));
    $rc = get_exit_code($?);
    if ($rc) {
        # $MSGCMD exits with an error. The message facility must be broken.
        # Use a hard-coded message for the error.
        $msg_string = "Cannot get message using: $command. Check if $MSGCMD " .
            "is executable and message map is up-to-date.\n";
    }
    return($msg_string);
}

#########################################################################
#									#
# Subroutine: print_message						#
# Description:								#
#	Print NL messages. if $PRINT_ENG_MSG is true, print English	#
#	version also.							#
# Input:								#
#	message_label: the message label defined in message catalog.	#
#	argument: variable number of arguments for message.		#
# Global:								#
#	Locale environment variables. 					#
#	PRINT_ENG_MSG: 							#
#	    0: print only NL message					#
#	    1: print both NL and English message (for service people)	#
#									#
#########################################################################

sub print_message {
    local ($lc_all_save);
    local ($lc_all_exist);
    local ($i);
    local ($m);

    # When a new message is added to the catalog by replacing an empty
    # message, the empty message will still be produced when an older
    # message catalog is present.  This is possible because the code
    # filesets are updated more often than the message catalog.
    # A change to the process of adding new messages should prevent
    # this from happening in the future, but we should still check
    # for blank messages.  If one is seen, we will try to get a good
    # message directly from the hats.script.map file.

    $m = get_cat_msg("", @_);
    if($m == "") {
       printf(STDERR "%s", get_cat_msg("C", @_));
    } else {
       printf(STDERR "%s", $m);
       if ($PRINT_ENG_MSG) {
           printf(STDERR "%s", get_cat_msg("en_US", @_));
       }
    }
}

#########################################################################
#									#
# Subroutine: my_exit							#
# Description: wrapper for exit. Saves the log and then exit.		#
# Input:								#
#	exit_code							#
#									#
#########################################################################

sub my_exit {
    local ($exit_code);
    # Default exit code is 1.
    $exit_code = ($#_ < 0) ? 1 : $_[0];
    print_message("EMSG600", $SCRIPT, $exit_code);
    # Defect 105890 - If this is a result of an error in saveLogs(), we do
    # not want to call saveLogs() again.
    saveLogs() unless $IN_SAVELOGS;
    if ($VERIFY == 1) {
        eval `rm -f $Out_file` unless ( exists $overRide{'cllsifList'} );
        eval `rm -f $ENV{'HB_MACHINES_LIST'}`;
    }
    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);
    }
    return ($return_code);
}

#########################################################################
#									#
# Subroutine: saveLogs							#
# Description: creates a set of backup log files. The current log file	#
#	is copied to <log file>.1, <log file>.1 is copied to		#
#	<log file>.2, and so on, up to $NUMBER_OF_LOGS.			#
# Input: None								#
# Output: None								#
# Global:								#
#	$NUMBER_OF_LOGS: maximum number of logs to keep.		#
#	$DFLT_LOG: The log file name 					#
#									#
#########################################################################

sub saveLogs {
    local ($srcfile, $dstfile);
    local (@filelist);
    local ($date);
    local ($filecontent);
    local ($i);
    $IN_SAVELOGS = 1;

    # Do nothing if $DFLT_LOG is not defined or "".
    # Also this function cannot work if we are exiting too early into the
    # execution of this script (such as if the HACMP utilities cannot be
    # found)
    if ($DFLT_LOG && defined($ENV{'HB_MACHINES_LIST'})) {
	# Perl function localtime() without parameter returns ctime().
	# We do not do NLS on this message since it is for service people only.
	$date = localtime;
	printf(STDERR "%s ==========\n", $date);
        eval `chmod 0644 $DFLT_LOG`;
	# save also copies of some files
	# $Out_file is cllsifList or $HB_RUNDIR/cllsif.log.
	# output of /bin/ls (file names) is used "as is". No NLS
	@filelist = `/bin/ls $ENV{'HB_MACHINES_LIST'}* $HB_RUNDIR/dms_loads.out $Out_file 2> /dev/null`;
	if (@filelist) {
	    chomp(@filelist);
	    for($i = 0; $i <= $#filelist; $i++) {
		printf(STDERR "---- %s ----\n", $filelist[$i]);
		# The output of the following external command is not parsed
		# by topsvcs.pl. No NLS is needed.
		$filecontent = `/usr/bin/cat $filelist[$i] 2> /dev/null`;
		printf(STDERR "%s\n", $filecontent);
	    }
	}
        # Defect 104569
        # This, too, must use clrsctinfo/cllstopsvcs 
        # printf(STDERR "---- ODM object HACMPtopsvcs ----\n");
        if (exists($overRide{'HACMPtopsvcs'})) {
            printf(STDERR "---- %s ----\n", $overRide{'HACMPtopsvcs'});
            $filecontent = `cat $overRide{'HACMPtopsvcs'}`;
        } else {
            $cmd_name = &findHacmpPath("cllstopsvcs");
            printf(STDERR "---- %s ----\n", $cmd_name);
            $filecontent =
                join('', run_cmd_in_locale("en_US", "$ODMDIR $cmd_name"));
        }
	printf(STDERR "%s\n", $filecontent);
	if (exists($overRide{'cllsnim'})) {
            printf(STDERR "---- %s ----\n", $overRide{'cllsnim'});
	    $filecontent = `cat $overRide{'cllsnim'}`;
	} else {
            $cmd_name = &findHacmpPath("cllsnim");
            printf(STDERR "---- %s -c ----\n", $cmd_name);
            $filecontent = join('', run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -c"));
	}
	printf(STDERR "%s\n", $filecontent);
	if ( $hacmp_version422 ) {
	    printf(STDERR "---- SDRGetObjects -x -d ':' Adapter node_number adapter_type netaddr ----\n");
	    $filecontent = join('', run_cmd_in_locale("en_US", "SDRGetObjects -x -d ':' Adapter node_number adapter_type netaddr"));
	    printf(STDERR "%s\n", $filecontent);
	} else {
	    if (exists($overRide{'clhandle'})) {
		printf(STDERR "---- %s ----\n", $overRide{'clhandle'});
		$filecontent = `cat $overRide{'clhandle'}`;
	    } else {
		$cmd_name = &findHacmpPath("clhandle");
		printf(STDERR "---- %s -ac ----\n", $cmd_name);
		$filecontent = join('', run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -ac"));
	    }
	    printf(STDERR "%s\n", $filecontent);
	}
       if (exists($overRide{'cllsnw'}))
       {
           printf(STDERR "---- %s ----\n", $overRide{'cllsnw'});
           $filecontent = `cat $overRide{'cllsnw'}`;
       }
       else
       {
           $cmd_name = &findHacmpPath("cllsnw");
           printf(STDERR "---- %s -Sc ----\n", $cmd_name);
           $filecontent = join('', run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -Sc"));
       }
       printf(STDERR "%s\n", $filecontent);

	# Make backup copies of $DFLT_LOG file.
	$srcfile = $DFLT_LOG . "." . $NUMBER_OF_LOGS;
	for ($i = $NUMBER_OF_LOGS - 1; $i >= 1; $i--) {
	    $dstfile = $srcfile;
	    $srcfile = $DFLT_LOG . "." . $i;
	    if (-f $srcfile) {
		`mv -f $srcfile $dstfile 2> /dev/null`;
	    }
	}
	$dstfile = $srcfile;
	$srcfile = $DFLT_LOG;
	`cp -f $srcfile $dstfile 2> /dev/null`;
    }
    $IN_SAVELOGS = 0;
}

#########################################################################
#									#
# Subroutine: call_ffdcinit						#
# Description: As of Nov. 1999, FFDC initialization is supported in	#
#	shell and C-shell scripts only. This subroutine calls fcinit	#
#	shell script and grabs the environment variables it creates.	#
# Note: This subroutine is called before my_exit() is ready for use.    #
#       Use exit() instead of my_exit() in this subroutine.             #
# Input: None								#
# Output: None								#
# Global:								#
#	FFDC environment variables are added to %ENV.			#
#									#
#########################################################################

sub call_ffdcinit {
    local ($ffdcenv, $key, $value);
    local ($i, $rc);

    if ( -x $FFDC_FCINIT) {
        @ffdcenv = run_cmd_in_locale("", "$FFDC_FCINIT -n$$ -p$SUBSYS");
        $rc = get_exit_code($?);
        SWITCH_FFDC_RC: {
            # 0: FFDC Environment created, 1: FFDC Environment inherited
            if (($rc == 0) || ($rc == 1)) {
                chomp(@ffdcenv);    # remove trailing "\n"
                foreach $i (@ffdcenv) {
                    ($key, $value) = split('=', $i);
                    $ENV{"$key"} = $value;
                }
                last SWITCH_FFDC_RC;
            }

            # 2: a help message was generated
            if ($rc == 2) {
                # Do not use ffdc_errlog() here because FFDC is not working.

                # The following message is produced by $FFDC_FCINIT in
                # the current locale. Print it out directly.
                print STDERR "@ffdcenv\n";
                #"\"$FFDC_FCINIT -n$$ -p$SUBSYS\" command exits with
                #exit code=$rc"
                print_message("EMSG871", "$SCRIPT",
                    "\"$FFDC_FCINIT -n$$ -p$SUBSYS\"", "$rc");
                exit(1);
                last SWITCH_FFDC_RC;
            }
            # All other exit codes indicate an error.

            # Do not use ffdc_errlog() here because FFDC is not working.

            #"Can not initialize FFDC environment, return code = $rc"
            print_message("EMSG601", "$SCRIPT", "$rc");
            exit(1);
        }   # end SWITCH_FFDC_RC
    }
}

#=======================================================================#
#                                                                       #
# Function: ffdc_errlog                                                 #
# Description: add an entry to the FFDC error log using fclogerr command#
#                                                                       #
#     fclogerr parameters are as the following:                         #
#         $template: template id in hats.err.E                          #
#         $lineno: line number where the error was found (use __LINE__ )#
#         $event_type   error log type                                  #
#             possible values: INFO, UNKN, PERM, TEMP, PEND, PERF       #
#         $types: types used for the detailed data.                     #
#             Example: "DEC,ALPHA"                                      #
#             Must match the template in hats.err.E                     #
#             "" indicates that no detailed data is present             #
#         $sizes: sizes for each item in the detailed data              #
#             Example: "4,96"                                           #
#             Must match the template in hats.err.E                     #
#         $data: detailed data: a string with "," separating each       #
#             item                                                      #
#             Example: "$rc,$filename"                                  #
#                                                                       #
# Input:                                                                #
#     $template: template id in hats.err.E. Passed to fclogerr directly.#
#         The $event_type of fclogerr can be determined by the last two #
#         characters of $template                                       #
#     $lineno: line number where the error was found (use __LINE__ )    #
#         Passed to fclogerr directly.                                  #
#     $types: types used for the detailed data. Passed to fclogerr      #
#         directly.                                                     #
#     $sizes: sizes for each item in the detailed data separated by ',' #
#         Passed to fclogerr directly.                                  #
#     @det_data: a list of detailed data. ',' in data will be replaced  #
#         with '.' to avoid confusing fclogerr.                         #
#                                                                       #
# Output: None                                                          #
# Return:                                                               #
#     The exit code of fclogerr command.                                #
#                                                                       #
#=======================================================================#

sub ffdc_errlog {
    my ($template, $lineno, $types, $sizes, @det_data) = @_;
    my ($event_type, $data);
    my ($exec_str, $detail_data_str);
    local ($types_first, $types_rest, $sizes_first, $sizes_rest);
    local ($rc, $i);

    # Use the last 2 characters of the template ID to find the event type.
    $event_type = $FFDC_EVENT_TYPE{substr($template, -2)};
    $detail_data_str = "";
    if ($types) {
        $types_rest = $types;
        $sizes_rest = $sizes;
        $i = 0;
        while ($types_rest) {
            ($types_first, $types_rest) = split(',', $types_rest);
            ($sizes_first, $sizes_rest) = split(',', $sizes_rest);
            # Truncate a string if its length exceeds the reserved space.
            if (($types_first eq "ALPHA") && 
                (length($det_data[$i]) > $sizes_first)) {
                $det_data[$i] = substr($det_data[$i], 0, $sizes_first);
            }
            $det_data[$i] =~ s/,/./g;
            $i++;
        }
        $data = join(',', @det_data);
        $detail_data_str = "-x $types -y $sizes -d \"$data\" -b \"$data\"";
    }
    $exec_str = "$FFDC_FCLOGERR " . $detail_data_str .
                " -p $lineno -s $SCRIPT -v $SCCSID_VERSION -l $LPP_NAME -r $SUBSYS" .
                " -t $template -e $event_type -i $FFDC_TEMPLATE_INCLUDE_FILE";
    run_cmd_in_locale("", "$exec_str");
    $rc = get_exit_code($?);
    return ($rc);
}

################################################################################
#                                                                              #
# Subroutine: add_to_TypeOrder                                                 #
#   This routine adds a type to a TypeOrder array if needed. There are         #
#   two modes of operation: (1) if pluggable modules is being supported by     #
#   HACMP then the type is added to one of the TypeOrder arrays if it is not   #
#   there already. In this mode this routine always returns 1, to indicate     #
#   the type is valid. (2) if pluggable modules is not supported then the      #
#   routine returns 0 unless the type already belongs to the TypeOrder         #
#   array.                                                                     #
#                                                                              #
# Arguments:                                                                   #
#   type: network type                                                         #
#   is_ip: 1 if the network is an IP network; 0 if non-IP                      #
# Returns:                                                                     #
#   1 if the type is valid; 0 otherwise                                        #
#                                                                              #
################################################################################
sub add_to_TypeOrder {
    my($type, $is_ip) = @_;
    my($is_valid) = 0;

    if(exists($TypeOrder{$type})) {
        $is_valid = 1;
    }
    else {
        if($PLUGGABLE_NIM_SUPPORT) {
            if($is_ip) {
                $TypeOrderNonStandardIP{$type} =
                    (scalar keys %TypeOrderNonStandardIP) + 1
                     unless exists ($TypeOrderNonStandardIP{$type});
            }
            else { # non-IP
                $TypeOrderNonStandardNonIP{$type} =
                    (scalar keys %TypeOrderNonStandardNonIP) + 1
                     unless exists ($TypeOrderNonStandardNonIP{$type});
            }
            $is_valid = 1;
        } # pluggable moduled supported
    } # not in TypeOrder

    return $is_valid;
}

################################################################################
#                                                                              #
# Subroutine: by_type_order                                                    #
#   Sorting routine for network types. Used to determine the order of the      #
#   networks in the machines.lst file.                                         #
#                                                                              #
#   The following order is enforced:                                           #
#       - "standard" IP types                                                  #
#       - "non-standard" (user-defined) IP types                               #
#       - "standard" non-IP types                                              #
#       - "non-standard" (user-defined) non-IP types                           #
#                                                                              #
# Arguments:                                                                   #
#   IP address in "." format                                                   #
# Returns:                                                                     #
#   Incremented IP address in "." format                                       #
#                                                                              #
################################################################################
sub by_type_order {
    my(@types);
    my($type);
    my(@rank);
    my($i);

    $types[0] = $a;
    $types[1] = $b;
    
    # compute ordering of each type
    # the numbers are made to enforce the desired type ordering
    foreach $i (0 ... 1) {
        $type = $types[$i];

        if(exists($TypeOrder{$type})) {
            $rank[$i] = $TypeOrder{$type};
        }
        else { # non-standard types
            if(exists ($TypeOrderNonStandardIP{$type})) {
                # higher than standard IP, but smaller than standard non-IP
                $rank[$i] = $TypeOrderNonStandardIP{$type} + 100;
            }
            else { # not a non-standard IP
                if(exists ($TypeOrderNonStandardNonIP{$type})) {
                    # higher than standard non-IP
                    $rank[$i] = $TypeOrderNonStandardNonIP{$type} + 10000;
                }
                else { # should not happen
                    $rank[$i] = 100000;
                }
            }

        } # non-standard types

    } # foreach

    return $rank[0] <=> $rank[1];
}


################################################################################
#                                                                              #
# Subroutine: bump_ip                                                          #
#   Given an IP address n "." format, increment the address by 1. This         #
#   subroutine is used to assign the next "fake IP address" to a non-IP        #
#   adapter.                                                                   #
#                                                                              #
# Arguments:                                                                   #
#   IP address in "." format                                                   #
# Returns:                                                                     #
#   Incremented IP address in "." format                                       #
#                                                                              #
################################################################################

sub bump_ip {
    my($ip) = @_;
    my(@octets);
    my($ip_num);
    my($ip_return);

    @octets = split(/\./, $ip);

    $ip_num = ($octets[0] << 24) +
              ($octets[1] << 16) +
              ($octets[2] << 8) +
               $octets[3];

    $ip_num++;

    $octets[3] = $ip_num & 0xff;
    $ip_num >>= 8;
    $octets[2] = $ip_num & 0xff;
    $ip_num >>= 8;
    $octets[1] = $ip_num & 0xff;
    $ip_num >>= 8;
    $octets[0] = $ip_num & 0xff;

    $ip_return = join(".", @octets);

    return $ip_return;
}

################################################################################
#                                                                              #
# Subroutine: get_new_base_fake_address                                        #
#   Get a new base IP address for a network type. Non-IP networks are assigned #
#   a range of "fake IP addresses", and this function is invoked to obtain     #
#   a range for a new non-IP network                                           #
#                                                                              #
#   $non_ip_3rd_octet is used as a "static" variable in this function.         #
#                                                                              #
# Arguments:                                                                   #
#   net_type - network type                                                    #
# Returns:                                                                     #
#   base IP address for a new non-IP network                                   #
#                                                                              #
#                                                                              #
################################################################################

sub get_new_base_fake_address {
    my ($net_type) = @_;

    if(!defined($last_net_type_for_base_fake_address)) {
        $last_net_type_for_base_fake_address = "<none>";
    }

    if(!defined($non_ip_3rd_octet)) {
        $non_ip_3rd_octet = $NON_IP_3RD_OCTET_BASE;
    }
    else {
        # "diskhbmulti network type has a bigger range of addresses
        if($last_net_type_for_base_fake_address eq "diskhbmulti") {
            $non_ip_3rd_octet += $NON_IP_3RD_OCTET_INCR_DHBMULTI;
        }
        else {
            $non_ip_3rd_octet += $NON_IP_3RD_OCTET_INCR;
        }
    }

    $last_net_type_for_base_fake_address = $net_type;

    return "255.255.$non_ip_3rd_octet.0";
}


#########################################################################
#									#
# Subroutine: get_next_fake_address                                     #
# Description: Get the next "fake IP address" for a network of type	#
#	net_type. Function get_new_base_fake_address() is invoked to	#
#	retrieve the fake address the first time an address is needed   #
#       for a given type.                                               #
# Input: network type                                                   #
# Output: None								#
# Returns:			           				#
#	the next fake IP address to be used for this given network      #
#       type                                                            #
#									#
#########################################################################

## XXX no checking for addresses bumping into next range!!

sub get_next_fake_address {
    my ($net_type) = @_;
    my ($addr);

    if(!exists($fake_addr_by_net_type{$net_type})) {
        $fake_addr_by_net_type{$net_type} = get_new_base_fake_address(
                                                                  $net_type);
    }

    $addr =  $fake_addr_by_net_type{$net_type};
    $fake_addr_by_net_type{$net_type} =
                             bump_ip($fake_addr_by_net_type{$net_type});

    return $addr;
}


################################################################################
#                                                                              #
# Subroutine: dev_driver_to_device_name                                        #
#   Given a list of device drivers (or power-on select numbers), this function #
#   will traverse the output of "odmget CuDv" and return a list of [device     #
#   names-device driver pairs whose entries in CuDv match the the device       #
#   driver name.                                                               #
#                                                                              #
# Arguments:                                                                   #
#   @dev_driver_or_sel_nums: list of device driver names or power-on           #
#                            select numbers                                    #
#                                                                              #
# Returns:                                                                     #
#   List of [device name, device driver] pairs whose device driver or          #
#        power-on select number  matches those specified as parameters         #
#                                                                              #
# The following is an example of the output of "odmget CuDv"                   #
#                                                                              #
#  CuDv:                                                                       #
#       name = "ent0"        <= device name                                    #
#       status = 1                                                             #
#       chgstatus = 2                                                          #
#       ddins = "pci/kentdd" <= device driver                                  #
#       location = "10-80"                                                     #
#       connwhere = "128"                                                      #
#       PdDvLn = "adapter/pci/22100020"                                        #
#                             ^^^^^^^^ power-on select number                  #
#                                                                              #
#                                                                              #
#                                                                              #
################################################################################

sub dev_driver_to_device_name {
    my(@dev_driver_or_sel_nums) = @_;
    my($file);
    my($line);
    my($attr,$eqsign,$value);
    my($header);
    my(@device_names) = ();
    my($name);
    my($diemsg);
    my($dd);
    my($f1, $f2);

    $file="$HB_RUNDIR/CuDv.out";
    if (exists($overRide{'CuDv'})) {
        `cat $overRide{'CuDv'} > $file`;
    } else {
        # run_cmd_in_locale("en_US", "$ODMDIR odmget CuDv  > $file");
        # setting ODMDIR does not work and is not needed here
        run_cmd_in_locale("en_US", "odmget CuDv  > $file");
    }
    if ( $? != 0 ) {
        print_message("EMSG656", $SCRIPT, "CuDv");
        return @device_names;
    }
    $diemsg = get_cat_msg("", "EMSG663", $SCRIPT, $file);
    open(FPT,$file) || die $diemsg;
    $header="=";
    while ($line = <FPT>) {
        ($attr,$eqsign,$value)=split(' ',$line,3);
        next if $attr eq "CuDv:" ||  $attr eq '';

        if ( $attr eq "name") {
            # remove trailing \n
            chomp($value);

            # remove starting and trailing  '"'
            $value =~ s/^"//;
            $value =~ s/"$//;

            # store device name in case it's needed
            # Assumes that 'name' will always come first
            $name = $value;
            next;
        }

        if ( $attr eq "ddins") {
            # remove trailing \n
            chomp($value);

            # remove starting and trailing  '"'
            $value =~ s/^"//;
            $value =~ s/"$//;

            foreach $dd (@dev_driver_or_sel_nums) {
                if($dd eq $value) {
                    # print "FOUND $dd!!\n";
                    push @device_names, "$name;$dd";
                }
            } # foreach @dev_driver_or_sel_nums
            next;
        }

       if ( $attr eq "PdDvLn") {
            # remove trailing \n
            chomp($value);

            # remove starting and trailing  '"'
            $value =~ s/^"//;
            $value =~ s/"$//;

            # what we should have in $value is something like
            # adapter/pci/22100020. We need to get the numeric field
            ($f1, $f2, $value) = split('/',$value,3);

            # print "ATTR = [$value]\n";
            if(defined($value)) {
                foreach $dd (@dev_driver_or_sel_nums) {
                    if($dd eq $value) {
                        # print "FOUND $dd!!\n";
                        push @device_names, "$name;$dd";
                    }
                } # foreach @dev_driver_or_sel_nums
            } # defined $value
            next;
        } # PdDvLn

## eliminate repeated entries!!! ??

    } # while FPT

    return @device_names;
}


################################################################################
#                                                                              #
# Subroutine: device_name_to_interface_name                                    #
#   Given a local device name, this function returns the corresponding         #
#   local interface name. The conversion is done by the hatsdevtoint           #
#   utility, which retrieves NDD information from the kernel.                  #
#                                                                              #
# Arguments:                                                                   #
#   $device_name: adapter device name                                          #
#                                                                              #
# Returns:                                                                     #
#   Corresponding interface name or "" if some error occurred                  #
#   The input device name is returned if no interface name could be found      #
#   for the given device name                                                  #
#                                                                              #
#                                                                              #
################################################################################

sub device_name_to_interface_name {
    my($device_name) = @_;
    my($interface_name);
    my($rc);

# print "Executing $DEV_TO_INT_CMD $device_name\n";

    $interface_name = `$DEV_TO_INT_CMD $device_name`;
    $rc = get_exit_code($?);
    if ($rc != 0) {
        # XXX an error msg here???
        print "device_name_to_interface_name($device_name): error $rc\n";
        return "";
    }
    else {
        chomp($interface_name);
        return $interface_name;
    }
}


################################################################################
#                                                                              #
# Subroutine: generate_local_adapter_info                                      #
#   Add to the machines.lst information about the local adapters, based        #
#   on the adapter-card NIMs. If an adapter-card NIM is specified by           #
#   device driver then this function will "list" all the local interfaces      #
#   whose corresponding devices use the given device driver. The same goes     #
#   for adapter-card NIMs specified by power-on select number.                 #
#                                                                              #
#   Information about each adapter-card NIM is also added to the machines.lst. #
#                                                                              #
# The following procedure is used:                                             #
#     - find all the adapter-card NIMs present in the HACMPnim objects         #
#       Also print into the machines.lst file information about the            #
#       adapter-card NIMs.                                                     #
#     - locate all the local adapters that correspond to those adapter cards   #
#     - print into the machines.lst file one line for each such local adapter  #
#                                                                              #
#                                                                              #
# Arguments:                                                                   #
#   none                                                                       #
#                                                                              #
# Returns:                                                                     #
#   nothing                                                                    #
#                                                                              #
################################################################################

sub generate_local_adapter_info {
    my($dn, $dd);
    my($in);
    my($dev_pair);
    my(@dev_pairs);
    my(@adapter_card_nim_names);
    my($line);
    my($v);
    my($name,$desc,$addrtype,$path,$para,$grace,$hbrate,$cycle,$custom_hbrate);
    my($gratarp,$entry_type);
    my(@dummy);
    local ($rc);

    # obtain list of adapter_card_nim_names
    # -------------------------------------
    seek (FPNIM,0,0);    # rewind the FPNIM file, which contains the
                         # result of `cllsnim -c`
    while ($line = <FPNIM>) {
        ($name,$desc,$addrtype,$path,$para,$grace,$hbrate,$cycle,
         $custom_hbrate,$gratarp,$entry_type,@dummy)=split(':',$line);

        next if ( ($name eq "#name") ||  ($name eq '') );

        if ($entry_type eq "adapter_card") {
            # found an adapter_card NIM: add it to list of adapter-card
            # NIM names
            push(@adapter_card_nim_names, $name);

            # also create entries in machines.lst to describe the
            # adapter-card NIM
            print FP "*!NIM_adapter_name=$name\n";
            print FP "*!NIM_adapter_pathname=$path\n";
            print FP "*!NIM_adapter_parameters=$para\n";

            # print NIM path and version information
            # version information is printed when -v option is used
            print STDERR "NIM: $name  path: $path\n";
            if (-x $path) {
                $v = `$path -v`;
                print STDERR "    $v";
            }
        }
    } # while FPNIM


    # find the local adapters using the given device drivers
    # ------------------------------------------------------

    # only go through this if there is at least one adapter-card NIM
    if(scalar @adapter_card_nim_names) {
        @dev_pairs = dev_driver_to_device_name(@adapter_card_nim_names);

        foreach $dev_pair (@dev_pairs) {
            ($dn, $dd) = split(";", $dev_pair, 2);
            $in = device_name_to_interface_name($dn);

# print "Interface for $dn is $in\n";

            print FP "*!Local_adapter $in $dd\n";
        } # foreach @dev_pairs
    }

}



################################################################################
#                                                                              #
# Subroutine: isThereSpaceInFS                                                 #
#    Determines whether there is enough space in a given filesystem, by        #
#    running the "df" command.                                                 #
#                                                                              #
# Arguments:                                                                   #
#   $fs - path to filesystem (directory)                                       #
#                                                                              #
# Returns:                                                                     #
#   1 if there is enough space (or if there is a problem running "df")         #
#   0 otherwise                                                                #
#                                                                              #
################################################################################

sub isThereSpaceInFS {
    my ($fs) = @_;
    my (@output);
    my ($retval);
    my ($cmd);
    my ($fsname, $numblks, $used, $avail, $rest);
    my ($ret) = 0;
    my ($NO_SPACE_THRESHOLD) = 300;   # in Kbytes
 
    # typical output is
    # Filesystem    1024-blocks      Used Available Capacity Mounted on
    # /dev/hd3            65536     11964     53572      19% /tmp
 
    $cmd = "df -kP $fs";
    @output = run_cmd_in_locale("en_US", $cmd);
    $retval = get_exit_code($?);

    if($retval == 0) {
 
        # header should be $output[0]; data should be $output[1]
 
        if(defined($output[0]) && defined($output[1])) {
            # df has good output
 
            ($fsname, $numblks, $used, $avail, $rest) = split(" ", $output[1]);
 
            if($avail < $NO_SPACE_THRESHOLD) {
                print_message("EMSG657", $SCRIPT, $fs, "$avail");
                ffdc_errlog("ERRID_TS_NO_DISK_SPACE_ER", __LINE__, "ALPHA,DEC",
                           "96,4", $fs, $avail);
                # printf("Space in $fs is: $avail 1kbyte blocks\n");
                $ret = 0;
            }
            else {
                # enough space
                $ret = 1;
            }
 
        } # df has good output
        else {
            # df had bad output. Try to proceed as if there is enough space
            print_message("EMSG658", $SCRIPT, $cmd, $output[0]);
            $ret = 1;
        }
    } # command succeeded
    else {
        # somehow could not execute df. Try to proceed as if there is
        # enough space
        # The strange chars around $cmd are to allow print_message() to
        # handle the spaces inside $cmd to be handled correctly.
        print_message("EMSG871", $SCRIPT, "\"$cmd\"", "$retval");
        $ret = 1;
    }
 
    return $ret;
}



##########################################################################
                    #####    MAIN PROGRAM     #########
##########################################################################

### global variables 

$|=1; # force a flush after every print (defect 52128)
$Total=0;
$login='';
$SUBSYS='';

$LPP_NAME = "rsct";
$SCCSID_VERSION = "1.94";
$RSCT_ROOT = "/usr/sbin/rsct";
$RSCT_BIN = "$RSCT_ROOT/bin";
$RSCT_INC = "$RSCT_ROOT/include";
$RSCT_MSGMAP = "$RSCT_ROOT/msgmaps";
# fcistm initializes FFDC environment. fcinit.*sh call fcistm to do the job.
$FFDC_FCINIT = "$RSCT_BIN/fcistm";
$FFDC_FCLOGERR = "$RSCT_BIN/fclogerr";
$FFDC_TEMPLATE_INCLUDE_FILE = "$RSCT_INC/hats.err.S.h";
$ffdc_string_size = 100;        # FFDC detailed data string size
# Mapping from the last two characters of FFDC template IDs to FFDC event types.
%FFDC_EVENT_TYPE = (
    "EM" => "FFDC_EMERG",
    "ER" => "FFDC_ERROR",
    "ST" => "FFDC_STATE",
    "PE" => "FFDC_PERF",
    "TR" => "FFDC_TRACE",
    "RE" => "FFDC_RECOV",
    "DE" => "FFDC_DEBUG"
);

# This will be set to 1 if topsvcs is called to execute a migration-refresh
$MIGRATION_REFRESH = 0;

# $VERIFY will be set to 1 if topsvcs is called with option "-v" to verify
# configuration. A typical user of this option is HACMP utility "clverify."
# When called with "-v," topsvcs will perform verification on configuration
# only. The topsvcs daemon will not be exec'd. If a configuration error
# is found, topsvcs script exits with return code of -1. Otherwise, the
# return code is 0. The return code for verification is stored in
# $VERIFY_RC.  Currently, the following is being verified:
# - The number of offsets is not larger than HB_MAX_ADAPTERS_PER_NODE
#   (defined in rsct/pts/pam/lib/hb_client.h as 48).
# - 30 <= grace <= 360
# - 1 <= custom_hbrate <= 10
# - 4 <= cycle <= 75
# - para contains 9600, 19200, 38400 for rs232 networks
$VERIFY = 0;
$VERIFY_RC = 0;

# $VERIFY_DATA_ENTRY will be set to 1 if topsvcs is called with option "-V"
# to verify tunables (etc) at the time they are being specified to
# HACMP.
# If the parameters fail the checking, the script exits with non-zero exit
# code. otherwise 0 is returned.
$VERIFY_DATA_ENTRY = 0;


#
# Constants used for Multi-node Disk HB networks
#

#indicates whether -dhb_slot option was used -- initially assume it was not
$OPTION_DHB_SLOT_INVOKED = 0;

# Maximum number of nodes supported
$MAX_NUMBER_OF_NODES = 32;

# Number of Slot ranges
$MULTINODE_DHB_NUMRANGES = 4;

# Number of slots needed: N * (N - 1) /2
$MULTINODE_DHB_SLOTS_PER_RANGE =
         ($MAX_NUMBER_OF_NODES * $MAX_NUMBER_OF_NODES -
          $MAX_NUMBER_OF_NODES) / 2;



$DFLT_SCRIPT="topsvcs";
$DFLT_DAEMON="hatsd";
####### [ Setting the environment variables ] ####
$login=getlogin;
$login="${login}odi";

# output of basename is used "as is". No NLS
$SUBSYS=`eval "basename $0" `;
chop($SUBSYS);
$SCRIPT=$SUBSYS;
$SUBSYSNAME=$SUBSYS;

$OSname = `/bin/uname -s`;
chomp($OSname);

if ("AIX" eq $OSname) {
    $ENV{'PATH'}="/usr/bin:/usr/sbin:/usr/lpp/ssp/bin:/usr/sbin/rsct/bin";
} elsif ("Linux" eq $OSname) {
    $ENV{'PATH'}="/usr/bin:/usr/sbin:/usr/sbin/rsct/bin:/bin:/sbin";
} else {
    print_message("EMSG678", $SCRIPT, $OSname, $OSname);
    exit 1;
}

# Defect 105890 - Need to know when we've reached saveLogs() 
$IN_SAVELOGS = 0;

# Determine the daemon name from script name.
# If the script name is XXtopsvcs, then the daemon name is XXhatsd. e.g if
# the script name is "ltopsvcs", then the daemon to be used is "lhatsd".
# If the script name in not XXtopsvcs, then we don't play this trick and
# use the default daemon name "hatsd". This is used for developer's testing.
# In real world, Topology Services is started by HACMP and the name is
# "topsvcs" all the time.
# 
if ((rindex($SCRIPT, $DFLT_SCRIPT) != -1) &&
    (rindex($SCRIPT, $DFLT_SCRIPT) + length($DFLT_SCRIPT) eq length($SCRIPT))) {
    $DAEMON=substr($SCRIPT, 0, -length($DFLT_SCRIPT)) . $DFLT_DAEMON;
} else {
    $DAEMON=$DFLT_DAEMON;
}

$HacmpPath="/usr/sbin/cluster";
$HacmpUtilPath="/usr/sbin/cluster/utilities";
$HacmpESPath="/usr/es/sbin/cluster";
$HacmpESUtilPath="/usr/es/sbin/cluster/utilities";
$ODMDIR="ODMDIR=/etc/es/objrepos ";  # prefix to 'cl' commands: use the
                                     # /etc/es/objrepos version of ODM

#"substr($DAEMON, 0, -1)" removes the "d" of the daemon name.
$CATFILE = substr($DAEMON, 0, -1) . ".cat";
$MSGSET = "script";
$ENV{MSGMAPPATH} = $RSCT_MSGMAP;
$MSGCMD = "$RSCT_BIN/hadspmsg $MSGSET ${CATFILE}";

$ENV{'HB_LOGDIR'}="/var/ha/log";
$ENV{'HB_RUNDIR'}="/var/ha/run";

# Keep 5 sets of the most recent daemon user/service log files.
$num_logs_to_keep = 5;
# The stdout of this Perl script is redirected to a log file. Keep 7 most
# recent copies of this log file.
$NUMBER_OF_LOGS = 7;

# constants used to generate "fake IP addresses" for non-IP interfaces
# Note that changing the numbers below will have coexistence considerations,
# since the machines.lst file is generated at each node, and the addresses
# must match.
# Multi-node DHB networks may potentially use lots of addresses, so
# this type of network will get a bigger chunk of addresses.
$NON_IP_3RD_OCTET_BASE = 10;
$NON_IP_3RD_OCTET_INCR_DHBMULTI = 16;
$NON_IP_3RD_OCTET_INCR = 2;  # one unit represents 256 addresses

# name of the program that converts adapter device names into adapter
# interface names
$DEV_TO_INT_CMD = "hatsdevtoint";


###################################################

# AIX lft terminal mode is used for command line mode when AIX boots up.
# AIX lft terminal doesn't have the ability to display non-ASCII characters.
# Messages printed at boot time are not displayed correctly in a non-ASCII
# system locale. AIX 5.1 sets LC_MESSAGES to C@lft at boot time to force
# messages to be displayed in C locale. The Topology Services start-up
# script and daemon print their messages to log files. No message is
# printed to the screen. Unset LC_MESSAGES to print messages in the
# correct locale if LC_MESSAGES is C@lft.
if (exists($ENV{LC_MESSAGES}) && ($ENV{LC_MESSAGES} eq "C\@lft")) {
    delete($ENV{LC_MESSAGES});
}

$PRINT_ENG_MSG = (is_english_locale()) ? 0 : 1;

$REFRESH=0;
$DMS_enabled_flag = 0;
$nobuild=0;
$i=0;
$DaemonDir="/usr/sbin/rsct/bin";

# Comment out line below to disable "> 16 HB ring" capability
# $ENV{'HB_DISABLE_MORE_THAN_16_HBRINGS'} = "true";

if(defined $ENV{'HB_DISABLE_MORE_THAN_16_HBRINGS'} ) {
    $HB_MAX_ADAPTERS_PER_NODE=16;   # not the default
}
else {
    $HB_MAX_ADAPTERS_PER_NODE=48;
}

# Defect 143177: The length of a device name is increased to handle the
# uniqued features of the device name used for MNDHB (which not only has
# the device path, but includes local and remote node numbers plus the
# slot offset).  To prevent catastropic failure should the size increase
# further, we want to do some checks.  A maximum must be defined here.
# This value should match the value in bootstrp.h
$HB_MAX_DEV_NAME_LEN=40;

$num_offsets = 0;
$MIN_CUSTOM_HBRATE=1;
$MIN_CUSTOM_HBRATE_FAST_IP_US=200000;
$MIN_CUSTOM_HBRATE_FAST_RS232_US=750000;
$MIN_CUSTOM_HBRATE_FAST_DISKHB_US=750000;
$MAX_CUSTOM_HBRATE=10;
$MIN_CYCLE=3;
$MAX_CYCLE=75;
$MIN_GRACE=30;
$MAX_GRACE=360;

# Starting with HACMP 5.2, hbrate (cllsnim) will be produced in microseconds.
# In case the unit is interpreted incorrectly, the following threshold is
# used to help decide what unit is being used
$USEC_SEC_VALUE_THRESHOLD = 10000;
$SECS_TO_USECS = 1000000;

# $source_routing will be set to 1 if src_routing of any adapter is 1.
$source_routing = 0;

# Initialize FFDC environment variables.
call_ffdcinit();

for ($i=0; $i<=$#ARGV; $i++) {
    if ( $ARGV[$i] eq '-noExec' ) {
        $overRide{'noExec'}=1;
        next;
    }
    if ( $ARGV[$i] eq '-debug' ) {
        if ( $ARGV[$i+1] eq 'Show' ) {
            #print "-debug All         Turn on all debug flags\n";
            #print "-debug IntName     Turn on Interface Name debug output\n";
            #print "-debug NetType     Turn on Network Type debug output\n";
            #print "-debug NetName     Turn on Network Name debug output\n";
            #print "-debug Mytable     Turn on Mytable debug output\n";
            #print "-debug IPaddrs     Turn on IP addresses debug output\n";
            #print "-debug NodeList    Turn on Node List debug output\n";
            #print "-debug NodeNumber  Turn on Node Number debug output\n";
            #print "-debug ConfigTable Turn on Configuration Table debug output\n";
            #print "-debug Daisy       Turn on DaisyTable debug output\n";
	    print_message("I_TopsvcsDebug");
            exit 0;
        }
        $debug{$ARGV[$i+=1]}=1;
        next;
    }
    if ( $ARGV[$i] eq '-daemonDir' ) {
        $overRide{'daemonDir'}=$ARGV[$i+=1];
        next;
    }
    if ( $ARGV[$i] eq 'refresh' ) {
        $REFRESH=1;
        next;
    }
    if ( $ARGV[$i] eq 'migration_refresh' ) {
        $REFRESH=1;
        $MIGRATION_REFRESH = 1;
        next;
    }
    if ( $ARGV[$i] eq '-noBuild' ) {
        $overRide{'noBuild'}=1;
        next;
    }
    if ( $ARGV[$i] eq '-DMS_enable' ) {
        $DMS_enabled_flag = 1;
        next;
    }
    if ( $ARGV[$i] eq '-nodeNumber' ) {
        $overRide{'nodeNumber'}=$ARGV[$i+=1];
        next;
    }
    if ( $ARGV[$i] eq '-machList' ) {
        $overRide{'machList'} = $ARGV[$i+=1];
        next;
    }
    if ( $ARGV[$i] eq '-HACMPtopsvcs' ) {
	$overRide{'HACMPtopsvcs'}=$ARGV[$i+=1];
	next;
    }
    if ( $ARGV[$i] eq '-cllsnim' ) {
	$overRide{'cllsnim'}=$ARGV[$i+=1];
	next;
    }
    if ( $ARGV[$i] eq '-clmixver' ) {
	$overRide{'clmixver'}=$ARGV[$i+=1];
	next;
    }
    if ( $ARGV[$i] eq '-clhandle' ) {
	$overRide{'clhandle'}=$ARGV[$i+=1];
	next;
    }
    if ( $ARGV[$i] eq '-cllsifList' ) {
        $overRide{'cllsifList'}=$ARGV[$i+=1];
        next;
    }
    if ( $ARGV[$i] eq '-cluster' ) {
        if ( $ARGV[$i+1] =~ /[0-9]+:.*/ ) {
            $overRide{'cluster'} = $ARGV[$i+=1];
        } else {
            ffdc_errlog("ERRID_TS_SYNTAX_ER", __LINE__, "ALPHA", "100",
                "-cluster $ARGV[$i+1]");
            #print "Cluster designator not valid $ARGV[$i+1]\n";
	    print_message("EMSG651", $SCRIPT, $ARGV[$i+1]);
            exit 1;
        }
        next;
    }
    if ( $ARGV[$i] eq '-cllsnw' ) {
        $overRide{'cllsnw'}=$ARGV[$i+=1];
        next;
    }
    if ( $ARGV[$i] eq '-v' ) {
        $VERIFY=1;
        next;
    }
    if ( $ARGV[$i] eq '-V' ) {
        $VERIFY_DATA_ENTRY=1;
        next;
    }
    if ( $ARGV[$i] eq '-hb_tunables' ) {
        if($VERIFY_DATA_ENTRY) {
            $verify_entry_type = "hb_tunables";
            $verify_entry_custom_rate = $ARGV[$i+=1];
            $verify_entry_cycle       = $ARGV[$i+=1];
            $verify_entry_nim_name    = $ARGV[$i+=1];
            next;
        }
        else { # "-hb_tunables" without "-V" is not allowed
            $ARGV[$i] = "-?";
            # fall through
        }

    }

    if ( $ARGV[$i] eq '-dhb_slot' ) {
        $OPTION_DHB_SLOT_INVOKED = 1;
        if(exists($ARGV[$i + 2])) {
            $dhb_slot_node1 = $ARGV[$i+=1];
            $dhb_slot_node2 = $ARGV[$i+=1];
            next;
        }
        else{ # "-dhb_slot requires 2 nodes as additional parameters
            $ARGV[$i] = "-?";
            # fall through
        }
    }


    if ( $ARGV[$i] eq "-?" ) {
        ffdc_errlog("ERRID_TS_SYNTAX_ER", __LINE__, "ALPHA", "100",
            "$ARGV[$i]");
        #print "topsvcs\t[-machList <file>]\n";
        #print "\t[-cluster <clusterDesignator>]\n";
        #print "\t[-nodeNumber <number>]\n";
        #print "\t[-noBuild]\n";
        #print "\t[-noExec]\n";
	#print "\t[-HACMPtopsvcs <file>]\n"; 
	#print "\t[-clhandle <file>]\n"; 
	#print "\t[-clmixver HACMP version + 1000 (mixed versions) or HACMP version (nodes at same level)]\n";
        #print "\t[-cllsifList <file>]\n";
        #print "\t[-daemonDir <directory>]\n";
        #print "\t[-debug All|IntName|NetType|NetName|Mytable|IPaddrs|NodeList|ConfigTable|Daisy|MachList]\n";
        #print "\t[refresh]\n";
        #print "\t<IPaddress>\n";
	print_message("I_TopsvcsUsage", $SCRIPT);
        exit 1;
    }
    if ( $ARGV[$i] =~ /[0-9]*\.[0-9]*\.[0-9]*\.[0-9]*/ ) {
        $ENV{'SP_NAME'}="$ARGV[$i]";
        print STDERR "SP_NAME=$ENV{'SP_NAME'}\n";
    } else {
        ffdc_errlog("ERRID_TS_SYNTAX_ER", __LINE__, "ALPHA", "100",
            "$ARGV[$i]");
        #print "Unknown parameter $ARGV[$i]\n";
	print_message("EMSG650", $SCRIPT, $ARGV[$i]);
        exit 1;
    }
}

if ( exists $debug{"All"} ) {
    $debug{IntName}=1;
    $debug{NetType}=1;
    $debug{NetName}=1;
    $debug{Mytable}=1;
    $debug{IPaddrs}=1;
    $debug{NodeList}=1;
    $debug{NodeNumber}=1;
    $debug{ConfigTable}=1;
    $debug{Daisy}=1;
    $debug{MachList}=1;
    $debug{Alias}=1;
    $debug{DHBMulti}=1;
}

# See if topsvcs was invoked only to print the slot offset corresponding
# to a given pair of nodes
if($OPTION_DHB_SLOT_INVOKED) {
    $rc = 0;
    if(defined($dhb_slot_node1) && defined($dhb_slot_node2)) {

        $slot_off = GetSlotOffsetForMultiNodeNonIPNetwork($dhb_slot_node1,
                                                          $dhb_slot_node2);

        print "$slot_off\n";

    }
    else {
        $rc = 1;
    }

    exit $rc;
}



# The verification of tunables may occur even if the cluster has not been
# created yet. We cannot count on the log, run directories to be already
# present, so we run the verification very early in this script
if($VERIFY_DATA_ENTRY) {

    $rc = 0;
    switch_data_entry: { 

       if($verify_entry_type eq "hb_tunables") {
           verify_options($verify_entry_nim_name,
                          $verify_entry_custom_rate,
                          $verify_entry_cycle,
                          "", # no parameter checking for now
                          $MIN_GRACE
                              # no grace period being checked for now
                          );

           $rc = ($VERIFY_RC)? 1: 0;
           last switch_data_entry;
       }

       # add new checking "types" here. For example: (not implemented yet)
       # if($verify_entry_type eq "hb_tunables_grace period") {
       #  ...
       #  last switch_data_entry;
       #
       # if($verify_entry_type eq "hb_valid_nim_type")

    } # switch_data_entry

    exit $rc;
}


$HB_LOGDIR="/var/ha/log";
if ( ! -d $HB_LOGDIR ) {
    eval `mkdir -p $HB_LOGDIR`;
    if ($? != 0) {
        ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100", $HB_LOGDIR);
        #print " $PROGNAME: cannot create directory $HB_LOGDIR .\n";
	print_message("EMSG603", $SCRIPT, $HB_LOGDIR);
        exit 3;
    }
    eval `chmod 0750 ${HB_LOGDIR}`;
}

# Name of the default log. The standard output of this script is being
# redirected to file $DFLT_LOG. This file name must be kept in sync
# with topsvcsctrl.
# From this point on, use "my_exit" instead of "exit" to allow for the
# logs to be saved.
$DFLT_LOG=$HB_LOGDIR . '/' . $SUBSYS . ".default";

if ($VERIFY == 1) {
    # For verification, the script is invoked outside src
    # control. Need to associate STDERR with $DFLT_LOG explicitly.
    $diemsg = get_cat_msg("", "EMSG663", $SCRIPT, $DFLT_LOG);
    open(STDERR, ">$DFLT_LOG")  || die $diemsg;
    # When we are verifying, the ODMDIR must NOT be set because when
    # restoring a snapshot, topsvcs will be invoked with the
    # verification option while the ODM is not in its usual place.
    # We leave it set at all other times because it will not make a
    # difference in most cases and is required in some (NxN migration).
    # Defect 76820
    $ODMDIR="";
}

if ($VERIFY == 1) {
    print_message("I_DoVerification");
}
print_message("I_HatsStartup", $SCRIPT);
print STDERR "@ARGV\n";

if (exists($overRide{'noExec'})) {
    print STDERR "overRide noExec=$overRide{'noExec'}\n";
}
if (exists($overRide{'daemonDir'})) {
    print STDERR "overRide daemonDir=$overRide{'daemonDir'}\n";
}
if (exists($overRide{'noBuild'})) {
    print STDERR "overRide noBuild=$overRide{'noBuild'}\n";
}
if (exists($overRide{'nodeNumber'})) {
    print STDERR "overRide nodeNumber=$overRide{'nodeNumber'}\n";
}
if (exists($overRide{'machList'})) {
    print STDERR "overRide machList=$overRide{'machList'}\n";
}
if (exists($overRide{'HACMPtopsvcs'})) {
    print STDERR "overRide HACMPtopsvcs=$overRide{'HACMPtopsvcs'}\n";
}
if (exists($overRide{'cllsnim'})) {
    print STDERR "overRide cllsnim=$overRide{'cllsnim'}\n";
}
if (exists($overRide{'clmixver'})) {
    print STDERR "overRide clmixver=$overRide{'clmixver'}\n";
}
if (exists($overRide{'clhandle'})) {
    print STDERR "overRide clhandle=$overRide{'clhandle'}\n";
}
if (exists($overRide{'cllsifList'})) {
    print STDERR "overRide cllsifList=$overRide{'cllsifList'}\n";
}
if (exists($overRide{'cllsnw'})) {
    print STDERR "overRide cllsnw=$overRide{'cllsnw'}\n";
}
if (exists($overRide{'cluster'})) {
    print STDERR "overRide cluster=$overRide{'cluster'}\n";
}

########  $cluster = cluster id  ##########################  
if (exists($overRide{'cluster'})) {
    $cluster = $overRide{'cluster'};
} else {
    $cmd_name = &findHacmpPath("cllsclstr");
    $cluster = join("", run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -Sc"));
    $rc = get_exit_code($?);
    if ( $rc != 0 ) {
        ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC", "96,4",
            "$ODMDIR $cmd_name -Sc", $rc);
        #printf("Unable to execute cllsclstr\n");
	print_message("EMSG660", $SCRIPT, "cllsclstr");
        exit -1;
    } else {
        chop($cluster);
    }
}

($clusterId, $clusterName) = split(':',$cluster);

# HACMP releases
# NOTE: Code has to be added here in new releases of HACMP.
$hacmp_version422 = 0;
$hacmp_version430 = 0;
$hacmp_version431 = 0;
$hacmp_version440 = 0;
$hacmp_version441 = 0;
$hacmp_version450 = 0;
$hacmp_version510 = 0;
$hacmp_version520 = 0;
$hacmp_version530 = 0;
$hacmp_version540 = 0;

# The standard output of "clmixver" is the version of the cluster
# ('0' for 4.2.2, '1' for 4.3.0, '2' for 4.3.1, '3' for 4.4.0,
# '4' for 4.4.1, '5' for 4.5.0, '6' for 5.1.0, '7' for 5.2.0,
# '8' for 5.3.0)
# Check src/43haes/inc/cluster/cluster.h for version information.
if (exists($overRide{'clmixver'})) {
    # "clmixver" command actually provides two pieces of information.
    # The return code shows if the cluster is in migration. The number
    # printed out to stdout shows the version of HACMP. We encode the
    # override of clmixver as:
    #     HACMP version +    0 : if not in migration
    #     HACMP version + 1000 : if in migration
    $hacmp_ver = $overRide{'clmixver'};
    if ($hacmp_ver < 1000) {
	$migrSupport = 0;
    } else {
	$migrSupport = 1;
	$hacmp_ver -= 1000;
    }
} else {
    # The exit code will be 1 if HACMP is under migration and 0 otherwise.
    $cmd_name = &findHacmpPath("clmixver");
    # Output of the following external command is a number. No NLS.
    $hacmp_ver = `$ODMDIR $cmd_name`;
    chop $hacmp_ver;
    $migrSupport = $?;
}

if ( $migrSupport ) {
    #print "Configuration still in migration\n";
    print_message("I_TopsvcsInMigration");
} else {
    #print "Configuration no longer in migration\n";
    print_message("I_TopsvcsNotInMigration");
}

HACMP_VER_SWICH: {
    if($hacmp_ver == 0) {
        $hacmp_version422 = 1;
        #print "HACMP version 4.2.2 .\n";
	print_message("I_TopsvcsHACMPVersion", "4.2.2");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 1) {
        $hacmp_version430 = 1;
        #print "HACMP version 4.3.0 .\n";
	print_message("I_TopsvcsHACMPVersion", "4.3.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 2) {
        $hacmp_version431 = 1;
        #print "HACMP version 4.3.1 .\n";
	print_message("I_TopsvcsHACMPVersion", "4.3.1");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 3) {
        $hacmp_version440 = 1;
        #print "HACMP version 4.4.0 .\n";
	print_message("I_TopsvcsHACMPVersion", "4.4.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 4) {
        $hacmp_version441 = 1;
        #print "HACMP version 4.4.1 .\n";
        print_message("I_TopsvcsHACMPVersion", "4.4.1");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 5) {
        $hacmp_version450 = 1;
        #print "HACMP version 4.5.0 .\n";
        print_message("I_TopsvcsHACMPVersion", "4.5.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 6) {
        $hacmp_version510 = 1;
        #print "HACMP version 5.1.0 .\n";
        print_message("I_TopsvcsHACMPVersion", "5.1.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 7) {
        $hacmp_version520 = 1;
        #print "HACMP version 5.2.0 .\n";
        print_message("I_TopsvcsHACMPVersion", "5.2.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 8) {
        $hacmp_version530 = 1;
        #print "HACMP version 5.3.0 .\n";
        print_message("I_TopsvcsHACMPVersion", "5.3.0");
        last HACMP_VER_SWICH;
    }
    if($hacmp_ver == 9) {
        $hacmp_version540 = 1;
        #print "HACMP version 5.4.0 .\n";
        print_message("I_TopsvcsHACMPVersion", "5.4.0");
        last HACMP_VER_SWICH;
    }
    # Defect 105021:
    # !! highest_known_hacmp_ver MUST BE UPPED FOR EACH VERSION OF HACMP !!
    $highest_known_hacmp_ver = 9;

    if ($hacmp_ver > $highest_known_hacmp_ver) {
        print_message("I_TopsvcsHighHACMPVersion", $hacmp_ver);
    } else {
        #print "Unknown HACMP version. hacmp_ver = $hacmp_ver\n";
        print_message("I_TopsvcsUnknownHACMPVersion", $hacmp_ver);
    }
}

# HAGEO is not supported until HACMP 4.3.1.
$HAGEO_SUPPORT = ($hacmp_ver >= 2) ? 1 : 0;
# Pluggable modules is not supported until HACMP 4.5.0.
$PLUGGABLE_NIM_SUPPORT = ($hacmp_ver >= 5) ? 1 : 0;

# Fast Heartbeating is not supported until HACMP 5.2.0
$FAST_HB_SUPPORT  = ($hacmp_ver >= 7) ? 1 : 0;

# Fast Failure Detection ("halt callback") is not supported until HACMP 5.4.0
$FFD_SUPPORT = ($hacmp_ver >= 9) ? 1 : 0;

# The following table is used to:
# - check if a network type is supported
# - decide the order of networks in machine list file
# Note that IP-based networks come before non-IP based networks. 
# Geo_Secondary must be in the last one of IP-based and the first one
# of non-IP based network because Geo_Secondary can be IP or non-IP based.

# The numbers here are designed to enforce the following ordering of the
# netwporks:
# - all the supported IP types (including Geo_Primary)
# - all the non-supported IP types
# - Geo_Secondary (which could be either IP or non-IP
# - all the non-supported non-IP types
#
# The goal is to keep all the IP types before all the non-IP types

if ($HAGEO_SUPPORT) {
    %TypeOrder=(
          "ether"         => 0,
          "hps"           => 1,
          "token"         => 2,
          "fddi"          => 3,
          "atm"           => 4,
	  "IP"            => 5,
	  "Geo_Primary"   => 6,
	  "Geo_Secondary" => 1007,
          "rs232"         => 1008,
          "tmscsi"        => 1009,
          "tmssa"         => 1010,
          "diskhb"        => 1011,
          "diskhbmulti"   => 1012);
} else {
    %TypeOrder=(
          "ether" => 0,
          "hps" => 1,
          "token" => 2,
          "fddi" => 3,
          "atm" => 4,
          "rs232" => 5,
          "tmscsi" => 6,
          "tmssa" => 7,
          "diskhb" => 8,
          "diskhbmulti" => 9);
}

# Supported non-IP adapters.
# This hash array maps the non-IP device names to the non-IP network types
# known to HACMP and HATS.
%NonIPType = (
	"tty"	=> "rs232",
	"tmscsi"=> "tmscsi",
        "tmssa" => "tmssa",
        "rhdisk"=> "diskhb");

$HA_SYSPAR_NAME=$clusterName;

# Output of "spget_syspar -n" (partition name) is used "as is". No NLS.
if ( $hacmp_version422 ) {
    $PARTITION=`spget_syspar -n`;
    chop $PARTITION;
}
$SUBSYSNAME="${SUBSYSNAME}.${HA_SYSPAR_NAME}";
$ENV{'HA_DOMAIN_NAME'}="$HA_SYSPAR_NAME";
$ENV{'HB_SUBSYS_NAME'}="$SUBSYS";
$ENV{'HB_SERVICE_NAME'}="$SUBSYS";
$HB_RUNDIR="/var/ha/run/${SUBSYSNAME}";
$HB_SERVER_SOCKET="/var/ha/soc/${SUBSYS}/server_socket";
$ENV{'HB_SERVER_SOCKET'}="$HB_SERVER_SOCKET";
$HB_SOCKETDIR="/var/ha/soc/${SUBSYS}";
$ENV{'HB_SOCKETDIR'}="$HB_SOCKETDIR";

if (! -d $HB_SOCKETDIR) {
    eval `mkdir -p $HB_SOCKETDIR`;
    if ($? != 0) {
        ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100",
            $HB_SOCKETDIR);
        #print " $PROGNAME: cannot create directory $HB_SOCKETDIR.";
	print_message("EMSG603", $SCRIPT, $HB_SOCKETDIR);
        exit 3;
    }
    eval `chmod 0755 $HB_SOCKETDIR`;
}
if (! -d $HB_RUNDIR) {
    eval  `mkdir -p  ${HB_RUNDIR}`;
    if ($? != 0) {
        ffdc_errlog("ERRID_TS_SP_DIR_ER", __LINE__, "ALPHA", "100", $HB_RUNDIR);
        #print " $PROGNAME: cannot create directory $HB_RUNDIR." ;
	print_message("EMSG603", $SCRIPT, $HB_RUNDIR);
        exit 3;
    }
    # Defect 114250: Permissions for run directory were too lenient (757)
    eval `chmod 0750 ${HB_RUNDIR}`;
}
chdir ${HB_RUNDIR};

### [ Routine to generate the machine list  ]
if ( exists $overRide{'machList'} ) {
    $ENV{'HB_MACHINES_LIST'}=$overRide{'machList'};
} else {
    if ($VERIFY == 1) {
        $ENV{'HB_MACHINES_LIST'}="${HB_RUNDIR}/machines.$clusterId.lst.v";
    } else {
        $ENV{'HB_MACHINES_LIST'}="${HB_RUNDIR}/machines.$clusterId.lst";
    }
}

if ( $hacmp_version422 ) {
    ${HB_MACHINES_LIST_REL1}="/var/ha/run/${SUBSYS}.${PARTITION}/machines.${clusterId}.lst";
}

# Defect 81658
# Moved the following block from its location below so that the DMS was loaded
# before the call to MachineSub(), wherein NIMs may be called to get their
# version strings.  If this is done before the DMS is loaded, harmless but
# annoying messages may appear in the log.
# Load the Dead Man Switch if necessary
if (!$REFRESH && !$VERIFY) {
    eval `/usr/sbin/rsct/bin/haDMS/haDMS_query >/dev/null 2>&1`;
    if ( $? != 0 ) {
        eval `/usr/sbin/rsct/bin/haDMS/haDMS_load /usr/sbin/rsct/bin/haDMS/haDMS_kex`;
    }
}

# FFD Support
if ( (!$VERIFY) && ("Linux" ne $OSname) ) {
    # Linux does not (and cannot) use this kernel extension and it is
    # unnecessary to load it or initialize it in verification.
    if (!$REFRESH) {
        `$RSCT_BIN/hahalt/hahalt_query >/dev/null 2>&1`;
        $rc = get_exit_code($?);
        if ( $rc != 0 ) {
            print_message("EMSG647", $SCRIPT);
            `$RSCT_BIN/hahalt/hahalt_load $RSCT_BIN/hahalt/hahalt_kex`;
            $rc = get_exit_code($?);
            if ( $rc != 0 ) {
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC",
                            "96,4",
                     "$RSCT_BIN/hahalt/hahalt_load $RSCT_BIN/hahalt/hahalt_kex",
                            $rc);
                print_message("EMSG871", $SCRIPT,
                 "\"$RSCT_BIN/hahalt/hahalt_load $RSCT_BIN/hahalt/hahalt_kex\"",
                              $rc);
                my_exit (-1);
            }
        }
    }

    if ($FFD_SUPPORT) {
        `$RSCT_BIN/hahalt/hahalt_query fullInitDone`;
        $FullInitDone = get_exit_code($?);
        if (!$FullInitDone) {
            `$RSCT_BIN/hahalt/hahalt_query init 2>&1`;
            $rc = get_exit_code($?);
            if ( $rc != 0 ) {
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC",
                            "96,4", "$RSCT_BIN/hahalt/hahalt_query init", $rc);
                print_message("EMSG871", $SCRIPT,
                              "\"$RSCT_BIN/hahalt/hahalt_query init\"", $rc);
                my_exit (-1);
            }
        }
    } else {
        if (!$REFRESH) {
            # If we are in a refresh, initializing to the minimal level is
            # not necessary, as it must be initialized AT LEAST to that level
            # already.
            `$RSCT_BIN/hahalt/hahalt_query noSupport 2>&1`;
            $rc = get_exit_code($?);
            if ( $rc != 0 ) {
                ffdc_errlog("ERRID_TS_EXEC_COMMAND_ER", __LINE__, "ALPHA,DEC",
                            "96,4", "$RSCT_BIN/hahalt/hahalt_query noSupport",
                            $rc);
                print_message("EMSG871", $SCRIPT,
                              "\"$RSCT_BIN/hahalt/hahalt_query noSupport\"",
                              $rc);
                my_exit (-1);
            }
        }
    }
}

# Check if there is enough disk space to generate the machines.lst file
# Error msgs are printed by isThereSpaceInFS()
if (!isThereSpaceInFS($HB_LOGDIR) || !isThereSpaceInFS($HB_RUNDIR)) {
    my_exit(1);
}


#### The following line calls the MachineSub subroutine to generate the list.
if ( ! exists $overRide{'noBuild'} ) {
    $ret=&MachineSub();
    if ($ret == -1) {
        # The real problem should have been reported from inside MachineSub().
        #print " Error occured while creating the machine list \n";
	print_message("EMSG662", $SCRIPT);
        my_exit(-1);
    }
}

if ( $VERIFY == 1 ) {
    my_exit ($VERIFY_RC);
}

if ( exists $overRide{'noExec'} ) {
    exit 0;
}

# The following lines enables IP source routing. This is required to support
# Reliable Messaging. Under no circumstances should it be removed, commented
# out, or the option disabled.  This will only be set if src_routing is
# set for any of the adapters.
if ($source_routing == 1) {
    `no -o nonlocsrcroute=1` ;
    `no -o ipsrcroutesend=1 -o ipsrcrouterecv=1 -o ipsrcrouteforward=1`;
}

if ( $REFRESH == 1 ) {
    `refresh -s $SUBSYS`;
    $rc = get_exit_code($?);
    if ($rc != 0) {
        ffdc_errlog("ERRID_TS_REFRESH_ER", __LINE__, "", "", "");
    }
    my_exit($rc);
}


### [Rename any core files based on previous log name.]
### core files in AIX 5.1 have name 'core.<pid>.ddhhmmss'(if
### env var CORE_NAMING is set), while in AIX 4.3 the name is still 'core'
$CORE_43="${HB_RUNDIR}/core";
($CORE_51)=glob "$HB_RUNDIR/core.[0-9]*.[0-9]*";
   # $CORE_51 will only be defined if there is a core file with name
   # like core.12345.12235959 in directory HB_RUNDIR

if ( (-e $CORE_43) || defined($CORE_51) ) {
    # The output of ls (file names) is used "as is". No NLS.
    $PREV=`ls -tr ${HB_LOGDIR}/${SUBSYS}.*.${HA_SYSPAR_NAME} 2>/dev/null | tail -1`;
    chop($PREV);
    if ( -e $PREV ) {
        $header="$HB_LOGDIR/$SUBSYS.";
        $trailer=".$HA_SYSPAR_NAME";
        $PREV=~/$header(.*.)$trailer/;
        $middle=$1;
        print STDERR $middle; 
        if(-e $CORE_43) {
            eval `mv ${HB_RUNDIR}/core  ${HB_RUNDIR}/core.${middle}`;
        }
        else {
            eval `mv $CORE_51 ${HB_RUNDIR}/core.${SUBSYS}.${middle}`;
                 # SUBSYS is used for AIX 5 cores, to help distinguish between
                 # original core.pid.ddhhmmss  cores from "cooked"
                 # core.dd.hhmmss cores (which used to be created by
                 # this script).
        }
    }
    else {
        eval `rm -f ${HB_RUNDIR}/core`;
    }
}		

### [ Remove the 0ldest logs > $num_logs_to_keep ]
# First, assume all Topology Services log files need to be removed.
# Then get rid of the most recent log files from the removing list.
# The service log file names are: ${SUBSYS}.dd.hhmmss.${HA_SYSPAR_NAME},
# where dd=[01..31], hh=[00-23], mm=[00-59], ss=[00-59].
$base_log_file = "${HB_LOGDIR}/${SUBSYS}.[0-3][0-9].[0-2][0-9][0-5][0-9][0-5][0-9].${HA_SYSPAR_NAME}";
# The output of /bin/ls (file names) is used "as is". No NLS.
@to_be_removed = `/bin/ls -t ${base_log_file}* 2> /dev/null`;
chomp(@to_be_removed);
@serv_log_files = grep(/^${base_log_file}$/, @to_be_removed);
# Get rid of the most recent service log file names, as well
# as their corresponding backup files, user log files, and
# backup of user log files, from the removing list.
for ($i = ($#serv_log_files + 1 > $num_logs_to_keep) ?
    ($num_logs_to_keep - 1) : $#serv_log_files;
    $i >= 0; $i--) {
    @to_be_removed = grep(!/$serv_log_files[$i]/, @to_be_removed);
}
if (@to_be_removed) {
    # Print out the file names to be removed.
    print STDERR "Log files:\n";
    for($i = 0; $i <= $#to_be_removed; $i++) {
       	print STDERR "$i: $to_be_removed[$i] WILL BE REMOVED\n";
    }
    # Remove older log files remaining on the removing list.
    unlink @to_be_removed;
}

#Remove the oldest corefile > 2
# The output of /bin/ls (file names) is used "as is". No NLS.
while ( `ls -t ${HB_RUNDIR}/core* 2>/dev/null | wc -l` > 2 ) {
    $TEMP=`ls -t ${HB_RUNDIR}/core* | tail -1`;
    chop($TEMP);
    eval `rm -f $TEMP `; 
    if ( $? != 0 ) {
        last;
    } 
}

# The following line is needed for self-death analysis to work. Under no
# circumstances should it be removed, commented out, or the option disabled.
# da41012: "no -o bcastping=1" no longer required for netmonAdapterHealth.
#     Remove "no -o bcastping=1" to prevent denial-of-service attacks.
#eval `no -o bcastping=1`;


stat("/dev/css0");
#eval `ifconfig css0 arp` if -c _; # if the css0 special file exists
run_cmd_in_locale("en_US", "ifconfig css0 arp") if -c _; # if the css0 special file exists
#if ( $? != 0 ) {
#    print " Only root user can set the network options \n"; 
#exit -1; 
#}	
$ENV{'HB_LOGDIR'}="/var/ha/log/"; # Daemon expects trailing 
$ENV{'HB_RUNDIR'}="${HB_RUNDIR}/"; # Daemon expects trailing
if ( $hacmp_version422 ) {
    # The output of node_number is a number. No NLS.
    $MY_NODE_NUMBER=`/usr/lpp/ssp/install/bin/node_number`;  #local node number
    chop($MY_NODE_NUMBER); # defect 52128
    print STDERR "My node Number is ${MY_NODE_NUMBER}\n" if exists $debug{NodeNumber};
} else { 
    if ( ! exists $overRide{'nodeNumber'} ) {
	if (exists($overRide{'clhandle'})) {
	    # Match my hostname in $overRide{'clhandle'} file to find
	    # my node number. Note host name can be in foreign language.
	    $handle = join("", run_cmd_in_locale("", "/usr/bin/hostname"));
	    chop($handle);
	    ($Hostname, $Domainname) = split('\.',$handle, 2);
	    $handle = join("", run_cmd_in_locale(
                "", "/usr/bin/grep -w \"$Hostname\" $overRide{'clhandle'}"));
            $rc = get_exit_code($?);
	    if ($rc == 0) {
		chop($handle);
		print STDERR "handle=$handle " if exists $debug{NodeNumber};
		($MY_NODE_NUMBER, $MY_NODE_NAME) = split(':',$handle, 2);
		print STDERR "My_Node_Number=$MY_NODE_NUMBER, My Node Name=$MY_NODE_NAME\n" if exists $debug{NodeNumber};
	    } else {
		# My host name is not in the "clhandle -ac" file. We have
		# no way to know my node number. Assign one.
		$MY_NODE_NUMBER = 1;
		print STDERR "Assign My_Node_Number=$MY_NODE_NUMBER\n" if exists $debug{NodeNumber};
	    }
	} else {
	    $cmd_name = &findHacmpPath("clhandle");
	    $handle = join("",
                run_cmd_in_locale("en_US", "$ODMDIR $cmd_name -c"));
	    print STDERR "handle=$handle" if exists $debug{NodeNumber};
	    ($MY_NODE_NUMBER, $MY_NODE_NAME) = split(':',$handle, 2);
	    print STDERR "My_Node_Number=$MY_NODE_NUMBER, My Node Name=$MY_NODE_NAME\n" if exists $debug{NodeNumber};
	}
    } else {
        $MY_NODE_NUMBER=$overRide{'nodeNumber'};
        print STDERR "My_Node_Number=$MY_NODE_NUMBER\n" if exists $debug{NodeNumber};
    }
}
if ( exists $overRide{'daemonDir'} ) {
    $DaemonDir=$overRide{'daemonDir'};
} else {
    $DaemonDir='/usr/sbin/rsct/bin';
}
print STDERR "DaemonDir=$DaemonDir\n" if exists $overRide{'daemonDir'};

# Defect 81658 - Moved up above
## Load the Dead Man Switch if necessary
#eval `/usr/sbin/rsct/bin/haDMS/haDMS_query >/dev/null 2>&1`;
#if ( $? != 0 ) {
#    eval `/usr/sbin/rsct/bin/haDMS/haDMS_load /usr/sbin/rsct/bin/haDMS/haDMS_kex`;
#}

# Load the "pinning" kernel extension if necessary
if ("AIX" eq $OSname) {
    `/usr/sbin/rsct/bin/pin/hatspin_load 1>&2`;
}

# Force 1-1 mapping between user and kernel threads
# The HATS daemon already has code to create threads using an 1-1 mapping,
# but the main thread would still have "process scope". The statement below
# changes that.
$ENV{'AIXTHREAD_SCOPE'} = "S";

# Defect 126129 - timing issue with netmon trying to do a local adapter
# status check just when HACMP is removing an IP address can result
# in a loopback route left behind that is no longer valid.
$ENV{'HA_DONT_REMOVE_LOOPBACK_ROUTE'} = "YES";

# In AIX 5.1 memory is used in the threads library for "virtual processors".
# Since HATS adopts the 1-1 mapping between user and kernel threads, it does
# not need the virtual processors. The statement below helps save around
# 2Mb for the daemon and each NIM.
$ENV{'NUM_SPAREVP'} = "1";

# Indicate the strategy used by the netmon library to ping other local
# adapters
#     ALL_OTHERS: ping all other local adapters, regardless of type
#     SAME_INTERFACE_TYPE: ping all other adapters that appear to have the
#                 same interface type -- there is a good chance they are in
#                 the same wire
#     (default)   ping only those addresses passed by the daemon in the
#                 "open" request. In practice, this will be the local
#                 adaptrers that are on the same network as the local adapter
#                 being monitored. The caveat here is that these are the
#                 addresses as known by the daemon, which may not include
#                 cascading takeover addresses that may be in use.
$ENV{'HA_NIM_NETMON_PING_LOCAL_ADAPTERS'} = "SAME_INTERFACE_TYPE";

# Enable Dead Man Switch if option "-DMS_enable" was used
if ($DMS_enabled_flag == 1) {
    $daemon_dms_enable_option = "-o deadManSwitch";
}
else {
    $daemon_dms_enable_option = "";
}

# Make back up for log files.
saveLogs();

# Defect 114250: Permissions need to be restricted for security reasons
umask (022);

exec("${DaemonDir}/${DAEMON} -n ${MY_NODE_NUMBER} ${daemon_dms_enable_option}" ) if ! exists $overRide{'noExec'};
