I wrote POE::Component::Client::RADIUS a little while back because I needed a RADIUS client under POE.
It uses Net::RADIUS modules to deal with the messy business of constructing and parsing the RADIUS packets.
It was based on a script that is in use every day monitoring our RADIUS servers using Nagios, here's the check_radius plugin I wrote
#!/usr/bin/perl
use strict;
use warnings;
use Time::HiRes qw(gettimeofday tv_interval);
use IO::Socket::INET;
use Net::Radius::Dictionary;
use Net::Radius::Packet;
use POSIX qw(uname);
use Getopt::Long;
use POE;
$|=1;
my $dict = new Net::Radius::Dictionary '/etc/radius/dictionary'
or die "Couldn't read dictionary: $!";
my $myip = join '.',unpack "C4",gethostbyname((uname)[1]);
my $retcode = 0;
# test user details
my $user;
my $pass;
# details of RADIUS authentication and accounting servers
my $address;
my $authport = 1645;
my $secret; # Shared secret for this client
GetOptions(
"hostname|H=s", \$address,
"pass=s", \$pass,
"port|P=i", \$authport,
"user=s", \$user,
"secret=s", \$secret,
);
exit 3 unless $address and $user and $pass and $secret;
POE::Session->create(
package_states => [
'main' => [qw(_start _get_datagram _time_out)],
],
);
$poe_kernel->run();
exit $retcode;
sub _start {
my ($kernel,$heap) = @_[KERNEL,HEAP,ARG0];
my $socket = IO::Socket::INET->new(
Proto => 'udp',
);
die "Couldn't create client socket: $!" unless $socket;
$kernel->select_read( $socket, '_get_datagram' );
my $ident = 1;
my $req = new Net::Radius::Packet $dict;
$req->set_code('Access-Request');
$req->set_attr('User-Name' => $user);
$req->set_attr('Service-Type' => 'Framed');
$req->set_attr('Framed-Protocol' => 'PPP');
$req->set_attr('NAS-Port' => 1234);
$req->set_attr('NAS-Identifier' => 'PerlTester');
$req->set_attr('NAS-IP-Address' => $myip);
$req->set_attr('Called-Station-Id' => '0000');
$req->set_attr('Calling-Station-Id' => '01234567890');
$req->set_identifier($ident);
$req->set_authenticator(bigrand()); # random authenticator require
+d
$req->set_password($pass, $secret); # encode and store password
# Send to the server. Encoding with auth_resp is NOT required.
my $server_address = pack_sockaddr_in( $authport, inet_aton($address
+) );
my $message = $req->pack;
send( $socket, $message, 0, $server_address ) == length($message) or
die "Trouble sending message: $!";
$kernel->delay( '_time_out', 10, $socket );
return;
}
sub _time_out {
my ($kernel,$socket) = @_[KERNEL,ARG0];
$retcode = 2;
print "CRITICAL Socket Timeout\n";
$kernel->select_read( $socket );
return;
}
sub _get_datagram {
my ($kernel,$heap,$socket) = @_[KERNEL,HEAP,ARG0];
$kernel->delay( '_time_out' );
my $remote_address = recv( $socket, my $message = '', 4096, 0 );
unless ( defined $remote_address ) {
$retcode = 3;
print "UKNOWN No remote address\n";
return;
}
my $resp = new Net::Radius::Packet $dict, $message;
if ( $resp->code ne 'Access-Accept' ) {
$retcode = 1;
print "WARN ", $resp->code, "\n";
}
else {
print "OK ", $resp->code, "\n";
}
$kernel->select_read( $socket );
return;
}
sub bigrand {
pack "n8",
rand(65536), rand(65536), rand(65536), rand(65536),
rand(65536), rand(65536), rand(65536), rand(65536);
}
|