#!/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. 2000,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 
#
# @(#)24   1.10         src/rsct/cfg_access/gpfs/ct_topology_info.perl, cfg.access, rsct_relgh, relghs001a 1/25/03 13:55:12
#
# This will give the topology info for GPFS clusters
# Usage: ct_topology_info [-l] [-w]
#    -l  to get the data from the local repository (performance)
#    -w  to set the data to the repository (input from stdin)
#
use Getopt::Std;

my %opts = ();
&getopts(':lw',\%opts);
my $mmrefresh=(defined($opts{l}) ? "norefresh" : "");
my $mmsetting=(defined($opts{w}) ? 1 : 0);

$RSCTBIN="/usr/sbin/rsct/bin";
$MMHA="/usr/lpp/mmfs/bin/mmha";

($dir,$progname) = $0 =~ /(.*\/)?(.*)/; # get basename of $0

# ValidKeys: list of all acceptable keys (either canset or not).
# In other words, the input keys must be in the list.
# Otherwise, an error will be issued.

$NON_SETTABLE = 0;
$SETTABLE = 1;

%ValidKeys = (
    "NETWORK_NAME"	=> $NON_SETTABLE,
    "NETWORK_TYPE"	=> $SETTABLE,
    "NETWORK_FREQ"	=> $SETTABLE,
    "NETWORK_SENS"	=> $SETTABLE,
    "NETWORK_NIM_EXEC"  => $SETTABLE,
    "NETWORK_NIM_PAR"	=> $SETTABLE,
    "NETWORK_SRC_ROUTING" => $SETTABLE,
    "NETWORK_BCAST"	=> $SETTABLE,
    "ADAPTER"		=> $NON_SETTABLE
);


# main starts here
if($mmsetting) {
   #write the data to the repository
   &print_dbgmsg("Set data to repository");
   &set_data_to_repository();
} else {
   my $outcnt = &get_data_from_repository();
   if($outcnt == 0) {
        &print_dbgmsg("No fields are read.");
        exit(1);
   }
}
exit(0);

#-------- functions -----------------------------------
# print_dbgmsg(list)
sub print_dbgmsg
{
  my @args = @_;
  if(!defined($ccal_log_inited)) {
	my $outfile = $ENV{"HA_CCAL_LOG"};
	$ccal_log_inited = 0;
	if(defined($outfile) && open(LOGOUT, ">>$outfile")) {
	    $ccal_log_inited = 1;
	    select LOGOUT;
	    $| = 1; # unbuffered
	    select STDOUT;
	}
  }
  if($ccal_log_inited) {
	my $dstr = scalar(localtime);
	my $msg = "$dstr $progname: " . join(" ", @args);
	print LOGOUT $msg, "\n" ;
  }
}

sub print_errmsg
{
   &print_dbgmsg(@_);
   print STDERR "# $progname: ", join(" ", @_), "\n";
}
#-----------------------------------------------------

