auth-filter

#!/usr/bin/perl -w
# Author: Nigel Kukard  <nkukard@lbsd.net>
# Date: 12/04/2007
# Desc: Authentication filter for GNU Radius
# License: GPL

use strict;
use Benchmark;
use Getopt::Long;
use DateTime;
use Time::HiRes qw( gettimeofday tv_interval );

# Set library directory
use lib qw(../../);

use sm::config;
use sm::dblayer;

require("common.pm");


my %optctl = ();

GetOptions(\%optctl, "help");


# Check if user wants usage
if (defined($optctl{'help'})) {
	displayUsage();
}

# Open up logfile
my $logfile = "/var/log/radius/auth-filter";
open(FH,">> $logfile") or die "Failed to open '$logfile': $!";


# Databases
my $dbh;  # Authentication
my $dbh_log;  # Logs

# Get db handle
$dbh = sm::dbilayer->new($cfg_db_DSN, $cfg_db_Username, $cfg_db_Password);
if (!$dbh) {
	print(STDERR "Error creating database object: ".sm::dbilayer->internalErr());
	exit 1;
}

# Connect to database
if ($dbh->connect() != 0) {
	print(STDERR "Error connecting to database: ".$dbh->err); 
	exit 1;
}

# Check if we must use split db's
if (defined($cfg_radiuslog_db_DSN)) {
	# Get log db handle
	$dbh_log = sm::dbilayer->new($cfg_radiuslog_db_DSN, $cfg_radiuslog_db_Username, $cfg_radiuslog_db_Password);
	if (!$dbh_log) {
		print(STDERR "Error creating database object: ".sm::dbilayer->internalErr());
		exit 1;
	}

	# Connect to database
	if ($dbh_log->connect() != 0) {
		print(STDERR "Error connecting to database: ".$dbh_log->err); 
		exit 1;
	}
# If not use the main DB
} else {
	$dbh_log = $dbh;
}


# No buffering
select((select(FH), $| = 1)[0]);
select((select(STDOUT), $| = 1)[0]);

