#! /usr/bin/perl

use strict ;
use warnings ;

use Socket ;
use Net::Netmask ;
use Net::Ping ;

my $ROUTE = 'ip route show' ;
my $IPPAT = qr{(\d{1,3})(\.\d{1,3}){3}} ;

my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-f] args
option v : be verbose
option q : be quiet
option d : show debug info
option f : action ; otherwise dry-run
USAGE
sub Usage { die "$_[0]$Usage" ; }
sub Error { die "[error] $prog: $_[0]\n" ; }
sub Warn  { warn "[warn] $prog: $_[0]\n" ; }

# usage: &GetOptions(ARG,ARG,..) defines $opt_ID as 1 or user spec'ed value
# usage: &GetOptions(\%opt,ARG,ARG,..) defines $opt{ID} as 1 or user value
# ARG = 'ID' | 'ID=SPC' | 'ID:SPC' for no-arg, required-arg or optional-arg
# ID  = perl identifier
# SPC = i|f|s for integer, fixedpoint real or string argument

use Getopt::Long ;
Getopt::Long::config ( 'no_ignore_case' ) ;
my %opt = () ; Usage '' unless GetOptions
  ( \%opt, qw(v q d f) ) ;
Usage("Arg count\n") unless @ARGV >= 0 ;

$opt{v} ||= $opt{d} ;

# default via 131.211.31.129 dev eth0 
# 131.211.31.128/25 dev eth0  proto kernel  scope link  src 131.211.31.204 
# 169.254.0.0/16 dev eth0  scope link  metric 1002 

sub get_block
  { my $res ;
    my $gate ;
    my @lines ;
    print "running $ROUTE ...\n" if $opt{d} ;
    if ( open ROUTE, '-|', $ROUTE )
      { @lines = <ROUTE> ;
        close ROUTE ;
      }
    else
      { Error "can't popen $ROUTE ($!)" ; }
    Error "no lines" unless @lines ;
    my $line = ( grep /^default\s/, @lines ) [ 0 ] ;
    $gate = ( split ' ', $line ) [ 2 ] ;
    Error "no default route" unless defined $gate ;
    for my $line ( @lines )
      { if ( $line =~ m!^$IPPAT/\d+\s! )
          { printf "match $line" if $opt{d} ;
            my $cidr = ( split ' ', $line ) [ 0 ] ;
            my $blck = Net::Netmask -> new ( $cidr ) ;
            $res = $blck if $blck -> match ( $gate ) ;
          }
        last if defined $res ;
      }
    ( $gate, $res ) ;
  }

sub hnam
  { my $ip  = shift ;
    my $res = '' ;
    if ( my $iaddr = inet_aton $ip )
      { if ( my $name = gethostbyaddr ( $iaddr, AF_INET ) )
          { $res = $name ; }
        else
          { $res = 'no name' ; }
      }
    else
      { $res = 'no addr' ; }
    $res ;
  }

sub max
  { return undef unless @_ ;
    my $res = shift ;
    for ( @_ ) { $res = $_ if $res < $_ ; }
    $res ;
  }

sub W { max map { length $_ } @_ ; }

my ( $gate, $block ) = get_block ;
my $base = $block -> base ;
my $bcst = $block -> broadcast ;
my $host = `hostname` ; chomp $host ;
my $addr = pop @{ [ split ' ', `host $host` ] } ;

printf "host %s %s\ndefault gateway : %s\n", $host, $addr, $gate ;
printf "block %s base %s broadcast %s\n"
  , ( $block || '<undef>' ), $base, $bcst ;

my @ips = $block -> enumerate ; shift @ips ; pop @ips ;

for my $ip ( @ips )
  { printf "ip %s\n", $ip if $ip eq $base or $ip eq $bcst ; }

printf "ping %d ips ; %s .. %s\n"
  , ( scalar @ips )
  , $ips [ 0 ]
  , $ips [ $#ips ]
  ;

my $p = Net::Ping -> new ( "syn" ) ;

for my $ip ( @ips )
  { printf "ping %s\n", $ip if $opt{d} ; $p -> ping ( $ip ) ; }

my %ips = () ;
my %hws = () ;
my $CMD = 'ip neigh' ;
open CMD, '-|', $CMD or Error "can't popen $CMD ($!)" ;
while ( <CMD> )
  { next unless /lladdr ([a-f0-9:]+)/i ;
    my $hw = $1 ;
    my $ip = ( split ' ', $_ ) [ 0 ] ;
    $ips { $hw } = [] unless exists $ips { $hw } ;
    push @{ $ips { $hw } }, $ip ;
    $hws { $ip } = $hw ;
  }

if ( $opt{v} )
  { my $W = W keys %hws ;
    for my $ip ( sort keys %hws )
      { printf "ip %-${W}s hwaddr %s %s\n", $ip, $hws { $ip }, hnam $ip ; }
  }

for my $hw ( sort keys %ips )
  { my $lst = $ips { $hw } ;
    my $W   = W @$lst ;
    if ( @$lst > 1 )
      { printf "multiple ips for %s\n  %s\n", $hw, join "\n  ", sort
          map { sprintf "%-${W}s %s", $_, hnam $_ ; } @$lst ;
      }
  }