# Radius daemon
# 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::daemon;


use strict;
use warnings;


# 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 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 smradius::util;
use smradius::attributes;





# Override configuration
sub configure {
	my ($self,$defaults) = @_;
	my $server = $self->{'server'};


	# If we hit a hash, add the config vars to the server
	if (defined($defaults)) {
		foreach my $item (keys %{$defaults}) {
			$server->{$item} = $defaults->{$item};
		}
		return;
	}

	# 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/smradius/smradiusd.pid";
	$server->{'log_level'} = 2;
	$server->{'log_file'} = "/var/log/smradius/smradiusd.log";

	$server->{'host'} = "*";
	$server->{'port'} = [ 1812, 1813 ];
	$server->{'proto'} = 'udp';

	$server->{'min_servers'} = 4;
	$server->{'min_spare_servers'} = 4;
	$server->{'max_spare_servers'} = 12;
	$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} = ();
	if (!GetOptionsFromArray(
			\@runArgs,
			\%{$cmdline},
			"help",
			"config:s",
			"debug",
			"fg",
	)) {
		print(STDERR "ERROR: Error parsing commandline arguments");
		return 1;
	}

	# Check for some args
	if ($cmdline->{'help'}) {
		$self->displayHelp();
		exit 0;
	}
	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;
	#untie(%inifile);

	# Pull in params for the server
	my @server_params = (
			'log_level','log_file',
#			'port',   - We don't want to override this do we?
			'host',
			'cidr_allow', 'cidr_deny',
			'pid_file',
			'user', 'group',
			'timeout',
			'background',
			'min_servers',
			'min_spare_servers',
			'max_spare_servers',
			'max_servers',
			'max_requests'
	);
	foreach my $param (@server_params) {
		$server->{$param} = $config{'server'}{$param} if (defined($config{'server'}{$param}));
	}

	# Fix up these ...
	if (defined($server->{'cidr_allow'})) {
		my @lst = split(/,\s;/,$server->{'cidr_allow'});
		$server->{'cidr_allow'} = \@lst;
	}
	if (defined($server->{'cidr_deny'})) {
		my @lst = split(/,\s;/,$server->{'cidr_deny'});
		$server->{'cidr_deny'} = \@lst;
	}

	# Override
	if ($cmdline->{'debug'}) {
		$server->{'log_level'} = 4;
		$cfg->{'debug'} = 1;
	}

	# If we set on commandline for foreground, keep in foreground
	if ($cmdline->{'fg'} || (defined($config{'server'}{'background'}) && $config{'server'}{'background'} eq "no" )) {
		$server->{'background'} = undef;
		$server->{'log_file'} = undef;
	} else {
		$server->{'setsid'} = 1;
	}

	# Loop with logging detail
	if (defined($config{'server'}{'log_detail'})) {
		# Lets see what we have to enable
		foreach my $detail (split(/[,\s;]/,$config{'server'}{'log_detail'})) {
			$cfg->{'logging'}{$detail} = 1;
		}
	}

	#
	# System modules
	#
	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";
			push(@{$cfg->{'module_list'}},$module);
		}
	} else {
		my @moduleList = split(/\s+/,$config{'system'}{'modules'});
		foreach my $module (@moduleList) {
			# Skip comments
			next if ($module =~ /^#/);
			$module = "system/$module";
			push(@{$cfg->{'module_list'}},$module);
		}
	}

	#
	# Feature modules
	#
	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";
			push(@{$cfg->{'module_list'}},$module);
		}
	} else {
		my @moduleList = split(/\s+/,$config{'features'}{'modules'});
		foreach my $module (@moduleList) {
			# Skip comments
			next if ($module =~ /^#/);
			$module = "features/$module";
			push(@{$cfg->{'module_list'}},$module);
		}
	}

	#
	# Authentication modules
	#
	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";
			push(@{$cfg->{'module_list'}},$module);
		}
	} else {
		my @moduleList = split(/\s+/,$config{'authentication'}{'mechanisms'});
		foreach my $module (@moduleList) {
			# Skip comments
			next if ($module =~ /^#/);
			$module = "authentication/$module";
			push(@{$cfg->{'module_list'}},$module);
		}
	}

	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";
			push(@{$cfg->{'module_list'}},$module);
		}
	} else {
		my @moduleList = split(/\s+/,$config{'authentication'}{'users'});
		foreach my $module (@moduleList) {
			# Skip comments
			next if ($module =~ /^#/);
			$module = "userdb/$module";
			push(@{$cfg->{'module_list'}},$module);
		}
	}

	#
	# Accounting modules
	#
	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";
			push(@{$cfg->{'module_list'}},$module);
		}
	} else {
		my @moduleList = split(/\s+/,$config{'accounting'}{'modules'});
		foreach my $module (@moduleList) {
			# Skip comments
			next if ($module =~ /^#/);
			$module = "accounting/$module";
			push(@{$cfg->{'module_list'}},$module);
		}
	}

	#
	# Dictionary configuration
	#
	# Split off dictionaries to load
	if (ref($config{'dictionary'}->{'load'}) eq "ARRAY") {
		foreach my $dict (@{$config{'dictionary'}->{'load'}}) {
			$dict =~ s/\s+//g;
			# Skip comments
			next if ($dict =~ /^#/);
			push(@{$cfg->{'dictionary_list'}},$dict);
		}
	} else {
		my @dictList = split(/\s+/,$config{'dictionary'}->{'load'});
		foreach my $dict (@dictList) {
			# Skip comments
			next if ($dict =~ /^#/);
			push(@{$cfg->{'dictionary_list'}},$dict);
		}
	}

	# 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;
}



# Run straight after ->run
sub post_configure_hook {
	my $self = shift;
	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);
	$self->log(LOG_INFO,"[SMRADIUS] Configuration initialized.");

	# Load dictionaries
	$self->log(LOG_INFO,"[SMRADIUS] Initializing dictionaries...");
	my $dict = smradius::Radius::Dictionary->new();
	foreach my $df (@{$config->{'dictionary_list'}}) {
		# Load dictionary
		if (!$dict->readfile($df)) {
			$self->log(LOG_WARN,"[SMRADIUS] Failed to load dictionary '$df': $!");
		}
		$self->log(LOG_DEBUG,"[SMRADIUS] Loaded dictionary '$df'.");
	}
	$self->log(LOG_INFO,"[SMRADIUS] Dictionaries initialized.");
	# Store the dictionary
	$self->{'radius'}->{'dictionary'} = $dict;

	$self->log(LOG_INFO,"[SMRADIUS] Initializing modules...");
	# Load modules
	foreach my $module (@{$config->{'module_list'}}) {
		# Split off dir and mod name
		$module =~ /^(\w+)\/(\w+)$/;
		my ($mod_dir,$mod_name) = ($1,$2);

		# Load module
		## no critic (BuiltinFunctions::ProhibitStringyEval)
		my $res = eval qq{
			use smradius::modules::${mod_dir}::${mod_name};
			plugin_register(\$self,\"${mod_name}\",\$smradius::modules::${mod_dir}::${mod_name}::pluginInfo);
		};
		## use critic
		if ($@ || (defined($res) && $res != 0)) {
			$self->log(LOG_WARN,"[SMRADIUS] Error loading module $module ($@)");
		} else {
			$self->log(LOG_DEBUG,"[SMRADIUS] Plugin '$module' loaded.");
		}
	}
	$self->log(LOG_INFO,"[SMRADIUS] Plugins initialized.");

	$self->log(LOG_INFO,"[SMRADIUS] Initializing system modules.");
	# Init caching engine
	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;
}



# Register plugin info
sub plugin_register {
	my ($self,$plugin,$info) = @_;


	# If no info, return
	if (!defined($info)) {
		print(STDERR "WARNING: Plugin info not found for plugin => $plugin\n");
		return -1;
	}

	# Set real module name & save
	$info->{'Module'} = $plugin;
	push(@{$self->{'module_list'}},$info);

	# If we should, init the module
	if (defined($info->{'Init'})) {
		$info->{'Init'}($self);
	}

	return 0;
}



# Initialize child
sub child_init_hook
{
	my $self = shift;
	my $config = $self->{'config'};


	$self->SUPER::child_init_hook();

	$self->log(LOG_INFO,"[SMRADIUS] Starting up caching engine");
	AWITPT::Cache::connect($self);

	# Do we need database support?
	if ($self->{'smradius'}->{'database'}->{'enabled'}) {
		# This is the database connection timestamp, if we connect, it resets to 0
		# if not its used to check if we must kill the child and try a reconnect
		$self->{'client'}->{'dbh_status'} = time();

		# Init core database support
		$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().
						" ($$)");
			}
		} else {
			$self->log(LOG_WARN,"[SMRADIUS] Failed to Initialize: ".awitpt::db::dbilayer::internalError()." ($$)");
		}
	}

	return;
}



