Skip to content

GitLab

Commit d82d2454 authored by Nigel Kukard's avatar Nigel Kukard
Browse files

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
Hide whitespace changes
Inline Side-by-side
Showing with 1085 additions and 311 deletions
FEATURES
View file @ d82d2454
......@@ -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
......
TODO
View file @ d82d2454
......@@ -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
......
database/core.tsql
View file @ d82d2454
......@@ -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@;
lib/smradius/attributes.pm
View file @ d82d2454
......@@ -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:
......
lib/smradius/client.pm
View file @ d82d2454
# 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;
}
......
lib/smradius/constants.pm
View file @ d82d2454
......@@ -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,
};
......
lib/smradius/daemon.pm
View file @ d82d2454
# 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);