#!/usr/bin/perl
# Radius daemon
# Copyright (C) 2008, AllWorldIT
# Copyright (C) 2007, Nigel Kukard  <nkukard@lbsd.net>
# 
# 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.


use strict;
use warnings;

# Set library directory
use lib qw(
	../ ./ 
	smradius/modules/authentication
	smradius/modules/userdb
	smradius/modules/accounting
);

package radiusd;


use base qw(Net::Server::PreFork);
use Config::IniFiles;
use Getopt::Long;
use Sys::Syslog;

use smradius::version;
use smradius::constants;
use smradius::logging;
use smradius::config;
use smradius::dbilayer;
use smradius::cache;
use smradius::util;

use Radius::Packet;

use Data::Dumper;



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

	$server->{'timeout'} = 120;
	$server->{'background'} = "yes";
	$server->{'pid_file'} = "/var/run/smradiusd.pid";
	$server->{'log_level'} = 2;
	$server->{'log_file'} = "/var/log/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;

	# Parse command line params
	my $cmdline;
	%{$cmdline} = ();
	GetOptions(
			\%{$cmdline},
			"help",
			"config:s",
			"debug",
			"fg",
	) or die "Error parsing commandline arguments";
	
	# 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;
		}
	}
	
	#
	# Authentication plugins
	#
	my @auth_params = (
			'mechanisms',
			'users',
	);
	my $auth;
	foreach my $param (@auth_params) {
		$auth->{$param} = $config{'authentication'}{$param} if (defined($config{'authentication'}{$param}));
	}

	if (!defined($auth->{'mechanisms'})) {
		$self->log(LOG_ERR,"[SMRADIUS] Authentication configuration error: Mechanism plugins not found");
		exit 1;
	}
	if (!defined($auth->{'users'})) {
		$self->log(LOG_ERR,"[SMRADIUS] Authentication configuration error: Userdb plugins not found");
		exit 1;
	}

	# Split off plugins
	foreach my $plugin (@{$auth->{'mechanisms'}},@{$auth->{'users'}}) {
		$plugin =~ s/\s+//g;
	}

	#
	# Accounting plugins
	#
	my @acct_params = (
			'plugins',
	);
	my $acct;
	foreach my $param (@acct_params) {
		$acct->{$param} = $config{'accounting'}{$param} if (defined($config{'accounting'}{$param}));
	}

	if (!defined($acct->{'plugins'})) {
		$self->log(LOG_ERR,"[SMRADIUS] Accounting configuration error: Plugins not found");
		exit 1;
	}

	# Split off plugins
	foreach my $plugin (@{$auth->{'plugins'}}) {
		$plugin =~ s/\s+//g;
	}

	#
	# Dictionary configuration
	#
	my @dictionary_params = (
			'load',
	);
	my $dictionary;
	foreach my $param (@dictionary_params) {
		$dictionary->{$param} = $config{'dictionary'}{$param} if (defined($config{'dictionary'}{$param}));
	}

	if (!defined($dictionary->{'load'})) {
		$self->log(LOG_ERR,"[SMRADIUS] Dictionary configuration error: 'load' not found");
		exit 1;
	}
	# Split off dictionaries to load
	foreach my $fn (@{$dictionary->{'load'}}) {
		$fn =~ s/\s+//g;
	}
	
	$cfg->{'authentication'} = $auth;
	$cfg->{'dictionary'} = $dictionary;

	$cfg->{'plugins'} = [ 
		@{$auth->{'mechanisms'}},
		@{$auth->{'users'}},
		@{$acct->{'plugins'}} 
	];

	# Save our config and stuff
	$self->{'config'} = $cfg;
	$self->{'cmdline'} = $cmdline;
	$self->{'inifile'} = \%config;
}



