#!/usr/bin/perl -I/usr/local/lib/perl5 --  # -*-Perl-*-
#
# ntc_config.pl -- script to manage NTC configuration from the SP
#
# Copyright 2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# ident	"@(#)ntc_config	1.5	04/08/25 SMI
#

require 5.005;

use File::Basename;
use Getopt::Long;
use Fcntl ':flock';

use Net::Telnet;
use Net::Ping;

use strict;

################################################################
#
# global variables
#
################################################################

my ($version) = "1.5";
my ($prog,$path,$suffix);
my ($ret_code) = 'OK';

#
# Access blocking info
#
my ($packageName) = "SUNWsespnc";
my ($filePath) = "/opt/" . ${packageName} . "/";
my ($ntc_blocker) = $filePath . "ntc_access_block";
my ($ntc_is_blocked) = "";
my ($unConfigure) = "";
my ($reset) = "";

#
# config file constants
#
my ($configFile) = "config.sys";
my ($bootConfig) = "/tftpboot/" . $configFile;
my ($bakConfig) = "/tftpboot/" . $configFile . ".bak";
my ($newConfig) = "/tftpboot/new_" . $configFile;
my ($defConfig) = "/opt/SUNWsentcu/" . $configFile;

#
# telnet "object"
#
my ($tnet) = undef;
my ($telnetLogFile, $optLogFile) = undef;
my ($sleep_time) = 1;

#
# NTC variables and constants
#
my ($ntc_login) = "rss";
my ($ntc_login_pwd) = "sun1";
my ($ntc_priv_pwd) = "sun1rss";
my ($ntc_prompt) = "/ntc0: /";
my ($ntc_name);
my (%ntc_ip2name) = (
	3 => "sp0-ntc",
	13 => "sp1-ntc",
	23 => "sp2-ntc",
	33 => "sp3-ntc",
	43 => "sp4-ntc",
	53 => "sp5-ntc",
	63 => "sp6-ntc",
	73 => "sp7-ntc",
	243 => "new_ntc",
);

#
# option variables
#
my ($prt_err_codes, $debug, $prt_vers) = 0;
my (%in_vars) = ('d' => \$debug,
                 'e' => \$prt_err_codes,
                 'version' => \$prt_vers,
                 'L' => \$telnetLogFile);

#
# return codes & descriptions
#
my (%errcodes) = (
    OK => 0,
    InternalErr => 1,
    FileErr => 2,
    FileLockErr => 3,
    BadArgs => 10,
    NTCUnReachable => 20,
    TnetErr => 30,
    TnetCreateErr => 31,
    TnetLogErr => 32,
    TnetConnectErr => 33,
    TnetLoginErr => 34,
    SigInt => 50,
    Reserved => 99,
);

my (%errcode_desc) = (
    0 => "Good completion",
    1 => "Internal script error",
    2 => "Error opening file",
    3 => "Error locking file",
    10 => "Invalid or missing argument(s)",
    20 => "NTC not reachable (ping)",
    30 => "General Telnet error",
    31 => "Error creating Telnet connection",
    32 => "Error creating Telnet log files",
    33 => "Error connecting via Telnet",
    34 => "Error logging into host via Telnet",
    50 => "Interrupted by signal",
    99 => "Reserved for future use",
);

################################################################
#
# subroutines
#
################################################################

#
# &print_error_codes() -- print a list of return codes
#
sub print_error_codes
{
    sub sort_values
    {
        $errcodes{$a} <=> $errcodes{$b};
    }

    my $key;
    my $fmt = "%14s\t%4d\t%s\n";
    my $num_codes = keys %errcodes;
    my $num_descs = keys %errcode_desc;

    &dprint("Num. error codes: $num_codes - Num. descriptions: $num_descs");
    &exit_sub('InternalErr') unless ($num_codes == $num_descs);

    print("\n${prog} error code list\n\n");
    print("   Semantic   \tCode\t  Description  \n");
    print("--------------\t----\t---------------\n");

    foreach $key (sort sort_values keys %errcodes) {
        printf($fmt, $key, $errcodes{$key}, $errcode_desc{$errcodes{$key}});
    }

    print("\n");
}

#
# &exit_sub(ErrSemantic) -- exit with status
# ErrSemantic is the key used to lookup the exit status
# in the %errcodes hash.
#
sub exit_sub
{
    my ($status) = shift;

    if ( ! exists $errcodes{$status} ) {
        &dprint("ERR: '$status' not a recognized semantic!");
        $status = 'InternalErr';
    }

	# make sure we release access locks
	&unblock_ntc;

    &dprint("$errcode_desc{$errcodes{$status}}");
    exit ($errcodes{$status})
}

