rlm_perl hang server
Abdul Lateef
abdul_zu at yahoo.com
Mon Oct 10 09:41:05 CEST 2005
Hi,
i am not using sql.conf at all. i have only DB
connection in example.pl file. But my example.pl file
really it is very big. and i have lot of queries cous
of i am using this file for
Prepaid
CallShop
Diffrent rate for diffrent customers.
I would like to paste my script here. but i am really
sorry to post big script here.
================example.pl ==================
use DBI;
#use strict;
use POSIX qw(ceil floor);
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use Data::Dumper;
# This is hash wich hold original request from radius
#my %RAD_REQUEST;
# In this hash you add values that will be returned to
NAS.
#my %RAD_REPLY;
#This is for check items
#my %RAD_CHECK;
#
# This the remaping of return values
#
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 $db_host = '192.168.1.65';
my $db_user = 'testdb';
my $db_pass = 'MoHaKa21';
my $db_name = 'radius';
sub dbh{
my $db =
"dbi:mysql:dbname=${db_name};host=${db_host}";
my $dbv = DBI->connect($db, $db_user, $db_pass,
{ RaiseError => 1, AutoCommit => 0 }
) || die "Error connecting to the database";
}
sub debugit{
#if(!$RAD_REQUEST{'User-Password'}){
#my $cn = $RAD_REQUEST{'Called-Station-Id'};
#my $up = $RAD_REQUEST{'User-Password'};
#}else{
#my $tt = $RAD_REQUEST{'Acct-Unique-Session-Id'};
#}
my $debug_sql = "INSERT INTO nas (nasname)
VALUES ($tt)";
my $dbg = dbh()->prepare($debug_sql);
$dbg->execute();
}
#debugit();
# Function to handle authorize
sub authorize {
# For debugging purposes only
&log_request_attributes;
#debugit();
my $UserP;
my $uidf;
my $pwws;
my $uid;
if(!$RAD_REQUEST{'User-Password'}){
$uidf = $RAD_REQUEST{'User-Name'};
@WordList = split(/_/, $uidf ) ;
$pwws = @WordList[1];
$uid = @WordList[0];
}else{
$pwws = $RAD_REQUEST{'User-Password'};
$uid = $RAD_REQUEST{'User-Name'};
}
my $sql_reg = "SELECT 1 FROM radcheck WHERE UserName
= '$uid' and Value = '$pwws' ORDER BY id";
my $auth = dbh()->selectrow_array($sql_reg);
if(!$auth){return RLM_MODULE_REJECT;}
else {return RLM_MODULE_OK;}
}
# Function to handle authenticate
sub authenticate {
# For debugging purposes only
&log_request_attributes;
if ($RAD_REQUEST{'User-Name'} =~ /^baduser/i) {
# Reject user and tell him why
$RAD_REPLY{'Reply-Message'} = "Denied access by
rlm_perl function";
return RLM_MODULE_REJECT;
} else {
# Accept user and set some attribute
if(!$RAD_REQUEST{'Called-Station-Id'}){$skipp=0;}
else{max_time();}
&log_request_attributes;
return RLM_MODULE_OK;
}
} #end of authenticate function
################ FUNCTION FOR LIVE CALL
##################
sub max_time{
#debugit();
my $sessionID = $RAD_REQUEST{'Acct-Session-Id'};
my $sessionID =~ s/T/V/;
my $CalledID = $RAD_REQUEST{'Called-Station-Id'};
my $DCode = r_code($CalledID);
my $UserName = $RAD_REQUEST{'User-Name'};
if ($ARGV[1] == 800800) #for ivr call
{
$RAD_REPLY{'h323-credit-time'} =
"h323-credit-time=60";
exit;
} #End if
my $sql_rate = "Select If(RT.Rate Is
Null,T.Rate*STC.Percentage,RT.Rate) As Sell_Rate
From (Tariff As T JOIN Tariff_Classes As STC Inner
Join Rate_Card As RC On STC.ID=RC.Groupn)
Left Join Reseller_Tariff As RT On T.Co_Name=RT.Code
And RC.AgentID=RT.AgentID And RC.Groupn=RT.Groupn
Where RC.UserName='$UserName' And
T.Co_Name='$DCode'";
my $sql_usr_balance = "SELECT Amount FROM balance
WHERE op='r' and UserName = '$UserName' ";
my $sql_port = "SELECT port FROM radcheck WHERE
UserName = '$UserName' ";
my $sql_status = "SELECT count(*) as RecNo FROM
radacct WHERE UserName = '$UserName' and status ='1'
and AcctSessionId = '$sessionID' ";
my $sql_statuso = "SELECT count(*) as RecNo FROM
radacct WHERE UserName = '$UserName' and status ='1'";
my $query_resel = "select R_update_balance.Amount
from R_update_balance
INNER join Device_auth on R_update_balance.AgentID
= Device_auth.AgentID
Where Device_auth.DeviceID = '$UserName' ";
my $reseller_balance =
dbh()->selectrow_array($query_resel);
my $calling_rate =
dbh()->selectrow_array($sql_rate);
if($reseller_balance <= 0){
$RAD_REPLY{'h323-credit-time'} = "h323-credit-time=0";
exit;}
if ($calling_rate <= 0) {
$RAD_REPLY{'h323-credit-time'} = "h323-credit-time=0";
exit;}
# Callshop
# if(!$RAD_REQUEST{'Calling-Station-Id'}){
# my $don = 1;
# }else{
# my $callingID = $RAD_REQUEST{'Calling-Station-Id'};
# my $booth_credit = "SELECT credit FROM booth_credit
WHERE UserName = '$UserName' and port ='$callingID'";
# my $boCredit =
dbh()->selectrow_array($booth_credit);
# &log_request_attributes;
# if($boCredit <=0)
# {
# my $t=0;
# }else{
# $total_minute_duration = $boCredit/$calling_rate;
# $return_h323_time = $total_minute_duration*60;
# $RAD_REPLY{'h323-credit-time'} =
"h323-credit-time=$return_h323_time";
# &log_request_attributes;
# #exit;
# return true;
# } #end if for callshop
#
# } #End if
# End call shop area
if($RAD_REQUEST{'Calling-Station-Id'}){
my $callingID = $RAD_REQUEST{'Calling-Station-Id'};
my $booth_credit = "SELECT credit FROM booth_credit
WHERE UserName = '$UserName' and port ='$callingID'";
my $boCredit =
dbh()->selectrow_array($booth_credit);
&log_request_attributes;
if($boCredit <=0)
{
my $t=0;
}else{
$total_minute_duration = $boCredit/$calling_rate;
$return_h323_time = $total_minute_duration*60;
$RAD_REPLY{'h323-credit-time'} =
"h323-credit-time=$return_h323_time";
&log_request_attributes;
#exit;
return true;
} #end if for callshop
} #End if
my $returnba = 0;
my $total_balance =
dbh()->selectrow_array($sql_usr_balance);
my $port = dbh()->selectrow_array($sql_port);
my $status =
dbh()->selectrow_array($sql_status);
my $statuso =
dbh()->selectrow_array($sql_statuso);
if($total_balance >=5 && $port >= 2){
my $d = $port-$status;
$returnba = $total_balance/$d;
}elsif($total_balance < 5 && $statuso >= 2){
$returnba = 0;
}elsif($total_balance <= 0){
$returnba = 0;
}else{
$returnba = $total_balance;
} #End If for port devision
$total_minute_duration =
$returnba/$calling_rate;
#$total_minute_duration = $calling_rate;
my $return_h323_time =
$total_minute_duration*60;
$RAD_REPLY{'h323-credit-time'} =
"h323-credit-time=$return_h323_time";
&log_request_attributes;
} #end max_time
sub r_code #from reseller table
{
$wh = $_[0];
$wh =~ s/^00//;
$sql_code = "SELECT Max(Co_Name) As Code FROM
`Tariff` WHERE '$wh' Like Concat(`Co_Name`,'%')";
return dbh()->selectrow_array($sql_code);
} #End r_code
######################## END LIVE CALL FUNCTION
#########
# Function to handle preacct
sub preacct {
# For debugging purposes only
# &log_request_attributes;
return RLM_MODULE_OK;
}
# Function to handle accounting
sub accounting {
# For debugging purposes only
&log_request_attributes;
my
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= localtime time;
my $years = $year+1900;
my $mons = $mon+1;
my $fdatetime = "$years-$mons-$mday $hour:$min:$sec";
my $accounting_start;
my $accounting_stop_query;
$accounting_start = "INSERT IGNORE into radacct
(AcctSessionId, AcctUniqueId, UserName, Realm,
NASIPAddress, NASPortId, NASPortType, AcctStartTime,
AcctStopTime, AcctSessionTime, AcctAuthentic,
ConnectInfo_start, ConnectInfo_stop, AcctInputOctets,
AcctOutputOctets, CalledStationId,
CallingStationId, AcctTerminateCause, ServiceType,
FramedProtocol, FramedIPAddress, AcctStartDelay,
AcctStopDelay, status,Termination)
values('$RAD_REQUEST{'Acct-Session-Id'}',
'$RAD_REQUEST{'Acct-Unique-Session-Id'}',
'$RAD_REQUEST{'User-Name'}', '$RAD_REQUEST{'Realm'}',
'$RAD_REQUEST{'NAS-IP-Address'}',
'$RAD_REQUEST{'NAS-Port'}',
'$RAD_REQUEST{'NAS-Port-Type'}', '$fdatetime', '0',
'0',
'$RAD_REQUEST{'Acct-Authentic'}',
'$RAD_REQUEST{'Connect-Info'}', '', '0', '0',
'$RAD_REQUEST{'Called-Station-Id'}',
'$RAD_REQUEST{'Calling-Station-Id'}', '',
'$RAD_REQUEST{'Service-Type'}',
'$RAD_REQUEST{'Framed-Protocol'}',
'$RAD_REQUEST{'Framed-IP-Address'}',
'$RAD_REQUEST{'Acct-Delay-Time'}', '0',
'1','$RAD_REQUEST{'h323-remote-address'}')";
$accounting_stop_query = "UPDATE radacct
SET AcctStopTime = '$fdatetime', AcctSessionTime =
'$RAD_REQUEST{'Acct-Session-Time'}',
AcctInputOctets =
'$RAD_REQUEST{'Acct-Input-Octets'}', AcctOutputOctets
= '$RAD_REQUEST{'Acct-Output-Octets'}',
AcctTerminateCause =
'$RAD_REQUEST{'Acct-Terminate-Cause'}', AcctStopDelay
= '$RAD_REQUEST{'Acct-Delay-Time'}', status = '1',
ConnectInfo_stop = '$RAD_REQUEST{'Connect-Info'}'
WHERE AcctSessionId =
'$RAD_REQUEST{'Acct-Session-Id'}' AND UserName =
'$RAD_REQUEST{'User-Name'}' AND NASIPAddress =
'$RAD_REQUEST{'NAS-IP-Address'}'";
my $dbg = dbh()->prepare($accounting_start);
$dbg->execute();
if($RAD_REQUEST{'Acct-Input-Octets'}){
my $dbup = dbh()->prepare($accounting_stop_query);
$dbup->execute();
}
return RLM_MODULE_OK;
}
# Function to handle checksimul
sub checksimul {
# For debugging purposes only
# &log_request_attributes;
return RLM_MODULE_OK;
}
# Function to handle xlat
sub xlat {
# For debugging purposes only
# &log_request_attributes;
# Loads some external perl and evaluate it
my ($filename,$a,$b,$c,$d) = @_;
&radiusd::radlog(1, "From xlat $filename ");
&radiusd::radlog(1,"From xlat $a $b $c $d ");
local *FH;
open FH, $filename or die "open '$filename' $!";
local($/) = undef;
my $sub = <FH>;
close FH;
my $eval = qq{ sub handler{ $sub;} };
eval $eval;
eval {main->handler;};
}
# Function to handle detach
sub detach {
# For debugging purposes only
# &log_request_attributes;
# Do some logging.
&radiusd::radlog(0,"rlm_perl::Detaching. Reloading.
Done.");
}
#
# Some functions that can be called from other
functions
#
sub test_call {
# Some code goes here
}
sub log_request_attributes {
# This shouldn't be done in production environments!
# This is only meant for debugging!
for (keys %RAD_REQUEST) {
&radiusd::radlog(1, "RAD_REQUEST: $_ =
$RAD_REQUEST{$_}");
}
}
--------
Yours,
Abdul Lateef
Computer Programmer
HATIF COM
Mob: +974 - 5405022
Tel: +974 - 4883068
ICQ: 276994704
YM!: abdul_zu
Fax: +974 - 4883063
Doha Qatar
http://www.hatif.com
__________________________________
Yahoo! Mail - PC Magazine Editors' Choice 2005
http://mail.yahoo.com
More information about the Freeradius-Users
mailing list