Ok, here it goes. The Perl script and SQL schema are in attachment.
Best regards,
Julien Leloup
Alan DeKok a écrit :
Julien Leloup wrote:
My question is, do I have to make this script (and SQL schema I suppose)
available in the FreeRadius CVS ? I'm not sure it's the kind of script
usefull for a large panel of FreeRadius users, but if I have to make it
available (maybe to respect GPLv2 or if someone is interested by this
script) it's not a problem.
Post it to the list. Or if it's large, as a new feature request to
bugs.freeradius.org.
Alan DeKok.
-
List info/subscribe/unsubscribe? See http://www.freeradius.org/list/users.html
#!/usr/bin/perl
use strict;
use DBI;
# This is very important ! Without this script will not get the filled hashesh
from main.
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK %RAD_REQUEST_PROXY
%RAD_REQUEST_PROXY_REPLY);
use Data::Dumper;
# Types de retour possibles (code standard FreeRadius)
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
*/
# Fonction appellee en phase post-proxy
sub post_proxy {
# Liste des attributs presents en phase Post-Proxy : debug uniquement
# &log_attributes;
# Recuperation des attributs de QoS Redback, provenant du serveur
Radius distant
my $class = $RAD_REQUEST_PROXY_REPLY{'Class'};
if( !$class ) {
&radiusd::radlog(4, "Attribut Class absent : utilisation du
profil de QoS par défaut");
# La valeur de l'attribut Class n'a pas ete trouvee dans la
reponse du Radius distant.
# On passe sur un profil de QoS par défaut
$class = "default_class";
# return RLM_MODULE_REJECT;
}
# Recuperation du Circuit-Id
my $circuit = $RAD_REQUEST{'ADSL-Agent-Circuit-Id'};
if( !$circuit ) {
&radiusd::radlog(4, "Attribut Circuit Id absent");
# La valeur de l'attribut Circuit Id n'a pas ete trouvée dans
la requete d'origine.
return RLM_MODULE_REJECT;
}
my $dbp =
DBI->connect("dbi:mysql:database=radius;host=127.0.0.1","radius","radius") or
die "Connection au serveur MySQL impossible!";
# Requête SQL de matching des attributs de QoS Alcatel-Lucent et Redback
# Les signes '?' seront remplacés à l'exécution par de vraies valeurs
(protection contre les injections SQL)
my $requete=" SELECT SLA_Profile, Sub_Profile, COUNT(*)
FROM qos
WHERE class=?
GROUP BY SLA_Profile, Sub_Profile;";
# Préparation de la requête SQL
my $result = $dbp->prepare($requete);
#exécution de la requête sql
$result-> execute($class) || die "Probleme de mapping QoS :
$DBI::errstr";
# Récupération des résultats de la requête
# Attention : la requête peut retourner plus d'une ligne
my ($sla, $sub, $count) = $result->fetchrow_array;
if(!defined($count)) {
&radiusd::radlog(4, "Erreur lors du mapping attributs de QoS :
aucune correspondance, utilisation d'un profil par défaut");
# La requête n'a pas retournée de ligne : on utilise un profil
de QoS par défaut
$sla = "9c_3P_sla";
$sub = "9c_3P_sub";
# return RLM_MODULE_REJECT;
}
elsif($count > 1) {
&radiusd::radlog(4, "Plusieurs profils QoS trouvés : $count
profils pour la classe $class. Utilisation du profil par défaut.");
# La requête a retournée plus d'une ligne : on passe sur le
profil par défaut
$sla = "9c_3P_sla";
$sub = "9c_3P_sub";
# return RLM_MODULE_REJECT;
}
elsif( $sub eq '' ) {
&radiusd::radlog(4, "Attribut Sub-Profile absent de la base.
Utilisation du profil par défaut.");
# La valeur de l'attribut Sub-Profile n'a pas été renseignée
correctement : profil par défaut
$sla = "9c_3P_sla";
$sub = "9c_3P_sub";
# return RLM_MODULE_REJECT;
}
elsif( $sla eq '' ) {
&radiusd::radlog(4, "Attribut SLA-Profile absent de la base.
Utilisation du profil par défaut");
# La valeur de l'attribut SLA-Profile n'a pas été renseignée
correctement
$sla = "9c_3P_sla";
$sub = "9c_3P_sub";
# return RLM_MODULE_REJECT;
}
# Ajout des attributs de QOS Alcatel-Lucent
&radiusd::radlog(1, "Ajout des attributs 'Alc-SLA-Prof-Str' et
'Alc-Subsc-Prof-Str'");
$RAD_REQUEST_PROXY_REPLY{'Alc-SLA-Prof-Str'} = $sla;
$RAD_REQUEST_PROXY_REPLY{'Alc-Subsc-Prof-Str'} = $sub;
# Cloture de la requête
$result->finish();
# Ajout des attributs Subscriber-Id et Alc-Retail-Serv-Id
# Les signes '?' seront remplacés à l'exécution par de vraies valeurs
(protection contre les injections SQL)
my $requete2=" SELECT Subscriber_Id, Retailer_Service_Id,
COUNT(*)
FROM post_proxy
WHERE Circuit_Id=?
GROUP BY Subscriber_Id, Retailer_Service_Id;";
# Préparation de la requête SQL
my $result2 = $dbp->prepare($requete2);
#exécution de la requête sql
$result2-> execute($circuit) || die "Probleme de mapping d'attributs
post-proxy : $DBI::errstr";
# Récupération des résultats de la requête
# Attention : la requête peut retourner plus d'une ligne
my ($subid, $retid, $count2) = $result2->fetchrow_array;
if(!defined($count2)) {
&radiusd::radlog(4, "Erreur lors du mapping des attributs
Subscriber Id et Retailer Service Id : aucune ligne renvoyee");
# La requête a retournée plus d'une ligne : erreur
return RLM_MODULE_REJECT;
}
elsif($count2 > 1) {
&radiusd::radlog(4, "Plusieurs lignes retournées dans la
requête SQL (Attributs ID) : $count2 retournées");
# La requête a retournée plus d'une ligne : erreur
return RLM_MODULE_REJECT;
}
elsif( $subid eq '' ) {
&radiusd::radlog(4, "Mauvaise valeur de l'attribut
Subscriber-Id : $subid");
# La valeur de l'attribut Subscriber-Id n'a pas été renseignée
correctement
return RLM_MODULE_REJECT;
}
elsif( $retid eq '' ) {
&radiusd::radlog(4, "Mauvaise valeur de l'attribut
Alc-Retail-Serv-Id : $retid");
# La valeur de l'attribut Alc-Retail-Serv-Id n'a pas été
renseignée correctement
return RLM_MODULE_REJECT;
}
# Ajout des attributs
&radiusd::radlog(1, "Ajout des attributs 'Alc-Subsc-ID-Str' et
'Alc-Retail-Serv-Id'");
$RAD_REQUEST_PROXY_REPLY{'Alc-Subsc-ID-Str'} = $subid;
$RAD_REQUEST_PROXY_REPLY{'Alc-Retail-Serv-Id'} = $retid;
# Requête terminée
$result2->finish();
# En cas de traitement positif, code de retour du module OK
return RLM_MODULE_OK;
}
# Utilisé pour lister les attributs des hash tables, Debug uniquement
sub log_attributes {
for (keys %RAD_REQUEST) {
&radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
}
for (keys %RAD_REPLY) {
&radiusd::radlog(1, "RAD_REPLY: $_ = $RAD_REPLY{$_}");
}
for (keys %RAD_CHECK) {
&radiusd::radlog(1, "RAD_CHECK: $_ = $RAD_CHECK{$_}");
}
for (keys %RAD_REQUEST_PROXY) {
&radiusd::radlog(1, "RAD_REQUEST_PROXY: $_ =
$RAD_REQUEST_PROXY{$_}");
}
for (keys %RAD_REQUEST_PROXY_REPLY) {
&radiusd::radlog(1, "RAD_REQUEST_PROXY_REPLY: $_ =
$RAD_REQUEST_PROXY_REPLY{$_}");
}
}
--
-- Table structure for table `qos`
--
DROP TABLE IF EXISTS `qos`;
SET @saved_cs_client = @@character_set_client;
SET character_set_client = utf8;
CREATE TABLE `qos` (
`qos_id` int(11) NOT NULL auto_increment,
`SLA_Profile` varchar(255) NOT NULL,
`Sub_Profile` varchar(255) NOT NULL,
`class` varchar(255) NOT NULL,
PRIMARY KEY (`qos_id`),
UNIQUE KEY `qos_mapping_unique` (`class`),
KEY `index_class` (`class`)
) ENGINE=MyISAM AUTO_INCREMENT=1 DEFAULT CHARSET=latin1;
SET character_set_client = @saved_cs_client;
-
List info/subscribe/unsubscribe? See http://www.freeradius.org/list/users.html
