#!/usr/bin/perl -w
#---AUTOPRAGMASTART---
use 5.012;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use English qw( -no_match_vars );
use Carp;
our $VERSION = 0.996;
#---AUTOPRAGMAEND---
use Authen::Radius;
use Term::ReadKey;
my $username = 'cavac';
my $password;
unless (defined $password) {
print 'Password: ';
ReadMode('noecho');
chomp($password = ReadLine(0));
ReadMode('restore');
print "\n";
}
my $r = new Authen::Radius(Host => '127.0.0.1', Secret => 'mysecret', TimeOut=>10);
if($r->check_pwd($username, $password)) {
print "Welcome!\n";
} else {
print "***** FAIL *****\n";
}
####
diff -rupN Authen-Radius-0.20_old/Radius.pm Authen-Radius-0.20/Radius.pm
--- Authen-Radius-0.20_old/Radius.pm 2012-03-18 20:17:49.313819745 +0100
+++ Authen-Radius-0.20/Radius.pm 2012-03-18 20:18:20.054569761 +0100
@@ -429,7 +429,7 @@ sub vendorID ($) {
} else {
# look up vendor by attribute name
my $vendor_name = $dict_name{$attr->{'Name'}}{'vendor'};
- my $vendor_id = defined ($dict_vendor_name{$vendor_name}{'id'}) ?
+ my $vendor_id = (defined $vendor_name && defined ($dict_vendor_name{$vendor_name}{'id'})) ?
$dict_vendor_name{$vendor_name}{'id'} : 'not defined';
return $vendor_id;
}
####
diff -rupN RADIUS-1.0_old/RADIUS/Packet.pm RADIUS-1.0/RADIUS/Packet.pm
--- RADIUS-1.0_old/RADIUS/Packet.pm 2012-03-18 19:37:52.083326134 +0100
+++ RADIUS-1.0/RADIUS/Packet.pm 2012-03-18 19:40:54.467770068 +0100
@@ -160,6 +160,12 @@ sub unpack {
while (length($attrdat)) {
my $length = unpack "x C", $attrdat;
my ($type, $value) = unpack "C x a${\($length-2)}", $attrdat;
+ if(!defined($dict->attr_numtype($type))) {
+ print STDERR "Unknown type $type! Skipping this one - might have dire consequences)!\n";
+ print STDERR " Please add type $type to your dictionary!\n";
+ substr($attrdat, 0, $length) = "";
+ next;
+ }
my $val = &{$unpacker{$dict->attr_numtype($type)}}($value, $type);
$self->set_attr($dict->attr_name($type), $val);
substr($attrdat, 0, $length) = "";
####
#!/usr/bin/perl -w
#---AUTOPRAGMASTART---
use 5.012;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use English qw( -no_match_vars );
use Carp;
our $VERSION = 0.996;
#---AUTOPRAGMAEND---
BEGIN {
# So we find the rest of our code
unshift @INC, ".";
};
use Rader;
our $APPNAME = "Simple Radius Server";
my $psname = "simpleradius";
print "Changing application name to '$psname'\n\n";
$0 = $psname;
my $server = Rader->new(
host => 'localhost',
port => 1812,
proto => 'udp',
);
$server->run();
####
package Rader;
#---AUTOPRAGMASTART---
use 5.012;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use English qw( -no_match_vars );
use Carp;
our $VERSION = 0.996;
#---AUTOPRAGMAEND---
use base qw(Net::Server::Single);
use RADIUS::Dictionary;
use RADIUS::Packet;
use OATHusers;
sub process_request {
my $self = shift;
my $prop = $self->{'server'};
# This is a VERY simple RADIUS authentication server which responds
# to Access-Request packets with Access-Accept/Access-reject.
my $secret = "mysecret"; # Shared secret on the term server
# Parse the RADIUS dictionary file (must have dictionary in current dir)
my $dict = new RADIUS::Dictionary "dictionary"
or die "Couldn't read dictionary: $!";
my $um = OATHusers->new();
# Get the data
my $rec = $prop->{udp_data};
# Unpack it
my $p = RADIUS::Packet->new($dict, $rec);
if ($p->code eq 'Access-Request') {
# Print some details about the incoming request (try ->dump here)
#print $p->attr('User-Name'), " logging in with password ",
# $p->password($secret), "\n";
#$p->dump;
# Create a response packet
my $rp = new RADIUS::Packet $dict;
if($um->validate($p->attr('User-Name'), $p->password($secret))) {
$rp->set_code('Access-Accept');
print "Password OK\n";
} else {
$rp->set_code('Access-Reject');
print "Password FAIL\n";
}
$rp->set_identifier($p->identifier);
$rp->set_authenticator($p->authenticator);
# (No attributes are needed.. but you could set IP addr, etc. here)
# Authenticate with the secret and send to the client.
my $outpacket = auth_resp($rp->pack, $secret);
$prop->{'client'}->send($outpacket, 0);
#$s->sendto(auth_resp($rp->pack, $secret), $whence);
}
else {
# It's not an Access-Request
print "***** Unexpected packet type recieved. ******";
$p->dump;
}
}
1;
####
package OATHusers;
#---AUTOPRAGMASTART---
use 5.012;
use strict;
use warnings;
use diagnostics;
use mro 'c3';
use English qw( -no_match_vars );
use Carp;
our $VERSION = 0.996;
#---AUTOPRAGMAEND---
use Authen::OATH;
sub new {
my $class = shift;
my $self = bless {}, $class;
my %seeds = (
'tye' => {
key_id => '000001',
pin => '2412',
seed => uc('aaaaaaaaabbbbbbbbbbbbbbccccccccccddddddd'),
},
'browseruk'=> {
key_id => '222222',
pin => '4242',
seed => uc('0101010101010101010101010101010101010101'),
},
'reaper' => {
key_id => '9',
pin => 'SIGKILL',
seed => uc('1231231231231231231231231231231231231231'),
},
);
$self->{seeds} = \%seeds;
return $self;
}
sub validate {
my ($self, $username, $password) = @_;
# Missing fields
if(!defined($username) || !defined($password) ||
$username eq '' || $password eq '') {
return 0;
}
# Unknown username
if(!defined($self->{seeds}->{$username})) {
return 0;
}
# For the easy part: Check length of password
if(length($password) != (length($self->{seeds}->{$username}->{pin}) + 6)) {
return 0;
}
my $oath = Authen::OATH->new(timestep => 60);
my $valid = 0;
my $now = time;
my $userseed = $self->{seeds}->{$username}->{seed};
for(my $i = -300; $i <= 300; $i += 60) { # Search +/- 5 minutes
my $totp = $oath->totp($userseed, $now + $i);
my $fullpass = $self->{seeds}->{$username}->{pin} . $totp;
if($fullpass eq $password) {
print "$username key drift $i\n";
$valid = 1;
last;
}
}
return $valid;
}
1;