rlm_perl module crash on high load, need to restart service

5 Jun 2023

      Thanks Alen,

This is my perl script code which is a socket client for the swoole TCP
socket server.

use strict;
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use IO::Socket;
use locale;
use POSIX;
use JSON;

use Sys::Syslog;

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

setlocale(LC_ALL, 'C');

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

my $swoole;
my $answer;

sub logs
{
    my $err2 = @_[0];
    &radiusd::radlog(1, $err2);

#    uncomment to logs to syslog
   # syslog('info', $err2);

}

sub rtrim { my $s = shift; $s =~ s/\s+$//;       return $s };

sub socket_init {
    &logs("Opening connection to swoole\n");
    my $swoole = new IO::Socket::INET (
PeerAddr => '127.0.0.1',
PeerPort => '26312',
Proto => 'tcp'
    );

    # setsockopt($swoole, SOL_SOCKET, SO_KEEPALIVE, 1);
    &logs("Connect to swoole finish with error: $!\n") unless $swoole;
    return $swoole;
}

sub CLONE {
&logs('Cloning...');
$swoole=&socket_init;
}

sub check_connection() {
# swoole connection check...
if ((not defined $swoole) || (!$swoole->connected())) {
&logs("Try to reconnect to swoole\n");
$swoole=&socket_init;
}

if ((not defined $swoole) || (!$swoole->connected())) {
   return 0;
} else {
return 1;
    }

    }

sub authorize {
if (!check_connection()) {
   return RLM_MODULE_REJECT;
}

print  $swoole "::authorization::\n" .encode_json(\%RAD_REQUEST) . "\n"
.encode_json(\%RAD_REPLY) ."\n" .encode_json(\%RAD_CHECK);
$answer=<$swoole>;

    $answer=rtrim($answer);
    &logs("ans:".$answer);
    $answer=decode_json($answer);

    if ($answer->{radreply} ne "")
{
my $radreply = $answer->{radreply};
%RAD_REPLY=%{$radreply};
}

    if($answer->{radcheck} ne "")
    {
    my $radcheck = $answer->{radcheck};
    %RAD_CHECK=%{$radcheck};
    }

    if ($answer->{response} ne "accept") {
        return RLM_MODULE_REJECT;
    }

    return RLM_MODULE_OK;

}

sub authenticate {

if ($RAD_REPLY{'Packet-Type'} eq "Access-Reject") {
        return RLM_MODULE_REJECT;
    } else {
        return RLM_MODULE_OK;
    }

}

sub preacct {
return RLM_MODULE_OK;
}

sub accounting {
if (!check_connection()) {
    return RLM_MODULE_OK;
}
print  $swoole "::accounting::\n" . encode_json(\%RAD_REQUEST);
$answer=<$swoole>;
$answer=rtrim($answer);
    &logs("Accounting:".$answer);
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 post_auth {
return RLM_MODULE_OK;
}

Guide me if i made a mistake here..

Thanks
Imdad

Imdad Hasan

Ľudovít Mikula

tags

participants (2)