dicts/dictionary.valemount

-#
-#       Valemount Networks Corporation specific radius attributes
-#       networks@valemount.com
-#
-#	$Id: dictionary.valemount,v 1.1 2006/11/14 17:44:59 lem Exp $
-#
-
-VENDOR	  ValemountNetworks	16313
-
-# Rates to give PPPoE customers, can be used in Authentication replies,
-# in bits/s
-ATTRIBUTE VNC-PPPoE-CBQ-RX		1	integer ValemountNetworks
-ATTRIBUTE VNC-PPPoE-CBQ-TX		2	integer ValemountNetworks
-
-# Fallback support for each direction. (1 / 0)
-ATTRIBUTE VNC-PPPoE-CBQ-RX-Fallback	3	integer ValemountNetworks
-ATTRIBUTE VNC-PPPoE-CBQ-TX-Fallback	4	integer ValemountNetworks
-
-ATTRIBUTE VNC-Splash			10	integer ValemountNetworks
-
-VALUE	VNC-Splash	Show		1
-VALUE	VNC-Splash	No-Show		0
-

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-2010, 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,13 +63,34 @@ 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,$nattributes,$vattributes,$attribute)
+## @fn addAttribute($server,$user,$attribute)
 # Function to add an attribute to $attributes
 #
 # @param server Server instance
@@ -66,13 +99,13 @@ my @attributeVReplyIgnoreList = (
 # @param attribute Attribute to add, eg. Those from a database
 sub addAttribute
 {
-	my ($server,$nattributes,$vattributes,$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 = ".niceUndef($attribute->{'Name'}).
-				", operator = ".niceUndef($attribute->{'Operator'}).", value = ".niceUndef($attribute->{'Value'}));
+		$server->log(LOG_DEBUG,"[ATTRIBUTES] Problem adding attribute with name = ".prettyUndef($attribute->{'Name'}).
+				", operator = ".prettyUndef($attribute->{'Operator'}).", value = ".prettyUndef($attribute->{'Value'}));
 		return;
 	}
 
@@ -80,12 +113,12 @@ sub addAttribute
 	$attribute->{'Name'} =~ s/\s*(\S+)\s*/$1/;
 	$attribute->{'Operator'} =~ s/\s*(\S+)\s*/$1/;
 
-	# Grab attribue name, operator and value
+	# 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 = $nattributes;
+	my $attributes = $user->{'Attributes'};
 
 	# Check where we must add this attribute, maybe to the vendor attributes?
 	if ($name =~ /^\[(\d+):(\S+)\]$/) {
@@ -95,7 +128,7 @@ sub addAttribute
 		# Reset attribute name
 		$attribute->{'Name'} = $name;
 		# Set the attributes to use to the vendor
-		$attributes = $vattributes;
+		$attributes = $user->{'VAttributes'};
 	}
 
 	# Check if this is an array
@@ -118,6 +151,9 @@ sub addAttribute
 	} else {
 		$attributes->{$name}->{$operator} = $attribute;
 	}
+
+	# Process the item incase its a config attribute
+	return processConfigAttribute($server,$user,$attribute);
 }
 
 
@@ -130,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
@@ -153,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;
@@ -178,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) {
@@ -196,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;
@@ -210,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;
@@ -224,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;
@@ -238,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;
@@ -252,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;
 			}
 
@@ -266,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;
@@ -280,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;
@@ -295,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;
@@ -307,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: :=
@@ -320,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 {
@@ -403,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
@@ -418,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 '+=') {
@@ -429,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;
@@ -468,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)."'");
 
 
@@ -498,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
@@ -513,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 '+=') {
@@ -535,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
@@ -543,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;
@@ -557,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: :=
 	#
@@ -579,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;
 }
 
 
@@ -615,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

smradius/config.pm → lib/smradius/config.pm

 # SMRadius config information
-# Copyright (C) 2007-2010, 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
@@ -24,13 +24,14 @@ use strict;
 use warnings;
 
 # Exporter stuff
-require Exporter;
-our (@ISA,@EXPORT);
-@ISA = qw(Exporter);
-@EXPORT = qw(
+use base qw(Exporter);
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
 );
 
 
+use AWITPT::Util;
 use smradius::logging;
 
 
@@ -68,22 +69,55 @@ sub Init
 	} else {
 		$server->{'smradius'}{'event_timezone'} = "GMT";
 	}
-		
+
 	# Should we use the packet timestamp?
-	if (defined($config->{'server'}{'use_packet_timestamp'})) {
-		if ($config->{'server'}{'use_packet_timestamp'} =~ /^\s*(yes|true|1)\s*$/i) {
-			$server->{'smradius'}{'use_packet_timestamp'} = 1;
-		} elsif ($config->{'server'}{'use_packet_timestamp'} =~ /^\s*(no|false|0)\s*$/i) {
-			$server->{'smradius'}{'use_packet_timestamp'} = 0;
+	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;
 }
 
 

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

 # SMRadius Constants
-# Copyright (C) 2007-2010, 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,22 +20,23 @@
 ## @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
 
-	UINT_MAX
+	GIGAWORD_VALUE
 );
 @EXPORT_OK = ();
 
@@ -47,8 +48,8 @@ use constant {
 	MOD_RES_SKIP => 0,
 	MOD_RES_ACK => 1,
 	MOD_RES_NACK => 2,
-	
-	UINT_MAX => 2**32
+
+	GIGAWORD_VALUE => 2**32,
 };
 
 

smradiusd → lib/smradius/daemon.pm

