package Monitor::ping;

# Author:   Thomas Aeby
#
# Author:   mose@ccsn.edu (Russell Mosemann)
#
# Authors of the original pingecho():
#           karrer@bernina.ethz.ch (Andreas Karrer)
#           pmarquess@bfsec.bt.co.uk (Paul Marquess)
#
# Copyright (c) 1996 Russell Mosemann.  All rights reserved.  This
# program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

require 5.002;
require Exporter;

use strict;
use vars qw(@ISA @EXPORT $VERSION
            $def_timeout $def_proto $max_datasize);
use FileHandle;
use IPC::Open2;
use IPC::Open3;
use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
               inet_aton inet_ntoa sockaddr_in);
use Carp;

@ISA = qw(Exporter Monitor::Monitor);
@EXPORT = qw(pingecho);
$VERSION = 2.02;

# Constants

$def_timeout = 5;           # Default timeout to wait for a reply
$def_proto = "udp";         # Default protocol to use for pinging
$max_datasize = 1024;       # Maximum data bytes in a packet

# Description:  The new() method creates a new ping object.  Optional
# parameters may be specified for the protocol to use, the timeout in
# seconds and the size in bytes of additional data which should be
# included in the packet.
#   After the optional parameters are checked, the data is constructed
# and a socket is opened if appropriate.  The object is returned.

sub new
{
    my ($this,
        $proto,             # Optional protocol to use for pinging
        $timeout,           # Optional timeout in seconds
        $data_size,         # Optional additional bytes of data
	$pingcmd	    # Used by "external" protocol
        ) = @_;
    my  $class = ref($this) || $this;
    my  $self = {};
    my ($cnt,               # Count through data bytes
        $min_datasize       # Minimum data bytes required
        );

    bless($self, $class);

    $proto = $def_proto unless $proto;          # Determine the protocol
    croak("Protocol for ping must be \"tcp\", \"udp\", \"icmp\", \"fping\", or \"external\"")
        unless $proto =~ m/^(tcp|udp|icmp|karl|external|fping)$/;
    $self->{"proto"} = $proto;

    $timeout = $def_timeout unless $timeout;    # Determine the timeout
    croak("Default timeout for ping must be greater than 0 seconds")
        if $timeout <= 0;
    $self->{"timeout"} = $timeout;

    $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
    unless( defined $data_size ) {
	$data_size = $min_datasize;
	$data_size = 20 if( $proto eq "icmp" );
    }
    croak("Data for ping must be from $min_datasize to $max_datasize bytes")
        if ($data_size < $min_datasize) || ($data_size > $max_datasize);
    $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
    $self->{"data_size"} = $data_size;

    $self->{"data"} = "";                       # Construct data bytes
    for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
    {
        $self->{"data"} .= chr($cnt % 256);
    }

    $self->{"seq"} = time & 65536;              # For counting packets
    if ($self->{"proto"} eq "udp")              # Open a socket
    {
        $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
            croak("Can't udp protocol by name");
        $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
            croak("Can't get udp echo port by name");
        $self->{"fh"} = FileHandle->new();
        socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
               $self->{"proto_num"}) ||
            croak("udp socket error - $!");
    }
    elsif ($self->{"proto"} eq "icmp")
    {
        croak("icmp ping requires root privilege") if $>;
        $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
                    croak("Can't get icmp protocol by name");
        $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
        $self->{"fh"} = FileHandle->new();
        socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
            croak("icmp socket error - $!");
    }
    elsif ($self->{"proto"} eq "tcp")           # Just a file handle for now
    {
        $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
            croak("Can't get tcp protocol by name");
        $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
            croak("Can't get tcp echo port by name");
        $self->{"fh"} = FileHandle->new();
    }
    elsif ($self->{"proto"} eq "external")
    {
	$self->{"pingcmd"} = $pingcmd;
    }

    my( @bla)  = ();
    $self->{"htable"} = \@bla;

    return($self);
}


sub add_hosts {
    my( $self ) = shift;
    my( $htable, $host, $item ) = $self->{"htable"};

    while( @_ ) {
	$host = shift;
	$item = shift;
	($item = "$host.conn") unless( $item );
	push( @$htable, $host, $item );
    }
}

# Description: Ping a host name or IP number with an optional timeout.
# First lookup the host, and return undef if it is not found.  Otherwise
# perform the specific ping method based on the protocol.  Return the 
# result of the ping.

