dicts/dictionary.versanet

-#
-# dictionary.versanet Vendor specfic attributes for versanet
-#
-#
-#    VersaNet Communications, Inc.
-#     Http://www.versa-net.com
-#
-#
-#Versanet add Vendor specific terminal cause in our radius group.
-#You can follow this to set it in NAS box.
-#
-#          >> gr radius
-#          >> sh
-#          >> set 34 23
-#          >> co
-#
-#This will let our unit transfer every detail terminal cause 
-#information to Redius server's accounting log file and  
-#save as "Vendor Specific=Terminate Cause". 
-#
-# Version:   @(#)dictionary.versanet 1.00 22-Jul-1999 support@versanetcomm.com
-#
-
-VENDOR Versanet 2180
-
-ATTRIBUTE Versanet-Termination-Cause 1 integer Versanet
-
-VALUE Versanet-Termination-Cause Normal-Hangup-No-Error-Occurred 0
-VALUE Versanet-Termination-Cause Call-Waiting-Caused-Disconnect  3
-VALUE Versanet-Termination-Cause Physical-Carrier-Loss           4
-VALUE Versanet-Termination-Cause No-err-correction-at-other-end  5
-VALUE Versanet-Termination-Cause No-resp-to-feature-negotiation  6
-VALUE Versanet-Termination-Cause 1st-modem-async-only-2nd-sync   7
-VALUE Versanet-Termination-Cause No-framing-technique-in-common  8
-VALUE Versanet-Termination-Cause No-protocol-in-common           9
-VALUE Versanet-Termination-Cause Bad-resp-to-feature-negotiation 10
-VALUE Versanet-Termination-Cause No-sync-info-from-remote-modem  11
-VALUE Versanet-Termination-Cause Normal-Hangup-by-Remote-modem   12
-VALUE Versanet-Termination-Cause Retransmission-limit-reached    13
-VALUE Versanet-Termination-Cause Protocol-violation-occurred     14
-VALUE Versanet-Termination-Cause Lost-DTR                        15
-VALUE Versanet-Termination-Cause Received-GSTN-cleardown         16
-VALUE Versanet-Termination-Cause Inactivity-timeout              17
-VALUE Versanet-Termination-Cause Speed-not-supported             18
-VALUE Versanet-Termination-Cause Long-space-disconnect           19
-VALUE Versanet-Termination-Cause Key-abort-disconnect            20
-VALUE Versanet-Termination-Cause Clears-previous-disc-reason     21
-VALUE Versanet-Termination-Cause No-connection-established       22
-VALUE Versanet-Termination-Cause Disconnect-after-three-retrains 23
-

dicts/dictionary.wispr

+# Copyright (C) 2007-2016, AllWorldIT
+# Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 The FreeRADIUS Server Project
+#
+# The following dictionary file is a derivative work of the dictionary file
+# from the FreeRADIUS Server Project, which is licensed GPLv2. This file
+# therefore is also licensed under the terms of the GNU Public License,
+# verison 2
+#
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
 #
 # dictionary.wispr
 #

dicts/dictionary.xedia

-##############################################################################
-#
-#               XEDIA, AP series routers
-# From Yard RADIUS, and Piotr Orlewicz, porlewicz@teleton.pl www.real-data.pl
-#
-#	$Id: dictionary.xedia,v 1.1 2006/11/14 17:44:59 lem Exp $
-#
-#############################################################################
-VENDOR          Xedia           838
-
-ATTRIBUTE       Xedia-DNS-Server        1       ipaddr  	Xedia
-ATTRIBUTE       Xedia-NetBios-Server    2       ipaddr  	Xedia
-ATTRIBUTE       Xedia-Address-Pool      3       string  	Xedia
-ATTRIBUTE       Xedia-PPP-Echo-Interval 4       integer 	Xedia
-ATTRIBUTE       Xedia-SSH-Privileges    5       integer 	Xedia
-ATTRIBUTE       Xedia-Client-Access-Network     6       string  Xedia

Radius/Dictionary.pm → lib/smradius/Radius/Dictionary.pm

-package Radius::Dictionary;
+# COPYRIGHT AND LICENSE
+#
+# Copyright 2007-2016, AllWorldIT 
+#
+# Original work (c) Christopher Masto. Changes (c) 2002,2003 Luis
+# E. Muñoz <luismunoz@cpan.org>.
+# 
+# This software can be used under the same terms as perl itself. It also
+# carries the same warranties.
+# 
+# Please send bug reports (or patches) as well as feedback and
+# suggestions to
+# 
+# luismunoz@cpan.org
+# 
+# When submitting bugs, it is very important that you include the
+# relevant information for reproducing the bug. Packet dumps are most
+# useful.
+
+package smradius::Radius::Dictionary;
 
 use strict;
 use warnings;
@@ -31,9 +50,9 @@ sub new {
 sub readfile {
   my ($self, $filename) = @_;
 
-  open(DICT, "< $filename") or return undef;
+  open(my $DICT, "<", $filename) or return;
 
-  while (defined(my $l = <DICT>)) {
+  while (defined(my $l = <$DICT>)) {
     next if $l =~ /^\#/;
     next unless my @l = split /\s+/, $l;
 
@@ -166,7 +185,8 @@ sub readfile {
       warn "Warning: Weird dictionary line: $l\n";
     }
   }
-  close DICT;
+  close $DICT;
+  return 1;
 }
 
 # Accessors for standard attributes

Radius/Packet.pm → lib/smradius/Radius/Packet.pm

-package Radius::Packet;
+# COPYRIGHT AND LICENSE
+#
+# Copyright 2007-2016, AllWorldIT 
+#
+# Original work (c) Christopher Masto. Changes (c) 2002,2003 Luis
+# E. Muñoz <luismunoz@cpan.org>.
+# 
+# This software can be used under the same terms as perl itself. It also
+# carries the same warranties.
+# 
+# Please send bug reports (or patches) as well as feedback and
+# suggestions to
+# 
+# luismunoz@cpan.org
+# 
+# When submitting bugs, it is very important that you include the
+# relevant information for reproducing the bug. Packet dumps are most
+# useful.
+
+package smradius::Radius::Packet;
 
 use strict;
 require Exporter;
@@ -13,7 +32,7 @@ $VSA = 26;			# Type assigned in RFC2138 to the
 				# Vendor-Specific Attributes
 
 # Be sure our dictionaries are current
-use Radius::Dictionary 1.50;
+use smradius::Radius::Dictionary 1.50;
 use Carp;
 use Socket;
 use Digest::MD5;

lib/smradius/Radius/README.txt

+There are notable differences between Packet.pm and the Net::Radius Packet.pm, most notable raw value support.

smradius/attributes.pm → lib/smradius/attributes.pm

 # Attribute handling functions
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2016, 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
@@ -24,24 +24,36 @@ use strict;
 use warnings;
 
 # Exporter stuff
-require Exporter;
-our (@ISA,@EXPORT);
-@ISA = qw(Exporter);
+use base qw(Exporter);
+our (@EXPORT);
 @EXPORT = qw(
 	addAttribute
 	checkAuthAttribute
+	checkAcctAttribute
 	setReplyAttribute
 	setReplyVAttribute
 	processConfigAttribute
 
 	getAttributeValue
+
+	addAttributeConditionalVariable
+	processAttributeConditionals
 );
 
 
+use AWITPT::Util;
+
+# Check Math::Expression is installed
+if (!eval {require Math::Expression; 1;}) {
+	print STDERR "You're missing Math::Expression, try 'apt-get install libmath-expression-perl'\n";
+	exit 1;
+}
+
 use smradius::logging;
 use smradius::util;
 
 
+
 # Attributes we do not handle
 my @attributeCheckIgnoreList = (
 	'User-Password'
@@ -51,42 +63,97 @@ my @attributeReplyIgnoreList = (
 	'SMRadius-Capping-Traffic-Limit',
 	'SMRadius-Capping-Uptime-Limit',
 	'SMRadius-Validity-ValidFrom',
-	'SMRadius-Validity-ValidTo'
+	'SMRadius-Validity-ValidTo',
+	'SMRadius-Validity-ValidWindow',
+	'SMRadius-Username-Transform',
+	'SMRadius-Evaluate',
+	'SMRadius-Peer-Address',
+	'SMRadius-Disable-WebUITopup',
+	'SMRadius-AutoTopup-Traffic-Enabled',
+	'SMRadius-AutoTopup-Traffic-Amount',
+	'SMRadius-AutoTopup-Traffic-Limit',
+	'SMRadius-AutoTopup-Traffic-Notify',
+	'SMRadius-AutoTopup-Traffic-NotifyTemplate',
+	'SMRadius-AutoTopup-Traffic-Threshold',
+	'SMRadius-AutoTopup-Uptime-Enabled',
+	'SMRadius-AutoTopup-Uptime-Amount',
+	'SMRadius-AutoTopup-Uptime-Limit',
+	'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 = (
 );
 
 
-## @fn addAttribute($server,$attributes,$attribute)
+## @fn addAttribute($server,$user,$attribute)
 # Function to add an attribute to $attributes
 #
 # @param server Server instance
-# @param attributes Hashref of attributes we already have and / or must add to
+# @param nattributes Hashref of normal attributes we already have and/or must add to
+# @param vattributes Hashref of vendor attributes we already have and/or must add to
 # @param attribute Attribute to add, eg. Those from a database
 sub addAttribute
 {
-	my ($server,$attributes,$attribute) = @_;
+	my ($server,$user,$attribute) = @_;
+
+
+	# Check we have the name, operator AND value
+	if (!defined($attribute->{'Name'}) || !defined($attribute->{'Operator'}) || !defined($attribute->{'Value'})) {
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] Problem adding attribute with name = ".prettyUndef($attribute->{'Name'}).
+				", operator = ".prettyUndef($attribute->{'Operator'}).", value = ".prettyUndef($attribute->{'Value'}));
+		return;
+	}
+
+	# Clean them up a bit
+	$attribute->{'Name'} =~ s/\s*(\S+)\s*/$1/;
+	$attribute->{'Operator'} =~ s/\s*(\S+)\s*/$1/;
+
+	# Grab attribute name, operator and value
+	my $name = $attribute->{'Name'};
+	my $operator = $attribute->{'Operator'};
+	my $value = $attribute->{'Value'};
+	# Default attribute to add is normal
+	my $attributes = $user->{'Attributes'};
+
+	# Check where we must add this attribute, maybe to the vendor attributes?
+	if ($name =~ /^\[(\d+):(\S+)\]$/) {
+		my $vendor = $1; $name = $2;
+		# Set vendor
+		$attribute->{'Vendor'} = $vendor;
+		# Reset attribute name
+		$attribute->{'Name'} = $name;
+		# Set the attributes to use to the vendor
+		$attributes = $user->{'VAttributes'};
+	}
 
 	# Check if this is an array
-	if ($attribute->{'Operator'} =~ s/^\|\|//) {
+	if ($operator =~ s/^\|\|//) {
 		# Check if we've seen this before
-		if (defined($attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}}) &&
-				ref($attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}}->{'Value'}) eq "ARRAY" ) {
+		if (defined($attributes->{$name}->{$operator}) &&
+				ref($attributes->{$name}->{$operator}->{'Value'}) eq "ARRAY" ) {
 			# Then add value to end of array
-			push(@{$attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}}->{'Value'}}, $attribute->{'Value'});
+			push(@{$attributes->{$name}->{$operator}->{'Value'}}, $value);
 
 		# If we have not seen it before, initialize it
 		} else {
 			# Assign attribute
-			$attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}} = $attribute;
+			$attributes->{$name}->{$operator} = $attribute;
 			# Override type ... else we must create a custom attribute hash, this is dirty, but faster
-			$attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}}->{'Value'} = [ $attribute->{'Value'} ];
+			$attributes->{$name}->{$operator}->{'Value'} = [ $value ];
 		}
 
 	# If its not an array, just add it normally
 	} else {
-		$attributes->{$attribute->{'Name'}}->{$attribute->{'Operator'}} = $attribute;
+		$attributes->{$name}->{$operator} = $attribute;
 	}
+
+	# Process the item incase its a config attribute
+	return processConfigAttribute($server,$user,$attribute);
 }
 
 
