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

@@ -25,11 +25,13 @@ use warnings;
 
 # Exporter stuff
 use base qw(Exporter);
-our (@EXPORT);
-@EXPORT = qw(
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
 );
 
 
+use AWITPT::Util;
 use smradius::logging;
 
 
@@ -70,10 +72,8 @@ sub Init
 
 	# Should we use the packet timestamp?
 	if (defined($config->{'radius'}{'use_packet_timestamp'})) {
-		if ($config->{'radius'}{'use_packet_timestamp'} =~ /^\s*(yes|true|1)\s*$/i) {
-			$server->{'smradius'}{'use_packet_timestamp'} = 1;
-		} elsif ($config->{'radius'}{'use_packet_timestamp'} =~ /^\s*(no|false|0)\s*$/i) {
-			$server->{'smradius'}{'use_packet_timestamp'} = 0;
+		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");
 		}
@@ -83,10 +83,8 @@ sub Init
 
 	# Should we use abuse prevention?
 	if (defined($config->{'radius'}{'use_abuse_prevention'})) {
-		if ($config->{'radius'}{'use_abuse_prevention'} =~ /^\s*(yes|true|1)\s*$/i) {
-			$server->{'smradius'}{'use_abuse_prevention'} = 1;
-		} elsif ($config->{'radius'}{'use_abuse_prevention'} =~ /^\s*(no|false|0)\s*$/i) {
-			$server->{'smradius'}{'use_abuse_prevention'} = 0;
+		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");
 		}

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

@@ -20,14 +20,13 @@
 ## @class smradius::constants
 # SMRadius constants package
 package smradius::constants;
+use base qw(Exporter);
 
 use strict;
 use warnings;
 
 
 
-# Exporter stuff
-use base qw(Exporter);
 our (@EXPORT,@EXPORT_OK);
 @EXPORT = qw(
 	RES_OK
@@ -37,7 +36,7 @@ our (@EXPORT,@EXPORT_OK);
 	MOD_RES_NACK
 	MOD_RES_SKIP
 
-	UINT_MAX
+	GIGAWORD_VALUE
 );
 @EXPORT_OK = ();
 
@@ -50,7 +49,7 @@ use constant {
 	MOD_RES_ACK => 1,
 	MOD_RES_NACK => 2,
 
-	UINT_MAX => 2**32
+	GIGAWORD_VALUE => 2**32,
 };
 
 

smradius/daemon/request.pm → lib/smradius/daemon/request.pm

@@ -25,6 +25,13 @@ use warnings;
 use base qw{AWITPT::Object};
 
 
+use DateTime;
+use DateTime::TimeZone;
+use Try::Tiny;
+
+use smradius::Radius::Packet;
+
+
 
 # Parse radius packet
 sub parsePacket
@@ -33,7 +40,7 @@ sub parsePacket
 
 
 	# Parse the radius packet
-	$self->{'packet'} = Radius::Packet->new($dictionary,$rawPacket);
+	$self->{'packet'} = smradius::Radius::Packet->new($dictionary,$rawPacket);
 
 	# Loop with packet attribute names and add to our log line
 	$self->addLogLine("PACKET => ");
@@ -80,7 +87,7 @@ sub setTimestamp
 	# 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'},
+			time_zone => $self->{'timezone'},
 	);
 	# Set the timestamp (not in unix)
 	$self->{'user'}->{'_Internal'}->{'Timestamp'} = $eventTimestamp->strftime('%Y-%m-%d %H:%M:%S');
@@ -91,12 +98,20 @@ sub setTimestamp
 
 
 # Set internal time zone
-sub setTimeZone
+sub setTimezone
 {
-	my ($self,$timeZone) = @_;
+	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;
+	$self->{'timezone'} = $timezone_obj;
 
 	return $self;
 }
@@ -144,7 +159,7 @@ sub _init
 	$self->{'logLine'} = [ ];
 	$self->{'logLineParams'} = [ ];
 
-	$self->{'timeZone'} = "UTC";
+	$self->{'timezone'} = "UTC";
 
 	# Initialize user
 	$self->{'user'} = {

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

 # Test accounting database
-# Copyright (C) 2007-2015, 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,7 +99,10 @@ Acct-Delay-Time: %{accounting.Acct-Delay-Time}
 	foreach my $attr ($packet->attributes) {
 		$template->{'accounting'}->{$attr} = $packet->attr($attr)
 	}
-	$template->{'user'} = $user;
+
+	# 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());

lib/smradius/modules/features/mod_feature_fup.pm

+# FUP support
+# Copyright (C) 2007-2019, AllWorldIT
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+package smradius::modules::features::mod_feature_fup;
+
+use strict;
+use warnings;
+
+# Modules we need
+use smradius::attributes;
+use smradius::constants;
+use smradius::logging;
+use smradius::util;
+
+use AWITPT::Util;
+use List::Util qw( min );
+use MIME::Lite;
+use POSIX qw( floor );
+
+
+# Set our version
+our $VERSION = "0.0.1";
+
+
+# Load exporter
+use base qw(Exporter);
+our @EXPORT = qw(
+);
+our @EXPORT_OK = qw(
+);
+
+
+
+# Plugin info
+our $pluginInfo = {
+	Name => "User FUP Feature",
+	Init => \&init,
+
+	# Authentication hook
+	'Feature_Post-Authentication_hook' => \&post_auth_hook,
+
+	# Accounting hook
+	'Feature_Post-Accounting_hook' => \&post_acct_hook,
+};
+
+
+# Some constants
+my $FUP_PERIOD_ATTRIBUTE = 'SMRadius-FUP-Period';
+my $FUP_TRAFFIC_THRESHOLD_ATTRIBUTE = 'SMRadius-FUP-Traffic-Threshold';
+
+my $config;
+
+
+
+## @internal
+# Initialize module
+sub init
+{
+	my $server = shift;
+	my $scfg = $server->{'inifile'};
+
+
+	# Defaults
+	$config->{'enable_mikrotik'} = 0;
+
+	# Setup SQL queries
+	if (defined($scfg->{'mod_feature_fup'})) {
+		# Check if option exists
+		if (defined($scfg->{'mod_feature_fup'}{'enable_mikrotik'})) {
+			# Pull in config
+			if (defined(my $val = isBoolean($scfg->{'mod_feature_fup'}{'enable_mikrotik'}))) {
+				if ($val) {
+					$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Mikrotik-specific vendor return attributes ENABLED");
+					$config->{'enable_mikrotik'} = $val;
+				}
+			} else {
+				$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Value for 'enable_mikrotik' is invalid");
+			}
+		}
+	}
+
+	return;
+}
+
+
+
+## @post_auth_hook($server,$user,$packet)
+# Post authentication hook
+#
+# @param server Server object
+# @param user User data
+# @param packet Radius packet
+#
+# @return Result
+sub post_auth_hook
+{
+	my ($server,$user,$packet) = @_;
+
+
+	# Skip MAC authentication
+	return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] POST AUTH HOOK");
+
+
+	#
+	# Get threshold from attributes
+	#
+
+	my $fupPeriod = _getAttributeKeyNumeric($server,$user,$FUP_PERIOD_ATTRIBUTE);
+	my $trafficThreshold = _getAttributeKeyNumeric($server,$user,$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE);
+
+	# If we have no FUP period, skip
+	if (!defined($fupPeriod)) {
+		return MOD_RES_SKIP;
+	};
+
+	# If we have no traffic threshold, display an info message and skip
+	if (!defined($trafficThreshold)) {
+		$server->log(LOG_INFO,"[MOD_FEATURE_FUP] User has a '$FUP_PERIOD_ATTRIBUTE' defined, but NOT a ".
+			"'$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE' attribute, aborting FUP checks.");
+		return MOD_RES_SKIP;
+	};
+
+
+	#
+	# Get current traffic and uptime usage
+	#
+
+	my $accountingUsage = _getAccountingUsage($server,$user,$packet,$fupPeriod);
+	if (!defined($accountingUsage)) {
+		return MOD_RES_SKIP;
+	}
+
+
+	#
+	# Display our FUP info
+	#
+
+	_logUsage($server,$fupPeriod,$accountingUsage->{'TotalDataUsage'},$trafficThreshold);
+
+
+	#
+	# Check if the user has exceeded the FUP
+	#
+
+	my $fupExceeded = ($accountingUsage->{'TotalDataUsage'} > $trafficThreshold) ? 1 : 0;
+
+	#
+	# Add conditional variables
+	#
+
+	addAttributeConditionalVariable($user,"SMRadius_FUP",$fupExceeded);
+
+
+	return MOD_RES_ACK;
+}
+
+
+
+## @post_acct_hook($server,$user,$packet)
+# Post authentication hook
+#
+# @param server Server object
+# @param user User data
+# @param packet Radius packet
+#
+# @return Result
+sub post_acct_hook
+{
+	my ($server,$user,$packet) = @_;
+
+
+	# We cannot cap a user if we don't have a UserDB module can we? no userdb, no cap?
+	return MOD_RES_SKIP if (!defined($user->{'_UserDB'}->{'Name'}));
+
+	# Skip MAC authentication
+	return MOD_RES_SKIP if ($user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
+
+	# User is either connecting 'START' or disconnecting 'STOP'
+	return MOD_RES_SKIP if ($packet->rawattr('Acct-Status-Type') ne "1" && $packet->rawattr('Acct-Status-Type') ne "3");
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] POST ACCT HOOK");
+
+
+	#
+	# Get threshold from attributes
+	#
+
+	my $fupPeriod = _getAttributeKeyNumeric($server,$user,$FUP_PERIOD_ATTRIBUTE);
+	my $trafficThreshold = _getAttributeKeyNumeric($server,$user,$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE);
+
+	# If we have no FUP period, skip
+	if (!defined($fupPeriod)) {
+		return MOD_RES_SKIP;
+	};
+
+	# If we have no traffic threshold, display an info message and skip
+	if (!defined($trafficThreshold)) {
+		$server->log(LOG_INFO,"[MOD_FEATURE_FUP] User has a '$FUP_PERIOD_ATTRIBUTE' defined, but NOT a ".
+			"'$FUP_TRAFFIC_THRESHOLD_ATTRIBUTE' attribute, aborting FUP checks.");
+		return MOD_RES_SKIP;
+	};
+
+
+	#
+	# Get current traffic and uptime usage
+	#
+
+	my $accountingUsage = _getAccountingUsage($server,$user,$packet,$fupPeriod);
+	if (!defined($accountingUsage)) {
+		return MOD_RES_SKIP;
+	}
+
+
+	#
+	# Display our FUP info
+	#
+
+	_logUsage($server,$fupPeriod,$accountingUsage->{'TotalDataUsage'},$trafficThreshold);
+
+
+	#
+	# Check if the user has exceeded the FUP
+	#
+
+	my $fupExceeded = ($accountingUsage->{'TotalDataUsage'} > $trafficThreshold) ? 1 : 0;
+
+	#
+	# Add conditional variables
+	#
+
+	addAttributeConditionalVariable($user,"SMRadius_FUP",$fupExceeded);
+
+
+	return MOD_RES_ACK;
+}
+
+
+
+## @internal
+# Code snippet to grab the current uptime limit by processing the user attributes
+sub _getAttributeKeyNumeric
+{
+	my ($server,$user,$attributeKey) = @_;
+
+
+	# Short circuit return if we don't have the uptime key set
+	return if (!defined($user->{'Attributes'}->{$attributeKey}));
+
+	# Short circuit if we do not have a valid attribute operator: ':='
+	if (!defined($user->{'Attributes'}->{$attributeKey}->{':='})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] No valid operators for attribute '".
+				$user->{'Attributes'}->{$attributeKey}."'");
+		return;
+	}
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_FUP] Attribute '".$attributeKey."' is defined");
+
+	# Check for valid attribute value
+	if (!defined($user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}) ||
+			$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'} !~ /^\d+$/) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_FUP] Attribute '".$user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'}.
+				"' is NOT a numeric value");
+		return;
+	}
+
+	return $user->{'Attributes'}->{$attributeKey}->{':='}->{'Value'};
+}
+
+
+
+## @internal
+# Code snippet to grab the accounting usage of a user for a specific period
+sub _getAccountingUsage
+{
+	my ($server,$user,$packet,$period) = @_;
+
+
+	foreach my $module (@{$server->{'module_list'}}) {
+		# Do we have the correct plugin?
+		if (defined($module->{'Accounting_getUsage'})) {
+			$server->log(LOG_INFO,"[MOD_FEATURE_FUP] Found plugin: '".$module->{'Name'}."'");
+			# Fetch users session uptime & bandwidth used for a specific period
+			if (my $res = $module->{'Accounting_getUsage'}($server,$user,$packet,$period)) {
+				return $res;
+			}
+			$server->log(LOG_ERR,"[MOD_FEATURE_FUP] No usage data found for user '".$user->{'Username'}."'");
+		}
+	}
+
+	return;
+}
+
+
+
+## @internal
+# Code snippet to log our FUP information
+sub _logUsage
+{
+	my ($server,$period,$total,$threshold) = @_;
+
+	$server->log(LOG_INFO,"[MOD_FEATURE_FUP] FUP information [period: %s days, total: %s, threshold: %s]",
+			$period,$total,$threshold);
+
+	return;
+}
+
+
+
+## @internal
+# Function snippet to return a attribute
+sub _getAttribute
+{
+	my ($server,$user,$attributeName) = @_;
+
+
+	# Check the attribute exists
+	return if (!defined($user->{'Attributes'}->{$attributeName}));
+
+	$server->log(LOG_DEBUG,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' is defined");
+
+	# Check the required operator is present in this case :=
+	if (!defined($user->{'Attributes'}->{$attributeName}->{':='})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no ':=' operator");
+		return;
+	}
+
+	# Check the operator value is defined...
+	if (!defined($user->{'Attributes'}->{$attributeName}->{':='}->{'Value'})) {
+		$server->log(LOG_NOTICE,"[MOD_FEATURE_CAPPING] User attribute '".$attributeName."' has no value");
+		return;
+	}
+
+	return $user->{'Attributes'}->{$attributeName}->{':='}->{'Value'};
+}
+
+
+
+1;
+# vim: ts=4

smradius/modules/features/mod_feature_update_user_stats_sql.pm → lib/smradius/modules/features/mod_feature_update_user_stats_sql.pm

 # Support for updating of user stats
-# Copyright (C) 2007-2011, 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.
@@ -74,7 +74,8 @@ sub init
 			PeriodKey = %{query.PeriodKey},
 			TotalTraffic = %{query.TotalTraffic},
 			TotalUptime = %{query.TotalUptime},
-			NASIdentifier = %{request.NAS-Identifier}
+			NASIdentifier = %{request.NAS-Identifier},
+			LastAcctUpdate = now()
 		WHERE
 			Username = %{user.Username}
 	';
@@ -109,9 +110,9 @@ sub updateUserStats
 
 
 	# Skip MAC authentication
-	return MOD_RES_SKIP if (defined($user->{'_UserDB'}->{'Name'}) && 
+	return MOD_RES_SKIP if (defined($user->{'_UserDB'}->{'Name'}) &&
 			$user->{'_UserDB'}->{'Name'} eq "SQL User Database (MAC authentication)");
-	
+
 	$server->log(LOG_DEBUG,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] UPDATE USER STATS HOOK");
 
 	# Build template
@@ -119,7 +120,10 @@ sub updateUserStats
 	foreach my $attr ($packet->attributes) {
 		$template->{'request'}->{$attr} = $packet->rawattr($attr)
 	}
-	$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'});
@@ -152,7 +156,7 @@ sub updateUserStats
 	# Perform query
 	my $sth = DBDo(@dbDoParams);
 	if (!$sth) {
-		$server->log(LOG_ERR,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Database query failed: ".AWITPT::DB::DBLayer::Error());
+		$server->log(LOG_ERR,"[MOD_FEATURE_UPDATE_USER_STATS_SQL] Database query failed: ".AWITPT::DB::DBLayer::error());
 		return;
 	}
 

smradius/modules/features/mod_feature_user_stats.pm → lib/smradius/modules/features/mod_feature_user_stats.pm

@@ -147,6 +147,23 @@ sub updateUserStats
 				return MOD_RES_SKIP;
 			}
 		}
+
+		# Set user FUP state
+		# NK: Perhaps this should be moved to the mod_feature_fup module?
+		my $fupState = $user->{'AttributeConditionalVariables'}->{"SMRadius_FUP"};
+		if (defined($fupState)) {
+			$fupState = $fupState->[0];
+		} else {
+			$fupState = "-1";
+		}
+		$res = $user->{'_UserDB'}->{'Users_data_set'}($server,$user,
+				'mod_feature_fup','State',
+				$fupState
+		);
+		if (!defined($res)) {
+			$server->log(LOG_ERR,"[MOD_USERS_DATA] Failed to store FUP state for user '".$user->{'Username'}."'");
+			return MOD_RES_SKIP;
+		}
 	}
 
 	return MOD_RES_ACK;