#
# &dprint(msg) -- debug print
# "msg" is the string to be printed
#
sub dprint
{
    my ($msg) = shift;
    my ($pmsg) = &pstring($msg);

    print STDERR "DEB($$): $pmsg\n" if $debug;
}

#
# &pstring(str) -- prettify a string
# "str" is the string to be prettified
#
sub pstring
{
    my ($str) = shift;

    $str =~ s/\n/\\n/g;
    $str =~ s/\r/\\r/g;

    $str;
}

#
# &sigHandler(sigName) -- handle signals
# "sigName" must be the name of a valid signal
#
sub sigHandler
{
    my ($sigNo) = shift;

    print STDERR "\n$prog: Interrupted by Signal: $sigNo\n";

    if ( defined $tnet ) {
        $tnet->close;
    }

    &exit_sub('SigInt');
}

#
# &write-lock(filehandle) -- set an exclusive write lock on a filehandle
#
sub write_lock
{
    my ($fileHandle) = shift;
    flock ($fileHandle, LOCK_EX) or do {
		&dprint("ERR: cannot set exclusive lock on file");
		&exit_sub('FileLockErr');
	};
}

#
# &read_lock(filehandle) -- set a shared read lock on a filehandle
#
sub read_lock
{
    my ($fileHandle) = shift;
    flock ($fileHandle, LOCK_SH) or do {
		&dprint("ERR: cannot set shared lock on file");
		&exit_sub('FileLockErr');
	};
}

#
# &unlock(filehandle) -- release an existing lock on a filehandle
#
sub unlock
{
    my ($fileHandle) = shift;
    flock ($fileHandle,LOCK_UN) or do {
		&dprint("ERR: cannot release lock on file");
		&exit_sub('FileLockErr');
	};
}

#
# &block_ntc() -- block access to the NTC
# This routine creates the file "ntc_access_block" if it does not
# exist, and sets an exclusive write lock on the file when preparing
# to access the file.  This means that if the agent is called
# subsequently, it will block trying to set another lock on the
# file.  Other agents should attempt to exclusively lock the same file
# (non-blocking, if they should exit immediately).
#
sub block_ntc
{
    open BLOCKER, ">" . $ntc_blocker;
    &dprint("Locking blocker file '$ntc_blocker'");

    eval {
        local $SIG{ALRM} = sub {die "alarm timeout"};
        # set a 3-minute alarm
        alarm 180;
        &write_lock(\*BLOCKER);
        alarm 0;
    };

    if ( $@ and $@ =~ /alarm timeout/ ) {
        &exit_sub('FileLockErr');
    }

    print BLOCKER "$$\n";
    $ntc_is_blocked = "yes";
}

#
# &unblock_ntc() -- restore access to the NTC
#
sub unblock_ntc
{
    if ( $ntc_is_blocked ) {
        seek BLOCKER, 0, 0;
        print BLOCKER "\n";
        &unlock(\*BLOCKER);
        $ntc_is_blocked = "";
        &dprint("Unlocked blocker file");
        close BLOCKER;
    }
}

#
# &verify_connect(hostname_or_ip) -- ping a host
# This routine will act on the parameter as a hostname or IP address.
# If the parameter is a hostname, the SP must be able to resolve it.
#
sub verify_connect
{

    my ($pingHost) = shift;
    my ($status, $ping);

    &dprint("Pinging $pingHost via ICMP");
    $ping = Net::Ping->new('icmp');
    $status = $ping->ping($pingHost);
    $ping->close;

    return($status);
}

#
# &new_telnet(ipAddress) -- set up a new Telnet connection
# ipAddress is - guess what - the IP address of the device to
# which you wish to establish the Telnet connection. =8^)
#
sub new_telnet
{
    my ($timeoutVal) = 30;
    my ($onErr) = 'return';
    my ($ntc) = shift;

    # create a telnet object
    &exit_sub('TnetCreateErr') unless ($tnet = new Net::Telnet);

    # set up configuration options:
    # "return" on error
    # 30-second default command timeout
    # match pattern for main menu
    $tnet->errmode($onErr);
    $tnet->timeout($timeoutVal);
    $tnet->prompt('/login: $/');

    # set up telnet logging, if requested (for debugging)
    if (defined($telnetLogFile)) {
        $optLogFile = $telnetLogFile . ".opt";
        &dprint(">> dumping Telnet log to \"$telnetLogFile\"");
        &dprint(">> dumping Telnet options to \"$optLogFile\"");
        &exit_sub('TnetLogErr') unless
            ($tnet->dump_log($telnetLogFile) and
             $tnet->option_log($optLogFile));
    }

    # try to connect
    &exit_sub('TnetConnectErr') unless
        ($tnet->open(Host => $ntc));

    # connection successful - issue logon password
    $tnet->waitfor('/Password: $/');
    &exit_sub('TnetLoginErr') unless $tnet->cmd($ntc_login_pwd);

    # login user
    $tnet->prompt($ntc_prompt);
    &exit_sub('TnetLoginErr') unless $tnet->cmd($ntc_login);

    # set privileged status
    $tnet->print("set priv");
    $tnet->waitfor('/Password: $/');
    $tnet->cmd($ntc_priv_pwd);
}

