#!/usr/bin/perl -w
#
# peek.pl - walk up the IP stack looking for problems.
#
# 6/7/06 bet

use strict ;

use Getopt::Long qw(:config gnu_compat no_ignore_case no_debug) ;

`uname` =~ /FreeBSD/ or die "Program is for FreeBSD" ;

my %opt =
  ( 'router' => '192.168.2.1'
  ) ;

GetOptions( 'r|router' => \$opt{ 'router' } )
  or die ;

# Definitions
my $localnet = "127.0.0.1" ;  # Should get this from "hosts" file.

# Files we need.
my $resolv = "/etc/resolv.conf" ;  # To get the nameservers from.
my $hosts  = "/etc/hosts" ;        # To get "localhost" from.

# Commands
my $short_ping  = q(ping -t1 -c1 -n) ;
my $dig_cmd     = q(dig) ;
my $dig_options = q(+short +tries=1 +time=2) ;
my $config_cmd  = q(ifconfig) ;
my $status_cmd  = q(netstat -rn) ;

# Hold found routes.
my @net ;
my $token ;
my $host ;

# Subroutines
#
sub check_interface
{
  # Options: -d interface down; -u: interface up
  my ( $option, $message ) = @_ ;

  my @ifs = qx{ $config_cmd $option } ;
  return unless scalar @ifs ;

  @ifs = map { m/^([a-z]+[0-9]):/ ? $1 : () } @ifs ;
  print scalar @ifs, $message ;
  print "\t$_\n" foreach @ifs ;
  return @ifs ;
}

sub ping_host
{
  my ( $host, $show_msg ) = @_ ;

  my $cmd = join ' ', $short_ping, $host, '>/dev/null 2>&1' ;
  my $rc  = system( $cmd ) == 0 ;

  printf "%s\n", $rc ? 'working.' : '***FAILED***' if $show_msg ;
  return $rc ;
}


# Abnomal exit point.  Used for network errors. Use "die" for program errors.
sub bail
{  # Tell the user we can't continue.
  print shift @_ ;
  print "\nCan't continue tests.\n" ;
  exit 1 ;
}

sub print_check_msg
{
  my ( $chk, $what ) = @_ ;
  printf '%-26s', 'Checking ' . $chk ;
  printf '%-14s', $what if defined $what ;
}

# Find any interfaces marked "down"
check_interface( "-d", " interfaces down:\n" ) ;

# Find any interfaces marked "up"
my @ifs = check_interface( "-u", " interfaces up:\n" ) ;

# Check localhost direct
print_check_msg( "localnet:", $localnet ) ;
ping_host( $localnet, 'print' ) ;

# Check local host via lookup
print_check_msg( '"localhost" ', '' ) ;
ping_host( "localhost", 'print' ) ;

# Find address of remaining interfaces.
# Check it
my $count = 0 ;
foreach my $ifs ( @ifs )
{
  next if $ifs eq 'lo0' ;
  @net = grep m/inet /, split /\n/, qx{$config_cmd $ifs} ;
  unless ( scalar @net )
  {
    print "$ifs: No inet record found.\n" ;
    next ;
  }
  if ( $net[0] =~ m/( (?:[0-9]+[.]){3} [0-9]+)/x )
  {
    print_check_msg( "interface $ifs:", $1 ) ;
    ping_host( $1, 'print' ) and $count++;
  }
}

if ( $count == 0 ) { bail "No external interfaces!!!" }
print "$count external interface", ( $count == 1 ) ? '' : 's', " found.\n" ;

# Find default route and check
@net = grep m/default/, split '\n', `$status_cmd` ;
if ( scalar @net == 0 ) { bail "No default route!" }
if ( scalar @net >= 2 ) { bail "Multiple default routes!" }

# Could be on different subnets??
( $token, $host ) = split ' ', $net[ 0 ] ;  #awk compatible pattern.
print_check_msg( "Default route:", $host ) ;
ping_host( $host, 'print' ) ;

print_check_msg( "default router:", $opt{ 'router' } ) ;
ping_host( $opt{ 'router' }, 'print' ) ;

#       Could we maybe use TTL to resolve next hop? So we don't hardcode it.
#               Otherwice we have to get it from the router.
#               "ping -m3  $DNS" works, but would break if ??.

#       lookup DNS in /etc/resolv.conf
#               Check DNS
#
-e $resolv or die "$resolv file ***missing ***" ;
open FH, '<' , $resolv or die "Open $resolv failed: $!" ;

while ( <FH> )
{
  next if length $_ < 10 ;

  ( $token, $host ) = split ' ' ;  #awk compatible pattern.
  next if $token ne "nameserver" ;

  print_check_msg( "DNS host:" ) ;
  qx{$dig_cmd \@$host -x $host $dig_options} =~ m/([\w.]+)/ ;

  printf "%s\n", $? == 0 ? "$1 working." : "$host ***FAILED***!" ;
}

close FH or die "Close $resolv failed: $!" ;

# Normal program termination.
exit 0 ;
__END__