#!/usr/bin/perl -I/usr/local/lib/perl5
#
# FW_config.pl -- script to manage the NetGear RP114 firewall
#
# Copyright 2004 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# ident "@(#)FW_config 1.26 05/06/08 SMI
#

#
# The firewall does not have a programmatic interface.
# To make the problem worse the menus are presented 
# strangely, the left side is drawn, then the traditional
# prompt and then the right side of the menu.  This makes
# using the 'cmd' method and 'timeout' settings in the
# Net::Telnet module very difficult.  There are many
# workarounds scattered in the code as needed.
#
# This all means that telnet connections are basically
# working blindly and we hope that everything works out.
#
# There is a temptation to shorten the sleeps between
# telnet commands.  While this may seem like a great
# way to speed things up it may cause us to get out of
# sync.  Sicne we are working blind this is very bad.
#
#
# The firewall can get tempermental at times.  It seems
# to go out to lunch.  This script has recently been
# improved to be much more robust than in the past.
# The main difference is that the connection to the
# firewall is verified much better than before.
#
# The script has been enhanced to verify critical states
# rather than relying on data in the repository which
# includes an exhaustive search should the firewall be
# at the wrong IP address.
#

require 5.005;

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

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

use strict;

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

my ($version) = "1.26";					# script version (in sync with SCCS)
my ($packageName) = "SUNWsespfw";					# package name
my ($filePath) = "/opt/" . ${packageName} . "/";	# path: package location
my ($rep_file) = $filePath . "repository";			# file: repository
my ($rep_tmp_file) = $filePath . "repository.tmp";	# file: temporary repository
my ($fw_blocker) = $filePath . "fw_access_block";	# file: firewall access lock
my ($fw_is_blocked) = "no";				# Is the firewall access lock active?
my ($change_tracker) = "no";				# Where configuration changes made?
my ($rnid_info_changed) = "no";				# Does RNID data need updating?
my ($found_firewall) = "no";				# firewall found alive
my ($firewall_alive) = "no";				# firewall connectivy verified
my ($ret_code) = 'OK';					# return code
my ($key,$prog,$path,$suffix,$rc);
my ($scriptStartTime, $startTime, $runTime);

#
# config backup variables
#
my ($romFile) = "rom-0";
my ($newBakFile) = $filePath . $romFile . ".bak";
my ($oldBakFile) = $newBakFile . ".prev";
my ($defCfgFile) = "/opt/SUNWsespfd/" . $romFile;
my ($rasFile) = "/opt/SUNWsespfd/ras";

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

#
# firewall variables
#
my ($fwMenuPrompt) = '/Number/';
my ($fwCmdPrompt) = '/SE6[x9]20> /'; # allow SE6x20, SE6920
my ($wanEnetIF) = 'enet1';
my ($wanIF) = 'enif1';
my ($lanIF) = 'enif0';
my ($firmware_version) = undef;

my ($minPort) = 1024;
my ($maxPort) = 65535;
my ($patchproPort) = 443;
my ($cimIndicationsPort) = 8990;

#
# command option variables
#
my ($prt_err_codes, $debug, $prt_vers, $prt_usage, $prt_services) = 0;
my (%in_vars) = ();
my (%port_vals) = ();

################################################################
#
# return codes & descriptions
#
################################################################

my (%errcodes) = (
    OK => 0,
    InternalErr => 1,
    FileErr => 2,
    FileLockErr => 3,
    BadArgs => 10,
    BadWanIPCfg => 11,
    BadLanIPCfg => 12,
    BadSubnetMask => 13,
    SPLanIPOverlap => 14,
    CLanIPOverlap => 15,
    DhcpStateErr => 16,
    WanStateErr => 17,
    FWUnReachable => 20,
    HostUnReachable => 21,
    NoFwNoRep => 22,
	FWNotFound => 23,
    TnetError => 30,
    TnetCreateError => 31,
    TnetLogError => 32,
    TnetConnErr => 33,
    TnetLoginErr => 34,
    ConnectErr => 35,
    FtpErr => 40,
    FtpCreateErr => 41,
    FtpLogin => 42,
    FtpGetErr => 43,
    FtpPuterr => 44,
    SigInt => 50,
    RNIDScriptErr => 97,
    RNIDErr => 98,
    Reserved => 99,
	# return codes from RNID configuration script
    RNIDInternalErr => 101,
    RNIDFileErr => 102,
    RNIDFileLockErr => 103,
    RNIDPWFileErr => 104,
    RNIDInvPwd => 105,
    RNIDBadArgs => 110,
    RNIDTnetError => 130,
    RNIDTnetLogin => 134,
    RNIDCIMError => 135,
    RNIDSigInt => 150,
);

my (%errcode_desc) = (
    0 => "Good completion",
    1 => "Internal script error",
    2 => "Error opening file",
    3 => "Error locking file",
    10 => "Invalid or missing argument(s)",
    11 => "Invalid static IP configuration for WAN",
    12 => "Invalid static IP configuration for LAN",
    13 => "Invalid subnet mask",
    14 => "WAN/SP-LAN IP address overlap",
    15 => "WAN/Component-LAN IP address overlap",
    16 => "DHCP Server state inconsistency",
	17 => "WAN address type state inconsistency",
    20 => "Firewall not reachable",
    21 => "Host not reachable (ping)",
    22 => "No repository found; no firewall at default address",
	23 => "Could not locale a functional firewall",
    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",
	35 => "Error connectiong to firewall, firewall not responding to ping",
    40 => "General FTP error",
    41 => "Error creating new FTP connection",
    42 => "Error logging into host via FTP",
    43 => "Error getting file from host via FTP",
    44 => "Error putting file to host via FTP",
    50 => "Interrupted by signal",
	97 => "Error running 't4_rnid_cfg', check file is installed properly",
	98 => "Unknown error configuring RNID data",
    99 => "Reserved for future use",
    101 => "(RNID):Internal script error",
    102 => "(RNID):Error opening file",
    103 => "(RNID):Error locking file",
    104 => "(RNID):Error opening password file",
    105 => "(RNID):Invalid or placeholder password in password file",
    110 => "(RNID):Invalid or missing argument(s)",
    130 => "(RNID):General telnet error",
    134 => "(RNID):Error logging into host via telnet",
    135 => "(RNID):Error connecting to CIMOM",
    150 => "(RNID):Interrupted by signal",
);

################################################################
#
# default information for the repository
#
################################################################

my (%def_repository) = (
    Version => $version,
    UniqueID => "",
    FirewallLogin => "admin",
    FirewallPwd => "sun1",
    WanAddrType => "static",
    WanIPAddr => "0.0.0.0",
    WanSubnetMask => "0.0.0.0",
    WanGateway => "0.0.0.0",
    LanIPAddr => "new_firewall",
    LanSubnetMask => "255.255.255.0",
    LanDHCPSrv => "disabled",
    LanDNSSrv => "0.0.0.0",
    ssh => "disabled",
    dns => "enabled",
    ntp => "enabled",
    snmp => "enabled",
    slp => "enabled",
    patchpro => "enabled",
    patchpro_port => $patchproPort,
    cim_indications => "enabled",
    cim_indications_port => $cimIndicationsPort,
    cim_http => "enabled",
    cim_https => "enabled",
    management => "enabled",
    esm => "enabled",
);

my (%stored_repository, %curr_repository);

#
# The following may be commented to help debug while in development.
# 
#open (DEBUGTRACE, ">>/var/tmp/firewall.log") || die "cant open debug file";

################################################################
#
# Filter Sets
#
################################################################

my (%filterSets) = (
    DualFilter => "7",
    InputFilter1 => "8",
    InputFilter2 => "9",
    OutputFilter1 => "10",
    OutputFilter2 => "11",
);

################################################################
#
# The following hash indicates which page a rule resides in.
#
################################################################
my (%ruleFilterSets) = (
    ssh => "DualFilter",
    ssh_reply => "DualFilter",
    smtp => "OutputFilter1",
    smtp_reply => "InputFilter1",
    dns => "OutputFilter1",
    dns_reply => "InputFilter1",
    dhcp => "OutputFilter1",
    dhcp_reply => "InputFilter1",
    ntp => "OutputFilter1",
    ntp_reply => "InputFilter2",
    snmp => "DualFilter",
    snmp_reply => "DualFilter",
    snmpTrap => "OutputFilter1",
    snmpTrap_reply => "InputFilter2",
    slp => "DualFilter",
    slp_reply => "DualFilter",
    patchpro => "OutputFilter1",
    patchpro_reply => "InputFilter2",
    cim_indications => "OutputFilter2",
    cim_indications_reply => "InputFilter2",
    cim_http => "InputFilter1",
    cim_http_reply => "OutputFilter2",
    cim_https => "InputFilter1",
    cim_https_reply => "OutputFilter2",
    management => "InputFilter1",
    management_reply => "OutputFilter2",
    esm => "OutputFilter2",
    esm_reply => "InputFilter2",
);

################################################################
#
# The following hash contains the index of the rule within the
# page it resides.  Note that "reply" means inbound relative
# to the firewall.
#
################################################################
my (%ruleFilterNumber) = (
    ssh => "1",
    ssh_reply => "2",
    smtp => "1",
    smtp_reply => "4",
    dns => "2",
    dns_reply => "5",
    dhcp => "3",
    dhcp_reply => "6",
    ntp => "4",
    ntp_reply => "1",
    snmp => "3",
    snmp_reply => "4",
    snmpTrap => "5",
    snmpTrap_reply => "2",
    slp => "5",
    slp_reply => "6",
    patchpro => "6",
    patchpro_reply => "3",
    cim_indications => "5",
    cim_indications_reply => "5",
    cim_http => "1",
    cim_http_reply => "2",
    cim_https => "2",
    cim_https_reply => "3",
    management => "3",
    management_reply => "4",
    esm => "1",
    esm_reply => "4",
);

################################################################
#
# Services
#
################################################################