# Destroy the child
sub child_finish_hook {
	my $self = shift;
	my $server = $self->{'server'};

	$self->SUPER::child_finish_hook();

	$self->log(LOG_INFO,"[SMRADIUS] Shutting down caching engine ($$)");
	AWITPT::Cache::disconnect($self);

	return;
}



# Process requests we get
sub process_request {
	my $self = shift;
	my $server = $self->{'server'};
	my $client = $self->{'client'};
	my $log = defined($server->{'config'}{'logging'}{'module_list'});


	# Grab packet
	my $rawPacket = $server->{'udp_data'};

	# Check min size
	if (length($rawPacket) < 18)
	{
		$self->log(LOG_WARN, "[SMRADIUS] Packet too short - Ignoring");
		return;
	}

	# Very first timer ...
	my $timer0 = [gettimeofday];

	# Grab NOW()
	my $now = time();

	# VERIFY SOURCE SERVER
	$self->log(LOG_DEBUG,"[SMRADIUS] Packet From = > ".$server->{'peeraddr'});

	# Check if we got connected, if not ... bypass
	if ($self->{'client'}->{'dbh_status'} > 0) {
		my $action;

		$self->log(LOG_WARN,"[SMRADIUS] Client in BYPASS mode due to DB connection failure!");
		# Check bypass mode
		if (!defined($self->{'inifile'}{'database'}{'bypass_mode'})) {
			$self->log(LOG_ERR,
					"[SMRADIUS] No bypass_mode specified for failed database connections, defaulting to tempfail");
			$action = "tempfail";
		# Check for "tempfail"
		} elsif (lc($self->{'inifile'}{'database'}{'bypass_mode'}) eq "tempfail") {
		# And for "bypass"
		} elsif (lc($self->{'inifile'}{'database'}{'bypass_mode'}) eq "pass") {
		}

		# Check if we need to reconnect or not
		my $timeout = $self->{'inifile'}{'database'}{'bypass_timeout'};
		if (!defined($timeout)) {
			$self->log(LOG_ERR,"[SMRADIUS] No bypass_timeout specified for failed database connections, defaulting to 120s");
			$timeout = 120;
		}
		# Get time left
		my $timepassed = $now - $self->{'client'}->{'dbh_status'};
		# Then check...
		if ($timepassed >= $timeout) {
			$self->log(LOG_WARN,"[SMRADIUS] Client BYPASS timeout exceeded, reconnecting...");
			exit 0;
		} else {
			$self->log(LOG_WARN,"[SMRADIUS] Client still in BYPASS mode, ".( $timeout - $timepassed ).
					"s left till next reconnect");
			return;
		}
	}

	# Setup database handle
	AWITPT::DB::DBLayer::setHandle($self->{'client'}->{'dbh'});


	my $request = smradius::daemon::request->new($self);
	if (!$request->setTimezone($self->{'smradius'}->{'event_timezone'})) {
		$self->log(LOG_ERR,"[SMRADIUS] Setting event_timezone to '%s' failed",$self->{'smradius'}->{'event_timezone'});
		return;
	}

	$request->parsePacket($self->{'radius'}->{'dictionary'},$rawPacket);

	# Check if we need to override the packet timestamp, if we are not using the packet timestamp, set it to when we go the packet
	if (!booleanize($self->{'smradius'}->{'use_packet_timestamp'})) {
		$request->setTimestamp($now);
	}

	# Username should always be defined?
	if (!$request->hasUsername()) {
		$self->log(LOG_NOTICE,"[SMRADIUS] Packet with no username from ".$server->{'peeraddr'});
		return;
	}


	# 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: Server trying too fast. server = ".$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: Server trying too fast. server = ".$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_DEBUG,"[SMRADIUS] CONFIG: Trying plugin '".$module->{'Name'}."' for incoming connection");
			my $res = $module->{'Config_get'}($self,$user,$pkt);

			# Check result
			if (!defined($res)) {
				$self->log(LOG_WARN,"[SMRADIUS] CONFIG: Error with plugin '".$module->{'Name'}."'");
				$logReason = "Config Error";

			# Check if we skipping this plugin
			} elsif ($res == MOD_RES_SKIP) {
				$self->log(LOG_DEBUG,"[SMRADIUS] CONFIG: Skipping '".$module->{'Name'}."'");

			# Check if we got a positive result back
			} elsif ($res == MOD_RES_ACK) {
				$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_DEBUG,"[SMRADIUS] CONFIG: Configuration rejection when using '".$module->{'Name'}."'");
				$logReason = "Config Rejected";

				# FIXME/TODO NK WIP
				return;
#				$configured = 0;
#				last;
			}
		}
	}


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

	# 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") {

		# Loop with modules to try find user
		foreach my $module (@{$self->{'module_list'}}) {

			# Try find user
			if ($module->{'User_find'}) {
				$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Trying plugin '".$module->{'Name'}."' for username '".
						$user->{'Username'}."'");
				my ($res,$userDB_Data) = $module->{'User_find'}($self,$user,$pkt);

				# Check result
				if (!defined($res)) {
					$self->log(LOG_WARN,"[SMRADIUS] FIND: Error with plugin '".$module->{'Name'}."'");
					$logReason = "Error Finding User";

				# Check if we skipping this plugin
				} elsif ($res == MOD_RES_SKIP) {
					$self->log(LOG_DEBUG,"[SMRADIUS] FIND: Skipping '".$module->{'Name'}."'");

				# Check if we got a positive result back
				} elsif ($res == MOD_RES_ACK) {
					$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_DEBUG,"[SMRADIUS] FIND: Username not found with '".$module->{'Name'}."'");
					$logReason = "User Not Found";
					last;

				}
			}
		}
	}


	#
	# 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($user->{'_UserDB'}) && defined($user->{'_UserDB'}->{'User_get'})) {
			my $res = $user->{'_UserDB'}->{'User_get'}($self,$user,$pkt);

			# Check result
			if ($res) {
				$self->log(LOG_WARN,"[SMRADIUS] GET: Error returned from '".$user->{'_UserDB'}->{'Name'}.
						"' for username '".$user->{'Username'}."'");
			}
		}

		# Loop with modules to try something that handles accounting
		foreach my $module (@{$self->{'module_list'}}) {
			# Try find user
			if ($module->{'Accounting_log'}) {
				$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Trying plugin '".$module->{'Name'}."'");
				my $res = $module->{'Accounting_log'}($self,$user,$pkt);

				# Check result
				if (!defined($res)) {
					$self->log(LOG_WARN,"[SMRADIUS] ACCT: Error with plugin '".$module->{'Name'}."'");
					$logReason = "Accounting Log Error";

				# Check if we skipping this plugin
				} elsif ($res == MOD_RES_SKIP) {
					$self->log(LOG_DEBUG,"[SMRADIUS] ACCT: Skipping '".$module->{'Name'}."'");

				# Check if we got a positive result back
				} elsif ($res == MOD_RES_ACK) {
					$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_DEBUG,"[SMRADIUS] ACCT: Accounting NOT LOGGED using '".$module->{'Name'}."'");
					$logReason = "Accounting NOT Logged";
				}
			}
		}

		# Are we going to POD the user?
		my $PODUser = 0;

		# 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_DEBUG,"[SMRADIUS] POST-ACCT: Trying plugin '".$module->{'Name'}."' for '".
						$user->{'Username'}."'");
				my $res = $module->{'Feature_Post-Accounting_hook'}($self,$user,$pkt);

				# Check result
				if (!defined($res)) {
					$self->log(LOG_WARN,"[SMRADIUS] POST-ACCT: Error with plugin '".$module->{'Name'}."'");
					$logReason = "Post Accounting Error";

				# Check if we skipping this plugin
				} elsif ($res == MOD_RES_SKIP) {
					$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Skipping '".$module->{'Name'}."'");

				# Check if we got a positive result back
				} elsif ($res == MOD_RES_ACK) {
					$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_DEBUG,"[SMRADIUS] POST-ACCT: Failed post accounting hook by '".$module->{'Name'}."'");
					$logReason = "Failed Post Accounting";
					$PODUser = 1;
				}
			}
		}

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

		# 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 attributes
				my $res = checkAcctAttribute($self,$user,$acctAttributes,$attr);
				# We don't care if it fails
			}
		}
