# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-03 23:24 (EST)
# Function: ping service test
#
# $Id: Ping.pm,v 1.43 2005/12/04 20:52:57 jaw Exp $

package Ping;
@ISA = qw(Service);

use Argus::Encode;

use strict qw(refs vars);
use vars qw(@ISA $doc);

my $FPING_ARGS = " -r 3 -t 500 -e";
# -e   => show elapsed time
# -r   => retry limit
# -t   => timeout

# this works by getting a bunch of objects at a time
# and fping'ing them all at once
# it plays some games with the scheduling to accomplish this

$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [qw(Service MonEl BaseIO)],
    methods => {},
    fields => {
      ping::hostname => {
	  descr => 'hostname or IP address to test',
	  attrs => ['config', 'inherit'],
      },
      ping::addr => {
	  descr => 'address to ping',
      },
      ping::rbuffer => {
	  descr => 'read buffer',
      },
      ping::running => {
	  descr => 'is a ping already running?',
      },
      ping::data => {
	  descr => 'data returned by fping',
      },
      ping::ipver => {
	  descr => 'IP version (4 or 6)',
      },
      ping::rtt => {
	  descr => 'round trip time of last ping test',
      },
      ping::resolvp => {},
      ping::resolvt => {},
    },
};

my @pending = ();	# [$fn]{$ip} = [objs...]

sub probe {
    my $name = shift;

    return ( $name =~ /^Ping/ ) ? [ 4, \&config ] : undef;
}

sub config {
    my $me = shift;
    my $cf = shift;
    my( $ip );

    $me->init_from_config( $doc, 'ping' );

    if( $Resolv::enable_p ){
	$ip = Resolv::resolv_defer( $me->{ping}{hostname} );
	$me->{ping}{resolvp} = 1;
    }else{
	$ip = ::resolve( $me->{ping}{hostname} );
	return $cf->error( "cannot resolve host $me->{ping}{hostname}" )
	    unless $ip;
    }
    $me->{ping}{addr} = $ip;
    
    if( length($ip) == 4 ){
	$me->{ping}{ipver} = 4;
	return $cf->error( "fping not configured" )
	    unless $::path_fping;
    }elsif( length($ip) == 16 ){
	$me->{ping}{ipver} = 6;
	return $cf->error( "fping6 not configured" )
	    unless $::path_fping6;
    }

    $me->{uname} = "Ping_$me->{ping}{hostname}";

    bless $me if( ref($me) eq 'Service' );
    $me;
}

sub reresolv {
    my $me = shift;

    my $ip = Resolv::resolv_check( $me->{ping}{hostname} );
    $me->debug( "IP addr changed" ) if $ip && $me->{ping}{addr} && $ip ne $me->{ping}{addr};
    $me->{ping}{addr} = $ip if defined $ip;
    
    $me->{ping}{ipver} = 4 if length($ip) == 4;
    $me->{ping}{ipver} = 6 if length($ip) == 16;

    $me->{ping}{addr};
}

sub start {
    my $me = shift;
    my( $fh, $fn, $pid, $to, $n );

    if( $me->{ping}{running} ){
	$me->debug( 'already pinging' );
	return;
    }
    $me->debug( 'start ping' );
    $me->SUPER::start();

    if( $me->{ping}{resolvp} ){
	my $ip = $me->reresolv();

	unless( $ip ){
	    $me->{ping}{resolvt} ||= $^T + Resolv->too_long();
	    if( $^T > $me->{ping}{resolvt} ){
		return $me->isdown( "cannot resolve hostname" );
	    }else{
		$me->debug( 'Test skipped - resolv still pending' );
		return $me->done();
	    }
	}
    }

    
    $me->{fd} = $fh = BaseIO::anon_fh();

    # Jack shall pipe and Gill shall dance.
    #   -- George Wither, Poem on Christmas.
    
    # open pipes to fping, and fork,exec
    unless( pipe($fh, FPW) ){
	my $m = "pipe1 failed: $!";
	::sysproblem( "PING $m" );
	$me->debug( $m );
	$me->done();
	return;
    }
    unless( pipe(FPR, FPD) ){
	my $m = "pipe2 failed: $!";
	close FPW;
	::sysproblem( "PING $m" );
	$me->debug( $m );
	$me->done();
	return;
    }
    
    unless( ($pid = fork) ){
        # child
        BaseIO::closeall();
	close STDOUT; open( STDOUT, ">&FPW" ); close FPW;
        close STDERR; open( STDERR, ">/dev/null" );
        close STDIN;  open( STDIN, "<&FPR" );  close FPR;
        close $fh;
        close FPD;
	# Execute their airy purposes.
        #   -- John Milton, Paradise Lost
	if( $me->{ping}{ipver} == 4 ){
	    exec( "$::path_fping $FPING_ARGS" );
	}else{
	    exec( "$::path_fping6 $FPING_ARGS" );
	}
	# no, I didn't mean system() when I said exec()
	# and yes, I am aware the following statement is unlikely to be reached.
	syswrite( STDERR, "bummer dude, couldn't fping, what's that about? $!\n" );
        _exit(-1);
    }

    # First Musician Faith, we may put up our pipes, and be gone.
    #   -- Shakespeare, Romeo+Juliet
    close FPR;
    close FPW;

    if( !defined($pid) ){
	# fork failed
	my $m = "fork failed: $!";
	close FPD;
	::sysproblem( "PING $m" );
	$me->debug( $m );
	return $me->done();
    }
    
    $me->{ping}{pid} = $pid;
    $me->baseio_init();

    $fn = fileno($fh);
    $me->{ping}{rbuffer} = '';
    $to = $me->{srvc}{timeout};
    $n = 1;
    
    # the profiler suggested that I find a better way to do this
    # in the name of speed, we'll poke around in what was formerly
    # BaseIO's private data...
    # ick!
    # but 0.0030s -> 0.0010s

    # find all of the things scheduled to be pinged (or is it pung) at the same time
    # send them all to fping and do some bookkeeping so we can find
    # everything later
    foreach my $x (@BaseIO::bytime){
	next unless $x;
	last if $x->{time} > $^T;
	my $o = $x->{obj};
	next unless defined $o->{ping};
	next if $o->{srvc}{disabled};
	
	$o->reresolv() if $o->{ping}{resolvp};
	next unless $o->{ping}{addr};
	# fping can do one or the other, we do all v4 pings in one bunch, v6 another...
	next unless $o->{ping}{ipver} == $me->{ping}{ipver};
	
	$o->{ping}{pid} = $pid;
	# save effort for BaseIO and self, clean up after ourself
	$x = undef;

	$o->SUPER::start();
	my $ip = ::xxx_inet_ntoa($o->{ping}{addr});
	
	print FPD "$ip\n";
	push @{ $pending[$fn]{$ip} }, $o;
	$o->{ping}{running} = 1;
	$o->{srvc}{state} = 'running';
	$o->debug( 'ping start' );
	$to = $o->{srvc}{timeout} if $o->{srvc}{timeout} > $to;
	$n ++;
    }

    # also add current obj (it has already been removed from @bytime)
    my $ip = ::xxx_inet_ntoa($me->{ping}{addr});
    print FPD "$ip\n";
    push @{ $pending[$fn]{$ip} }, $me;
    $me->wantread(1);
    $me->wantwrit(0);
    $to = 10 unless $to > 10;
    $me->settimeout( $to + int($n/2) + 5 );	# to account for overhead...
    $me->{ping}{running} = 1;
    $me->{srvc}{state} = 'running';
    $me->debug( 'pinging' );
    
    close FPD;
}