my ($service_list) =
    "#Currently available services:\n" .
    "#<service name>, <port>, <direction>, <toggle>, <change port>\n" .
    "#============================================================\n" .
    "ssh, 22, both, yes, no\n" .
    "smtp, 25, out, no, no\n" .
    "dns, 53, out, yes, no\n" .
    "dhcp, 67, out, no, no\n" .
    "ntp, 123, out, yes, no\n" .
    "snmp, 161, both, yes, no\n" .
    "snmpTrap, 162, out, no, no\n" .
    "slp, 427, both, yes, no\n" .
    "patchpro, 443, out, no, yes\n" .
    "cim_indications, 8990, out, yes, yes\n" .
    "cim_http, 5988, in, yes, no\n" .
    "cim_https, 5989, in, yes, no\n" .
    "management, 6789, in, yes, no\n" .
    "esm, 8443, out, yes, no\n";

################################################################
#
# Basic Functions
#
################################################################

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

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

    &dprint("Number of codes: $num_codes - number of descriptions: $num_descs");
    &exit_sub('InternalErr') unless ($num_codes == $num_descs);

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

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

    print("\n");
}

#
# &print_services()
#
# print a list of services
#
# This list is parsed by scripts to determine the supported functionality.
#
sub print_services
{
	print($service_list);
}

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

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

    #
    # The following may be commented to help debug while in development.
    #
    # print DEBUGTRACE "DEBUG($$): $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 return ('FileLockErr');
}

#
# &read_lock(filehandle)
#
# set a shared read lock on a filehandle
#
sub read_lock
{
    my ($fileHandle) = shift;
    flock ($fileHandle, LOCK_SH) or return ('FileLockErr');
}

#
# &unlock(filehandle)
#
# release an existing lock on a filehandle
#
sub unlock
{
    my ($fileHandle) = shift;
    flock ($fileHandle,LOCK_UN) or return ('FileLockErr');
}

################################################################
#
# Parsing Functions
#
################################################################

#
# &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 command line options
	# PLEASE: keep this in sych with printUsage()
	$ret_code = GetOptions (\%in_vars,
		'e' => \$prt_err_codes,
		'd' => \$debug,
		'help' => \$prt_usage,
		'version' => \$prt_vers,
		'init_repository',
		'unconfigure',
		'L=s' => \$telnetLogFile,
		'wan_addr_type=s',
		'wan_ip_addr=s',
		'wan_subnet_mask=s',
		'wan_gateway=s',
		'lan_ip_addr=s',
		'ping=s',
		'toggle_port_state=s',
		'dhcp_server=s',
		'dhcp_dns_server=s',
		'port_fwd_addr=s',
		'set_port_val=i' => \%port_vals,
		'firmware_version',
		'upgrade_firmware',
		'services' => \$prt_services,
	);

	&dprint("Parsing command line ...");

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

		# validate "--wan_addr_type" parameter combinations
		# "--wan_addr_type static" requires "--wan_ip_addr <ip>",
		# "--wan_subnet_mask <mask>" and "--wan_gateway <ip>"
		if ( exists $in_vars{wan_addr_type} ) {
			&dprint("  Checking WAN arguements ...");
			foreach ($in_vars{wan_addr_type}) {
				/static/   and do { ($ret_code = 'BadWanIPCfg') unless
						 (( exists $in_vars{wan_ip_addr} ) &&
						  ( exists $in_vars{wan_subnet_mask} ) &&
						  ( exists $in_vars{wan_gateway} ));
			  last; };
				/dynamic/    and do { last; };
				$ret_code = 'BadArgs';
			}
		}

		# validate "--toggle_port_state" option value
		if ( exists $in_vars{toggle_port_state} ) {
			&dprint("  Checking 'toggle_port_state' ports exist ...");
			( $ret_code = 'BadArgs' ) unless (
				exists $ruleFilterNumber{$in_vars{toggle_port_state}} );
		}

		# validate "--set_port_val" switch
		# connections for which we allow port setting:
		# patchpro
		if ( %port_vals ) {
			&dprint("  Checking 'set_port_val' values ...");
			foreach $key ( keys %port_vals ) {
				if ( $key eq 'patchpro' ) {
					($ret_code = 'BadArgs') unless (
						$port_vals{$key} == $patchproPort || (
						  $port_vals{$key} >= $minPort &&
						  $port_vals{$key} <= $maxPort ) )
				} elsif ( $key eq 'cim_indications' ) {
					($ret_code = 'BadArgs') unless (
						$port_vals{$key} == $cimIndicationsPort || (
						  $port_vals{$key} >= $minPort &&
						  $port_vals{$key} <= $maxPort ) )
				} else {
					&dprint("    >>> ERROR: port setting not allowed for " .
						"connection '$key'");
					$ret_code = 'BadArgs';
				}
			}
		}
	}

	return($ret_code);
}

#
# prints usage/help
#
sub printUsage
{
		#'e' => \$prt_err_codes,
		#'d' => \$debug,
		#'version' => \$prt_vers,
		#'init_repository',
		#'unconfigure',
		#'L=s' => \$telnetLogFile,
		#'wan_addr_type=s',
		#'wan_ip_addr=s',
		#'wan_subnet_mask=s',
		#'wan_gateway=s',
		#'lan_ip_addr=s',
		#'ping=s',
		#'toggle_port_state=s',
		#'dhcp_server=s',
		#'dhcp_dns_server=s',
		#'port_fwd_addr=s',
		#'set_port_val=i' => \%port_vals,
		#'firmware_version',
		#'upgrade_firmware',
		#'services' => \$prt_services,
	print STDOUT "\t--d                                  print debug output      \n"
		. "\t--e                                  print error codes      \n"
		. "\t--help                               print this usage message \n"
		. "\t--version                            print version          \n"
		. "\t--init_repository                    initialize the repository \n"
		. "\t--unconfigure                        unconfigure the firewall \n"
		. "\t--wan_addr_type [dynamic | static]   set address type       \n"
		. "\t--wan_ip_addr   <ip>                 set wan ip address     \n"
		. "\t--wan_subnet_mask  <mask>            set subnet mask        \n"
		. "\t--wan_gateway <gateway>              set gateway address    \n"
		. "\t--lan_ip_addr                        set lan ip address     \n"
		. "\t--ping                                                      \n"
		. "\t--toggle_port_state                  --services shows which may be toggled \n"
		. "\t--dhcp_server                                               \n"
		. "\t--dhcp_dns_server                                           \n"
		. "\t--port_fwd_addr                                             \n"
		. "\t--set_port_val <svc=port>            modify patchpro or cim_indications \n"
		. "\t--firmware_version                                          \n"
		. "\t--upgrade_firmware                                          \n"
		. "\t--services                           shows port rules       \n";
}



#
# &convert_mask(hex subnet mask)
#
# convert hexadecimal subnet mask to dotted-decimal format
#
sub convert_mask
{
	my ($new_mask) = shift;
	my (@chars, @octets);
	my ($dec_mask, $bin);
	my ($idx0) = 0;
	my ($idx1) = 0;
	my ($idx2) = 1;

	if ($new_mask eq "0x00000000") {
		return "0.0.0.0";
	}

	# create an array of characters from the hexadecimal mask
	@chars = split //, $new_mask;

	# fill in the array of octets
	while ( $idx2 le 9 ) {
		$idx1 += 2;
		$idx2 += 2;

		$bin = $chars[$idx1] . $chars[$idx2];
		$octets[$idx0] = hex $bin;
		$idx0++;
	}

	# concatenate the decimal mask from the octets
	$idx0 = 1;
	$dec_mask = $octets[0];
	while ( $idx0 le 3 ) {
		$dec_mask = $dec_mask . "." . $octets[$idx0];
		$idx0++;
	}

	return($dec_mask);
}