# TEST START
		my $coaReq = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});

		# Process the reply attributes
		$self->_processReplyAttributes($request,$user,$coaReq);
# TEST END


		# Check if we must POD the user
		if ($PODUser) {
			$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying to disconnect user...");

			my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});

			$resp->set_code('Disconnect-Request');
			my $id = $$ & 0xff;
			$resp->set_identifier( $id );

			$resp->set_attr('User-Name',$pkt->attr('User-Name'));
			$resp->set_attr('Framed-IP-Address',$pkt->attr('Framed-IP-Address'));
			$resp->set_attr('NAS-IP-Address',$pkt->attr('NAS-IP-Address'));

			# Add onto logline
			$request->addLogLine(". REPLY => ");
			foreach my $attrName ($resp->attributes) {
				$request->addLogLine(
					"%s: '%s'",
					$attrName,
					$resp->rawattr($attrName)
				);
			}

			# Grab packet
			my $response = auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"));

			my $coaServer;

			# Check for old POD server attribute
			if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'})) {
				$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-PODServer is defined");
				$coaServer = $user->{'ConfigAttributes'}->{'SMRadius-Config-PODServer'};
			}

			# Check for new CoA server attribute
			if (defined($user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'})) {
				$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-CoAServer is defined");
				$coaServer = $user->{'ConfigAttributes'}->{'SMRadius-Config-CoAServer'};
			}

			# Check for CoA servers
			if (defined($coaServer)) {
				# Check address format
				foreach my $coaServerAttribute (@{$coaServer}) {
					# Check for valid IP
					if ($coaServerAttribute =~ /^([0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})/) {
						my $coaServer = $1;

						# If we have a port, use it, otherwise use default 1700
						my $coaServerPort;
						if ($coaServerAttribute =~ /:([0-9]+)$/) {
							$coaServerPort = $1;
						} else {
							$coaServerPort = 1700;
						}

						$self->log(LOG_DEBUG,"[SMRADIUS] POST-ACCT: Trying CoAServer => IP: '".$coaServer."' Port: '".$coaServerPort."'");

						# Create socket to send packet out on
						my $coaServerTimeout = "10";  # 10 second timeout
						my $coaSock = IO::Socket::INET->new(
								PeerAddr => $coaServer,
								PeerPort => $coaServerPort,
								Type => SOCK_DGRAM,
								Proto => 'udp',
								TimeOut => $coaServerTimeout,
						);

						if (!$coaSock) {
							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to create socket to send POD on");
							next;
						}

						# Check if we sent the packet...
						if (!$coaSock->send($response)) {
							$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 = IO::Select->new($coaSock);
						if (!$sh) {
							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to select data on socket");
							next;
						}

						if (!$sh->can_read($coaServerTimeout)) {
							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Failed to receive data on socket");
							next;
						}

						my $data;
						$coaSock->recv($data, 65536);
						if (!$data) {
							$self->log(LOG_ERR,"[SMRADIUS] POST-ACCT: Receive data failed");
							$logReason = "CoA 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 CoA Server value: '".$coaServerAttribute."'");
					}
				}
			} else {
				$self->log(LOG_DEBUG,"[SMRADIUS] SMRadius-Config-CoAServer is not defined");
			}
		}

	# Or maybe a access request
	} elsif ($pkt->code eq "Access-Request") {


		$self->log(LOG_DEBUG,"[SMRADIUS] Access Request Packet");

		# Authentication variables
		my $authenticated = 0;
		my $mechanism;
		# Authorization variables
		my $authorized = 1;


		# If no user is found, bork out ...
		if (!defined($user->{'_UserDB'})) {
			$self->log(LOG_DEBUG,"[SMRADIUS] FIND: No plugin found for username '".$user->{'Username'}."'");
			goto CHECK_RESULT;
		}

		#
		# GET USER
		#

		# Get user data
		if ($user->{'_UserDB'}->{'User_get'}) {
			my $res = $user->{'_UserDB'}->{'User_get'}($self,$user,$pkt);

			# Check result
			if ($res) {
				$self->log(LOG_WARN,"[SMRADIUS] GET: Error returned from '".$user->{'_UserDB'}->{'Name'}.
						"' for username '".$user->{'Username'}."'");
				goto CHECK_RESULT;
			}
		} else {
			$self->log(LOG_ERR,"[SMRADIUS] GET: No 'User_get' function available for module '".$user->{'_UserDB'}->{'Name'}."'");

			goto CHECK_RESULT;
		}

		#
		# AUTHENTICATE USER
		#

		# Loop with authentication modules
		foreach my $module (@{$self->{'module_list'}}) {
			# Try authenticate
			if ($module->{'Authentication_try'}) {
				$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Trying plugin '".$module->{'Name'}."' for '".$user->{'Username'}."'");
				my $res = $module->{'Authentication_try'}($self,$user,$pkt);

				# Check result
				if (!defined($res)) {
					$self->log(LOG_ERR,"[SMRADIUS] AUTH: Error with plugin '".$module->{'Name'}."'");

				# Check if we skipping this plugin
				} elsif ($res == MOD_RES_SKIP) {
					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Skipping '".$module->{'Name'}."'");

				# Check if we got a positive result back
				} elsif ($res == MOD_RES_ACK) {
					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
					$logReason = "User Authenticated";
					$mechanism = $module;
					$authenticated = 1;
					last;

				# Or a negative result
				} elsif ($res == MOD_RES_NACK) {
					$self->log(LOG_DEBUG,"[SMRADIUS] AUTH: Failed authentication by '".$module->{'Name'}."'");
					$logReason = "User NOT Authenticated";
					$mechanism = $module;
					last;

				}
			}
		}

		# Loop with modules that have post-authentication hooks
		if ($authenticated) {
			foreach my $module (@{$self->{'module_list'}}) {
				# Try authenticate
				if ($module->{'Feature_Post-Authentication_hook'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Trying plugin '".$module->{'Name'}.
							"' for '".$user->{'Username'}."'");

					my $res = $module->{'Feature_Post-Authentication_hook'}($self,$user,$pkt);

					# Check result
					if (!defined($res)) {
						$self->log(LOG_ERR,"[SMRADIUS] POST-AUTH: Error with plugin '".$module->{'Name'}."'");

					# Check if we skipping this plugin
					} elsif ($res == MOD_RES_SKIP) {
						$self->log(LOG_DEBUG,"[SMRADIUS] POST-AUTH: Skipping '".$module->{'Name'}."'");

					# Check if we got a positive result back
					} elsif ($res == MOD_RES_ACK) {
						$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_DEBUG,"[SMRADIUS] POST-AUTH: Failed authentication by '".$module->{'Name'}."'");
						$logReason = "Post Authentication Failure";
						$authenticated = 0;
						# Do we want to run the other modules ??
						last;
					}
				}
			}
		}

		#
		# AUTHORIZE USER
		#

		# Build a list of our attributes in the packet
		my $authAttributes;
		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
			foreach my $attrOp (keys %{$user->{'Attributes'}->{$attrName}}) {
				# Grab attribute
				my $attr = $user->{'Attributes'}->{$attrName}->{$attrOp};
				# Check attribute against authorization attributes
				my $res = checkAuthAttribute($self,$user,$authAttributes,$attr);
				if ($res == 0) {
					$authorized = 0;
					last;
				}
			}
			# We don't want to process everyting if something doesn't match
			last if (!$authorized);
		}

		# Check if we authenticated or not
		if ($authenticated && $authorized) {
			$self->log(LOG_DEBUG,"[SMRADIUS] Authenticated and authorized");
			$logReason = "User Authorized";

			my $resp = smradius::Radius::Packet->new($self->{'radius'}->{'dictionary'});
			$resp->set_code('Access-Accept');
			$resp->set_identifier($pkt->identifier);
			$resp->set_authenticator($pkt->authenticator);

			# Process the reply attributes
			$self->_processReplyAttributes($request,$user,$resp);

			$server->{'client'}->send(
				auth_resp($resp->pack, getAttributeValue($user->{'ConfigAttributes'},"SMRadius-Config-Secret"))
			);

		}