smradius/modules/features/mod_feature_validity.pm → lib/smradius/modules/features/mod_feature_validity.pm

 # Validity support
-# Copyright (C) 2007-2011, 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.
@@ -28,12 +28,10 @@ use DateTime;
 use Date::Parse;
 
 # 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(
 );
 
 
@@ -41,7 +39,7 @@ our (@ISA,@EXPORT,@EXPORT_OK);
 our $pluginInfo = {
 	Name => "User Validity Feature",
 	Init => \&init,
-	
+
 	# Authentication hook
 	'Feature_Post-Authentication_hook' => \&checkValidity,
 	'Feature_Post-Accounting_hook' => \&checkValidity
@@ -148,15 +146,15 @@ sub checkValidity
 	if (defined($validFrom)) {
 
 		# Convert string to datetime
-		my $validFrom_unixtime = str2time($validFrom);
+		my $validFrom_unixtime = str2time($validFrom,$server->{'smradius'}->{'event_timezone'});
 		if (!defined($validFrom_unixtime)) {
-			$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] Date conversion failed on '".$validFrom."'");
+			$server->log(LOG_NOTICE,"[MOD_FEATURE_VALIDITY] Date conversion failed on '%s'",$validFrom);
 
 		# If current time before start of valid pariod
 		} elsif ($now < $validFrom_unixtime) {
 			my $pretty_dt = DateTime->from_epoch( epoch => $validFrom_unixtime )->strftime('%Y-%m-%d %H:%M:%S');
 
-			$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid start date: '".$pretty_dt."', rejecting");
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid start date: '%s', rejecting",$pretty_dt);
 			# Date not within valid period, must be disconnected
 
 			return MOD_RES_NACK;
@@ -167,14 +165,14 @@ sub checkValidity
 	if (defined($validTo)) {
 
 		# Convert string to datetime
-		my $validTo_unixtime = str2time($validTo);
+		my $validTo_unixtime = str2time($validTo,$server->{'smradius'}->{'event_timezone'});
 		if (!defined($validTo_unixtime)) {
-				$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Date conversion failed on '".$validTo."'");
+				$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Date conversion failed on '%s'",$validTo);
 
 		# If current time after start of valid pariod
 		} elsif ($now > $validTo_unixtime) {
 			my $pretty_dt = DateTime->from_epoch( epoch => $validTo_unixtime )->strftime('%Y-%m-%d %H:%M:%S');
-			$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid end date: '".$pretty_dt."', rejecting");
+			$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid end date: '%s', rejecting",$pretty_dt);
 			# Date not within valid period, must be disconnected
 
 			return MOD_RES_NACK;
@@ -194,18 +192,20 @@ sub checkValidity
 					# If current time after start of valid pariod
 					if ($now > $validUntil) {
 						my $pretty_dt = DateTime->from_epoch( epoch => $validUntil )->strftime('%Y-%m-%d %H:%M:%S');
-						$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid window end date: '".$pretty_dt."', rejecting");
+						$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] Current date outside valid window end date: '%s', ".
+								"rejecting",$pretty_dt);
 						# Date not within valid window, must be disconnected
 						return MOD_RES_NACK;
 					}
 				}
 	
 			} else {
-				$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] No users_data 'global/FirstLogin' found for user '".$user->{'Username'}."'");
+				$server->log(LOG_DEBUG,"[MOD_FEATURE_VALIDITY] No users_data 'global/FirstLogin' found for user '%s'",
+						$user->{'Username'});
 			} # if (defined(my $res = $module->{'Users_data_get'}($server,$user,'global','FirstLogin'))) {
 		} else {
-			$server->log(LOG_WARN,"[MOD_FEATURE_VALIDITY] UserDB module '".$user->{'_UserDB'}->{'Name'}.
-					"' does not support 'users_data'. Therefore no support for Validity Window feature");
+			$server->log(LOG_WARN,"[MOD_FEATURE_VALIDITY] UserDB module '%s' does not support 'users_data'. Therefore no ".
+					"support for Validity Window feature",$user->{'_UserDB'}->{'Name'});
 		} # if (defined($user->{'_UserDB'}->{'Users_data_get'})) {
 	}
 

