Someone

use strict;

use CDB_File;

use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);

# for standaline testing
#my %RAD_REQUEST;
#my %RAD_REPLY;
#my %RAD_CHECK;

# This the remapping of return values

use constant    RLM_MODULE_REJECT=>    0;#  /* immediately reject the request */
use constant    RLM_MODULE_FAIL=>      1;#  /* module failed, don't reply */
use constant    RLM_MODULE_OK=>        2;#  /* the module is OK, continue */
use constant    RLM_MODULE_HANDLED=>   3;#  /* the module handled the request, so stop. */
use constant    RLM_MODULE_INVALID=>   4;#  /* the module considers the request invalid. */
use constant    RLM_MODULE_USERLOCK=>  5;#  /* reject the request (user is locked out) */
use constant    RLM_MODULE_NOTFOUND=>  6;#  /* user not found */
use constant    RLM_MODULE_NOOP=>      7;#  /* module succeeded without doing anything */
use constant    RLM_MODULE_UPDATED=>   8;#  /* OK (pairs modified) */
use constant    RLM_MODULE_NUMCODES=>  9;#  /* How many return codes there are */

sub authorize {
	&radiusd::radlog(1, "::: authorize\n");
#	$RAD_REPLY{'Auth-Type'} = "Perl";
#	&log_request_attributes;
        return RLM_MODULE_UPDATED
}

sub authenticate {
        my %isplookup;
        my $isp;
        my $tie;
        my $username;
        my %ispconfig;
        my @ispconfarray;
	my %CAV;

	&radiusd::radlog(1, "::: authenticate\n");
        &log_request_attributes;
#        $RAD_REQUEST{'User-Name'} = "nasport:192.168.1.41:2/0/0/400";
	$username = $RAD_REQUEST{"User-Name"};
        &radiusd::radlog(1, "!!! " . $username . "\n");
	if ($username =~ /^nasport:/) {
                $tie = tie %isplookup, 'CDB_File', '/ftth/radius/ispuser.cdb' or return RLM_MODULE_FAIL;
                $username =~ s/^nasport://;
                &radiusd::radlog(1, "Username:$username\n");

                $isp = $isplookup{$username};
                ##print "ISP:$isp\n";
                if($isp) {
                        # Lookup ISP config and return reply AVPs
                        $tie = tie %ispconfig, 'CDB_File', '/ftth/radius/ispconfig.cdb' or return RLM_MODULE_FAIL;
                        @ispconfarray = split(/\t/,$ispconfig{$isp}); # fields are tab delimited
                        my $lns_ipaddr = $ispconfarray[0];
                        my $lns_passwd = $ispconfarray[1];
                        my $vrf = $ispconfarray[2];

                        ##print "IPADDR:$lns_ipaddr, PASSWD:$lns_passwd, VRF:$vrf\n";
                       	$CAV{"vpdn:tunnel-type"} = "l2tp";
                       	$CAV{"vpdn:vpn-vrf"} = $vrf;
                       	$CAV{"vpdn:ip-addresses"} = $lns_ipaddr; 
			$CAV{"vpdn:l2tp-tunnel-password"} = $lns_passwd;
			$RAD_REPLY{'Cisco-AVpair'} = %CAV;
                        return RLM_MODULE_OK;

                } else {
                        # No ISP found
                        return RLM_MODULE_INVALID;
                }

                undef $tie;
                untie %isplookup;
        } else {
		# not nasport: ?!
		&radiusd::radlog(1, "FAIL! " . $RAD_REQUEST{'User-Name'} . "\n");
                return RLM_MODULE_FAIL;
        }

        undef $tie;
        untie %isplookup;
}


sub log_request_attributes {
        # This shouldn't be done in production environments!
        # This is only meant for debugging!
        for (keys %RAD_REQUEST) {
                &radiusd::radlog(1, "RAD_REQUEST: '$_' = '$RAD_REQUEST{$_}'");
        }
}

# standalone
#authenticate();