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;