@@ -99,7 +166,7 @@ sub addAttribute
 # @param attribute Attribute to check, eg. One of the ones from the database
 sub checkAuthAttribute
 {
-	my ($server,$packetAttributes,$attribute) = @_;
+	my ($server,$user,$packetAttributes,$attribute) = @_;
 
 
 	# Check ignore list
@@ -122,18 +189,21 @@ sub checkAuthAttribute
 	# Get packet attribute value
 	my $attrVal = $packetAttributes->{$attribute->{'Name'}};
 
-	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".niceUndef($attrVal)." against: '".
+	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
 			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
 
 	# Loop with all the test attribute values
 	foreach my $tattrVal (@attrValues) {
+		# Sanitize the operator
+		my ($operator) = ($attribute->{'Operator'} =~ /^(?:\|\|)?(.*)$/);
+
 		# Operator: ==
 		#
 		# Use: Attribute == Value
 		# As a check item, it matches if the named attribute is present in the request,
 		# AND has the given value.
 		#
-		if ($attribute->{'Operator'} eq '==' ) {
+		if ($operator eq '==' ) {
 			# Check for correct value
 			if (defined($attrVal) && $attrVal eq $tattrVal) {
 				$matched = 1;
@@ -147,7 +217,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '>') {
+		} elsif ($operator eq '>') {
 			if (defined($attrVal) && $attrVal =~ /^[0-9]+$/) {
 				# Check for correct value
 				if ($attrVal > $tattrVal) {
@@ -165,7 +235,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '<') {
+		} elsif ($operator eq '<') {
 			# Check for correct value
 			if (defined($attrVal) && $attrVal < $tattrVal) {
 				$matched = 1;
@@ -179,7 +249,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '<=') {
+		} elsif ($operator eq '<=') {
 			# Check for correct value
 			if (defined($attrVal) && $attrVal <= $tattrVal) {
 				$matched = 1;
@@ -193,7 +263,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '>=') {
+		} elsif ($operator eq '>=') {
 			# Check for correct value
 			if (defined($attrVal) && $attrVal >= $tattrVal) {
 				$matched = 1;
@@ -207,7 +277,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '=*') {
+		} elsif ($operator eq '=*') {
 			# Check for matching value
 			if (defined($attrVal)) {
 				$matched = 1;
@@ -221,9 +291,9 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '!=') {
+		} elsif ($operator eq '!=') {
 			# Check for correct value
-			if (defined($attrVal) && $attrVal ne $tattrVal) {
+			if (!defined($attrVal) || $attrVal ne $tattrVal) {
 				$matched = 1;
 			}
 
@@ -235,7 +305,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '!*') {
+		} elsif ($operator eq '!*') {
 			# Skip if value not defined
 			if (!defined($attrVal)) {
 				$matched = 1;
@@ -249,7 +319,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '=~') {
+		} elsif ($operator eq '=~') {
 			# Check for correct value
 			if (defined($attrVal) && $attrVal =~ /$tattrVal/) {
 				$matched = 1;
@@ -264,7 +334,7 @@ sub checkAuthAttribute
 		#
 		# Not allowed as a reply item.
 
-		} elsif ($attribute->{'Operator'} eq '!~') {
+		} elsif ($operator eq '!~') {
 			# Check for correct value
 			if (defined($attrVal) && !($attrVal =~ /$tattrVal/)) {
 				$matched = 1;
@@ -276,12 +346,114 @@ 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 '+=') {
+
+			# Check if we're a conditional and process
+			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
+				$matched = processConditional($server,$user,$attribute,$tattrVal);
+			} else {
+				$matched = 1;
+			}
+
+		# FIXME
+		# Operator: :=
+		#
+		# Use: Attribute := Value
+		# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
+
+		} elsif ($operator eq ':=') {
+			# FIXME - Add or replace config items
+			# FIXME - Add attribute to request
+
+			# Check if we're a conditional and process
+			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
+				$matched = processConditional($server,$user,$attribute,$tattrVal);
+			} else {
+				$matched = 1;
+			}
+
+		# Attributes that are not defined
+		} else {
+			# Ignore
+			$matched = 2;
+			last;
+		}
+	}
+
+	# Some debugging info
+	if ($matched == 1) {
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' matched");
+	} elsif ($matched == 2) {
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored");
+	} else {
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' not matched");
+	}
+
+	return $matched;
+}
+
+
+
+
+## @fn checkAcctAttribute($server,$packetAttributes,$attribute)
+# Function to check an attribute in the accounting stage
+#
+# @param server Server instance
+# @param packetAttributes Hashref of attributes provided, eg. Those from the packet
+# @param attribute Attribute to check, eg. One of the ones from the database
+sub checkAcctAttribute
+{
+	my ($server,$user,$packetAttributes,$attribute) = @_;
+
+
+	# Check ignore list
+	foreach my $ignoredAttr (@attributeCheckIgnoreList) {
+		# 2 = IGNORE, so return IGNORE for all ignored items
+		return 2 if ($attribute->{'Name'} eq $ignoredAttr);
+	}
+
+	# Matched & ok?
+	my $matched = 0;
+
+	# Figure out our attr values
+	my @attrValues;
+	if (ref($attribute->{'Value'}) eq "ARRAY") {
+		@attrValues = @{$attribute->{'Value'}};
+	} else {
+		@attrValues = ( $attribute->{'Value'} );
+	}
+
+	# Get packet attribute value
+	my $attrVal = $packetAttributes->{$attribute->{'Name'}};
+
+	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CHECK attribute value ".prettyUndef($attrVal)." against: '".
+			$attribute->{'Name'}."' ".$attribute->{'Operator'}." '".join("','",@attrValues)."'");
+
+	# Loop with all the test attribute values
+	foreach my $tattrVal (@attrValues) {
+		# Sanitize the operator
+		my ($operator) = ($attribute->{'Operator'} =~ /^(?:\|\|)?(.*)$/);
+
+		# Operator: +=
+		#
+		# Use: Attribute += Value
+		# 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 idendtical meaning, but the
 		# attribute is added to the reply items.
 
-		} elsif ($attribute->{'Operator'} eq '+=') {
-			# FIXME - Add to config items
-			$matched = 1;
+		if ($operator eq '+=') {
+
+			# Check if we're a conditional and process
+			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
+				$matched = processConditional($server,$user,$attribute,$tattrVal);
+			} else {
+				$matched = 1;
+			}
 
 		# FIXME
 		# Operator: :=
@@ -289,10 +461,16 @@ sub checkAuthAttribute
 		# Use: Attribute := Value
 		# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
 
-		} elsif ($attribute->{'Operator'} eq ':=') {
+		} elsif ($operator eq ':=') {
 			# FIXME - Add or replace config items
 			# FIXME - Add attribute to request
-			$matched = 1;
+
+			# Check if we're a conditional and process
+			if ($attribute->{'Name'} eq "SMRadius-Evaluate") {
+				$matched = processConditional($server,$user,$attribute,$tattrVal);
+			} else {
+				$matched = 1;
+			}
 
 		# Attributes that are not defined
 		} else {
@@ -372,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
@@ -387,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 '+=') {
@@ -398,9 +576,8 @@ sub setReplyAttribute
 
 	# Attributes that are not defined
 	} else {
-		# Ignore and b0rk out
+		# Ignore invalid operator
 		$server->log(LOG_NOTICE,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored, invalid operator?");
-		last;
 	}
 
 	return;
@@ -437,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)."'");
 
 
@@ -467,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
@@ -482,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 '+=') {
@@ -504,7 +681,7 @@ sub setReplyVAttribute
 
 
 
-## @fn processConfigAttribute($server,$packetAttributes,$attribute)
+## @fn processConfigAttribute($server,$user,$attribute)
 # Function to process a configuration attribute
 #
 # @param server Server instance
@@ -512,11 +689,13 @@ sub setReplyVAttribute
 # @param attribute Attribute to process, eg. One of the ones from the database
 sub processConfigAttribute
 {
-	my ($server,$configAttributes,$attribute) = @_;
+	my ($server,$user,$attribute) = @_;
 
+	# Make things easier?
+	my $configAttributes = $user->{'ConfigAttributes'};
 
-	# Matched & ok?
-	my $matched = 0;
+	# Did we get processed?
+	my $processed = 0;
 
 	# Figure out our attr values
 	my @attrValues;
@@ -526,21 +705,18 @@ sub processConfigAttribute
 		@attrValues = ( $attribute->{'Value'} );
 	}
 
-	$server->log(LOG_DEBUG,"[ATTRIBUTES] Processing CONFIG attribute: '".$attribute->{'Name'}."' ".
-			$attribute->{'Operator'}." '".join("','",@attrValues)."'");
-
 	# Operator: +=
 	#
 	# Use: Attribute += Value
 	# 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 '+=') {
-		$server->log(LOG_DEBUG,"[ATTRIBUTES] Operator '+=' triggered: Adding item to configuration items.");
 		push(@{$configAttributes->{$attribute->{'Name'}}},@attrValues);
+		$processed = 1;
 
 	# Operator: :=
 	#
@@ -548,17 +724,21 @@ 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 ':=') {
-		$server->log(LOG_DEBUG,"[ATTRIBUTES] Operator ':=' triggered: Adding or replacing item in configuration items.");
 		@{$configAttributes->{$attribute->{'Name'}}} = @attrValues;
+		$processed = 1;
 
-	# Operators that are not defined
-	} else {
-		# Ignore
-		$server->log(LOG_DEBUG,"[ATTRIBUTES] - Attribute '".$attribute->{'Name'}."' ignored");
 	}
+
+	# If we got procsessed output some debug
+	if ($processed) {
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] Processed CONFIG attribute: '".$attribute->{'Name'}."' ".
+				$attribute->{'Operator'}." '".join("','",@attrValues)."'");
+	}
+
+	return $processed;
 }
 
 
@@ -584,6 +764,113 @@ sub getAttributeValue
 }
 
 
+## @fn addAttributeConditionalVariable($user,$name,$value)
+# Function that adds a conditional variable
+#
+# @param user User hash
+# @param name Variable name
+# @param value Variable value
+sub addAttributeConditionalVariable
+{
+	my ($user,$name,$value) = @_;
+
+
+	$user->{'AttributeConditionalVariables'}->{$name} = [ $value ];
+
+	return;
+}
+
+
+## @fn processConditional($server,$user,$attribute,$attrVal)
+# This function processes a attribute conditional
+#
+# @param server Server hash
+# @param user User hash
+# @param attribute Attribute hash to process
+# @param attrVal Current value we need to process
+sub processConditional
+{
+	my ($server,$user,$attribute,$attrVal) = @_;
+
+
+	# Split off expression
+	# 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)) {
+		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$attrVal' cannot be parsed");
+		return 1;
+	}
+
+	$server->log(LOG_DEBUG,"[ATTRIBUTES] Conditional parsed ".$attribute->{'Name'}." => if ($condition) then {".
+			( $onTrue ? $onTrue : "-undef-")."} else {".( $onFalse ? $onFalse : "-undef-")."}");
+
+	# Create the environment
+	my @error;
+	my $mathEnv = Math::Expression->new(
+			'PrintErrFunc' => sub { @error = @_ },
+			'VarHash' => $user->{'AttributeConditionalVariables'}
+	);
+
+	# Parse and create math tree
+	my $mathTree = $mathEnv->Parse($condition);
+	# Check for error
+	if (@error) {
+		my $errorStr = sprintf($error[0],$error[1]);
+		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$condition' in '$attrVal' does not parse: $errorStr");
+		return 1;
+	}
+
+	# Evaluate tree
+	my $res = $mathEnv->Eval($mathTree);
+	if (!defined($res)) {
+		$server->log(LOG_WARN,"[ATTRIBUTES] Conditional '$condition' in '$attrVal' does not evaluate");
+		return 1;
+	}
+
+	# Check result
+	# If we have a onTrue or onFalse we will return "Matched = True"
+	# If we don't have an onTrue or onFalse we will return the result of the $condition
+	my $attribStr;
+	if ($res && defined($onTrue)) {
+		$attribStr = $onTrue;
+		$res = 1;
+	} elsif (!$res && defined($onFalse)) {
+		$attribStr = $onFalse;
+		$res = 1;
+	} elsif (defined($onTrue) || defined($onFalse)) {
+		$res = 1;
+	}
+
+	$server->log(LOG_DEBUG,"[ATTRIBUTES] - Evaluated to '$res' returning '".(defined($attribStr) ? $attribStr : "-undef-")."'");
+
+	# Loop with attributes:
+	# We only get here if $res is set to 1 above, if its only a conditional with no onTrue & onFalse
+	# Then attribStr will be unef
+	if ($res && defined($attribStr)) {
+		# Sanitize the output
+		$attribStr =~ s/^\s*//;
+		$attribStr =~ s/\s*$//;
+
+		foreach my $rawAttr (split(/;/,$attribStr)) {
+			# Split off attribute string:  name = value
+			my ($attrName,$attrVal) = ($rawAttr =~ /^\s*([^=]+)=\s*(.*)/);
+			# Build attribute
+			my $attribute = {
+				'Name' => $attrName,
+				'Operator' => ':=',
+				'Value' => $attrVal
+			};
+			# Add attribute
+			addAttribute($server,$user,$attribute);
+		}
+	}
+
+	return $res;
+}
+
+
 
 1;
 # vim: ts=4

lib/smradius/client.pm

+# Radius client
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+
+
+package smradius::client;
+
+
+use strict;
+use warnings;
+
+use base qw(AWITPT::Object);
+
+use Getopt::Long qw( GetOptionsFromArray );
+use IO::Select;
+use IO::Socket;
+
+use smradius::version;
+use smradius::Radius::Packet;
+
+# Check Config::IniFiles is instaslled
+if (!eval {require Config::IniFiles; 1;}) {
+	print STDERR "You're missing Config::IniFiles, try 'apt-get install libconfig-inifiles-perl'\n";
+	exit 1;
+}
+
+
+
+# Run the client
+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-2019, AllWorldIT\n");
+
+	print(STDERR "\n");
+
+	# Set defaults
+	my $cfg;
+	$cfg->{'config_file'} = "/etc/smradiusd.conf";
+
+	# Grab runtime arguments
+	my @runArgs = @methodArgs ? @methodArgs : @ARGV;
+
+	# Parse command line params
+	my $cmdline;
+	%{$cmdline} = ();
+	if (!GetOptionsFromArray(
+		\@runArgs,
+		\%{$cmdline},
+		"config:s",
+		"raddb:s",
+		"listen:s",
+		"help",
+	)) {
+		print(STDERR "ERROR: Error parsing commandline arguments");
+		return 1;
+	}
+
+	# Check for some args
+	if ($cmdline->{'help'}) {
+		displayHelp();
+		return 0;
+	}
+
+	# Make sure we only have 2 additional args
+	if (@runArgs < 3) {
+		print(STDERR "ERROR: Invalid number of arguments\n");
+		displayHelp();
+		return 1;
+	}
+
+	if (!defined($cmdline->{'raddb'}) || $cmdline->{'raddb'} eq "") {
+		print(STDERR "ERROR: No raddb directory specified!\n");
+		displayHelp();
+		return 1;
+	}
+
+	# Get variables we need
+	my $server = shift(@runArgs);
+	my $type = shift(@runArgs);
+	$self->{'secret'} = shift(@runArgs);
+
+	# Validate type
+	if (!defined($type) || ( $type ne "acct" && $type ne "auth" && $type ne "disconnect")) {
+		print(STDERR "ERROR: Invalid packet type specified!\n");
+		displayHelp();
+		return 1;
+	}
+
+
+	print(STDERR "\n");
+
+
+	# Time to start loading the dictionary
+	print(STDERR "Loading dictionaries...");
+	my $raddb = smradius::Radius::Dictionary->new();
+
+	# Look for files in the dir
+	my $DIR;
+	if (!opendir($DIR, $cmdline->{'raddb'})) {
+		print(STDERR "ERROR: Cannot open '".$cmdline->{'raddb'}."': $!");
+		return 1;
+	}
+	my @raddb_files = readdir($DIR);
+
+	# And load the dictionary
+	foreach my $df (@raddb_files) {
+		my $df_fn = $cmdline->{'raddb'}."/$df";
+		# Load dictionary
+		if (!$raddb->readfile($df_fn)) {
+			print(STDERR "Failed to load dictionary '$df_fn': $!");
+		}
+		print(STDERR ".");
+	}
+	print(STDERR "\n");
+
+	# Decide what type of packet this is
+	my $port;
+	my $pkt_code;
+	if ($type eq "acct") {
+		$port = 1813;
+		$pkt_code = "Accounting-Request";
+	} elsif ($type eq "auth") {
+		$port = 1812;
+		$pkt_code = "Access-Request";
+	} elsif ($type eq "disconnect") {
+		$port = 1813;
+		$pkt_code = "Disconnect-Request";
+	}
+
+
+	print(STDERR "\nRequest:\n");
+	printf(STDERR " > Secret => '%s'\n",$self->{'secret'});
+	# Build packet
+	$self->{'packet'} = smradius::Radius::Packet->new($raddb);
+	$self->{'packet'}->set_code($pkt_code);
+	# Generate identifier
+	my $ident = int(rand(32768));
+	$self->{'packet'}->set_identifier($ident);
+	print(STDERR " > Identifier: $ident\n");
+	# Generate authenticator number
+	my $authen = int(rand(32768));
+	$self->{'packet'}->set_authenticator($authen);
+	print(STDERR " > Authenticator: $ident\n");
+
+	# Pull in attributes from STDIN if we're not being called as a function
+	if (!@runArgs) {
+		while (my $line = <STDIN>) {
+			$self->addAttributesFromString($line);
+		}
+	}
+
+	# Pull in attributes from commandline
+	while (my $line = shift(@runArgs)) {
+		$self->addAttributesFromString($line);
+	}
+
+	# Create UDP packet
+	my $udp_packet = $self->{'packet'}->pack();
+
+	# Create socket to send packet out on
+	my $sockTimeout = "10";  # 10 second timeout
+	my $sock = IO::Socket::INET->new(
+		PeerAddr => $server,
+		PeerPort => $port,
+		Type => SOCK_DGRAM,
+		Proto => 'udp',
+		Timeout => $sockTimeout,
+	);
+
+	if (!$sock) {
+		print(STDERR "ERROR: Failed to create socket\n");
+		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");
+
+	# Once sent, we need to get a response back
+	my $rsock = IO::Select->new($sock);
+	if (!$rsock) {
+		print(STDERR "ERROR: Failed to select response data on socket\n");
+		return 1;
+	}
+
+	# Check if we can read a response after the select()
+	if (!$rsock->can_read($sockTimeout)) {
+		print(STDERR "ERROR: Failed to receive response data on socket\n");
+		return 1;
+	}
+
+	# Read packet
+	$sock->recv($udp_packet, 65536);
+	if (!$udp_packet) {
+		print(STDERR "ERROR: Receive response data failed on socket: $!\n");
+		return 1;
+	}
+
+	# Parse packet
+	my $pkt = smradius::Radius::Packet->new($raddb,$udp_packet);
+	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 $ret;
+	}
+
+	return 0;
+}
+
+
+
+
+# Return a hashed version of the packet
+sub hashedPacket
+{
+	my ($self,$pkt) = @_;
+
+
+	my $res = {};
+
+
+	$res->{'code'} = $pkt->code();
+	$res->{'identifier'} = $pkt->identifier();
+
+	foreach my $attrName (sort $pkt->attributes()) {
+		my $attrVal = $pkt->rawattr($attrName);
+		$res->{'attributes'}->{$attrName} = $attrVal;
+	}
+
+	foreach my $attrVendor ($pkt->vendors()) {
+		foreach my $attrName ($pkt->vsattributes($attrVendor)) {
+			$res->{'vattributes'}->{$attrVendor}->{$attrName} = $pkt->vsattr($attrVendor,$attrName);
+		}
+	}
+
+	return $res;
+}
+
+
+
+# Allow adding attribute from a string
+sub addAttributesFromString
+{
+	my ($self,$line) = @_;
+
+
+	# Remove EOL
+	chomp($line);
+	# Split on , and newline
+	my @rawAttributes = split(/[,\n]+/,$line);
+	foreach my $attr (@rawAttributes) {
+		# Pull off attribute name & value
+		my ($name,$value) = ($attr =~ /\s*(\S+)\s*=\s?(.+)/);
+		$self->addAttribute($name,$value);
+	}
+
+	return;
+}
+
+
+
+# Add attribute to packet
+sub addAttribute
+{
+	my ($self,$name,$value) = @_;
+
+
+	# Add to packet
+	print(STDERR " > Adding '$name' => '$value'\n");
+	if ($name eq "User-Password") {
+		$self->{'packet'}->set_password($value,$self->{'secret'});
+	} else {
+		$self->{'packet'}->set_attr($name,$value);
+	}
+
+	return;
+}
+
+
+
+# Display help
+sub displayHelp {
+	print(STDERR<<EOF);
+
+Usage: $0 [args] <server> <acct|auth|disconnect> <secret> [ATTR=VALUE,...]
+    --raddb=<DIR>          Directory where the radius dictionary files are
+
+EOF
+
+	return;
+}
+
+
+1;
+# vim: ts=4

lib/smradius/config.pm

+# SMRadius config information
+# Copyright (C) 2007-2015, 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+
+## @class smradius::config
+# Configuration handling class
+package smradius::config;
+
+use strict;
+use warnings;
+
+# Exporter stuff
+use base qw(Exporter);
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
+);
+
+
+use AWITPT::Util;
+use smradius::logging;
+
+
+# Our vars
+my $config;
+
+
+## @fn Init($server)
+# Initialize this module with a server object
+#
+# @param server Server object we need to setup
+sub Init
+{
+	my $server = shift;
+
+
+	# Setup configuration
+	$config = $server->{'inifile'};
+
+	# Setup database config
+	my $db;
+	$db->{'DSN'} = $config->{'database'}{'dsn'};
+	$db->{'Username'} = $config->{'database'}{'username'};
+	$db->{'Password'} = $config->{'database'}{'password'};
+	$db->{'enabled'} = 0;
+	# Check we have all the config we need
+	if (!defined($db->{'DSN'})) {
+		$server->log(LOG_NOTICE,"smradius/config.pm: No 'DSN' defined in config file for 'database'");
+	}
+	$server->{'smradius'}{'database'} = $db;
+
+	# Setup event timezone config
+	if (defined($config->{'server'}{'event_timezone'})) {
+		$server->{'smradius'}{'event_timezone'} = $config->{'server'}{'event_timezone'};
+	} else {
+		$server->{'smradius'}{'event_timezone'} = "GMT";
+	}
+
+	# Should we use the packet timestamp?
+	if (defined($config->{'radius'}{'use_packet_timestamp'})) {
+		if (defined(my $val = isBoolean($config->{'radius'}{'use_packet_timestamp'}))) {
+			$server->{'smradius'}{'use_packet_timestamp'} = $val;
+		} else {
+			$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'use_packet_timestamp' is invalid");
+		}
+	} else {
+		$server->{'smradius'}{'use_packet_timestamp'} = 0;
+	}
+
+	# Should we use abuse prevention?
+	if (defined($config->{'radius'}{'use_abuse_prevention'})) {
+		if (defined(my $val = isBoolean($config->{'radius'}{'use_abuse_prevention'}))) {
+			$server->{'smradius'}{'use_abuse_prevention'} = $val;
+		} else {
+			$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'use_abuse_prevention' is invalid");
+		}
+	} else {
+		$server->{'smradius'}{'use_abuse_prevention'} = 0;
+	}
+	if (defined($config->{'radius'}{'access_request_abuse_threshold'})) {
+		if ($config->{'radius'}{'access_request_abuse_threshold'} =~ /^[1-9][0-9]*$/i) {
+			$server->{'smradius'}{'access_request_abuse_threshold'} = $config->{'radius'}{'access_request_abuse_threshold'};
+		} else {
+			$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'access_request_abuse_threshold' is invalid");
+		}
+	} else {
+		$server->{'smradius'}{'access_request_abuse_threshold'} = 10;
+	}
+	if (defined($config->{'radius'}{'accounting_request_abuse_threshold'})) {
+		if ($config->{'radius'}{'accounting_request_abuse_threshold'} =~ /^[1-9][0-9]*$/i) {
+			$server->{'smradius'}{'accounting_request_abuse_threshold'} = $config->{'radius'}{'accounting_request_abuse_threshold'};
+		} else {
+			$server->log(LOG_NOTICE,"smradius/config.pm: Value for 'accounting_request_abuse_threshold' is invalid");
+		}
+	} else {
+		$server->{'smradius'}{'accounting_request_abuse_threshold'} = 5;
+	}
+
+	$server->log(LOG_NOTICE,"smradius/config.pm: Using ". ( $server->{'smradius'}{'use_packet_timestamp'} ? 'packet' : 'server' ) ." timestamp");
+	$server->log(LOG_NOTICE,"smradius/config.pm: Using timezone '".$server->{'smradius'}{'event_timezone'}."'");
+	$server->log(LOG_NOTICE,"smradius/config.pm: Abuse prevention ".( $server->{'smradius'}{'use_abuse_prevention'} ? 
+			'active (access-threshold = '.$server->{'smradius'}{'access_request_abuse_threshold'}.
+			', accounting-threshold = '.$server->{'smradius'}{'accounting_request_abuse_threshold'}.')'
+			: 'inactive'));
+
+	return;
+}
+
+
+## @fn getConfig
+# Get the config hash
+#
+# @return Hash ref of all our config items
+sub getConfig
+{
+	return $config;
+}
+
+
+
+1;
+# vim: ts=4

smradius/constants.pm → lib/smradius/constants.pm

 # SMRadius Constants
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2015, 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
@@ -20,31 +20,36 @@
 ## @class smradius::constants
 # SMRadius constants package
 package smradius::constants;
+use base qw(Exporter);
 
 use strict;
+use warnings;
 
-# Exporter stuff
-require Exporter;
-our (@ISA,@EXPORT,@EXPORT_OK);
-@ISA = qw(Exporter);
+
+
+our (@EXPORT,@EXPORT_OK);
 @EXPORT = qw(
 	RES_OK
 	RES_ERROR
-	
+
 	MOD_RES_ACK
 	MOD_RES_NACK
 	MOD_RES_SKIP
+
+	GIGAWORD_VALUE
 );
 @EXPORT_OK = ();
 
 
 use constant {
-	RES_OK			=> 0,
-	RES_ERROR		=> -1,
+	RES_OK => 0,
+	RES_ERROR => -1,
+
+	MOD_RES_SKIP => 0,
+	MOD_RES_ACK => 1,
+	MOD_RES_NACK => 2,
 
-	MOD_RES_SKIP		=> 0,
-	MOD_RES_ACK		=> 1,
-	MOD_RES_NACK		=> 2,
+	GIGAWORD_VALUE => 2**32,
 };
 
 

smradiusd → lib/smradius/daemon.pm

-#!/usr/bin/perl
 # Radius daemon
-# Copyright (C) 2007-2009, 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
@@ -17,37 +16,101 @@
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 
+
+package smradius::daemon;
+
+
 use strict;
 use warnings;
 
-# Set library directory
-use lib qw(
-	../ ./
-	smradius
-	awitpt/db
-);
 
-package radiusd;
+# Check if we have Net::Server::PreFork installed
+if (!eval {require Net::Server::PreFork; 1;}) {
+	print STDERR "You're missing Net::Server::PreFork, try 'apt-get install libnet-server-perl'\n";
+	exit 1;
+}
+
+# Check Config::IniFiles is instaslled
+if (!eval {require Config::IniFiles; 1;}) {
+	print STDERR "You're missing Config::IniFiles, try 'apt-get install libconfig-inifiles-perl'\n";
+	exit 1;
+}
+
+# Check DateTime is installed
+if (!eval {require DateTime; 1;}) {
+	print STDERR "You're missing DateTime, try 'apt-get install libdatetime-perl'\n";
+	exit 1;
+}
+
+# Check Crypt::DES is installed
+if (!eval {require Crypt::DES; 1;}) {
+	print STDERR "You're missing DateTime, try 'apt-get install libcrypt-des-perl'\n";
+	exit 1;
+}
 
+# Check Crypt::RC4 is installed
+if (!eval {require Crypt::RC4; 1;}) {
+	print STDERR "You're missing Crypt::RC4, try 'apt-get install libcrypt-rc4-perl'\n";
+	exit 1;
+}
 
-use base qw(Net::Server::PreFork);
-use Config::IniFiles;
-use DateTime;
-use Getopt::Long;
+# Check Digest::MD4 is installed
+if (!eval {require Digest::MD4; 1;}) {
+	print STDERR "You're missing Digest::MD4, try 'apt-get install libdigest-md4-perl'\n";
+	exit 1;
+}
+
+# Check Digest::SHA is installed
+if (!eval {require Digest::SHA; 1;}) {
+	print STDERR "You're missing Digest::SHA, try 'apt-get install libdigest-sha-perl'\n";
+	exit 1;
+}
+
+# Check Date::Parse is installed
+if (!eval {require Date::Parse; 1;}) {
+	print STDERR "You're missing TimeDate, try 'apt-get install libtimedate-perl'\n";
+	exit 1;
+}
+
+# Check Cache::FastMmap is installed
+if (!eval {require Cache::FastMmap; 1;}) {
+	print STDERR "You're missing DateTime, try 'apt-get install libcache-fastmmap-perl'\n";
+	exit 1;
+} else {
+	eval {use AWITPT::Cache;};
+}
+
+# Check MIME::Lite is installed
+if (!eval {require MIME::Lite; 1;}) {
+	print STDERR "You're missing MIME::Lite, try 'apt-get install libmime-lite-perl'\n";
+	exit 1;
+}
+
+
+## no critic (BuiltinFunctions::ProhibitStringyEval)
+eval qq{
+	use base qw(Net::Server::PreFork);
+};
+## use critic
+
+use Getopt::Long qw( GetOptionsFromArray );
+use Socket;
 use Sys::Syslog;
+use Time::HiRes qw( gettimeofday tv_interval );
 
+use AWITPT::DB::DBLayer;
+use AWITPT::Util qw( booleanize );
+
+use smradius::Radius::Packet;
 use smradius::version;
 use smradius::constants;
+use smradius::daemon::request;
 use smradius::logging;
 use smradius::config;
-use awitpt::db::dbilayer;
-use awitpt::cache;
 use smradius::util;
 use smradius::attributes;
 
-use Radius::Packet;
 
-use Socket;
 
 
 
@@ -68,12 +131,13 @@ sub configure {
 	# Set defaults
 	my $cfg;
 	$cfg->{'config_file'} = "/etc/smradiusd.conf";
+	$cfg->{'cache_file'} = '/var/run/smradius/cache';
 
 	$server->{'timeout'} = 120;
 	$server->{'background'} = "yes";
-	$server->{'pid_file'} = "/var/run/smradiusd.pid";
+	$server->{'pid_file'} = "/var/run/smradius/smradiusd.pid";
 	$server->{'log_level'} = 2;
-	$server->{'log_file'} = "/var/log/smradiusd.log";
+	$server->{'log_file'} = "/var/log/smradius/smradiusd.log";
 
 	$server->{'host'} = "*";
 	$server->{'port'} = [ 1812, 1813 ];
@@ -85,16 +149,23 @@ sub configure {
 	$server->{'max_servers'} = 25;
 	$server->{'max_requests'} = 1000;
 
+	# Work out runtime arguments
+	my @runArgs = @{$server->{'_run_args'}} ? @{$server->{'_run_args'}} : @ARGV;
+
 	# Parse command line params
 	my $cmdline;
 	%{$cmdline} = ();
-	GetOptions(
+	if (!GetOptionsFromArray(
+			\@runArgs,
 			\%{$cmdline},
 			"help",
 			"config:s",
 			"debug",
 			"fg",
-	) or die "Error parsing commandline arguments";
+	)) {
+		print(STDERR "ERROR: Error parsing commandline arguments");
+		return 1;
+	}
 
 	# Check for some args
 	if ($cmdline->{'help'}) {
@@ -133,7 +204,7 @@ sub configure {
 			'min_spare_servers',
 			'max_spare_servers',
 			'max_servers',
-			'max_requests',
+			'max_requests'
 	);
 	foreach my $param (@server_params) {
 		$server->{$param} = $config{'server'}{$param} if (defined($config{'server'}{$param}));
@@ -177,9 +248,9 @@ sub configure {
 	if (ref($config{'system'}{'modules'}) eq "ARRAY") {
 		foreach my $module (@{$config{'system'}{'modules'}}) {
 			$module =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($module =~ /^#/);
-	 		$module = "system/$module";
+			# Skip comments
+			next if ($module =~ /^#/);
+			$module = "system/$module";
 			push(@{$cfg->{'module_list'}},$module);
 		}
 	} else {
@@ -198,9 +269,9 @@ sub configure {
 	if (ref($config{'features'}{'modules'}) eq "ARRAY") {
 		foreach my $module (@{$config{'features'}{'modules'}}) {
 			$module =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($module =~ /^#/);
-	 		$module = "features/$module";
+			# Skip comments
+			next if ($module =~ /^#/);
+			$module = "features/$module";
 			push(@{$cfg->{'module_list'}},$module);
 		}
 	} else {
@@ -219,9 +290,9 @@ sub configure {
 	if (ref($config{'authentication'}{'mechanisms'}) eq "ARRAY") {
 		foreach my $module (@{$config{'authentication'}{'mechanisms'}}) {
 			$module =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($module =~ /^#/);
-	 		$module = "authentication/$module";
+			# Skip comments
+			next if ($module =~ /^#/);
+			$module = "authentication/$module";
 			push(@{$cfg->{'module_list'}},$module);
 		}
 	} else {
@@ -237,9 +308,9 @@ sub configure {
 	if (ref($config{'authentication'}{'users'}) eq "ARRAY") {
 		foreach my $module (@{$config{'authentication'}{'users'}}) {
 			$module =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($module =~ /^#/);
-	 		$module = "userdb/$module";
+			# Skip comments
+			next if ($module =~ /^#/);
+			$module = "userdb/$module";
 			push(@{$cfg->{'module_list'}},$module);
 		}
 	} else {
@@ -258,9 +329,9 @@ sub configure {
 	if (ref($config{'accounting'}{'modules'}) eq "ARRAY") {
 		foreach my $module (@{$config{'accounting'}{'modules'}}) {
 			$module =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($module =~ /^#/);
-	 		$module = "accounting/$module";
+			# Skip comments
+			next if ($module =~ /^#/);
+			$module = "accounting/$module";
 			push(@{$cfg->{'module_list'}},$module);
 		}
 	} else {
@@ -280,8 +351,8 @@ sub configure {
 	if (ref($config{'dictionary'}->{'load'}) eq "ARRAY") {
 		foreach my $dict (@{$config{'dictionary'}->{'load'}}) {
 			$dict =~ s/\s+//g;
-	 		# Skip comments
-	 		next if ($dict =~ /^#/);
+			# Skip comments
+			next if ($dict =~ /^#/);
 			push(@{$cfg->{'dictionary_list'}},$dict);
 		}
 	} else {
@@ -293,10 +364,18 @@ sub configure {
 		}
 	}
 
+	# Check if the user specified a cache_file in the config
+	if (defined($config{'server'}{'cache_file'})) {
+		$cfg->{'cache_file'} = $config{'server'}{'cache_file'};
+	}
+
+
 	# Save our config and stuff
 	$self->{'config'} = $cfg;
 	$self->{'cmdline'} = $cmdline;
 	$self->{'inifile'} = \%config;
+
+	return;
 }
 
 
@@ -307,26 +386,28 @@ sub post_configure_hook {
 	my $config = $self->{'config'};
 
 
+	$self->log(LOG_NOTICE,"[SMRADIUS] SMRadius - v$VERSION");
+
 	# Init config
-	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing configuration...");
+	$self->log(LOG_INFO,"[SMRADIUS] Initializing configuration...");
 	smradius::config::Init($self);
-	$self->log(LOG_NOTICE,"[SMRADIUS] Configuration initialized.");
+	$self->log(LOG_INFO,"[SMRADIUS] Configuration initialized.");
 
 	# Load dictionaries
-	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing dictionaries...");
-	my $dict = new Radius::Dictionary;
+	$self->log(LOG_INFO,"[SMRADIUS] Initializing dictionaries...");
+	my $dict = smradius::Radius::Dictionary->new();
 	foreach my $df (@{$config->{'dictionary_list'}}) {
 		# Load dictionary
 		if (!$dict->readfile($df)) {
 			$self->log(LOG_WARN,"[SMRADIUS] Failed to load dictionary '$df': $!");
 		}
-		$self->log(LOG_DEBUG,"[SMRADIUS] Loaded module '$df'.");
+		$self->log(LOG_DEBUG,"[SMRADIUS] Loaded dictionary '$df'.");
 	}
-	$self->log(LOG_NOTICE,"[SMRADIUS] Dictionaries initialized.");
+	$self->log(LOG_INFO,"[SMRADIUS] Dictionaries initialized.");
 	# Store the dictionary
 	$self->{'radius'}->{'dictionary'} = $dict;
 
-	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing modules...");
+	$self->log(LOG_INFO,"[SMRADIUS] Initializing modules...");
 	# Load modules
 	foreach my $module (@{$config->{'module_list'}}) {
 		# Split off dir and mod name
@@ -334,23 +415,31 @@ sub post_configure_hook {
 		my ($mod_dir,$mod_name) = ($1,$2);
 
 		# Load module
-		my $res = eval("
+		## no critic (BuiltinFunctions::ProhibitStringyEval)
+		my $res = eval qq{
 			use smradius::modules::${mod_dir}::${mod_name};
 			plugin_register(\$self,\"${mod_name}\",\$smradius::modules::${mod_dir}::${mod_name}::pluginInfo);
-		");
+		};
+		## use critic
 		if ($@ || (defined($res) && $res != 0)) {
 			$self->log(LOG_WARN,"[SMRADIUS] Error loading module $module ($@)");
 		} else {
 			$self->log(LOG_DEBUG,"[SMRADIUS] Plugin '$module' loaded.");
 		}
 	}
-	$self->log(LOG_NOTICE,"[SMRADIUS] Plugins initialized.");
+	$self->log(LOG_INFO,"[SMRADIUS] Plugins initialized.");
 
-	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing system modules.");
+	$self->log(LOG_INFO,"[SMRADIUS] Initializing system modules.");
 	# Init caching engine
-#	awitpt::cache::Init($self);
-	$self->log(LOG_NOTICE,"[SMRADIUS] System modules initialized.");
+	AWITPT::Cache::Init($self,{
+		'cache_file' => $self->{'config'}{'cache_file'},
+		'cache_file_user' => $self->{'server'}->{'user'},
+		'cache_file_group' => $self->{'server'}->{'group'}
+	});
+
+	$self->log(LOG_INFO,"[SMRADIUS] System modules initialized.");
 
+	return;
 }
 
 
@@ -379,6 +468,7 @@ sub plugin_register {
 }
 
 
+
 # Initialize child
 sub child_init_hook
 {
@@ -388,8 +478,8 @@ sub child_init_hook
 
 	$self->SUPER::child_init_hook();
 
-	$self->log(LOG_DEBUG,"[SMRADIUS] Starting up caching engine");
-	awitpt::cache::connect($self);
+	$self->log(LOG_INFO,"[SMRADIUS] Starting up caching engine");
+	AWITPT::Cache::connect($self);
 
 	# Do we need database support?
 	if ($self->{'smradius'}->{'database'}->{'enabled'}) {
@@ -398,21 +488,22 @@ sub child_init_hook
 		$self->{'client'}->{'dbh_status'} = time();
 
 		# Init core database support
-		$self->{'client'}->{'dbh'} = awitpt::db::dbilayer::Init($self,'smradius');
+		$self->{'client'}->{'dbh'} = AWITPT::DB::DBILayer::Init($self,'smradius');
 		if (defined($self->{'client'}->{'dbh'})) {
 			# Check if we succeeded
 			if (!($self->{'client'}->{'dbh'}->connect())) {
 			# If we succeeded, record OK
 				$self->{'client'}->{'dbh_status'} = 0;
 			} else {
-				$self->log(LOG_WARN,"[SMRADIUS] Failed to connect to database: ".$self->{'client'}->{'dbh'}->Error().
+				$self->log(LOG_WARN,"[SMRADIUS] Failed to connect to database: ".$self->{'client'}->{'dbh'}->error().
 						" ($$)");
 			}
 		} else {
-			$self->log(LOG_WARN,"[SMRADIUS] Failed to Initialize: ".awitpt::db::dbilayer::internalError()." ($$)");
+			$self->log(LOG_WARN,"[SMRADIUS] Failed to Initialize: ".AWITPT::DB::DBILayer::internalError()." ($$)");
 		}
 	}
 
+	return;
 }
 
 
@@ -424,11 +515,14 @@ sub child_finish_hook {
 
 	$self->SUPER::child_finish_hook();
 
-	$self->log(LOG_DEBUG,"[SMRADIUS] Shutting down caching engine ($$)");
-	awitpt::cache::disconnect($self);
+	$self->log(LOG_INFO,"[SMRADIUS] Shutting down caching engine ($$)");
+	AWITPT::Cache::disconnect($self);
+
+	return;
 }
 
 
+
 # Process requests we get
 sub process_request {
 	my $self = shift;
@@ -438,17 +532,20 @@ sub process_request {
 
 
 	# Grab packet
-	my $udp_packet = $server->{'udp_data'};
+	my $rawPacket = $server->{'udp_data'};
 
 	# Check min size
-	if (length($udp_packet) < 18)
+	if (length($rawPacket) < 18)
 	{
 		$self->log(LOG_WARN, "[SMRADIUS] Packet too short - Ignoring");
 		return;
 	}
 
-	# Parse packet
-	my $pkt = new Radius::Packet($self->{'radius'}->{'dictionary'},$udp_packet);
+	# Very first timer ...
+	my $timer0 = [gettimeofday];
+
+	# Grab NOW()
+	my $now = time();
 
 	# VERIFY SOURCE SERVER
 	$self->log(LOG_DEBUG,"[SMRADIUS] Packet From = > ".$server->{'peeraddr'});
@@ -476,50 +573,104 @@ sub process_request {
 			$timeout = 120;
 		}
 		# Get time left
-		my $timepassed = time() - $self->{'client'}->{'dbh_status'};
+		my $timepassed = $now - $self->{'client'}->{'dbh_status'};
 		# Then check...
 		if ($timepassed >= $timeout) {
-			$self->log(LOG_NOTICE,"[SMRADIUS] Client BYPASS timeout exceeded, reconnecting...");
+			$self->log(LOG_WARN,"[SMRADIUS] Client BYPASS timeout exceeded, reconnecting...");
 			exit 0;
 		} else {
-			$self->log(LOG_NOTICE,"[SMRADIUS] Client still in BYPASS mode, ".( $timeout - $timepassed ).
+			$self->log(LOG_WARN,"[SMRADIUS] Client still in BYPASS mode, ".( $timeout - $timepassed ).
 					"s left till next reconnect");
 			return;
 		}
 	}
 
 	# Setup database handle
-	awitpt::db::dblayer::setHandle($self->{'client'}->{'dbh'});
+	AWITPT::DB::DBLayer::setHandle($self->{'client'}->{'dbh'});
+
+
+	my $request = smradius::daemon::request->new($self);
+	if (!$request->setTimezone($self->{'smradius'}->{'event_timezone'})) {
+		$self->log(LOG_ERR,"[SMRADIUS] Setting event_timezone to '%s' failed",$self->{'smradius'}->{'event_timezone'});
+		return;
+	}
+
+	$request->parsePacket($self->{'radius'}->{'dictionary'},$rawPacket);
+
+	# Check if we need to override the packet timestamp, if we are not using the packet timestamp, set it to when we go the packet
+	if (!booleanize($self->{'smradius'}->{'use_packet_timestamp'})) {
+		$request->setTimestamp($now);
+	}
 
-	# Main user hash with everything in
-	my $user;
-	$user->{'ConfigAttributes'} = {};
-	$user->{'ReplyAttributes'} = {};
-	$user->{'ReplyVAttributes'} = {};
+	# Username should always be defined?
+	if (!$request->hasUsername()) {
+		$self->log(LOG_NOTICE,"[SMRADIUS] Packet with no username from ".$server->{'peeraddr'});
+		return;
+	}
 
-	# Private data
-	$user->{'_Internal'} = {
-		'Timestamp-Unix' => defined($pkt->rawattr('Event-Timestamp')) ? $pkt->rawattr('Event-Timestamp') : time()
-	};
-	my $eventTimestamp = DateTime->from_epoch( epoch => $user->{'_Internal'}->{'Timestamp-Unix'} );
-	$user->{'_Internal'}->{'Timestamp'} = $eventTimestamp->strftime('%Y-%m-%d %H:%M:%S');
 
+	# TODO/FIXME: WIP
+	my $pkt = $request->{'packet'};
+	my $user = $request->{'user'};
+	my $logReason = "UNKNOWN";
+
+
+	# First thing we do is to make sure the NAS behaves if we using abuse prevention
+	if ($self->{'smradius'}->{'use_abuse_prevention'} && defined($user->{'Username'})) {
+		my ($res,$val) = cacheGetKeyPair('FloodCheck',$server->{'peeraddr'}."/".$user->{'Username'}."/".$pkt->code);
+		if (defined($val)) {
+			my $timePeriod = $now - $val;
+			# Check if we're still within the abuse threshold
+			if ($pkt->code eq "Access-Request" && $timePeriod < $self->{'smradius'}->{'access_request_abuse_threshold'}) {
+				$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: NAS trying too fast. NAS = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
+						", code = ".$pkt->code.", timeout = ".($now - $val));
+				# Tell the NAS we got its packet
+				my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
+				$resp->set_code('Access-Reject');
+				$resp->set_identifier($pkt->identifier);
+				$resp->set_authenticator($pkt->authenticator);
+				$server->{'client'}->send(
+					auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
+				);
+				return;
+
+			} elsif ($pkt->code eq "Accounting-Request" && $timePeriod < $self->{'smradius'}->{'accounting_request_abuse_threshold'}) {
+				$self->log(LOG_NOTICE,"[SMRADIUS] ABUSE: NAS trying too fast. NAS = ".$server->{'peeraddr'}.", user = ".$user->{'Username'}.
+						", code = ".$pkt->code.", timeout = ".($now - $val));
+				# Tell the NAS we got its packet
+				my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
+				$resp->set_code('Accounting-Response');
+				$resp->set_identifier($pkt->identifier);
+				$resp->set_authenticator($pkt->authenticator);
+				$server->{'client'}->send(
+					auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
+				);
+				return;
+
+			}
+		}
+		# We give the benefit of the doubt and let a query take 60s. We update to right stamp at end of this function
+		cacheStoreKeyPair('FloodCheck',$server->{'peeraddr'}."/".$user->{'Username'}."/".$pkt->code,$now + 60);
+	}
 
 	#
 	# GRAB & PROCESS CONFIG
 	#
 
+	my $configured = 1;
+
 	foreach my $module (@{$self->{'module_list'}}) {
 		# Try find config attribute
 		if ($module->{'Config_get'}) {
 
 			# Get result from config module
-			$self->log(LOG_INFO,"[SMRADIUS] CONFIG: Trying plugin '".$module->{'Name'}."' for incoming connection");
+			$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Trying plugin '".$module->{'Name'}."' for incoming connection");
 			my $res = $module->{'Config_get'}($self,$user,$pkt);
 
 			# Check result
 			if (!defined($res)) {
-				$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Error with plugin '".$module->{'Name'}."'");
+				$self->log(LOG_WARN,"[SMRADIUS] CONFIG: Error with plugin '".$module->{'Name'}."'");
+				$logReason = "Config Error";
 
 			# Check if we skipping this plugin
 			} elsif ($res == MOD_RES_SKIP) {
@@ -527,45 +678,79 @@ sub process_request {
 
 			# Check if we got a positive result back
 			} elsif ($res == MOD_RES_ACK) {
-				$self->log(LOG_NOTICE,"[SMRADIUS] CONFIG: Configuration retrieved from '".$module->{'Name'}."'");
+				$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Configuration retrieved from '".$module->{'Name'}."'");
+				$logReason = "Config Retrieved";
 
 			# Check if we got a negative result back
 			} elsif ($res == MOD_RES_NACK) {
-				$self->log(LOG_NOTICE,"[SMRADIUS] CONFIG: Configuration problem when using '".$module->{'Name'}."'");
+				$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Configuration rejection when using '".$module->{'Name'}."'");
+				$logReason = "Config Rejected";
+
+				# FIXME/TODO NK WIP
+				return;
+#				$configured = 0;
+#				last;
 			}
 		}
 	}
 
-	# FIXME - need secret
-	# FIXME - need acl list
 
 	#
-	# START PROCESSING
+	# USERNAME TRANSFORM
+	#
+
+	# If we have a config attribute to transform username, use it
+	if (defined($user->{'ConfigAttributes'}->{'SMRadius-Username-Transform'})) {
+
+		$self->log(LOG_DEBUG,"[SMRADIUS] Attribute 'SMRadius-Username-Transform' exists, transforming username.");
+
+# NK: Not ready for prime time yet
+#		# Get clients(NAS) username transform pattern
+#		my $transform = shift(@{$user->{'ConfigAttributes'}->{'SMRadius-Username-Transform'}});
+#		if ($transform =~ /^(@\S+)=(@\S+)$/i) {
+#
+#			# Set old and new, prevents warnings
+#			my ($old,$new) = ($1,$2);
+#
+#			# Use client username transform on temp username
+#			my $tempUsername = $user->{'Username'};
+#			$tempUsername =~ s/$old/$new/;
+#
+#			# Override username
+#			$user->{'Username'} = $tempUsername;
+#		} else {
+#			$self->log(LOG_DEBUG,"[SMRADIUS] No string replacement possible on pattern '".
+#					$transform."', using username '".$user->{'Username'}."'");
+#		}
+	}
+
+
+	#
+	# FIND USER
 	#
 
-	# UserDB module if we using/need it
-	my $userdb;
+	# Get the user timer
+	my $timer1 = [gettimeofday];
+
+	# FIXME - need secret
+	# FIXME - need acl list
 
 	# Common stuff for multiple codes....
 	if ($pkt->code eq "Accounting-Request" || $pkt->code eq "Access-Request") {
-		# Set username
-		$user->{'Username'} = $pkt->attr('User-Name');
-
-		#
-		# FIND USER
-		#
 
 		# Loop with modules to try find user
 		foreach my $module (@{$self->{'module_list'}}) {
+
 			# Try find user
 			if ($module->{'User_find'}) {
-				$self->log(LOG_INFO,"[SMRADIUS] FIND: Trying plugin '".$module->{'Name'}."' for username '".
+				$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Trying plugin '".$module->{'Name'}."' for username '".
 						$user->{'Username'}."'");
-				my ($res,$userdb_data) = $module->{'User_find'}($self,$user,$pkt);
+				my ($res,$userDB_Data) = $module->{'User_find'}($self,$user,$pkt);
 
 				# Check result
 				if (!defined($res)) {
-					$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Error with plugin '".$module->{'Name'}."'");
+					$self->log(LOG_WARN,"[SMRADIUS] FIND: Error with plugin '".$module->{'Name'}."'");
+					$logReason = "Error Finding User";
 
 				# Check if we skipping this plugin
 				} elsif ($res == MOD_RES_SKIP) {
@@ -573,14 +758,17 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] FIND: Username found with '".$module->{'Name'}."'");
-					$userdb = $module;
-					$user->{'_UserDB_Data'} = $userdb_data;
+					$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Username found with '".$module->{'Name'}."'");
+					$user->{'_UserDB'} = $module;
+					$user->{'_UserDB_Data'} = $userDB_Data;
+					# The user ID is supposed to be global unique, on the same level as the username
+					$user->{'ID'} = $user->{'_UserDB_Data'}->{'ID'};
 					last;
 
 				# Or a negative result
 				} elsif ($res == MOD_RES_NACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] FIND: Username not found with '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Username not found with '".$module->{'Name'}."'");
+					$logReason = "User Not Found";
 					last;
 
 				}
@@ -589,23 +777,41 @@ sub process_request {
 	}
 
 
+	#
+	# PROCESS PACKET
+	#
+
+	# Process the packet timer
+	my $timer2 = [gettimeofday];
+
+
 	# Is this an accounting request
 	if ($pkt->code eq "Accounting-Request") {
 
 		$self->log(LOG_DEBUG,"[SMRADIUS] Accounting Request Packet");
 
+		# Add onto logline
+		$request->addLogLine(". REQUEST => ");
+		foreach my $attrName ($pkt->attributes) {
+			$request->addLogLine(
+				"%s: '%s'",
+				$attrName,
+				$pkt->rawattr($attrName)
+			);
+		}
+
 		#
 		# GET USER
 		#
 
 		# Get user data
-		if (defined($userdb) && defined($userdb->{'User_get'})) {
-			my $res = $userdb->{'User_get'}($self,$user,$pkt);
+		if (defined($user->{'_UserDB'}) && defined($user->{'_UserDB'}->{'User_get'})) {
+			my $res = $user->{'_UserDB'}->{'User_get'}($self,$user,$pkt);
 
 			# Check result
-			if (defined($res) && ref($res) eq "HASH") {
-				# We're only after the attributes here
-				$user->{'Attributes'} = $res;
+			if ($res) {
+				$self->log(LOG_WARN,"[SMRADIUS] GET: Error returned from '".$user->{'_UserDB'}->{'Name'}.
+						"' for username '".$user->{'Username'}."'");
 			}
 		}
 
@@ -613,12 +819,13 @@ sub process_request {
 		foreach my $module (@{$self->{'module_list'}}) {
 			# Try find user
 			if ($module->{'Accounting_log'}) {
-				$self->log(LOG_INFO,"[SMRADIUS] ACCT: Trying plugin '".$module->{'Name'}."'");
+				$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Trying plugin '".$module->{'Name'}."'");
 				my $res = $module->{'Accounting_log'}($self,$user,$pkt);
 
 				# Check result
 				if (!defined($res)) {
-					$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Error with plugin '".$module->{'Name'}."'");
+					$self->log(LOG_WARN,"[SMRADIUS] ACCT: Error with plugin '".$module->{'Name'}."'");
+					$logReason = "Accounting Log Error";
 
 				# Check if we skipping this plugin
 				} elsif ($res == MOD_RES_SKIP) {
@@ -626,36 +833,32 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] ACCT: Accounting logged using '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Accounting logged using '".$module->{'Name'}."'");
+					$logReason = "Accounting Logged";
 
 				# Check if we got a negative result back
 				} elsif ($res == MOD_RES_NACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] ACCT: Accounting NOT LOGGED using '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Accounting NOT LOGGED using '".$module->{'Name'}."'");
+					$logReason = "Accounting NOT Logged";
 				}
 			}
 		}
-		# Tell the NAS we got its packet
-		my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
-	   	$resp->set_code('Accounting-Response');
-		$resp->set_identifier($pkt->identifier);
-		$resp->set_authenticator($pkt->authenticator);
-		$udp_packet = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
-		$server->{'client'}->send($udp_packet);
 
 		# Are we going to POD the user?
 		my $PODUser = 0;
 
-		# Loop with modules that have post-authentication hooks
+		# Loop with modules that have post-accounting hooks
 		foreach my $module (@{$self->{'module_list'}}) {
 			# Try authenticate
 			if ($module->{'Feature_Post-Accounting_hook'}) {
-				$self->log(LOG_INFO,"[SMRADIUS] POST-ACCT: Trying plugin '".$module->{'Name'}."' for '".
+				$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying plugin '".$module->{'Name'}."' for '".
 						$user->{'Username'}."'");
 				my $res = $module->{'Feature_Post-Accounting_hook'}($self,$user,$pkt);
 
 				# Check result
 				if (!defined($res)) {
-					$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Error with plugin '".$module->{'Name'}."'");
+					$self->log(LOG_WARN,"[SMRADIUS] POST-ACCT: Error with plugin '".$module->{'Name'}."'");
+					$logReason = "Post Accounting Error";
 
 				# Check if we skipping this plugin
 				} elsif ($res == MOD_RES_SKIP) {
@@ -663,61 +866,182 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: Passed post accounting hook by '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Passed post accounting hook by '".$module->{'Name'}."'");
+					$logReason = "Post Accounting Success";
 
 				# Or a negative result
 				} elsif ($res == MOD_RES_NACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: Failed post accounting hook by '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Failed post accounting hook by '".$module->{'Name'}."'");
+					$logReason = "Failed Post Accounting";
 					$PODUser = 1;
 				}
 			}
 		}
 
-		# Check if we must POD the user
-		if ($PODUser) {
-			$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying to disconnect user...");
+		# Tell the NAS we got its packet
+		my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
+		$resp->set_code('Accounting-Response');
+		$resp->set_identifier($pkt->identifier);
+		$resp->set_authenticator($pkt->authenticator);
+		$server->{'client'}->send(
+			auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
+		);
+
+		# CoA and POD only apply to accounting updates...
+		if ($pkt->rawattr('Acct-Status-Type') eq "3") {
+
+			# Build a list of our attributes in the packet
+			my $acctAttributes;
+			foreach my $attr ($pkt->attributes) {
+				$acctAttributes->{$attr} = $pkt->rawattr($attr);
+			}
+			# Loop with attributes we got from the user
+			foreach my $attrName (keys %{$user->{'Attributes'}}) {
+				# Loop with operators
+				foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
+					# Grab attribute
+					my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
+					# Check attribute against accounting attributes
+					my $res = checkAcctAttribute($self,$user,$acctAttributes,$attr);
+					# We don't care if it fails
+				}
+			}
+
+			# 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);
+			}
+
+			# 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'));
+
+			# 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'});
+			}
 
-			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
+			# 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]+))?/);
 
-		 	$resp->set_code('Disconnect-Request');
-			my $id = $$ & 0xff;
-			$resp->set_identifier( $id );
+				if (!defined($coaServerIP)) {
+					$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: CoAServer '$coaServer' looks incorrect");
+					next;
+				}
 
-			$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'));
+				# Set default CoA server port
+				$coaServerPort //= 1700;
 
-			$udp_packet = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
+				$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '".$coaServer."' Port: '".$coaServerPort."'");
 
-			# Create socket to send packet out on
-			my $podServer = "10.254.254.239";
-			my $podServerPort = "1700";
-			my $podServerTimeout = "10";  # 10 second timeout
-			my $podSock = new IO::Socket::INET(
-					PeerAddr => $podServer,
-					PeerPort => $podServerPort,
+				# 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 => $podServerTimeout,
-			) or return $self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send POD on: $!");
+					TimeOut => $coaServerTimeout,
+				);
 
-			# Check if we sent the packet...
-			if (!$podSock->send($udp_packet)) {
-				return $self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on socket: $!");
-			}
+				if (!$coaSock) {
+					$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send CoA on: $!");
+					next;
+				}
 
-			# Once sent, we need to get a response back
-			my $sh = new IO::Select($podSock) 
-					or return $self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket: $!");
+				# 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': $!");
+					$request->addLogLine(". No response to CoA/POD");
+					next;
+				}
 
-			$sh->can_read($podServerTimeout) 
-					or return $self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket: $!");
+				# Parse the radius packet
+				my $coaRes = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'},$coaRes_packet);
 
-			my $data;
-			$podSock->recv($data, 65536) 
-					or return $self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Receive data failed: $!");
-#			my @stuff = unpack('C C n a16 a*', $data);
-#			$self->log(LOG_DEBUG,"STUFF: ".Dumper(\@stuff));
+				# Check status
+				if ($coaRes->code eq "CoA-ACK") {
+					$request->addLogLine(". CoA Success");
+					last;
+				} elsif ($coaRes->code eq "CoA-NACK") {
+					$request->addLogLine(". CoA Fail");
+				} elsif ($coaRes->code eq "Disconnect-ACK") {
+					$request->addLogLine(". POD Success");
+					last;
+				} elsif ($coaRes->code eq "Disconnect-NACK") {
+					$request->addLogLine(". POD Fail");
+				} else {
+					$request->addLogLine(". Invalid CoA/POD response");
+				}
+			}
 		}
 
 	# Or maybe a access request
@@ -734,8 +1058,8 @@ sub process_request {
 
 
 		# If no user is found, bork out ...
-		if (!defined($userdb)) {
-			$self->log(LOG_INFO,"[SMRADIUS] FIND: No plugin found for username '".$user->{'Username'}."'");
+		if (!defined($user->{'_UserDB'})) {
+			$self->log(LOG_DEBUG,"[SMRADIUS] FIND: No plugin found for username '".$user->{'Username'}."'");
 			goto CHECK_RESULT;
 		}
 
@@ -744,19 +1068,17 @@ sub process_request {
 		#
 
 		# Get user data
-		if ($userdb->{'User_get'}) {
-			my $res = $userdb->{'User_get'}($self,$user,$pkt);
+		if ($user->{'_UserDB'}->{'User_get'}) {
+			my $res = $user->{'_UserDB'}->{'User_get'}($self,$user,$pkt);
 
 			# Check result
-			if (!defined($res) || ref($res) ne "HASH") {
-				$self->log(LOG_WARN,"[SMRADIUS] GET: No data returned from '".$userdb->{'Name'}.
+			if ($res) {
+				$self->log(LOG_WARN,"[SMRADIUS] GET: Error returned from '".$user->{'_UserDB'}->{'Name'}.
 						"' for username '".$user->{'Username'}."'");
 				goto CHECK_RESULT;
 			}
-			# Setup user dataw
-			$user->{'Attributes'} = $res;
 		} else {
-			$self->log(LOG_INFO,"[SMRADIUS] GET: No 'User_get' function available for module '".$userdb->{'Name'}."'");
+			$self->log(LOG_ERR,"[SMRADIUS] GET: No 'User_get' function available for module '".$user->{'_UserDB'}->{'Name'}."'");
 
 			goto CHECK_RESULT;
 		}
@@ -769,12 +1091,12 @@ sub process_request {
 		foreach my $module (@{$self->{'module_list'}}) {
 			# Try authenticate
 			if ($module->{'Authentication_try'}) {
-				$self->log(LOG_INFO,"[SMRADIUS] AUTH: Trying plugin '".$module->{'Name'}."' for '".$user->{'Username'}."'");
+				$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Trying plugin '".$module->{'Name'}."' for '".$user->{'Username'}."'");
 				my $res = $module->{'Authentication_try'}($self,$user,$pkt);
 
 				# Check result
 				if (!defined($res)) {
-					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Error with plugin '".$module->{'Name'}."'");
+					$self->log(LOG_ERR,"[SMRADIUS] AUTH: Error with plugin '".$module->{'Name'}."'");
 
 				# Check if we skipping this plugin
 				} elsif ($res == MOD_RES_SKIP) {
@@ -782,14 +1104,16 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
+					$logReason = "User Authenticated";
 					$mechanism = $module;
 					$authenticated = 1;
 					last;
 
 				# Or a negative result
 				} elsif ($res == MOD_RES_NACK) {
-					$self->log(LOG_NOTICE,"[SMRADIUS] AUTH: Failed authentication by '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Failed authentication by '".$module->{'Name'}."'");
+					$logReason = "User NOT Authenticated";
 					$mechanism = $module;
 					last;
 
@@ -802,14 +1126,14 @@ sub process_request {
 			foreach my $module (@{$self->{'module_list'}}) {
 				# Try authenticate
 				if ($module->{'Feature_Post-Authentication_hook'}) {
-					$self->log(LOG_INFO,"[SMRADIUS] POST-AUTH: Trying plugin '".$module->{'Name'}.
+					$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Trying plugin '".$module->{'Name'}.
 							"' for '".$user->{'Username'}."'");
 
 					my $res = $module->{'Feature_Post-Authentication_hook'}($self,$user,$pkt);
 
 					# Check result
 					if (!defined($res)) {
-						$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Error with plugin '".$module->{'Name'}."'");
+						$self->log(LOG_ERR,"[SMRADIUS] POST-AUTH: Error with plugin '".$module->{'Name'}."'");
 
 					# Check if we skipping this plugin
 					} elsif ($res == MOD_RES_SKIP) {
@@ -817,11 +1141,13 @@ sub process_request {
 
 					# Check if we got a positive result back
 					} elsif ($res == MOD_RES_ACK) {
-						$self->log(LOG_NOTICE,"[SMRADIUS] POST-AUTH: Passed authenticated by '".$module->{'Name'}."'");
+						$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Passed authenticated by '".$module->{'Name'}."'");
+						$logReason = "Post Authentication Success";
 
 					# Or a negative result
 					} elsif ($res == MOD_RES_NACK) {
-						$self->log(LOG_NOTICE,"[SMRADIUS] POST-AUTH: Failed authentication by '".$module->{'Name'}."'");
+						$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Failed authentication by '".$module->{'Name'}."'");
+						$logReason = "Post Authentication Failure";
 						$authenticated = 0;
 						# Do we want to run the other modules ??
 						last;
@@ -839,6 +1165,8 @@ sub process_request {
 		foreach my $attr ($pkt->attributes) {
 			$authAttributes->{$attr} = $pkt->rawattr($attr);
 		}
+		# Peer address
+		$authAttributes->{'SMRadius-Peer-Address'} = $server->{'peeraddr'};
 		# Loop with attributes we got from the user
 		foreach my $attrName (keys %{$user->{'Attributes'}}) {
 			# Loop with operators
@@ -846,7 +1174,7 @@ sub process_request {
 				# Grab attribute
 				my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
 				# Check attribute against authorization attributes
-				my $res = checkAuthAttribute($self,$authAttributes,$attr);
+				my $res = checkAuthAttribute($self,$user,$authAttributes,$attr);
 				if ($res == 0) {
 					$authorized = 0;
 					last;
@@ -859,46 +1187,19 @@ sub process_request {
 		# Check if we authenticated or not
 		if ($authenticated && $authorized) {
 			$self->log(LOG_DEBUG,"[SMRADIUS] Authenticated and authorized");
+			$logReason = "User Authorized";
 
-			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
-		 	$resp->set_code('Access-Accept');
+			my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
+			$resp->set_code('Access-Accept');
 			$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
-			foreach my $attrName (keys %replyAttributes) {
-				# Loop with values
-				foreach my $value (@{$replyAttributes{$attrName}}) {
-					# Add each value
-					$resp->set_attr($attrName,$value);
-				}
-			}
-
-			# Loop with vendor reply attributes
-			my %replyVAttributes = %{ $user->{'ReplyVAttributes'} };
-			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);
-					}
-				}
-			}
+			# Process the reply attributes
+			$self->_processReplyAttributes($request,$user,$resp);
 
-			$udp_packet = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
-			$server->{'client'}->send($udp_packet);
+			$server->{'client'}->send(
+				auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
+			);
 
 		}
 
@@ -906,13 +1207,15 @@ CHECK_RESULT:
 		# Check if found and authenticated
 		if (!$authenticated || !$authorized) {
 			$self->log(LOG_DEBUG,"[SMRADIUS] Authentication or authorization failure");
+			$logReason = "User NOT Authenticated or Authorized";
 
-			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
-		 	$resp->set_code('Access-Reject');
+			my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
+			$resp->set_code('Access-Reject');
 			$resp->set_identifier($pkt->identifier);
 			$resp->set_authenticator($pkt->authenticator);
-			$udp_packet = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
-			$server->{'client'}->send($udp_packet);
+			$server->{'client'}->send(
+				auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
+			);
 		}
 
 	# We don't know how to handle this
@@ -920,10 +1223,36 @@ CHECK_RESULT:
 		$self->log(LOG_WARN,"[SMRADIUS] We cannot handle code: '".$pkt->code."'");
 	}
 
+	# END
+	my $timer9 = [gettimeofday];
+	my $timediff1 = tv_interval($timer0,$timer1);
+	my $timediff2 = tv_interval($timer1,$timer2);
+	my $timediff3 = tv_interval($timer2,$timer9);
+	my $timediff = tv_interval($timer0,$timer9);
+
+	# FIXME/TODO NK WIP
+	my $logLine = join(' ',@{$request->{'logLine'}});
+	my @logLineArgs = @{$request->{'logLineParams'}};
+
+
+	# How should we output this ...
+	if ($server->{'log_level'} > LOG_NOTICE) {
+		$self->log(LOG_NOTICE,"[SMRADIUS] Result: $logReason (%.3fs + %.3fs + %.3fs = %.3fs) => $logLine",
+				$timediff1,$timediff2,$timediff3,$timediff,@logLineArgs);
+	} else {
+		$self->log(LOG_NOTICE,"[SMRADIUS] Result: $logReason => $logLine",@logLineArgs);
+	}
+
+	# If we using abuse prevention record the time we ending off
+	if ($self->{'smradius'}->{'use_abuse_prevention'} && defined($user->{'Username'})) {
+		cacheStoreKeyPair('FloodCheck',$server->{'peeraddr'}."/".$user->{'Username'}."/".$pkt->code,time());
+	}
+
 	return;
 }
 
 
+
 # Initialize child
 sub server_exit
 {
@@ -932,20 +1261,23 @@ sub server_exit
 
 	$self->log(LOG_DEBUG,"Destroying system modules.");
 	# Destroy cache
-#	cbp::cache::Destroy($self);
+	AWITPT::Cache::Destroy($self);
 	$self->log(LOG_DEBUG,"System modules destroyed.");
 
 	# Parent exit
 	$self->SUPER::server_exit();
+
+	return;
 }
 
 
 
 # Slightly better logging
-sub log
+sub log ## no critic (Subroutines::ProhibitBuiltinHomonyms)
 {
 	my ($self,$level,$msg,@args) = @_;
 
+
 	# Check log level and set text
 	my $logtxt = "UNKNOWN";
 	if ($level == LOG_DEBUG) {
@@ -967,14 +1299,19 @@ sub log
 		$msg = "[CORE] $logtxt: $msg";
 	}
 
-	$self->SUPER::log($level,"[".$self->log_time." - $$] $msg",@args);
+	# If we have args, this is more than likely a format string & args
+	if (@args > 0) {
+		$msg = sprintf($msg,@args);
+	}
+
+	return $self->SUPER::log($level,"[".$self->log_time." - $$] $msg");
 }
 
 
 
 # Display help
 sub displayHelp {
-	print(STDERR "SMRadius v".VERSION." - Copyright (c) 2007-2009, AllWorldIT\n");
+	print(STDERR "SMRadius v$VERSION - Copyright (c) 2007-2016, AllWorldIT\n");
 
 	print(STDERR<<EOF);
 
@@ -984,13 +1321,133 @@ Usage: $0 [args]
     --fg                   Don't go into background
 
 EOF
+
+	return;
 }
 
 
 
+#
+# Internal functions
+#
+
+
+# Process reply attributes
+sub _processReplyAttributes
+{
+	my ($self,$request,$user,$pkt) = @_;
+
+	# Add attributes we got from plugins and process attributes attached to the user
+	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);
+		}
+	}
+	# Add vendor attributes we got from plugins and process attributes attached to the user
+	my %replyVAttributes = %{ $user->{'ReplyVAttributes'} };
+	foreach my $attrName (keys %{$user->{'VAttributes'}}) {
+		# Loop with operators
+		foreach my $attrOp (keys %{$user->{'VAttributes'}->{$attrName}}) {
+			# Grab attribute
+			my $attr = $user->{'VAttributes'}->{$attrName}->{$attrOp};
+			# Add this to the reply attribute?
+			setReplyVAttribute($self,\%replyVAttributes,$attr);
+		}
+	}
+
+	# Loop with reply attributes add them to our response, or output them to log if they were excluded
+	$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
+				$pkt->set_attr($attrName,$value);
+			} else {
+				$request->addLogLine("%s ",$attrName);
+			}
+		}
+	}
+
+	# Loop with reply vendor attributes add them to our response, or output them to log if they were excluded
+	$request->addLogLine(". RVFILTER => ");
+	# Process reply vattributes already added
+	foreach my $vendor (keys %replyVAttributes) {
+		# Loop with operators
+		foreach my $attrName (keys %{$replyVAttributes{$vendor}}) {
+			# Add each value
+			foreach my $value (@{$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
+					$pkt->set_vsattr($vendor,$attrName,$value);
+				} else {
+					$request->addLogLine("%s ",$attrName);
+				}
+			}
+		}
+	}
+
+	# Add attributes onto logline
+	$request->addLogLine(". REPLY => ");
+	foreach my $attrName ($pkt->attributes) {
+		$request->addLogLine(
+			"%s: '%s",
+			$attrName,
+			$pkt->rawattr($attrName)
+		);
+	}
+	# Add vattributes onto logline
+	$request->addLogLine(". VREPLY => ");
+	# Loop with vendors
+	foreach my $vendor ($pkt->vendors()) {
+		# Loop with attributes
+		foreach my $attrName ($pkt->vsattributes($vendor)) {
+			# Grab the value
+			my @attrRawVal = ( $pkt->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
+			);
+		}
+	}
+
+	return $self;
+};
 
-__PACKAGE__->run;
 
 
 1;
 # vim: ts=4
+

lib/smradius/daemon/request.pm

+# Radius daemon request processing
+# Copyright (C) 2007-2016, 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+
+
+package smradius::daemon::request;
+
+use strict;
+use warnings;
+
+use base qw{AWITPT::Object};
+
+
+use DateTime;
+use DateTime::TimeZone;
+use Try::Tiny;
+
+use smradius::Radius::Packet;
+
+
+
+# Parse radius packet
+sub parsePacket
+{
+	my ($self,$dictionary,$rawPacket) = @_;
+
+
+	# Parse the radius packet
+	$self->{'packet'} = smradius::Radius::Packet->new($dictionary,$rawPacket);
+
+	# Loop with packet attribute names and add to our log line
+	$self->addLogLine("PACKET => ");
+	foreach my $attrName (sort $self->{'packet'}->attributes()) {
+		# Make the value a bit more pretty to print
+		my $attrVal;
+		if ($attrName eq "User-Password") {
+			$attrVal = "-encrypted-";
+		} else {
+			$attrVal = $self->{'packet'}->rawattr($attrName);
+		}
+		# Add it onto the log line...
+		$self->addLogLine(
+			"%s: '%s'",
+			$attrName,
+			$attrVal,
+		);
+	}
+
+	# Set the username
+	$self->{'user'}->{'Username'} = $self->{'packet'}->attr('User-Name');
+
+	# Set the packet timestamp in unix time
+	if (my $timestamp = $self->{'packet'}->rawattr('Event-Timestamp')) {
+		$self->setTimestamp($timestamp);
+	} else {
+		$self->setTimestamp(time());
+	}
+
+	return $self;
+}
+
+
+
+# Set internal timestamp
+sub setTimestamp
+{
+	my ($self,$timestamp) = @_;
+
+
+	# Set timestamp
+	$self->{'user'}->{'_Internal'}->{'Timestamp-Unix'} = $timestamp;
+
+	# Grab real event timestamp in local time uzing the time zone
+	my $eventTimestamp = DateTime->from_epoch(
+			epoch => $self->{'user'}->{'_Internal'}->{'Timestamp-Unix'},
+			time_zone => $self->{'timezone'},
+	);
+	# Set the timestamp (not in unix)
+	$self->{'user'}->{'_Internal'}->{'Timestamp'} = $eventTimestamp->strftime('%Y-%m-%d %H:%M:%S');
+
+	return $self;
+}
+
+
+
+# Set internal time zone
+sub setTimezone
+{
+	my ($self,$timezone) = @_;
+
+
+	my $timezone_obj;
+	try {
+		$timezone_obj = DateTime::TimeZone->new('name' => $timezone);
+	};
+
+	# Retrun if we don't have a value, this means we failed
+	return if (!defined($timezone_obj));
+
+	$self->{'timezone'} = $timezone_obj;
+
+	return $self;
+}
+
+
+
+# Add something onto the log line in printf() style...
+sub addLogLine
+{
+	my ($self,$template,@params) = @_;
+
+
+	# Add on template and params
+	push(@{$self->{'logLine'}},$template);
+	push(@{$self->{'logLineParams'}},@params);
+
+	return $self;
+}
+
+
+
+# Return if the Username attribute of the user is defined
+sub hasUsername
+{
+	my $self = shift;
+
+
+	return defined($self->{'user'}->{'Username'});
+}
+
+
+
+#
+# INTERNAL METHODS
+#
+
+
+# This method is called from the new-> method during instantiation
+sub _init
+{
+	my ($self) = @_;
+
+
+	# Initialize log line
+	$self->{'logLine'} = [ ];
+	$self->{'logLineParams'} = [ ];
+
+	$self->{'timezone'} = "UTC";
+
+	# Initialize user
+	$self->{'user'} = {
+		'Username' => undef,
+
+		'ConfigAttributes' => { },
+		'Attributes' => { },
+		'VAttributes' => { },
+		'ReplyAttributes' => { },
+		'ReplyVAttributes' => { },
+		'AttributeConditionalVariables' => { },
+	};
+
+	return $self;
+}
+
+
+
+1;
+# vim: ts=4

smradius/logging.pm → lib/smradius/logging.pm

 # Logging constants
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2015, 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

lib/smradius/modules/accounting/mod_accounting_sql.pm

+# SQL accounting database
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package smradius::modules::accounting::mod_accounting_sql;
+
+use strict;
+use warnings;
+
+# Modules we need
+use smradius::constants;
+use AWITPT::Cache;
+use AWITPT::DB::DBLayer;
+use AWITPT::Util;
+use smradius::logging;
+use smradius::util;
+
+use POSIX qw(ceil);
+use DateTime;
+use Math::BigInt;
+use Math::BigFloat;
+
+
+# Exporter stuff
+use base qw(Exporter);
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
+);
+
+
+
+# Plugin info
+our $pluginInfo = {
+	Name => "SQL Accounting Database",
+	Init => \&init,
+
+	# Cleanup run by smadmin
+	CleanupOrder => 30,
+	Cleanup => \&cleanup,
+
+	# Accounting database
+	Accounting_log => \&acct_log,
+	Accounting_getUsage => \&getUsage
+};
+
+
+# Module config
+my $config;
+
+
+## @internal
+# Initialize module
+sub init
+{
+	my $server = shift;
+	my $scfg = $server->{'inifile'};
+
+
+	# Enable support for database
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Enabling database support");
+	if (!$server->{'smradius'}->{'database'}->{'enabled'}) {
+		$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Enabling database support.");
+		$server->{'smradius'}->{'database'}->{'enabled'} = 1;
+	}
+
+	# Default configs...
+	$config->{'accounting_start_query'} = '
+		INSERT INTO
+			@TP@accounting
+		(
+			Username,
+			ServiceType,
+			FramedProtocol,
+			NASPort,
+			NASPortType,
+			CallingStationID,
+			CalledStationID,
+			NASPortID,
+			AcctSessionID,
+			FramedIPAddress,
+			AcctAuthentic,
+			EventTimestamp,
+			AcctStatusType,
+			NASIdentifier,
+			NASIPAddress,
+			AcctDelayTime,
+			AcctSessionTime,
+			AcctInputOctets,
+			AcctInputGigawords,
+			AcctInputPackets,
+			AcctOutputOctets,
+			AcctOutputGigawords,
+			AcctOutputPackets,
+			PeriodKey
+		)
+		VALUES
+		(
+			%{user.Username},
+			%{request.Service-Type},
+			%{request.Framed-Protocol},
+			%{request.NAS-Port},
+			%{request.NAS-Port-Type},
+			%{request.Calling-Station-Id},
+			%{request.Called-Station-Id},
+			%{request.NAS-Port-Id},
+			%{request.Acct-Session-Id},
+			%{request.Framed-IP-Address},
+			%{request.Acct-Authentic},
+			%{request.Timestamp},
+			%{request.Acct-Status-Type},
+			%{request.NAS-Identifier},
+			%{request.NAS-IP-Address},
+			%{request.Acct-Delay-Time},
+			%{request.Acct-Session-Time},
+			%{request.Acct-Input-Octets},
+			%{request.Acct-Input-Gigawords},
+			%{request.Acct-Input-Packets},
+			%{request.Acct-Output-Octets},
+			%{request.Acct-Output-Gigawords},
+			%{request.Acct-Output-Packets},
+			%{query.PeriodKey}
+		)
+	';
+
+	$config->{'accounting_update_get_records_query'} = '
+		SELECT
+			SUM(AcctInputOctets) AS AcctInputOctets,
+			SUM(AcctInputPackets) AS AcctInputPackets,
+			SUM(AcctOutputOctets) AS AcctOutputOctets,
+			SUM(AcctOutputPackets) AS AcctOutputPackets,
+			SUM(AcctInputGigawords) AS AcctInputGigawords,
+			SUM(AcctOutputGigawords) AS AcctOutputGigawords,
+			SUM(AcctSessionTime) AS AcctSessionTime,
+			PeriodKey
+		FROM
+			@TP@accounting
+		WHERE
+			Username = %{user.Username}
+			AND AcctSessionID = %{request.Acct-Session-Id}
+			AND NASIPAddress = %{request.NAS-IP-Address}
+			AND NASPort = %{request.NAS-Port}
+		GROUP BY
+			PeriodKey
+		ORDER BY
+			ID ASC
+	';
+
+	$config->{'accounting_update_query'} = '
+		UPDATE
+			@TP@accounting
+		SET
+			AcctSessionTime = %{query.Acct-Session-Time},
+			AcctInputOctets = %{query.Acct-Input-Octets},
+			AcctInputGigawords = %{query.Acct-Input-Gigawords},
+			AcctInputPackets = %{query.Acct-Input-Packets},
+			AcctOutputOctets = %{query.Acct-Output-Octets},
+			AcctOutputGigawords = %{query.Acct-Output-Gigawords},
+			AcctOutputPackets = %{query.Acct-Output-Packets},
+			AcctStatusType = %{request.Acct-Status-Type}
+		WHERE
+			Username = %{user.Username}
+			AND AcctSessionID = %{request.Acct-Session-Id}
+			AND NASIPAddress = %{request.NAS-IP-Address}
+			AND NASPort = %{request.NAS-Port}
+			AND PeriodKey = %{query.PeriodKey}
+	';
+
+	$config->{'accounting_stop_status_query'} = '
+		UPDATE
+			@TP@accounting
+		SET
+			AcctStatusType = %{request.Acct-Status-Type},
+			AcctTerminateCause = %{request.Acct-Terminate-Cause}
+		WHERE
+			Username = %{user.Username}
+			AND AcctSessionID = %{request.Acct-Session-Id}
+			AND NASIPAddress = %{request.NAS-IP-Address}
+			AND NASPort = %{request.NAS-Port}
+	';
+
+	$config->{'accounting_usage_query'} = '
+		SELECT
+			SUM(AcctInputOctets) AS AcctInputOctets,
+			SUM(AcctOutputOctets) AS AcctOutputOctets,
+			SUM(AcctInputGigawords) AS AcctInputGigawords,
+			SUM(AcctOutputGigawords) AS AcctOutputGigawords,
+			SUM(AcctSessionTime) AS AcctSessionTime
+		FROM
+			@TP@accounting
+		WHERE
+			Username = %{user.Username}
+			AND PeriodKey = %{query.PeriodKey}
+	';
+
+	$config->{'accounting_usage_query_period'} = '
+		SELECT
+			SUM(AcctInputOctets) AS AcctInputOctets,
+			SUM(AcctOutputOctets) AS AcctOutputOctets,
+			SUM(AcctInputGigawords) AS AcctInputGigawords,
+			SUM(AcctOutputGigawords) AS AcctOutputGigawords,
+			SUM(AcctSessionTime) AS AcctSessionTime
+		FROM
+			@TP@accounting
+		WHERE
+			Username = %{user.Username}
+			AND EventTimestamp > %{query.PeriodKey}
+	';
+
+	$config->{'accounting_select_duplicates_query'} = '
+		SELECT
+			ID
+		FROM
+			@TP@accounting
+		WHERE
+			Username = %{user.Username}
+			AND AcctSessionID = %{request.Acct-Session-Id}
+			AND NASIPAddress = %{request.NAS-IP-Address}
+			AND NASPort = %{request.NAS-Port}
+			AND PeriodKey = %{query.PeriodKey}
+		ORDER BY
+			ID
+			LIMIT 99 OFFSET 1
+	';
+
+	$config->{'accounting_delete_duplicates_query'} = '
+		DELETE FROM
+			@TP@accounting
+		WHERE
+			ID = %{query.DuplicateID}
+	';
+
+	$config->{'accounting_usage_cache_time'} = 300;
+
+
+	# Setup SQL queries
+	if (defined($scfg->{'mod_accounting_sql'})) {
+		# Pull in queries
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_start_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_start_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_start_query'}) eq "ARRAY") {
+				$config->{'accounting_start_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_start_query'}});
+			} else {
+				$config->{'accounting_start_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_start_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_update_get_records_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_update_get_records_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_update_get_records_query'}) eq "ARRAY") {
+				$config->{'accounting_update_get_records_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_update_get_records_query'}});
+			} else {
+				$config->{'accounting_update_get_records_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_update_get_records_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_update_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_update_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_update_query'}) eq "ARRAY") {
+				$config->{'accounting_update_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_update_query'}});
+			} else {
+				$config->{'accounting_update_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_update_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_stop_status_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_stop_status_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_stop_status_query'}) eq "ARRAY") {
+				$config->{'accounting_stop_status_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_stop_status_query'}});
+			} else {
+				$config->{'accounting_stop_status_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_stop_status_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_usage_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_usage_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_usage_query'}) eq "ARRAY") {
+				$config->{'accounting_usage_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_usage_query'}});
+			} else {
+				$config->{'accounting_usage_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_usage_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}) eq "ARRAY") {
+				$config->{'accounting_usage_query_period'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'}});
+			} else {
+				$config->{'accounting_usage_query_period'} = $scfg->{'mod_accounting_sql'}->{'accounting_usage_query_period'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'}) eq "ARRAY") {
+				$config->{'accounting_select_duplicates_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'}});
+			} else {
+				$config->{'accounting_select_duplicates_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_select_duplicates_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_delete_duplicates_query'}) &&
+				$scfg->{'mod_accounting_sql'}->{'accounting_delete_duplicates_query'} ne "") {
+			if (ref($scfg->{'mod_accounting_sql'}->{'accounting_delete_duplicates_query'}) eq "ARRAY") {
+				$config->{'accounting_delete_duplicates_query'} = join(' ',
+						@{$scfg->{'mod_accounting_sql'}->{'accounting_delete_duplicates_query'}});
+			} else {
+				$config->{'accounting_delete_duplicates_query'} = $scfg->{'mod_accounting_sql'}->{'accounting_delete_duplicates_query'};
+			}
+		}
+		if (defined($scfg->{'mod_accounting_sql'}->{'accounting_usage_cache_time'})) {
+			# Check if we're a boolean
+			if (defined(my $val = isBoolean($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'}))) {
+				# If val is true, we default to the default anyway
+
+				# We're disabled
+				if (!$val) {
+					$config->{'accounting_usage_cache_time'} = undef;
+				}
+			# We *could* have a value...
+			} elsif ($scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'} =~ /^[0-9]+$/) {
+				$config->{'accounting_usage_cache_time'} = $scfg->{'mod_accounting_sql'}{'accounting_usage_cache_time'};
+			} else {
+				$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Value for 'accounting_usage_cache_time' is invalid");
+			}
+		}
+	}
+
+	# Log this for info sake
+	if (defined($config->{'accounting_usage_cache_time'})) {
+		$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] getUsage caching ENABLED, cache time is %ds.",
+				$config->{'accounting_usage_cache_time'});
+	} else {
+		$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] getUsage caching DISABLED");
+	}
+}
+
+
+# Function to get radius user data usage
+# The 'period' parameter is optional and is the number of days to return usage for
+sub getUsage
+{
+	my ($server,$user,$packet,$period) = @_;
+
+	# Build template
+	my $template;
+	foreach my $attr ($packet->attributes) {
+		$template->{'request'}->{$attr} = $packet->rawattr($attr)
+	}
+
+	# Add user details
+	$template->{'user'}->{'ID'} = $user->{'ID'};
+	$template->{'user'}->{'Username'} = $user->{'Username'};
+
+	# Current PeriodKey, this is used for non-$period queries
+	my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
+
+	# Query template to use below
+	my $queryTemplate;
+	# If we're doing a query for a specific period
+	if (defined($period)) {
+		# We need to switch out the query to the period query
+		$queryTemplate = "accounting_usage_query_period";
+		# Grab a clone of now, and create the start date DateTime object
+		my $startDate = $now->clone->subtract( 'days' => $period );
+		# And we add the start date
+		$template->{'query'}->{'PeriodKey'} = $startDate->ymd();
+
+	# If not, we just use PeriodKey as normal...
+	} else {
+		# Set the normal PeriodKey query template to use
+		$queryTemplate = "accounting_usage_query";
+		# And set the period key to this month
+		$template->{'query'}->{'PeriodKey'} = $now->strftime("%Y-%m");
+	}
+
+	# If we using caching, check how old the result is
+	if (defined($config->{'accounting_usage_cache_time'})) {
+		my ($res,$val) = cacheGetComplexKeyPair('mod_accounting_sql(getUsage)',$user->{'Username'}."/".
+				$template->{'query'}->{'PeriodKey'});
+		if (defined($val) && $val->{'CachedUntil'} > $user->{'_Internal'}->{'Timestamp-Unix'}) {
+			return $val;
+		}
+	}
+
+	# Replace template entries
+	my (@dbDoParams) = templateReplace($config->{$queryTemplate},$template);
+
+	# Fetch data
+	my $sth = DBSelect(@dbDoParams);
+	if (!$sth) {
+		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
+		return;
+	}
+
+	# Our usage hash
+	my %usageTotals;
+	$usageTotals{'TotalSessionTime'} = Math::BigInt->new(0);
+	$usageTotals{'TotalDataInput'} = Math::BigInt->new(0);
+	$usageTotals{'TotalDataOutput'} = Math::BigInt->new(0);
+
+	# Pull in usage and add up
+	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
+			qw(AcctSessionTime AcctInputOctets AcctInputGigawords AcctOutputOctets AcctOutputGigawords)
+	)) {
+
+		# Look for session time
+		if (defined($row->{'AcctSessionTime'}) && $row->{'AcctSessionTime'} > 0) {
+			$usageTotals{'TotalSessionTime'}->badd($row->{'AcctSessionTime'});
+		}
+		# Add input usage if we have any
+		if (defined($row->{'AcctInputOctets'}) && $row->{'AcctInputOctets'} > 0) {
+			$usageTotals{'TotalDataInput'}->badd($row->{'AcctInputOctets'});
+		}
+		if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
+			my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
+			$inputGigawords->bmul(GIGAWORD_VALUE);
+			$usageTotals{'TotalDataInput'}->badd($inputGigawords);
+		}
+		# Add output usage if we have any
+		if (defined($row->{'AcctOutputOctets'}) && $row->{'AcctOutputOctets'} > 0) {
+			$usageTotals{'TotalDataOutput'}->badd($row->{'AcctOutputOctets'});
+		}
+		if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
+			my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
+			$outputGigawords->bmul(GIGAWORD_VALUE);
+			$usageTotals{'TotalDataOutput'}->badd($outputGigawords);
+		}
+	}
+	DBFreeRes($sth);
+
+	# Convert to bigfloat for accuracy
+	my $totalData = Math::BigFloat->new(0);
+	$totalData->badd($usageTotals{'TotalDataOutput'})->badd($usageTotals{'TotalDataInput'});
+	my $totalTime = Math::BigFloat->new(0);
+	$totalTime->badd($usageTotals{'TotalSessionTime'});
+
+	# Rounding up
+	my %res;
+	$res{'TotalDataUsage'} = $totalData->bdiv(1024)->bdiv(1024)->bceil()->bstr();
+	$res{'TotalSessionTime'} = $totalTime->bdiv(60)->bceil()->bstr();
+
+	# If we using caching and got here, it means that we must cache the result
+	if (defined($config->{'accounting_usage_cache_time'})) {
+		$res{'CachedUntil'} = $user->{'_Internal'}->{'Timestamp-Unix'} + $config->{'accounting_usage_cache_time'};
+
+		# Cache the result
+		cacheStoreComplexKeyPair('mod_accounting_sql(getUsage)',$user->{'Username'}."/".$template->{'query'}->{'PeriodKey'},\%res);
+	}
+
+	return \%res;
+}
+
+
+## @log
+# Try find a user
+#
+# @param server Server object
+# @param user User object
+# @param packet Radius packet
+#
+# @return Result
+sub acct_log
+{
+	my ($server,$user,$packet) = @_;
+
+
+	# Build template
+	my $template;
+	foreach my $attr ($packet->attributes) {
+		$template->{'request'}->{$attr} = $packet->rawattr($attr);
+	}
+	# Fix event timestamp
+	$template->{'request'}->{'Timestamp'} = $user->{'_Internal'}->{'Timestamp'};
+
+	# Add user details
+	$template->{'user'}->{'ID'} = $user->{'ID'};
+	$template->{'user'}->{'Username'} = $user->{'Username'};
+
+	# Current PeriodKey
+	my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
+	my $periodKey = $now->strftime("%Y-%m");
+
+	# For our queries
+	$template->{'query'}->{'PeriodKey'} = $periodKey;
+
+	# Default to being a new period, only if we update on INTERIM or STOP do we set this to 0
+	my $newPeriod = 1;
+
+	#
+	# U P D A T E   &   S T O P   P A C K E T
+	#
+	if ($packet->rawattr('Acct-Status-Type') eq "2" || $packet->rawattr('Acct-Status-Type') eq "3") {
+		# Replace template entries
+		my @dbDoParams = templateReplace($config->{'accounting_update_get_records_query'},$template);
+
+		# Fetch previous records of the same session
+		my $sth = DBSelect(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
+			return;
+		}
+
+		# Convert session total gigawords into bytes
+		my $totalInputBytes = Math::BigInt->new($template->{'request'}->{'Acct-Input-Gigawords'});
+		my $totalOutputBytes = Math::BigInt->new($template->{'request'}->{'Acct-Output-Gigawords'});
+		$totalInputBytes->bmul(GIGAWORD_VALUE);
+		$totalOutputBytes->bmul(GIGAWORD_VALUE);
+		# Add byte counters
+		$totalInputBytes->badd($template->{'request'}->{'Acct-Input-Octets'});
+		$totalOutputBytes->badd($template->{'request'}->{'Acct-Output-Octets'});
+		# Packets, no conversion
+		my $totalInputPackets = Math::BigInt->new($template->{'request'}->{'Acct-Input-Packets'});
+		my $totalOutputPackets = Math::BigInt->new($template->{'request'}->{'Acct-Output-Packets'});
+		# We don't need bigint here, but why not ... lets keep everything standard
+		my $totalSessionTime = Math::BigInt->new($template->{'request'}->{'Acct-Session-Time'});
+
+		# Loop through previous records and subtract them from our session totals
+		while (my $sessionPart = hashifyLCtoMC($sth->fetchrow_hashref(),
+				qw(AcctInputOctets AcctInputPackets AcctOutputOctets AcctOutputPackets AcctInputGigawords AcctOutputGigawords
+					SessionTime PeriodKey)
+		)) {
+			# Make sure we treat undef values sort of sanely
+			$sessionPart->{'AcctInputGigawords'} //= 0;
+			$sessionPart->{'AcctInputOctets'} //= 0;
+			$sessionPart->{'AcctOutputGigawords'} //= 0;
+			$sessionPart->{'AcctOutputOctets'} //= 0;
+			$sessionPart->{'AcctInputPackets'} //= 0;
+			$sessionPart->{'AcctOutputPackets'} //= 0;
+			$sessionPart->{'AcctSessionTime'} //= 0;
+
+			# Convert the gigawords into bytes
+			my $sessionInputBytes = Math::BigInt->new($sessionPart->{'AcctInputGigawords'});
+			my $sessionOutputBytes = Math::BigInt->new($sessionPart->{'AcctOutputGigawords'});
+			$sessionInputBytes->bmul(GIGAWORD_VALUE);
+			$sessionOutputBytes->bmul(GIGAWORD_VALUE);
+			# Add the byte counters
+			$sessionInputBytes->badd($sessionPart->{'AcctInputOctets'});
+			$sessionOutputBytes->badd($sessionPart->{'AcctOutputOctets'});
+			# And packets
+			my $sessionInputPackets = Math::BigInt->new($sessionPart->{'AcctInputPackets'});
+			my $sessionOutputPackets = Math::BigInt->new($sessionPart->{'AcctOutputPackets'});
+			# Finally session time
+			my $sessionSessionTime = Math::BigInt->new($sessionPart->{'AcctSessionTime'});
+
+			# Check if this record is from an earlier period
+			if (defined($sessionPart->{'PeriodKey'}) && $sessionPart->{'PeriodKey'} ne $periodKey) {
+
+				# Subtract from our total, we can hit NEG!!! ... we check for that below
+				$totalInputBytes->bsub($sessionInputBytes);
+				$totalOutputBytes->bsub($sessionOutputBytes);
+				$totalInputPackets->bsub($sessionInputPackets);
+				$totalOutputPackets->bsub($sessionOutputPackets);
+				$totalSessionTime->bsub($sessionSessionTime);
+
+				# We need to continue this session in a new entry
+				$newPeriod = 1;
+			}
+		}
+		DBFreeRes($sth);
+
+		# Sanitize
+		if ($totalInputBytes->is_neg()) {
+			$totalInputBytes->bzero();
+		}
+		if ($totalOutputBytes->is_neg()) {
+			$totalOutputBytes->bzero();
+		}
+		if ($totalInputPackets->is_neg()) {
+			$totalInputPackets->bzero();
+		}
+		if ($totalOutputPackets->is_neg()) {
+			$totalOutputPackets->bzero();
+		}
+		if ($totalSessionTime->is_neg()) {
+			$totalSessionTime->bzero();
+		}
+
+		# Re-calculate
+		my ($inputGigawordsStr,$inputOctetsStr) = $totalInputBytes->bdiv(GIGAWORD_VALUE);
+		my ($outputGigawordsStr,$outputOctetsStr) = $totalOutputBytes->bdiv(GIGAWORD_VALUE);
+
+		# Conversion to strings
+		$template->{'query'}->{'Acct-Input-Gigawords'} = $inputGigawordsStr->bstr();
+		$template->{'query'}->{'Acct-Input-Octets'} = $inputOctetsStr->bstr();
+		$template->{'query'}->{'Acct-Output-Gigawords'} = $outputGigawordsStr->bstr();
+		$template->{'query'}->{'Acct-Output-Octets'} = $outputOctetsStr->bstr();
+
+		$template->{'query'}->{'Acct-Input-Packets'} = $totalInputPackets->bstr();
+		$template->{'query'}->{'Acct-Output-Packets'} = $totalOutputPackets->bstr();
+
+		$template->{'query'}->{'Acct-Session-Time'} = $totalSessionTime->bstr();
+
+
+		# Replace template entries
+		@dbDoParams = templateReplace($config->{'accounting_update_query'},$template);
+
+		# Update database
+		$sth = DBDo(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting ALIVE record: ".
+					AWITPT::DB::DBLayer::error());
+			return MOD_RES_NACK;
+		}
+
+		# If we updated *something* ...
+		if ($sth ne "0E0") {
+			# Be very sneaky .... if we updated something, this is obviously NOT a new period
+			$newPeriod = 0;
+			# If we updated a few things ... possibly duplicates?
+			if ($sth > 1) {
+				fixDuplicates($server, $template);
+			}
+		}
+	}
+
+
+	#
+	# S T A R T   P A C K E T
+	#
+	# Possible aswell if we are missing a start packet for this session or for the period
+	#
+
+	if ($packet->rawattr('Acct-Status-Type') eq "1" || $newPeriod) {
+		# Replace template entries
+		my @dbDoParams = templateReplace($config->{'accounting_start_query'},$template);
+		# Insert into database
+		my $sth = DBDo(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to insert accounting START record: ".
+					AWITPT::DB::DBLayer::error());
+			return MOD_RES_NACK;
+		}
+		# Update first login?
+		if (defined($user->{'_UserDB'}->{'Users_data_get'}) && defined($user->{'_UserDB'}->{'Users_data_set'})) {
+			# Try get his first login
+			my $firstLogin = $user->{'_UserDB'}->{'Users_data_get'}($server,$user,'global','FirstLogin');
+			# If we don't get it, set it
+			if (!defined($firstLogin)) {
+				$user->{'_UserDB'}->{'Users_data_set'}($server,$user,'global','FirstLogin',$user->{'_Internal'}->{'Timestamp-Unix'});
+			}
+		}
+	}
+
+
+	#
+	# S T O P   P A C K E T   specifics
+	#
+
+	if ($packet->rawattr('Acct-Status-Type') eq "2") {
+
+		# Replace template entries
+		my @dbDoParams = templateReplace($config->{'accounting_stop_status_query'},$template);
+
+		# Update database (status)
+		my $sth = DBDo(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting STOP record: %s",AWITPT::DB::DBLayer::error());
+			return MOD_RES_NACK;
+		}
+	}
+
+
+	return MOD_RES_ACK;
+}
+
+
+# Resolve duplicate records
+sub fixDuplicates
+{
+	my ($server, $template) = @_;
+
+
+	# Replace template entries
+	my @dbDoParams = templateReplace($config->{'accounting_select_duplicates_query'},$template);
+
+	# Select duplicates
+	my $sth = DBSelect(@dbDoParams);
+	if (!$sth) {
+		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
+		return;
+	}
+
+	# Pull in duplicates
+	my @IDList;
+	while (my $duplicates = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID))) {
+		push(@IDList,$duplicates->{'ID'});
+	}
+	DBFreeRes($sth);
+
+	# Loop through IDs and delete
+	DBBegin();
+	foreach my $duplicateID (@IDList) {
+		# Add ID list to the template
+		$template->{'query'}->{'DuplicateID'} = $duplicateID;
+
+		# Replace template entries
+		@dbDoParams = templateReplace($config->{'accounting_delete_duplicates_query'},$template);
+
+		# Delete duplicates
+		$sth = DBDo(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
+			DBRollback();
+			return;
+		}
+	}
+
+	# Commit changes to the database
+	$server->log(LOG_DEBUG,"[MOD_ACCOUNTING_SQL] Duplicate accounting records deleted");
+	DBCommit();
+
+
+	return
+}
+
+
+# Add up totals function
+sub cleanup
+{
+	my ($server,$runForDate) = @_;
+
+
+	# The datetime now
+	my $now = DateTime->from_epoch(epoch => $runForDate)->set_time_zone($server->{'smradius'}->{'event_timezone'});
+
+	# Use truncate to set all values after 'month' to their default values
+	my $thisMonth = $now->clone()->truncate( to => "month" );
+
+	# Last month..
+	my $lastMonth = $thisMonth->clone()->subtract( months => 1 );
+	my $prevPeriodKey = $lastMonth->strftime("%Y-%m");
+
+
+	# Begin transaction
+	DBBegin();
+
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Removing previous accounting summaries (if any)");
+
+	# Delete duplicate records
+	# NK: MYSQL SPECIFIC
+	my $sth = DBDo('
+		DELETE FROM
+			@TP@accounting_summary
+		WHERE
+			STR_TO_DATE(PeriodKey,"%Y-%m") >= ?',
+		$prevPeriodKey
+	);
+	if (!$sth) {
+		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to delete accounting summary record: ".
+				AWITPT::DB::DBLayer::error());
+		DBRollback();
+		return;
+	}
+
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Generating accounting summaries");
+
+	# Select totals for last month
+	$sth = DBSelect('
+		SELECT
+			Username,
+			AcctSessionTime,
+			AcctInputOctets,
+			AcctInputGigawords,
+			AcctOutputOctets,
+			AcctOutputGigawords
+		FROM
+			@TP@accounting
+		WHERE
+			PeriodKey = ?
+		',
+		$prevPeriodKey
+	);
+	if (!$sth) {
+		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to select accounting record: ".
+				AWITPT::DB::DBLayer::error());
+		return;
+	}
+
+	# Load items into array
+	my %usageTotals;
+	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
+			qw(Username AcctSessionTime AcctInputOctets AcctInputGigawords AcctOutputOctets AcctOutputGigawords)
+	)) {
+
+		# check if we've seen this user, if so just add up
+		if (defined($usageTotals{$row->{'Username'}})) {
+			# Look for session time
+			if (defined($row->{'AcctSessionTime'}) && $row->{'AcctSessionTime'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalSessionTime'}->badd($row->{'AcctSessionTime'});
+			}
+			# Add input usage if we have any
+			if (defined($row->{'AcctInputOctets'}) && $row->{'AcctInputOctets'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($row->{'AcctInputOctets'});
+			}
+			if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
+				my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
+				$inputGigawords->bmul(GIGAWORD_VALUE);
+				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
+			}
+			# Add output usage if we have any
+			if (defined($row->{'AcctOutputOctets'}) && $row->{'AcctOutputOctets'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($row->{'AcctOutputOctets'});
+			}
+			if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
+				my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
+				$outputGigawords->bmul(GIGAWORD_VALUE);
+				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
+			}
+
+		# This is a new record...
+		} else {
+
+			# Make BigInts for this user
+			$usageTotals{$row->{'Username'}}{'TotalSessionTime'} = Math::BigInt->new(0);
+			$usageTotals{$row->{'Username'}}{'TotalDataInput'} = Math::BigInt->new(0);
+			$usageTotals{$row->{'Username'}}{'TotalDataOutput'} = Math::BigInt->new(0);
+
+			# Look for session time
+			if (defined($row->{'AcctSessionTime'}) && $row->{'AcctSessionTime'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalSessionTime'}->badd($row->{'AcctSessionTime'});
+			}
+			# Add input usage if we have any
+			if (defined($row->{'AcctInputOctets'}) && $row->{'AcctInputOctets'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($row->{'AcctInputOctets'});
+			}
+			if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
+				my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
+				$inputGigawords->bmul(GIGAWORD_VALUE);
+				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
+			}
+			# Add output usage if we have any
+			if (defined($row->{'AcctOutputOctets'}) && $row->{'AcctOutputOctets'} > 0) {
+				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($row->{'AcctOutputOctets'});
+			}
+			if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
+				my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
+				$outputGigawords->bmul(GIGAWORD_VALUE);
+				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
+			}
+
+		}
+	}
+
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Creating new accounting summaries");
+
+	# Loop through users and insert totals
+	foreach my $username (keys %usageTotals) {
+
+		# Convert to bigfloat for accuracy
+		my $totalDataOutput = Math::BigFloat->new($usageTotals{$username}{'TotalDataOutput'});
+		my $totalDataInput = Math::BigFloat->new($usageTotals{$username}{'TotalDataInput'});
+		my $totalTime = Math::BigFloat->new($usageTotals{$username}{'TotalSessionTime'});
+
+		# Rounding up
+		my $res;
+		$res->{'TotalDataInput'} = $totalDataInput->bdiv(1024)->bdiv(1024)->bceil()->bstr();
+		$res->{'TotalDataOutput'} = $totalDataOutput->bdiv(1024)->bdiv(1024)->bceil()->bstr();
+		$res->{'TotalSessionTime'} = $totalTime->bdiv(60)->bceil()->bstr();
+
+		# Do query
+		$sth = DBDo('
+			INSERT INTO
+				@TP@accounting_summary
+			(
+				Username,
+				PeriodKey,
+				TotalSessionTime,
+				TotalInput,
+				TotalOutput
+			)
+			VALUES
+				(?,?,?,?,?)
+			',
+			$username,
+			$prevPeriodKey,
+			$res->{'TotalSessionTime'},
+			$res->{'TotalDataInput'},
+			$res->{'TotalDataOutput'}
+		);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to create accounting summary record: ".
+					AWITPT::DB::DBLayer::error());
+			DBRollback();
+			return;
+		}
+
+		# Lets log
+		$server->log(LOG_DEBUG,"[MOD_ACCOUNTING_SQL] Cleanup => INSERT: Username = '%s', PeriodKey = '%s', ".
+				"TotalSessionTime = '%s', TotalInput = '%s', TotalOutput = '%s'", $username, $prevPeriodKey,
+				$res->{'TotalSessionTime'}, $res->{'TotalDataInput'}, $res->{'TotalDataOutput'});
+	}
+
+	# Commit if succeeded
+	DBCommit();
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Accounting summaries created");
+}
+
+
+
+1;
+# vim: ts=4

smradius/modules/accounting/mod_accounting_test.pm → lib/smradius/modules/accounting/mod_accounting_test.pm

 # Test accounting database
-# Copyright (C) 2007-2009, AllWorldIT
-# 
+# Copyright (C) 2007-2016, 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
 # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.
-# 
+#
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License along
 # with this program; if not, write to the Free Software Foundation, Inc.,
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
@@ -99,15 +99,18 @@ Acct-Delay-Time: %{accounting.Acct-Delay-Time}
 	foreach my $attr ($packet->attributes) {
 		$template->{'accounting'}->{$attr} = $packet->attr($attr)
 	}
-	$template->{'user'} = $user;
 
-	if ($packet->attr('Acct-Status-Type') eq "Start") {
+	# Add user details
+	$template->{'user'}->{'ID'} = $user->{'ID'};
+	$template->{'user'}->{'Username'} = $user->{'Username'};
+
+	if ($packet->rawattr('Acct-Status-Type') eq "1") {
 		$server->log(LOG_DEBUG,"Start Packet: ".$packet->dump());
 
-	} elsif ($packet->attr('Acct-Status-Type') eq "Alive") {
+	} elsif ($packet->rawattr('Acct-Status-Type') eq "3") {
 		$server->log(LOG_DEBUG,"Alive Packet: ".$packet->dump());
 
-	} elsif ($packet->attr('Acct-Status-Type') eq "Stop") {
+	} elsif ($packet->rawattr('Acct-Status-Type') eq "2") {
 		$server->log(LOG_DEBUG,"Stop Packet: ".$packet->dump());
 
 	}

smradius/modules/authentication/mod_auth_chap.pm → lib/smradius/modules/authentication/mod_auth_chap.pm

 # CHAP authentication
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2015, AllWorldIT
 #
 # References:
 #	RFC1944 - PPP Challenge Handshake Authentication Protocol (CHAP)

smradius/config.pm → lib/smradius/modules/authentication/mod_auth_macauth.pm

-# SMRadius config information
-# Copyright (C) 2007-2009, AllWorldIT
+# MAC Authentication
+# Copyright (C) 2007-2015, 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
 # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.
-#
+# 
 # This program is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.
-#
+# 
 # You should have received a copy of the GNU General Public License along
 # with this program; if not, write to the Free Software Foundation, Inc.,
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
-
-## @class smradius::config
-# Configuration handling class
-package smradius::config;
+package smradius::modules::authentication::mod_auth_macauth;
 
 use strict;
 use warnings;
 
+# Modules we need
+use smradius::attributes;
+use smradius::constants;
+use smradius::logging;
+
+
+
 # Exporter stuff
 require Exporter;
-our (@ISA,@EXPORT);
+our (@ISA,@EXPORT,@EXPORT_OK);
 @ISA = qw(Exporter);
 @EXPORT = qw(
 );
+@EXPORT_OK = qw(
+);
 
 
-use smradius::logging;
 
+# Plugin info
+our $pluginInfo = {
+	Name => "MAC Authentication",
+	Init => \&init,
+	
+	# Authentication
+	Authentication_try => \&authenticate,
+};
 
-# Our vars
-my $config;
 
 
-## @fn Init($server)
-# Initialize this module with a server object
-#
-# @param server Server object we need to setup
-sub Init
+## @internal
+# Initialize module
+sub init
 {
 	my $server = shift;
+}
 
 
-	# Setup configuration
-	$config = $server->{'inifile'};
 
-	my $db;
-	$db->{'DSN'} = $config->{'database'}{'dsn'};
-	$db->{'Username'} = $config->{'database'}{'username'};
-	$db->{'Password'} = $config->{'database'}{'password'};
-	$db->{'enabled'} = 0;
+## @authenticate
+# Try authenticate user
+#
+# @param server Server object
+# @param user User hash
+# @param packet Radius packet
+#
+# @return Result
+sub authenticate
+{
+	my ($server,$user,$packet) = @_;
 
-	# Check we have all the config we need
-	if (!defined($db->{'DSN'})) {
-		$server->log(LOG_NOTICE,"smradius/config.pm: No 'DSN' defined in config file for 'database'");
-	}
 
-	$server->{'smradius'}{'database'} = $db;
-}
+	# This is not a MAC authentication request
+	if ($user->{'_UserDB'}->{'Name'} ne "SQL User Database (MAC authentication)") {
+		return MOD_RES_SKIP;
+	}
 
+	$server->log(LOG_DEBUG,"[MOD_AUTH_MACAUTH] This is a MAC authentication request");
 
-## @fn getConfig
-# Get the config hash
-#
-# @return Hash ref of all our config items
-sub getConfig
-{
-	return $config;
+	return MOD_RES_ACK;
 }
 
 
-
 1;
 # vim: ts=4

smradius/modules/authentication/mod_auth_mschap.pm → lib/smradius/modules/authentication/mod_auth_mschap.pm

 # Microsoft CHAP version 1 and 2 support
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2015, AllWorldIT
 #
 # References: 
 #	RFC1994 - PPP Challenge Handshake Authentication Protocol (CHAP)
 #	RFC2443 - Microsoft PPP CHAP Extensions
 #	RFC2759 - Microsoft PPP CHAP Extensions, Version 2
 #	RFC2548 - Microsoft Vendor-specific RADIUS Attributes
+#	RFC3079 - Deriving Keys for use with Microsoft Point-to-Point 
+#	          Encryption (MPPE)
 #
 # 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
@@ -36,8 +38,9 @@ use smradius::constants;
 use smradius::logging;
 use Crypt::DES;
 use Crypt::RC4;
-use Digest::SHA1;
+use Digest::SHA;
 use Digest::MD4 qw( md4 );
+use Digest::MD5 qw( );
 
 # Don't use unicode
 use bytes;
@@ -48,6 +51,8 @@ require Exporter;
 our (@ISA,@EXPORT,@EXPORT_OK);
 @ISA = qw(Exporter);
 @EXPORT = qw(
+);
+@EXPORT_OK = qw(
 	GenerateNTResponse
 	ChallengeHash
 	NtPasswordHash
@@ -57,8 +62,6 @@ our (@ISA,@EXPORT,@EXPORT_OK);
 	CheckAuthenticatorResponse
 	NtChallengeResponse
 );
-@EXPORT_OK = qw(
-);
 
 
 use constant {
@@ -142,22 +145,29 @@ sub authenticate
 		my $challenge = @{$rawChallenge}[0];
 		my $response = substr(@{$rawResponse}[0],2);
 
-#		print(STDERR "RECEIVED\n");
-#		print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
-#		print(STDERR "Reponse  : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
-#		print(STDERR "\n\n");
-
-#		print(STDERR "CHOPPED OFFF!!\n");
 		# Chop off NtResponse
 		my $NtResponse = substr($response,24,24);
-#		print(STDERR "NTRespons: len = ".length($NtResponse).", hex = ".unpack("H*",$NtResponse)."\n");
-#		print(STDERR "\n\n");
 
-#		print(STDERR "TEST\n");
 		# Generate our response
 		my $ourResponse = NtChallengeResponse($challenge,$unicodePassword);
-#		print(STDERR "Calculate: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
-#		print(STDERR "\n\n");
+
+
+# MPPE Code
+##################
+		my $NtPasswordHash = NtPasswordHash($unicodePassword);
+		my $HashNtPasswordHash = HashNtPasswordHash($NtPasswordHash);
+
+		my $sendkey = pack("x8a16",$HashNtPasswordHash);
+		my $recvkey;
+		
+		setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
+			'Vendor' => 311,
+			'Name' => 'MS-CHAP-MPPE-Keys',
+			'Operator' => ":=",
+			'Value' => $sendkey
+		});
+##################
+
 
 		# Check responses match
 		if ($NtResponse eq $ourResponse) {
@@ -174,29 +184,13 @@ sub authenticate
 		my $ident = unpack("C", substr(@{$rawResponse2}[0],0,1));
 		my $response = substr(@{$rawResponse2}[0],2);
 
-#		print(STDERR "RECEIVED\n");
-#		print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
-#		print(STDERR "Ident    : $ident\n");
-#		print(STDERR "Response : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
-#		print(STDERR "\n\n");
-
-
-
-#		print(STDERR "CHOPPED OFFF!!\n");
 		# Grab peer challenge and response
 		my $peerChallenge = substr($response,0,16);
 		my $NtResponse = substr($response,24,24);
-#		print(STDERR "PeerChallenge: len = ".length($peerChallenge).", hex = ".unpack("H*",$peerChallenge)."\n");
-#		print(STDERR "NTResponse: len = ".length($NtResponse).", hex = ".unpack("H*",$NtResponse)."\n");
-#		print(STDERR "\n\n");
 
-#		print(STDERR "TEST\n");
 		# Generate our challenge and our response
 		my $ourChallenge = ChallengeHash($peerChallenge,$challenge,$username);
 		my $ourResponse = NtChallengeResponse($ourChallenge,$unicodePassword);
-#		print(STDERR "OurChallenge: len = ".length($ourChallenge).", hex = ".unpack("H*",$ourChallenge)."\n");
-#		print(STDERR "OurResponse: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
-#		print(STDERR "\n\n");
 
 		# Check response match
 		if ($NtResponse eq $ourResponse) {
@@ -204,8 +198,57 @@ sub authenticate
 			my $authenticatorResponse = pack("C",$ident) . GenerateAuthenticatorResponse($unicodePassword,$ourResponse,
 					$peerChallenge,$challenge,$username);
 
-#			print(STDERR "Authenticator Response: len = ".length($authenticatorResponse).
-#					", hex = ".unpack("H*",$authenticatorResponse)."\n");
+			# MPPE Code
+################################
+
+			my $NtPasswordHash = NtPasswordHash($unicodePassword);
+			my $HashNtPasswordHash = HashNtPasswordHash($NtPasswordHash);
+
+			# Create master key
+			my $MasterKey = GetMasterKey($HashNtPasswordHash,$NtResponse);
+
+			# Create MPPE keys
+			my $mppe_sendKey = GetAsymmetricStartKey($MasterKey,16,1,1);
+			my $mppe_recvKey = GetAsymmetricStartKey($MasterKey,16,1,0);
+
+
+			# Generate salts ... this should be in its own module and salt_offset should be global
+			my $salt_offset = 0;
+			my $salt1 = pack("C2",(0x80 | ( (($salt_offset++) & 0x0f) << 3) |
+   	            (rand(255) & 0x07)),rand(255));
+			my $salt2 = pack("C2",(0x80 | ( (($salt_offset++) & 0x0f) << 3) |
+   	            (rand(255) & 0x07)),rand(255));
+
+			# Encode keys
+			my $mppe_sendKey_e = mppe_encode_key(
+					getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"),
+					$packet->authenticator,
+					$salt1,
+					$mppe_sendKey
+			);
+			my $mppe_recvKey_e = mppe_encode_key(
+					getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"),
+					$packet->authenticator,
+					$salt2,
+					$mppe_recvKey
+			);
+
+			# Finally setup arguments
+			setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
+				'Vendor' => 311,
+				'Name' => 'MS-MPPE-Recv-Key',
+				'Operator' => ":=",
+				'Value' => $mppe_recvKey_e
+			});
+
+			setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
+				'Vendor' => 311,
+				'Name' => 'MS-MPPE-Send-Key',
+				'Operator' => ":=",
+				'Value' => $mppe_sendKey_e
+			});
+#################################
+
 
 			setReplyVAttribute($server,$user->{'ReplyVAttributes'}, {
 				'Vendor' => 311,
@@ -285,7 +328,7 @@ sub ChallengeHash
 
 
 	# SHA encryption
-	my $sha = Digest::SHA1->new();
+	my $sha = Digest::SHA->new();
 	$sha->add($PeerChallenge);
 	$sha->add($AuthenticatorChallenge);
 	$sha->add($UserName);
@@ -522,7 +565,7 @@ sub GenerateAuthenticatorResponse
 	my $PasswordHashHash = HashNtPasswordHash($PasswordHash);
 		
 	# SHA encryption
-	my $sha = Digest::SHA1->new();
+	my $sha = Digest::SHA->new();
 	$sha->add($PasswordHashHash);
 	$sha->add($NTResponse);
 	foreach my $item (@Magic1) {
@@ -532,7 +575,7 @@ sub GenerateAuthenticatorResponse
 
 	my $Challenge = ChallengeHash($PeerChallenge, $AuthenticatorChallenge, $UserName);
 
-	$sha = Digest::SHA1->new();
+	$sha = Digest::SHA->new();
 	$sha->add($Digest);
 	$sha->add($Challenge);
 	foreach my $item (@Magic2) {
@@ -769,5 +812,220 @@ sub NtChallengeResponse {
 
 
 
+#
+# RFC 3079
+#
+
+#GetMasterKey(
+#	IN  16-octet  PasswordHashHash,
+#	IN  24-octet  NTResponse,
+#	OUT 16-octet  MasterKey )
+#{
+#	20-octet Digest
+#
+#	ZeroMemory(Digest, sizeof(Digest));
+#
+#	/*
+#	 * SHSInit(), SHSUpdate() and SHSFinal()
+#	 * are an implementation of the Secure Hash Standard [7].
+#	 */
+#
+#	SHSInit(Context);
+#	SHSUpdate(Context, PasswordHashHash, 16);
+#	SHSUpdate(Context, NTResponse, 24);
+#	SHSUpdate(Context, Magic1, 27);
+#	SHSFinal(Context, Digest);
+#
+#	MoveMemory(MasterKey, Digest, 16);
+#}
+sub GetMasterKey
+{
+	my ($PasswordHashHash,$NTResponse) = @_;
+
+
+	# "Magic" constants used in key derivations - in hex
+	my @Magic1 =
+		("54", "68", "69", "73", "20", "69", "73", "20", "74",
+		 "68", "65", "20", "4d", "50", "50", "45", "20", "4d",
+		 "61", "73", "74", "65", "72", "20", "4b", "65", "79");
+
+	my $sha = Digest::SHA->new();
+	$sha->add($PasswordHashHash);
+	$sha->add($NTResponse);
+	foreach my $item (@Magic1) {
+		$sha->add(pack("H*",$item));
+	}
+	my $Digest = $sha->digest();
+	# Cut off MasterKey
+	my $MasterKey = substr($Digest,0,16);
+
+	return $MasterKey;
+}
+
+
+
+
+#VOID
+#GetAsymetricStartKey(
+#	IN   16-octet      MasterKey,
+#	OUT  8-to-16 octet SessionKey,
+#	IN   INTEGER       SessionKeyLength,
+#	IN   BOOLEAN       IsSend,
+#	IN   BOOLEAN       IsServer )
+#{
+#
+#	20-octet Digest;
+#
+#	ZeroMemory(Digest, 20);
+#
+#	if (IsSend) {
+#		if (IsServer) {
+#			s = Magic3
+#		} else {
+#			s = Magic2
+#		}
+#	} else {
+#		if (IsServer) {
+#			s = Magic2
+#		} else {
+#			s = Magic3
+#		}
+#	}
+#
+#	/*
+#	 * SHSInit(), SHSUpdate() and SHSFinal()
+#	 * are an implementation of the Secure Hash Standard [7].
+#	 */
+#
+#	SHSInit(Context);
+#	SHSUpdate(Context, MasterKey, 16);
+#	SHSUpdate(Context, SHSpad1, 40);
+#	SHSUpdate(Context, s, 84);
+#	SHSUpdate(Context, SHSpad2, 40);
+#	SHSFinal(Context, Digest);
+#
+#	MoveMemory(SessionKey, Digest, SessionKeyLength);
+#}
+sub GetAsymmetricStartKey
+{
+	my ($MasterKey,$SessionKeyLength,$IsSend,$IsServer) = @_;
+
+
+	# "Magic" constants used in key derivations - in hex
+	my @Magic2 =
+		("4f", "6e", "20", "74", "68", "65", "20", "63", "6c", "69",
+		 "65", "6e", "74", "20", "73", "69", "64", "65", "2c", "20",
+		 "74", "68", "69", "73", "20", "69", "73", "20", "74", "68",
+		 "65", "20", "73", "65", "6e", "64", "20", "6b", "65", "79",
+		 "3b", "20", "6f", "6e", "20", "74", "68", "65", "20", "73",
+		 "65", "72", "76", "65", "72", "20", "73", "69", "64", "65",
+		 "2c", "20", "69", "74", "20", "69", "73", "20", "74", "68",
+		 "65", "20", "72", "65", "63", "65", "69", "76", "65", "20",
+		 "6b", "65", "79", "2e");
+
+	my @Magic3 =
+		("4f", "6e", "20", "74", "68", "65", "20", "63", "6c", "69",
+		 "65", "6e", "74", "20", "73", "69", "64", "65", "2c", "20",
+		 "74", "68", "69", "73", "20", "69", "73", "20", "74", "68",
+		 "65", "20", "72", "65", "63", "65", "69", "76", "65", "20",
+		 "6b", "65", "79", "3b", "20", "6f", "6e", "20", "74", "68",
+		 "65", "20", "73", "65", "72", "76", "65", "72", "20", "73",
+		 "69", "64", "65", "2c", "20", "69", "74", "20", "69", "73",
+		 "20", "74", "68", "65", "20", "73", "65", "6e", "64", "20",
+		 "6b", "65", "79", "2e");
+
+	# Pads used in key derivation - in hex
+	my @SHSpad1 =
+		("00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
+		 "00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
+		 "00", "00", "00", "00", "00", "00", "00", "00", "00", "00",
+		 "00", "00", "00", "00", "00", "00", "00", "00", "00", "00");
+
+	my @SHSpad2 =
+		("f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
+		 "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
+		 "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2",
+		 "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2", "f2");
+
+	my @s;
+	if ($IsSend) {
+		if ($IsServer) {
+			@s = @Magic3;
+		} else {
+			@s = @Magic2;
+		}
+	} else {
+		if ($IsServer) {
+			@s = @Magic2;
+		} else {
+			@s = @Magic3;
+		}
+	}
+
+	my $sha = Digest::SHA->new();
+	$sha->add($MasterKey);
+	foreach my $item (@SHSpad1) {
+		$sha->add(pack("H*",$item));
+	}
+	foreach my $item (@s) {
+		$sha->add(pack("H*",$item));
+	}
+	foreach my $item (@SHSpad2) {
+		$sha->add(pack("H*",$item));
+	}
+	my $digest = $sha->digest();
+	# Cut off SessionKey
+	my $SessionKey = substr($digest,0,$SessionKeyLength);
+
+	return $SessionKey;
+}
+
+
+# Function to encode a key
+sub mppe_encode_key
+{
+	my ($secret,$vector,$salt,$enckey) = @_;
+
+
+	# Ok, to do this we need the length of the key first
+	my @plain = (
+		16, # Length
+		unpack("C*",pack("a31",$enckey))
+	);
+	
+	# Create our first digest
+	my $sha = Digest::MD5->new();
+	$sha->add($secret);
+	$sha->add($vector);
+	$sha->add($salt);
+	# Unpack digest for calculation
+	my @buf = unpack("C*",$sha->digest());
+
+	# Calculate
+	for(my $i=0; $i < 16; $i++) {
+		$plain[$i] ^= $buf[$i];
+	}
+
+	# Second round
+	$sha = Digest::MD5->new();
+	$sha->add($secret);
+	# Add the values we calculated above
+	for (my $i = 0; $i < 16; $i++) {
+		$sha->add(pack("C",$plain[$i]));
+	}
+	# Unpack digest for calculation
+	@buf = unpack("C*",$sha->digest());
+
+	# Calculate
+	for (my $i = 0; $i < 16; $i++) {
+		$plain[$i+16] ^= $buf[$i];
+	}
+	# Pack salt, and result
+	my $key = pack("a2C32",$salt,@plain);
+
+	return $key;
+}
+
+
 1;
 # vim: ts=4

smradius/modules/authentication/mod_auth_pap.pm → lib/smradius/modules/authentication/mod_auth_pap.pm

 # PAP
-# Copyright (C) 2007-2009, AllWorldIT
+# Copyright (C) 2007-2015, AllWorldIT
 #
 # References:
 #	RFC1334 - PPP Authentication Protocols
@@ -80,6 +80,8 @@ sub authenticate
 
 	# Check if this is PAP authentication
 	return MOD_RES_SKIP if (!defined($encPassword));
+	# Skip MAC authentication
+	return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
 
 	$server->log(LOG_DEBUG,"[MOD_AUTH_PAP] This is a PAP authentication request");
 

lib/smradius/modules/features/mod_feature_capping.pm

+# Capping support
+# 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package smradius::modules::features::mod_feature_capping;
+
+use strict;
+use warnings;
+
+# Modules we need
+use smradius::attributes;
+use smradius::constants;
+use smradius::logging;
+use smradius::util;
+
+use AWITPT::Util;
+use List::Util qw( min );
+use MIME::Lite;
+use POSIX qw( floor );
+
+
+# Set our version
+our $VERSION = "0.0.1";
+
+
+# Load exporter
+use base qw(Exporter);
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
+);
+
+
+
+# Plugin info
+our $pluginInfo = {
+	Name => "User Capping Feature",
+	Init => \&init,
+
+	# Authentication hook
+	'Feature_Post-Authentication_hook' => \&post_auth_hook,
+
+	# Accounting hook
+	'Feature_Post-Accounting_hook' => \&post_acct_hook,
+};
+
+
+# Some constants
+my $TRAFFIC_LIMIT_ATTRIBUTE = 'SMRadius-Capping-Traffic-Limit';
+my $UPTIME_LIMIT_ATTRIBUTE = 'SMRadius-Capping-Uptime-Limit';
+
+my $TRAFFIC_TOPUP_ATTRIBUTE = 'SMRadius-Capping-Traffic-Topup';
+my $TIME_TOPUP_ATTRIBUTE = 'SMRadius-Capping-Uptime-Topup';
+
+my $config;
+
+
+
+## @internal
+# Initialize module
+sub init
+{
+	my $server = shift;
+	my $scfg = $server->{'inifile'};
+
+
+	# Defaults
+	$config->{'enable_mikrotik'} = 0;
+	$config->{'caveat_captrafzero'} = 0;
+
+	# Setup SQL queries
+	if (defined($scfg->{'mod_feature_capping'})) {
+		# Check if option exists
+		if (defined($scfg->{'mod_feature_capping'}{'enable_mikrotik'})) {
+			# Pull in config
+			if (defined(my $val = isBoolean($scfg->{'mod_feature_capping'}{'enable_mikrotik'}))) {
+				if ($val) {
+					$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Mikrotik-specific vendor return attributes ENABLED");
+					$config->{'enable_mikrotik'} = $val;
+				}
+			} else {
+				$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Value for 'enable_mikrotik' is invalid");
+			}
+		}
+		# Check if we have the caveat setting
+		if (defined(my $val = isBoolean($scfg->{'mod_feature_capping'}{'caveat_captrafzero'}))) {
+			if ($val) {
+				$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Caveat to swap '0' and -undef- for ".
+						"SMRadius-Capping-Traffic-Limit ENABLED");
+				$config->{'caveat_captrafzero'} = $val;
+			}
+		} else {
+			$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Value for 'caveat_captrafzero' is invalid");
+		}
+	}
+
+	return;
+}
+
+
+
+## @post_auth_hook($server,$user,$packet)
+# Post authentication hook
+#
+# @param server Server object
+# @param user User data
+# @param packet Radius packet
+#
+# @return Result
+sub post_auth_hook
+{
+	my ($server,$user,$packet) = @_;
+
+
+	# Skip MAC authentication
+	return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] POST AUTH HOOK");
+
+
+	#
+	# Get limits from attributes
+	#
+
+	my $uptimeLimit = _getAttributeKeyLimit($server,$user,$UPTIME_LIMIT_ATTRIBUTE);
+	my $trafficLimit = _getAttributeKeyLimit($server,$user,$TRAFFIC_LIMIT_ATTRIBUTE);
+
+	# Swap around 0 and undef if we need to apply the captrafzero caveat
+	if ($config->{'caveat_captrafzero'}) {
+		if (!defined($uptimeLimit)) {
+			$uptimeLimit = 0;
+		} elsif ($uptimeLimit == 0) {
+			$uptimeLimit = undef;
+		}
+		if (!defined($trafficLimit)) {
+			$trafficLimit = 0;
+		} elsif ($trafficLimit == 0) {
+			$trafficLimit = undef;
+		}
+	}
+
+
+	#
+	# Get current traffic and uptime usage
+	#
+
+	my $accountingUsage = _getAccountingUsage($server,$user,$packet);
+	if (!defined($accountingUsage)) {
+		return MOD_RES_SKIP;
+	}
+
+
+	#
+	# Get valid traffic and uptime topups
+	#
+
+	# Check if there was any data returned at all
+	my $uptimeTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_TOPUP_ATTRIBUTE) // 0;
+	my $trafficTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_TOPUP_ATTRIBUTE) // 0;
+
+
+	#
+	# Set the new uptime and traffic limits (limit, if any.. + topups)
+	#
+
+	# Uptime..
+	# // is a defined operator,  $a ? defined($a) : $b
+	my $uptimeLimitWithTopups = ($uptimeLimit // 0) + $uptimeTopupAmount;
+
+	# Traffic..
+	# // is a defined operator,  $a ? defined($a) : $b
+	my $trafficLimitWithTopups = ($trafficLimit // 0) + $trafficTopupAmount;
+
+
+	#
+	# Do auto-topups for both traffic and uptime
+	#
+
+	my $autoTopupTrafficAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalDataUsage'},"traffic",
+			$trafficLimitWithTopups,1);
+	if (defined($autoTopupTrafficAdded)) {
+		$trafficLimitWithTopups += $autoTopupTrafficAdded;
+	}
+
+	my $autoTopupUptimeAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalSessionTime'},"uptime",
+			$uptimeLimitWithTopups,2);
+	if (defined($autoTopupUptimeAdded)) {
+		$uptimeLimitWithTopups += $autoTopupUptimeAdded;
+	}
+
+
+	#
+	# Display our usages
+	#
+
+	_logUsage($server,$accountingUsage->{'TotalDataUsage'},$trafficLimit,$trafficTopupAmount,'traffic');
+	_logUsage($server,$accountingUsage->{'TotalSessionTime'},$uptimeLimit,$uptimeTopupAmount,'uptime');
+
+
+	#
+	# Add conditional variables
+	#
+
+	addAttributeConditionalVariable($user,"SMRadius_Capping_TotalDataUsage",$accountingUsage->{'TotalDataUsage'});
+	addAttributeConditionalVariable($user,"SMRadius_Capping_TotalSessionTime",$accountingUsage->{'TotalSessionTime'});
+
+
+	#
+	# Allow for capping overrides by attribute
+	#
+
+	if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'})) {
+		my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'}});
+
+		my $newLimit = $uptimeLimitWithTopups * $multiplier;
+		my $newSessionTime = $accountingUsage->{'TotalSessionTime'} * $multiplier;
+
+		$uptimeLimitWithTopups = $newLimit;
+		$accountingUsage->{'TotalSessionTime'} = $newSessionTime;
+
+		$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User uptime multiplier '$multiplier' changes ".
+				"uptime limit ('$uptimeLimitWithTopups' => '$newLimit'), ".
+				"uptime usage ('".$accountingUsage->{'TotalSessionTime'}."' => '$newSessionTime')"
+		);
+	}
+	if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'})) {
+		my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'}});
+
+		my $newLimit = $trafficLimitWithTopups * $multiplier;
+		my $newDataUsage = $accountingUsage->{'TotalDataUsage'} * $multiplier;
+
+		$trafficLimitWithTopups = $newLimit;
+		$accountingUsage->{'TotalDataUsage'} = $newDataUsage;
+
+		$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User traffic multiplier '$multiplier' changes ".
+				"traffic limit ('$trafficLimitWithTopups' => '$newLimit'), ".
+				"traffic usage ('".$accountingUsage->{'TotalDataUsage'}."' => '$newDataUsage')"
+		);
+	}
+
+
+	#
+	# Check if we've exceeded our limits
+	#
+
+	# Uptime...
+	if (defined($uptimeLimit)) {
+
+		# Check session time has not exceeded what we're allowed
+		if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalSessionTime'}.
+					"min exceeds allowed limit of ".$uptimeLimitWithTopups."min");
+			return MOD_RES_NACK;
+		# Setup limits
+		} else {
+			# Check if we returning Mikrotik vattributes
+			# FIXME: NK - this is not mikrotik specific
+			if ($config->{'enable_mikrotik'}) {
+				# FIXME: NK - We should cap the maximum total session time to that which is already set, if something is set
+				# Setup reply attributes for Mikrotik HotSpots
+				my %attribute = (
+					'Name' => 'Session-Timeout',
+					'Operator' => '=',
+					'Value' => $uptimeLimitWithTopups - $accountingUsage->{'TotalSessionTime'}
+				);
+				setReplyAttribute($server,$user->{'ReplyAttributes'},\%attribute);
+			}
+		}
+	}
+
+	# Traffic
+	if (defined($trafficLimit)) {
+
+		# Capped
+		if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalDataUsage'}.
+					"Mbyte exceeds allowed limit of ".$trafficLimitWithTopups."Mbyte");
+			return MOD_RES_NACK;
+		# Setup limits
+		} else {
+			# Check if we returning Mikrotik vattributes
+			if ($config->{'enable_mikrotik'}) {
+				# Get remaining traffic
+				my $remainingTraffic = $trafficLimitWithTopups - $accountingUsage->{'TotalDataUsage'};
+				my $remainingTrafficLimit = ( $remainingTraffic % 4096 ) * 1024 * 1024;
+				my $remainingTrafficGigawords = floor($remainingTraffic / 4096);
+
+				# Setup reply attributes for Mikrotik HotSpots
+				foreach my $attrName ('Recv','Xmit','Total') {
+					my %attribute = (
+						'Vendor' => 14988,
+						'Name' => "Mikrotik-$attrName-Limit",
+						'Operator' => '=',
+						# Gigawords leftovers
+						'Value' => $remainingTrafficLimit
+					);
+					setReplyVAttribute($server,$user->{'ReplyVAttributes'},\%attribute);
+
+					%attribute = (
+						'Vendor' => 14988,
+						'Name' => "Mikrotik-$attrName-Limit-Gigawords",
+						'Operator' => '=',
+						# Gigawords
+						'Value' => $remainingTrafficGigawords
+					);
+					setReplyVAttribute($server,$user->{'ReplyVAttributes'},\%attribute);
+				}
+			}
+		}
+	}
+
+	return MOD_RES_ACK;
+}
+
+
+
+## @post_acct_hook($server,$user,$packet)
+# Post authentication hook
+#
+# @param server Server object
+# @param user User data
+# @param packet Radius packet
+#
+# @return Result
+sub post_acct_hook
+{
+	my ($server,$user,$packet) = @_;
+
+
+	# We cannot cap a user if we don't have a UserDB module can we? no userdb, no cap?
+	return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
+
+	# Skip MAC authentication
+	return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
+
+	# User is either connecting 'START' or disconnecting 'STOP'
+	return MOD_RES_SKIP if ($packet->rawattr('Acct-Status-Type') ne "1" && $packet->rawattr('Acct-Status-Type') ne "3");
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] POST ACCT HOOK");
+
+
+	#
+	# Get limits from attributes
+	#
+
+	my $uptimeLimit = _getAttributeKeyLimit($server,$user,$UPTIME_LIMIT_ATTRIBUTE);
+	my $trafficLimit = _getAttributeKeyLimit($server,$user,$TRAFFIC_LIMIT_ATTRIBUTE);
+
+	# Swap around 0 and undef if we need to apply the captrafzero caveat
+	if ($config->{'caveat_captrafzero'}) {
+		if (!defined($uptimeLimit)) {
+			$uptimeLimit = 0;
+		} elsif ($uptimeLimit == 0) {
+			$uptimeLimit = undef;
+		}
+		if (!defined($trafficLimit)) {
+			$trafficLimit = 0;
+		} elsif ($trafficLimit == 0) {
+			$trafficLimit = undef;
+		}
+	}
+
+	#
+	# Get current traffic and uptime usage
+	#
+	#
+	my $accountingUsage = _getAccountingUsage($server,$user,$packet);
+	if (!defined($accountingUsage)) {
+		return MOD_RES_SKIP;
+	}
+
+
+	#
+	# Get valid traffic and uptime topups
+	#
+
+	# Check if there was any data returned at all
+	my $uptimeTopupAmount = _getConfigAttributeNumeric($server,$user,$TIME_TOPUP_ATTRIBUTE) // 0;
+	my $trafficTopupAmount = _getConfigAttributeNumeric($server,$user,$TRAFFIC_TOPUP_ATTRIBUTE) // 0;
+
+
+	#
+	# Set the new uptime and traffic limits (limit, if any.. + topups)
+	#
+
+	# Uptime..
+	# // is a defined operator,  $a ? defined($a) : $b
+	my $uptimeLimitWithTopups = ($uptimeLimit // 0) + $uptimeTopupAmount;
+
+	# Traffic..
+	# // is a defined operator,  $a ? defined($a) : $b
+	my $trafficLimitWithTopups = ($trafficLimit // 0) + $trafficTopupAmount;
+
+
+	#
+	# Do auto-topups for both traffic and uptime
+	#
+
+	my $autoTopupTrafficAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalDataUsage'},"traffic",
+			$trafficLimitWithTopups,1);
+	if (defined($autoTopupTrafficAdded)) {
+		$trafficLimitWithTopups += $autoTopupTrafficAdded;
+	}
+
+	my $autoTopupUptimeAdded = _doAutoTopup($server,$user,$accountingUsage->{'TotalSessionTime'},"uptime",
+			$uptimeLimitWithTopups,2);
+	if (defined($autoTopupUptimeAdded)) {
+		$uptimeLimitWithTopups += $autoTopupUptimeAdded;
+	}
+
+
+	#
+	# Display our usages
+	#
+
+	_logUsage($server,$accountingUsage->{'TotalDataUsage'},$trafficLimit,$trafficTopupAmount,'traffic');
+	_logUsage($server,$accountingUsage->{'TotalSessionTime'},$uptimeLimit,$uptimeTopupAmount,'uptime');
+
+
+	#
+	# Add conditional variables
+	#
+
+	# Add attribute conditionals BEFORE override
+	addAttributeConditionalVariable($user,"SMRadius_Capping_TotalDataUsage",$accountingUsage->{'TotalDataUsage'});
+	addAttributeConditionalVariable($user,"SMRadius_Capping_TotalSessionTime",$accountingUsage->{'TotalSessionTime'});
+
+
+	#
+	# Allow for capping overrides by user attribute
+	#
+
+	if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'})) {
+		my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Uptime-Multiplier'}});
+		my $newLimit = $uptimeLimitWithTopups * $multiplier;
+		$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User cap uptime multiplier '$multiplier' changes limit ".
+				"from '$uptimeLimitWithTopups' to '$newLimit'");
+		$uptimeLimitWithTopups = $newLimit;
+	}
+	if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'})) {
+		my $multiplier = pop(@{$user->{'ConfigAttributes'}->{'SMRadius-Config-Capping-Traffic-Multiplier'}});
+		my $newLimit = $trafficLimitWithTopups * $multiplier;
+		$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] User cap traffic multiplier '$multiplier' changes limit ".
+				"from '$trafficLimitWithTopups' to '$newLimit'");
+		$trafficLimitWithTopups = $newLimit;
+	}
+
+
+	#
+	# Check if we've exceeded our limits
+	#
+
+	# Uptime..
+	if (defined($uptimeLimit)) {
+
+		# Capped
+		if ($accountingUsage->{'TotalSessionTime'} >= $uptimeLimitWithTopups) {
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalSessionTime'}.
+					"min exceeds allowed limit of ".$uptimeLimitWithTopups."min");
+			return MOD_RES_NACK;
+		}
+	}
+
+	# Traffic
+	if (defined($trafficLimit)) {
+
+		# Capped
+		if ($accountingUsage->{'TotalDataUsage'} >= $trafficLimitWithTopups) {
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Usage of ".$accountingUsage->{'TotalDataUsage'}.
+					"Mbyte exceeds allowed limit of ".$trafficLimitWithTopups."Mbyte");
+			return MOD_RES_NACK;
+		}
+	}
+
+	return MOD_RES_ACK;
+}
+
+
+
+## @internal
+# Code snippet to grab the current attribute key limit by processing the user attributes
+sub _getAttributeKeyLimit
+{
+	my ($server,$user,$attributeKey) = @_;
+
+
+	# Short circuit return if we don't have the uptime key set
+	return if (!defined($user->{'Attributes'}->{$attributeKey}));
+
+	# Short circuit if we do not have a valid attribute operator: ':='
+	if (!defined($user->{'Attributes'}->{$attributeKey}->{':='})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] No valid operators for attribute '".
+				$user->{'Attributes'}->{$attributeKey}."'");
+		return;
+	}
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Attribute '".$attributeKey."' is defined");
+
+	# Check for valid attribute value
+	if (!defined($user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}) ||
+			$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'} !~ /^\d+$/) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Attribute '".$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}.
+				"' is NOT a numeric value");
+		return;
+	}
+
+	return $user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'};
+}
+
+
+
+## @internal
+# Code snippet to grab the current accounting usage of a user
+sub _getAccountingUsage
+{
+	my ($server,$user,$packet) = @_;
+
+
+	foreach my $module (@{$server->{'module_list'}}) {
+		# Do we have the correct plugin?
+		if (defined($module->{'Accounting_getUsage'})) {
+			$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Found plugin: '".$module->{'Name'}."'");
+			# Fetch users session uptime & bandwidth used
+			if (my $res = $module->{'Accounting_getUsage'}($server,$user,$packet)) {
+				return $res;
+			}
+			$server->log(LOG_ERR,"[MOD_FEATURE_CAPPING] No usage data found for user '".$user->{'Username'}."'");
+		}
+	}
+
+	return;
+}
+
+
+
+## @internal
+# Code snippet to log our uptime usage
+sub _logUsage
+{
+	my ($server,$accountingUsage,$limit,$topupAmount,$type) = @_;
+
+
+	my $typeKey = ucfirst($type);
+
+	# Check if our limit is defined
+	if (defined($limit) && $limit == 0) {
+		$limit = '-topup-';
+	} else {
+		$limit = '-none-';
+	}
+
+	$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Capping information [type: %s, total: %s, limit: %s, topups: %s]",
+			$type,$accountingUsage,$limit,$topupAmount);
+
+	return;
+}
+
+
+
+## @internal
+# Function snippet to return a user attribute
+sub _getConfigAttributeNumeric
+{
+	my ($server,$user,$attributeName) = @_;
+
+
+	# Short circuit if the attribute does not exist
+	return 0 if (!defined($user->{'ConfigAttributes'}->{$attributeName}));
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] Config attribute '".$attributeName."' is defined");
+	# Check for value
+	if (!defined($user->{'ConfigAttributes'}->{$attributeName}->[0])) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Config attribute '".$attributeName."' has no value");
+		return 0;
+	}
+
+	# Is it a number?
+	if ($user->{'ConfigAttributes'}->{$attributeName}->[0] !~ /^\d+$/) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] Config attribute '".$user->{'ConfigAttributes'}->{$attributeName}->[0].
+				"' is NOT a numeric value");
+		return 0;
+	}
+
+	return $user->{'ConfigAttributes'}->{$attributeName}->[0];
+}
+
+
+
+## @internal
+# Function snippet to return a attribute
+sub _getAttribute
+{
+	my ($server,$user,$attributeName) = @_;
+
+
+	# Check the attribute exists
+	return if (!defined($user->{'Attributes'}->{$attributeName}));
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' is defined");
+
+	# Check the required operator is present in this case :=
+	if (!defined($user->{'Attributes'}->{$attributeName}->{':='})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no ':=' operator");
+		return;
+	}
+
+	# Check the operator value is defined...
+	if (!defined($user->{'Attributes'}->{$attributeName}->{':='}->{'Value'})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no value");
+		return;
+	}
+
+	return $user->{'Attributes'}->{$attributeName}->{':='}->{'Value'};
+}
+
+
+
+## @internal
+# Function which impelments our auto-topup functionality
+sub _doAutoTopup
+{
+	my ($server,$user,$accountingUsage,$type,$usageLimit,$topupType) = @_;
+	my $scfg = $server->{'inifile'};
+
+
+	# Get the key, which has the first letter uppercased
+	my $typeKey = ucfirst($type);
+
+	# Booleanize the attribute and check if its enabled
+	if (my $enabled = booleanize(_getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Enabled"))) {
+		$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups for %s is enabled',$type);
+	} else {
+		$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] AutoTopups for %s is not enabled',$type);
+		return;
+	}
+
+	# Do sanity checks on the auto-topup amount
+	my $autoTopupAmount = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Amount");
+	if (!defined($autoTopupAmount)) {
+		$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Amount must have a value',$typeKey);
+		return;
+	}
+	if (!isNumber($autoTopupAmount)){
+		$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Amount must be a number and be > 0, instead it was '.
+				'\'%s\', IGNORING SMRadius-AutoTopup-%s-Enabled',$typeKey,$autoTopupAmount,$typeKey);
+		return;
+	}
+
+	# Do sanity checks on the auto-topup threshold
+	my $autoTopupThreshold = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Threshold");
+	if (defined($autoTopupThreshold) && !isNumber($autoTopupThreshold)){
+		$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Threshold must be a number and be > 0, instead it was '.
+				'\'%s\', IGNORING SMRadius-AutoTopup-%s-Threshold',$typeKey,$autoTopupAmount,$typeKey);
+		$autoTopupThreshold = undef;
+	}
+
+	# Check that if the auto-topup limit is defined, that it is > 0
+	my $autoTopupLimit = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Limit");
+	if (defined($autoTopupLimit) && !isNumber($autoTopupLimit)) {
+		$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s-Limit must be a number and be > 0, instead it was '.
+				'\'%s\', IGNORING SMRadius-AutoTopup-%s-Enabled',$typeKey,$autoTopupAmount,$typeKey);
+		return;
+	}
+
+	# Pull in ahow many auto-topups were already added
+	my $autoTopupsAdded = _getConfigAttributeNumeric($server,$user,"SMRadius-Capping-$typeKey-AutoTopup") // 0;
+
+	# Default to an auto-topup threshold of the topup amount divided by two if none has been provided
+	$autoTopupThreshold //= floor($autoTopupAmount / 2);
+
+	# Check if we're still within our usage limit and return
+	if (($usageLimit + $autoTopupsAdded - $accountingUsage) > $autoTopupThreshold) {
+		$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s: CHECK => usageLimit(%s) + autoTopupsAdded(%s) - '.
+				'accountingUsage(%s) < autoTopupThreshold(%s) = not eligble for auto-topup yet',$typeKey,
+				$usageLimit,$autoTopupsAdded,$accountingUsage,$autoTopupThreshold);
+		return;
+	} else {
+		$server->log(LOG_DEBUG,'[MOD_FEATURE_CAPPING] SMRadius-AutoTopup-%s: CHECK => usageLimit(%s) + autoTopupsAdded(%s) - '.
+				'accountingUsage(%s) < autoTopupThreshold(%s) = eligble, processing',$typeKey,
+				$usageLimit,$autoTopupsAdded,$accountingUsage,$autoTopupThreshold);
+	}
+
+	# Check the difference between our accounting usage and our usage limit
+	my $usageDelta = $accountingUsage - $usageLimit;
+	# Make sure our delta is at least 0
+	$usageDelta = 0 if ($usageDelta < 0);
+
+	# Calculate how many topups are needed
+	my $autoTopupsRequired = floor($usageDelta / $autoTopupAmount) + 1;
+
+	# Default the topups to add to the number required
+	my $autoTopupsToAdd = $autoTopupsRequired;
+
+	# If we have an auto-topup limit, recalculate how many we must add... maybe it exceeds
+	if (defined($autoTopupLimit)) {
+		my $autoTopupsAllowed = floor(($autoTopupLimit - $autoTopupsAdded) / $autoTopupAmount);
+		$autoTopupsToAdd = min($autoTopupsRequired,$autoTopupsAllowed);
+		# We cannot add a negative amount of auto-topups, if we have a negative amount, we have hit our limit
+		$autoTopupsToAdd = 0 if ($autoTopupsToAdd < 0);
+	}
+
+	# Total topup amount
+	my $autoTopupsToAddAmount = $autoTopupsToAdd * $autoTopupAmount;
+
+	# The datetime now
+	my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
+	# Use truncate to set all values after 'month' to their default values
+	my $thisMonth = $now->clone()->truncate( to => "month" );
+	# This month, in string form
+	my $thisMonth_str = $thisMonth->strftime("%Y-%m-%d");
+	# Next month..
+	my $nextMonth = $thisMonth->clone()->add( months => 1 );
+	my $nextMonth_str = $nextMonth->strftime("%Y-%m-%d");
+
+	# Lets see if a module accepts to add a topup
+	my $res;
+	foreach my $module (@{$server->{'module_list'}}) {
+		# Do we have the correct plugin?
+		if (defined($module->{'Feature_Config_Topop_add'})) {
+			$server->log(LOG_INFO,"[MOD_FEATURE_CAPPING] Found plugin: '".$module->{'Name'}."'");
+			# Try add topup
+			$res = $module->{'Feature_Config_Topop_add'}($server,$user,$thisMonth_str,$nextMonth_str,
+					($topupType | 4),$autoTopupAmount);
+			# Skip to end if we added a topup
+			if ($res == MOD_RES_ACK) {
+				my $topupsRemaining = $autoTopupsToAdd - 1;
+				while ($topupsRemaining > 0) {
+					# Try add another topup
+					$res = $module->{'Feature_Config_Topop_add'}($server,$user,$thisMonth_str,$nextMonth_str,
+							($topupType | 4),$autoTopupAmount);
+					$topupsRemaining--;
+				}
+				last;
+			}
+		}
+	}
+	# If not, return undef
+	if (!defined($res) || $res != MOD_RES_ACK) {
+		$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] Auto-Topup(s) cannot be added, no module replied with ACK');
+		return;
+	}
+
+	$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] Auto-Topups added [type: %s, threshold: %s, amount: %s, required: %s, limit: %s, added: %s]',
+			$type,$autoTopupThreshold,$autoTopupAmount,$autoTopupsRequired,$autoTopupLimit,$autoTopupsToAdd);
+
+	# Grab notify destinations
+	my $notify;
+	if (!defined($notify = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-Notify"))) {
+		$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify destination is not specified, NOT notifying');
+		goto END;
+	}
+	$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify destination is \'%s\'',$notify);
+
+	# Grab notify template
+	my $notifyTemplate;
+	if (!defined($notifyTemplate = _getAttribute($server,$user,"SMRadius-AutoTopup-$typeKey-NotifyTemplate"))) {
+		$server->log(LOG_INFO,'[MOD_FEATURE_CAPPING] AutoTopups notify template is not specified, NOT notifying');
+		goto END;
+	}
+
+	# NOTE: $autoTopupToAdd and autoTopupsToAddAmount will be 0 if no auto-topups were added
+
+	# Create variable hash to pass to TT
+	my $variables = {
+		'user' => {
+			'ID' => $user->{'ID'},
+			'username' => $user->{'Username'},
+		},
+		'usage' => {
+			'total' => $accountingUsage,
+			'limit' => $usageLimit,
+		},
+		'autotopup' => {
+			'amount' => $autoTopupAmount,
+			'limit' => $autoTopupLimit,
+			'added' => $autoTopupsAdded,
+			'toAdd' => $autoTopupsToAdd,
+			'toAddAmount' => $autoTopupsToAddAmount,
+		},
+	};
+
+	# Split off notification targets
+	my @notificationTargets = split(/[,;\s]+/,$notify);
+
+	foreach my $notifyTarget (@notificationTargets) {
+		# Parse template
+		my ($notifyMsg,$error) = quickTemplateToolkit($notifyTemplate,{
+				%{$variables},
+				'notify' => { 'target' => $notifyTarget }
+		});
+
+		# Check if we have a result, if not, report the error
+		if (!defined($notifyMsg)) {
+			my $errorMsg = $error->info();
+			$errorMsg =~ s/\r?\n/\\n/g;
+			$server->log(LOG_WARN,'[MOD_FEATURE_CAPPING] AutoTopups notify template parsing failed: %s',$errorMsg);
+			next;
+		}
+
+		my %messageHeaders = ();
+
+		# Split message into lines
+		my @lines = split(/\r?\n/,$notifyMsg);
+		while (defined($lines[0]) && (my $line = $lines[0]) =~ /(\S+): (.*)/) {
+			my ($header,$value) = ($1,$2);
+			$messageHeaders{$header} = $value;
+			# Remove line
+			shift(@lines);
+			# Last if our next line is undefined
+			last if (!defined($lines[0]));
+			# If the next line is blank, remove it, and continue below
+			if ($lines[0] =~ /^\s*$/) {
+				# Remove blank line
+				shift(@lines);
+				last;
+			}
+		}
+
+		# Create message
+		my $msg = MIME::Lite->new(
+			'Type' => 'multipart/mixed',
+			'Date' => $now->strftime('%a, %d %b %Y %H:%M:%S %z'),
+			%messageHeaders
+		);
+
+		# Attach body
+		$msg->attach(
+			'Type' => 'TEXT',
+			'Encoding' => '8bit',
+			'Data' => join("\n",@lines),
+		);
+
+		# Send email
+		my $smtpServer = $scfg->{'server'}{'smtp_server'} // 'localhost';
+		eval { $msg->send("smtp",$smtpServer); };
+		if (my $error = $@) {
+			$server->log(LOG_WARN,"[MOD_FEATURE_CAPPING] Email sending failed: '%s'",$error);
+		}
+
+	}
+
+END:
+	return $autoTopupsToAddAmount;
+}
+
+
+
+1;
+# vim: ts=4