#
# &validate_mask(subnet mask)
#
# validate a dotted-decimal subnet mask
#
sub validate_mask
{
	my ($mask) = shift;

	my @octets = ("");
	my @valid_masks = (0, 128, 192, 224, 240, 248, 252, 254);
	my ($idx1) = 0;
	my ($idx) = 0;
	my $mask_ok = 1;
	my $valid_octet = 0;
	my $no_more_allowed = 0;

	# if mask is not defined then it's not valid
	if ($mask eq "") {
		return 0;
	}

	@octets = split /\./, $mask;

	# validate each octet as long as the mask remains valid
	while ( ($idx <= $#octets) && $mask_ok ) {

		# validate octets that don't mask the entire range
		if ($octets[$idx] != 255) {

			# the first octet cannot be 0, or we wouldn't have any portion
			# of the IP address for the network address
			if ( ($idx == 0) && ($octets[$idx] == 0) ) {
				$mask_ok = 0;

			# if we've already encountered an octet that was not 255,
			# we cannot have any more non-zero octets
			} elsif ( $no_more_allowed && ($octets[$idx] != 0) ) {
				$mask_ok = 0;

			# we have an allowable non-255 octet - is it valid?
			} else {
				$idx1 = 0;
				$no_more_allowed = 1;

				# check that the octet is one of the 8 remaining valid masks
				while ($idx1 <= $#valid_masks) {
					if ( $octets[$idx] == $valid_masks[$idx1] ) {
						# we matched against a valid mask
						$valid_octet = 1;
					}

					$idx1++;
				}

				# if we did not find a valid mask in the octet, the entire
				# subnet mask is invalid
				if (!$valid_octet) {
					$mask_ok = 0;
				}
			}

		# we cannot have 255 in the last octet - that would mean the entire
		# IP address would represent the network address!
		} elsif ( ($idx == 3) || $no_more_allowed ) {
			$mask_ok = 0;
		}

		$idx++;
	}

	return ($mask_ok);
}

#
# &mask_addr(ip_addr, netmask)
#
# returns logical AND of an IP address and a subnet mask for comparisons.
# The address and the netmask are given in dotted-decimal form
#
sub mask_addr
{
	my ($ipAddr) = shift;
	my ($netMask) = shift;
	my ($hexAddr, $hexMask, $decAddr, $decMask);
	my (@octets);
	my ($idx, $result, $hostName);
	my ($hostfile) = "/etc/hosts";

	# if the IP address is 'new_firewall', lookup the actual
	# dotted-decimal address
	if ( $ipAddr == 'new_firewall' ) {
		CORE::open HOSTFILE, "<" . $hostfile or
		 &exit_sub('FileErr');

	  while (<HOSTFILE>) {
		 /new_firewall/ and do {
			($ipAddr, $hostName) = split;
			last;
		 }
	  }

	  close HOSTFILE;
	}

	# convert the IP address to hex
	(@octets) = split /\./, $ipAddr;

	$idx = 0;
	while ($idx <= $#octets) {
	  $hexAddr = $hexAddr . sprintf "%02lx", $octets[$idx];
	  $idx++;
	}

	# convert the subnet mask to hex
	(@octets) = split /\./, $netMask;

	$idx = 0;
	while ($idx <= $#octets) {
	  $hexMask = $hexMask . sprintf "%02lx", $octets[$idx];
	  $idx++;
	}

	# convert each hex value to decimal so the bitwise AND will work
	# properly
	$decAddr = hex $hexAddr;
	$decMask = hex $hexMask;

	# return the bitwise AND of the address and mask
	$result = ($decAddr & $decMask);
	return ($result);
}

################################################################
#
# Repository Operations
#
################################################################

#
# &read_repository()
#
# read the repository file into the "stored_repository" hash
#
sub read_repository
{
	my ($key,$value);

	if ( -e $rep_file ) {
		&dprint("  Opening repository: ${rep_file}");

		# open for reading
		CORE::open REPOSITORY, "<" .$rep_file or &exit_sub('FileErr');

		#lock the repository while we read it
		eval {
			local $SIG{ALRM} = sub {die "alarm timeout"};
			alarm 60;
			&read_lock(\*REPOSITORY);
			alarm 0;
		};

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

		# read the repository file, load "stored_repository" hash
		while (<REPOSITORY>) {
			($key,$value) = split /:/;
			chomp $value;
			$stored_repository{$key} = $value;
		}

		# unlock the repository file
		&unlock(\*REPOSITORY);
		close REPOSITORY;

		# copy stored values to current repository
		# note that the hash "def_repository" is the template
		# for a complete repository.  If a key exists in
		# "stored_repository" that is not in "def_repository", it will NOT
		# be copied to "curr_repository"!
		foreach $key (keys %def_repository) {
			if ( exists $stored_repository{$key} ) {
				if ( $key eq 'Version' ) {
					$curr_repository{$key} = $version;

					if ( $stored_repository{$key} ne $version ) {
						&dprint("    Updating version information in " .
							"repository");
						$change_tracker = "yes";
					}
				} else {
					$curr_repository{$key} = $stored_repository{$key};
				}
			} else {
				# key did not exist in old repository
				&dprint("    Creating new key '$key' in repository");
				$curr_repository{$key} = $def_repository{$key};
				$change_tracker="yes";
			}
		}
	} else {
		&dprint("    Repository (${rep_file}) does not exist.");
		&dprint("    Creating new repository ...");

		# copy default repository hash
		# fill in blanks from current firewall state
		%curr_repository = %def_repository;

		# save the repository 
		&create_repository;
	}

	return;
}

#
# &create_repository() -- create the repository file from the
# "curr_repository" hash
#
sub create_repository
{
    my $key;

	# open for writing
	CORE::open REPOSITORY, ">" . $rep_tmp_file or &exit_sub('FileErr');

    # lock the temporary repository
    &write_lock(\*REPOSITORY);

	&dprint("    Saving repository: $rep_file");

    foreach $key (keys %curr_repository) {
        print REPOSITORY $key . ":" . $curr_repository{$key} . "\n";
    }

    # unlock the file
    &unlock(\*REPOSITORY);
    close REPOSITORY;

	# move the temporary repository to the real repository
    if ( ! rename $rep_tmp_file, $rep_file ) {
        &dprint("      >>> ERROR: renaming temp repository $rep_tmp_file " .
			"' $! '");
        &exit_sub('FileErr');
    }

    return;
}

################################################################
#
# firewall access lock
#
################################################################

#
# &block_fw() -- block access to the firewall
#
# This routine creates the file "fw_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_fw
{
    &dprint("Grabbing the firewall access lock: " . $fw_blocker);

	CORE::open BLOCKER, ">" . $fw_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";
    $fw_is_blocked = "yes";
}

#
# &unblock_fw() -- restore access to the firewall
#
sub unblock_fw
{
    if ( $fw_is_blocked eq "yes") {
        seek BLOCKER, 0, 0;
        print BLOCKER "\n";
        &unlock(\*BLOCKER);
        $fw_is_blocked = "no";
        &dprint("Releaseing the firewall access lock: " .
			$fw_blocker);
        close BLOCKER;
    }
}

################################################################
#
# Basic Telnet Operations
#
################################################################

#
# &new_telnet()
#
# set up a new telnet connection
#
sub new_telnet
{
	my ($firewall) = $curr_repository{LanIPAddr};

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

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

	# set up telnet logging, if requested (for debugging)
	if (defined($telnetLogFile)) {
		&dprint("% Dumping telnet log to: $telnetLogFile");
		&exit_sub('TnetLogError') unless
			$tnet->dump_log($telnetLogFile);
	}

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

	# connection successful, so log on
	$tnet->waitfor('/Password: $/');
	&exit_sub('TnetLoginErr') unless $tnet->cmd($curr_repository{FirewallPwd});
}

#
# &close_telnet()
#
# close the telnet connection
#
sub close_telnet
{
	my ($firewall) = $curr_repository{LanIPAddr};
	$tnet->close;
}

#
# &fld_advance(count)
#
# move to subsequent menu fields "count" is a positive integer
#
sub fld_advance
{
	my ($iterations) = shift;

	# save the current timeout value
	my ($old_timeout) = $tnet->timeout;

	# set a really short timeout, so this doesn't take too long
	$tnet->timeout('1');
	until ($iterations == 0) {
		$tnet->cmd("");
		$iterations--;
	}

	# restore the old timeout value
	$tnet->timeout($old_timeout);
}

#
# &fld_advance_fast(count)
#
# move to subsequent menu fields "count" is a positive integer
#
# The telnet timeout is removed to go faster and has a sleep at the end
# to clear the buffer.  Works best for high iterations.
#
sub fld_advance_fast
{
	my ($iterations) = shift;

	# save the current timeout value
	my ($old_timeout) = $tnet->timeout;

	# remove the timeout an allow telnet to buffer
	$tnet->timeout('0');
	until ($iterations == 0) {
		$tnet->cmd("");
		$iterations--;
	}

	# sleep for a short period to let the buffer clear
	sleep 1;

	# restore the old timeout value
	$tnet->timeout($old_timeout);
}

#
# &nav_cli()
#
# navigate to firewall's command mode interpreter
#
# This routine assumes a telnet connection has been established and
# connected to the main menu.
#
sub nav_cli
{
	# System Maintenance
	$tnet->cmd('24');

	# set up CLI mode prompt and invoke CLI mode
	$tnet->prompt($fwCmdPrompt);
	$tnet->cmd('8');
}

################################################################
#
# Connectivity Checks
#
################################################################

#
# &verify_ping(hostname_or_ip)
#
# Standard ICMP ping with a 20 second timeout
#
# 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_ping
{
    my ($pingHost) = shift;
    my ($status, $ping);

    &dprint("    ping $pingHost");

	# ICMP Ping with 20 second timout
    $ping = Net::Ping->new('icmp', 20);
    $status = $ping->ping($pingHost);
    $ping->close;

    if ($status eq "1") {
		&dprint("      $pingHost is alive");
		return ('OK')
    } else {
		&dprint("      no response from $pingHost");
		return($status);
    }
}

#
# &verify_connect(hostname_or_ip)
#
# Verify connectivity to an firewall.
# Requires response from ping and telnet.
#
# 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 ($firewall) = shift;
	my ($iterations) = 7;
    my ($status) = 0;
	my ($ping);

    &dprint("    checking connectivity to $firewall");

	# try 7 quick pings
	# waiting a few extra seconds is better than a quick failure
	while (($iterations > 0) && ($status ne "1")) {
		&dprint("      ping $firewall");
		$ping = Net::Ping->new('icmp', 5);
		$status = $ping->ping($firewall);
		$ping->close;
		$iterations--;
	}

	# check ping status
    if ($status eq "1") {
		&dprint("        $firewall is alive");
    } else {
		&dprint("        no response from $firewall");
		return($status);
    }

	# if ping works then try telnet
    &dprint("      telnet $firewall");

	# create a telnet object
	&exit_sub('TnetCreateError') unless ($tnet = new Net::Telnet);
	$tnet->errmode('return');
	$tnet->timeout(30);

	# try to connect
	if ($tnet->open(Host => $firewall)) {
		&dprint("        $firewall responds to telnet");
		return ('OK')
	} else {
		&dprint("        no response to telnet from $firewall");
		return (0);
	}
	
	$tnet->close;
}

#
# &wait_connect(hostname_or_ip)
#
# Wait for a significant ammount of time for an firewall to be alive.
# Requires response from ping and telnet.
#
# This is used to shorten the time spent waiting for an firewall to
# reboot or reconfigure the LAN interface and accept connections again.
#
# 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 wait_connect
{
    my ($firewall) = shift;
    my ($waitTime) = shift;
	my $total_sleeps = 1;

	&dprint("  Waiting for connectivity to firewall ($firewall) ...");

	# Since this is often called when a host is rebooting or reconfiguring
	# it's network interface which take a while to complete it is necessary
	# to sleep for a couple of seconds to ensure the host/network went down
	# and has started to ensure this gets a connection to the firewall
	# after it's rebooted or reconfigured it's network interface.
	sleep $waitTime;

	# Try connecting to the firewall several times.
	#
	# Don't give up for a very long time as we are fairly sure the firewall
	# was recently working at the known IP address and it may have simply gone
	# out to lunch.
	#
	# Each unsuccessful loop takes about 25 seconds.
	# 	There are 5 pings with 5 second timouts in verify_connect
	#   There is one telnet attempt with a 20 second timeout.
	#
	# Because of the sleep in verify_connect there is no reason to sleep
	# between loops.
	while ($total_sleeps < 25) {
		if (&verify_connect($firewall)) {;
			&dprint("  Connectivity (ping/telnet) to firewall ($firewall) " .
				"obtained.");
			return 0;
		} else {
			$total_sleeps = $total_sleeps + 1;
		}
	}

	# connection timeout
	&dprint("  >>> ERROR: failed to obtain connectivity to firewall " .
		"($firewall).");

	&exit_sub('ConnectErr');
}