sub check
{
    my ($self) = @_;
    my (%ret, %ip, $host, $i, @list, %result, $timeout, $ret );
    my( $htable ) = $self->{"htable"};

    $timeout = $self->{"timeout"} unless $timeout;
    @list = @$htable;

    for( $i=0; $i<=$#list; $i+=2 ) {
	my $hip = inet_aton($list[$i]);
	($ip{$hip} = $list[$i+1]) if( $hip );
    }

    if ($self->{"proto"} eq "udp")
    {
        %ret = $self->ping_udp($timeout, %ip);
    }
    elsif ($self->{"proto"} eq "icmp")
    {
        %ret = $self->ping_icmp($timeout, %ip);
    }
    elsif ($self->{"proto"} eq "tcp")
    {
        %ret = $self->ping_tcp($timeout, %ip);
    }
    elsif ($self->{"proto"} eq "external")
    {
	%ret = $self->ping_external($timeout, %ip);
    }
    elsif ($self->{"proto"} eq "karl")
    {
        %ret = $self->ping_karl($timeout, %ip);
    }
    elsif ($self->{"proto"} eq "fping")
    {
        %ret = $self->ping_fping($timeout, %ip);
    }
    while( ($i,$ret) = each %ret ) {
	my ($code, $resp);
	#print "Reporting for i=",$i," ret=",$ret," \@\$ret=@$ret\n";
	#print "Items $#$ret\n";
	for (my ($j)=0; $j <= $#$ret; $j+=2) {
	    ($code, $resp) = ($ret->[$j],$ret->[$j+1]);
	    #print "Popped item code=",$code," resp=",$resp,"\n";
	    $self->report( $i, $code, $resp );
	    #sleep 1;
	}
	#sleep 1;
#	$self->report( $i, $ret->[0], $ret->[1] );
    }
}

sub ping_icmp
{
    my ($self, $timeout, %ip ) = @_;

    my ($ip, %ret );
    my $ICMP_ECHOREPLY = 0; # ICMP packet types
    my $ICMP_ECHO = 8;
    my $icmp_struct = "C2 S3 A";  # Structure of a minimal ICMP packet
    my $subcode = 0;        # No ICMP subcode for ECHO and ECHOREPLY
    my $flags = 0;          # No special flags when opening a socket
    my $port = 0;           # No port with ICMP

    my ($saddr,             # sockaddr_in with port and ip
        $checksum,          # Checksum of ICMP packet
        $msg,               # ICMP packet to send
        $len_msg,           # Length of $msg
        $rbits,             # Read bits, filehandles for reading
        $nfound,            # Number of ready filehandles found
        $finish_time,       # Time ping should be finished
        $done,              # set to 1 when we are done
        $recv_msg,          # Received message including IP header
        $from_saddr,        # sockaddr_in of sender
        $from_port,         # Port packet was sent from
        $from_ip,           # Packed IP of sender
        $from_type,         # ICMP type
        $from_subcode,      # ICMP subcode
        $from_chk,          # ICMP packet checksum
        $from_pid,          # ICMP packet id
        $from_seq,          # ICMP packet sequence
        $from_msg,           # ICMP message
	$now
        );

    $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence

    $done = 0;
    $finish_time = time() + $timeout;       # Must be done by this time
    $now = 0;
    while (!$done && $timeout > 0)          # Keep trying if we have time
    {
	if( time - $now >= 1 ) {
	    foreach $ip (keys %ip) {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "icmp-ping FAILURE" ];
		$checksum = 0;                          # No checksum for starters
		$msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
			    $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
		$checksum = Monitor::ping->checksum($msg);
		$msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
			    $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
		$len_msg = length($msg);
		$saddr = sockaddr_in($port, $ip);
		send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
	    }
	    $now = time;
	}
        $rbits = "";
        vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
        $nfound = select($rbits, undef, undef, 1); # Wait for packet
        $timeout = $finish_time - time();   # Get remaining time
        if (!defined($nfound))              # Hmm, a strange error
        {
            $done = 1;
        }
        elsif ($nfound)                     # Got a packet from somewhere
        {
            $recv_msg = "";
            $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
	    next unless( $from_saddr );
            ($from_port, $from_ip) = sockaddr_in($from_saddr);
            ($from_type, $from_subcode, $from_chk,
             $from_pid, $from_seq, $from_msg) =
                unpack($icmp_struct . $self->{"data_size"},
                       substr($recv_msg, length($recv_msg) - $len_msg,
                              $len_msg));
            if (($from_type == $ICMP_ECHOREPLY) &&
                ($ip{$from_ip}) &&
                ($from_pid == $self->{"pid"}) && # Does the packet check out?
                ($from_seq == $self->{"seq"}))
            {
	        $ret{$ip{$from_ip}} = [ $BigSister::common::status_codes{"green"}, "icmp-ping OK" ];
		delete $ip{$from_ip};
                $done = !%ip;
            }
        }
        elsif( $timeout<=0 )                                # Oops, timed out
        {
            $done = 1;
        }
    }
    return(%ret)
}