-#!/usr/bin/perl
 # Radius daemon
-# Copyright (C) 2007-2010, 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,38 +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;
+}
+
+# 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 base qw(Net::Server::PreFork);
-use Config::IniFiles;
-use DateTime;
-use Getopt::Long;
+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;
 
 
 
@@ -69,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 ];
@@ -86,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'}) {
@@ -178,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 {
@@ -199,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 {
@@ -220,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 {
@@ -238,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 {
@@ -259,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 {
@@ -281,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 {
@@ -294,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;
 }
 
 
@@ -308,6 +386,8 @@ sub post_configure_hook {
 	my $config = $self->{'config'};
 
 
+	$self->log(LOG_NOTICE,"[SMRADIUS] SMRadius - v$VERSION");
+
 	# Init config
 	$self->log(LOG_INFO,"[SMRADIUS] Initializing configuration...");
 	smradius::config::Init($self);
@@ -315,13 +395,13 @@ sub post_configure_hook {
 
 	# Load dictionaries
 	$self->log(LOG_INFO,"[SMRADIUS] Initializing dictionaries...");
-	my $dict = new Radius::Dictionary;
+	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_INFO,"[SMRADIUS] Dictionaries initialized.");
 	# Store the dictionary
@@ -335,10 +415,12 @@ 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 {
@@ -349,9 +431,15 @@ sub post_configure_hook {
 
 	$self->log(LOG_INFO,"[SMRADIUS] Initializing system modules.");
 	# Init caching engine
-#	awitpt::cache::Init($self);
+	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;
 }
 
 
@@ -380,6 +468,7 @@ sub plugin_register {
 }
 
 
+
 # Initialize child
 sub child_init_hook
 {
@@ -389,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'}) {
@@ -399,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;
 }
 
 
@@ -425,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;
@@ -439,20 +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;
 	}
 
-	# Profiling...
+	# Very first timer ...
 	my $timer0 = [gettimeofday];
 
-	# Parse packet
-	my $pkt = new Radius::Packet($self->{'radius'}->{'dictionary'},$udp_packet);
+	# Grab NOW()
+	my $now = time();
 
 	# VERIFY SOURCE SERVER
 	$self->log(LOG_DEBUG,"[SMRADIUS] Packet From = > ".$server->{'peeraddr'});
@@ -480,7 +573,7 @@ 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_WARN,"[SMRADIUS] Client BYPASS timeout exceeded, reconnecting...");
@@ -493,50 +586,85 @@ sub process_request {
 	}
 
 	# Setup database handle
-	awitpt::db::dblayer::setHandle($self->{'client'}->{'dbh'});
+	AWITPT::DB::DBLayer::setHandle($self->{'client'}->{'dbh'});
+
 
-	# Log line to use with logging
-	my $logLine = ""; my $logReason = "UNKNOWN";
-	foreach my $attr ($pkt->attributes) {
-		$logLine .= " $attr: '".$pkt->rawattr($attr)."',";
+	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;
 	}
-	chop($logLine);
-
-	# Main user hash with everything in
-	my $user;
-	$user->{'ConfigAttributes'} = {};
-	$user->{'ReplyAttributes'} = {};
-	$user->{'ReplyVAttributes'} = {};
-
-	# Private data
-	# Where we going to get the timestamp to use from?, from the packet, if its there, or from ourselves
-	if (defined($pkt->rawattr('Event-Timestamp')) && $self->{'smradius'}->{'use_packet_timestamp'}) {
-		$user->{'_Internal'}->{'Timestamp-Unix'} = $pkt->rawattr('Event-Timestamp');
-	} else {
-		$user->{'_Internal'}->{'Timestamp-Unix'} = time();
+
+	$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);
 	}
 
-	# VERY IMPORTANT!!!!!!
-	# Timestamp AND Timestamp-Unix are in the CONVERTED timezone (event_timezone)
-	my $eventTimestamp = DateTime->from_epoch(
-			epoch => $user->{'_Internal'}->{'Timestamp-Unix'},
-			time_zone => $self->{'smradius'}->{'event_timezone'} 
-	);
-	$user->{'_Internal'}->{'Timestamp'} = $eventTimestamp->strftime('%Y-%m-%d %H:%M:%S');
+	# Username should always be defined?
+	if (!$request->hasUsername()) {
+		$self->log(LOG_NOTICE,"[SMRADIUS] Packet with no username from ".$server->{'peeraddr'});
+		return;
+	}
 
-	# Set username
-	$user->{'Username'} = $pkt->attr('User-Name');
+
+	# 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
@@ -550,42 +678,74 @@ sub process_request {
 
 			# Check if we got a positive result back
 			} elsif ($res == MOD_RES_ACK) {
-				$self->log(LOG_INFO,"[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_INFO,"[SMRADIUS] CONFIG: Configuration rejection when using '".$module->{'Name'}."'");
+				$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Configuration rejection when using '".$module->{'Name'}."'");
 				$logReason = "Config Rejected";
-				goto CHECK_RESULT;
+
+				# 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") {
 
-		#
-		# 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)) {
@@ -598,14 +758,16 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_INFO,"[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_INFO,"[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;
 
@@ -615,24 +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->{'Attributes'};
-				$user->{'VAttributes'} = $res->{'VAttributes'};
+			if ($res) {
+				$self->log(LOG_WARN,"[SMRADIUS] GET: Error returned from '".$user->{'_UserDB'}->{'Name'}.
+						"' for username '".$user->{'Username'}."'");
 			}
 		}
 
@@ -640,7 +819,7 @@ 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
@@ -654,32 +833,25 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_INFO,"[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_INFO,"[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);
 
@@ -694,112 +866,181 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_INFO,"[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_INFO,"[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'});
 
-			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
+			# Set packet identifier
+			$coaReq->set_identifier( $$ & 0xff );
 
-			$resp->set_code('Disconnect-Request');
-			my $id = $$ & 0xff;
-			$resp->set_identifier( $id );
+			# 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);
+			}
 
-			$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'));
+			# 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
-			$logLine .= ". REPLY => ";
-			foreach my $attr ($resp->attributes) {
-				$logLine .= " $attr: '".$resp->rawattr($attr)."',";
+			$request->addLogLine(". REPLY => ");
+			foreach my $attrName ($coaReq->attributes) {
+				$request->addLogLine(
+					"%s: '%s'",
+					$attrName,
+					$coaReq->rawattr($attrName)
+				);
 			}
-			chop($logLine);
 
-			# Grab packet
-			$udp_packet = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
+			# Generate coaReq packet
+			my $coaReq_packet = auth_resp($coaReq->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));
 
-			# Check for POD Servers and send disconnect
+			# 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 address format
-				foreach my $podServerAttribute (@{$user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'}}) {
-					# Check for valid IP
-					if ($podServerAttribute =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/) {
-						my $podServer = $1;
-
-						# If we have a port, use it, otherwise use default 1700
-						my $podServerPort;
-						if ($podServerAttribute =~ /:([0-9]+)$/) {
-							$podServerPort = $1;
-						} else {
-							$podServerPort = 1700;
-						}
-
-						$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying PODServer => IP: '".$podServer."' Port: '".$podServerPort."'");
-
-						# Create socket to send packet out on
-						my $podServerTimeout = "10";  # 10 second timeout
-						my $podSock = new IO::Socket::INET(
-								PeerAddr => $podServer,
-								PeerPort => $podServerPort,
-								Type => SOCK_DGRAM,
-								Proto => 'udp',
-								TimeOut => $podServerTimeout,
-						);
-
-						if (!$podSock) {
-							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send POD on");
-							next;
-						}
-
-						# Check if we sent the packet...
-						if (!$podSock->send($udp_packet)) {
-							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on socket");
-							next;
-						}
-
-						# Once sent, we need to get a response back
-						my $sh = new IO::Select($podSock);
-						if (!$sh) {
-							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket");
-							next;
-						}
-
-						if (!$sh->can_read($podServerTimeout)) {
-							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket");
-							next;
-						}
-
-						my $data;
-						$podSock->recv($data, 65536);
-						if (!$data) {
-							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Receive data failed");
-							$logReason = "POD Failure";
-						} else {
-							$logReason = "User POD";
-						}
-
-						#my @stuff = unpack('C C n a16 a*', $data);
-						#$self->log(LOG_DEBUG,"STUFF: ".Dumper(\@stuff));
-					} else {
-						$self->log(LOG_DEBUG,"[SMRADIUS] Invalid POD Server value: '".$podServerAttribute."'");
-					}
+			# Check for new CoA server attribute
+			if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'})) {
+				$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-CoAServer is defined");
+				@coaServers = @{$user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'}};
+			}
+
+			# If we didn't get provided a CoA server, use the peer address
+			if (!@coaServers) {
+				push(@coaServers,$server->{'peeraddr'});
+			}
+
+			# Check address format
+			foreach my $coaServer (@coaServers) {
+				# Remove IPv6 portion for now...
+				$coaServer =~ s/^::ffff://;
+				# Check for valid IP
+				my ($coaServerIP,$coaServerPort) = ($coaServer =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})(?::([0-9]+))?/);
+
+				if (!defined($coaServerIP)) {
+					$self->log(LOG_NOTICE,"[SMRADIUS] POST-ACCT: CoAServer '$coaServer' looks incorrect");
+					next;
+				}
+
+				# Set default CoA server port
+				$coaServerPort //= 1700;
+
+				$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '".$coaServer."' Port: '".$coaServerPort."'");
+
+				# Create socket to send packet out on
+				my $coaServerTimeout = "2";  # 2 second timeout
+				my $coaSock = IO::Socket::INET->new(
+					PeerAddr => $coaServerIP,
+					PeerPort => $coaServerPort,
+					Type => SOCK_DGRAM,
+					Proto => 'udp',
+					TimeOut => $coaServerTimeout,
+				);
+
+				if (!$coaSock) {
+					$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send CoA on: $!");
+					next;
+				}
+
+				# Check if we sent the packet...
+				if (!$coaSock->send($coaReq_packet)) {
+					$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to send data on CoA socket: $!");
+					next;
+				}
+
+				# Once sent, we need to get a response back
+				my $select = IO::Select->new($coaSock);
+				if (!$select) {
+					$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket: $!");
+					next;
+				}
+
+				if (!$select->can_read($coaServerTimeout)) {
+					$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket: $!");
+					next;
+				}
+
+				# Grab CoA response
+				my $coaRes_packet;
+				$coaSock->recv($coaRes_packet, 65536);
+				if (!$coaRes_packet) {
+					$self->log(LOG_INFO,"[SMRADIUS] POST-ACCT: No data received in response to our request to '$coaServerIP:$coaServerPort': $!");
+					$request->addLogLine(". No response to CoA/POD");
+					next;
+				}
+
+				# Parse the radius packet
+				my $coaRes = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'},$coaRes_packet);
+
+				# 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");
 				}
-			} else {
-				$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is not defined");
 			}
 		}
 
@@ -817,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;
 		}
 
@@ -827,20 +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->{'Attributes'};
-			$user->{'VAttributes'} = $res->{'VAttributes'};
 		} 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;
 		}
@@ -853,7 +1091,7 @@ 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
@@ -866,7 +1104,7 @@ sub process_request {
 
 				# Check if we got a positive result back
 				} elsif ($res == MOD_RES_ACK) {
-					$self->log(LOG_INFO,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
+					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
 					$logReason = "User Authenticated";
 					$mechanism = $module;
 					$authenticated = 1;
@@ -874,7 +1112,7 @@ sub process_request {
 
 				# Or a negative result
 				} elsif ($res == MOD_RES_NACK) {
-					$self->log(LOG_INFO,"[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;
@@ -888,7 +1126,7 @@ 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);
@@ -903,13 +1141,13 @@ sub process_request {
 
 					# Check if we got a positive result back
 					} elsif ($res == MOD_RES_ACK) {
-						$self->log(LOG_INFO,"[SMRADIUS] POST-AUTH: Passed authenticated by '".$module->{'Name'}."'");
-						$logReason = "Post Authentication Success"; 
+						$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_INFO,"[SMRADIUS] POST-AUTH: Failed authentication by '".$module->{'Name'}."'");
-						$logReason = "Post Authentication Failure"; 
+						$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;
@@ -927,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
@@ -934,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;
@@ -947,62 +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"; 
+			$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 $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);
-				}
-			}
-			foreach my $vendor (keys %replyVAttributes) {
-				# Loop with operators
-				foreach my $attrName (keys %{$replyVAttributes{$vendor}}) {
-					# Add each value
-					foreach my $value (@{$replyVAttributes{$vendor}->{$attrName}}) {
-						$resp->set_vsattr($vendor,$attrName,$value);
-					}
-				}
-			}
-	
-			# Add onto logline
-			$logLine .= ". REPLY => ";
-			foreach my $attr ($resp->attributes) {
-				$logLine .= " $attr: '".$resp->rawattr($attr)."',";
-			}
-			chop($logLine);
+			# 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"))
+			);
 
 		}
 