# Run straight after ->run
sub post_configure_hook {
	my $self = shift;
	my $config = $self->{'config'};


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

	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing modules...");
	# Load plugins
	foreach my $plugin (@{$config->{'plugins'}}) {
		# Load plugin
		my $res = eval("
			use $plugin;
			plugin_register(\$self,\"$plugin\",\$${plugin}::pluginInfo);
		");
		if ($@ || (defined($res) && $res != 0)) {
			$self->log(LOG_WARN,"[SMRADIUS] Error loading plugin $plugin ($@)");
		} else {
			$self->log(LOG_DEBUG,"[SMRADIUS] Plugin '$plugin' loaded.");
		}
	}
	$self->log(LOG_NOTICE,"[SMRADIUS] Plugins initialized.");

	$self->log(LOG_NOTICE,"[SMRADIUS] Initializing system modules.");
	# Init config
	smradius::config::Init($self);
	# Init caching engine
#	smradius::cache::Init($self);
	$self->log(LOG_NOTICE,"[SMRADIUS] System modules initialized.");
	
}



# 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->{'plugins'}},$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_DEBUG,"[SMRADIUS] Starting up caching engine");
	smradius::cache::connect($self);

	# Do we need database support?
	if ($self->{'smradius'}->{'database'}->{'enable'}) {
		# 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'} = smradius::dbilayer::Init($self);
		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: ".smradius::dbilayer::internalErr()." ($$)");
		}
	}
	
}



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

	$self->SUPER::child_finish_hook();
	
	$self->log(LOG_DEBUG,"[SMRADIUS] Shutting down caching engine ($$)");
	smradius::cache::disconnect($self);
}


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


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

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

	# Parse packet
	my $pkt = new Radius::Packet($self->{'radius'}->{'dictionary'},$udp_packet);

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


#LOGIN
#Service-Type:        Login-User
#User-Name:           joe
#User-Password:       \x{d3}\x{df}\x{10}\x{8c}\x{a0}r.\x{fd}=\x{ff}\x{96}\x{a}\x{86}\x{91}\x{e}c
#Calling-Station-Id:  10.254.254.242
#NAS-Identifier:      lbsd-test
#NAS-IP-Address:      10.254.254.239

#PPPOE:
#Service-Type:        Framed-User
#Framed-Protocol:     PPP
#NAS-Port:            19
#NAS-Port-Type:       Ethernet
#User-Name:           nigel
#Calling-Station-Id:  00:E0:4D:2A:72:35
#Called-Station-Id:   pppoe-24
#NAS-Port-Id:         ether1
#NAS-Identifier:      lbsd-test
#NAS-IP-Address:      10.254.254.239



#
# User Authentication
#

# Authentication
#a. SELECT ID, Password FROM Users WHERE Username = %u
# Optional Items:
# 	'Disabled' - Indicates the user is disabled
#
# Save the query result, so we can use it as macros....  ${user.<column name>}  below...


#
# Authorization: Attribute checks
#

# User attributes
#b. SELECT Attribute, OP, Value FROM UserAttributes WHERE UserID = ${user.id}

# Attribute groups
#c. SELECT Group FROM UsersToGroups WHERE UserID = ${user.id}
# Save the query result, so we can use it as macros... ${group.<column name>} below...

# Group attributes
#d. SELECT Attribute, OP, Value FROM GroupAttributes WHERE GroupID = ${group.id}
# Loop with groups and do the query ...

#
# Authentication procedure
#

# On user AUTH ....
#1. Execute query (a), set query result in 'user' hash
#	- Check 'disabled' parameter
#2. Run past plugins - check if we authenticate
#	- if not reject
#3. Pull in query (c), loop with groups for query (d)
#4. Merge in query (b)
#5. Check attributes that need checking
#	- reject if fail
#6. Return attributes that need to be returned


