<snip MainAuth.pl>
#!/usr/bin/perl
###############################################################################
### Radius Custom Authentication Handler ###
###############################################################################
use Crypt::RandPasswd;
use Data::Dumper;
use Mysql;
use Net::SMTP;
use Number::Format;
use POSIX;
use strict;
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use warnings;
###############################################################################
### Constants & Variables ###
###############################################################################
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
use constant DBHost=> "mysqldb host";
use constant DBName=> "db name";
use constant DBUser=> "user";
use constant DBPass=> "password";
my ($Sec, $Min, $Hour, $MDay, $Mon, $Year, $WDay, $YDay, $Isdst) = localtime();
my ($Date_Start, $Date_Small_Start, $Date_End) = undef;
###############################################################################
### Code Starts ###
###############################################################################
# This is for a authentication request
sub authorize {
my $GlobalDB = Mysql->connect(DBHost, DBName, DBUser, DBPass);
$GlobalDB->{'GlobalDB'}->{'PrintError'} = 0;
if ($GlobalDB && $RAD_REQUEST{'NAS-Port-Type'} eq "Virtual" && $RAD_REQUEST{'Framed-Protocol'} eq "PPP") {
my $SQL = $GlobalDB->query("SELECT Username, Password, isActive, BytesAvail, BytesUsed FROM PrePaidUsers WHERE Username='" . $RAD_REQUEST{'User-Name'} .
"' LIMIT 1");
if (!$SQL->numrows == "1") {
# Account not found.
$RAD_REPLY{'Reply-Message'} = "Unknown User";
return RLM_MODULE_REJECT;
}
while (my ($Username, $Password, $isActive, $BytesAvail, $BytesUsed) = $SQL->fetchrow_array) {
if ($isActive eq "n") {
# Account suspended.
$RAD_REPLY{'Reply-Message'} = "Account Suspended.";
### LOG IT!
return RLM_MODULE_USERLOCK;
} elsif ($BytesAvail - $BytesUsed <= 0) {
# Account Quota Exceeded.
$RAD_REPLY{'Reply-Message'} = "Quota Exceeded. You need to purchase more bandwidth.";
### LOG IT!
return RLM_MODULE_USERLOCK;
} else {
# Successfull Login.
my $za = new Number::Format(-thousands_sep => ',',
-decimal_point => '.',
-KILO_SUFFIX => 'KB',
-MEGA_SUFFIX => 'MB',
-GIGA_SUFFIX => 'GB',
-int_curr_symbol => 'ZAR');
$RAD_REPLY{'Acct-Interim-Interval'} = "300";
$RAD_REPLY{'Framed-Compression'} = "Van-Jacobson-TCP-IP";
$RAD_REPLY{'Framed-Protocol'} = "PPP";
$RAD_REPLY{'Framed-Routing'} = "Broadcast-Listen";
$RAD_REPLY{'Idle-Timeout'} = "600";
$RAD_REPLY{'MS-MPPE-Encryption-Policy'} = "1";
$RAD_REPLY{'MS-MPPE-Encryption-Types'} = "LS";
$RAD_REPLY{'Rate-Limit'} = "256k/512k";
$RAD_REPLY{'Recv-Limit'} = $BytesAvail - $BytesUsed;
$RAD_REPLY{'Xmit-Limit'} = $BytesAvail - $BytesUsed;
$RAD_REPLY{'Reply-Message'} = "You have " . $za->format_bytes($BytesAvail - $BytesUsed) . " available.";
$RAD_REPLY{'Service-Type'} = "Framed-User";
$RAD_REPLY{'Session-Timeout'} = "86400";
### LOG IT!
return RLM_MODULE_UPDATED;
}
}
} elsif ($GlobalDB && $RAD_REQUEST{'NAS-Port-Type'} eq "Ethernet" && $RAD_REQUEST{'Framed-Protocol'} eq "PPP") {
# PPPoE
} elsif ($GlobalDB) {
return RLM_MODULE_NOOP;
} else {
return RLM_MODULE_FAIL;
}
}
# Accounting Request
sub accounting {
return RLM_MODULE_OK;
}sub detach {
&radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
}# This is xlate function wich loads some external perl and evaluate it.
sub xlat {
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;};
}
</snip>TYIA, Chris.
----- Original Message ----- From: "Charles K. Clarkson" <[EMAIL PROTECTED]>
To: <beginners@perl.org>
Sent: Wednesday, March 23, 2005 3:12 AM
Subject: RE: hash issue
Chris Knipe <mailto:[EMAIL PROTECTED]> wrote: : : i.e. : $RAD_REPLY{'Recv-Limit'} = "20971520"; : $RAD_REPLY{'Xmit-Limit'} = "20971520"; : works. : $RAD_REPLY{'Recv-Limit'} = $BytesAvail - $BytesUsed; : $RAD_REPLY{'Xmit-Limit'} = $BytesAvail - $BytesUsed; : doesn't work.
Works for me:
#!/usr/bin/perl
use strict; use warnings;
use Data::Dumper 'Dumper';
my( $BytesAvail, $BytesUsed ) = (20971521, 1);
{ my %RAD_REPLY; $RAD_REPLY{'Recv-Limit'} = "20971520"; $RAD_REPLY{'Xmit-Limit'} = "20971520"; print Dumper \%RAD_REPLY; }
{ my %RAD_REPLY; $RAD_REPLY{'Recv-Limit'} = $BytesAvail - $BytesUsed; $RAD_REPLY{'Xmit-Limit'} = $BytesAvail - $BytesUsed; print Dumper \%RAD_REPLY; }
__END__
: So, what am I doing wrong?
Probably something you are not showing us.
HTH,
Charles K. Clarkson -- Mobile Homes Specialist 254 968-8328
-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
-- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