@@ -1010,14 +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"; 
+			$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
@@ -1026,14 +1224,35 @@ CHECK_RESULT:
 	}
 
 	# END
-	my $timer1 = [gettimeofday];
-	my $timediff = tv_interval($timer0,$timer1);
-	$self->log(LOG_NOTICE,"[SMRADIUS] Result: $logReason (${timediff}s) => $logLine");
+	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
 {
@@ -1042,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) {
@@ -1077,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);
 
@@ -1094,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-2010, 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

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

 # SQL accounting database
-# Copyright (C) 2007-2010, 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
 # 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.
@@ -22,7 +22,9 @@ use warnings;
 
 # Modules we need
 use smradius::constants;
-use awitpt::db::dblayer;
+use AWITPT::Cache;
+use AWITPT::DB::DBLayer;
+use AWITPT::Util;
 use smradius::logging;
 use smradius::util;
 
@@ -33,12 +35,10 @@ use Math::BigFloat;
 
 
 # Exporter stuff
-require Exporter;
-our (@ISA,@EXPORT,@EXPORT_OK);
-@ISA = qw(Exporter);
-@EXPORT = qw(
+use base qw(Exporter);
+our @EXPORT = qw(
 );
-@EXPORT_OK = qw(
+our @EXPORT_OK = qw(
 );
 
 
@@ -49,6 +49,7 @@ our $pluginInfo = {
 	Init => \&init,
 
 	# Cleanup run by smadmin
+	CleanupOrder => 30,
 	Cleanup => \&cleanup,
 
 	# Accounting database
@@ -108,14 +109,14 @@ sub init
 		)
 		VALUES
 		(
-			%{request.User-Name},
+			%{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.NAS-Port-Id},
 			%{request.Acct-Session-Id},
 			%{request.Framed-IP-Address},
 			%{request.Acct-Authentic},
@@ -124,34 +125,34 @@ sub init
 			%{request.NAS-Identifier},
 			%{request.NAS-IP-Address},
 			%{request.Acct-Delay-Time},
-			%{request.SessionTime},
-			%{request.InputOctets},
-			%{request.InputGigawords},
-			%{request.InputPackets},
-			%{request.OutputOctets},
-			%{request.OutputGigawords},
-			%{request.OutputPackets},
+			%{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 InputOctets,
-			SUM(AcctInputPackets) AS InputPackets,
-			SUM(AcctOutputOctets) AS OutputOctets,
-			SUM(AcctOutputPackets) AS OutputPackets,
-			SUM(AcctInputGigawords) AS InputGigawords,
-			SUM(AcctOutputGigawords) AS OutputGigawords,
-			SUM(AcctSessionTime) AS SessionTime,
+			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 = %{request.User-Name}
+			Username = %{user.Username}
 			AND AcctSessionID = %{request.Acct-Session-Id}
 			AND NASIPAddress = %{request.NAS-IP-Address}
-			AND NASPortID = %{request.NAS-Port-Id=}
+			AND NASPort = %{request.NAS-Port}
 		GROUP BY
 			PeriodKey
 		ORDER BY
@@ -162,19 +163,19 @@ sub init
 		UPDATE
 			@TP@accounting
 		SET
-			AcctSessionTime = %{query.SessionTime},
-			AcctInputOctets = %{query.InputOctets},
-			AcctInputGigawords = %{query.InputGigawords},
-			AcctInputPackets = %{query.InputPackets},
-			AcctOutputOctets = %{query.OutputOctets},
-			AcctOutputGigawords = %{query.OutputGigawords},
-			AcctOutputPackets = %{query.OutputPackets},
+			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 = %{request.User-Name}
+			Username = %{user.Username}
 			AND AcctSessionID = %{request.Acct-Session-Id}
 			AND NASIPAddress = %{request.NAS-IP-Address}
-			AND NASPortID = %{request.NAS-Port-Id=}
+			AND NASPort = %{request.NAS-Port}
 			AND PeriodKey = %{query.PeriodKey}
 	';
 
@@ -185,10 +186,10 @@ sub init
 			AcctStatusType = %{request.Acct-Status-Type},
 			AcctTerminateCause = %{request.Acct-Terminate-Cause}
 		WHERE
-			Username = %{request.User-Name}
+			Username = %{user.Username}
 			AND AcctSessionID = %{request.Acct-Session-Id}
 			AND NASIPAddress = %{request.NAS-IP-Address}
-			AND NASPortID = %{request.NAS-Port-Id=}
+			AND NASPort = %{request.NAS-Port}
 	';
 
 	$config->{'accounting_usage_query'} = '
@@ -201,20 +202,34 @@ sub init
 		FROM
 			@TP@accounting
 		WHERE
-			Username = %{request.User-Name}
+			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 = %{request.User-Name}
+			Username = %{user.Username}
 			AND AcctSessionID = %{request.Acct-Session-Id}
 			AND NASIPAddress = %{request.NAS-IP-Address}
-			AND NASPortID = %{request.NAS-Port-Id=}
+			AND NASPort = %{request.NAS-Port}
 			AND PeriodKey = %{query.PeriodKey}
 		ORDER BY
 			ID
@@ -228,6 +243,9 @@ sub init
 			ID = %{query.DuplicateID}
 	';
 
+	$config->{'accounting_usage_cache_time'} = 300;
+
+
 	# Setup SQL queries
 	if (defined($scfg->{'mod_accounting_sql'})) {
 		# Pull in queries
@@ -276,6 +294,15 @@ sub init
 				$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") {
@@ -294,41 +321,96 @@ sub init
 				$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) = @_;
+	my ($server,$user,$packet,$period) = @_;
 
 	# Build template
 	my $template;
 	foreach my $attr ($packet->attributes) {
 		$template->{'request'}->{$attr} = $packet->rawattr($attr)
 	}
-	$template->{'user'} = $user;
 
-	# Current PeriodKey
+	# 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'});
-	$template->{'query'}->{'PeriodKey'} = $now->strftime("%Y-%m");
+
+	# 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->{'accounting_usage_query'},$template);
+	my (@dbDoParams) = templateReplace($config->{$queryTemplate},$template);
 
 	# Fetch data
 	my $sth = DBSelect(@dbDoParams);
 	if (!$sth) {
-		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".awitpt::db::dblayer::Error());
+		$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();
-	$usageTotals{'TotalDataInput'} = Math::BigInt->new();
-	$usageTotals{'TotalDataOutput'} = Math::BigInt->new();
+	$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(),
@@ -345,7 +427,7 @@ sub getUsage
 		}
 		if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
 			my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
-			$inputGigawords->bmul(UINT_MAX);
+			$inputGigawords->bmul(GIGAWORD_VALUE);
 			$usageTotals{'TotalDataInput'}->badd($inputGigawords);
 		}
 		# Add output usage if we have any
@@ -354,22 +436,30 @@ sub getUsage
 		}
 		if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
 			my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
-			$outputGigawords->bmul(UINT_MAX);
+			$outputGigawords->bmul(GIGAWORD_VALUE);
 			$usageTotals{'TotalDataOutput'}->badd($outputGigawords);
 		}
 	}
 	DBFreeRes($sth);
 
 	# Convert to bigfloat for accuracy
