freeradius + perl module gives wrong ip addresses

Hi, I'm trying to implement freeradius with perl module, but have strange bug, perl module gives wrong ip address, not that one which it takes from mysql, it is observed in freeradius debug, but the perl module itself gives right ip address in syslog messages.
Here is the piece of code-
Perl:
$dbh  = DBI->connect($dsn,$username,$password, \%attr);

        $SQL="SELECT * FROM radius_reply WHERE uname = '$user_name' and conn_type = 'dhcp'";
        $sth = $dbh->prepare($SQL);
        $sth->execute();
        $num_of_rows = $sth->rows;
        if($num_of_rows == 0){
                $message = "authenticate_dhcp, status: error, err_str: username not found, username: $user_name";
                $result = RLM_MODULE_REJECT;
        }elsif($num_of_rows == 1) {
                while (@row = $sth->fetchrow_array()) {
                        $RAD_REPLY{'Service-Type'} = 'Framed-User';
                        $RAD_REPLY{'Framed-Ip-Netmask'} = $row[5];
                        $RAD_REPLY{'Framed-Ip-Address'} = $row[4];
                        syslog(LOG_INFO, "$row[4] +++ $user_name");
                        syslog(LOG_INFO, "$RAD_REPLY{'Framed-Ip-Address'} +-+-+ $user_name");
                        $RAD_REPLY{'ERX-Service-Activate:1'} = $row[9];
                        $RAD_REPLY{'ERX-Client-Profile-Name'} = $row[10];
                }
                $message = "authenticate_dhcp, status: ok, username: $user_name";
                $result =  RLM_MODULE_OK;
        } else {
                $message = "authenticate_dhcp, status: error, err_str: username presents more than once, username: $user_name";
                $result = RLM_MODULE_REJECT;
        }
          $sth->finish();
          $dbh->disconnect();
                syslog(LOG_INFO, $message);

    }else{
        #$message = "authenticate_pppoe, status: ok, username: $user_name";
        #$result = RLM_MODULE_OK;
        #syslog(LOG_INFO, $message);
        $message = "authenticate_else, status: error, no ERX-DHCP-Header username: $user_name";
        $result = RLM_MODULE_REJECT;
        
    }
    return $result;
}
 
Perl:
$SQL="SELECT * FROM radius_reply WHERE uname = '$user_name' and conn_type = 'dhcp'"; 
$sth = $dbh->prepare($SQL); 
$sth->execute();
Bad code, it's vulnerable to SQL injection. A carefully selected 'user_name' will break this. You're using prepare and execute but you're using it incorrectly.

And I suggest turning on use strict;.

Perl:
my $SQL="SELECT * FROM radius_reply WHERE uname = ? and conn_type = 'dhcp'"; 
my $sth = $dbh->prepare($SQL); 
$sth->execute($user_name);

And I suggest refactoring the code a bit, don't nest too many times, it makes the code really hard to follow.

Good video about nesting:
View: https://www.youtube.com/watch?v=CFRhGnuXG-4

He uses Python in his examples but the same techniques can be applied to any other programming language.
 
Bad code, it's vulnerable to SQL injection. A carefully selected 'user_name' will break this. You're using prepare and execute but you're using it incorrectly.

And I suggest turning on use strict;.

Perl:
my $SQL="SELECT * FROM radius_reply WHERE uname = ? and conn_type = 'dhcp'";
my $sth = $dbh->prepare($SQL);
$sth->execute($user_name);

And I suggest refactoring the code a bit, don't nest too many times, it makes the code really hard to follow.

Good video about nesting:
View: https://www.youtube.com/watch?v=CFRhGnuXG-4

He uses Python in his examples but the same techniques can be applied to any other programming language.
the point is such -> actual code is giving right ip address, but freeradius ignores it sometimes and puts IP's of other users, not that one that is given by this piece of code
 
Where's the code that sends the $RAD_REPLY hash to the server? Perhaps the issue is in that function. If you say that this piece of code correctly provides the customer's IP then the issue must be happening in another piece of code.