# Description:  Do a checksum on the message.  Basically sum all of
# the short words and fold the high order bits into the low order bits.

sub checksum
{
    my ($class,
        $msg            # The message to checksum
        ) = @_;
    my ($len_msg,       # Length of the message
        $num_short,     # The number of short words in the message
        $short,         # One short word
        $chk            # The checksum
        );

    $len_msg = length($msg);
    $num_short = $len_msg / 2;
    $chk = 0;
    foreach $short (unpack("S$num_short", $msg))
    {
        $chk += $short;
    }                                           # Add the odd byte in
    $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
    $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
    return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
}

# Description:  Perform a tcp echo ping.  Since a tcp connection is
# host specific, we have to open and close each connection here.  We
# can't just leave a socket open.  Because of the robust nature of
# tcp, it will take a while before it gives up trying to establish a
# connection.  Therefore, we have to set the Platform::bsalarm to break out of the
# connection sooner if the timeout expires.  No data bytes are actually
# sent since the successful establishment of a connection is proof
# enough of the reachability of the remote host.  Also, tcp is
# expensive and doesn't need our help to add to the overhead.

sub ping_tcp
{
    my ($self, $timeout, %ip ) = @_;
    my ($saddr,             # sockaddr_in with port and ip
        %ret                # The return value
        );
    my( $ip );

    foreach $ip (keys %ip) {
	socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) || next;
	$saddr = sockaddr_in($self->{"port_num"}, $ip);

	$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "tcp-ping FAILURE" ];               # Default to unreachable
	eval <<'EOM' ;
	    $SIG{'ALRM'} = sub { die };
	    Platform::bsalarm($timeout);        # Interrupt Platform::bsconnect() if we have to
	    die unless Platform::bsconnect($self->{"fh"}, $saddr);
	    $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "tcp-ping OK" ];
	    Platform::bsalarm(0);
EOM
	Platform::bsalarm(0);
	$self->{"fh"}->close();
    }
    return(%ret)
}

# Description:  Perform a udp echo ping.  Construct a message of
# at least the one-byte sequence number and any additional data bytes.
# Send the message out and wait for a message to come back.  If we
# get a message, make sure all of its parts match.  If they do, we are
# done.  Otherwise go back and wait for the message until we run out
# of time.  Return the result of our efforts.

sub ping_udp
{
    my ($self, $timeout, %ip ) = @_;

    my $flags = 0;          # Nothing special on open

    my ($saddr,             # sockaddr_in with port and ip
        %ret,               # The return value
	$ip,
        $msg,               # Message to be echoed
        $finish_time,       # Time ping should be finished
        $done,              # Set to 1 when we are done pinging
        $rbits,             # Read bits, filehandles for reading
        $nfound,            # Number of ready filehandles found
        $from_saddr,        # sockaddr_in of sender
        $from_msg,          # Characters echoed by $host
        $from_port,         # Port message was echoed from
        $from_ip,           # Packed IP number of sender
	$now,
	%msg2ip,
	%ip2msg
        );

    $self->{"seq"} = ($self->{"seq"} + 1) % 65536;    # Increment sequence
    $done = 0;
    $finish_time = time() + $timeout;       # Ping needs to be done by then
    $now = 0;
    %msg2ip = ();
    %ip2msg = ();
    foreach $ip (keys %ip) {
	$self->{"seq"} = ($self->{"seq"} + 257) % 65536;    # Increment sequence
	$msg = pack("S",$self->{"seq"}) . "udp_ping" . $self->{"data"};   # Add data if any
	$msg2ip{$msg} = $ip;
	$ip2msg{$ip} = $msg;
    }
    while (!$done && $timeout > 0)
    {
	if( time - $now >= 1 ) {
	    foreach $ip (keys %ip) {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "udp-ping FAILURE" ];
		$saddr = sockaddr_in($self->{"port_num"}, $ip);
		$msg = $ip2msg{$ip};
		send($self->{"fh"}, $msg, $flags, $saddr);      # Send it
	    }
	    $now = time;
	}
        $rbits = "";
        vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
        $nfound = select($rbits, undef, undef, 1); # Wait for response
        $timeout = $finish_time - time();   # Get remaining time

        if (!defined($nfound))  # Hmm, a strange error
        {
            $done = 1;
        }
        elsif ($nfound)         # A packet is waiting
        {
            $from_msg = "";
            $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags);
	    next unless( $from_saddr);
            ($from_port, $from_ip) = sockaddr_in($from_saddr);
	    # don't check for $from_ip = ...ip since the distant machine might be multihomed ...
            if (($msg2ip{$from_msg}) &&        # Does the packet check out?
                ($from_port == $self->{"port_num"})) 
            {
		$ip = $msg2ip{$from_msg};
		# we might get a packet from a former "send"
	        $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "udp-ping OK" ] if( defined $ip{$ip} );
		delete $ip{$ip};
                $done = !%ip;
            }
        }
        elsif( $timeout<=0 )                    # Oops, timed out
        {
            $done = 1;
        }
    }
    return(%ret);
}   