################################################################
#
# Helper Functions
#
################################################################

#
# &update_rnid()
#
# update the RNID data on the arrays
#
sub update_rnid
{
	my ($key);
	my ($t4_rc) = 0;
	my ($found_key) = 0;

	$rc = 0;

	&dprint("  Calling RNID configuration agent ..."); 

	# call agent to configure T4 RNID params
	$rc = system("/usr/local/bin/t4_rnid_cfg");

	&dprint("    RNID configuration agent returned: $rc");

    if ($rc == '-1') {
        $ret_code = 'RNIDScriptErr';
		$found_key = 1;
    } else {
        $t4_rc = 0xffff & $rc;

        if ( ($t4_rc & 0xff) == 0 ) {
            $t4_rc >>= 8;
        }

        # need to find the right exit semantic
        foreach $key (keys %errcodes) {
            if ( $t4_rc == $errcodes{$key} ) {
                $ret_code = $key;
                $found_key = 1;
                last;
            }
        }
    }

    if ( ! $found_key ) {
        $ret_code = 'RNIDErr';
    }
}

#
# &update_repository()
#
# update the repository file
#
sub update_repository
{
	&dprint("  Updating repository ..."); 
	$change_tracker = "yes";
	&create_repository;
}

#
# &update_routing()
#
# update the routing tables and default router on the service processor
#
sub update_routing
{
    my ($firewall) = shift;

	# flush the routing table on the SP
	&dprint("  Flushing the routing table on the Service Processor ...");
	system("/usr/sbin/route flush > /dev/null");

	# create the default route
	&dprint("  Creating the default route on the Service Processor ...");
	system("/usr/sbin/route add default $firewall > /dev/null");
	system("/usr/bin/echo $firewall > /etc/defaultrouter");
}

################################################################
#
# Firmware
#
################################################################

#
# &get_firmware_version()
#
# retrieves the firmware version that is currently installed
#
sub get_firmware_version
{
	my $g1;
	my $idx = 0;
	my (@buffer);

	&dprint("  Getting firewall firwmare version ...");

	# set up a new telnet connection
	&new_telnet;

	# navigate to command interpreter
	&nav_cli;

	@buffer = $tnet->cmd('sys version');
	while ($idx <= $#buffer) {
		# Format of the revision string:  RAS version: V3.26(CD.0) | 8/17/2001
		if ($buffer[$idx] =~ /RAS version:/) {
			($g1, $firmware_version) = split /:/, $buffer[$idx];
			chomp $firmware_version;
			$firmware_version =~ s/^ *//;
			&dprint("    Firewall firmware version: $firmware_version");
			last;
		}
		$idx++;
	}

	# close the telnet connection
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("exit");
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;
	return ('OK')
}

#
# &upgrade_firmware()
#
# Copies a new firmware file over to the firewall and waits for the upgrade
# to happen. The current configuration is saved prior to the upgrade and
# restored when completed.
#
# Documentation states:
# 	"In some cases you may need to reconfigure the router after upgrading."
#
sub upgrade_firmware
{
	my ($ftp) = undef;
	my ($savedFile) = undef;
	my ($firewall) = $curr_repository{LanIPAddr};

	&dprint("  Upgrading firewall firwmare (ras image) ...");

	&exit_sub('FileErr') unless
		(-e $rasFile);

	# backup up the current configuration
	&backup_config;

    # create a new FTP object
    &exit_sub('FtpCreateErr') unless
        ($ftp = Net::FTP->new($firewall));

    # login and setup
    &exit_sub('FtpLogin') unless
      ($ftp->login($curr_repository{FirewallLogin},
       $curr_repository{FirewallPwd}));
    $ftp->binary;

    # send the firmware file to the firewall
    &exit_sub('FtpPutErr') unless
      ($savedFile = $ftp->put($rasFile));

    # cleanup
    $ftp->quit;

    # need to wait for the firewall to reboot
	&dprint("  Waiting for firewall to load new firmware (ras image) ...");
	&wait_connect($firewall, 5);

    # restore the current configuration
    &restore_config($firewall, $newBakFile);

	# wait for the firewall to reboot
	&dprint("  Waiting for firewall to load the new firmware ...");
	&wait_connect($curr_repository{LanIPAddr}, 5);

    &dprint("  Firmware (ras image) upgrade on firewall complete");

    return ('OK');
}

################################################################
#
# Configuration Backup/Restore
#
################################################################

#
# &restore_config(ip_addr, config_file)
#
# restore the firewall's most recent configuration
#
# "ip_addr" must be the IP address to connect with
# "config_file" is the file to restore
#
sub restore_config
{
    my ($ftp) = undef;
    my ($savedFile) = undef;
    my ($firewall) = shift;
    my ($restoreFile) = shift;

    &dprint("  Restoring firewall ($firewall) configuration ...");
    &dprint("    Using configuration file: $restoreFile");

    &exit_sub('FileErr') unless
        (-e $restoreFile);

    # create a new FTP object
    &exit_sub('FtpCreateErr') unless
        ($ftp = Net::FTP->new($firewall));

    # login and setup
    &exit_sub('FtpLogin') unless
      ($ftp->login($curr_repository{FirewallLogin},
       $curr_repository{FirewallPwd}));
    $ftp->binary;

    # put the configuration file to the firewall
    &exit_sub('FtpPutErr') unless
      ($savedFile = $ftp->put($restoreFile, $romFile));

    # cleanup
    $ftp->quit;

    &dprint("    Restored configuration $restoreFile on firewall ($firewall)");

	# update the routing tables
	&update_routing($firewall);

}

#
# &backup_config()
#
# backup the firewall's existing configuration
#
sub backup_config
{
    my ($ftp) = undef;
    my ($savedFile) = undef;
    my ($firewall) = $curr_repository{LanIPAddr};

    # turn off change tracker to avoid recursion
    $change_tracker = "no";

	&dprint("  Saving configuration for firewall at $firewall");

	if ( -e $newBakFile ) {
		if (! rename $newBakFile, $oldBakFile ) {
			&dprint("  >>> ERROR: renaming backup file $newBakFile failed: " .
				"' $! '");
			&exit_sub('FileErr');
		}
	}

	# create a new FTP object
	&exit_sub('FtpCreateErr') unless
		($ftp = Net::FTP->new($firewall));

	# login and setup
	&exit_sub('FtpLogin') unless
	  ($ftp->login($curr_repository{FirewallLogin},
	   $curr_repository{FirewallPwd}));
	$ftp->binary;

	# get the file
	&exit_sub('FtpGetErr') unless
	  ($savedFile = $ftp->get($romFile, $newBakFile));

	# cleanup
	$ftp->quit;
}

################################################################
#
# Major Functions
#
################################################################

#
# &get_unique_id()
#
# find the firewall's WAN-side MAC address, and store it as the unique identifer
#
sub get_unique_id
{
	my ($unique_id);
	my (@buffer);
	my ($trash1, $trash2);
	my ($cmdString) = 'ether driver stat ' . $wanEnetIF;

	&new_telnet;

	# get to command mode
	&nav_cli;

	# get the info for WAN-side I/F
	@buffer = $tnet->cmd($cmdString);

	# parse out the MAC address from the buffer
	($trash1, $trash2, $unique_id) = split /=/, $buffer[0];

	# get rid of the cruft
	chomp $unique_id;
	$unique_id =~ s/ //g;
	$unique_id =~ s/://g;
	&dprint ("  Unique ID: '$unique_id'");

	# close the telnet connection
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("exit");
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	return($unique_id);
}