I would still recommend adding use strict; because you may have a problem with the scope of certain variables. If $RAD_REPLY has a global scope it may contain old data (from a previous customer) stored in that hash.
 
Where's the code that sends the $RAD_REPLY hash to the server? Perhaps the issue is in that function. If you say that this piece of code correctly provides the customer's IP then the issue must be happening in another piece of code.

I would still recommend adding use strict; because you may have a problem with the scope of certain variables. If $RAD_REPLY has a global scope it may contain old data (from a previous customer) stored in that hash.
That right, it's seems that old data was int the scope of the previous client, but I can't understand the certain reason why it was so, here is the new code that working without bug:
Perl:
use strict;
use DBI;
use Switch;
use Data::Dumper;

our (%RAD_REQUEST, %RAD_REPLY, %RAD_CHECK);

use constant {
    RLM_MODULE_REJECT   => 0, # immediately reject the request
    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
};


our %DATA = (
    'user_name' => $RAD_REQUEST{'User-Name'},
    'session_id' => $RAD_REQUEST{'Acct-Session-Id'},
    'description' => $RAD_REQUEST{'ERX-Pppoe-Description'},
);



sub authorize {
    my $result;
    if(exists($RAD_REQUEST{'ERX-DHCP-Header'})){
        $RAD_CHECK{'Auth-Type'} = "Perl";
            my $message = "dhcp_authorize, status: ok, username: $RAD_REQUEST{'User-Name'}";
            my $result =  RLM_MODULE_UPDATED;
            &radiusd::radlog(1, $message);
            return $result;
    }else{
        # Something else
        my $result = RLM_MODULE_REJECT; 
    }
    return RLM_MODULE_UPDATED;
}



sub authenticate(){
    my $message;
    my $result;
    if(exists($RAD_REQUEST{'ERX-DHCP-Header'})){
    my $dbh = DBI->connect('DBI:mysql:radius_db', 'radius', 'password') || die "Could not connect to database: $DBI::errstr";
    my $un = $RAD_REQUEST{'User-Name'};
    my $SQL="SELECT * FROM radius_reply WHERE uname = '$un' and conn_type = 'dhcp'";
        my $sth = $dbh->prepare($SQL);
        $sth->execute();
        my $num_of_rows = $sth->rows;
        if($num_of_rows == 0){
                my $result = RLM_MODULE_REJECT;
        &radiusd::radlog(1, "$un not in database");
        }elsif($num_of_rows == 1) {
            my $row = $sth->fetchrow_hashref();
                        $RAD_REPLY{'Service-Type'} = 'Framed-User';
            $RAD_REPLY{'Framed-Ip-Address'} = $row->{ip_address};
                        $RAD_REPLY{'Framed-Ip-Netmask'} = $row->{mask};
                        $RAD_REPLY{'ERX-Service-Activate:1'} = $row->{rate};
                        $RAD_REPLY{'ERX-Client-Profile-Name'} = $row->{profile};
                $sth->finish();
                  $dbh->disconnect();
            &radiusd::radlog(1, "logged in with $RAD_REPLY{'Framed-Ip-Netmask'}, user $un");
            return RLM_MODULE_OK;
        } else {
              $sth->finish();
              $dbh->disconnect();
                return RLM_MODULE_REJECT;
        }
    }
}

sub post_auth {
    my $result;
    if(exists($RAD_REQUEST{'ERX-DHCP-Header'})){
        my $message = "post_auth_dhcp, status: ok, username: $RAD_REQUEST{'User-Name'}";
               my $result =  RLM_MODULE_OK;
    }else{
        my $result = RLM_MODULE_REJECT;
    }
    return RLM_MODULE_OK;
}

sub preacct {
    return RLM_MODULE_OK;
}

sub checksimul {
    return RLM_MODULE_OK;
}

sub pre_proxy {
    return RLM_MODULE_OK;
}

sub post_proxy {
    return RLM_MODULE_OK;
}


sub detach {
    &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
    return RLM_MODULE_OK;
}
 
Back
Top