CHECK_RESULT:
		# Check if found and authenticated
		if (!$authenticated || !$authorized) {
			$self->log(LOG_DEBUG,"[SMRADIUS] Authentication or authorization failure");
			$logReason = "User NOT Authenticated or Authorized";

			my $resp = 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"))
			);
		}

	# We don't know how to handle this
	} else {
		$self->log(LOG_WARN,"[SMRADIUS] We cannot handle code: '".$pkt->code."'");
	}

	# END
	my $timer9 = [gettimeofday];
	my $timediff1 = tv_interval($timer0,$timer1);
	my $timediff2 = tv_interval($timer1,$timer2);
	my $timediff3 = tv_interval($timer2,$timer9);
	my $timediff = tv_interval($timer0,$timer9);

	# FIXME/TODO NK WIP
	my $logLine = join(' ',@{$request->{'logLine'}});
	my @logLineArgs = @{$request->{'logLineParams'}};


	# How should we output this ...
	if ($server->{'log_level'} > LOG_NOTICE) {
		$self->log(LOG_NOTICE,"[SMRADIUS] Result: $logReason (%.3fs + %.3fs + %.3fs = %.3fs) => $logLine",
				$timediff1,$timediff2,$timediff3,$timediff,@logLineArgs);
	} else {
		$self->log(LOG_NOTICE,"[SMRADIUS] Result: $logReason => $logLine",@logLineArgs);
	}

	# If we using abuse prevention record the time we ending off
	if ($self->{'smradius'}->{'use_abuse_prevention'} && defined($user->{'Username'})) {
		cacheStoreKeyPair('FloodCheck',$server->{'peeraddr'}."/".$user->{'Username'}."/".$pkt->code,time());
	}

	return;
}