#
# &toggle_port_state()
#
# toggle port filter state
#
# Only ports that have a enabled/disabled status in the repository can
# have their state changed.  PatchPro is an exception, it is in the
# repository so it's port number can be changed.
#
# BUG: A filter set with no rules or just one rule will have a
#      slightly different interface.  This method is not meant to
#      handle that interface since no configuration has just one
#      rule in a filter set.
#
sub toggle_port_state
{
	my ($idx) = 0;
	my ($filter, $rule, $no_rules);

	if ( ($in_vars{toggle_port_state} ne "patchpro") ) {
		foreach ( $ruleFilterSets{$in_vars{toggle_port_state}} ) {
			$rule = $ruleFilterNumber{$in_vars{toggle_port_state}};
		}

		&dprint("  Changing port filter '$in_vars{toggle_port_state}' " .
			"state ...");

		# set up new telnet connection
		&new_telnet;

		# navigate to filter set configuration menu
		$tnet->prompt("/Configure/");
		$tnet->cmd('21');

		# navigate to the appropriate filter set
		$filter = $filterSets{$ruleFilterSets{$in_vars{toggle_port_state}}};
		$tnet->prompt("/Comments/");
		$tnet->cmd($filter);
		$tnet->prompt("/Cancel/");
		$tnet->cmd("");
		$tnet->prompt("/Configure/");
		$tnet->cmd("");

		# bring up the desired ruleset
		$tnet->prompt("/Active/");
		$tnet->cmd($rule);

		# now toggle the active state
		$tnet->prompt("/Toggle/");
		$tnet->cmd(" ");

		$tnet->prompt("/Configure/");
		&fld_advance_fast(17);

		# back out to filter set configuration menu
		$tnet->prompt("/0/");
		$tnet->cmd("\e");

		# NOTE: For some reason it seems impossible to find the correct
		#       prompt here.  Since we are exiting anyway this will just
		#       be ignored and a low telnet timeout set in hopes that
		#       cleanup works reasonably well.
		$tnet->timeout(0);

		# back out to main menu
		$tnet->prompt($fwMenuPrompt);
		$tnet->cmd("\e");

		# close telnet connection
		$tnet->prompt("//"); # ignore the prompt, we are closing the connection
		$tnet->cmd("99");
		&close_telnet;

		# NOTE: There is a problem with reliably detecting the return to
		#       the Filter Set Configuration menu.  Due to the inability
		#       to detect the current location in the menu it's easier
		#       to close the telnet connection (above) and reopen a
		#       telnet connection (below) than to blindly go through the
		#       firewall menus and hope we are in the correct location.

		#
		# toggle the reply port
		#
		$idx = 0;

		&dprint("  Changing port filter " .
			"'$in_vars{toggle_port_state}_reply' state ...");
		$rule = $ruleFilterNumber{$in_vars{toggle_port_state} . "_reply"};

		# set up new telnet connection
		&new_telnet;

		# navigate to filter set configuration menu
		$tnet->prompt("/Configure/");
		$tnet->cmd('21');

		# navigate to the appropriate filter set
		$filter = $filterSets{$ruleFilterSets{($in_vars{toggle_port_state} .
			"_reply")}};
		$tnet->prompt("/Comments/");
		$tnet->cmd($filter);
		$tnet->prompt("/Cancel/");
		$tnet->cmd("");
		$tnet->prompt("/Configure/");
		$tnet->cmd("");

		# bring up the desired ruleset
		$tnet->prompt("/Active/");
		$tnet->cmd($rule);

		# now toggle the active state
		$tnet->prompt("/Toggle/");
		$tnet->cmd(" ");

		# quickly go through the rest of the fields on the screen
		$tnet->prompt("/Configure/");
		&fld_advance_fast(17);

		# back out to filter set configuration menu
		$tnet->prompt("/0/");
		$tnet->cmd("\e");

		# NOTE: For some reason it seems impossible to find the correct
		#       prompt here.  Since we are exiting anyway this will just
		#       be ignored and a low telnet timeout set in hopes that
		#       cleanup works reasonably well.
		$tnet->timeout(0);

		# back out to main menu
		$tnet->prompt($fwMenuPrompt);
		$tnet->cmd("\e");

		# close telnet connection
		$tnet->prompt("//"); # ignore the prompt, we are closing the connection
		$tnet->cmd("99");
		&close_telnet;

		if ( $curr_repository{$in_vars{toggle_port_state}} eq "enabled" ) {
			$curr_repository{$in_vars{toggle_port_state}} = "disabled";
			&dprint("  Port filter '$in_vars{toggle_port_state}' is disabled");
		} else {
			$curr_repository{$in_vars{toggle_port_state}} = "enabled";
			&dprint("  Port filter '$in_vars{toggle_port_state}' is enabled");
		}

		# update the repository
		&update_repository;
	}
}

#
# &set_port_val(portName, portVal)
#
# set the port value on a port filter
#
# portName is the semantic name for the port filter 
#          (ie "patchpro" or "cim_indications")
# portVal is the port number to be set
#
# BUG: A filter set with no rules or just one rule will have a
#      slightly different interface.  This method is not meant to
#      handle that interface since no configuration has just one
#      rule in a filter set.
#
#
sub set_port_val
{
	my ($portName) = shift;
	my ($portVal) = shift;
	my ($preAdvance, $postAdvance, $rule, $filter);

	&dprint("  Setting port to '$portVal' for connection '$portName' ...");
	foreach ( $ruleFilterSets{$portName} ) {
			$rule = $ruleFilterNumber{$portName};
			last;
	}

	# figure out if we are modifying the source port or the destination port
	if ( $portName =~ /_reply/ ) {
		$preAdvance = 9;
		$postAdvance = 6;
	} else {
		$preAdvance = 5;
		$postAdvance = 10;
	}

	# set up new telnet connection
	&new_telnet;

	# navigate to filter set configuration menu
	$tnet->prompt("/Configure/");
	$tnet->cmd('21');

	# navigate to the appropriate filter set
	$filter = $filterSets{$ruleFilterSets{$portName}};
	$tnet->prompt("/Comments/");
	$tnet->cmd($filter);
	$tnet->prompt("/Cancel/");
	$tnet->cmd("");
	$tnet->prompt("/Configure/");
	$tnet->cmd("");

	# bring up the desired ruleset, then wait
	$tnet->prompt("/Active/");
	$tnet->cmd($rule);

	# now navigate to the source/destination port field and update the value
	$tnet->prompt("/value/");
	&fld_advance_fast($preAdvance);
	$tnet->prompt("/Toggle/");
	$tnet->cmd($portVal);
	# quickly jump past all the other fields on the screen
	$tnet->prompt("/Configure/");
	&fld_advance_fast($postAdvance);

	# back out to the filter set configuration menu
	$tnet->prompt("/0/");
	$tnet->cmd("\e");

	# NOTE: For some reason it seems impossible to find the correct
	#       prompt here.  Since we are exiting anyway this will just
	#       be ignored and a low telnet timeout set in hopes that
	#       cleanup works reasonably well (which is not required).
	$tnet->timeout(0);

	# back out to main menu
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("\e");

	# close telnet connection
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	# the repository will be updated by the calling function since the
	# regular port and reply port are both modified it's better to wait
	# until both ports have been updated before the repository is updated

	return ('OK');
}

