.gitlab-ci.yml

@@ -3,15 +3,21 @@ stages:
   - tests
   - install
 
+
+
 code-quality:
   stage: quality
   script:
     - export DEBIAN_FRONTEND=noninteractive
     - apt-get update
     - apt-get dist-upgrade -y
-    - apt-get install -y libperl-critic-perl make
+    - apt-get install -y perl-modules
+    - apt-get install -y make
+    - apt-get install -y libperl-critic-perl
     - perlcritic --gentle "$CI_PROJECT_DIR"
 
+
+
 make-test:
   stage: tests
   script:
@@ -19,11 +25,44 @@ make-test:
     - apt-get update
     - apt-get dist-upgrade -y
     - apt-get install -y git make
-    - apt-get install -y mysql-server
+    - apt-get install -y libdevel-cover-perl libpod-coverage-perl libtest-most-perl
+    - apt-get install -y libnet-server-perl libconfig-inifiles-perl libdatetime-perl libcache-fastmmap-perl libtimedate-perl
+      libcrypt-des-perl libcrypt-rc4-perl libdigest-sha-perl libdigest-md4-perl libmime-lite-perl
+    - apt-get install -y mariadb-server
+
+    # Start services and create dirs we need
+    - service mysql start
+    - mkdir /var/run/smradius
+
+    # Update our dependencies
     - cd "$CI_PROJECT_DIR"
     - ./update-git-modules
+    - perl -MCPAN -e 'install Math::Expression' < /dev/null
+
+    # Build Makefile and make
     - perl Makefile.PL
-    - make test
+    - make
+
+    # Convert DB into MySQL
+    - blib/script/convert-tsql MySQL database/core.tsql > database/core.mysql
+    - blib/script/convert-tsql MySQL database/users-accounting-summary.tsql > database/users-accounting-summary.mysql
+    - blib/script/convert-tsql MySQL database/wisp.tsql > database/wisp.mysql
+
+    # Load SQL into DB
+    - echo "CREATE DATABASE smradiustest;" | mysql -u root
+    - mysql -u root smradiustest < database/core.mysql
+    - mysql -u root smradiustest < database/users-accounting-summary.mysql
+    - mysql -u root smradiustest < database/wisp.mysql
+
+    # Sort out config file
+    - cp smradiusd.conf smradiusd.conf.test
+    - perl -pi -e 's/database=smradius/database=smradiustest/' smradiusd.conf.test
+
+    # Run tests, exclude all but smradius
+    - DBTESTS=1 cover -test -ignore_re '.*' -select_re '^blib\/lib\/smradius\/' | tee devel-coverage.txt
+    - grep "^Total" devel-coverage.txt | awk '{ print "(" $8 "%) covered" }'
+
+
 
 make-install:
   stage: install
@@ -32,7 +71,7 @@ make-install:
     - apt-get update
     - apt-get dist-upgrade -y
     - apt-get install -y git make
-    - apt-get install -y mysql-server
+    - apt-get install -y mariadb-server
     - cd "$CI_PROJECT_DIR"
     - ./update-git-modules
     - perl Makefile.PL

3rdparty/Makefile.PL

-my @additionalDirs = ();
 # Makefile
 # Copyright (C) 2014-2016, AllWorldIT
 #
@@ -28,6 +27,8 @@ use File::Find;
 
 
 