smradius/modules/system/mod_config_sql.pm → lib/smradius/modules/system/mod_config_sql.pm

 # SQL config database support
-# Copyright (C) 2007-2011, 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
@@ -171,7 +171,7 @@ sub getConfig
 	$server->log(LOG_DEBUG,"Processing DEFAULT realm attributes");
 	my $sth = DBSelect($config->{'get_config_realm_id_query'},$realmName);
 	if (!$sth) {
-		$server->log(LOG_ERR,"Failed to get default realm ID: ".AWITPT::DB::DBLayer::Error());
+		$server->log(LOG_ERR,"Failed to get default realm ID: ".AWITPT::DB::DBLayer::error());
 		return MOD_RES_NACK;
 	}
 	# Set realm ID
@@ -186,7 +186,7 @@ sub getConfig
 	if (defined($realmID)) {
 		$sth = DBSelect($config->{'get_config_realm_attributes_query'},$realmID);
 		if (!$sth) {
-			$server->log(LOG_ERR,"Failed to get default realm config attributes: ".AWITPT::DB::DBLayer::Error());
+			$server->log(LOG_ERR,"Failed to get default realm config attributes: ".AWITPT::DB::DBLayer::error());
 			return MOD_RES_NACK;
 		}
 		# Add any default realm attributes to config attributes
@@ -197,14 +197,14 @@ sub getConfig
 	}
 
 	# Extract realm from username
