New subject: rlm_perl and accounting -- radrelay?

22 Aug 2006

      I'm running freeradius v. 1.1.0 and am trying to use rlm_perl to rewrite 
accounting attributes before they are written to log with detail and 
then replicated with radrelay.  Here is the version of example.pl that 
I'm using (I've only added a single statement to the preacct function):

use strict;
# use ...
# This is very important ! Without this script will not get the filled 
hashesh from main.
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 remapping 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 */

# Function to handle authorize
sub authorize {
         # For debugging purposes only
#       &log_request_attributes;

         # Here's where your authorization code comes
         # You can call another function from here:
         &test_call;

         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
                 $RAD_REPLY{'h323-credit-amount'} = "100";
                 return RLM_MODULE_OK;
         }
}

# Function to handle preacct
sub preacct {
         # For debugging purposes only
         #&log_request_attributes;
         $RAD_REPLY{'Acct-Session-Id'} = "new-session-value";
         return RLM_MODULE_OK;
}

# Function to handle accounting
sub accounting {
         # For debugging purposes only
#       &log_request_attributes;

         # You can call another subroutine from here
         #&test_call;
         return RLM_MODULE_OK;
}

# Function to handle checksimul
sub checksimul {
         # For debugging purposes only
#       &log_request_attributes;

         return RLM_MODULE_OK;
}

# Function to handle pre_proxy
sub pre_proxy {
         # For debugging purposes only
#       &log_request_attributes;

         return RLM_MODULE_OK;
}

# Function to handle post_proxy
sub post_proxy {
         # For debugging purposes only
#       &log_request_attributes;

         return RLM_MODULE_OK;
}

# Function to handle post_auth
sub post_auth {
         # 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{$_}");
         }
}

Here's the output of freeradius -X:

root@black-pearl:/etc/freeradius# freeradius -X
...
Module: Loaded perl
  perl: module = "/home/jcc/scripts/example.pl"
  perl: func_authorize = "authorize"
  perl: func_authenticate = "authenticate"
  perl: func_accounting = "accounting"
  perl: func_preacct = "preacct"
  perl: func_checksimul = "checksimul"
  perl: func_detach = "detach"
  perl: func_xlat = "xlat"
  perl: func_pre_proxy = "pre_proxy"
  perl: func_post_proxy = "post_proxy"
  perl: func_post_auth = "post_auth"
  perl: perl_flags = "(null)"
  perl: func_start_accounting = "(null)"
  perl: func_stop_accounting = "(null)"
  perl: max_clones = 32
  perl: start_clones = 5
  perl: min_spare_clones = 3
  perl: max_spare_clones = 3
  perl: cleanup_delay = 5
  perl: max_request_per_clone = 0
Module: Instantiated perl (perl)
...

Here's my radiusd.conf:
...
modules {
	perl {
                 module = /home/jcc/scripts/example.pl
                 max_clones = 32
     		start_clones = 5
     		min_spare_clones = 3
     		max_spare_clones = 3
     		cleanup_delay = 5
     		max_request_per_clone = 0
         }
}
...
preacct {
         preprocess
	acct_unique
	perl
	suffix
	files
}
accounting {
	local-detail
	radrelay-detail
	unix
	radutmp
}
...

Notice from my example.pl that I'm trying to rewrite the value for 
Acct-Session-Id.  The freeradius -X output shows that I've added a new 
pair, Acct-Session-Id = new-session-value, but only the original value 
shows up in the radacct log, not the new value:

rad_recv: Accounting-Request packet from host 127.0.0.1:32819, id=89, 
length=65
         User-Name = "jcc"
         NAS-Port = 1
         Acct-Session-Id = "accounting-session-1"
         Sip-Transport-Protocol = TCP
   Processing the preacct section of radiusd.conf
modcall: entering group preacct for request 0
   modcall[preacct]: module "preprocess" returns noop for request 0
rlm_acct_unique: Hashing 'NAS-Port = 1,Client-IP-Address = 
127.0.0.1,NAS-IP-Address = 127.0.0.1,Acct-Session-Id = 
"accounting-session-1",User-Name = "jcc"'
rlm_acct_unique: Acct-Unique-Session-ID = "4f08f8eb92e050ff".
   modcall[preacct]: module "acct_unique" returns ok for request 0
perl_pool: item 0x8168260 asigned new request. Handled so far: 1
found interpetator at address 0x8168260
rlm_perl: Added pair Acct-Session-Id = new-session-value
perl_pool total/active/spare [5/0/5]
Could not get @DynaLoader::dl_librefs for unloading.
Unreserve perl at address 0x8168260
   modcall[preacct]: module "perl" returns ok for request 0
     rlm_realm: No '@' in User-Name = "jcc", looking up realm NULL
     rlm_realm: No such realm "NULL"
   modcall[preacct]: module "suffix" returns noop for request 0
   modcall[preacct]: module "files" returns noop for request 0
modcall: leaving group preacct (returns ok) for request 0
   Processing the accounting section of radiusd.conf
modcall: entering group accounting for request 0
radius_xlat:  '/var/log/freeradius/radacct/127.0.0.1/detail-20060822'
rlm_detail: 
/var/log/freeradius/radacct/%{Client-IP-Address}/detail-%Y%m%d expands 
to /var/log/freeradius/radacct/127.0.0.1/detail-20060822
   modcall[accounting]: module "local-detail" returns ok for request 0
radius_xlat:  '/var/log/freeradius/radacct/radrelay-detail'
rlm_detail: /var/log/freeradius/radacct/radrelay-detail expands to 
/var/log/freeradius/radacct/radrelay-detail
rlm_detail: Acquired filelock, tried 1 time(s)
rlm_detail: Released filelock
   modcall[accounting]: module "radrelay-detail" returns ok for request 0
rlm_unix: no Accounting-Status-Type attribute in request.
   modcall[accounting]: module "unix" returns noop for request 0
rlm_radutmp: No Accounting-Status-Type record.
   modcall[accounting]: module "radutmp" returns noop for request 0
modcall: leaving group accounting (returns ok) for request 0
Sending Accounting-Response of id 89 to 127.0.0.1 port 32819
Finished request 0
Going to the next request
--- Walking the entire request list ---
Cleaning up request 0 ID 89 with timestamp 44eb308c
Nothing to do.  Sleeping until we see a request.

radrelay-detail log:

Tue Aug 22 12:27:56 2006
         User-Name = "jcc"
         NAS-Port = 1
         Acct-Session-Id = "accounting-session-1"
         Sip-Transport-Protocol = TCP
         NAS-IP-Address = 127.0.0.1
         Client-IP-Address = 127.0.0.1
         Acct-Unique-Session-Id = "4f08f8eb92e050ff"
         Timestamp = 1156264076

What am I missing?

Thanks.

-jc

rlm_perl and accounting

Justin Church

Alex French

Justin Church

Pshem Kowalczyk

Justin Church

Boian Jordanov

Pshem Kowalczyk

Pshem Kowalczyk

Pshem Kowalczyk

Justin Church

Justin Church

Justin Church

Justin Church

Justin Church

Justin Church

Justin Church

Justin Church

Justin Church

George C. Kaplan

Alex French

KES

tags

participants (9)