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_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.