sub timeout {
    my $me = shift;
    my( $fh, $l );

    $me->debug( 'ping - timeout' );
    kill 9, $me->{ping}{pid} if $me->{ping}{pid};
    # pick up any un-read data
    $fh = $me->{fd};
    while( sysread($fh, $l, 8192) ){
	$me->debug( "ping - read data ($l)" );
	$me->{ping}{rbuffer} .= $l;
    }
    
    $me->finish(1);
}

sub readable {
    my $me = shift;
    my( $fh, $i, $l );

    $fh = $me->{fd};
    $i = sysread $fh, $l, 8192;
    if( $i ){
	$me->debug( "ping - read data ($l)" );
	$me->{ping}{rbuffer} .= $l;
    }else{
	$me->finish(0);
    }
}

# fping gives us lines like:
#   ip is alive (100 msec)
#   ip is unreachable
# for each line, find the correct ping object (from the table built in start)
# and mark them all as up/down
sub finish {
    my $me = shift;
    my $killedp = shift;
    my( $n, $fh, $fn, @l );

    $fh = $me->{fd};
    $fn = fileno($fh);

    @l = split /\n/, $me->{ping}{rbuffer};
    $me->{ping}{rbuffer} = '';
    $me->wantread(0);
    foreach (@l){
	my( $ip, $rtt );
	if( /bummer/i ){
	    ::sysproblem( "PING failed - $_" );
	    next;
	}
	($ip)  = /^([^\s]+)\s/;
	($rtt) = /\((.*) ms(ec)?/;
	foreach my $x ( @{$pending[$fn]{$ip}} ){
	    next unless $x;
	    $n ++;
	    $x->{ping}{running} = undef;
	    $x->debug( "PING: $_" );
	    # keep the rtt, and full line available for debugging
	    $x->{ping}{rtt}    = $rtt;
	    $x->{srvc}{result} = $rtt || 0;	# QQQ - what value if down?
	    $x->{ping}{data}   = $_;

	    if( /alive/ ){
		if( $x->{test}{testedp} ){
		    $x->generic_test( $rtt );
		}else{
		    $x->isup();
		}
	    }else{
		$x->isdown( $_ );
	    }
	}
	delete $pending[$fn]{$ip};
    }

    ::sysproblem( 'PING failed - returned no data' )
	if( !$n && !$killedp );
    
    # make sure fping returned what it was supposed to
    foreach my $ip ( keys %{$pending[$fn]} ){
	# most likely, fping timed out and we killed it
	::sysproblem( "fping failed to return data about $ip" )
	    unless $killedp;
	foreach my $x ( @{$pending[$fn]{$ip}} ){
	    next unless $x;
	    undef $x->{ping}{running};
	    undef $x->{ping}{data};
	    undef $x->{ping}{rtt};
	    $x->{ping}{result} = 0;
	    if( $killedp ){
		$x->isdown( 'timeout - fping killed' );
	    }else{
		$x->isdown( 'ERROR - fping failed us' );
	    }
	}
	delete $pending[$fn]{$ip};
    }
    $pending[$fn] = undef;
}

sub about_more {
    my $me = shift;
    my $ctl = shift;
    my( $k, $v );

    $me->SUPER::about_more($ctl);
    $me->more_about_whom($ctl, 'ping');
}

# sub webpage_more {
#     my $me = shift;
#     my $fh = shift;
#     my( $k, $v );
#     
#     foreach $k (qw(rtt)){
# 	  $v = $me->{ping}{$k};
# 	  print $fh "<TR><TD>$k</TD><TD>$v</TD></TR>\n" if defined($v);
#     }
# }


################################################################
# global config
################################################################
Doc::register( $doc );
push @Service::probes, \&probe;

1;
