#!/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,v 1.2 2003/01/08 03:42:41 lem Exp $

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;
    }
  }
}