# find user
# get user
#	- User
#		- Password
#			{mech}data
#		- Data
#			(additional columns from table)
#		- Attributes (array)
#			Attribute,OP,Value
#	- Group (array)
#		- Data
#			(additional columns from table)
#		- Attributes
#			Attribute,OP,Value
# try authenticate
# check attribs


	# Main user hash with everything in
	my $user;
	# UserDB module if we using/need it
	my $userdb;

	# Common stuff for multiple codes....
	if ($pkt->code eq "Accounting-Request" || $pkt->code eq "Access-Request") {
		# Set username
		$user->{'Username'} = $pkt->attr('User-Name');
		
		#
		# FIND USER
		#

		# Loop with modules to try find user
		foreach my $module (@{$self->{'plugins'}}) {
			# Try find user
			if ($module->{'User_find'}) {
				$self->log(LOG_INFO,"[SMRADIUS] FIND: Trying plugin '".$module->{'Name'}."' for username '".$user->{'Username'}."'");
				my $res = $module->{'User_find'}($self,$user,$pkt);

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

				# 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_NOTICE,"[SMRADIUS] FIND: Username found with '".$module->{'Name'}."'");
					$userdb = $module;
					last;

				# Or a negative result
				} elsif ($res == MOD_RES_NACK) {
					$self->log(LOG_NOTICE,"[SMRADIUS] FIND: Username not found with '".$module->{'Name'}."'");
					last;

				}
			}
		}
	}


	# Is this an accounting request
	if ($pkt->code eq "Accounting-Request") {

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

		#
		# GET USER
		#

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

			# Check result
			if (defined($res) && ref($res) eq "HASH") {
				# We're only after the attributes here
				$user->{'Attributes'} = $res->{'Attributes'};
			}
		}

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

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

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

				# Check if we got a positive result back
				} elsif ($res == MOD_RES_ACK) {
					$self->log(LOG_NOTICE,"[SMRADIUS] ACCOUNTING: Accounting logged using '".$module->{'Name'}."'");

				# Check if we got a negative result back
				} elsif ($res == MOD_RES_NACK) {
					$self->log(LOG_NOTICE,"[SMRADIUS] ACCOUNTING: Accounting NOT LOGGED using '".$module->{'Name'}."'");
				}
			}
		}
		# Tell the NAS we got its packet	
		my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
	   	$resp->set_code('Accounting-Response');
		$resp->set_identifier($pkt->identifier);
		$resp->set_authenticator($pkt->authenticator);
		$udp_packet = auth_resp($resp->pack, "test");
		$server->{'client'}->send($udp_packet);


	# Or maybe a access request
	} elsif ($pkt->code eq "Access-Request") {
	
	
		$self->log(LOG_DEBUG,"[SMRADIUS] Access Request Packet");
		$self->log(LOG_DEBUG,"[SMRADIUS] Packet: ".$pkt->dump);
	
		# Authentication variables
		my $authenticated = 0;
		my $mechanism;
		# Authorization variables
		my $authorized = 0;


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

		#
		# GET USER
		#

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

			# Check result
			if (!defined($res) || ref($res) ne "HASH") {
				$self->log(LOG_WARN,"[SMRADIUS] GET: No data returned from '".$userdb->{'Name'}."' for username '".$user->{'Username'}."'");
				goto CHECK_RESULT;
			}
			# Setup user dataw
			$user->{'ClearPassword'} = $res->{'ClearPassword'};
			$user->{'Attributes'} = $res->{'Attributes'};
		} else {
			$self->log(LOG_INFO,"[SMRADIUS] GET: No 'User_get' funcation available for module '".$userdb->{'Name'}."'");

			goto CHECK_RESULT;
		}

		#
		# AUTHENTICATE USER
		#

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

				# Check result
				if (!defined($res)) {
					$self->log(LOG_DEBUG,"[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_NOTICE,"[SMRADIUS] AUTH: Authenticated by '".$module->{'Name'}."'");
					$mechanism = $module;
					$authenticated = 1;
					last;

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

				}
			}
		}

		#
		# AUTHORIZE USER
		#

		foreach my $attr (@{$user->{'Attributes'}}) {

			# Operator: ==
			#
			# Use: Attribute == Value
			# As a check item, it matches if the named attribute is present in the request,
			# AND has the given value.
			#

			if ($attr->{'Operator'} eq '==' ) {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' == '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				# Check for correct value
				if ($attrVal eq $attr->{'Value'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' matched");
					my $authorized = 1;
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' does not match");
					$authorized = 0;
					last;
				}
			}

			# Operator: >
			#
			# Use: Attribute > Value
			# As a check item, it matches if the request contains an attribute
			# with a value greater than the one given.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '>') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' > '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				if ($attrVal =~ /^[0-9]+$/) {
					# Check for correct value
					if ($attrVal > $attr->{'Value'}) {
						$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' matched");
					} else {
						$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' does not match");
						$authorized = 0;
						last;
					}
				} else {
					$self->log(LOG_WARN,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' is NOT a number!");
				}
			}

			# Operator: <
			#
			# Use: Attribute < Value
			# As a check item, it matches if the request contains an attribute
			# with a value less than the one given.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '<') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing ".$attr->{'Name'}."' < '".$attr->{'Value'}." against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				# Check for correct value
				if ($attrVal < $attr->{'Value'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' less than current value");
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' does not match");
					$authorized = 0;
					last;
				}
			}

			# Operator: <=
			#
			# Use: Attribute <= Value
			# As a check item, it matches if the request contains an attribute
			# with a value less than, or equal to the one given.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '<=') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' <= '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				# Check for correct value
				if ($attrVal <= $attr->{'Value'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' less than or equals current value");
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' greater than current value");
					$authorized = 0;
					last;
				}
			}

			# Operator: >=
			#
			# Use: Attribute >= Value
			# As a check item, it matches if the request contains an attribute
			# with a value greater than, or equal to the one given.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '>=') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' >= '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				# Check for correct value
				if ($attrVal >= $attr->{'Value'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' greater than or equals current value");
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' with value '$attrVal' less than current value");
					$authorized = 0;
					last;
				}
			}

			# Operator: =*
			#
			# Use: Attribute =* Value
			# As a check item, it matches if the request contains the named attribute,
			# no matter what the value is.
			#
			# Not allowed as a reply item.

			# Needs fixing, need to retrieve name, not value?

			if ($attr->{'Operator'} eq '=*') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' =* '".$attr->{'Value'}."' against NAS ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					$authorized = 0;
					next;
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' matched");
				}
			}

			# Operator !=
			#
			# Use: Attribute != Value
			# As a check item, matches if the given attribute is in the
			# request, AND does not have the given value.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '!=') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' != '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (!defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					next;
				}
				# Check for correct value
				if ($attrVal ne $attr->{'Value'}) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' does not match");
				} else {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' matches");
					$authorized = 0;
					last;
				}
			}

			# Operator: !*
			#
			# Use: Attribute !* Value
			# As a check item, matches if the request does not contain the named attribute, no matter
			# what the value is.
			#
			# Not allowed as a reply item.

			if ($attr->{'Operator'} eq '!*') {
				my $attrVal = $pkt->attr($attr->{'Name'});
				$self->log(LOG_DEBUG,"[SMRADIUS] Processing '".$attr->{'Name'}."' !* '".$attr->{'Value'}."' against NAS value ".niceUndef($attrVal));
				# Skip if value not defined
				if (defined($attrVal)) {
					$self->log(LOG_DEBUG,"[SMRADIUS] - Attribute '".$attr->{'Name'}."' not defined");
					$authorized = 0;
					next;
				}
			}

			# Operator: =~
			#
			# Use: Attribute =~ Value
			# As a check item, matches if the request contains an attribute which matches the given regular expression.
			# This operator may only be applied to string attributes.
			#
			# Not allowed as a reply item.

			#if ($attr->{'Operator'} eq '=~') {
			#	my $attrVal = $pkt->attr($attr->{'Name'});
			#	$self->log(LOG_DEBUG,"[SMRADIUS] Processing ".$attr->{'Name'}." '=~' ".$attr->{'Value'}." against NAS $attrVal");
			#	# Skip if value not defined
			#	if (!defined($attrVal)) {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}." not defined");
			#		next;
			#	}
			#	# Check for correct value
			#	if ($attrVal =~ /$attr->{'Value'}/) {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal does not match");
			#	} else {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal matches");
			#		$authorized = 0;
			#		last;
			#}
			#}

			# Operator: !~
			#
			# Use: Attribute !~ Value
			# As a check item, matches if the request does not contain the named attribute, no matter
			# what the value is.
			#
			# Not allowed as a reply item.

			#if ($attr->{'Operator'} eq '!~') {
			#	my $attrVal = $pkt->attr($attr->{'Name'});
			#	$self->log(LOG_DEBUG,"[SMRADIUS] Processing ".$attr->{'Name'}." '!~' ".$attr->{'Value'}." against NAS $attrVal");
				# Skip if value not defined
			#	if (!defined($attrVal)) {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}." not defined");
			#		next;
			#	}
				# Check for correct value
			#	if (!($attrVal =~ /$attr->{'Value'}/)) {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal does not match");
			#	} else {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal matches");
			#		$authorized = 0;
			#		last;
			#	}
			#}

			# FIXME - Nigel
			# Operator: +=
			#
			# Use: Attribute += Value
			# Always matches as a check item, and adds the current
			# attribute with value to the list of configuration items.
			#
			# As a reply item, it has an itendtical meaning, but the
			# attribute is added to the reply items.

			#if ($attr->{'Operator'} eq '+=') {
			#	my $attrVal = $pkt->attr($attr->{'Name'});
			#	$self->log(LOG_DEBUG,"[SMRADIUS] Processing ".$attr->{'Name'}." '+=' ".$attr->{'Value'}." against NAS $attrVal");
			#	# Skip if value not defined
			#	if (!defined($attrVal)) {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}." not defined");
			#		next;
			#	}
			#	# Check for correct value
			#	if ($attrVal == $attr->{'Value'}) {
			#		#FIXME add to config item list
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal exists and is equal to ".$attr->{'Name'});
			#	} else {
			#		$self->log(LOG_DEBUG,"[SMRADIUS] ".$attr->{'Name'}.": $attrVal exists and is not equal to ".$attr->{'Name'});
			#		$authorized = 0;
			#		last;
			#	}
			#}
		}

		# Check if we authenticated or not
		if ($authenticated && $authorized) {
			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
		 	$resp->set_code('Access-Accept');
			$resp->set_identifier($pkt->identifier);
			$resp->set_authenticator($pkt->authenticator);
			# Loop with user attributes and add to radius response
			foreach my $attr (@{$user->{'Attributes'}}) {

				#Operator: =
				#
				#Use: Attribute = Value
				#Not allowed as a check item for RADIUS protocol attributes. It is allowed for server
				#configuration attributes (Auth-Type, etc), and sets the value of on attribute,
				#only if there is no other item of the same attribute.
				#
				#As a reply item, it means "add the item to the reply list, but only if there is
				#no other item of the same attribute.

				if ($attr->{'Operator'} eq '=') {
					$resp->set_attr($attr->{'Name'},$attr->{'Value'});
				}
			}
			$self->log(LOG_DEBUG,"[SMRADIUS] User attributes:".Dumper($user));

			$udp_packet = auth_resp($resp->pack, "test");
			$server->{'client'}->send($udp_packet);

		}

