125 lines
3.8 KiB
Perl
125 lines
3.8 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use Net::Radius::Dictionary;
|
|
use Net::Radius::Packet;
|
|
use Net::Inet;
|
|
use Net::UDP;
|
|
use warnings;
|
|
use strict;
|
|
use Fcntl;
|
|
|
|
# This is a VERY simple RADIUS authentication server which accepts
|
|
# any user whos User-Name and Password match according to the Unix
|
|
# getpwnam() function. It then displays a menu asking whether they
|
|
# wish to telnet or start PPP. If telnet is chosen, they are asked
|
|
# for a host name.
|
|
|
|
# NOTE - This server must be run as root on systems with shadow passwords.
|
|
|
|
# $Id: example-menu.pl 7 2003-01-08 03:42:41Z lem $
|
|
|
|
my $secret = "mysecret"; # Shared secret on the term server
|
|
|
|
# Function to check name and password. Returns undef if no such user.
|
|
sub check_pass {
|
|
my ($user, $pass) = @_;
|
|
if (my $pwd = (getpwnam($user))[1]) {
|
|
$pwd =~ /^\$.+\$(.+)\$/ or $pwd =~ /^(..)/;
|
|
my $salt = $1;
|
|
if (crypt($pass, $salt) eq $pwd) {
|
|
return 1;
|
|
}
|
|
else {
|
|
return 0;
|
|
}
|
|
}
|
|
else {
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
# 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 (must have radius in /etc/services)
|
|
my $s = new Net::UDP { thisservice => "radius" } or die $!;
|
|
$s->bind or die "Couldn't bind: $!";
|
|
$s->fcntl(F_SETFL, $s->fcntl(F_GETFL,0) | O_NONBLOCK)
|
|
or die "Couldn't make socket non-blocking: $!";
|
|
|
|
# Loop forever, recieving packets and replying to them
|
|
while (1) {
|
|
my ($rec, $whence);
|
|
# Wait for a packet
|
|
my $nfound = $s->select(1, 0, 1, undef);
|
|
if ($nfound > 0) {
|
|
# Get the data
|
|
$rec = $s->recv(undef, undef, $whence);
|
|
# Unpack it
|
|
my $p = new Net::Radius::Packet $dict, $rec;
|
|
if ($p->code eq 'Access-Request') {
|
|
# Initialize the response packet we'll send back
|
|
my $rp = new Net::Radius::Packet $dict;
|
|
$rp->set_identifier($p->identifier);
|
|
$rp->set_authenticator($p->authenticator);
|
|
if (not defined($p->attr('State'))) {
|
|
print $p->attr('User-Name'), " attempting login with password ",
|
|
$p->password($secret), "\n";
|
|
# Check against the Unix passwd file
|
|
if (check_pass($p->attr('User-Name'), $p->password($secret))) {
|
|
print "Login valid. Sending menu.\n";
|
|
$rp->set_code('Access-Challenge');
|
|
$rp->set_attr('State', 'menu');
|
|
$rp->set_attr('Reply-Message',
|
|
"\r\nWelcome to BlahNet.\r\n" .
|
|
"Please choose from the following menu:\r\n\r\n" .
|
|
"1: PPP\r\n2: Telnet\r\n");
|
|
}
|
|
else {
|
|
print "Invalid login.\n";
|
|
$rp->set_code('Access-Reject');
|
|
$rp->set_attr('Reply-Message', "\r\nInvalid login.\r\n");
|
|
}
|
|
}
|
|
else {
|
|
# We are dealing with a response to a previous challenge
|
|
if ($p->attr('State') eq 'menu') {
|
|
if ($p->password($secret) eq '1') {
|
|
print "PPP login selected.\n";
|
|
$rp->set_code('Access-Accept');
|
|
$rp->set_attr('Service-Type', 'Framed-User');
|
|
$rp->set_attr('Framed-Protocol', 'PPP');
|
|
}
|
|
elsif ($p->password($secret) eq '2') {
|
|
print "Telnet login selected.\n";
|
|
$rp->set_code('Access-Challenge');
|
|
$rp->set_attr('Reply-Message', "\r\nWhich host?\r\n");
|
|
$rp->set_attr('State', 'host');
|
|
}
|
|
else {
|
|
print "Invalid menu option.\n";
|
|
$rp->set_code('Access-Reject');
|
|
$rp->set_attr('Reply-Message', "\r\nInvalid response.\r\n");
|
|
}
|
|
}
|
|
elsif ($p->attr('State') eq 'host') {
|
|
print "Telnet host chosen: ", $p->password($secret), "\n";
|
|
$rp->set_code('Access-Accept');
|
|
$rp->set_attr('Service-Type', 'Login-User');
|
|
$rp->set_attr('Login-Service', 'Telnet');
|
|
$rp->set_attr('Login-IP-Host', $p->password($secret));
|
|
$rp->set_attr('Reply-Message', "Connecting...\r\n");
|
|
}
|
|
}
|
|
# Authenticate with the secret and send to the server.
|
|
$s->sendto(auth_resp($rp->pack, $secret), $whence);
|
|
}
|
|
else {
|
|
# It's not an Access-Request
|
|
print "Unexpected packet type recieved.";
|
|
$p->dump;
|
|
}
|
|
}
|
|
}
|