#! /usr/bin/perl

use strict ;
use warnings ;
use Net::Ping ;

our $DEF_HOSTS   = '/etc/hosts' ;
our $DEF_RANGE   = '/usr/local/bin/nodesrange' ;
our $DEF_LPING   = '/local/lib/ping-cluster' ;
our $DEF_PORT    = 'ssh' ;
our $DEF_TIMEOUT = 1 ;
our $TAG0 = qr{^# range-cluster}i ;
our $TAG1 = qr{^# begin-cluster}i ;
our $TAG2 = qr{^# end-cluster}i ;

my $prog = substr $0, rindex ( $0, '/' ) + 1 ;
my $Usage = <<USAGE ;
Usage: $prog [-v] [-q] [-d] [-u] [-t timeout] [hosts-file]
option v : be verbose
option q : be quiet
option d : show debug info
option p : send 'syn' to port <p> ; default '$DEF_PORT'
option u : only report the number of unreachable hosts ;
           prints nothing if the host-list is empty
option n : don't ping ; just print the hostnames ; implies -v
option t : use <timeout> [seconds] ; default $DEF_TIMEOUT
===================================================
$prog sends a 'syn' package to the specified hosts/port ;
-- then it waits for the corresponding 'acks'.
Argument hosts-file : default $DEF_HOSTS
-- $prog searches the hosts-file and picks hosts between lines matching :
     start : $TAG1
     end   : $TAG2
-- $prog also searches for a line like :
      $TAG0 [nodesrange-file]
   default nodesrange-file : $DEF_RANGE
   The nodesrange-file must contain a RANGE-line like (either/or) :
     RANGE=alpha_name[num|num1-num2, ...]
     RANGE=NameNum1..NameNum2
   -- whitespace is ignored
   -- 'RANGE' may be preceeded by "export "
   Examples :
     RANGE=blib[14,15,22-28,72,100-102]
     export RANGE=blob007..blob022
-- or else, $prog uses host-list $DEF_LPING
    The host-list should contain one host per line.
===================================================
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 p=s u n t=i) ) ;
Usage "Arg count\n" unless @ARGV <= 1 ;

$opt{v} ||= $opt{d} ;
$opt{v} ||= $opt{n} ;
$opt{t} ||= $DEF_TIMEOUT ;
$opt{p} ||= $DEF_PORT ;

my $HOSTS = shift || $DEF_HOSTS ;

Error "no hosts-file [$HOSTS]" unless -f $HOSTS ;

sub by_name
  { my ( $pa, $na, $pb, $nb ) ;
    ( $pa, $na ) = ( $1, $2 ) if $a =~ /^([^\d]*)(\d+)$/ ;
    ( $pb, $nb ) = ( $1, $2 ) if $b =~ /^([^\d]*)(\d+)$/ ;
    if ( defined $pa and defined $pb and $pa eq $pb )
      { $na <=> $nb ; }
    else
      { $a cmp $b ; }
  }

sub expnd
  { my $nam = shift ;
    my $num = shift ;
    my @res = () ;
    if ( $num =~ /-/ )
      { Error "bad sub-range [$num]" unless $` <= $' ;
        push @res, "$nam$_" for $` .. $' ;
      }
    else
      { push @res, "$nam$num" ; }
    @res ;
  }

sub get_hosts
  { my $file = shift ; $file =~ s/\s//g ; $file ||= $DEF_RANGE ;
    print "using range file $file\n" if $opt{v} ;
    my $RANG ;
    open FILE, '<', $file or Error "can't open $file ($!)" ;
    while ( <FILE> ) { chomp ; $RANG = $2 if /^(export\s+)?RANGE=(.*)/ ; }
    close FILE ;
    Error "no RANGE found in $file" unless defined $RANG ;
    $RANG =~ s/\s//g ;
    print "RANG 1 [$RANG]\n" if $opt{v} ;
    if ( $RANG =~ m/([a-z]+)(\d+)\.\.([a-z]+)(\d+)/ )
      { Error "bad RANGE [$RANG] ; '$1' != '$3'" unless $1 eq $3 ;
        $RANG = sprintf '%s[%s-%s]', $1, $2, $4 ;
      }
    print "RANG 2 [$RANG]\n" if $opt{v} ;
    my $pat = qr{(\d+(-\d+)?)} ;
    Error "bad RANGE [$RANG]"
      unless $RANG =~ /(\w+)\[($pat(,$pat)*)\]/ ;
    my $name = $1 ;
    my $rang = $2 ;
    print "name [$name] rang [$rang]\n" if $opt{v} ;
    my @res = () ; push @res, expnd $name, $_ for split ',', $rang ;
    @res ;
  }

my @hosts = () ;
my %pings = () ;
my $skip  = 1 ;
my $tags  = 0 ;
my $file  = undef ;
my $cnt   = 0 ;
open HOSTS, '<', $HOSTS or Error "can't open $HOSTS ($!)" ;
while ( my $line = <HOSTS> )
  { $cnt ++ ;
    chomp $line ;
    if ( $skip )
      { Error "bad end-tag [line $.]" if $line =~ $TAG2 ;
        $skip = 0  if $line =~ $TAG1 ;
        $file = $' if $line =~ $TAG0 ;
      }
    else
      { Error "bad begin-tag [line $.]" if $line =~ $TAG1 ;
        $skip = 1 if $line =~ $TAG2 ;
      }

    unless ( $skip )
      { $tags = 1 ;
        next if $line =~ /^#/ or $line =~ /^\s*$/ ;
        my ( $IP, $hnam ) = ( split ' ', $line ) [ 0, 1 ] ;
        push @hosts, $hnam ;
      }
  }
close HOSTS ;

Error "missing end-tag in $HOSTS" if $tags and ! $skip ;
# Error "no cluster-tag found in $HOSTS" unless $tags or defined $file ;

if ( -f $DEF_LPING )
  { print "using range in $DEF_LPING\n" if $opt{v} ;
    open LIST, '<', $DEF_LPING or Error "can't open $DEF_LPING ($!)" ;
    while ( <LIST> )
      { chomp ;
        s/^\s+// ;
        s/\s+$// ;
        next if /^$/ ;
        next if /^#/ ;
        push @hosts, ( split ' ', ) [ 0 ] ;
      }
  }
elsif ( defined $file )
  { @hosts = get_hosts $file ; }
else
  { Error "no cluster-tag found in $HOSTS ; no $DEF_LPING" ; }

printf "hosts [%s]\n", join ',', @hosts if $opt{v} ;
# quit on $opt{n}
exit if $opt{n} ;

my $W    = 0 ;
my $port = $opt{p} =~ /^\d+$/ ? $opt{p} : getservbyname ( $opt{p}, "tcp" ) ;
Error "bad port [$opt{p}]" unless defined $port ;

print "using port[$port]\n" if $opt{v} ;

my $ping = Net::Ping -> new ( 'syn' ) ;
$ping -> { port_num } = $port ;

for my $hnam ( @hosts )
  { $ping -> hires ( 1 ) ;
    $ping -> ping ( $hnam, $opt{t} ) ;
    $pings { $hnam } = undef ;
    $W = length $hnam if length $hnam > $W ;
  }

while ( my ( $host, $rtt, $ip ) = $ping -> ack )
  { $pings { $host } = $rtt ; }

my @no_ping = grep ! defined $pings { $_ }, keys %pings ;

# quit on $opt{u}
if ( $opt{u} )
  { printf "%s\n", scalar @no_ping if @hosts ;
    exit ;
  }

for my $host ( sort by_name keys %pings )
  { my $rtt = $pings { $host } ;
    printf "%-${W}s [%s]\n"
      , $host
      , ( ( defined $rtt )
        ? $rtt
        : $ping -> nack ( $host ) || 'no reason'
        ) ;
  }

my $no_ping = @no_ping ? join ',', @no_ping : 'NONE' ;
if ( @hosts )
  { printf "$prog: can't ping [%s]\n", $no_ping ; }
else
  { printf "no hosts found in $HOSTS\n" ; }