CHECK_RESULT:
		# Check if found and authenticated
		if (!$authenticated) {
			my $resp = Radius::Packet->new($self->{'radius'}->{'dictionary'});
		   	$resp->set_code('Access-Reject');
			$resp->set_identifier($pkt->identifier);
			$resp->set_authenticator($pkt->authenticator);
			$udp_packet = auth_resp($resp->pack, "test");
			$server->{'client'}->send($udp_packet);
		}

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

return;
#	$pkt->dump;
#
#	# PAP
#	if ((my $rawPassword = $pkt->attr('User-Password'))) {
#
#
#		print(STDERR "RECEIVED\n");
#		print(STDERR "User-Pass: len = ".length($rawPassword).", hex = ".unpack("H*",$rawPassword)."\n");
#		print(STDERR "\n\n");
#
#		my $result = $pkt->password("test","User-Password");
#	
#		print(STDERR "CALC\n");
#		print(STDERR "Result   : len = ".length($result).", hex = ".unpack("H*",$result).", password = $result\n");
#
#	}
#
#	# CHAP
#	if ((my $rawChallenge = $pkt->attr('CHAP-Challenge')) && (my $rawPassword = $pkt->attr('CHAP-Password'))) {
#		print(STDERR "This is a CHAP challenge....\n");
#	
#		print(STDERR "RECEIVED\n");
#		print(STDERR "Challenge: len = ".length($rawChallenge).", hex = ".unpack("H*",$rawChallenge)."\n");
#		print(STDERR "Password : len = ".length($rawPassword).", hex = ".unpack("H*",$rawPassword)."\n");
#		print(STDERR "\n\n");
#
#		my $id = substr($rawPassword,0,1);
#		print(STDERR "ID: ".length($id).", hex = ".unpack("H*",$id)."\n");
#
#		my $result = encode_chap($id,$rawChallenge,"mytest");
#		
#		print(STDERR "CALC\n");
#		print(STDERR "Result   : len = ".length($result).", hex = ".unpack("H*",$result)."\n");
#		print(STDERR "\n\n");
#	}
#
#
#	# Is this a MSCHAP autehentication attempt?
#	if ((my $rawChallenge = $pkt->vsattr("311",'MS-CHAP-Challenge'))) {
#		print(STDERR "This is a MS-CHAP challenge....\n");
#
#		# MSCHAPv1
#		if (my $rawResponse = $pkt->vsattr("311",'MS-CHAP-Response')) {
#			my $challenge = @{$rawChallenge}[0];
#			my $response = substr(@{$rawResponse}[0],2);
#
#			print(STDERR "RECEIVED\n");
#			print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
#			print(STDERR "Reponse  : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
#			print(STDERR "\n\n");
#
#
#
#			print(STDERR "CHOPPED OFFF!!\n");
##			my $peerChallenge = substr($response,0,16);
#			my $NtResponse = substr($response,24,24);
##			print(STDERR "Challenge: len = ".length($peerChallenge).", hex = ".unpack("H*",$peerChallenge)."\n");
#			print(STDERR "NTRespons: len = ".length($NtResponse).", hex = ".unpack("H*",$NtResponse)."\n");
#			print(STDERR "\n\n");
#
#			my $unipass = "mytest";
#			$unipass =~ s/(.)/$1\0/g; # convert ASCII to unicaode
#			my $username = "nigel";
#
#			print(STDERR "TEST\n");
##			my $ourChallenge = ChallengeHash($peerChallenge,$challenge,$username);
#			my $ourResponse = NtChallengeResponse($challenge,$unipass);
#			print(STDERR "Calculate: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
#			print(STDERR "\n\n");
#
#
#		# MSCHAPv2
#		} elsif (my $rawResponse = $pkt->vsattr("311",'MS-CHAP2-Response')) {
#			my $challenge = @{$rawChallenge}[0];
#			my $response = substr(@{$rawResponse}[0],2);
#
#			print(STDERR "RECEIVED\n");
#			print(STDERR "Challenge: len = ".length($challenge).", hex = ".unpack("H*",$challenge)."\n");
#			print(STDERR "Reponse  : len = ".length($response).", hex = ".unpack("H*",$response)."\n");
#			print(STDERR "\n\n");
#
#
#
#			print(STDERR "CHOPPED OFFF!!\n");
#			my $peerChallenge = substr($response,0,16);
#			my $NtRespnse = substr($response,24,24);
#			print(STDERR "Challenge: len = ".length($peerChallenge).", hex = ".unpack("H*",$peerChallenge)."\n");
#			print(STDERR "NTRespons: len = ".length($NtRespnse).", hex = ".unpack("H*",$NtRespnse)."\n");
#			print(STDERR "\n\n");
#
#			my $unipass = "mytest";
#			$unipass =~ s/(.)/$1\0/g; # convert ASCII to unicaode
#			my $username = "nigel";
#
#			print(STDERR "TEST\n");
#			my $ourChallenge = ChallengeHash($peerChallenge,$challenge,$username);
#			my $ourResponse = NtChallengeResponse($ourChallenge,$unipass);
#			print(STDERR "Calculate: len = ".length($ourResponse).", hex = ".unpack("H*",$ourResponse)."\n");
#			print(STDERR "\n\n");
#
#
#
#		}
#	}
#
#
#
##	printf("GOT PACKET: user = %s/%s, nas-ip = %s, nas-port-type = %s, nas-port = %s, connect-info = %s, service-type = %s\n",
##		$pkt->attr('User-Name'), $pkt->password('test'),
##		$pkt->attr('NAS-IP-Address'),
##		$pkt->attr('NAS-Port-Type'),
##		$pkt->attr('NAS-Port'),
##		$pkt->attr('Connect-Info'),
##		$pkt->attr('Service-Type')
##	);
#
#
#	if ($pkt->code eq "Accounting-Request") {
#		my $resp = Radius::Packet->new($self->{'config'}->{'dictionary'});
#		$resp->set_code('Accounting-Response');
#		$resp->set_identifier($pkt->identifier);
#		$resp->set_authenticator($pkt->authenticator);
#		$udp_packet = auth_resp($resp->pack, "test");
#		$server->{'client'}->send($udp_packet);
#
#
#	} elsif ($pkt->code eq "Access-Request") {
#		my $resp = Radius::Packet->new($self->{'config'}->{'dictionary'});
#    	$resp->set_code('Access-Accept');
#	    $resp->set_identifier($pkt->identifier);
#	    $resp->set_authenticator($pkt->authenticator);
#	    $resp->set_attr('Framed-IP-Address' => "192.168.0.233");
#		$udp_packet = auth_resp($resp->pack, "test");
#		$server->{'client'}->send($udp_packet);
#	}
#

}



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

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

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



# Slightly better logging
sub log
{
	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";
	}

	$self->SUPER::log($level,"[".$self->log_time." - $$] $msg",@args);
}



# Display help
sub displayHelp {
	print(STDERR "SMRadius v".VERSION." - Copyright (c) 2007-2008 AllWorldIT\n");

	print(STDERR<<EOF);

Usage: $0 [args]
    --config=<file>        Configuration file
    --debug                Put into debug mode
    --fg                   Don't go into background

EOF
}




__PACKAGE__->run;


1;
# vim: ts=4