Итак, некоторые, кхм, недоработки, приводящие к проблемам с rlm_perl (предварительные результаты):
1) post_auth вызывается "как есть" из auth.pm - что есть неверно. Добавляем в конфиг радиуса вызов враппера с инициализацией скл соединения:
2) в журналирование в Nas.pm стоит добавить установку $db (а в идеале - вообще выкинуть журналирование оттуда, т.к. ф-и журналирования в нескольких местах - ИМХО избыточны. Но это я возможно сделаю позже - если
~Asmodeus~ согласится включить доработку в основное дерево):
Код: Выделить всё
--- Nas.pm.orig 2009-10-12 21:46:48.000000000 +0300
+++ Nas.pm 2009-10-12 21:46:14.000000000 +0300
@@ -523,6 +523,7 @@
%DATA = $self->get_data($attr);
# $date, $time, $log_type, $action, $user, $message
$DATA{MESSAGE} =~ s/'/\\'/g;
+ $db = $DATA{DB} if (defined $DATA{DB});
$self->query($db, "INSERT INTO errors_log (date, log_type, action, user, message, nas_id)
values (now(), '$DATA{LOG_TYPE}', '$DATA{ACTION}', '$DATA{USER_NAME}', '$DATA{MESSAGE}', '$self->{NAS_ID}');", 'do');
3) модифицирован rauth.pl (новое имя - rauth.pl.inc) - выкинут лишний код, в перспективе - подключать его как библиотеку ф-й к rauth.pl для rlm_exec
Код: Выделить всё
--- rauth.pl 2009-05-19 12:56:01.000000000 +0300
+++ rauth.pl.inc 2009-10-12 22:05:03.000000000 +0300
@@ -22,8 +22,8 @@
# Max session tarffic limit (Mb)
my %auth_mod = ();
require Abills::SQL;
-my $sql = Abills::SQL->connect($conf{dbtype}, $conf{dbhost}, $conf{dbname}, $conf{dbuser}, $conf{dbpasswd});
-my $db = $sql->{db};
+#my $sql = Abills::SQL->connect($conf{dbtype}, $conf{dbhost}, $conf{dbname}, $conf{dbuser}, $conf{dbpasswd});
+#my $db = $sql->{db};
require Nas;
$nas = undef;
@@ -47,14 +47,18 @@
my $Nas = $attr->{NAS};
+ my $db = undef;
if ($conf{debugmods} =~ /$LOG_TYPE/) {
if ($conf{ERROR2DB} && $attr->{NAS}) {
+
+ $db = $attr->{DB} if ($attr->{DB});
$Nas->log_add({LOG_TYPE => $log_levels{$LOG_TYPE},
ACTION => 'AUTH',
USER_NAME=> "$USER_NAME",
- MESSAGE => "$MESSAGE"
+ MESSAGE => "$MESSAGE",
+ DB => $db
});
}
@@ -65,34 +69,6 @@
};
-my $RAD = get_radius_params();
-if ($RAD->{NAS_IP_ADDRESS}) {
- my $ret = get_nas_info($db, $RAD);
- if (defined($ARGV[0]) && $ARGV[0] eq 'pre_auth') {
- auth($db, $RAD, undef, { pre_auth => 1 });
- exit 0;
- }
- elsif (defined($ARGV[0]) && $ARGV[0] eq 'post_auth') {
- post_auth($RAD);
- exit 0;
- }
-
-
- if($ret == 0) {
- $ret = auth($db, $RAD, $nas);
- }
- #$db->disconnect();
-
- if ($ret == 0) {
- print $rr;
- }
- else {
- print "Reply-Message = \"$RAD_REPLY{'Reply-Message'}\"\n";
- }
-
- exit $ret;
-}
-
#*******************************************************************
# get_nas_info();
@@ -113,16 +89,16 @@
#
if (defined($nas->{errno}) || $nas->{TOTAL} < 1) {
# (defined($RAD->{NAS_IDENTIFIER})) ? $RAD->{NAS_IDENTIFIER} : ''
- access_deny("$RAD->{USER_NAME}", "Unknow server '$RAD->{NAS_IP_ADDRESS}' [$nas->{errno}] $nas->{errstr}", 0);
+ access_deny($db, $RAD, "$RAD->{USER_NAME}", "Unknow server '$RAD->{NAS_IP_ADDRESS}' [$nas->{errno}] $nas->{errstr}", 0);
$RAD_REPLY{'Reply-Message'}="Unknow server '$RAD->{NAS_IP_ADDRESS}'";
return 1;
}
elsif(! defined($RAD->{USER_NAME}) || $RAD->{USER_NAME} eq '') {
- #access_deny("$RAD->{USER_NAME}", "Disabled NAS server '$RAD->{NAS_IP_ADDRESS}'", 0);
+ #access_deny($db, $RAD, "$RAD->{USER_NAME}", "Disabled NAS server '$RAD->{NAS_IP_ADDRESS}'", 0);
return 1;
}
elsif($nas->{NAS_DISABLE} > 0) {
- access_deny("$RAD->{USER_NAME}", "Disabled NAS server '$RAD->{NAS_IP_ADDRESS}'", 0);
+ access_deny($db, $RAD, "$RAD->{USER_NAME}", "Disabled NAS server '$RAD->{NAS_IP_ADDRESS}'", 0);
return 1;
}
@@ -150,7 +126,7 @@
$auth_mod{'default'} = Auth->new($db, \%conf);
$r = $auth_mod{'default'}->pre_auth($RAD);
if ($auth_mod{'default'}->{errno}) {
- $log_print->('LOG_INFO', $RAD->{USER_NAME}, "MS-CHAP PREAUTH FAILED$GT", { NAS => $nas });
+ $log_print->('LOG_INFO', $RAD->{USER_NAME}, "MS-CHAP PREAUTH FAILED$GT", { NAS => $nas, DB => $db });
}
else {
while(my($k, $v)=each(%{ $auth_mod{'default'}->{'RAD_CHECK'} })) {
@@ -163,7 +139,6 @@
$rr = '';
-
if(defined($AUTH{$nas->{NAS_TYPE}})) {
if (! defined($auth_mod{"$nas->{NAS_TYPE}"})) {
require $AUTH{$nas->{NAS_TYPE}} . ".pm";
@@ -195,7 +170,7 @@
}
my $CID = ($RAD->{CALLING_STATION_ID}) ? " CID: $RAD->{CALLING_STATION_ID} " : '';
- access_deny("$RAD->{USER_NAME}", "$message$CID", $nas->{NAS_ID});
+ access_deny($db, $RAD, "$RAD->{USER_NAME}", "$message$CID", $nas->{NAS_ID});
$RAD_CHECK{'Auth-Type'} = 'Reject';
return $r;
}
@@ -233,7 +208,7 @@
}
}
- $log_print->('LOG_DEBUG', $RAD->{USER_NAME}, "$rr", { NAS => $nas});
+ $log_print->('LOG_DEBUG', $RAD->{USER_NAME}, "$rr", { NAS => $nas, DB => $db});
}
if ($begin_time > 0) {
@@ -246,7 +221,7 @@
my $CID = ($RAD->{CALLING_STATION_ID}) ? " CID: $RAD->{CALLING_STATION_ID} " : '';
- $log_print->('LOG_INFO', $RAD->{USER_NAME}, "$CID$GT", { NAS => $nas});
+ $log_print->('LOG_INFO', $RAD->{USER_NAME}, "$CID$GT", { NAS => $nas, DB => $db});
return $r;
}
@@ -256,21 +231,21 @@
# post_auth()
#*******************************************************************
sub post_auth {
- my ($RAD) = @_;
+ my ($db, $RAD) = @_;
my $reject_info = '';
if (defined(%RAD_REQUEST)) {
# return 0;
if ($RAD_REQUEST{'Calling-Station-Id'}) {
$reject_info=" CID $RAD_REQUEST{'Calling-Station-Id'}";
}
- $log_print->('LOG_WARNING', $RAD_REQUEST{'User-Name'}, "REJECT Wrong password $reject_info$GT", { NAS => $nas});
+ $log_print->('LOG_WARNING', $RAD_REQUEST{'User-Name'}, "REJECT Wrong password $reject_info$GT", { NAS => $nas, DB => $db});
return 0;
}
else {
if ($RAD->{CALLING_STATION_ID}) {
$reject_info=" CID $RAD->{CALLING_STATION_ID}";
}
- $log_print->('LOG_WARNING', $RAD->{USER_NAME}, "REJECT Wrong password$reject_info$GT", { NAS => $nas});
+ $log_print->('LOG_WARNING', $RAD->{USER_NAME}, "REJECT Wrong password$reject_info$GT", { NAS => $nas, DB => $db});
}
# return RLM_MODULE_OK;
@@ -282,9 +257,9 @@
# access_deny($user, $message);
#*******************************************************************
sub access_deny {
- my ($user_name, $message, $nas_num) = @_;
+ my ($db, $RAD, $user_name, $message, $nas_num) = @_;
- $log_print->('LOG_WARNING', $user_name, "$message", { NAS => $nas});
+ $log_print->('LOG_WARNING', $user_name, "$message", { NAS => $nas, DB => $db});
#External script for error connections
if ($conf{AUTH_ERROR_CMD}) {
4) Собссно модификация rlm_perl.pl (пока - черновой, но вроде рабочий набросок - по крайней мере аутентификация):
Код: Выделить всё
--- rlm_perl.pl.orig 2008-11-12 10:59:23.000000000 +0200
+++ rlm_perl.pl 2009-10-12 22:11:25.000000000 +0300
@@ -10,7 +10,7 @@
# This is hash wich hold original request from radius
-#my %RAD_REQUEST;
+my %RAD_REQ = ();
# In this hash you add values that will be returned to NAS.
#my %RAD_REPLY;
#This is for check items
@@ -36,7 +36,7 @@
require $Bin ."/config.pl";
unshift(@INC, $Bin . '/../', $Bin . "/../Abills/$conf{dbtype}");
-require $Bin ."/rauth.pl";
+require $Bin ."/rauth.pl.inc";
require $Bin ."/racct.pl";
$nas = undef;
@@ -48,25 +48,26 @@
#**********************************************************
sub sql_connect {
my $sql = Abills::SQL->connect($conf{dbtype}, $conf{dbhost}, $conf{dbname}, $conf{dbuser}, $conf{dbpasswd});
- my $db = $sql->{db};
+# my $db = $sql->{db};
#$rc = $dbh->ping;
- $RAD_REQUEST{NAS_IDENTIFIER}='' if (! $RAD_REQUEST{NAS_IDENTIFIER});
+ $RAD_REQ{NAS_IDENTIFIER}='' if (! $RAD_REQ{NAS_IDENTIFIER});
- if (! $NAS_INFO{$RAD_REQUEST{NAS_IP_ADDRESS}.'_'.$RAD_REQUEST{NAS_IDENTIFIER}}) {
- $nas = Nas->new($db, \%conf);
- if (get_nas_info($db, \%RAD_REQUEST) == 0) {
- $NAS_INFO{$RAD_REQUEST{NAS_IP_ADDRESS}.'_'.$RAD_REQUEST{NAS_IDENTIFIER}}=$nas;
+ if (! $NAS_INFO{$RAD_REQ{NAS_IP_ADDRESS}.'_'.$RAD_REQ{NAS_IDENTIFIER}}) {
+ $nas = Nas->new($sql->{db}, \%conf);
+ if (get_nas_info($sql->{db}, \%RAD_REQ) == 0) {
+ $NAS_INFO{$RAD_REQ{NAS_IP_ADDRESS}.'_'.$RAD_REQ{NAS_IDENTIFIER}}=$nas;
}
else {
return;
}
}
else {
- $nas = $NAS_INFO{$RAD_REQUEST{NAS_IP_ADDRESS}.'_'.$RAD_REQUEST{NAS_IDENTIFIER}};
+ $nas = $NAS_INFO{$RAD_REQ{NAS_IP_ADDRESS}.'_'.$RAD_REQ{NAS_IDENTIFIER}};
+ $nas->{db} = $sql->{db};
}
- return $db;
+ return $sql;
}
#**********************************************************
@@ -74,43 +75,74 @@
#
#**********************************************************
sub authorize {
+
$begin_time = check_time();
convert_radpairs();
- my $db = sql_connect();
+ my $sql = sql_connect();
+
+ my $return = RLM_MODULE_REJECT;
- if ( $db ) {
- if (auth($db, \%RAD_REQUEST, $nas, { pre_auth => 1 }) == 0) {
- if ( auth($db, \%RAD_REQUEST, $nas) == 0 ) {
+ if ( $sql->{db} ) {
+ if (auth($sql->{db}, \%RAD_REQ, $nas, { pre_auth => 1 }) == 0) {
+ if ( auth($sql->{db}, \%RAD_REQ, $nas) == 0 ) {
#$RAD_CHECK{'User-Password'} = 'test12345';
- return RLM_MODULE_OK;
+ $return = RLM_MODULE_OK;
}
}
+ $sql->{db}->disconnect;
+ $sql->{db}=undef;
+ }
+
+ return $return;
+}
+
+sub postauth {
+
+ $begin_time = check_time();
+
+ convert_radpairs();
+
+ my $sql = sql_connect();
+
+ my $return = RLM_MODULE_REJECT;
+
+ if ( $sql->{db} ) {
+ if (post_auth($sql->{db}, \%RAD_REQ)) {
+# $return = RLM_MODULE_OK;
+ }
+ $sql->{db}->disconnect;
+ $sql->{db}=undef;
}
- return RLM_MODULE_REJECT;
+ return $return;
}
+
#**********************************************************
# Function to handle authenticate
#
#**********************************************************
sub authenticate {
+
$begin_time = check_time();
convert_radpairs();
- my $db = sql_connect();
+ my $sql = sql_connect();
+ my $return = RLM_MODULE_REJECT;
- if ( $db ) {
- if ( auth($db, \%RAD_REQUEST, $nas) == 0 ) {
- return RLM_MODULE_OK;
+ if ( $sql->{db} ) {
+ if ( auth($sql->{db}, \%RAD_REQ, $nas) == 0 ) {
+ $return = RLM_MODULE_OK;
}
+ $sql->{db}->disconnect;
+ $sql->{db}=undef;
}
#$RAD_CHECK{'Auth-Type'} = 'Accept';
#return RLM_MODULE_OK;
- return RLM_MODULE_REJECT;
+ return $return;
}
@@ -122,9 +154,11 @@
$begin_time = check_time();
convert_radpairs();
- my $db = sql_connect();
- if ( $db ) {
- my $ret = acct($db, \%RAD_REQUEST, $nas);
+ my $sql = sql_connect();
+ if ( $sql->{db} ) {
+ my $ret = acct($sql->{db}, \%RAD_REQ, $nas);
+ $sql->{db}->disconnect;
+ $sql->{db}=undef;
}
return RLM_MODULE_OK;
@@ -142,7 +176,7 @@
$k =~ tr/[a-z]/[A-Z]/;
$r{$k}=$v;
}
- %RAD_REQUEST = %r;
+ %RAD_REQ = %r;
}
Это все вокруг аутентификации. Аккаунтингом еще не занимался. To be continued...
P.S. У кого есть желание потестить или кто заметит явные ошибки - буду признателен за ответы.
Я ошибаюсь? Или нет?
Конкретного решения, кроме апдейта до 5.10 я так понял нет?