-	if (defined($user->{'Username'}) && $user->{'Username'} =~ /^\S+@(\S+)$/) {
-		$realmName = $1;
-		
-		$server->log(LOG_DEBUG,"Processing realm attributes for '$realmName'");
+	if (defined($user->{'Username'}) && $user->{'Username'} =~ /^\S+(?:@(\S+))?$/) {
+		my $userRealm = $1 // "";
 
-		$sth = DBSelect($config->{'get_config_realm_id_query'},$realmName);
+		$server->log(LOG_DEBUG,"Processing attributes for realm '$userRealm'");
+
+		$sth = DBSelect($config->{'get_config_realm_id_query'},$userRealm);
 		if (!$sth) {
-			$server->log(LOG_ERR,"Failed to get user realm config attributes: ".AWITPT::DB::DBLayer::Error());
+			$server->log(LOG_ERR,"Failed to get realm config attributes: ".AWITPT::DB::DBLayer::error());
 			return MOD_RES_NACK;
 		}
 		# Fetch realm ID
@@ -216,7 +216,7 @@ sub getConfig
 			# User realm attributes
 			$sth = DBSelect($config->{'get_config_realm_attributes_query'},$realmID);
 			if (!$sth) {
-				$server->log(LOG_ERR,"Failed to get user realm config attributes: ".AWITPT::DB::DBLayer::Error());
+				$server->log(LOG_ERR,"Failed to get realm config attributes: ".AWITPT::DB::DBLayer::error());
 				return MOD_RES_NACK;
 			}
 			# Add any realm attributes to config attributes
@@ -224,6 +224,8 @@ sub getConfig
 				processConfigAttribute($server,$user,hashifyLCtoMC($row, qw(Name Operator Value)));
 			}
 			DBFreeRes($sth);
+
+			$realmName = $userRealm;
 		}
 	}
 
