#!/usr/bin/perl

use POSIX ':sys_wait_h';
use strict;

# Main
my $quiet = 0;
while($ARGV[0] eq '-q') {
    $quiet++;
    shift(@ARGV);
}

usage() if ($#ARGV != 1);
my $sleeptime = sprintf('%d', $ARGV[1]);
die("$0: bad interval $ARGV[1]\n") if ($sleeptime < 2);
while (1) {
    # Clean up any zombies
    while (waitpid(-1, WNOHANG) > 0) { }

    # Run the test
    do_test();

    # Sleep for the duration of the interval
    my $slept = 0;
    while ($slept < $sleeptime) {
	$slept += sleep($sleeptime - $slept);
    }
}

# Show usage and croak
sub usage() {
    die <<"ENDUSAGE";

Usage: xr-client-ping [-q] WEBINTERFACE-URL INTERVAL
The web interface is queried for clients. Connections to non-pingable clients
are killed. The process is repeated each interval.

The arguments:
  -q: quiet mode, suppresses verbose messaging
  WEBINTERFACE-URL: the URL of XR's web interface, include http://
  INTERVAL: number of seconds

ENDUSAGE
}

# Start a single test
my $_tries = 0;
sub do_test() {
    msg ("-----------------------------------------------------------------\n");
    msg ("Starting check run\n");
    my $xml;
    eval {
	$xml = http_get($ARGV[0]);
    };
    if ($@) {
	msg ("Could not access web interface: $@\n");
	die ("Too many tries now, giving up...\n") if ($_tries++ > 5);
	return;
    }
    $_tries = 0;

    my $active = 0;
    my ($id, $clientip);
    for my $line (split(/\n/, $xml)) {
	$active = 1 if ($line =~ /<thread>/);
	$active = 0 if ($line =~ /<\/thread>/);

	if ($active) {
	    if ($line =~ /<id>/) {
		$id = $line;
		$id =~ s/\s*<id>//;
		$id =~ s/<\/id>.*//;
	    } elsif ($line =~ /<clientip>/) {
		$clientip = $line;
		$clientip =~ s/\s*<clientip>//;
		$clientip =~ s/<\/clientip>//;
		check_client($id, $clientip) if ($clientip ne '0.0.0.0');
	    }
	}
    }
}

# Check one thread ID and client IP
sub check_client($$) {
    my ($id, $clientip) = @_;


    msg ("Checking connection for client $clientip (XR thread $id)\n");
    return if (fork());

    my $cmd = "ping -c3 -t3 $clientip >/dev/null";
    msg ("$clientip: pinging (external '$cmd')\n");
    my $status = system($cmd);
    if ($status != 0) {
	msg ("$clientip: ping status '$status' $!\n");
	msg ("$clientip: not reachable, stopping XR thread $id\n");
	eval {
	    http_get("$ARGV[0]/thread/kill/$id");
	};
	msg ("Failed to stop thread $id\n") if ($@);
    } else {
	msg ("$clientip: reachable, connection assumed valid\n");
    }
    exit(0);
}
	
# Do a HTTP GET. Try LWP::UserAgent if available, else try wget.
sub http_get($) {
    my $url = shift;
    my $ua;

    # Try LWP::UserAgent
    eval {
	require LWP::UserAgent;
    };
    if (! $@) {
	$ua = LWP::UserAgent->new();
	$ua->timeout(3);
	my $res = $ua->get($url);
	die ("Could not access url '$url'\n")
	  unless ($res->is_success());
	return $res->content();
    }

    # Try wget or curl, or any other command (can be put in here)
    for my $cmd ("wget -q -O- -T3 '$url'",
		 "curl --connect-timeout 3 -s '$url'") {
	msg ("Running: $cmd\n");
	open (my $if, "$cmd |");
	if ($if) {
	    my $cont = '';
	    while (my $line = <$if>) {
		$cont .= $line;
	    }
	    if (close($if)) {
		return $cont;
	    } else {
		msg("$cmd failed: $!\n");
	    }
	}
    }

    # All failed, now what?
    die ("No method to access url '$url'\n");
}
    
# Verbose messaging
sub msg {
    print ($$, ' ', scalar(localtime()), ' ', @_) unless ($quiet);
}