#
# &close_telnet() -- close the telnet connection
#
sub close_telnet
{
    $tnet->close;

}

#
# &read_options() -- parse command line options
#
sub read_options
{
    my ($ret_code, $key);

    # configure GetOpt to allow short commands to be grouped together
    # (really only for 'edL')
    Getopt::Long::Configure('bundling');

    # this is the list of valid options
    $ret_code = GetOptions (\%in_vars,
        'e',
        'd',
        'version',
	'unconfigure',
        'L=s',
        'curr_ip=s',
        'new_ip=s',
        'sp_ip=s',
	'reset',
    );

    if ( $ret_code eq '' ) {
        $ret_code = 'BadArgs';
    } else {
        $ret_code = 'OK';
    }

	if ( exists $in_vars{unconfigure} ) {
		&dprint("Unconfiguring NTC");
		$unConfigure  = "yes";
	}

	if ( exists $in_vars{reset} ) {
		&dprint("Just reset NTC only");
		$reset = "yes";
	}

	if ( $unConfigure ) {
		if ( !(exists $in_vars{curr_ip} && exists $in_vars{sp_ip} ) ) {
			&dprint("ERR: Invalid args: unconfigure requires curr_ip and sp_ip");
			&ret_code = 'BadArgs';
		}
	} elsif ( exists $in_vars{curr_ip} || exists $in_vars{new_ip} || exists $in_vars{sp_ip} ) {
       if ( !(exists $in_vars{curr_ip} && exists $in_vars{new_ip} && exists $in_vars{sp_ip}) ) {
          &dprint("ERR: Invalid arguments: curr_ip, new_ip, and sp_ip are required");
          $ret_code = 'BadArgs';
       }
    }

    return($ret_code);
}

#
# &find_hostname - returns NTC's hostname from its new IP address
#
sub find_hostname
{
	my ($new_name);
	my ($oct1, $oct2, $oct3, $oct4) = split /\./, $in_vars{new_ip};

	if ( exists $ntc_ip2name{$oct4} ) {
		$new_name = $ntc_ip2name{$oct4};
	} else {
		&dprint("ERR: Couldn't find hostname for address '$in_vars{new_ip}'");
		&exit_sub('BadArgs');
	}

	return $new_name;
}

#
# &create_config - Create a new config.sys file
#
sub create_config
{
	&dprint("Creating new config file");
    if ( $unConfigure || ! -e $bootConfig ) {
		if ( $unConfigure) {
			&dprint(">> Copying default file to unconfigure NTC");
		} else {
			&dprint(">> Config file does not exist - copying default file");
		}

		if ( ! -e $defConfig ) {
			&dprint("ERR: Default config file '$defConfig' does not exist!");
			&exit_sub('FileErr');
		}

        open INFILE, "<" . $defConfig or do {
			&dprint("ERR: Could not open '$defConfig' for input");
			&exit_sub('FileErr');
		};

        open OUTFILE, ">" . $bootConfig or do {
			&dprint("ERR: Could not open '$bootConfig' for ouptut");
			&exit_sub('FileErr');
		};

	# lock the files
	&read_lock(\*INFILE);
	&write_lock(\*OUTFILE);

        while (<INFILE>) {
            print OUTFILE;
        }

	# unlock and close the files
	&unlock(\*INFILE);
	&unlock(\*OUTFILE);

        close INFILE;
        close OUTFILE;
    }

	if (! $unConfigure ) {
		# set the new hostname
		&dprint(">> Getting new hostname");
		$ntc_name = &find_hostname;
		&dprint(">> New hostname = '$ntc_name'");
	
		# open the input and output files, start processing
		open INFILE, "<" . $bootConfig or do {
			&dprint("ERR: Could not open '$bootConfig' for input");
			&exit_sub('FileErr');
		};
		open NEWFILE, ">" . $newConfig or do {
			&dprint("ERR: Could not open '$newConfig' for output");
			&exit_sub('FileErr');
		};
	
		# lock the input file
		&read_lock(\*INFILE);
	
		LINE: while ( <INFILE> ) {
			if ( /server name/ ) {
				print NEWFILE "define server name \"" . $ntc_name . "\"\n";
				next LINE;
			} elsif ( /server ipaddress/ ) {
				print NEWFILE "define server ipaddress " . $in_vars{new_ip} . "\n";
				next LINE;
			} elsif ( /server loadhost/ ) {
				print NEWFILE "define server loadhost " . $in_vars{sp_ip} . "\n";
				next LINE;
			} elsif ( /server startupfile/ ) {
				print NEWFILE "define server startupfile \"" . $in_vars{sp_ip}
					. ":config.sys\"\n";
				next LINE;
			} elsif ( /ip timeserver/ ) {
				print NEWFILE "define ip timeserver ip " . $in_vars{sp_ip}
					. "\n";
				next LINE;
			} else  {
				print NEWFILE ;
				next LINE;
			}
		}
	
		# unlock and close files, backup original, rename new
		&unlock(\*INFILE);
		close INFILE;
		close NEWFILE;
	
		rename $bootConfig, $bakConfig or do {
			&dprint("ERR: Could not rename '$bootConfig' to '$bakConfig'");
			&exit_sub('FileErr');
		};
	
		rename $newConfig, $bootConfig or do {
			&dprint("ERR: Could not rename '$newConfig' to '$bootConfig'");
			&exit_sub('FileErr');
		};

	}

	&dprint(">> Done creating new config file");
}

