PERL Beginners - hash issue

Author

hash issue

Chris Knipe

2005-03-23, 3:56 am

Lo all,

Snipette from the perl code...
$RAD_REPLY{'Recv-Limit'} = $BytesAvail - $BytesUsed;
$RAD_REPLY{'Xmit-Limit'} = $BytesAvail - $BytesUsed;
$RAD_REPLY{'Reply-Message'} = "You have " .
$za->format_bytes($BytesAvail - $BytesUsed) . " available.";

Righty.

$za->format_bytes return 20M (20MB), and is inside hash, returned to FR.
Recv-Limit and Xmit-Limit never makes it to the hash. If I assign actual
NUMBERS (not via a variable) to the attributes, then they make it without
any problems...

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.

So, what am I doing wrong? It must be something really silly, but for the
love of (you know who), I just can't seem to get it to work.

--
Chris.

Charles K. Clarkson

2005-03-23, 3:56 am

Chris Knipe <mailto:savage@savage.za.org> 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

Chris Knipe

2005-03-23, 3:56 am

Allrighty.... The module is called from FreeRadius itself, so if there
really is nothing wrong with my code (which I suspect there isn't), then I
guess this must be moved to the FR list. But let's rather make sure it's
not the code first.

<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" <cclarkson@htcomp.net>
To: <beginners@perl.org>
Sent: Wednesday, March 23, 2005 3:12 AM
Subject: RE: hash issue

> Chris Knipe <mailto:savage@savage.za.org> 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: beginners-unsubscribe@perl.org
> For additional commands, e-mail: beginners-help@perl.org
> <http://learn.perl.org/> <http://learn.perl.org/first-response>
>
>
>

Charles K. Clarkson

2005-03-23, 3:56 am

Chris Knipe <mailto:savage@savage.za.org> wrote:

: Allrighty.... The module is called from FreeRadius itself, so if
: there really is nothing wrong with my code (which I suspect there
: isn't), then I guess this must be moved to the FR list. But let's
: rather make sure it's not the code first.

To set up a test case we can assume that the while loop has started
and we are in the 'else' block which affects $RAD_REPLY{'Recv-Limit'}
and $RAD_REPLY{'Xmit-Limit'}.

When I tested this, I found this part okay. Since %RAD_REPLY is
not accessed in this script, I don't know how you determined there
was failure.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper 'Dumper';

use Number::Format;

# use CGI;
# use CGI::Carp qw(fatalsToBrowser);

my %RAD_REPLY;
my( $Username, $Password, $isActive, $BytesAvail, $BytesUsed ) =
( 'foo', 'foo', 'y', 20971521, 1 );
# 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;

print Dumper \%RAD_REPLY;

__END__

BTW, we don't normally quote numbers in perl The
following line, for example, could be written better.

if (!$SQL->numrows == "1") {

if ( $SQL->numrows != 1 ) {

HTH,

Charles K. Clarkson
--
Mobile Homes Specialist
254 968-8328

Chris Knipe

2005-03-23, 3:56 am

> : Allrighty.... The module is called from FreeRadius itself, so if
> : there really is nothing wrong with my code (which I suspect there
> : isn't), then I guess this must be moved to the FR list. But let's
> : rather make sure it's not the code first.
>
> To set up a test case we can assume that the while loop has started
> and we are in the 'else' block which affects $RAD_REPLY{'Recv-Limit'}
> and $RAD_REPLY{'Xmit-Limit'}.
>
> When I tested this, I found this part okay. Since %RAD_REPLY is
> not accessed in this script, I don't know how you determined there
> was failure.

That's correct yes. FreeRadius has a built in perl module that process the
hash received from the script (that I am trying to write). I'm pretty
confident this is a possible bug in the rlm_perl module of freeradius.
While FR (FreeRadius) runs in debug mode, it outputs the values that is
inside the hash. All the values are printed back to me from FR, with the
exception of Recv-Limit and Xmit-Limit *IF* they are not assigned from the
variable substraction.

I'll go and moan there rather ;) It's definately a problem in the module
somewhere... As you said (and I concur), there really isn't anything in my
perl code that will make this not work.

> BTW, we don't normally quote numbers in perl The
> following line, for example, could be written better.
>
> if (!$SQL->numrows == "1") {
>
>
> if ( $SQL->numrows != 1 ) {

Thanks :) I must be getting sleepy!!! I don't normally do it either.

Cheers,
Chris.

Sponsored Links