#!/usr/bin/perl -I/usr/local/lib/perl5 --  # -*-Perl-*-
#
# dhcp_mon.pl -- script to monitor firewall for DHCP lease
#	changes
#
# Copyright 2002, 2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.
#
# ident	"@(#)dhcp_mon	1.4	04/02/24 SMI
#

require 5.005;

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

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

use strict;

################################################################
#
# local variables
#
################################################################

my ($version) = "1.4";
my ($prog,$path,$suffix);
my ($packageName) = "SUNWsespfw";
my ($filePath) = "/opt/" . ${packageName} . "/";
my ($rep_name) = "repository";
my ($fw_blocker) = "fw_access_block";
my ($tmp_name) = $rep_name . ".tmp";
my ($host_file) = '/etc/inet/hosts';
my ($change_tracker) = "no";
my ($wanIPaddr, $wanGW, $wanMask, $new_dns_server);
my (@buffer, @t4s);
my ($idx) = 0;
my ($idx2) = 0;
my ($ret_code) = 0;

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

#
# firewall variables
#
my ($fwMenuPrompt) = '/Number:/';
my ($fwCmdPrompt) = '/SE6x20> /';
my ($wanIF) = 'enif1';
my ($lanIF) = 'enif0';

my (%curr_repository);

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

#
# &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";
    $tnet->close;
    exit 10;
}

#
# &write_lock(filehandle) -- set an advisory write lock on
# a filehandle
#
sub write_lock
{
    my ($filehandle) = shift;
    flock ($filehandle, LOCK_EX) or
        die;
}

#
# &nb_write_lock(filehandle) -- set a non-blocking advisory
# write lock on a filehandle.  This call will return immediately
# if it cannot acquire the lock
#
sub nb_write_lock
{
    my ($filehandle) = shift;
    flock ($filehandle, LOCK_EX | LOCK_NB) or
        die;
}

#
# &read_lock(filehandle) -- set an advisory read lock on
# a filehandle
#
sub read_lock
{
    my ($filehandle) = shift;
    flock ($filehandle, LOCK_SH | LOCK_NB) or
        die;
}

#
# &unlock(filehandle) -- unlock a previously-locked filehandle
#
sub unlock
{
    my ($filehandle) = shift;
    flock ($filehandle, LOCK_UN) or
        die;
}

#
# &block_fw() -- block access to the firewall
# This routine sets a non-blocking write lock on the blocker
# file.
#
sub block_fw
{
    open BLOCKER, ">" . $filePath . $fw_blocker;
    &nb_write_lock(\*BLOCKER);
    print BLOCKER "$$\n";
}

#
# &unblock_fw() -- unblock access to the firewall
#
sub unblock_fw
{
    &unlock(\*BLOCKER);
    close BLOCKER;
}

#
# &convert_mask(hex subnetmask) -- convert a 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;

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

#
# &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);

    $ping = Net::Ping->new('icmp',1);
    $status = $ping->ping($pingHost);
    $ping->close;

    return($status);
}

#
# &read_repository() -- read the repository file into the
# "curr_repository" hash
#
sub read_repository
{
    my ($key,$value);
    my $rep_file = $filePath . $rep_name;

    if ( -e $rep_file ) {

      # open for reading
      $rep_file = "<" . $rep_file;
      open REPOSITORY, $rep_file or die;

      # lock the repository while we read it
      &read_lock(\*REPOSITORY);

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

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

    } else {
        exit 2;
    }

  return;
}

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

    open REPOSITORY, ">" . $filePath . $tmp_name or die;

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

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

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

    if ( ! rename $filePath . $tmp_name, $filePath . $rep_name ) {
        exit 3;
    }

    return;
}

#
# &new_telnet(<ip.addr>, <prompt>) -- set up a new Telnet connection
#
sub new_telnet
{
    my ($target) = shift;
    my ($prompt) = shift;
    my ($timeoutVal) = 10;
    my ($onErr) = 'return';

    # create a telnet object
    exit 4 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($prompt);

    # try to connect
    exit 5 unless
        ($tnet->open(Host => $target));

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

#
# &close_telnet() -- close the telnet connection
#
sub close_telnet
{
    $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);
}

#
# &nav_cli() -- navigate to firewall's command mode interpreter
#
# This routine assumes a Telnet connection has been established ($tnet)
#
sub nav_cli
{
    # navigate to the maintenance screen
    $tnet->cmd('24');		# System Maintenance

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

#
# &dns_server_cfg() -- configure customer DNS server address
#
sub dns_server_cfg
{
    my ($cmd_line) = "ip dhcp " . $lanIF . " server dnsserver ";

    if ( $curr_repository{LanDHCPSrv} eq "enabled" ) {
        $tnet->cmd($cmd_line . $new_dns_server);
    }

    return ($new_dns_server);
}

#
# &get_new_info() -- get current WAN IP address & related info
#
sub get_new_info
{
    my ($if_cmd) = "ip ifconfig " . $wanIF;
    my ($dhcp_cmd) = "ip dhcp " . $wanIF . " stat";
    my ($cap1, $cap2, $cap3);
    my ($idx) = 0;

    &nav_cli;

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

        $idx++;
    }

    $idx = 0;
    @buffer = $tnet->cmd($dhcp_cmd);
    while ( $idx <= $#buffer ) {
        foreach ($buffer[$idx]) {
            /DNS server/ and do {
                ($cap1, $cap2) = split /:/, $buffer[$idx];
                ($new_dns_server, $cap1) = split ',', $cap2;
                chomp $new_dns_server;
                $new_dns_server =~ s/ //g;
            };

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

       $idx++;
    }
}

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

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

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

#
# read stored repository, create working copy
#
&read_repository;

if ( $curr_repository{WanAddrType} eq "dynamic" ) {

    exit 7 unless
        &verify_connect($curr_repository{LanIPAddr});

    &block_fw;

    &new_telnet($curr_repository{LanIPAddr}, $fwMenuPrompt);

    &get_new_info;

    if ( $wanIPaddr ne $curr_repository{WanIPAddr} ) {
         $curr_repository{WanIPAddr} = $wanIPaddr;
         $curr_repository{WanSubnetMask} = $wanMask;
         $curr_repository{WanGateway} = $wanGW;
         $curr_repository{LanDNSSrv} = &dns_server_cfg;
         $change_tracker = "yes";
    }

    &close_telnet;

    &unblock_fw;
}

#
# cleanup
#
if ( $change_tracker eq "yes" ) {
    &create_repository;

    # call agent to configure T4 RNID params
    # (need return code checking here)
    $ret_code = 0xffff & system "/usr/local/bin/t4_rnid_cfg";

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

#
# time to go
#
exit $ret_code;
