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