@@ -233,6 +235,8 @@ sub getConfig
 		return MOD_RES_NACK;
 	}
 
+	$server->log(LOG_DEBUG,"Realm '$realmName' has ID '$realmID'");
+
 	# Get client name
 	my $clientID;
 
@@ -258,13 +262,12 @@ sub getConfig
 
 		$sth = DBSelect($config->{'get_config_accesslist_query'},$realmID);
 		if (!$sth) {
-			$server->log(LOG_ERR,"Failed to get config attributes: ".AWITPT::DB::DBLayer::Error());
+			$server->log(LOG_ERR,"Failed to get config attributes: ".AWITPT::DB::DBLayer::error());
 			return MOD_RES_NACK;
 		}
 
 		# Grab peer address object
 		my $peerAddrObj =  AWITPT::NetIP->new($server->{'server'}{'peeraddr'});
-
 		# Check if we know this client
 		my @accessList;
 		while (my $row = $sth->fetchrow_hashref()) {
@@ -274,9 +277,9 @@ sub getConfig
 			@accessList = split(',',$res->{'AccessList'});
 			# Loop with what we get and check if we have match
 			foreach my $range (@accessList) {
-				my $rangeObj = new AWITPT::NetIP->new($range);
+				my $rangeObj = AWITPT::NetIP->new($range);
 				# Check for match
-		 		if ($peerAddrObj->is_within($rangeObj)) {
+				if ($peerAddrObj->is_within($rangeObj)) {
 					$clientID = $res->{'ID'};
 					$server->log(LOG_INFO,"(SETCACHE) Got client ID '$clientID' from DB");
 					last;
@@ -300,7 +303,7 @@ sub getConfig
 	if (defined($clientID)) {
 		my $sth = DBSelect($config->{'get_config_client_attributes_query'},$clientID);
 		if (!$sth) {
-			$server->log(LOG_ERR,"Failed to get default config attributes: ".AWITPT::DB::DBLayer::Error());
+			$server->log(LOG_ERR,"Failed to get default config attributes: ".AWITPT::DB::DBLayer::error());
 			return MOD_RES_NACK;
 		}
 		# Add to config attributes

smradius/modules/system/mod_config_sql_topups.pm → lib/smradius/modules/system/mod_config_sql_topups.pm

@@ -28,21 +28,18 @@ use AWITPT::Util;
 use smradius::util;
 use smradius::attributes;
 
-use POSIX qw(ceil strftime);
+use POSIX qw(ceil);
 use DateTime;
 use Date::Parse;
 use Math::BigInt;
 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(
 );
 
 
@@ -57,7 +54,10 @@ our $pluginInfo = {
 	Cleanup => \&cleanup,
 
 	# User database
-	Config_get => \&getTopups
+	Config_get => \&getTopups,
+
+	# Topups
+	Feature_Config_Topop_add => \&addTopup,
 };
 
 # Module config
@@ -118,6 +118,29 @@ sub init
 			AND @TP@users.Username = ?
 	';
 
+	$config->{'topups_add_query'} = '
+		INSERT INTO
+			@TP@topups
+		(
+			UserID,
+			Timestamp,
+			ValidFrom,
+			ValidTo,
+			Type,
+			Value,
+			Depleted
+		)
+		VALUES
+		(
+			%{user.ID},
+			%{query.Timestamp},
+			%{query.ValidFrom},
+			%{query.ValidTo},
+			%{query.Type},
+			%{query.Value},
+			%{query.Depleted}
+		)
+	';
 
 	# Setup SQL queries
 	if (defined($scfg->{'mod_config_sql_topups'})) {
@@ -140,6 +163,15 @@ sub init
 			}
 
 		}
+
+		if (defined($scfg->{'mod_config_sql_topups'}->{'topups_add_query'}) &&
+				$scfg->{'mod_config_sql_topups'}->{'topups_add_query'} ne "") {
+			if (ref($scfg->{'mod_config_sql_topups'}->{'topups_add_query'}) eq "ARRAY") {
+				$config->{'topups_add_query'} = join(' ',@{$scfg->{'mod_config_sql_topups'}->{'topups_add_query'}});
+			} else {
+				$config->{'topups_add_query'} = $scfg->{'mod_config_sql_topups'}->{'topups_add_query'};
+			}
+		}
 	}
 }
 
@@ -185,7 +217,7 @@ sub getTopups
 	# Query database
 	my $sth = DBSelect($config->{'get_topups_summary_query'},$periodKey,$username);
 	if (!$sth) {
-		$server->log(LOG_ERR,"Failed to get topup information: ".AWITPT::DB::DBLayer::Error());
+		$server->log(LOG_ERR,"Failed to get topup information: %s",AWITPT::DB::DBLayer::error());
 		return MOD_RES_NACK;
 	}
 	while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(Balance Type ID))) {
@@ -196,7 +228,7 @@ sub getTopups
 	# Query database
 	$sth = DBSelect($config->{'get_topups_query'},$thisMonth->ymd,$now->ymd,$username);
 	if (!$sth) {
-		$server->log(LOG_ERR,"Failed to get topup information: ".AWITPT::DB::DBLayer::Error());
+		$server->log(LOG_ERR,"Failed to get topup information: %s",AWITPT::DB::DBLayer::error());
 		return MOD_RES_NACK;
 	}
 	# Fetch all new topups
@@ -254,7 +286,7 @@ sub cleanup
 
 	if (!$sth) {
 		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select users: ".
-				AWITPT::DB::DBLayer::Error());
+				AWITPT::DB::DBLayer::error());
 		return;
 	}
 