#
# &set_new_config - sources new config file onto the NTC, and sets new parameters
# that must be changed.  This routine assumes that a Telnet connection
# has been established
#
sub set_new_config
{
	my ($ret_code) = 'OK';
	my (@cmdReturn);
	my ($sourceFile) = "\"" . $in_vars{sp_ip} . ":" . $configFile . "\"";
	my ($errMsg);

	if ( ! defined $tnet ) {
		&dprint("ERR: Telnet object is not defined");
		$ret_code = 'TnetErr';
	} else {
		&dprint("Modifying NTC configuration");

		#
		# New ntc's are taking 2-3 minutes to source
		# the config.sys from the sp.  We changed the
		# timeout value from 90 to 500 seconds
		#
		my $oldTimeout = $tnet->timeout;
		my $sourceTimeout = 500;
		$tnet->timeout($sourceTimeout);
		&dprint(">> new tnet timeout, $sourceTimeout"); 

		# this may make processing easier
		CTRL: while  ( $ret_code eq 'OK' ) {

			# source the configuration file
			&dprint(">> sourcing the config file, " .
				localtime(time));
			@cmdReturn = $tnet->cmd("source " . $sourceFile);
			if ( @cmdReturn eq @_ ) {
				$errMsg = $tnet->errmsg;
				&dprint("ERR: problem sourcing config file, " .
					localtime(time));
				&dprint("ERR: '$errMsg'");
				$ret_code = 'TnetErr';
				last CTRL;
			} else {
				# restore the saved timeout
				$tnet->timeout($oldTimeout);
			}

			# reboot the NTC
			if ($reset) {
				&dprint(">> initializing the server delay 45, " .
					localtime(time));
				@cmdReturn = $tnet->cmd("init server delay 45");
			} else {
				&dprint(">> Reloading the server, " .
					localtime(time));
				@cmdReturn = $tnet->cmd("init reload");
			}
			if ( @cmdReturn eq @_ ) {
				$errMsg = $tnet->errmsg;
				&dprint("ERR: problem initializing server, " .
					localtime(time));
				&dprint("ERR: '$errMsg'");
				$ret_code = 'TnetErr';
				last CTRL;
			}

			# made it through successfully, so set this to break out
			$ret_code = 'BreakOut';
		}
	}

	if ( $ret_code eq 'BreakOut' ) {
		$ret_code = 'OK';
	}

	&dprint(">> set_new_config done, " . localtime(time));
	return $ret_code;
}

################################################################
#
# main -- start of processing
#
################################################################

#
# get our name (uses Basename)
#
($prog,$path,$suffix) = &fileparse($0, ".pl");
my (@buffer);

#
# handle these signals
#
$SIG{'INT'} = 'sigHandler';
$SIG{'QUIT'} = 'sigHandler';

#
# get command line options
#
$ret_code = &read_options;

if ($ret_code ne 'OK') {
    &exit_sub($ret_code);
}

#
# a few quick answers
#
# print a list of error codes
if ($prt_err_codes) {
    &print_error_codes;

    &exit_sub('OK');
}

# print version information
if ($prt_vers) {
    print "$prog version: $version\n";
    &exit_sub('OK');
}

#
# reconfiguration processing
#
# block NTC access first
&block_ntc;

# verify NTC is reachable at its current IP address
if ( exists $in_vars{curr_ip} ) {
    &exit_sub('NTCUnReachable') unless
        &verify_connect($in_vars{curr_ip});
}

# create the new config file
&create_config;

# open a new Telnet connection and log in
&new_telnet($in_vars{curr_ip});

# source new config file, initialize server
$ret_code = &set_new_config;

# close the Telnet object
&close_telnet;

# restore access to the NTC
&unblock_ntc;

#
# time to go
#
&exit_sub($ret_code);
