#!/usr/bin/perl

# doesn't work yet
# by Jakub Wartak ( vnull@pcnet.com.pl )

use Time::HiRes qw(gettimeofday tv_interval);
use Net::Inet qw(:routines);
use Net::Radius::Dictionary;
use Net::Radius::Packet;
use Net::Gen qw(:af);
use POSIX qw(uname);
use Net::UDP;
use warnings;
use strict;
use Fcntl;

# test user details
my $user = "xenomorph";
my $password = "123456";

# details of RADIUS authentication and accounting servers
my $authhost = "127.0.0.1";
my $authport = 1812;
my $secret = "testing123";  # Shared secret for this client

# Parse the RADIUS dictionary file (must have dictionary in current dir)
my $dict = new Net::Radius::Dictionary "dictionary"
	or die "Couldn't read dictionary: $!";

# Set up the network socket
my $s = new Net::UDP or die $!;

my ($authaddr, $acctaddr, $paddr);
$paddr = gethostbyname($authhost) or die "Can't resolve host $authhost\n";
$authaddr = pack_sockaddr_in(AF_INET, $authport, $paddr);

# discover my own IP address
my $myip = join '.',unpack "C4",gethostbyname((uname)[1]);

my $ident = 1;
my $whence;

# subroutine to make string of 16 random bytes
sub bigrand() {
        pack "n8",
                rand(65536), rand(65536), rand(65536), rand(65536),
                rand(65536), rand(65536), rand(65536), rand(65536);
}

my ($rec, $req, $resp);

# Create a request packet
$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($password, $secret);	# encode and store password

# Send to the server. Encoding with auth_resp is NOT required.
$s->sendto($req->pack, $authaddr);

# $req->dump;

# wait for response
$rec = $s->recv(undef, undef, $whence);

$resp = new Net::Radius::Packet $dict, $rec;
#$resp->dump;

if ($whence ne $authaddr || $resp->identifier != $ident) {
    die "unexpected reply to Radius authentication!\n";
}

if ($resp->code ne 'Access-Accept') {
    die "Radius response not Access-Accept\n";
}
my $mac = $resp->attr('User-Name');
print "$mac\n";

exit;