FreeRadius 3.0.1 perl module attr problem

5 Mar 2014

      Hi

I'm trying to move my freeradius 2.2 configuration to new installed 3.0.1.
All seem to work but perl clean up some attributes empty.

This is my test perl script

use strict;
use warnings;

# use ...
use Data::Dumper;
use DBI;                        # mysql information base

#
# Configuration parameters

use constant {
    DEBUG => '1', # for debuggin
    #
    # database parameters
    DB_HOSTNAME => 'db.example.com',
    DB_NAME     => 'radius',
    DB_USER     => 'radius',
    DB_PASS     => 'secret'
};

# Bring the global hashes into the package scope
our (%RAD_REQUEST, %RAD_REPLY, %RAD_CHECK);

#
# This the remapping of return values
#
use constant {

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

# Same as src/include/radiusd.h
    L_DBG => 1,
    L_AUTH => 2,
    L_INFO => 3,
    L_ERR => 4,
    L_PROXY => 5,
    L_ACCT => 6
};

our $dbh;

# Connecting datebase
sub CLONE {
    $dbh =
DBI->connect("dbi:mysql:dbname=".DB_NAME.";host=".DB_HOSTNAME,DB_USER,DB_PASS,{PrintError
=> 0})
    or &radiusd::radlog(L_DBG, "DEBUG post_auth: DBI error:
".$DBI::errstr);
    if (!defined($dbh)) {
        &err_out;
        &radiusd::radlog(L_ERR, "can't connect to database!");

        $RAD_REPLY {'Reply-Message'} = "Internal server error";
        return RLM_MODULE_FAIL;
    }
}

sub authorize {
    print Dumper (%RAD_REQUEST);
    return RLM_MODULE_OK;
}

And the radius -X output
This one without perl script
Ready to process requests.
rad_recv: Access-Request packet from host 192.168.20.240 port 1812, id=62,
length=205
    User-Name = 'test_jur'
    CHAP-Password = 0x01cc75f2ddb427d70
    CHAP-Challenge = 0xea55985e715e3e1f
    Service-Type = Framed-User
    Framed-Protocol = PPP
    NAS-Identifier = 'test-se600'
    NAS-Port = 50462720
    NAS-Real-Port = 838860811
    NAS-Port-Type = Virtual
    NAS-Port-Id = '3/2 vlan-id 11 pppoe 60'
    Medium-Type = DSL
    Mac-Addr = '00-50-56-84-69-59'
    Platform-Type = SE-600
    OS-Version = '12.1.1.5'
(5) # Executing section authorize from file
/usr/local/etc/raddb/sites-available/pppoe
(5)   authorize {
(5)   filter_username filter_username {
(5)    ? if (!User-Name)
(5)    ? if (!User-Name) -> FALSE
(5)    ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)
(5)    ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)  -> FALSE
(5)    ? if (User-Name == 'Redback')
(5)    ? if (User-Name == 'Redback') -> FALSE
(5)    ? if (User-Name =~ / /)
(5)    ? if (User-Name =~ / /)  -> FALSE
(5)    ? if (User-Name =~ /@.*@/ )
(5)    ? if (User-Name =~ /@.*@/ )  -> FALSE
(5)    ? if (User-Name =~ /\\.\\./ )
(5)    ? if (User-Name =~ /\\.\\./ )  -> FALSE
(5)    ? if (User-Name =~ /\\.$/)
(5)    ? if (User-Name =~ /\\.$/)   -> FALSE
(5)    ? if (User-Name =~ /@\\./)
(5)    ? if (User-Name =~ /@\\./)   -> FALSE
(5)   } # filter_username filter_username = notfound
(5)   [preprocess] = ok
(5)   ? if (OS-Version == '12.1.1.5')
(5)   ? if (OS-Version == '12.1.1.5')  -> TRUE
(5)   if (OS-Version == '12.1.1.5')  { ... } # empty sub-section is ignored
.....