+my @additionalDirs = ();
+
 find(
 	{
 		wanted => sub {
@@ -44,8 +45,6 @@ find(
 	".",
 );
 
-
-
 WriteMakefile(
 	'NAME' => 'SMRadius-3rdParty',
 

awitpt @ 6944c201

-Subproject commit 201569f905bade5bf06cb06866dcd54f6b99c100
+Subproject commit 6944c2017372a13a334f902fdd8461e171393949

FEATURES

@@ -27,7 +27,7 @@ Enhanced features:
 * Plugin: Topups
 * Plugin: Auto-topups
 * Plugin: Usage/Time caps
-* Plugin: Prepaid accounting based on usage/time 
+* Plugin: Prepaid accounting based on usage/time
 * Plugin: Creation of accounting START records when no START record has been received but an interim update has - helps on slow/lossly links
 * Plugin: Notifications, % based or approximate time based
 * Plugin: User blacklists

INSTALL

@@ -8,10 +8,10 @@ Installing SMRadius.
 - Cache::FastMmap (Debian based: libcache-fastmmap-perl, RPM based: perl-Cache-FastMmap)
 - DateTime (requires: perl-Class-Singleton)
 - TimeDate
-- Crypt::DES
-- Crytpt::RC4
-- Digest::SHA1
-- Digest::MD4
+- Crypt::DES (Debian based: libcrypt-des-perl)
+- Crytpt::RC4 (Debian based: libcrypt-rc4-perl)
+- Digest::SHA1 (Debian based: libdigest-sha-perl)
+- Digest::MD4 (Debian based: libdigest-md4-perl)
 - Math::Expression
 
 * Requirements for webui

Makefile.PL

@@ -37,7 +37,11 @@ WriteMakefile(
 
 	'DIR' => ["3rdparty"],
 
-	'EXE_FILES' => [qw( bin/smradiusd bin/smadmin bin/smradclient )],
+	'EXE_FILES' => [qw(
+		bin/smradiusd
+		bin/smadmin
+		bin/smradclient
+	)],
 );
 
 

README.md

+
+[![build status](https://gitlab.devlabs.linuxassist.net/smradius/smradius/badges/master/build.svg)](https://gitlab.devlabs.linuxassist.net/smradius/smradius/commits/master)
+
+[![coverage report](https://gitlab.devlabs.linuxassist.net/smradius/smradius/badges/master/coverage.svg)](https://gitlab.devlabs.linuxassist.net/smradius/smradius/commits/master)
\ No newline at end of file

TODO

@@ -5,8 +5,7 @@ smradiusd:
 
 * Create a raddbpath config option which is prepended to dict paths
 
-usage related queries:
-* Use Math module to perform calculations
+* Configurable 'use defaults for POD/CoA' we may not want to send these
 
 smadmin:
 * Ability to run smadmin before the end of current month and updating the records as necessary at a later stage

bin/smadmin

@@ -23,8 +23,9 @@ use warnings;
 
 
 
+use Config;
 use FindBin;
-use lib "$FindBin::Bin/../share/perl5";
+use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../share/perl5", "$FindBin::Bin/../share/perl/$Config{'version'}");
 
 
 

bin/smradclient

@@ -21,16 +21,18 @@ use warnings;
 
 
 
+use Config;
 use FindBin;
-use lib "$FindBin::Bin/../share/perl5";
+use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../share/perl5", "$FindBin::Bin/../share/perl/$Config{'version'}");
 
 use smradius::client;
 
 
 
-smradius::client->run();
+# Grab and exit with result received
+my $res = smradius::client->run();
+exit($res);
 
 
 
-1;
 # vim: ts=4

bin/smradiusd

@@ -23,14 +23,12 @@ use warnings;
 
 
 
+use Config;
 use FindBin;
-use lib "$FindBin::Bin/../share/perl5";
+use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../share/perl5", "$FindBin::Bin/../share/perl/$Config{'version'}");
 
 
 use smradius::daemon;
-
-
-
 smradius::daemon->run();
 
 

database/convert-tsql

-#!/bin/bash
-# Database translation/creation script
-# Copyright (C) 2009-2016, AllWorldIT
-# Copyright (C) 2008, LinuxRulz
-#
-# 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.
-
-database="$1"
-file="$2"
-prefix="$3"
-
-
-# Display usage info
-display_usage() {
-    echo "Usage: $0 <database type> <file> [prefix]"
-    echo
-    echo "Valid database types:"
-    echo "      mysql   - For MySQL v5.5+"
-    echo "      pgsql   - For PostgreSQL"
-    echo "      sqlite  - For SQLite v3"
-    echo
-    exit
-}
-
-
-# Check we have our params
-if [ -z "$database" -o -z "$file" ]
-then
-    display_usage
-fi
-
-
-
-# Check file exists
-if [ ! -f "$file" ]
-then
-    echo "ERROR: Cannot open file '$file'"
-    exit 1
-fi
-
-# Check what we converting for
-case "$database" in
-	"mysql")
-		sed \
-			-e "s/@PREFIX@/$prefix/g" \
-			-e 's/@PRELOAD@/SET FOREIGN_KEY_CHECKS=0;/' \
-			-e 's/@POSTLOAD@/SET FOREIGN_KEY_CHECKS=1;/' \
-			-e 's/@CREATE_TABLE_SUFFIX@/ENGINE=InnoDB CHARACTER SET latin1 COLLATE latin1_bin/' \
-			-e 's/@SERIAL_TYPE@/SERIAL/' \
-			-e 's/@BIGINT_UNSIGNED@/BIGINT UNSIGNED/' \
-			-e 's/@INT_UNSIGNED@/INT UNSIGNED/' \
-			-e 's/@TRACK_KEY_LEN@/512/' \
-			-e 's/@SERIAL_REF_TYPE@/BIGINT UNSIGNED/' < "$file"
-		;;
-
-	"pgsql")
-		sed \
-			-e "s/@PREFIX@/$prefix/g" \
-			-e 's/@PRELOAD@/SET CONSTRAINTS ALL DEFERRED;/' \
-			-e 's/@POSTLOAD@//' \
-			-e 's/@CREATE_TABLE_SUFFIX@//' \
-			-e 's/@SERIAL_TYPE@/SERIAL PRIMARY KEY/' \
-			-e 's/@BIGINT_UNSIGNED@/INT8/' \
-			-e 's/@INT_UNSIGNED@/INT8/' \
-			-e 's/@TRACK_KEY_LEN@/512/' \
-			-e 's/@SERIAL_REF_TYPE@/INT8/' < "$file"
-		;;
-
-	"sqlite")
-		sed \
-			-e "s/@PREFIX@/$prefix/g" \
-			-e 's/@PRELOAD@//' \
-			-e 's/@POSTLOAD@//' \
-			-e 's/@CREATE_TABLE_SUFFIX@//' \
-			-e 's/@SERIAL_TYPE@/INTEGER PRIMARY KEY AUTOINCREMENT/' \
-			-e 's/@BIGINT_UNSIGNED@/INT8/' \
-			-e 's/@INT_UNSIGNED@/INT8/' \
-			-e 's/@TRACK_KEY_LEN@/512/' \
-			-e 's/@SERIAL_REF_TYPE@/INT8/' < "$file"
-		;;
-
-	*)
-	    echo "ERROR: Invalid database type '$database'"
-	    exit 1
-	    ;;
-
-esac
-
-

database/core.tsql

@@ -179,7 +179,7 @@ CREATE TABLE @PREFIX@topups_summary (
 
 	TopupID			@SERIAL_REF_TYPE@ NOT NULL,
 
-	PeriodKey		VARCHAR(255) NOT NULL, 
+	PeriodKey		VARCHAR(255) NOT NULL,
 
 	Balance			@INT_UNSIGNED@,
 
@@ -199,13 +199,13 @@ CREATE TABLE @PREFIX@accounting (
 
 	ServiceType		@INT_UNSIGNED@,
 
-	FramedProtocol		@INT_UNSIGNED@, 
+	FramedProtocol		@INT_UNSIGNED@,
 
 	NASPort			VARCHAR(255),
 
 	NASPortType		@INT_UNSIGNED@,
 
-	CallingStationID	VARCHAR(255), 
+	CallingStationID	VARCHAR(255),
 
 	CalledStationID		VARCHAR(255),
 
@@ -251,6 +251,9 @@ CREATE INDEX @PREFIX@accounting_idx2 ON @PREFIX@accounting (PeriodKey);
 CREATE INDEX @PREFIX@accounting_idx4 ON @PREFIX@accounting (Username,AcctSessionID,NASIPAddress,NASPort);
 /* accounting_update_query */
 CREATE INDEX @PREFIX@accounting_idx5 ON @PREFIX@accounting (Username,AcctSessionID,NASIPAddress,NASPort,PeriodKey);
+/* Index for the EventTimestamp */
+CREATE INDEX @PREFIX@accounting_idx7 ON @PREFIX@accounting (EventTimestamp);
+CREATE INDEX @PREFIX@accounting_idx8 ON @PREFIX@accounting (Username,EventTimestamp);
 
 
 
@@ -269,11 +272,14 @@ CREATE TABLE @PREFIX@accounting_summary (
 	TotalOutput		@INT_UNSIGNED@
 ) @CREATE_TABLE_SUFFIX@;
 
+CREATE INDEX @PREFIX@accounting_summary_idx1 ON @PREFIX@accounting_summary (Username);
+CREATE INDEX @PREFIX@accounting_summary_idx2 ON @PREFIX@accounting_summary (PeriodKey);
+CREATE INDEX @PREFIX@accounting_summary_idx3 ON @PREFIX@accounting_summary (Username,PeriodKey);
 
 
 /* Users data */
 CREATE TABLE @PREFIX@users_data (
-	ID 			@SERIAL_TYPE@,
+	ID				@SERIAL_TYPE@,
 
 	UserID			@INT_UNSIGNED@,
 
@@ -284,4 +290,4 @@ CREATE TABLE @PREFIX@users_data (
 	Value			VARCHAR(255),
 
 	UNIQUE (UserID,Name)
-) @CREATE_TABLE_SUFFIX@; 
+) @CREATE_TABLE_SUFFIX@;

database/users-accounting-summary.tsql

@@ -2,3 +2,4 @@ ALTER TABLE @PREFIX@users ADD COLUMN PeriodKey VARCHAR(255);
 ALTER TABLE @PREFIX@users ADD COLUMN TotalTraffic @INT_UNSIGNED@;
 ALTER TABLE @PREFIX@users ADD COLUMN TotalUptime @INT_UNSIGNED@;
 ALTER TABLE @PREFIX@users ADD COLUMN NASIdentifier VARCHAR(255);
+ALTER TABLE @PREFIX@users ADD COLUMN LastAcctUpdate DATETIME;

lib/smradius/attributes.pm

@@ -41,6 +41,8 @@ our (@EXPORT);
 );
 
 
+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";
@@ -51,6 +53,7 @@ use smradius::logging;
 use smradius::util;
 
 
+
 # Attributes we do not handle
 my @attributeCheckIgnoreList = (
 	'User-Password'
@@ -65,7 +68,23 @@ my @attributeReplyIgnoreList = (
 	'SMRadius-Username-Transform',
 	'SMRadius-Evaluate',
 	'SMRadius-Peer-Address',
-	'SMRadius-Disable-WebUITopup'
+	'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 = (
 );
@@ -85,8 +104,8 @@ sub addAttribute
 
 	# 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;
 	}
 
@@ -170,7 +189,7 @@ 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
@@ -327,7 +346,7 @@ sub checkAuthAttribute
 		# Always matches as a check item, and adds the current
 		# attribute with value to the list of configuration items.
 		#
-		# As a reply item, it has an itendtical meaning, but the
+		# As a reply item, it has an idendtical meaning, but the
 		# attribute is added to the reply items.
 
 		} elsif ($operator eq '+=') {
@@ -410,7 +429,7 @@ sub checkAcctAttribute
 	# 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
@@ -424,7 +443,7 @@ sub checkAcctAttribute
 		# Always matches as a check item, and adds the current
 		# attribute with value to the list of configuration items.
 		#
-		# As a reply item, it has an itendtical meaning, but the
+		# As a reply item, it has an idendtical meaning, but the
 		# attribute is added to the reply items.
 
 		if ($operator eq '+=') {
@@ -531,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
@@ -546,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 '+=') {
@@ -595,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)."'");
 
 
@@ -625,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
@@ -640,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 '+=') {
@@ -692,7 +711,7 @@ sub processConfigAttribute
 	# Always matches as a check item, and adds the current
 	# attribute with value to the list of configuration items.
 	#
-	# As a reply item, it has an itendtical meaning, but the
+	# As a reply item, it has an idendtical meaning, but the
 	# attribute is added to the reply items.
 
 	if ($attribute->{'Operator'} eq '+=') {
@@ -705,7 +724,7 @@ sub processConfigAttribute
 	# Always matches as a check item, and replaces in the configuration items any attribute of the same name.
 	# If no attribute of that name appears in the request, then this attribute is added.
 	#
-	# As a reply item, it has an itendtical meaning, but for the reply items, instead of the request items.
+	# As a reply item, it has an idendtical meaning, but for the reply items, instead of the request items.
 
 	} elsif ($attribute->{'Operator'} eq ':=') {
 		@{$configAttributes->{$attribute->{'Name'}}} = @attrValues;
@@ -775,7 +794,8 @@ sub processConditional
 
 
 	# Split off expression
-	my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\s*\:\s*(.*))?)?$/);
+	# NK: This probably needs a bit of work
+	my ($condition,$onTrue,$onFalse) = ($attrVal =~ /^([^\?]*)(?:\?\s*((?:\S+)?[^:]*)(?:\:\s*(.*))?)?$/);
 
 	# If there is no condition we cannot really continue?
 	if (!defined($condition)) {
@@ -829,6 +849,10 @@ sub processConditional
 	# 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*(.*)/);

lib/smradius/client.pm

 # Radius client
-# Copyright (C) 2007-2016, AllWorldIT
+# Copyright (C) 2007-2019, AllWorldIT
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -23,12 +23,14 @@ package smradius::client;
 use strict;
 use warnings;
 
-use Getopt::Long;
+use base qw(AWITPT::Object);
+
+use Getopt::Long qw( GetOptionsFromArray );
 use IO::Select;
 use IO::Socket;
 
 use smradius::version;
-use Radius::Packet;
+use smradius::Radius::Packet;
 
 # Check Config::IniFiles is instaslled
 if (!eval {require Config::IniFiles; 1;}) {
@@ -38,97 +40,99 @@ if (!eval {require Config::IniFiles; 1;}) {
 
 
 
-
+# Run the client
 sub run
 {
+	my ($self,@methodArgs) = @_;
+
 
+	# Instantiate if we're not already instantiated
+	$self = $self->new() if (!ref($self));
 
-	print(STDERR "SMRadClient v".VERSION." - Copyright (c) 2007-2016, AllWorldIT\n");
+	# 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} = ();
-	GetOptions(
+	if (!GetOptionsFromArray(
+		\@runArgs,
 		\%{$cmdline},
 		"config:s",
 		"raddb:s",
+		"listen:s",
 		"help",
-	) or die "Error parsing commandline arguments";
+	)) {
+		print(STDERR "ERROR: Error parsing commandline arguments");
+		return 1;
+	}
 
 	# Check for some args
 	if ($cmdline->{'help'}) {
 		displayHelp();
-		exit 0;
+		return 0;
 	}
 
 	# Make sure we only have 2 additional args
-	if (@ARGV > 3 || @ARGV < 3) {
-		print(STDERR "ERROR: Invalid number of arguments\n\n");
+	if (@runArgs < 3) {
+		print(STDERR "ERROR: Invalid number of arguments\n");
 		displayHelp();
-		exit 1;
+		return 1;
 	}
 
 	if (!defined($cmdline->{'raddb'}) || $cmdline->{'raddb'} eq "") {
-		print(STDERR "ERROR: No raddb directory specified!\n\n");
+		print(STDERR "ERROR: No raddb directory specified!\n");
 		displayHelp();
-		exit 1;
+		return 1;
 	}
 
 	# Get variables we need
-	my ($server,$type,$secret) = @ARGV;
+	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\n");
+	if (!defined($type) || ( $type ne "acct" && $type ne "auth" && $type ne "disconnect")) {
+		print(STDERR "ERROR: Invalid packet type specified!\n");
 		displayHelp();
-		exit 1;
+		return 1;
 	}
 
 
-	#if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") {
-	#	$cfg->{'config_file'} = $cmdline->{'config'};
-	#}
-
-	# Check config file exists
-	#if (! -f $cfg->{'config_file'}) {
-	#	die("No configuration file '".$cfg->{'config_file'}."' found!\n");
-	#}
-
-	# Use config file, ignore case
-	#tie my %inifile, 'Config::IniFiles', (
-	#		-file => $cfg->{'config_file'},
-	#		-nocase => 1
-	#) or die "Failed to open config file '".$cfg->{'config_file'}."': $!";
-	# Copy config
-	#my %config = %inifile;
-
 	print(STDERR "\n");
 
 
 	# Time to start loading the dictionary
 	print(STDERR "Loading dictionaries...");
-	my $raddb = Radius::Dictionary->new();
+	my $raddb = smradius::Radius::Dictionary->new();
 
 	# Look for files in the dir
-	opendir(my $DIR, $cmdline->{'raddb'})
-	or die "Cannot open '".$cmdline->{'raddb'}."': $!";
+	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 ".");
+		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");
 
@@ -136,52 +140,45 @@ sub run
 	my $port;
 	my $pkt_code;
 	if ($type eq "acct") {
-	$port = 1813;
-	$pkt_code = "Accounting-Request";
+		$port = 1813;
+		$pkt_code = "Accounting-Request";
 	} elsif ($type eq "auth") {
-	$port = 1812;
-	$pkt_code = "Access-Request";
+		$port = 1812;
+		$pkt_code = "Access-Request";
 	} elsif ($type eq "disconnect") {
-	$port = 1813;
-	$pkt_code = "Disconnect-Request";
+		$port = 1813;
+		$pkt_code = "Disconnect-Request";
 	}
 
 
 	print(STDERR "\nRequest:\n");
-	print(STDERR " > Secret => '$secret'\n");
+	printf(STDERR " > Secret => '%s'\n",$self->{'secret'});
 	# Build packet
-	my $pkt = Radius::Packet->new($raddb);
-	$pkt->set_code($pkt_code);
+	$self->{'packet'} = smradius::Radius::Packet->new($raddb);
+	$self->{'packet'}->set_code($pkt_code);
 	# Generate identifier
 	my $ident = int(rand(32768));
-	$pkt->set_identifier($ident);
+	$self->{'packet'}->set_identifier($ident);
 	print(STDERR " > Identifier: $ident\n");
 	# Generate authenticator number
 	my $authen = int(rand(32768));
-	$pkt->set_authenticator($authen);
+	$self->{'packet'}->set_authenticator($authen);
 	print(STDERR " > Authenticator: $ident\n");
 
-	# Pull in attributes
-	while (my $line = <STDIN>) {
-	# 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?(.+)/);
-		# Add to packet
-		print(STDERR " > Adding '$name' => '$value'\n");
-		if ($name eq "User-Password") {
-			$pkt->set_password($value,$secret);
-		} else {
-			$pkt->set_attr($name,$value);
+	# 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 = $pkt->pack();
+	my $udp_packet = $self->{'packet'}->pack();
 
 	# Create socket to send packet out on
 	my $sockTimeout = "10";  # 10 second timeout
@@ -190,48 +187,183 @@ sub run
 		PeerPort => $port,
 		Type => SOCK_DGRAM,
 		Proto => 'udp',
-		TimeOut => $sockTimeout,
+		Timeout => $sockTimeout,
 	);
 
 	if (!$sock) {
-	print(STDERR "ERROR: Failed to create socket\n");
+		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");
-	exit 1;
+		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");
-	exit 1;
+		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");
-	exit 1;
+		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: $!\n");
-	exit 1;
+		print(STDERR "ERROR: Receive response data failed on socket: $!\n");
+		return 1;
 	}
 
 	# Parse packet
-	$pkt = Radius::Packet->new($raddb,$udp_packet);
-	print(STDERR " > Authenticated: ". (defined(auth_req_verify($udp_packet,$secret,$authen)) ? "yes" : "no") ."\n");
+	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;
 }
 
@@ -241,8 +373,8 @@ sub run
 sub displayHelp {
 	print(STDERR<<EOF);
 
-Usage: $0 [args] <server> <acct|auth|disconnect> <secret>
-    --raddb                Directory where the radius dictionary files are
+Usage: $0 [args] <server> <acct|auth|disconnect> <secret> [ATTR=VALUE,...]
+    --raddb=<DIR>          Directory where the radius dictionary files are
 
 EOF
 

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");
 		}

lib/smradius/constants.pm

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

lib/smradius/daemon/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'} = {