#!/usr/bin/perl -w

use strict;
use Getopt::Long;
use Net::Ping;

my $opt_a = undef;
my $opt_A = undef;
my $opt_e = undef;
my $opt_f = undef;
my $opt_h = undef;
my $opt_P = "http";
my $opt_s = undef;
my $opt_t = 8000;
my $opt_u = undef;
my $opt_v = undef;
my $hostsfile = undef;

sub usage {
  # Lazy usage - just dump my pod to STDOUT
  exec("pod2text ".__FILE__)
    or exit(1);
}

Getopt::Long::Configure("no_ignore_case");
&usage() unless
  (GetOptions
   "alive"      => \$opt_a,
   "Address"    => \$opt_A,
   "elapsed"    => \$opt_e,
   "file=s"     => \$opt_f,
   "help"       => \$opt_h,
   "Port=s"     => \$opt_P,
   "service"    => \$opt_s,
   "timeout=n"  => \$opt_t,
   "unreachable"=> \$opt_u,
   "version"    => \$opt_v,
   and !$opt_h);

if ($opt_v) {
  my $Id = $0;
  # Just print the version and exit
  print "$Id: fping,v 1.9 2003/03/04 15:39:46 rob Exp $/";
  exit(0);
}

if ($opt_a && $opt_u) {
  print STDERR "$0: Cannot specify both -a and -u\n";
  sleep 2;
  &usage();
}

my @hosts;
if (@ARGV) {
  if ($opt_f) {
    print STDERR "$0: Cannot specify hosts from both commandline and -f hostsfile\n";
    sleep 2;
    &usage();
  } else {
    @hosts = @ARGV;
  }
} else {
  if ($opt_f) {
    $hostsfile = $opt_f;
  } else {
    $hostsfile = "-";
  }
}

if ($hostsfile) {
  open (HOSTS, "$hostsfile");
  while (<HOSTS>) {
    push @hosts, split;
  }
  close HOSTS;
}

my $p = new Net::Ping "syn", $opt_t/1000;
if ($opt_s) {
  $p->tcp_service_check($opt_s);
}
if ($opt_e) {
  if (eval {require Time::HiRes;}) {
    $p->hires;
  } else {
    print STDERR "$0: Module Time::HiRes required when -e specified.\n";
  }
}

$p->{port_num} = $opt_P=~/^\d+$/?$opt_P:getservbyname($opt_P, "tcp")
  or die "$0: Invalid tcp service [$opt_P]\n";
my %syn;
foreach my $host (@hosts) {
  my ($ret,$nslookup_duration,$ip) = $p->ping($host);
  if ($ret) {
    $syn{$host} = $ip;
  } else {
    print STDERR "$host address not found\n";
  }
}
while (my ($host,$rtt,$ip) = $p->ack) {
  if ($opt_a || !$opt_u) {
    print $opt_A?$ip:$host;
    print " is alive" unless $opt_a;
    printf(" (%.3f ms)",$rtt*1000) if $opt_e;
    print "\n";
  }
  delete $syn{$host};
}

if (!$opt_a || $opt_u) {
  foreach my $host (keys %syn) {
    print $opt_A?$syn{$host}:$host;
    print " is unreachable" unless $opt_u;
    print "\n";
  }
}
__END__

=head1 NAME

fping - pings multiple hosts at once

=head1 SYNOPSIS

  fping [ options ] [ hosts ]
    or
  fping [ options ] -f hosts_file
    or
  fping [ options ] < hosts_file

=head1 DESCRIPTION

fping is a ping(1) like program which attempts a TCP connection
on a specific port to determine if a host is up.  fping is different
from ping in that you can specify any number of hosts on the
command line.  Instead of trying one host until it timeouts or
replies, fping will send out a ping packet and move on to the next
host in a round-robin fashion. If a host replies, it is noted and
removed from the list of hosts to check. If a host does not respond
within a certain time limit, it will be considered
unreachable.

=head1 OPTIONS

B<-a>   Show systems that are alive.

B<-A>   Display targets by address rather than DNS name.

B<-e>   Show elapsed (TCP SYN/ACK) time of packets.
Requires Time::Hires module to be installed.

B<-f> hostsfile   Read list of hosts from hostsfile.
Default is to read from STDIN.

B<-h>   Print this usage message.

B<-P> port   Specify the port to connect to on the target host.
It may be a numeric port or a service name.  Default is http.

B<-s>   Specify that the remote service should be on and listening
in order to report as alive.  The default behaviour is to report
the remote server as alive even when ECONNREFUSED is returned for
the tcp connection attempt.

B<-t> timeout   Target timeout in milliseconds that the TCP
three-way handshake must be completed by (default 8000 ms).
timeout is only effective as multiples of 1000 unless (-e)
is specified.  This does not consider retries and backoff
factors since that is built in to the TCP protocol itself.
This is just the total maximum time.

B<-u>   Show targets that are unreachable.

B<-v>   Print fping version information.

=head1 THANKS

This perl script was inspired by the fping utility (written in C)
originally by Roland Schemers now maintained by Thomas Dzubin.

Official fping website:  http://www.fping.com/

Some differences are as follows:
  Written in Perl using a Net::Ping backend.
  Does not require root privileges to run.
  Uses TCP instead of ICMP (heavier network traffic).
  Can determine reachability of a host even
  if ICMP protocol is blocked as long as a
  TCP port is open and listening on the host.

=head1 AUTHOR

bbb@cpan.org (Rob Brown)

$Header: /usr/local/cvsroot/freeware/Net-Ping/demo/fping,v 1.9 2003/03/04 15:39:46 rob Exp $

$CVSROOT :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware

=head1 COPYRIGHT

Copyright (c) 2002, Rob Brown.  All rights reserved.

This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.

=cut