@@ -283,7 +315,7 @@ sub cleanup
 	);
 	if (!$sth) {
 		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to delete topup summaries: ".
-				AWITPT::DB::DBLayer::Error());
+				AWITPT::DB::DBLayer::error());
 		DBRollback();
 		return;
 	}
@@ -299,8 +331,7 @@ sub cleanup
 			SMAdminDepletedOn >= ?', $thisMonth->ymd()
 	);
 	if (!$sth) {
-		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to undeplete topups: ".
-				AWITPT::DB::DBLayer::Error());
+		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to undeplete topups: ".AWITPT::DB::DBLayer::error());
 		DBRollback();
 		return;
 	}
@@ -319,7 +350,7 @@ sub cleanup
 	);
 	if (!$sth) {
 		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to retrieve accounting summaries: ".
-				AWITPT::DB::DBLayer::Error());
+				AWITPT::DB::DBLayer::error());
 		DBRollback();
 		return;
 	}
@@ -346,14 +377,14 @@ sub cleanup
 		);
 		if (!$sth) {
 			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select accounting summary record: ".
-					AWITPT::DB::DBLayer::Error());
+					AWITPT::DB::DBLayer::error());
 			goto FAIL_ROLLBACK;
 		}
 
 		# Our usage hash
 		my %usageTotals;
