rlm_perl DBI problems

29 Apr 2009

      hi

I have some problem with perl module in freeradius

There are an errors after that radius is fall down

Tue Apr 28 19:23:07 2009 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/processing.pl , func = reject_log exit status=
Undefined subroutine &DBD::mysql::dr::reject_log called at
/usr/local/lib/perl5/site_perl/5.8.9/mach/DBD/mysql.pm line 142.

Tue Apr 28 19:45:41 2009 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/processing.pl , func = reject_log exit status=
Undefined subroutine &DBD::mysql::dr::reject_log called at
/usr/local/lib/perl5/site_perl/5.8.9/mach/DBD/mysql.pm line 142.

Wed Apr 29 15:11:52 2009 : Error: rlm_perl: perl_embed:: module =
/usr/local/etc/raddb/processing.pl , func = reject_log exit status=
Undefined subroutine &DBI::Const::GetInfo::ODBC::reject_log called at
/usr/local/lib/perl5/site_perl/5.8.9/mach/DBI/Const/GetInfo/ODBC.pm line
1337.

Here is a processing.pl

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;

my $username; 

my $debug       = '1';

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

sub reject_log {
    #
    # -- function to log rejected users in xml format
    #

    $username = $RAD_REQUEST{'User-Name'};
    $username =~ s/[^a-zA-Z0-9_-]//g;
    &radiusd::radlog(1, "DEBUG reject_log: RAD_REQUEST User-Name:
".$RAD_REQUEST{'User-Name'}) if $debug;
    &radiusd::radlog(1, "DEBUG reject_log: UserName: ".$username) if $debug;

    my $textlog;        #       /* !!! Don't comment this line !!! */
    # Uncomment next line for text log readable from unix console (by
default log in xml)
#    $textlog = '1';

    # Log file
    my $logfile = '/var/log/radreject.log' if $textlog;
    my $logfilexml = '/var/log/radreject.xml';
    open (LOG, ">>$logfile") or $RAD_REPLY{'Module-Failure-Message'} =
"rlm_rejectlog: Can't open logfile." if $textlog;
    open (LOGXML, ">>$logfilexml") or $RAD_REPLY{'Module-Failure-Message'} =
"rlm_rejectlog: Can't open xml logfile." and return RLM_MODULE_FAIL;
    my $now = localtime;

    if ($RAD_REQUEST{'Module-Failure-Message'} eq "rlm_chap: Wrong user
password") {
        print LOG $now.
        " Password incorrect [ ".
        $RAD_REQUEST{'User-Name'}
        ." ]. (from ".
        $RAD_REQUEST{'NAS-IP-Address'}
        ." client ".
        $RAD_REQUEST{'Calling-Station-Id'}
        .")\n" if $textlog;

        print LOGXML "<date>".
        $now
        ."</date><message>Password incorrect</message><login>".
        $RAD_REQUEST{'User-Name'}
        ."</login><nas>".
        $RAD_REQUEST{'NAS-IP-Address'}
        ."</nas><cli_mac>".
        $RAD_REQUEST{'Calling-Station-Id'}
        ."</cli_mac>\n";
    }
    elsif($RAD_REQUEST{'Module-Failure-Message'} eq "rlm_chap: Clear text
password not available") {
        print LOG $now.
        " Login incorrect [ ".
        $RAD_REQUEST{'User-Name'}
        ." ]. (from ".
        $RAD_REQUEST{'NAS-IP-Address'}
        ." client ".
        $RAD_REQUEST{'Calling-Station-Id'}
        .")\n" if $textlog;

        print LOGXML "<date>".
        $now
        ."</date><message>Login incorrect</message><login>".
        $RAD_REQUEST{'User-Name'}
        ."</login><nas>".
        $RAD_REQUEST{'NAS-IP-Address'}
        ."</nas><cli_mac>".
        $RAD_REQUEST{'Calling-Station-Id'}
        ."</cli_mac>\n";
    }
    else {
        close LOGXML;
        close LOG if $textlog;
        return RLM_MODULE_NOOP;
    }
    close LOGXML;
    close LOG if $textlog;
    return RLM_MODULE_UPDATED;
}

sub post_auth {
    #
    # -- this function add attributes to reply
    #

    use DBI;
    use Time::HiRes qw(usleep);

    my $dblogin             = 'radius';
    my $dbpass              = 'secret';
    my $dbname              = 'RADDB';

    my $dbh =
DBI->connect("dbi:mysql:dbname=$dbname","$dblogin","$dbpass",{PrintError =>
0})
    or &radiusd::radlog(1, "DEBUG post_auth: DBI error: ".$DBI::errstr) if
$debug;
    if ($DBI::err != 0) {
        usleep(100000);
        $RAD_REPLY {'Reply-Message'} = "Error connecting to database.";
        return RLM_MODULE_FAIL;
    }

    $username = $RAD_REQUEST{'User-Name'};
    $username =~ s/[^a-zA-Z0-9_-]//g;
    &radiusd::radlog(1, "DEBUG post_auth: RAD_REQUEST User-Name:
".$RAD_REQUEST{'User-Name'}) if $debug;
    &radiusd::radlog(1, "DEBUG post_auth: UserName: ".$username) if $debug;

    my $query = "CALL rad_reply('".$username."')";

    my $sth = $dbh->prepare($query);
    my $rv = $sth->execute();
    &radiusd::radlog(1, "DEBUG: query error: ".$sth->errstr) if $debug;

    if (!defined $rv) {
        usleep(100000);
        $RAD_REPLY {'Reply-Message'} = "Error executing SQL query.";

#
#
# -- why db disconnect don't work in next line? It's say that db connect
already closed
#
#
#       $dbh->disconnect();
        return RLM_MODULE_FAIL;
    }

    my $attr_hash = $sth->fetchrow_hashref();
    if ($attr_hash->{is_blocked} == '0'){
        $RAD_REPLY {'Filter-Id'} = 'allow';
    }
    $RAD_REPLY {'Framed-IP-Address'} = $attr_hash->{ip};
    $RAD_REPLY {'Framed-IP-Netmask'} = '255.255.255.255';
    if ($attr_hash->{attr} ne 'NULL'){
        $RAD_REPLY {'Mikrotik-Rate-Limit'} = $attr_hash->{attr};
    }
    $RAD_REPLY {'Session-Timeout'} = '86400';
#
# -- here is the same - don't work L
#
#    $dbh->disconnect;
    return RLM_MODULE_UPDATED;
}

Other files
raddb/modules/rejectlog
#
# This module made for loggin reject radius answers
# using perl function reject_log
#

perl rejectlog {
    module = /usr/local/etc/raddb/rejectlog.pl
    func_post_auth = reject_log
}

raddb/sites-enable/my-site
:
post-auth {
        Post-Auth-Type REJECT {
                attr_filter.access_reject

                #
                # Log failed logins to xml log file or to unix log.
                #
                rejectlog
        }
        # Perl
        perl
}
:

Radiusd work fine a little time - an hour or an 2-3 hours but then its fall
What can I do with that errors?

rlm_perl DBI problems

Александр Косых