# Description:  Close the connection unless we are using the tcp
# protocol, since it will already be closed.

sub close
{
    my ($self) = @_;

    $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
}



sub ping_karl
{
   # Try again with a IMCP ping, for those goofy machines that don't run
   # the echo service...  This is a bit slower...

   # get pingtime

    my ($self, $timeout, %ip ) = @_;
    my (%ret                # The return value
        );
    my( $ip );

    my ( @ping, $ping );

    foreach $ip (keys %ip)
    {
 	my $aip = inet_ntoa( $ip );
       if (open(PING, "/usr/sbin/ping -s -t 100 $aip 88 6 |"))
       {
           @ping = <PING>;
           $ping = join '', @ping;

           if ($ping =~ m/\d+\/(\d+)\/\d+/g)
           {
               $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "karl-ping OK - $1ms" ];
           }
           elsif ($ping =~ m/time=(\d+)/g)
           {
               $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "karl-ping OK - $1ms" ];
           }
           else
           {
               $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "karl-ping FAILURE" ];               #
           }
           close(PING);
       }
    }

    # pass back the results
    return(%ret);
}

sub ping_external
{
    my ($self, $timeout, %ip ) = @_;
    my ($cc, $ip, %ret);
    my ( @ping, $ping );
    
    foreach $ip (keys %ip)
    {
	my $aip = join '.', unpack(' C4', $ip);
	$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "external-ping FAILURE\n" ];
	if (open (PING, $self->{"pingcmd"} . " $aip |")) 
	{
	    @ping = <PING>;
	    my $string = "";
	    foreach $ping (@ping) 
	    {
		if ($ping =~ m=[0-9.]+/([0-9.]+)/[0-9.]+=g)
		{
		    $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "external-ping OK - $1ms" ];
		}
		elsif ($ping =~ m/time=([0-9.]+)/g)
		{
		    $ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "kexternal-ping OK - $1ms" ];
		}
		$string .= $ping;
	    }
	    close(PING);
	    push( @{$ret{$ip{$ip}}}, 100, $string );
	}
	# FIXME: put something in here to report the failure.
    }

    return(%ret);
}