-	my $totalData = Math::BigFloat->new();
+	my $totalData = Math::BigFloat->new(0);
 	$totalData->badd($usageTotals{'TotalDataOutput'})->badd($usageTotals{'TotalDataInput'});
-	my $totalTime = Math::BigFloat->new();
+	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();
+	$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;
 }
@@ -387,6 +477,7 @@ sub acct_log
 {
 	my ($server,$user,$packet) = @_;
 
+
 	# Build template
 	my $template;
 	foreach my $attr ($packet->attributes) {
@@ -395,8 +486,9 @@ sub acct_log
 	# Fix event timestamp
 	$template->{'request'}->{'Timestamp'} = $user->{'_Internal'}->{'Timestamp'};
 
-	# Add user
-	$template->{'user'} = $user;
+	# 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'});
@@ -405,28 +497,30 @@ sub acct_log
 	# 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 its a new period we're going to trigger START
-	my $newPeriod;
-	if ($packet->attr('Acct-Status-Type') eq "Stop" || $packet->attr('Acct-Status-Type') eq "Alive") {
+	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: ".awitpt::db::dblayer::Error());
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
 			return;
 		}
 
-		# Convert session total gigawords/octets into bytes
-		my $totalInputBytes = Math::BigInt->new();
-		$totalInputBytes->badd($template->{'request'}->{'Acct-Input-Gigawords'})->bmul(UINT_MAX);
+		# 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'});
-		my $totalOutputBytes = Math::BigInt->new();
-		$totalOutputBytes->badd($template->{'request'}->{'Acct-Output-Gigawords'})->bmul(UINT_MAX);
 		$totalOutputBytes->badd($template->{'request'}->{'Acct-Output-Octets'});
 		# Packets, no conversion
 		my $totalInputPackets = Math::BigInt->new($template->{'request'}->{'Acct-Input-Packets'});
@@ -435,24 +529,32 @@ sub acct_log
 		my $totalSessionTime = Math::BigInt->new($template->{'request'}->{'Acct-Session-Time'});
 
 		# Loop through previous records and subtract them from our session totals
-		while (my $sessionPart = $sth->fetchrow_hashref()) {
-			$sessionPart = hashifyLCtoMC(
-				$sessionPart,
-				qw(InputOctets InputPackets OutputOctets OutputPackets InputGigawords OutputGigawords SessionTime PeriodKey)
-			);
-
-			# Convert this session usage to bytes
-			my $sessionInputBytes = Math::BigInt->new();
-			$sessionInputBytes->badd($sessionPart->{'InputGigawods'})->bmul(UINT_MAX);
-			$sessionInputBytes->badd($sessionPart->{'InputOctets'});
-			my $sessionOutputBytes = Math::BigInt->new();
-			$sessionOutputBytes->badd($sessionPart->{'OutputGigawods'})->bmul(UINT_MAX);
-			$sessionOutputBytes->badd($sessionPart->{'OutputOctets'});
+		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->{'InputPackets'});
-			my $sessionOutputPackets = Math::BigInt->new($sessionPart->{'OutputPackets'});
+			my $sessionInputPackets = Math::BigInt->new($sessionPart->{'AcctInputPackets'});
+			my $sessionOutputPackets = Math::BigInt->new($sessionPart->{'AcctOutputPackets'});
 			# Finally session time
-			my $sessionSessionTime = Math::BigInt->new($sessionPart->{'SessionTime'});
+			my $sessionSessionTime = Math::BigInt->new($sessionPart->{'AcctSessionTime'});
 
 			# Check if this record is from an earlier period
 			if (defined($sessionPart->{'PeriodKey'}) && $sessionPart->{'PeriodKey'} ne $periodKey) {
@@ -471,36 +573,36 @@ sub acct_log
 		DBFreeRes($sth);
 
 		# Sanitize
-		if ($totalInputBytes->is_neg()) {	
+		if ($totalInputBytes->is_neg()) {
 			$totalInputBytes->bzero();
 		}
-		if ($totalOutputBytes->is_neg()) {	
+		if ($totalOutputBytes->is_neg()) {
 			$totalOutputBytes->bzero();
 		}
-		if ($totalInputPackets->is_neg()) {	
+		if ($totalInputPackets->is_neg()) {
 			$totalInputPackets->bzero();
 		}
-		if ($totalOutputPackets->is_neg()) {	
+		if ($totalOutputPackets->is_neg()) {
 			$totalOutputPackets->bzero();
 		}
-		if ($totalSessionTime->is_neg()) {	
+		if ($totalSessionTime->is_neg()) {
 			$totalSessionTime->bzero();
 		}
 
 		# Re-calculate
-		my ($inputGigawordsStr,$inputOctetsStr) = $totalInputBytes->bdiv(UINT_MAX);
-		my ($outputGigawordsStr,$outputOctetsStr) = $totalOutputBytes->bdiv(UINT_MAX);
+		my ($inputGigawordsStr,$inputOctetsStr) = $totalInputBytes->bdiv(GIGAWORD_VALUE);
+		my ($outputGigawordsStr,$outputOctetsStr) = $totalOutputBytes->bdiv(GIGAWORD_VALUE);
 
 		# Conversion to strings
-		$template->{'query'}->{'InputGigawords'} = $inputGigawordsStr->bstr();
-		$template->{'query'}->{'InputOctets'} = $inputOctetsStr->bstr();
-		$template->{'query'}->{'OutputGigawords'} = $outputGigawordsStr->bstr();
-		$template->{'query'}->{'OutputOctets'} = $outputOctetsStr->bstr();
+		$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'}->{'InputPackets'} = $totalInputPackets->bstr();
-		$template->{'query'}->{'OutputPackets'} = $totalOutputPackets->bstr();
+		$template->{'query'}->{'Acct-Input-Packets'} = $totalInputPackets->bstr();
+		$template->{'query'}->{'Acct-Output-Packets'} = $totalOutputPackets->bstr();
 
-		$template->{'query'}->{'SessionTime'} = $totalSessionTime->bstr();
+		$template->{'query'}->{'Acct-Session-Time'} = $totalSessionTime->bstr();
 
 
 		# Replace template entries
@@ -510,7 +612,7 @@ sub acct_log
 		$sth = DBDo(@dbDoParams);
 		if (!$sth) {
 			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting ALIVE record: ".
-					awitpt::db::dblayer::Error());
+					AWITPT::DB::DBLayer::error());
 			return MOD_RES_NACK;
 		}
 
@@ -519,7 +621,7 @@ sub acct_log
 			# 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) {
+			if ($sth > 1) {
 				fixDuplicates($server, $template);
 			}
 		}
@@ -532,17 +634,25 @@ sub acct_log
 	# Possible aswell if we are missing a start packet for this session or for the period
 	#
 
-	if ($packet->attr('Acct-Status-Type') eq "Start" || $newPeriod) {
+	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());
+					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'});
+			}
+		}
 	}
 
 
@@ -550,7 +660,7 @@ sub acct_log
 	# S T O P   P A C K E T   specifics
 	#
 
-	if ($packet->attr('Acct-Status-Type') eq "Stop") {
+	if ($packet->rawattr('Acct-Status-Type') eq "2") {
 
 		# Replace template entries
 		my @dbDoParams = templateReplace($config->{'accounting_stop_status_query'},$template);
@@ -558,11 +668,12 @@ sub acct_log
 		# Update database (status)
 		my $sth = DBDo(@dbDoParams);
 		if (!$sth) {
-			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Failed to update accounting STOP record: ".awitpt::db::dblayer::Error());
+			$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;
 }
 
@@ -579,17 +690,13 @@ sub fixDuplicates
 	# Select duplicates
 	my $sth = DBSelect(@dbDoParams);
 	if (!$sth) {
-		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".awitpt::db::dblayer::Error());
+		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
 		return;
 	}
 
 	# Pull in duplicates
 	my @IDList;
-	while (my $duplicates = $sth->fetchrow_hashref()) {
-		$duplicates = hashifyLCtoMC(
-			$duplicates,
-			qw(ID)
-		);
+	while (my $duplicates = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID))) {
 		push(@IDList,$duplicates->{'ID'});
 	}
 	DBFreeRes($sth);
@@ -606,7 +713,7 @@ sub fixDuplicates
 		# Delete duplicates
 		$sth = DBDo(@dbDoParams);
 		if (!$sth) {
-			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: ".awitpt::db::dblayer::Error());
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Database query failed: %s",AWITPT::DB::DBLayer::error());
 			DBRollback();
 			return;
 		}
@@ -624,29 +731,45 @@ sub fixDuplicates
 # Add up totals function
 sub cleanup
 {
-	my ($server) = @_;
+	my ($server,$runForDate) = @_;
 
-	# The datetime now..
-	my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
 
-	# If this is a new year
-	my ($prevYear,$prevMonth);
-	if ($now->month == 1) {
-		$prevYear = $now->year - 1;
-		$prevMonth = 12;
-	} else {
-		$prevYear = $now->year;
-		$prevMonth = $now->month - 1;
+	# 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;
 	}
 
-	# New datetime
-	my $lastMonth = DateTime->new( year => $prevYear, month => $prevMonth, day => 1 );
-	my $periodKey = $lastMonth->strftime("%Y-%m");
-	# Sanitize
-	$lastMonth = $lastMonth->ymd();
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Generating accounting summaries");
 
 	# Select totals for last month
-	my $sth = DBSelect('
+	$sth = DBSelect('
 		SELECT
 			Username,
 			AcctSessionTime,
@@ -659,12 +782,11 @@ sub cleanup
 		WHERE
 			PeriodKey = ?
 		',
-		$periodKey
+		$prevPeriodKey
 	);
-
 	if (!$sth) {
 		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to select accounting record: ".
-				awitpt::db::dblayer::Error());
+				AWITPT::DB::DBLayer::error());
 		return;
 	}
 
@@ -686,7 +808,7 @@ sub cleanup
 			}
 			if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
 				my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
-				$inputGigawords->bmul(UINT_MAX);
+				$inputGigawords->bmul(GIGAWORD_VALUE);
 				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
 			}
 			# Add output usage if we have any
@@ -695,7 +817,7 @@ sub cleanup
 			}
 			if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
 				my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