# GET DATA from the repository
sub get_data_from_repository
{

   my $outcnt = 0;
   local(@mmNetworks) = ();	# raw network infos
   local(@mmAdapters) = ();	# raw adapter infos

   # step 1: get all network information
   my $MMGETNETCMD="${MMHA} haGetNetworkInfo all_networks all $mmrefresh";
   &print_dbgmsg("$MMGETNETCMD");
   if(!open(MMCMDFILE, "${MMGETNETCMD} |")) {
	&print_errmsg("Error on ${MMGETNETCMD}");
	exit(1);
   }
   @mmNetworks = <MMCMDFILE>;
   close MMCMDFILE;

   # step 2: get all adapter information
   my $MMHAADAPTCMD="${MMHA} haGetAllAdapters norefresh";
   &print_dbgmsg("$MMHAADAPTCMD");
   if(!open(MMCMDFILE, "${MMHAADAPTCMD} |")) {
	&print_errmsg("Error on ${MMHAADAPTCMD}");
	exit(1);
   }
   @mmAdapters = <MMCMDFILE>;
   close MMCMDFILE;

   #
   # step 3: for each network and print its network info & adapter infos
   #
   my @pair = ();
   foreach $mmNetLine (@mmNetworks) {
	# split colon-separated line into the different fields
	my %mmNetTbl = &trans_mmha_to_hash($mmNetLine);
	my $netname = $mmNetTbl{"NETWORK_NAME"};

	# 89428: Force to use "IP source routing"
	$mmNetTbl{"NETWORK_SRC_ROUTING"} = "1";

	# print the net info
	&print_dbgmsg("NETWORK_NAME $netname");
	print "NETWORK_NAME $netname\n";	  # network name
	$outcnt++;
	while( @pair = each %mmNetTbl ) {
	    if($pair[0] ne "NETWORK_NAME") {
		&print_dbgmsg("$pair[0] $pair[1]");
		print "$pair[0] $pair[1]\n";  # others
		$outcnt++;
	    }
	}

	# traverse all adapters which are related netname
	foreach $mmAdaptLine (@mmAdapters) {
	    #check whether it is related netname
	    my @kv = split(" ", $mmAdaptLine);
	    # fmt of kv: 'node# netname ip intf'
	    if( $kv[1] eq $netname ) {
		&print_dbgmsg("ADAPTER $kv[2] $kv[3] $kv[0] $kv[1]");
		print "ADAPTER $kv[2] $kv[3] $kv[0] $kv[1]\n";
		$outcnt++;
	    }
        }
   }
 
   # return # of output lines
   return $outcnt;
}



# SET DATA to the repository 
sub set_data_to_repository
{
   my $count = 0;
   my %kvFields = ();
   my @fields;
   my ($key, $val, $canset);
   my $netname = "";
   my @mmInList = ();
   my $MMPUTNETCMD="${MMHA} haPutNetworkInfo";
   while( <STDIN> ) {
	@fields = split " ";	# split input
	$key = $fields[0];
	$val = join(" ",@fields[1..$#fields]);
	next if(!defined($key) || ($key eq "") || ($key =~ /^#/));
        $key = uc $key;		# upper case
	$canset = $ValidKeys{$key};	
	if(defined($canset)) {
	    if($key eq "NETWORK_NAME") {
		#flush the current saved paramters
		if(scalar(@mmInList) > 0 && $netname ne "") {
			# update the network info
			my $mmInStr = join(":",@mmInList);
			&print_dbgmsg("$MMPUTNETCMD $netname $mmInStr");
			`$MMPUTNETCMD $netname \"$mmInStr\"`;
			$count++;
		}
		#new network starts
		@mmInList = ();		# make it empty
		$netname = $val;
	    } elsif($canset == $SETTABLE) {
		if($val eq "") { $val = " "; }  # make sure 'blank' exists
		my $kvStr = "$key=$val";
		push @mmInList, ($kvStr);
	    } else {
	    	&print_dbgmsg("Unsettable field: $key $val");
	    }
	} else {
	    # not defined...unknown key
	    &print_errmsg("Unknown field: $key $val");
	}
   }

   #flush the current saved paramters
   if(scalar(@mmInList) > 0 && $netname ne "") {
	# update the network info
	my $mmInStr = join(":",@mmInList);
	&print_dbgmsg("Update: $netname $mmInStr");
	`$MMPUTNETCMD $netname \"$mmInStr\"`;
	$rc = $?;
	&print_dbgmsg("$MMHAPUTCMD $netname $mmInStr RETURNS $rc");
	$count++;
   }

   return $count;
}

#
# Input:  a colon-separated mmha output line
#         eg: KA=V1:KB=V2:KC=V3:
# Output: hash table with pairs of {K}={V}
sub trans_mmha_to_hash
{
    my $parm = $_[0];
    chomp($parm);
    my @fields = split(":",$parm);
    my %outtbl = ();
    foreach $item (@fields) {
	my @kv=split("=",$item);
	if(scalar(@kv) >= 2) {
            $outtbl{$kv[0]} = join("=",@kv[1..$#kv]);
	} elsif(scalar(@kv) > 0) {
	    &print_dbgmsg("Unkown field $item");
	}
    }
    return %outtbl;
}

