#!/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 required
  $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);
}