# Initialize child
sub server_exit
{
	my $self = shift;


	$self->log(LOG_DEBUG,"Destroying system modules.");
	# Destroy cache
	AWITPT::Cache::Destroy($self);
	$self->log(LOG_DEBUG,"System modules destroyed.");

	# Parent exit
	$self->SUPER::server_exit();

	return;
}



# Slightly better logging
sub log ## no critic (Subroutines::ProhibitBuiltinHomonyms)
{
	my ($self,$level,$msg,@args) = @_;


	# Check log level and set text
	my $logtxt = "UNKNOWN";
	if ($level == LOG_DEBUG) {
		$logtxt = "DEBUG";
	} elsif ($level == LOG_INFO) {
		$logtxt = "INFO";
	} elsif ($level == LOG_NOTICE) {
		$logtxt = "NOTICE";
	} elsif ($level == LOG_WARN) {
		$logtxt = "WARNING";
	} elsif ($level == LOG_ERR) {
		$logtxt = "ERROR";
	}

	# Parse message nicely
	if ($msg =~ /^(\[[^\]]+\]) (.*)/s) {
		$msg = "$1 $logtxt: $2";
	} else {
		$msg = "[CORE] $logtxt: $msg";
	}

	# 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-2016, AllWorldIT\n");

	print(STDERR<<EOF);

Usage: $0 [args]
    --config=<file>        Configuration file
    --debug                Put into debug mode
    --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;
};



1;
# vim: ts=4