rlm_perl problem (Detaching!!)

8 Feb 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);
}

rlm_perl problem (Detaching!!)

Rohaizam Abu Bakar