rlm_perl and accounting

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