====== Новый модуль авторизации mikbill.pl для Radius  ======

<alert type="danger">Работает только с версии 3.09.02, на версиях ниже могут быть проблемы так как со стороны ядра биллинга нет контроля соединения</alert>

  * Добавлена проверка соединения с ядром биллинга и его автоматическое восстановление
  * Добавлено логирование о потери связи

\\ Данный код заменить в файле /etc/raddb/mikbill.pl или /etc/freeradius/3.0/mikbill.pl
\\ После чего перезапустить радиус.

===== Changelog =====

  * 2024-11-26: Переписан модуль (добавлены проверки ответа от ядра, улучшен контроль соединения). 

===== Файл mikbill.pl =====
<alert type="warning">Обратите внимание на $host="127.0.0.1" и $port="22007" если они у вас отличаются!</alert>

<code perl>
use strict;
use warnings;
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use IO::Socket;
use Socket qw(SOL_SOCKET SO_KEEPALIVE SO_ERROR);
use locale;
use POSIX;
use serialize;
use Data::Dumper;

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 */
 
use constant	RADIUS_L_DBG=> 	       0;# /* debug log  */
use constant	RADIUS_L_AUTH=>	       1;# /* auth log   */
use constant	RADIUS_L_PROXY=>       2;# /* peroxy log */
use constant	RADIUS_L_INFO=>        3;# /* info log   */
use constant	RADIUS_L_ERROR=>       4;# /* error log  */
 
# mikbill daemon IP address and port
my $host="127.0.0.1";
my $port="22007";
my $tcp_keepidle = 60;  # 60 секунд
my $tcp_keepintvl = 10; # 10 секунд
my $tcp_keepcnt = 5;    # 5 попыток

# def
my $sock;
my $answer;

# Helper function for logging
sub log_message {
    my ($level, $message) = @_;
    &radiusd::radlog($level, $message);
}

sub socket_init {
	my $sock = new IO::Socket::INET (
	    PeerAddr => $host,
	    PeerPort => $port,
	    Proto => 'tcp',
	) or do {
         log_message(RADIUS_L_ERROR, "No connection with mikbill daemon ($host:$port)");
         return undef;
    };
 
	# Configure socket options
    setsockopt($sock, SOL_SOCKET, SO_KEEPALIVE, 1) or do {
        log_message(RADIUS_L_ERROR, "Failed to enable SO_KEEPALIVE: $!");
        return undef;
    };

    setsockopt($sock, Socket::IPPROTO_TCP(), Socket::TCP_KEEPIDLE(), $tcp_keepidle) or do {
        log_message(RADIUS_L_ERROR, "Failed to set TCP_KEEPIDLE: $!");
        return undef;
    };

    setsockopt($sock, Socket::IPPROTO_TCP(), Socket::TCP_KEEPINTVL(), $tcp_keepintvl) or do {
        log_message(RADIUS_L_ERROR, "Failed to set TCP_KEEPINTVL: $!");
        return undef;
    };

    setsockopt($sock, Socket::IPPROTO_TCP(), Socket::TCP_KEEPCNT(), $tcp_keepcnt) or do {
        log_message(RADIUS_L_ERROR, "Failed to set TCP_KEEPCNT: $!");
        return undef;
    };

    log_message(RADIUS_L_INFO, "Connected to mikbill successfully.");
    return $sock;
}

# Check if the socket is still connected
sub StillConnected {
    return unless defined $sock;
    return unless $sock->connected();

    my $error = getsockopt($sock, SOL_SOCKET, SO_ERROR);
    if (!defined $error) {
        log_message(RADIUS_L_ERROR, "getsockopt failed: $!");
        return;
    }

    if (!$error) {
        log_message(RADIUS_L_ERROR, "Socket error detected: $error");
        return;
    }

    return 1;
}

# Ensure socket is active, reinitialize if needed
sub check_socket {
    unless (&StillConnected()) {
        log_message(RADIUS_L_INFO, "Reinitializing socket...");
        return socket_init();
    }
    return $sock;
}

# Close the socket cleanly
sub close_socket {
    if (defined $sock) {
        $sock->close();
        undef $sock;
    }
}

# Deserialize safely
sub safe_unserialize {
    my ($data) = @_;
    my $result = eval { unserialize($data) };
    if ($@) {
        log_message(RADIUS_L_ERROR, "Deserialization failed: $@");
        log_message(RADIUS_L_DBG, "'$data'");
        return undef;
    }
    return $result;
}

# Main authorize function
sub authorize {
    return RLM_MODULE_REJECT unless &check_socket();

    my $result = RLM_MODULE_OK;
    eval {
        print $sock "auth\n";
        $answer = <$sock>;

        print $sock serialize(\%RAD_REQUEST);
        $answer = <$sock>;

        print $sock serialize(\%RAD_REPLY);
        $answer = <$sock>;

        print $sock serialize(\%RAD_CHECK);
        $answer = <$sock>;
        
        if ($answer eq "reject\n") {
            $result = RLM_MODULE_REJECT;
            return;
        }

        $answer = <$sock>;
        if ($answer eq "reject\n") {
            $result = RLM_MODULE_REJECT;
            return;
        }

        if ($answer eq " ") {
            $answer = <$sock>;
        }

        if ($answer eq "accept\n") {
            $answer = <$sock>;
        }

        my $unserialized_reply = safe_unserialize($answer);
        if (defined $unserialized_reply && ref($unserialized_reply) eq 'HASH') {
            %RAD_REPLY = %{$unserialized_reply};
        } else {
            log_message(RADIUS_L_DBG, "failed unserialize RAD_REPLY: " . Dumper($unserialized_reply));
            $result = RLM_MODULE_REJECT;
            return;
        }

        $answer = <$sock>;
        my $unserialized_check = safe_unserialize($answer);
        if (defined $unserialized_check && ref($unserialized_check) eq 'HASH') {
            %RAD_CHECK = %{$unserialized_check};
        } else {
            log_message(RADIUS_L_DBG, "failed unserialize RAD_CHECK: " . Dumper($unserialized_check));
            $result = RLM_MODULE_REJECT;
            return;
        }
    };
    
    if ($@) {
        log_message(RADIUS_L_ERROR, "Authorize error: $@");
        $result = RLM_MODULE_REJECT;
    }

    return $result;
}

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

# Accounting function
sub accounting {
    return RLM_MODULE_OK unless &check_socket();

    eval {
        print $sock "acct\n";
        $answer = <$sock>;

        print $sock serialize(\%RAD_REQUEST);
    };
    if ($@) {
        log_message(RADIUS_L_ERROR, "Accounting error: $@");
    }

    return RLM_MODULE_OK;
}

# Log RADIUS request attributes
sub log_request_attributes {
    for (keys %RAD_REQUEST) {
        log_message(RADIUS_L_INFO, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
    }
}

sub CLONE {
	$sock=&socket_init;
}

# Lifecycle management functions
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 post_auth   { return authorize(); }
sub xlat        { log_message(RADIUS_L_INFO, "xlat not implemented"); }
sub detach      { log_message(RADIUS_L_INFO, "rlm_perl::Detaching. Done."); }
sub test_call   { log_message(RADIUS_L_INFO, "Test call invoked."); }

1;
</code>