-				$outputGigawords->bmul(UINT_MAX);
+				$outputGigawords->bmul(GIGAWORD_VALUE);
 				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
 			}
 
@@ -703,9 +825,9 @@ sub cleanup
 		} else {
 
 			# Make BigInts for this user
-			$usageTotals{$row->{'Username'}}{'TotalSessionTime'} = Math::BigInt->new();
-			$usageTotals{$row->{'Username'}}{'TotalDataInput'} = Math::BigInt->new();
-			$usageTotals{$row->{'Username'}}{'TotalDataOutput'} = Math::BigInt->new();
+			$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) {
@@ -717,7 +839,7 @@ sub cleanup
 			}
 			if (defined($row->{'AcctInputGigawords'}) && $row->{'AcctInputGigawords'} > 0) {
 				my $inputGigawords = Math::BigInt->new($row->{'AcctInputGigawords'});
-				$inputGigawords->bmul(UINT_MAX);
+				$inputGigawords->bmul(GIGAWORD_VALUE);
 				$usageTotals{$row->{'Username'}}{'TotalDataInput'}->badd($inputGigawords);
 			}
 			# Add output usage if we have any
@@ -726,30 +848,14 @@ sub cleanup
 			}
 			if (defined($row->{'AcctOutputGigawords'}) && $row->{'AcctOutputGigawords'} > 0) {
 				my $outputGigawords = Math::BigInt->new($row->{'AcctOutputGigawords'});
-				$outputGigawords->bmul(UINT_MAX);
+				$outputGigawords->bmul(GIGAWORD_VALUE);
 				$usageTotals{$row->{'Username'}}{'TotalDataOutput'}->badd($outputGigawords);
 			}
 
 		}
 	}
 
