Merge branch 'FUP' into 'master'

Added FUP support

See merge request !425

FEATURES

@@ -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

@@ -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

@@ -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

@@ -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

 # 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

@@ -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

 # 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
+			# 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,