rml_perl is not adding attributes to Access-accept

2 Aug 2011

      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 <bjordanov@orbitel.bg>
#

#
# 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

rml_perl is not adding attributes to Access-accept

Igor Xpinha