-	# Begin transaction
-	DBBegin();
-
-	# Delete duplicate records
-	my @dbDoParams;
-	@dbDoParams = ('
-		DELETE FROM
-			@TP@accounting_summary
-		WHERE
-			PeriodKey = ?',
-		$lastMonth
-	);
-
-	if ($sth) {
-		# Do query
-		$sth = DBDo(@dbDoParams);
-	}
+	$server->log(LOG_NOTICE,"[MOD_ACCOUNTING_SQL] Cleanup => Creating new accounting summaries");
 
 	# Loop through users and insert totals
 	foreach my $username (keys %usageTotals) {
@@ -761,11 +867,12 @@ sub cleanup
 
 		# 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();
+		$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();
 
-		@dbDoParams = ('
+		# Do query
+		$sth = DBDo('
 			INSERT INTO
 				@TP@accounting_summary
 			(
@@ -779,31 +886,30 @@ sub cleanup
 				(?,?,?,?,?)
 			',
 			$username,
-			$lastMonth,
+			$prevPeriodKey,
 			$res->{'TotalSessionTime'},
 			$res->{'TotalDataInput'},
 			$res->{'TotalDataOutput'}
 		);
-
-		if ($sth) {
-			# Do query
-			$sth = DBDo(@dbDoParams);
+		if (!$sth) {
+			$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to create accounting summary record: ".
+					AWITPT::DB::DBLayer::error());
+			DBRollback();
+			return;
 		}
-	}
 
-	# Rollback with error if failed
-	if (!$sth) {
-		DBRollback();
-		$server->log(LOG_ERR,"[MOD_ACCOUNTING_SQL] Cleanup => Failed to insert accounting summary record: ".
-				awitpt::db::dblayer::Error());
-		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 summary updated");
+	$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-2010, 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-2010, AllWorldIT
+# Copyright (C) 2007-2015, AllWorldIT
 #
 # References:
 #	RFC1944 - PPP Challenge Handshake Authentication Protocol (CHAP)

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

-# SMRadius Utility Functions
-# Copyright (C) 2007-2010, 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::util
-# Utility functions
-package smradius::util;
+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(
-	niceUndef
-	templateReplace
-	isBoolean
+);
+@EXPORT_OK = qw(
 );
 
 
 
-## @fn niceUndef($string)
-# If string defined return 'string', or if undefined return -undef-
-#
-# @param string String to check
-#
-# @return Return 'string' if defined, or -undef- otherwise
-sub niceUndef
-{
-	my $string = shift;
-
+# Plugin info
+our $pluginInfo = {
+	Name => "MAC Authentication",
+	Init => \&init,
+	
+	# Authentication
+	Authentication_try => \&authenticate,
+};
 
-	return defined($string) ? "'$string'" : '-undef-';
-}
 
 
-## @fn templateReplace($string,$hashref)
-# Template string replacer function
-#
-# @param string String to replace template items in
-# @param hashref Hashref containing the hash of tempalte items & values
-#
-# @return String with replaced items
-sub templateReplace
+## @internal
+# Initialize module
+sub init
 {
-	my ($string,$hashref) = @_;
-
-
-	my @valueArray = ();
-
-	# Replace blanks
-	while (my ($entireMacro,$section,$item,$default) = ($string =~ /(\%{([a-z]+)\.([a-z0-9\-]+)(?:=([^}]*))?})/i )) {
-		# Replace macro with ?	
-		$string =~ s/$entireMacro/\?/;
-
-		# Get value to substitute
-		my $value = defined($hashref->{$section}->{$item}) ? $hashref->{$section}->{$item} : $default;
-
-		# Add value onto our array
-		push(@valueArray,$value);
-		
-	}
-
-	return ($string, @valueArray);
+	my $server = shift;
 }
 
 
-## @fn isBoolean($var)
-# Check if a variable is boolean
+
+## @authenticate
+# Try authenticate user
 #
-# @param var Variable to check
+# @param server Server object
+# @param user User hash
+# @param packet Radius packet
 #
-# @return 1, 0 or undef
-sub isBoolean
+# @return Result
+sub authenticate
 {
-	my $var = shift;
+	my ($server,$user,$packet) = @_;
 
 
-	# Check if we're defined
-	if (!defined($var)) {
-		return undef;
+	# This is not a MAC authentication request
+	if ($user->{'_UserDB'}->{'Name'} ne "SQL User Database (MAC authentication)") {
+		return MOD_RES_SKIP;
 	}
 
-	# Nuke whitespaces
-	$var =~ s/\s//g;
-
-	# Allow true, on, set, enabled, 1, false, off, unset, disabled, 0
-	if ($var =~ /^(?:true|on|set|enabled|1)$/i) {
-		return 1;
-	}
-	if ($var =~ /^(?:false|off|unset|disabled|0)$/i) {
-		return 0;
-	}
+	$server->log(LOG_DEBUG,"[MOD_AUTH_MACAUTH] This is a MAC authentication request");
 
-	# Invalid or unknown
-	return undef;
+	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-2010, AllWorldIT
+# Copyright (C) 2007-2015, AllWorldIT
 #
 # References: 
 #	RFC1994 - PPP Challenge Handshake Authentication Protocol (CHAP)
@@ -38,7 +38,7 @@ 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( );
 
@@ -328,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);
@@ -565,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) {
@@ -575,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) {
@@ -849,7 +849,7 @@ sub GetMasterKey
 		 "68", "65", "20", "4d", "50", "50", "45", "20", "4d",
 		 "61", "73", "74", "65", "72", "20", "4b", "65", "79");
 
-	my $sha = Digest::SHA1->new();
+	my $sha = Digest::SHA->new();
 	$sha->add($PasswordHashHash);
 	$sha->add($NTResponse);
 	foreach my $item (@Magic1) {
@@ -962,7 +962,7 @@ sub GetAsymmetricStartKey
 		}
 	}
 
-	my $sha = Digest::SHA1->new();
+	my $sha = Digest::SHA->new();
 	$sha->add($MasterKey);
 	foreach my $item (@SHSpad1) {
 		$sha->add(pack("H*",$item));

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

 # PAP
-# Copyright (C) 2007-2010, 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");