-		$usageTotals{'TotalSessionTime'} = Math::BigInt->new();
-		$usageTotals{'TotalDataUsage'} = Math::BigInt->new();
+		$usageTotals{'TotalSessionTime'} = Math::BigInt->new(0);
+		$usageTotals{'TotalDataUsage'} = Math::BigInt->new(0);
 
 		# Pull in usage and add up
 		if (my $row = hashifyLCtoMC($sth->fetchrow_hashref(),
@@ -396,7 +427,7 @@ sub cleanup
 
 		if (!$sth) {
 			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select group usage caps: ".
-					AWITPT::DB::DBLayer::Error());
+					AWITPT::DB::DBLayer::error());
 			goto FAIL_ROLLBACK;
 		}
 
@@ -451,7 +482,7 @@ sub cleanup
 
 		if (!$sth) {
 			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select user usage caps: ".
-					AWITPT::DB::DBLayer::Error());
+					AWITPT::DB::DBLayer::error());
 			goto FAIL_ROLLBACK;
 		}
 
@@ -520,7 +551,7 @@ sub cleanup
 
 		if (!$sth) {
 			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topup summaries: ".
-					AWITPT::DB::DBLayer::Error());
+					AWITPT::DB::DBLayer::error());
 			goto FAIL_ROLLBACK;
 		}
 