#
# &set_wan_addr_type(addr_type)
#
# set up WAN address style
# "addr_type" will be either 'static' or 'dynamic'
# (validated # by &read_options)
#
sub set_wan_addr_type
{
	my(@buffer);
	my($dhcp_cmd) = "ip dhcp " . $wanIF . " stat"; # enif1
	my($if_cmd) = "ip ifconfig " . $wanIF; # enif1
	my($curr_type, $new_dns, $cap1, $cap2, $cap3);

	# determine firewall's current type of WAN addressing
	$curr_type = &get_addr_type;

	# check to see if the actual firewall state matches the repository
	if ($curr_repository{WanAddrType} ne $curr_type) {
	   &dprint("  >> Current WAN address type (" . $curr_type .
		   ") does not match recorded state (" .
		   $curr_repository{WanAddrType} . ")");

		# update the repository with the correct information
		# need to do this here in case the actual state is the desired state
		&dprint("      Updating WAN address type in repository with the " .
			"curent state ($curr_type) ...");
		$curr_repository{WanAddrType} = $curr_type;
		&update_repository;
	}

	# check to see if the settings are already the same
	# Specified address type matches current address type - AND
	if ((($curr_type eq 'dynamic') && ($in_vars{wan_addr_type} eq 'dynamic')) ||
		(((($curr_type eq 'static') && ($in_vars{wan_addr_type} eq 'static')) &&

			# Specified IP address matches current IP address - AND
			($curr_repository{WanIPAddr} eq $in_vars{wan_ip_addr}) &&

			# Specified subnet mask matches current subnet mask - AND
			($curr_repository{WanSubnetMask} eq $in_vars{wan_subnet_mask}) &&

			# Specified gateway address matches current gateway address
			($curr_repository{WanGateway} eq $in_vars{wan_gateway})))) {
		&dprint("  Desired WAN configuration matches current configuration.");
		return($curr_type);
	}

	# If a static address is specified check that the parameters are valid.
	# If the curr_type is static then the requested type must be dynamic. 
	if ($in_vars{wan_addr_type} eq "static") {
		# check that the subnetmask is correct
		&exit_sub('BadSubnetMask') unless
			&validate_mask($in_vars{wan_subnet_mask});

		# Make sure the new IP address doesn't result in a conflict with
		# our LAN IP address, or with the SP's dmfe1 address.
		# If the WAN address is 192.168.0.*, the SP will assume any packets
		# are for the component LAN and route them through dmfe1.

		# Check for address space overlaps between the WAN side and the SP
		if ( $in_vars{wan_ip_addr} =~ /^192\.168\.0+\./) {
		   &exit_sub('CLanIPOverlap');
		}

		# Check for address space overlaps between the WAN side and the LAN side
		if ( $in_vars{wan_ip_addr} =~ /^10\./ ) {
		   if (&mask_addr($in_vars{wan_ip_addr},
					$curr_repository{LanSubnetMask}) ==
									&mask_addr($curr_repository{LanIPAddr},
					$curr_repository{LanSubnetMask}) ) {
			  &exit_sub('SPLanIPOverlap');
			}
		}
	}

	&dprint("  Changing the WAN configuration ...");

	# set up a new telnet connection
	&new_telnet;
	$tnet->prompt('/Name/');
	$tnet->cmd('4');
	$tnet->prompt('/Toggle/');
	&fld_advance(3);

	#
	#  static
	#
	if ($in_vars{wan_addr_type} eq 'static') {
		&dprint("    WAN settings:");
		&dprint("      WAN uses a static IP address ...");
		&dprint("      WAN IP: $in_vars{wan_ip_addr}");
		&dprint("      WAN NETMASK: $in_vars{wan_subnet_mask}");
		&dprint("      WAN GATEWAY: $in_vars{wan_gateway}");

		# toggle the address type if we are changing types
		if ( $curr_type eq 'dynamic' ) {
			# toggle type to "static"
			$tnet->prompt('/Toggle/');
			$tnet->cmd(" ");
		} else {
			# move to the next field
			$tnet->prompt('/\w/');
			$tnet->cmd("");
		}

		# the prompt is hard if not impossible to predict at this point
		# match any character as it means we got data (moved on)
		$tnet->prompt('/\w/');

		# update corresponding information
		$tnet->cmd($in_vars{wan_ip_addr});
		$tnet->cmd($in_vars{wan_subnet_mask});
		$tnet->cmd($in_vars{wan_gateway});
	#
	# dynamic
	#
	} else {
		&dprint("    WAN settings:");
		&dprint("      WAN uses a dynamic IP address ...");

		# toggle the address type if we are changing types
		if ( $curr_type eq 'static' ) {
			# toggle type to "dynamic"
			$tnet->cmd(" ");
		}
	}

	# save the changes
	# the prompt is hard if not impossible to predict at this point
	# match any character as it means we got data (moved on)
	$tnet->prompt('/\w/');
	$tnet->cmd("");

	# save configuration info and close the telnet session
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("");
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	&dprint("  Verifying that the WAN address type changed as desired ...");
	$curr_type = &get_addr_type;

	# report the WAN address type so we can tell what happened
	&dprint("    WAN has a $curr_type address " .
		"($in_vars{wan_addr_type} was requested)");

	# use the currently detected state to keep the repository in sync
	$curr_repository{WanAddrType} = $curr_type;

	# update repository info
	if ($curr_type eq 'static') {
		$curr_repository{WanIPAddr} = $in_vars{wan_ip_addr};
		$curr_repository{WanSubnetMask} = $in_vars{wan_subnet_mask};
		$curr_repository{WanGateway} = $in_vars{wan_gateway};

	# get DHCP data and update repository info
	} else {

		# wait a for the firewall update the DHCP data
		sleep 5;

		# set the initial values in case there is no DHCP address
		$curr_repository{WanIPAddr} = '0.0.0.0';
		$curr_repository{WanSubnetMask} = '0.0.0.0';
		$curr_repository{WanGateway} = '0.0.0.0';
		$curr_repository{LanDNSSrv} = '0.0.0.0';

		# open a new telnet connection
		&new_telnet;
		&nav_cli;

		# NOTE: if the DHCP server assigns an IP address and netmask that cause
		# any kind of conflict with the SP or component LAN addresses, we will
		# *NOT* detect it here because it's too late to do anything about it.
		# The user documentation will have to warn the user that we cannot work
		# with any 192.168.0.x customer LANs, or any 10.x.x.x configurations
		# that are not differentiated from ours by subnet masking. One
		# possibility to deal with the above problem is to revert the firewall
		# to its previous configuration.  We decided it was not worth the effort
		# at the time of this implementation

		my ($idx) = 0;
		@buffer = $tnet->cmd($dhcp_cmd);
		while ( $idx <= $#buffer ) {
			foreach ($buffer[$idx]) {

				/DNS server/ and do {
					($cap1, $cap2) = split /:/, $buffer[$idx];
					($new_dns, $cap1) = split /,/, $cap2;
					chomp $new_dns;
					$new_dns =~ s/ //g;
				};

				/Default/ and do {
					($cap1, $cap2) = split /:/, $buffer[$idx];
					chomp $cap2;
					$cap2 =~ s/ //g;
					$curr_repository{WanGateway} = $cap2;
				};
		   }

		   $idx++;
		}

		# get WAN IP address, WAN subnet mask info
		$idx = 0;

		@buffer = $tnet->cmd($if_cmd);
		while ( $idx <= $#buffer ) {
			foreach ($buffer[$idx]) {
				/inet/ and do {
					($cap1, $cap2, $cap3) = split /,/, $buffer[$idx];
					$cap1 =~ s/^ +//g;
					$cap2 =~ s/^ +//g;
					($cap3, $curr_repository{WanIPAddr}) = split / /, $cap1;
					chomp $curr_repository{WanIPAddr};
					($cap3, $cap1) = split / /, $cap2;
					$cap1 =~ s/,//g;
					$curr_repository{WanSubnetMask} = &convert_mask($cap1);
					last;
				};
			}

			$idx++;
		}

		# close telnet connection
		$tnet->prompt($fwMenuPrompt);
		$tnet->cmd("exit");
		$tnet->prompt("//"); # ignore the prompt, we are closing the connection
		$tnet->cmd("99");
		&close_telnet;
	}

	# display the DHCP data for debugging purposes
	if ($curr_type eq 'dynamic') {

		# update the DNS server only if it has changed
		if ($new_dns ne $curr_repository{LanDNSSrv}) {
			&dprint("  Got new DNS server from DHCP, " .
				"updating DNS server ...");
			&dns_server_cfg($new_dns);
		}

		&dprint("    WAN DHCP data:");
		&dprint("      WAN IP: $curr_repository{WanIPAddr}");
		&dprint("      WAN NETMASK: $curr_repository{WanSubnetMask}");
		&dprint("      WAN GATEWAY: $curr_repository{WanGateway}");
		&dprint("      DNS SERVER: $curr_repository{LanDNSSrv}");
	}

	# update the repository
	&update_repository;
	$rnid_info_changed = "yes";

	&dprint("  WAN network settings updated");

	# exit if the WAN did not get updated as expected
	&exit_sub('WanStateErr') unless
		$curr_type eq $in_vars{wan_addr_type};

	return($curr_type);
}

#
# &get_addr_type() -- retrieve current WAN address type
#
sub get_addr_type
{
	my @buffer;
	my ($idx) = 0;
	my ($type) = "unassigned";
	my ($cmd_string) = "ip dhcp " . $wanIF . " stat"; # enif1

	&dprint("  Getting WAN address type ...");

	# open a new telnet connection
	&new_telnet;
	&nav_cli;
	@buffer = $tnet->cmd($cmd_string);

	while ($idx <= $#buffer) {
		if ($buffer[$idx] =~ /none/) {
			&dprint("    the WAN has a static IP address");
			$type = 'static';
			last;
		} elsif ($buffer[$idx] =~ /client/) {
			&dprint("    the WAN has a dynamic IP address");
			$type = 'dynamic';
			last;
		}
		$idx++;
	}

	# close the telnet connection
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("exit");
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	return($type);
}

#
# &set_port_fwd_addr()
#
# set default port forwarding address
#
# This subroutine will use the value of the input variable
# $in_vars{port_fwd_addr}, which should be the IP address of our
# service processor.
#
sub set_port_fwd_addr
{
	&dprint("  Changing the port forwarding address to " .
		"$in_vars{port_fwd_addr} ...");

	&new_telnet;
	$tnet->prompt('/Reserved/');

	# SUA Server Setup Menu
	$tnet->cmd('15');

	# the prompt is hard if not impossible to predict at this point
	# match any character as it means we got data (moved on)
	$tnet->prompt('/\w/');

	# set the Default port forwdwaing address
	$tnet->cmd($in_vars{port_fwd_addr});

	# quickly go through the rest of the fields on the screen
	$tnet->prompt($fwMenuPrompt);
	&fld_advance_fast(31);

	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	# update the repository
	$curr_repository{port_fwd_addr} = $in_vars{port_fwd_addr};
	&update_repository;

	&dprint("  Port forwarding settings updated");
}

#
# &dhcp_srv_cfg()
#
# enable/disable LAN DHCP server
#
sub dhcp_srv_cfg
{
	my ($repository_state) = $curr_repository{LanDHCPSrv};
	my ($requested_state) = $in_vars{dhcp_server} . "abled";
	my ($curr_state);
	my ($fields) = 0;

	&exit_sub('BadArgs') unless
		( $in_vars{dhcp_server} eq "en" || $in_vars{dhcp_server} eq "dis" );

	&dprint("  Configuring DHCP server ...");

	# determine current DHCP server state (actutal state on firewall)
	&dprint("    Verifying the current DHCP server state ...");
	$curr_state = &get_dhcp_state;

	if ($curr_state eq "unknown") {
	   &dprint("  >>> ERROR: unable to determine current DHCP server state");
	   &exit_sub('DhcpStateErr');
	}

	if ( $curr_state ne $repository_state ) {
	   &dprint("    >> Current DHCP server state ($curr_state) does not " .
		   "match recorded state ($repository_state)");

		# update the repository with the correct information
		# need to do this here in case the actual state is the desired state
		&dprint("      Updating DHCP server state in repository with the " .
			"curent state ($curr_state) ...");
		$curr_repository{LanDHCPSrv} = $curr_state;
		$repository_state = $curr_state; # keep updated just in case
		&update_repository;
	}

	if ($curr_state eq $requested_state) {
		&dprint("    Desired DHCP server configuration matches current " .
			"configuration. ($curr_state)");
	   return;
	} else {
		&dprint("    Changing DHCP server state to $requested_state...");
		&new_telnet;

		# navigate to TCP/IP options menu
		$tnet->cmd('3');
		$tnet->prompt('/Toggle/');
		$tnet->cmd('2');

		# toggle DHCP server state
		$tnet->cmd(" ");

		# figure out how many fields are left on the menu
		if ( $curr_state eq "enabled" ) {
			$fields = 6;
		} else {
			$fields = 10;
		}

		# quickly go through the rest of the fields on the screen
		$tnet->prompt($fwMenuPrompt);
		&fld_advance_fast($fields);

		# close the telnet connection
		$tnet->cmd("\e");
		$tnet->prompt("//"); # ignore the prompt, we are closing the connection
		$tnet->cmd("99");
		&close_telnet;

		# There have been a few issues with the DHCP server starting
		# reliably so it is necessary to check that the server state
		# changed as requested.
		#
		# The firewall needs a short period of time to START the DHCP
		# server.  If we are cheking that it started we need to wait
		# a short period of time.  Otherwise we can simply check
		# immediatly.
		#
		# Before the server state is check we need to check that
		# the firewall is still operational.  It will ocasionally
		# go out to lunch after changing the DHCP server state.

		&dprint("Waiting for firewall DHCP server to reconfigure ...");
		&wait_connect($curr_repository{LanIPAddr}, 5);

		# check DHCP server state
		&dprint("    Verifying that the DHCP server state changed " .
			"as requested ...");
		$curr_state = &get_dhcp_state;

		# If the DHCP server has not already reconfigured to the
		# requested state then give it just a little bit longer
		# to get caught up.
		if ($curr_state ne $requested_state) {
			&dprint("     DHCP server is not in the expected state " .
				"($requested_state), sleeping for retry ...");
			sleep 30;
			$curr_state = &get_dhcp_state;
		}

		# report the DHCP server state so we can tell what happened
		&dprint("      DHCP server is $curr_state " .
			"($requested_state was requested)");

		# update the repository
		# use the currently detected state to keep the repository in sync
		$curr_repository{LanDHCPSrv} = $curr_state;
		&update_repository;

		# exit if the DHCP server did not get updated as expected
		&exit_sub('DhcpStateErr') unless
			$curr_state eq $requested_state;

		&dprint("  DHCP server settings updated");
	}
}