# Loop with input
while (my $line = <STDIN>) {
	my %request;
	my @request;
	my %accessAttribs;
	my %replyAttribs;


	# Munch off \n
	chomp($line);

	# Check number of results
	if ((@request = split /:/, $line) < 6) {
		print(FH "ERROR: Number of params from radiusd: ".(@request)."/$line\n");
		print(STDOUT "1\n");
		next;
	}

	# Pull in request
	($request{'User-Name'},$request{'NAS-IP-Address'},$request{'NAS-Port-Type'},$request{'NAS-Port'},$request{'Connect-Info'},
			$request{'Service-Type'}) = @request;
	 my $dt = DateTime->from_epoch( epoch => time() );
	 $request{'Timestamp'} = $dt->strftime('%Y-%m-%d %H:%M:%S');

	# If this is a auth mechanism that called us, allow
	if ($request{'NAS-Port-Type'} eq "0" && $request{'NAS-Port'} eq "0" && $request{'Service-Type'} eq "0") {
		print(STDOUT "0\n");
		next;
	}

	my $timer0 = [gettimeofday];

	# Grab user details
	my $userData = getUser($dbh,$request{'User-Name'});
	if (ref $userData ne "HASH") {
		print(FH "ERROR: $userData\n");
		print(STDOUT "1\n");
		next;
	}

	printf(FH 'INFO: User-Name: %s, Timestamp: %s, NAS-IP-Address: %s, NAS-Port-Type: %s, NAS-Port: %s, Connect-Info: %s, Service-Type: %s, CappingType: %s, UsageCap: %s, AgentDisabled: %s'."\n",
		$request{'User-Name'},
		$request{'Timestamp'},
		$request{'NAS-IP-Address'},
		$request{'NAS-Port-Type'},
		$request{'NAS-Port'},
		$request{'Connect-Info'},
		$request{'Service-Type'},
		$userData->{'CappingType'},
		defined($userData->{'UsageCap'}) ? $userData->{'UsageCap'} : "uncapped",
		$userData->{'AgentDisabled'}
	);


	# Check user active, else insert into auth fail
	if ($userData->{'AgentDisabled'} eq "1") {
		print(FH "      - Agent disabled\n");
		print(STDOUT "1 Reply-Message = \"Your account is currently deactivated. Please, contact your ISP.\"\n");
		authFail(\%request,1);
		next;
	}

	# Pull in class attribs & check
	my $sth = $dbh->select("
			SELECT 
				Attr, OP, Value
			FROM 
				radiusClassAttribs
			WHERE 
				RadiusClassID = ".$dbh->quote($userData->{'RadiusClassID'})."
				AND OP IS NOT NULL
	");
	if (!$sth) {
		print(FH "ERROR: Selecting class attributes: ".$dbh->err."\n");
		print(STDOUT "1\n");
		next;
	}
	# Loop with class attribs and push
	while (my $item = $sth->fetchrow_hashref()) {
		push(@{$accessAttribs{$item->{'Attr'}}{$item->{'OP'}}},$item->{'Value'});
	}
	$sth->finish();
		
	# Pull in user attribs & check
	$sth = $dbh->select("
			SELECT 
				Attr, OP, Value
			FROM 
				radiusAttribs
			WHERE 
				RadiusUserID = ".$dbh->quote($userData->{'ID'})."
				AND OP IS NOT NULL
	");
	if (!$sth) {
		print(FH "ERROR: Selecting class attributes: ".$dbh->err."\n");
		print(STDOUT "1\n");
		next;
	}
	# Loop with class attribs and push
	while (my $item = $sth->fetchrow_hashref()) {
		push(@{$accessAttribs{$item->{'Attr'}}{$item->{'OP'}}},$item->{'Value'});
	}
	$sth->finish();
		
	# Loop with access attribs and push
	my $rejectAttrs = 0;
	foreach my $attr (keys %accessAttribs) {
		my $ok = 0;

		# Check if we missing something in the request	
		if (!defined($request{$attr})) {
			printf(FH "      - WARNING: Attribute '$attr' was in accessAttribs, but not request\n");
			next;
		}

		# Loop with attrib op's and check them out
		foreach my $op (keys %{$accessAttribs{$attr}}) {
			printf(FH '      - Checking %s, request="%s", op="%s", attr="%s": ',
					$attr, 
					$request{$attr},
					$op,
					join(',',@{$accessAttribs{$attr}{$op}})
			);
			# Check value against operator
			foreach my $val (@{$accessAttribs{$attr}{$op}}) {
				# Equal
				if ($op eq "=") {
					if ($request{$attr} eq $val) {
						print(FH "matched '$val'\n");
						$ok = 1;
						last;
					}
				}
			}
			# Check if we ok, if not continue
			if ($ok == 0) {
				print(FH "no match\n");
			} else {
				last
			}
		}
		# Check if we ok, if not we've been violated
		if ($ok == 0) {
			print(FH "      - Class attribute violation: '$attr'\n");
			$rejectAttrs = 1;
			last;
		}
	}
	# Check if something didn't match up
	if ($rejectAttrs == 1) {
		print(STDOUT "1 Reply-Message = \"Connection attribute mismatch. Please, contact your ISP.\"\n");
		authFail(\%request,5);
		next;
	}

	# Check user type vs. adsl & analogue/isdn

#	IF ADSL
	if ($request{'NAS-Port-Type'} eq "5") {
		# Calculate dates
		my $date = DateTime->from_epoch( epoch => time() );
		my $today = $date->ymd();
		$date->set_day(1);
	    my $thismonth = $date->ymd();
		$date->add( months => 1);
	    my $nextmonth = $date->ymd();


		# Extra query for selects
		my $extraQuery = "";

		# Check port locking, else insert into auth fail
		$sth = $dbh->select("
				SELECT 
					NASPort
				FROM 
					radiusPortLocks
				WHERE 
					RadiusUserID = ".$dbh->quote($userData->{'ID'})."
					AND AgentDisabled = 0
		");
		if (!$sth) {
			print(FH "ERROR: Selecting NAS ports: ".$dbh->err."\n");
			print(STDOUT "1\n");
			next;
		}
		# Check rows
		if ($sth->rows > 0) {
			my $found = 0;
			# Loop with port locks
			while (my $portLock = $sth->fetchrow_hashref()) {
				# Check if we found port locking
				if ($request{'NAS-Port'} eq $portLock->{'NASPort'}) {
					$found = 1;
					last;
				}
			}
			# Check if we found it
			if ($found == 0) {
				print(FH "      - Port locked\n");
				print(STDOUT "1 Reply-Message = \"Connection from unauthorized port. Please, contact your ISP.\"\n");
				authFail(\%request,4);
				$sth->finish();
				next;
			}
		}
		$sth->finish();



		# NULL - uncapped, no limits
		if (!defined($userData->{'UsageCap'})) {
			$extraQuery = "AND Timestamp > ".$dbh->quote($thismonth)." AND Timestamp < ".$dbh->quote($nextmonth);

		# > 0 - normal cap, check usage for this month, check topups for this month
		# Calculate cap user has  (acctinputoctets + (2^32 * gigawords)) /1024 / 1024
		# Calculate usage user has
		} elsif ($userData->{'UsageCap'} > 0) {
			$extraQuery = "AND Timestamp > ".$dbh->quote($thismonth)." AND Timestamp < ".$dbh->quote($nextmonth);

		# 0 - topup account
		} elsif ($userData->{'UsageCap'} == 0) {

		}

		# Grab users usage
		my $usageData = getUsage($dbh_log,$request{'User-Name'},$extraQuery);
		if (ref $usageData ne "HASH") {
			print(FH "ERROR: $usageData\n");
			print(STDOUT "1\n");
			next;
		}
		my $totalUsage = $usageData->{'Total'};

		# If we a normal or topup, check topups
		if (defined($userData->{'UsageCap'}) && ($userData->{'UsageCap'} > 0 || $userData->{'UsageCap'} == 0)) {
			# Prepare
			$extraQuery = "";

			# Only total up this month
			if ($userData->{'UsageCap'} > 0) {
				$extraQuery = "AND ValidFrom <= ".$dbh->quote($today)." AND ValidTo >= ".$dbh->quote($today);
			}

			# Get how much we've been topped up
			my $topupData = getTopups($dbh,$request{'User-Name'},$extraQuery);
			if (ref $topupData ne "HASH") {
				print(FH "ERROR: $topupData\n");
				print(STDOUT "1\n");
				next;
			}
			my $topupBw = $topupData->{'Total'};

			# Check capping, else insert into auth fail
			print(FH "      - Usage $totalUsage (Cap:".$userData->{'UsageCap'}."+Topup:$topupBw)\n");

			# Check capping
			if ($userData->{'CappingType'} == 1 && ($userData->{'UsageCap'} + $topupBw) <= $totalUsage) {
				print(FH "      - User capped\n");
				print(STDOUT "1 Reply-Message = \"Your account is has been capped. Please, contact your ISP.\"\n");
				authFail(\%request,2);
				next;
			}
		}

	
# IF ANALOGUE
	} elsif ($request{'NAS-Port-Type'} eq "0") {

# IF ISDN
	} elsif ($request{'NAS-Port-Type'} eq "2") {
	
	} else {
		print(FH "ERROR: Unknown NAS-Port-Type: ".$request{'NAS-Port-Type'}."\n");
	}

	# Pull in class attribs
	$sth = $dbh->select("
			SELECT 
				Attr, Value
			FROM 
				radiusClassAttribs
			WHERE 
				RadiusClassID = ".$dbh->quote($userData->{'RadiusClassID'})."
				AND OP IS NULL
	");
	if (!$sth) {
		print(FH "ERROR: Selecting class attributes: ".$dbh->err."\n");
		print(STDOUT "1\n");
		next;
	}
	# Loop with class attribs
	while (my $item = $sth->fetchrow_hashref()) {
		$replyAttribs{$item->{'Attr'}} = $item->{'Value'}; 
	}
	$sth->finish();

	# Pull in user attribs
	$sth = $dbh->select("
			SELECT 
				Attr, Value
			FROM 
				radiusAttribs
			WHERE 
				RadiusUserID = ".$dbh->quote($userData->{'ID'})."
				AND OP IS NULL
	");
	if (!$sth) {
		print(FH "ERROR: Selecting user attributes: ".$dbh->err."\n");
		print(STDOUT "1\n");
		next;
	}
	# Loop with user attribs
	while (my $item = $sth->fetchrow_hashref()) {
		$replyAttribs{$item->{'Attr'}} = $item->{'Value'}; 
	}
	$sth->finish();

	# Build up our attrib pairs
	my @replyAttribs;
	foreach my $key (keys %replyAttribs) {
		push(@replyAttribs,sprintf('%s = %s',$key,$replyAttribs{$key}));
	}

	my $timer1 = [gettimeofday];
	my $timediff = tv_interval($timer0,$timer1);
	printf(FH '      - Attributes => %s'."\n",join(", ",@replyAttribs));
	print(FH "Code execution took: ${timediff}s\n");

	# Reply with positive status plus , separated list of attribs
	printf(STDOUT '0 %s'."\n",join(", ",@replyAttribs));
}
close(FH);


# Log failed authentication
sub authFail
{
	my ($request,$reason) = @_;


	# Insert entry into auth fail table
	my $sth = $dbh_log->do("
		INSERT INTO radiusAuthFail 
				(
					Username,
					Timestamp,
					NASIPAddress,
					NASPortType,
					NASPort,
					ConnectInfo,
					ServiceType,
					Reason
				) 
		VALUES
				(
					".$dbh->quote($request->{'User-Name'}).",
					".$dbh->quote($request->{'Timestamp'}).",
					".$dbh->quote($request->{'NAS-IP-Address'}).",
					".$dbh->quote($request->{'NAS-Port-Type'}).",
					".$dbh->quote($request->{'NAS-Port'}).",
					".$dbh->quote($request->{'Connect-Info'}).",
					".$dbh->quote($request->{'Service-Type'}).",
					".$dbh->quote($request->{'Reason'})."

				)
	");
	if (!$sth) {
		print(FH "ERROR: Failed to insert radius auth fail data: ".$dbh_log->err."\n");
	}
}



# Display usage
sub displayUsage {
	print("Usage: $0 [--quiet]\n");
	exit 0;
} 


# vim: ts=4