sub ping_fping
{
    my ($self, $timeout, %ip ) = @_;
    my ($cc, $ip);
    my ( @ping, $ping, %ret);
    
    my ($FPING, $FPINGOPTS, $WARNLEV, $PANICLEV, $DEVWARN, $DEVPANIC);

    # Add option to suit your needs
    $FPINGOPTS="-A -C10 -q -e";

    # Define where fping lives
    $FPING="fping";

    # Percent packet loss to warn
    $WARNLEV=20;
    $PANICLEV=80;

    # Standard Deviation Warning levels
    $DEVWARN=80;
    $DEVPANIC=110;

    my ($temp, $alive, $aip);

    croak "Could not run $FPING\n" unless open3(*FPINGOUT, *FPINGIN, *FPINGERR, "$FPING $FPINGOPTS"); 
    %ret = map { $_ => [ $BigSister::common::status_codes{"red"}, "could not execute fping or response could not be parsed" ] } values %ip;
    foreach $ip (keys %ip) {
	$aip = join '.', unpack(' C4', $ip);
	print FPINGOUT $aip, "\n";
    }
    close(FPINGOUT);
    close(FPINGIN);

    while (<FPINGERR>) {
	chomp;
	if (/^(\S*)\s*:\s*xmt.* = [0-9]*\/[0-9]*\/([0-9]*)\%/) {
	    ($aip, $alive) = ($1, $2);
	    $ip = inet_aton($aip);
	    if ($alive >= $PANICLEV) {
		$ret{$ip{$ip}}= [ $BigSister::common::status_codes{"red"}, 
				  "fping FAILURE - packetloss $alive exceeds PANIC threshold($PANICLEV)" ];
	    } elsif ($alive >= $WARNLEV) {
		$ret{$ip{$ip}}= [ $BigSister::common::status_codes{"yellow"},
				  "fping FAILURE - packetloss $alive exceeds WARN threshold($WARNLEV)" ];
	    } else {
		$ret{$ip{$ip}}= [ $BigSister::common::status_codes{"green"}, "fping OK" ];
	    }
	    push( @{$ret{$ip{$ip}}}, 100, $_ );
	} elsif (/^(\S+)\s*:\s*([0-9 .-]+)/) {
	    my ($aip, $res) = ($1,$2);
	    $ip = inet_aton($aip);
	    my ($stddev, $var, $avg, $max, $min, $ms, $scount, $tcount, $loss, $data);
	    ($var, $avg, $scount, $tcount) = (0,0,0,0);
	    $data="data: ";
	    foreach $ms (split(' ',$res)) {
		$data.=" $ms";
		$tcount++;
		next if ($ms eq '-');
		$ms /= 10;
		$scount++;
		($max = $ms) unless (defined $max);
		($min = $ms) unless (defined $min);
		if ($ms > $max) { $max = $ms }
		if ($ms < $min) { $min = $ms }
		$avg += $ms;
		$var += $ms**2;
	    }
	    if ($tcount<1) {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "&green 0 pings sent to $aip" ];
	    } elsif ($scount<1) {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "&red Host($aip) did not respond" ];
	    } else {
		$avg /= $scount;
		$var -= $scount * ($avg**2);
		if ($scount>1) {
		    $var /= ($scount-1);
		} else {
		    $var = 0;
		}
		$stddev = ($var<=0)?0:(sqrt($var));
		$loss = (1 - $scount / $tcount) * 100;
		if ($loss >= $PANICLEV) {
		    $ret{$ip{$ip}}= [ $BigSister::common::status_codes{"red"}, 
				      "&red Packetloss $loss% exceeds PANIC threshold($PANICLEV%)" ];
		} elsif ($loss >= $WARNLEV) {
		    $ret{$ip{$ip}}= [ $BigSister::common::status_codes{"yellow"},
				      "&yellow Packetloss $loss% exceeds WARN threshold($WARNLEV%)" ];
		} else {
		    $ret{$ip{$ip}}= [ $BigSister::common::status_codes{"green"}, "&green Packetloss OK ($loss%)" ];
		}
		$var = int($var*1000)/1000;
		$stddev = int($stddev*1000)/1000;
		if ($stddev >= $DEVPANIC) {
		    push( @{$ret{$ip{$ip}}}, $BigSister::common::status_codes{"red"},
			  "&red Standard Deviation $stddev exceeds PANIC threshold($DEVPANIC)" );
		} elsif ($stddev >= $DEVWARN) {
		    push( @{$ret{$ip{$ip}}}, $BigSister::common::status_codes{"yellow"},
			  "&yellow Standard Deviation $stddev exceeds WARN threshold($DEVWARN)" );
		} else {
		    push( @{$ret{$ip{$ip}}}, $BigSister::common::status_codes{"green"},
			  "&green Standard Deviation OK ($stddev)" );
		}
		push( @{$ret{$ip{$ip}}}, 100, "$aip : xmt/rcv/loss $tcount/$scount/$loss%",
		      100, "$aip : min/avg/max $min/$avg/$max",
		      100, "$aip : var/stdev $var/$stddev",
		      100, "$aip : $data" );
	    }
	} elsif (/^\S* is \S*/) {
	    ($aip, $alive) = /^(\S*) is (\S*)/;
	    $ip = inet_aton($aip);
	    if ($alive eq 'alive') {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"green"}, "fping OK" ];
	    } else {
		$ret{$ip{$ip}} = [ $BigSister::common::status_codes{"red"}, "fping FAILURE" ];
	    }
	    push( @{$ret{$ip{$ip}}}, 100, $_ );
	} elsif (/^open3:/) {
	    foreach $ip (keys %ret) {
		push( @{$ret{$ip{$ip}}}, 100, "ERROR ".$_ );
	    }
	} else {
	    print "fping: Could not parse response '$_'", $_, "\n" if ($BigSister::common::dl>3);
	}
    }
    close(FPINGERR);

    return(%ret);
}

1;