#
# &get_dhcp_state()
#
# determine if LAN DHCP server is enabled or disabled.
#
sub get_dhcp_state
{
	my (@buffer) = ("");
	my ($dhcp_state, $line);
	my ($cmd_string) = "ip dhcp " . $lanIF . " stat" . "\n\n\n"; # enif0
	my ($idx) = 0;

	&dprint("      Getting current DHCP server state ...");

	&new_telnet;
	&nav_cli;

	# Depending on the state of the DHCP server the output will either
	# have a prompt or be a paged output.  Forunatly the second to last line of
	# each output ends with "Status:" so this can be used as the prompt.
	# The $cmd_string has new lines at the end so paged output will advance.
	# The extra newlines have no effect on the output.
	# This does not work with the standard prompt. (Don't know why.)
	$tnet->prompt('/Status:/');
	@buffer = $tnet->cmd($cmd_string);

	# parse first line of input buffer to determine current server state
	if ( @buffer eq ("") ) {
		$dhcp_state = "unknown";
		&dprint("      >>> get_dhcp_state() could not determine DHCP server " .
			"state");
	} elsif ( $buffer[0] =~ /server/ ) {
		&dprint("        DHCP server is enabled");
		$dhcp_state = "enabled";
	} elsif ( $buffer[0] =~ /none/ ) {
		&dprint("        DHCP server is disabled");
		$dhcp_state = "disabled";
	} else {
	   $dhcp_state = "unknown";
	   &dprint("      >>> unknown error retrieving dhcp server state");
	   while ( $idx <= $#buffer ) {
		  $line = $buffer[$idx];
		  &dprint($line);
		  $idx++;
	   }
	}

	# close the telnet connection
	$tnet->prompt($fwMenuPrompt);
	$tnet->cmd("exit");
	$tnet->prompt("//"); # ignore the prompt, we are closing the connection
	$tnet->cmd("99");
	&close_telnet;

	return($dhcp_state);
}

#
# &dns_server_cfg(<dns_server_addr>)
#
# configure customer DNS server address
#
# The DHCP server needs to be enabled.
#
sub dns_server_cfg
{
	my ($dns_server) = shift;
	my ($cmd_line) = "ip dhcp " . $lanIF . " server dnsserver "; # enif0

	&dprint("  Setting DNS server to $dns_server ...");
	if ( $curr_repository{LanDHCPSrv} eq "enabled" ) {
		# DHCP server is enabled, so see if we need to do anything at all
		if ( $curr_repository{LanDNSSrv} ne $dns_server ) {
			# set up a new telnet connection
			&new_telnet;

			# navigate to command interpreter
			&nav_cli;

			$tnet->cmd($cmd_line . $dns_server);

			# exit command interpreter and close telnet connection
			$tnet->prompt($fwMenuPrompt);
			$tnet->cmd("exit");
			$tnet->prompt("//"); # ignore the prompt, we are closing the connection
			$tnet->cmd("99");
			&close_telnet;
		}

	} else {
		 &dprint("  >> DHCP server not enabled - cannot specify DNS server");
		 $dns_server = "0.0.0.0";

		 # don't save the settings since they did not change
		 return;
	}

	# update the repository
	$curr_repository{LanDNSSrv} = $dns_server;
	&update_repository;

	&dprint("  DNS server settings updated");
}

#
# &set_lan_ip_cfg()
#
# set LAN configuration
#
# NOTE: This will drop the telnet session, unless the IP address
# given is the same as the current IP address.
#
sub set_lan_ip_cfg
{
	my ($fields) = 0;
	my ($curr_ip) = $curr_repository{LanIPAddr};
	my ($dhcp_state);

	&dprint("  Configuring LAN network settings ...");

	# If the desired address matches the current address then there is
	# nothing to do.  We are certain that this must be correct or the
	# verify_connection call at the beginning of the script would have
	# failed.
	if ( $in_vars{lan_ip_addr} eq $curr_ip ) {
		&dprint("    Desired LAN address matches current address");
		return;
	}

	# Determine the actualy DHCP state so we are certain to move correctly.
	$dhcp_state = &get_dhcp_state;
	if ( $dhcp_state eq 'enabled' ) {
		$fields = 5;
	} elsif ( $dhcp_state eq 'disabled' ) {
		$fields = 1;
	} else {
		&dprint("  >>> ERROR: unable to determine DHCP state and therfore " .
			"unable to configure LAN settings.");
		$tnet->close;
		&exit_sub('DhcpStateErr');
	}

	&dprint("    Changing the LAN configuration ...");
	&dprint("      LAN IP: $in_vars{lan_ip_addr}");
	&dprint("      LAN NETMASK: $curr_repository{LanSubnetMask}");

	# set up new telnet connection
	&new_telnet;
	$tnet->cmd('3');        # LAN setup menu
	$tnet->prompt('/Toggle/');
	$tnet->cmd('2');        # TCP/IP setup menu

	# set the LAN IP
	&fld_advance($fields);

	# the prompt is hard if not impossible to predict at this point
	# match any character as it means we got data (moved on)
	$tnet->prompt('/\w/');

	# set the LAN IP
	$tnet->cmd($in_vars{lan_ip_addr});

	# set the NetMask since the firewall clears this when the LAN IP changes
	$tnet->cmd($curr_repository{LanSubnetMask});

	# skip over the rest of the fields on the screen
	&fld_advance(2);

	$tnet->prompt($fwMenuPrompt);

	# this will commit the changes
	# and will cause the telnet connection to drop
	$tnet->cmd("");

	# close the telnet object to keep the agent sane
	&close_telnet;

	# store the new IP address
	# update the repository
	$curr_repository{LanIPAddr} = $in_vars{lan_ip_addr};
	&update_repository;

	&dprint("  LAN network settings updated");

	# update the routing tables
	&update_routing($curr_repository{LanIPAddr});

	# wait for firewall to reconfigure
	&dprint("  Waiting for firewall network interface to reconfigure ...");

	# The LAN interface seems to take a while to go down which
	# confuses the connectivity check so wait a little longer
	# for the interface to go down.
	&wait_connect($curr_repository{LanIPAddr}, 30);
}

#
# &exit_sub(ErrSemantic)
#
# exit with status
#
# ErrSemantic is the key used to lookup the exit status
# in the %errcodes hash.  This is also where cleanup
# actions are taken (creating the repository, backing up
# the firewall config)
#
sub exit_sub
{
    my ($status) = shift;
	my ($rc);

    #
    # save configuration (rom image)
	#
	# Only save changes if configuration was sucessful or we may
	# we saving a partial (dysfunctional) configuration and
	# delete a good backup.
    #
    if ($change_tracker eq "yes") {

		# If the firewall is not verified to be alive do a quick check as
		# it may be and it had simply not been tested.
		if ($firewall_alive eq "no") {
			if (&verify_connect($curr_repository{LanIPAddr}) ) {
				$firewall_alive = "yes";
			}
		}

		# If we are exiting since we cannot talk to the firewall do not
		# try to save the rom image.
		if ($firewall_alive eq "yes") {
			&dprint("Configuration changed: saving (rom) image ...");
			&backup_config;
		} else {
			&dprint(">>> WARNING: unable to save configuration changes " .
				"(rom image) since the firewall is not responding"); 
		}
    }

	# done accessing the firewall so release the lock
	# t4_rnid_cfg will grab the lock again
	&unblock_fw();

	# update RNID data if the WAN IP changed (includes unconfigure)
	if ( ($rnid_info_changed eq "yes") ) {
		&dprint("Updating RNID data on arrays ..."); 
		$rc = &update_rnid;

		# update the exit status with any errors codes that come from RNID
		if ($status eq "0") {
			$status = $rc;
		}
	}

    if ( ! exists $errcodes{$status} ) {
        $status = 'InternalErr';
    }

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

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

$scriptStartTime = time();

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

# 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 (no connection to firewall)
#

# 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');
}

# print usage information
if ($prt_usage) {
    &printUsage();
    &exit_sub('OK');
}


# print services information
if ($prt_services) {
    &print_services;
    &exit_sub('OK');
}

# ping: verify LAN <-> WAN connectivity
if ( exists $in_vars{ping} ) {
    &dprint("Testing connectivity ...");
    &exit_sub('HostUnReachable') unless
        (&verify_ping($in_vars{ping}));
    &exit_sub('OK');
}

#
##
### Start Configuration
##
#
&dprint("Starting firewall configuration ...");

# Actions from here down may access the firewall.
# Block access to protect the ability to reliably connect using telnet.
&block_fw;

#
# Order of Operations
#
# The is a method to the madness of operations connecting to the firewall.
#
# Exclusive operations, like unconfigure() which exit after being executed
# are done before non-exclusive operations.
#
# Some operation are dependent on the order like the DNS configuration must
# occur after DHCP configuration.
#
# Operations may be ordered to minimize time spent waiting for something.
#

#
# read stored repository, create working copy
#
&dprint("Reading repository ...");
&read_repository;

# initialize the repository
if ( exists $in_vars{init_repository} ) {
	&dprint("Initializing repository ...");
	&create_repository;
	&dprint("The repository has been initialized.");
	# don't do any firewall connectivity in exit_sub()
	$found_firewall = "skip";
	&exit_sub('OK');
}

#
# Verify connection to the Firewall
#
&dprint("Verifying connectivity to firewall ...");

