I'm new to FreeRADIUS and was initially exploring simple things, such as add attributes to an Access-Accept message.
My problem is that the perl script is not being able to access (ie print) values from RAD_REQUEST nor add pairs to RAD_REPLY. The following script: *********** start of example.pl script *********** # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA # # Copyright 2002 The FreeRADIUS server project # Copyright 2002 Boian Jordanov <[email protected]> # # # Example code for use with rlm_perl # # You can use every module that comes with your perl distribution! # # If you are using DBI and do some queries to DB, please be sure to # use the CLONE function to initialize the DBI connection to DB. # use strict; # use ... # This is very important ! Without this script will not get the filled hashesh from main. use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK); #use Data::Dumper; # This is hash wich hold original request from radius my %RAD_REQUEST; # In this hash you add values that will be returned to NAS. my %RAD_REPLY; #This is for check items 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 */ # Function to handle authorize sub authorize { # For debugging purposes only &log_request_attributes; # Here's where your authorization code comes # You can call another function from here: &test_call; return RLM_MODULE_OK; } # Function to handle authenticate sub authenticate { # For debugging purposes only &log_request_attributes; print "***** testing auth\n"; print $RAD_REQUEST{'User-Name'}; print "\n ******\n"; if ($RAD_REQUEST{'User-Name'} =~ /^baduser/i) { # Reject user and tell him why $RAD_REPLY{'Reply-Message'} = "Denied access by rlm_perl function"; return RLM_MODULE_REJECT; } else { # Accept user and set some attribute $RAD_REPLY{'h323-credit-amount'} = "100"; return RLM_MODULE_OK; } # Accept user and set some attribute $RAD_REPLY{'h323-credit-amount'} = "100"; return RLM_MODULE_OK; } # Function to handle preacct sub preacct { # For debugging purposes only &log_request_attributes; return RLM_MODULE_OK; } # Function to handle accounting sub accounting { print "***** accounting\n"; # For debugging purposes only &log_request_attributes; # You can call another subroutine from here &test_call; return RLM_MODULE_OK; } sub accounting_start { print "***** accounting_start\n"; return RLM_MODULE_OK; } sub accounting_stop { print "***** accounting_stop\n"; return RLM_MODULE_OK; } # Function to handle checksimul sub checksimul { # For debugging purposes only &log_request_attributes; return RLM_MODULE_OK; } # Function to handle pre_proxy sub pre_proxy { # For debugging purposes only &log_request_attributes; return RLM_MODULE_OK; } # Function to handle post_proxy sub post_proxy { # For debugging purposes only &log_request_attributes; return RLM_MODULE_OK; } # Function to handle post_auth sub post_auth { # For debugging purposes only &log_request_attributes; return RLM_MODULE_OK; } # Function to handle xlat sub xlat { # For debugging purposes only &log_request_attributes; # Loads some external perl and evaluate it my ($filename,$a,$b,$c,$d) = @_; &radiusd::radlog(1, "From xlat $filename "); &radiusd::radlog(1,"From xlat $a $b $c $d "); local *FH; open FH, $filename or die "open '$filename' $!"; local($/) = undef; my $sub = <FH>; close FH; my $eval = qq{ sub handler{ $sub;} }; eval $eval; eval {main->handler;}; } # Function to handle detach sub detach { # For debugging purposes only &log_request_attributes; # Do some logging. &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done."); } # # Some functions that can be called from other functions # sub test_call { # Some code goes here &radiusd::radlog(1, "Auth: RAD_REQUEST: $_ = $RAD_REQUEST{$_}"); } 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{$_}"); } } *********** end of example.pl script *********** with freeradius -X i get: ****** start of debugging info ****** rlm_perl: Auth: RAD_REQUEST: = rlm_perl: Added pair NAS-Port-Type = Virtual rlm_perl: Added pair Service-Type = Framed-User rlm_perl: Added pair Calling-Station-Id = XXXXXXXX rlm_perl: Added pair Called-Station-Id = XXXXXXXXXX rlm_perl: Added pair X-Ascend-Send-Auth = Send-Auth-PAP rlm_perl: Added pair Framed-Protocol = GPRS-PDP-Context rlm_perl: Added pair User-Name = XXXXXXXXXXXX rlm_perl: Added pair User-Password = 1z1z1z rlm_perl: Added pair NAS-IP-Address = 192.168.18.1 rlm_perl: Added pair NAS-Port = 60000 rlm_perl: Added pair NAS-Port-Id = GGSN rlm_perl: Added pair Auth-Type = Perl ++[perl] returns ok Found Auth-Type = Perl # Executing group from file /etc/freeradius/sites-enabled/default +- entering group Perl {...} ***** testing auth ****** rlm_perl: Added pair NAS-Port-Type = Virtual rlm_perl: Added pair Service-Type = Framed-User rlm_perl: Added pair Called-Station-Id = XXXXXXXXX rlm_perl: Added pair Calling-Station-Id = XXXXXXXXXXX rlm_perl: Added pair X-Ascend-Send-Auth = Send-Auth-PAP rlm_perl: Added pair Framed-Protocol = GPRS-PDP-Context rlm_perl: Added pair User-Name = XXXXXXXX rlm_perl: Added pair User-Password = XXXXXXXX rlm_perl: Added pair NAS-Port = 60000 rlm_perl: Added pair NAS-IP-Address = 192.168.18.1 rlm_perl: Added pair NAS-Port-Id = GGSN rlm_perl: Added pair Auth-Type = Perl ++[perl] returns ok # Executing section post-auth from file /etc/freeradius/sites-enabled/default +- entering group post-auth {...} ++[exec] returns noop Sending Access-Accept of id 60 to 192.168.18.1 port 1645 Finished request 0. Going to the next request Waking up in 4.9 seconds. Cleaning up request 0 ID 60 with timestamp +9 Ready to process requests. ****** end of debugging info ****** What I was expecting? I was expecting that the Access-Accept would have printed: print "***** testing auth\n"; print $RAD_REQUEST{'User-Name'}; print "\n ******\n"; But, as you see, it only printed: print "***** testing auth\n"; print "\n ******\n"; I was also expecting the Access-Accept to have: $RAD_REPLY{'h323-credit-amount'} = "100"; return RLM_MODULE_OK; But... it didn't happen as you can see. Version of FreeRADIUS: Tue Aug 2 16:55:46 2011 : Info: FreeRADIUS Version 2.1.10, for host x86_64-pc-linux-gnu, built on Nov 14 2010 at 21:12:30 Perl version: This is perl, v5.10.1 (*) built for x86_64-linux-gnu-thread-multi PS: I was able with users to add the desired attributes. Thank you for any help and best regards, FishSemXpinha - List info/subscribe/unsubscribe? See http://www.freeradius.org/list/users.html
