Commit d82d2454 authored by Nigel Kukard's avatar Nigel Kukard

Merge branch 'FUP' into 'master'

Added FUP support

See merge request !425
parents 71f628a0 f24d760c
Pipeline #3767 passed with stages
in 4 minutes and 2 seconds
......@@ -27,7 +27,7 @@ Enhanced features:
* Plugin: Topups
* Plugin: Auto-topups
* Plugin: Usage/Time caps
* Plugin: Prepaid accounting based on usage/time
* Plugin: Prepaid accounting based on usage/time
* Plugin: Creation of accounting START records when no START record has been received but an interim update has - helps on slow/lossly links
* Plugin: Notifications, % based or approximate time based
* Plugin: User blacklists
......
......@@ -5,8 +5,7 @@ smradiusd:
* Create a raddbpath config option which is prepended to dict paths
usage related queries:
* Use Math module to perform calculations
* Configurable 'use defaults for POD/CoA' we may not want to send these
smadmin:
* Ability to run smadmin before the end of current month and updating the records as necessary at a later stage
......
......@@ -199,13 +199,13 @@ CREATE TABLE @PREFIX@accounting (
ServiceType @INT_UNSIGNED@,
FramedProtocol @INT_UNSIGNED@,
FramedProtocol @INT_UNSIGNED@,
NASPort VARCHAR(255),
NASPortType @INT_UNSIGNED@,
CallingStationID VARCHAR(255),
CallingStationID VARCHAR(255),
CalledStationID VARCHAR(255),
......@@ -251,6 +251,9 @@ CREATE INDEX @PREFIX@accounting_idx2 ON @PREFIX@accounting (PeriodKey);
CREATE INDEX @PREFIX@accounting_idx4 ON @PREFIX@accounting (Username,AcctSessionID,NASIPAddress,NASPort);
/* accounting_update_query */
CREATE INDEX @PREFIX@accounting_idx5 ON @PREFIX@accounting (Username,AcctSessionID,NASIPAddress,NASPort,PeriodKey);
/* Index for the EventTimestamp */
CREATE INDEX @PREFIX@accounting_idx7 ON @PREFIX@accounting (EventTimestamp);
CREATE INDEX @PREFIX@accounting_idx8 ON @PREFIX@accounting (Username,EventTimestamp);
......@@ -276,7 +279,7 @@ CREATE INDEX @PREFIX@accounting_summary_idx3 ON @PREFIX@accounting_summary (User
/* Users data */
CREATE TABLE @PREFIX@users_data (
ID @SERIAL_TYPE@,
ID @SERIAL_TYPE@,
UserID @INT_UNSIGNED@,
......@@ -287,4 +290,4 @@ CREATE TABLE @PREFIX@users_data (
Value VARCHAR(255),
UNIQUE (UserID,Name)
) @CREATE_TABLE_SUFFIX@;
) @CREATE_TABLE_SUFFIX@;
......@@ -81,6 +81,10 @@ my @attributeReplyIgnoreList = (
'SMRadius-AutoTopup-Uptime-Notify',
'SMRadius-AutoTopup-Uptime-NotifyTemplate',
'SMRadius-AutoTopup-Uptime-Threshold',
'SMRadius-Config-Filter-Reply-Attribute',
'SMRadius-Config-Filter-Reply-VAttribute',
'SMRadius-FUP-Period',
'SMRadius-FUP-Traffic-Threshold',
);
my @attributeVReplyIgnoreList = (
);
......@@ -342,7 +346,7 @@ sub checkAuthAttribute
# Always matches as a check item, and adds the current
# attribute with value to the list of configuration items.
#
# As a reply item, it has an itendtical meaning, but the
# As a reply item, it has an idendtical meaning, but the
# attribute is added to the reply items.
} elsif ($operator eq '+=') {
......@@ -439,7 +443,7 @@ sub checkAcctAttribute
# Always matches as a check item, and adds the current
# attribute with value to the list of configuration items.
#
# As a reply item, it has an itendtical meaning, but the
# As a reply item, it has an idendtical meaning, but the
# attribute is added to the reply items.
if ($operator eq '+=') {
......@@ -546,7 +550,7 @@ sub setReplyAttribute
# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
# If no attribute of that name appears in the request, then this attribute is added.
#
# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
} elsif ($attribute->{'Operator'} eq ':=') {
# Overwrite
......@@ -561,7 +565,7 @@ sub setReplyAttribute
# Always matches as a check item, and adds the current
# attribute with value to the list of configuration items.
#
# As a reply item, it has an itendtical meaning, but the
# As a reply item, it has an idendtical meaning, but the
# attribute is added to the reply items.
} elsif ($attribute->{'Operator'} eq '+=') {
......@@ -610,7 +614,7 @@ sub setReplyVAttribute
@attrValues = ( $attribute->{'Value'} );
}
$server->log(LOG_DEBUG,"[VATTRIBUTES] Processing REPLY attribute: '".
$server->log(LOG_DEBUG,"[VATTRIBUTES] Processing REPLY vattribute: '".
$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
......@@ -640,7 +644,7 @@ sub setReplyVAttribute
# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
# If no attribute of that name appears in the request, then this attribute is added.
#
# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
} elsif ($attribute->{'Operator'} eq ':=') {
# Overwrite
......@@ -655,7 +659,7 @@ sub setReplyVAttribute
# Always matches as a check item, and adds the current
# attribute with value to the list of configuration items.
#
# As a reply item, it has an itendtical meaning, but the
# As a reply item, it has an idendtical meaning, but the
# attribute is added to the reply items.
} elsif ($attribute->{'Operator'} eq '+=') {
......@@ -707,7 +711,7 @@ sub processConfigAttribute
# Always matches as a check item, and adds the current
# attribute with value to the list of configuration items.
#
# As a reply item, it has an itendtical meaning, but the
# As a reply item, it has an idendtical meaning, but the
# attribute is added to the reply items.
if ($attribute->{'Operator'} eq '+=') {
......@@ -720,7 +724,7 @@ sub processConfigAttribute
# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
# If no attribute of that name appears in the request, then this attribute is added.
#
# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
} elsif ($attribute->{'Operator'} eq ':=') {
@{$configAttributes->{$attribute->{'Name'}}} = @attrValues;
......@@ -790,7 +794,8 @@ sub processConditional
# Split off expression
my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\s*\:\s*(.*))?)?$/);
# NK: This probably needs a bit of work
my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\:\s*(.*))?)?$/);
# If there is no condition we cannot really continue?
if (!defined($condition)) {
......@@ -838,6 +843,10 @@ sub processConditional
$res = 1;
}
# Sanitize the output
$attribStr =~ s/^\s*//;
$attribStr =~ s/\s*$//;
$server->log(LOG_DEBUG,"[ATTRIBUTES] - Evaluated to '$res' returning '".(defined($attribStr) ? $attribStr : "-undef-")."'");
# Loop with attributes:
......
# Radius client
# Copyright (C) 2007-2016, AllWorldIT
# Copyright (C) 2007-2019, AllWorldIT
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
......@@ -44,11 +44,15 @@ if (!eval {require Config::IniFiles; 1;}) {
sub run
{
my ($self,@methodArgs) = @_;
# Instantiate if we're not already instantiated
$self = $self->new() if (!ref($self));
# The hash we're going to return
my $ret = { };
print(STDERR "SMRadClient v$VERSION - Copyright (c) 2007-2016, AllWorldIT\n");
print(STDERR "SMRadClient v".VERSION." - Copyright (c) 2007-2019, AllWorldIT\n");
print(STDERR "\n");
......@@ -67,10 +71,11 @@ sub run
\%{$cmdline},
"config:s",
"raddb:s",
"listen:s",
"help",
)) {
print(STDERR "ERROR: Error parsing commandline arguments");
return 1;
print(STDERR "ERROR: Error parsing commandline arguments");
return 1;
}
# Check for some args
......@@ -190,13 +195,38 @@ sub run
return 1;
}
my $sock2;
# Check if we must listen on another IP/port
if (defined($cmdline->{'listen'}) && $cmdline->{'listen'} ne "") {
print(STDERR "Creating second socket\n");
# Check the details we were provided
my ($localAddr,$localPort) = split(/:/,$cmdline->{'listen'});
if (!defined($localPort)) {
print(STDERR "ERROR: The format for --listen is IP:Port\n");
return 1;
}
$sock2 = IO::Socket::INET->new(
LocalAddr => $localAddr,
LocalPort => $localPort,
Type => SOCK_DGRAM,
Proto => 'udp',
Timeout => $sockTimeout,
);
if (!$sock2) {
print(STDERR "ERROR: Failed to create second socket\n");
return 1;
}
}
# Check if we sent the packet...
if (!$sock->send($udp_packet)) {
print(STDERR "ERROR: Failed to send data on socket\n");
return 1;
}
# And time for the response
print(STDERR "\nResponse:\n");
......@@ -216,7 +246,7 @@ sub run
# Read packet
$sock->recv($udp_packet, 65536);
if (!$udp_packet) {
print(STDERR "ERROR: Receive response data failed: $!\n");
print(STDERR "ERROR: Receive response data failed on socket: $!\n");
return 1;
}
......@@ -225,13 +255,44 @@ sub run
print(STDERR " > Authenticated: ". (defined(auth_req_verify($udp_packet,$self->{'secret'},$authen)) ? "yes" : "no") ."\n");
print(STDERR $pkt->str_dump());
# Setup response
$ret->{'request'} = $self->hashedPacket($self->{'packet'});
$ret->{'response'} = $self->hashedPacket($pkt);
my $udp_packet2;
if (defined($sock2)) {
my $rsock2 = IO::Select->new($sock2);
if (!$rsock2) {
print(STDERR "ERROR: Failed to select response data on socket2\n");
return 1;
}
# Check if we can read a response after the select()
if (!$rsock2->can_read($sockTimeout)) {
print(STDERR "ERROR: Failed to receive response data on socket2\n");
return 1;
}
# Read packet
my $udp_packet2;
$sock2->recv($udp_packet2, 65536);
if (!$udp_packet2) {
print(STDERR "ERROR: Receive response data failed on socket2: $!\n");
return 1;
}
my $pkt2 = smradius::Radius::Packet->new($raddb,$udp_packet2);
print(STDERR $pkt2->str_dump());
# Save the packet we got
$ret->{'listen'}->{'response'} = $self->hashedPacket($pkt2);
}
# If we were called as a function, return hashed version of the response packet
if (@methodArgs) {
return {
'request' => $self->hashedPacket($self->{'packet'}),
'response' => $self->hashedPacket($pkt),
};
return $ret;
}
return 0;
......@@ -261,7 +322,7 @@ sub hashedPacket
foreach my $attrName ($pkt->vsattributes($attrVendor)) {
$res->{'vattributes'}->{$attrVendor}->{$attrName} = $pkt->vsattr($attrVendor,$attrName);
}
}
}
return $res;
}
......
......@@ -20,14 +20,13 @@
## @class smradius::constants
# SMRadius constants package
package smradius::constants;
use base qw(Exporter);
use strict;
use warnings;
# Exporter stuff
use base qw(Exporter);
our (@EXPORT,@EXPORT_OK);
@EXPORT = qw(
RES_OK
......@@ -37,7 +36,7 @@ our (@EXPORT,@EXPORT_OK);
MOD_RES_NACK
MOD_RES_SKIP
UINT_MAX
GIGAWORD_VALUE
);
@EXPORT_OK = ();
......@@ -50,7 +49,7 @@ use constant {
MOD_RES_ACK => 1,
MOD_RES_NACK => 2,
UINT_MAX => 2**32
GIGAWORD_VALUE => 2**32,
};
......
# Radius daemon
# Copyright (C) 2007-2016, AllWorldIT
# Copyright (C) 2007-2019, AllWorldIT
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
......@@ -898,109 +898,145 @@ sub process_request {
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Check attribute against accounting attributes attributes
# Check attribute against accounting attributes
my $res = checkAcctAttribute($self,$user,$acctAttributes,$attr);
# We don't care if it fails
}
}
# Check if we must POD the user
# The coaReq may be either POD or CoA
my $coaReq = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
# Set packet identifier
$coaReq->set_identifier( $$ & 0xff );
# Check if we must POD the user, if so we set the code to disconnect
if ($PODUser) {
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying to disconnect user...");
$coaReq->set_code('Disconnect-Request');
} else {
# If this is *not* a POD, we need to process reply attributes
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Sending CoA...");
$coaReq->set_code('CoA-Request');
# Process the reply attributes
$self->_processReplyAttributes($request,$user,$coaReq);
}
my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
# NAS identification
$coaReq->set_attr('NAS-IP-Address',$pkt->attr('NAS-IP-Address'));
# Session identification
$coaReq->set_attr('User-Name',$pkt->attr('User-Name'));
$coaReq->set_attr('NAS-Port',$pkt->attr('NAS-Port'));
$coaReq->set_attr('Acct-Session-Id',$pkt->attr('Acct-Session-Id'));
$resp->set_code('Disconnect-Request');
my $id = $$ & 0xff;
$resp->set_identifier( $id );
$resp->set_attr('User-Name',$pkt->attr('User-Name'));
$resp->set_attr('Framed-IP-Address',$pkt->attr('Framed-IP-Address'));
$resp->set_attr('NAS-IP-Address',$pkt->attr('NAS-IP-Address'));
# Add onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($resp->attributes) {
$request->addLogLine(
"%s: '%s'",
$attrName,
$resp->rawattr($attrName)
);
# Add onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($coaReq->attributes) {
$request->addLogLine(
"%s: '%s'",
$attrName,
$coaReq->rawattr($attrName)
);
}
# Generate coaReq packet
my $coaReq_packet = auth_resp($coaReq->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
# Array CoA servers to contact
my @coaServers;
# Check for old POD server attribute
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'})) {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is defined");
@coaServers = @{$user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'}};
}
# Check for new CoA server attribute
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'})) {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-CoAServer is defined");
@coaServers = @{$user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'}};
}
# If we didn't get provided a CoA server, use the peer address
if (!@coaServers) {
push(@coaServers,$server->{'peeraddr'});
}
# Check address format
foreach my $coaServer (@coaServers) {
# Remove IPv6 portion for now...
$coaServer =~ s/^::ffff://;
# Check for valid IP
my ($coaServerIP,$coaServerPort) = ($coaServer =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})(?::([0-9]+))?/);
if (!defined($coaServerIP)) {
$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: CoAServer '$coaServer' looks incorrect");
next;
}
# Grab packet
my $response = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
# Check for POD Servers and send disconnect
if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'})) {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is defined");
# Check address format
foreach my $podServerAttribute (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'}}) {
# Check for valid IP
if ($podServerAttribute =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/) {
my $podServer = $1;
# If we have a port, use it, otherwise use default 1700
my $podServerPort;
if ($podServerAttribute =~ /:([0-9]+)$/) {
$podServerPort = $1;
} else {
$podServerPort = 1700;
}
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying PODServer => IP: '".$podServer."' Port: '".$podServerPort."'");
# Create socket to send packet out on
my $podServerTimeout = "10"; # 10 second timeout
my $podSock = IO::Socket::INET->new(
PeerAddr => $podServer,
PeerPort => $podServerPort,
Type => SOCK_DGRAM,
Proto => 'udp',
TimeOut => $podServerTimeout,
);
if (!$podSock) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send POD on");
next;
}
# Check if we sent the packet...
if (!$podSock->send($response)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on socket");
next;
}
# Once sent, we need to get a response back
my $sh = IO::Select->new($podSock);
if (!$sh) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket");
next;
}
if (!$sh->can_read($podServerTimeout)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket");
next;
}
my $data;
$podSock->recv($data, 65536);
if (!$data) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Receive data failed");
$logReason = "POD Failure";
} else {
$logReason = "User POD";
}
#my @stuff = unpack('C C n a16 a*', $data);
#$self->log(LOG_DEBUG,"STUFF: ".Dumper(\@stuff));
} else {
$self->log(LOG_DEBUG,"[SMRADIUS] Invalid POD Server value: '".$podServerAttribute."'");
}
}
# Set default CoA server port
$coaServerPort //= 1700;
$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '".$coaServer."' Port: '".$coaServerPort."'");
# Create socket to send packet out on
my $coaServerTimeout = "2"; # 2 second timeout
my $coaSock = IO::Socket::INET->new(
PeerAddr => $coaServerIP,
PeerPort => $coaServerPort,
Type => SOCK_DGRAM,
Proto => 'udp',
TimeOut => $coaServerTimeout,
);
if (!$coaSock) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send CoA on: $!");
next;
}
# Check if we sent the packet...
if (!$coaSock->send($coaReq_packet)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on CoA socket: $!");
next;
}
# Once sent, we need to get a response back
my $select = IO::Select->new($coaSock);
if (!$select) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket: $!");
next;
}
if (!$select->can_read($coaServerTimeout)) {
$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket: $!");
next;
}
# Grab CoA response
my $coaRes_packet;
$coaSock->recv($coaRes_packet, 65536);
if (!$coaRes_packet) {
$self->log(LOG_INFO,"[SMRADIUS] POST-ACCT: No data received in response to our request to '$coaServerIP:$coaServerPort': $!");
$logReason = "No Response";
next;
}
# Parse the radius packet
my $coaRes = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'},$coaRes_packet);
# Check status
if ($coaRes->code eq "CoA-ACK") {
$logReason = "CoA Success";
last;
} elsif ($coaRes->code eq "CoA-NACK") {
$logReason = "CoA Fail";
} elsif ($coaRes->code eq "Disconnect-ACK") {
$logReason = "POD Success";
last;
} elsif ($coaRes->code eq "Disconnect-NACK") {
$logReason = "POD Fail";
} else {
$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is not defined");
$logReason = "CoA/POD Fail";
}
}
......@@ -1154,133 +1190,8 @@ sub process_request {
$resp->set_identifier($pkt->identifier);
$resp->set_authenticator($pkt->authenticator);
# Loop with attributes we got from the getReplyAttributes function, its a hash of arrays which are the values
my %replyAttributes = %{ $user->{'ReplyAttributes'} };
foreach my $attrName (keys %{$user->{'Attributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
# Grab attribute
my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyAttribute($self,\%replyAttributes,$attr);
}
}
# Loop with reply attributes
$request->addLogLine(". RFILTER => ");
foreach my $attrName (keys %replyAttributes) {
# Loop with values
foreach my $value (@{$replyAttributes{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-Attribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# Add each value
$resp->set_attr($attrName,$value);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
# Loop with vendor reply attributes
$request->addLogLine(". RVFILTER => ");
my %replyVAttributes = ();
# Process reply vattributes already added
foreach my $vendor (keys %{ $user->{'ReplyVAttributes'} }) {
# Loop with operators
foreach my $attrName (keys %{$user->{'ReplyVAttributes'}->{$vendor}}) {
# Add each value
foreach my $value (@{$user->{'ReplyVAttributes'}{$vendor}->{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-VAttribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# This attribute is not excluded, so its ok
$replyVAttributes{$vendor}->{$attrName} = $user->{'ReplyVAttributes'}->{$vendor}->{$attrName};
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
}
# Process VAttributes
foreach my $attrName (keys %{$user->{'VAttributes'}}) {
# Loop with operators
foreach my $attrOp (keys %{$user->{'VAttributes'}->{$attrName}}) {
# Check for filter matches
my $excluded = 0;
foreach my $item (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Filter-Reply-VAttribute'}}) {
my @attrList = split(/[;,]/,$item);
foreach my $aItem (@attrList) {
$excluded = 1 if (lc($attrName) eq lc($aItem));
}
}
# If we must be filtered, just exclude it then
if (!$excluded) {
# Grab attribute
my $attr = $user->{'VAttributes'}->{$attrName}->{$attrOp};
# Add this to the reply attribute?
setReplyVAttribute($self,\%replyVAttributes,$attr);
} else {
$request->addLogLine("%s ",$attrName);
}
}
}
foreach my $vendor (keys %replyVAttributes) {
# Loop with operators
foreach my $attrName (keys %{$replyVAttributes{$vendor}}) {
# Add each value
foreach my $value (@{$replyVAttributes{$vendor}->{$attrName}}) {
$resp->set_vsattr($vendor,$attrName,$value);
}
}
}
# Add attributes onto logline
$request->addLogLine(". REPLY => ");
foreach my $attrName ($resp->attributes) {
$request->addLogLine(
"%s: '%s",
$attrName,
$resp->rawattr($attrName)
);
}
# Add vattributes onto logline
$request->addLogLine(". VREPLY => ");
# Loop with vendors
foreach my $vendor ($resp->vendors()) {
# Loop with attributes
foreach my $attrName ($resp->vsattributes($vendor)) {
# Grab the value
my @attrRawVal = ( $resp->vsattr($vendor,$attrName) );
my $attrVal = $attrRawVal[0][0];
# Sanatize it a bit
if ($attrVal =~ /[[:cntrl:]]/) {
$attrVal = "-nonprint-";
} else {
$attrVal = "'$attrVal'";
}
$request->addLogLine(
"%s/%s: %s",
$vendor,
$attrName,
$attrVal
);
}
}
# Process the reply attributes
$self->_processReplyAttributes($request,$user,$resp);
$server->{'client'}->send(
auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
......@@ -1412,6 +1323,127 @@ EOF
#
# Internal functions
#
# Process reply attributes
sub _processReplyAttributes
{
my ($self,$request,$user,$pkt) = @_;