# look for the firewall where we expect to find it
if (&verify_connect($curr_repository{LanIPAddr}) ) {
	$found_firewall = "yes";
} else {
	# we couldn't reach the firewall at the expected address
	&dprint("  >>> firewall not found at expected address: " .
		"$curr_repository{LanIPAddr}");
}

# try the default address (new_firewall)
if ($found_firewall ne "yes") {
    if ( $curr_repository{LanIPAddr} ne $def_repository{LanIPAddr} ) {
        &dprint("  >>> trying default address: $def_repository{LanIPAddr}");

        # try the default (new firewall) IP address
        if ( &verify_connect($def_repository{LanIPAddr}) ) {

			# If the firewall is found at the address of the new (unconfigured)
			# firewall then the safest thing to do is to assume the firewall
			# is new or unconfigured and restore the default configuration
			# just to make sure the configuration and repository are in sync
			# and to update the repository.
			$found_firewall = "yes";

            &dprint("  >>> firewall found at: $def_repository{LanIPAddr};");

            # restore the most recent configuration
            &dprint("  >>> restoring default configuration ...");
            &restore_config($def_repository{LanIPAddr}, $defCfgFile);

			# destroy the current repository
			%curr_repository = %def_repository;
			&create_repository;

			# update the routing tables
			&update_routing("new_firewall");

			# wait for the firewall to reboot
			&dprint("  Waiting for firewall to load the new configuration ...");
			&wait_connect($curr_repository{LanIPAddr}, 5);

			# reset the UniqueID as it may be different now
            $curr_repository{UniqueID} = "";
		} else {
			&dprint("  >>> firewall not found at: $def_repository{LanIPAddr}");
		}
	}
}

# go hunting for the firewall at possible addresses
#
# It should be a very rare occurance that the firewall is not found at the
# expected address or at the default address but in case this does happen
# then the firewall should be located as it will minimally allow the firewall
# to be unconfigured and reconfigured using the standard user interfaces.
#
# While the actual configuration of the firewall may not match the data in
# the repositiry the firewall may be fully functional and configured the
# way the customer wants.  This may lead to the firewall state being reported
# incorrectly but it's better to allow access to the firewall than to simply
# exit with an error that would require service.
#
# BUG: There are two minor issues with the way we search for a firewall.
#      The first is that we will retry the firewall that is listed in
#      the repository.  This is not really a big deal as is adds perhaps
#      30 seconds to the execution of the script and the script is trying
#      to deal with a strange situation as it si.
#      The second issue (which perhaps means the first issues is not a big deal)
#      is that if we retry the address in the repository and it works this
#      time the message saying we did not find the firewall at the expected
#      location is not really correct. (This has happened.)
#      To fix either problem we would have to be able to resolve hostnames
#      into IP addresses.
#      Both of these issues are not really worth the effort to fix do to
#      the their rare occurance and low impact on customers.
if ($found_firewall eq "no") {
	my ($index) = 0;
	while (($index < 8) && ($found_firewall ne "yes")) {
		&dprint("  >>> looking for firewall named: sp" . $index . "-firewall");
		if ( &verify_connect("sp" . $index . "-firewall") ) {
			$found_firewall = "yes";

            &dprint("  >>> firewall found named: sp" . $index . "-firewall");

			# update the repository with the address the firewall was found at
			$curr_repository{LanIPAddr} = "sp" . $index . "-firewall";
			&update_repository;

			# update the routing tables
			&update_routing("new_firewall");

			# wait for the firewall to reboot
			&dprint("  Waiting for firewall to load the new configuration ...");
			&wait_connect($curr_repository{LanIPAddr}, 5);

			# reset the UniqueID as it may be different now
            $curr_repository{UniqueID} = "";
		} else {
			&dprint("  >>> did not find firewall named: sp" . $index .
				"-firewall");
		}

		$index++;
	}

	if ($found_firewall ne "yes") {
		&dprint("ERROR: could not locate a functional firewall");
		&dprint("Exiting, have a little cleanup to do first ...");
		&exit_sub('FWNotFound');
	} else {
		print("WARNING: The firewall was found at an unexpected address, " .
			"the actual configuration may not match the data in the " .
			"repository.  The firewall may need to be " .
			"reconfigured to restore expected operation.\n");
	}
}

#
# firewall should be at a known IP address now so it's safe to use it
#

# make sure the UniqueID is set
if ($curr_repository{UniqueID} eq "") {
	&dprint("Getting the firewall's unique ID ...");
	$curr_repository{UniqueID} = &get_unique_id;
	&update_repository;
}

#
# unconfigure
#
if ( exists $in_vars{unconfigure} ) {
	# check to see if the WAN IP is going to change
	if ($curr_repository{WanIPAddr} ne "new_firewall") {
		$rnid_info_changed = "yes";
	}

    &dprint("Restoring default configuration ...");
    &restore_config($curr_repository{LanIPAddr}, $defCfgFile);

    # destroy the current repository
    %curr_repository = %def_repository;
    &create_repository;

	# update the routing tables
	&update_routing("new_firewall");

	# wait for the firewall to reboot
	&dprint("  Waiting for firewall to load the new configuration ...");
	&wait_connect($curr_repository{LanIPAddr}, 5);
	# if we get here then the firewall is alive
	# or wait_connect would have exited
	$firewall_alive = "yes";

	$runTime = time() - $scriptStartTime;
    &dprint("Firewall has been restored to the default configuration. " .
		"($runTime seconds)");

    &exit_sub('OK');
}

#
# get firmware version
#
if ( exists $in_vars{firmware_version} ) {
    &dprint("Checking firmware version ...");

    &exit_sub('HostUnReachable') unless
		&get_firmware_version;

    print("$firmware_version\n");

	&dprint("Exiting, starting housekeeping ...");
    &exit_sub('OK');
}

#
# upgrade firmware
#
if ( exists $in_vars{upgrade_firmware} ) {
    &dprint("Upgrading firmware (ras image) ...");

    &exit_sub('HostUnReachable') unless
		&upgrade_firmware;

    &dprint("Firewall configuration complete.");
	&dprint("Exiting, starting housekeeping ...");
    &exit_sub('OK');
}

#
# toggle port state
#
if ( exists $in_vars{toggle_port_state} ) {
	$startTime = time();
    &dprint("Modifying port state ...");
	&toggle_port_state;
	$runTime = time() - $startTime;
    &dprint("... finished modifying port state. ($runTime seconds)");
}

#
# set port value
#
if ( %port_vals ) {
	$startTime = time();
    &dprint("Modifying port values ...");

	# set the return code to a know value to determine if any ports were changed
	$rc = 'Reserved';

    foreach $key ( keys %port_vals ) {
		if ( $curr_repository{$key . "_port"} == $port_vals{$key} ) {
            &dprint("  new port value '$port_vals{$key}' for '$key' " .
				"matches existing repository value");
        } else {
			# change the main port
            $rc = &set_port_val($key, $port_vals{$key});

			# change the reply port if the main port worked
			if ( $rc eq 'OK' ) {
				$rc = &set_port_val($key . "_reply", $port_vals{$key});
			}

			# update the repository if the port was sucessfully modified
            if ( $rc eq 'OK' ) {
                $curr_repository{$key . "_port"} = $port_vals{$key};
			}
			&dprint("  '$key' is configured for port '$port_vals{$key}'");

        }
    }

	# update the repository only if a port value was changed
    if ( $rc ne 'Reserved') {
		&update_repository;
    }

	$runTime = time() - $startTime;
    &dprint("... finished modifying port values. ($runTime seconds)");
}

#
# set WAN addressing
#
# BUG: If you specify any of the following command line options:
#          wan_ip_addr, wan_subnet_mask, wan_gateway
#      But do not specify 'wan_addr_type static' then no configuration
#      changes are made and no warning is issued.
#
if ( exists $in_vars{wan_addr_type} ) {
	$startTime = time();
    &dprint("Modifying WAN connection ...");
    &set_wan_addr_type;
	$runTime = time() - $startTime;
    &dprint("... finished modifying WAN connection. ($runTime seconds)");
}

#
# set default port forwarding address
#
if (exists $in_vars{port_fwd_addr} ) {
	$startTime = time();
    &dprint("Modifying port forwarding address ...");
    &set_port_fwd_addr;
	$runTime = time() - $startTime;
    &dprint("... finished modifying port forwarding address. " .
		"($runTime seconds)");
}

#
# configure SP-LAN DHCP server
#
if ( exists $in_vars{dhcp_server} ) {
	$startTime = time();
	&dprint("Modifying DHCP server ...");
	&dhcp_srv_cfg;
	$runTime = time() - $startTime;
    &dprint("... finished modifying DHCP server. ($runTime seconds)");
}

#
# configure customer DNS server address
#
if ( exists $in_vars{dhcp_dns_server} ) {
	$startTime = time();
	&dprint("Modifying DNS server ...");
    &dns_server_cfg($in_vars{dhcp_dns_server});
	$runTime = time() - $startTime;
    &dprint("... finished modifying DNS server. ($runTime seconds)");
}

#
# set LAN addressing
#
if ( exists $in_vars{lan_ip_addr} ) {
	$startTime = time();
    &dprint("Modifying LAN connection ...");
    &set_lan_ip_cfg;
	$runTime = time() - $startTime;
    &dprint("... finished modifying LAN connection. ($runTime seconds)");
}

#
# changes are done, make sure connectivity is back
#
# It's importnat to ensure connectivity is back so it the script is executed
# again immediatly after it finishes the next execution is certain to work.
#
&dprint("Firewall changes complete.");
&dprint("Verifying connectivity to firewall ...");
&wait_connect($curr_repository{LanIPAddr}, 0);
# if we get here then the firewall is alive or wait_connect would have exited
$firewall_alive = "yes";

#
# Done!
#
$runTime = time() - $scriptStartTime;
&dprint("Firewall configuration complete. ($runTime seconds)");
&exit_sub($ret_code);