@@ -532,7 +563,7 @@ sub cleanup
 
 			if (defined($row->{'ValidTo'})) {
 				# Convert string to unix time
-				my $unix_validTo = str2time($row->{'ValidTo'});
+				my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
 				# Process traffic topup
 				if (_isTrafficTopup($row->{'Type'})) {
 					push(@trafficSummary, {
@@ -590,8 +621,7 @@ sub cleanup
 		);
 
 		if (!$sth) {
-			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topups: ".
-					AWITPT::DB::DBLayer::Error());
+			$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to select topups: ".AWITPT::DB::DBLayer::error());
 			goto FAIL_ROLLBACK;
 		}
 
@@ -600,7 +630,7 @@ sub cleanup
 		while (my $row = hashifyLCtoMC($sth->fetchrow_hashref(), qw(ID Value Type ValidTo))) {
 
 			# Convert string to unix time
-			my $unix_validTo = str2time($row->{'ValidTo'});
+			my $unix_validTo = str2time($row->{'ValidTo'},$server->{'smradius'}->{'event_timezone'});
 			# If this is a traffic topup ...
 			if (_isTrafficTopup($row->{'Type'})) {
 				push(@trafficTopups, {
@@ -983,7 +1013,7 @@ sub cleanup
 
 			if (!$sth) {
 				$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to create topup summary: ".
-						AWITPT::DB::DBLayer::Error());
+						AWITPT::DB::DBLayer::error());
 				goto FAIL_ROLLBACK;
 			}
 
@@ -1010,7 +1040,7 @@ sub cleanup
 			);
 			if (!$sth) {
 				$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to deplete topup: ".
-						AWITPT::DB::DBLayer::Error());
+						AWITPT::DB::DBLayer::error());
 				goto FAIL_ROLLBACK;
 			}
 
@@ -1036,7 +1066,7 @@ sub cleanup
 			);
 			if (!$sth) {
 				$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Cleanup => Failed to update topups_summary: ".
-						AWITPT::DB::DBLayer::Error());
+						AWITPT::DB::DBLayer::error());
 				goto FAIL_ROLLBACK;
 			}
 
@@ -1060,6 +1090,47 @@ FAIL_ROLLBACK:
 
 
 
+## @addTopup
+# Create a topup
+#
+# @param server Server object
+# @param user User
+# @param packet Radius packet
+#
+# @return Result
+sub addTopup
+{
+	my ($server,$user,$validFrom,$validTo,$type,$value) = @_;
+
+
+	# Build template
+	my $template;
+	$template->{'user'}->{'ID'} = $user->{'ID'};
+	$template->{'user'}->{'Username'} = $user->{'Username'};
+
+	my $now = DateTime->now->set_time_zone($server->{'smradius'}->{'event_timezone'});
+
+	$template->{'query'}->{'Timestamp'} = $now->strftime('%F %T');
+	$template->{'query'}->{'ValidFrom'} = $validFrom;
+	$template->{'query'}->{'ValidTo'} = $validTo;
+	$template->{'query'}->{'Type'} = $type;
+	$template->{'query'}->{'Value'} = $value;
+	$template->{'query'}->{'Depleted'} = 0;
+
+	# Replace template entries
+	my @dbDoParams = templateReplace($config->{'topups_add_query'},$template);
+	# Insert into database
+	my $sth = DBDo(@dbDoParams);
+	if (!$sth) {
+		$server->log(LOG_ERR,"[MOD_CONFIG_SQL_TOPUPS] Failed to insert topup record: %s",AWITPT::DB::DBLayer::error());
+		return MOD_RES_NACK;
+	}
+
+	return MOD_RES_ACK;
+}
+
+
+
 ## @internal
 # Function snippet to add up traffic summaries based on topup types
 sub _trafficSummaryAdd

smradius/modules/system/mod_config_test.pm → lib/smradius/modules/system/mod_config_test.pm

@@ -15,7 +15,7 @@
 # with this program; if not, write to the Free Software Foundation, Inc.,
 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
-package smradius::smradius::modules::system::mod_config_test;
+package smradius::modules::system::mod_config_test;
 
 use strict;
 use warnings;