#!/usr/bin/perl -w

# This runs on Linux (could easily be changed to not use /dev/urandom,
# but I did that to get real good random numbers).
#
# To avoid putting a secret, username, and password on the command line,
# put them in the script.  If you use the same one on all server you
# will monitor, just change the "default" declaration below.  Otherwise
# put the declaration for each server in the "servers" section.
#
# Chris Adams <cadams@ro.com>
#

use IO::Socket;
use IO::Select;
use RADIUS::Packet;
use RADIUS::Dictionary;
use Getopt::Std;
use strict;

#
# Put the connect info for the servers here
my %default = (
	"secret" => "RADIUSsecret",
	"user" => "Auser",
	"pass" => "Apassword",
	"port" => 1645
);
my %servers = (
	"default" => \%default
);

#
# Get the options
$Getopt::Std::opt_t = 5;
$Getopt::Std::opt_a = 3;
getopts ("a:t:");
my $timeout = $Getopt::Std::opt_t;
my $attempts = $Getopt::Std::opt_a;
my @servers = @ARGV;

open (RAND, "/dev/urandom");
$::rad_dict = new RADIUS::Dictionary "/etc/radius/dictionary";

my @error = ();
my @hosts = ();
while ($attempts-- && @servers) {
	my @nextpass = ();

	#
	# First pass - submit a request to each server
	my %reqs = ();
	my $id = 0;
	sysread (RAND, $id, 1);
	$id = unpack ("C", $id);
	my $sel = new IO::Select;
	while (my $server = shift @servers) {
		if (! defined ($servers{$server})) {
			%{$servers{$server}} = ();
		}
		foreach (keys %{$servers{default}}) {
			$servers{$server}{$_} = $servers{default}{$_}
			    if (! defined ($servers{$server}{$_}));
		}

		my $req_auth = "";
		sysread (RAND, $req_auth, 16);

		my $req = new RADIUS::Packet $::rad_dict;
		$req->set_code ('Access-Request'); #'
		$req->set_identifier ($id++);
		$req->set_authenticator ($req_auth);
		$req->set_attr ('User-Name', $servers{$server}{user}); #'
		$req->set_attr ('Password', $servers{$server}{pass});

		my $sock = IO::Socket::INET->new (
			PeerAddr => $server,
			PeerPort => $servers{$server}{port},
			Proto => 'udp') or die "new socket: $!\n";

		if (! $sock->send ($req->pack ($servers{$server}{secret}))) {
			if ($attempts) {
				push @nextpass, $server;
			} else {
				push @error, "$server: send: $!";
				push @hosts, $server;
			}
		} else {
			$reqs{$sock->fileno}{server} = $server;
			$reqs{$sock->fileno}{auth} = $req_auth;
			$reqs{$sock->fileno}{id} = $req->identifier;
			$reqs{$sock->fileno}{secret}
			    = $servers{$server}{secret};
			$reqs{$sock->fileno}{sock} = $sock;
			$sel->add ($sock);
		}
	}
	close (RAND);

	#
	# Second pass - look for server responses
	my $start = time ();
	my $to = $timeout - (time () - $start);

	while ($sel->handles && (my @found = $sel->can_read ($to))) {
		foreach my $f (@found) {
			my $fno = $f->fileno;
			my $res = check_res ($f, $reqs{$fno}{server},
			    $reqs{$fno}{auth}, $reqs{$fno}{id},
			    $reqs{$fno}{secret});
			if ($res) {
				if ($attempts) {
					push @nextpass, $reqs{$fno}{server};
				} else {
					push @error, $res;
					push @hosts, $reqs{$fno}{server};
				}
			}
			$sel->remove ($f);
			$f->close;
		}
		$to = $timeout - (time () - $start);
	}

	#
	# Third pass - any left timed out
	foreach my $f ($sel->handles) {
		if ($attempts) {
			push @nextpass, $reqs{$f->fileno}{server};
		} else {
			push @error, $reqs{$f->fileno}{server} .
			    ": No response"; #"
			push @hosts, $reqs{$f->fileno}{server};
		}
	}

	@servers = @nextpass;
}

if (@hosts) {
	print join (" ", sort @hosts), "\n";
}
if (@error) {
	print join ("\n", @error), "\n";
}
exit (@hosts);


#
# Check a result to see that it is valid
sub check_res
{
	my ($sock, $server, $auth, $id, $secret) = @_;

	my $buf = "";
	if (! $sock->recv ($buf, 4096)) {
		return ("$server: recv: $!");
	}
	my $resp = new RADIUS::Packet $::rad_dict, $buf;
	my $resp_auth = auth_resp ($buf, $secret, $auth);

	if (($resp->identifier != $id)
	    || ($resp->authenticator ne $resp_auth)) {
		return ("$server: Invalid response");
	}
	return ();
}