rlm_perl problem (Detaching!!)
Rohaizam Abu Bakar
haizam at myjaring.net
Fri Feb 9 05:42:44 CET 2007
Hi..
FR: 1.1.2
FBSD: 6.0
My rlm_perl keep logging error as example below. Everytime this happen
radiusd will hang and DO NOT respond to any request.
But this NEVER happen while running in debug mode and working fine.
rlm_perl is used to load timeout based on certain rules.. u can see below my
perl script (newtimeou5.pl) and also config files setting.
Please help TQ.
Error /var/log/radius.log
##################################################################################
Thu Feb 8 12:30:09 2007 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/newtimeout4.pl , func = authorize exit status=
Undefined subroutine &main:: called.
Thu Feb 8 12:32:00 2007 : rlm_perl: rlm_perl::Detaching. Reloading. Done.
Thu Feb 8 12:39:46 2007 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/newtimeout4.pl , func = authorize exit status= panic:
leave_scope inconsistency at /usr/local/etc/raddb/newtimeout4.pl line 184.
Thu Feb 8 12:39:47 2007 : rlm_perl: rlm_perl::Detaching. Reloading. Done.
Thu Feb 8 14:08:52 2007 : rlm_perl: rlm_perl::Detaching. Reloading. Done.
Thu Feb 8 14:22:40 2007 : rlm_perl: rlm_perl::Detaching. Reloading. Done.
Thu Feb 8 14:57:25 2007 : rlm_perl: rlm_perl::Detaching. Reloading. Done.
Fri Feb 9 09:53:52 2007 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/newtimeout5.pl , func = authorize exit status= Usage:
Encode::is_utf8(sv, check = 0) at
/usr/local/lib/perl5/site_perl/5.8.7/Convert/ASN1.pm line 422, <DATA> line
424.
Fri Feb 9 10:21:59 2007 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/newtimeout5.pl , func = authorize exit status=
Undefined subroutine &Convert::ASN1::authorize called at
/usr/local/lib/perl5/site_perl/5.8.7/Net/LDAP.pm line 759
Fri Feb 9 10:57:59 2007 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/newtimeout5.pl , func = preacct exit status=
Undefined subroutine &Convert::ASN1::preacct called at
/usr/local/lib/perl5/site_perl/5.8.7/Net/LDAP.pm line 759
####################################################
######################users############################
DEFAULT NAS-Identifier == "Wireless-802.11", Autz-Type := Y5,
Auth-Type :Y5
########################################################
#################radiusd.conf#################################
authorize {
Autz-Type Y5 {
redundant {
ldapy51
ldapy52
}
y5perl
}
}
modules {
perl y5perl {
module = /usr/local/etc/raddb/newtimeout5.pl
}
}
authenticate {
Auth-Type Y5 {
redundant {
ldapy51
ldapy52
}
}
}
##########################################################
#######################newtimeout5.pl########################
sub authorize {
##main
my $return_value = 0;
$return_value = &timeout;
print "VALUE return: $return_value\n";
if ($return_value eq '-1'){
return RLM_MODULE_REJECT;
}else{
return RLM_MODULE_OK;
}
}
sub timeout {
my $query;
my $query2;
my $uid=$RAD_REQUEST{'User-Name'};
my $userfrom;
my $userconnect=$RAD_REQUEST{'NAS-Identifier'};
my $timeout;
################################
if ($userconnect =~ /Wireless-802.11|WiFi/) {
$query="Service";
$query2 = "TimeoutWIFI";
}
if ($query){
$userfrom = ldapquery($uid,$query);
if ($userfrom =~ /Y5PLAT|Y5GOLD/){
$userfrom = "WiFi-BTP";
}elsif ($userfrom =~ /^Y5$/){
$userfrom = "Wireless-802.11";
}
if ($userconnect eq $userfrom){
print "rlm_perl: Local user.. No timeout.. Unlimited!!!\n";
return (1);
}elsif ($userconnect ne $userfrom){
print "rlm_perl: Roaming user.. Timeout will be loaded
!!\n";
$timeout = ldapquery($uid,$query2);
print "rlm_perl: $query2:$timeout\n";
if (!$timeout){
return (-1);
}else{
$RAD_REPLY{'Session-Timeout'} = $timeout;
print "rlm_perl: NOT YET....\n";
return (1);
}
}
}else{
print "rlm_perl: Not a wifi connection !!!\n";
return (1);
}
}
sub ldapquery {
my ( $uid, $query ) = @_;
my $host = "xxxxxxxxxx";
my $value;
my $baseDN = "ou=Y5,ou=AAA, ou=xxxxx, dc=xxxxx, dc=xxxx";
my $ldap = Net::LDAP->new( $host ) or die "$@";
my $mesg = $ldap->bind ; # an anonymous bind
$mesg = $ldap->search( # perform a search
base => $baseDN,
filter => "(&(uid=$uid))"
);
my $count = $mesg->count;
if ($mesg->code) {
return ("NULL");
}
if ($count < 0 ){
return ("NULL");
}elsif ($count > 0){
for ( my $i = 0 ; $i < $count ; $i++ ) {
my $entry = $mesg->entry ( $i );
my $data = $entry->dn;
$value = $entry->get_value($query);
}
}
$mesg = $ldap->unbind;
return ($value);
}
More information about the Freeradius-Users
mailing list