And this one with perl
rad_recv: Access-Request packet from host 192.168.20.240 port 1812, id=60,
length=205
    User-Name = 'test_jur'
    CHAP-Password = 0x016dbecc2a777
    CHAP-Challenge = 0xec96dfb8b8af
    Service-Type = Framed-User
    Framed-Protocol = PPP
    NAS-Identifier = 'test-se600'
    NAS-Port = 50462720
    NAS-Real-Port = 838860811
    NAS-Port-Type = Virtual
    NAS-Port-Id = '3/2 vlan-id 11 pppoe 58'
    Medium-Type = DSL
    Mac-Addr = '00-50-56-84-69-59'
    Platform-Type = SE-600
    OS-Version = '12.1.1.5'
(0) # Executing section authorize from file
/usr/local/etc/raddb/sites-available/pppoe
(0)   authorize {
$VAR1 = 'OS-Version';
$VAR2 = '';
$VAR3 = 'NAS-Port-Type';
$VAR4 = 'Virtual';
$VAR5 = 'NAS-Real-Port';
$VAR6 = '838860811';
$VAR7 = 'CHAP-Password';
$VAR8 = '0x016dbecc2a777';
$VAR9 = 'Service-Type';
$VAR10 = 'Framed-User';
$VAR11 = 'Medium-Type';
$VAR12 = 'DSL';
$VAR13 = 'Framed-Protocol';
$VAR14 = 'PPP';
$VAR15 = 'User-Name';
$VAR16 = '';
$VAR17 = 'CHAP-Challenge';
$VAR18 = '0xec96dfb8b8af';
$VAR19 = 'NAS-Identifier';
$VAR20 = '';
$VAR21 = 'Platform-Type';
$VAR22 = 'SE-600';
$VAR23 = 'NAS-Port';
$VAR24 = '50462720';
$VAR25 = 'Mac-Addr';
$VAR26 = '';
$VAR27 = 'NAS-Port-Id';
$VAR28 = '';
rlm_perl: Added pair OS-Version =
rlm_perl: Added pair NAS-Port-Type = Virtual
rlm_perl: Added pair NAS-Real-Port = 838860811
rlm_perl: Added pair CHAP-Password = 0x016dbecc2a777
rlm_perl: Added pair Service-Type = Framed-User
rlm_perl: Added pair Medium-Type = DSL
rlm_perl: Added pair Framed-Protocol = PPP
rlm_perl: Added pair User-Name =
rlm_perl: Added pair CHAP-Challenge = 0xec96dfb8b8af
rlm_perl: Added pair NAS-Identifier =
rlm_perl: Added pair Platform-Type = SE-600
rlm_perl: Added pair NAS-Port = 50462720
rlm_perl: Added pair Mac-Addr =
rlm_perl: Added pair NAS-Port-Id =
(0)   [perl_pppoe] = ok
(0)   filter_username filter_username {
(0)    ? if (!User-Name)
(0)    ? if (!User-Name) -> FALSE
(0)    ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)
(0)    ? if (User-Name =~ /([0-9A-F]{2}[:-]){5}([0-9A-F]{2})$/)  -> FALSE
(0)    ? if (User-Name == 'Redback')
(0)    ? if (User-Name == 'Redback') -> FALSE
(0)    ? if (User-Name =~ / /)
(0)    ? if (User-Name =~ / /)  -> FALSE
(0)    ? if (User-Name =~ /@.*@/ )
(0)    ? if (User-Name =~ /@.*@/ )  -> FALSE
(0)    ? if (User-Name =~ /\\.\\./ )
(0)    ? if (User-Name =~ /\\.\\./ )  -> FALSE
(0)    ? if (User-Name =~ /\\.$/)
(0)    ? if (User-Name =~ /\\.$/)   -> FALSE
(0)    ? if (User-Name =~ /@\\./)
(0)    ? if (User-Name =~ /@\\./)   -> FALSE
(0)   } # filter_username filter_username = ok
(0)   [preprocess] = ok
(0)   ? if (OS-Version == '12.1.1.5')
(0)   ? if (OS-Version == '12.1.1.5')  -> FALSE
....

As you can see in the second -X output perl cleared some attributes:
OS-Version (which I tested with if statement after perl)
User-Name
NAS-Identifier
Mac-Addr
NAS-Port-Id

Why is it so? Did I do something wrong or it's a perl bug?

P.S. In 2.2 this perl script work fine.

*Regards,*
*Alexander.*

FreeRadius 3.0.1 perl module attr problem

Alexander Kosykh