

use strict;

# This is very important ! Without this script will not get the filled  hashesh from main.
use vars qw(%RAD_REQUEST %RAD_REPLY %RAD_CHECK);
use Data::Dumper;


## SAMU
use MIME::Base64;
use MIME::Base64::URLSafe;
use LWP::Simple;
use Crypt::CBC;
use String::Random qw(random_regex random_string);
use Digest::SHA qw(sha256_hex sha256);
use DBI;

##------------------------ CONFIG PARAMS


#----DATABASE CONNECTION PARAMS
	my $DB_name = 'ic_db1';
	my $DB_username = 'raduser1';
	my $DB_password = 'radpass1';

#----ENCRYPTION PARAMS
	# Encryption $key, 256 bits = 32 bytes, SHA256 of the string $key.
	# If you want NO encryption, only base64 coding for transmission purposes, assign this value to undef (no quotes);
	my $key = 'clave';
	# Where apply for an Infocard-URL
	my $preurl = 'https://idp.ic/module.php/InfoCard/STS_card_issuer.php';



# This is hash wich hold original request from radius
#my %RAD_REQUEST;
# In this hash you add values that will be returned to NAS.
#my %RAD_REPLY;
# This is for check items
# my %RAD_CHECK;

#
# This the remapping of return values
#
       use constant    RLM_MODULE_REJECT=>    0;#  /* immediately reject the request */
       use constant    RLM_MODULE_FAIL=>      1;#  /* module failed, don't reply */
       use constant    RLM_MODULE_OK=>        2;#  /* the module is OK, continue */
       use constant    RLM_MODULE_HANDLED=>   3;#  /* the module handled the request, so stop. */
       use constant    RLM_MODULE_INVALID=>   4;#  /* the module considers the request invalid. */
       use constant    RLM_MODULE_USERLOCK=>  5;#  /* reject the request (user is locked out) */
       use constant    RLM_MODULE_NOTFOUND=>  6;#  /* user not found */
       use constant    RLM_MODULE_NOOP=>      7;#  /* module succeeded without doing anything */
       use constant    RLM_MODULE_UPDATED=>   8;#  /* OK (pairs modified) */
       use constant    RLM_MODULE_NUMCODES=>  9;#  /* How many return codes there are */



## Request an InfoCard
# Input: username, cardid
# Output: InfoCard-URL
sub get_InfoCard {
	# Username/cardid
	my $username = $_[0];
	my $cardid = $_[1];
	
	my $iv = ''; #Do NOT change it, initialization
	my ($cipher, $encrequest, $response);
	
	if (defined($key)){
		my $enckey = pack("H*",sha256_hex($key));
		# IV, 16 bytes
		$iv = random_regex('.' x 16);
		# Initialize cipher
		$cipher = Crypt::CBC->new( -literal_key=>1, -key => $enckey, -cipher => 'Rijndael', -iv => $iv, -header=>'none');
	}
	
	#Encapsulate data (username size + username + cardid size + cardid)
	#Attribute MUST NOT begin with a number
	
	my $request = length($username).$username.length($cardid).$cardid;
	
	# Encrypt request
	if (defined($key)){
		$encrequest = $cipher->encrypt($request);
	} else {
		$encrequest = $request;
	}

	# Retrieve data	
	my $url = $preurl."?data=".urlsafe_b64encode($encrequest)."&iv=".urlsafe_b64encode($iv)."&ident=RADIUS";
	my $encresponse = decode_base64(get $url);
	
	# Decrypt data
	if (defined($key)){
		$response = $cipher->decrypt($encresponse);
	} else {
		$response = $encresponse;
	}
	&radiusd::radlog(1, "URL: $response");
	return $response;
}



# Input: EAP-message
# Output: Card Id or NULL
## pending improvements PARSE the eap-message in a better way
sub get_Card_Id {
	my ($pos, $len, $vendor, $type, $data_length, $data);
	if (uc($RAD_REQUEST{'EAP-Message'})=~/(.{3}7.{4}00534D48.*)$/) {
			
		$pos = 0;
		$len = 0;
				
		#TLV_type (2 bytes)
		$len = 4;
		$type = substr($1, $pos, $len);
		$pos += $len;
		
		#Data Length (2 bytes)
		$len = 4;
		$data_length = hex("0x".substr($1, $pos, $len))*2; #*2 because we are in hex mode (2 hex chars = 1 byte)
		$pos += $len;

		#Vendor id (4 bytes)
		$len = 8;
		$vendor = substr($1, $pos, $len);
		$pos += $len;
		
		#Data
		$len = $data_length;
		$data = pack("H*",substr($1, $pos, $len));
		
		return $data;
	}
	
	return "";
}



##MODEL DATA FUNCTIONS

# INPUT: $RAD_REQUEST('User-Name')
# OUTPUT: Password, taken from a database, ldap, etc
sub get_Password{
	# Username
	my $userID = $_[0];
	my $retval;
	my $dbh = DBI->connect("dbi:Pg:dbname=$DB_name", $DB_username, $DB_password) or die "ERROR: could not connecto to database";
	my $sth = $dbh->prepare('SELECT cleartext_password FROM users WHERE name = ?') or die "Couldn't prepare statement: " . $dbh->errstr;
	$sth->execute($userID) or die "Couldn't execute statement: " . $sth->errstr;
	my @data = $sth->fetchrow_array();
	if (@data==0){
		$retval = ''; #NULL
	} else {
		$retval = $data[0];
	}
	$sth->finish;
	$dbh->disconnect();
	return $retval;
}


# INPUT: $RAD_REQUEST('User-Name'), Self issued card ID, authentication-method
# OUTPUT: Set the user connected in the database
sub connect_user{
	my $userID = $_[0];
	my $self_card_id = $_[1];
	my $auth_method = $_[2];
	
	&disconnect_user($userID);
	
	my $dbh = DBI->connect("dbi:Pg:dbname=$DB_name", $DB_username, $DB_password) or die "ERROR: could not connecto to database";
	my $sth = $dbh->prepare('INSERT INTO connected_users (name, self_card_id, auth_method) VALUES (?,?,?)') or die "Couldn't prepare statement: " . $dbh->errstr;
	$sth->execute($userID, $self_card_id, $auth_method) or die "Couldn't execute statement: " . $sth->errstr;
	$sth->finish;
	$dbh->disconnect();	
	return 0;
}


# INPUT: $RAD_REQUEST('User-Name')
# OUTPUT: Set the user disconnected in the database
sub disconnect_user{
	my $userID = $_[0];
	
	my $dbh = DBI->connect("dbi:Pg:dbname=$DB_name", $DB_username, $DB_password) or die "ERROR: could not connecto to database";
	my $sth = $dbh->prepare('DELETE FROM connected_users where name = ?') or die "Couldn't prepare statement: " . $dbh->errstr;
	$sth->execute($userID) or die "Couldn't execute statement: " . $sth->errstr;
	$sth->finish;
	$dbh->disconnect();	
	
	return 0;
}




#RADIUS HARD STUFF
#In this Hash I'll store user status
my %user_status;


# Function to handle authorize
sub authorize {
	&radiusd::radlog(1, "----------->    AUTORIZACION");

# for (keys %RAD_REQUEST) {&radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");}
# for (keys %RAD_REPLY) {&radiusd::radlog(1, "RAD_REPLY: $_ = $RAD_REPLY{$_}");}
# for (keys %RAD_CHECK) {&radiusd::radlog(1, "RAD_CHECK: $_ = $RAD_CHECK{$_}");}
for (keys %user_status) {&radiusd::radlog(1, "user_status: $_ = $user_status{$_}");}
	

	if (($RAD_REQUEST{'EAP-Type'} eq "MS-CHAP-V2") && (!exists($user_status{$RAD_REQUEST{'User-Name'}}))){
		$user_status{$RAD_REQUEST{'User-Name'}} = 1;
		$RAD_CHECK{'Cleartext-Password'} = &get_Password($RAD_REQUEST{'User-Name'});
		return RLM_MODULE_UPDATED;
	} else {
		if (($user_status{$RAD_REQUEST{'User-Name'}}==1) && ($RAD_REQUEST{'EAP-Type'} eq "PEAP")){
			$user_status{$RAD_REQUEST{'User-Name'}} = 2;
			return RLM_MODULE_UPDATED;
		} elsif (($user_status{$RAD_REQUEST{'User-Name'}}==2) && ($RAD_REQUEST{'EAP-Type'} eq "MS-CHAP-V2")){
			my ($cardid) = &get_Card_Id;
			if ($cardid ne ""){
				&connect_user($RAD_REQUEST{'User-Name'},$cardid,$RAD_REQUEST{'EAP-Type'});
				&radiusd::radlog(1, "----------->    CARDID $cardid");
				#Request an Infocard for the user to the STS
				$RAD_REPLY{'EDUROAM-Card-URL'} = &get_InfoCard($RAD_REQUEST{'User-Name'},$cardid);
			}
			
			return RLM_MODULE_UPDATED;
		} else {
			delete($user_status{$RAD_REQUEST{'User-Name'}});
		}
	}
	return RLM_MODULE_NOOP;



# 	if ($RAD_REQUEST{'EAP-Type'} eq "MS-CHAP-V2") {
# 		if(!exists($state{$RAD_REQUEST{'User-Name'}})){
# 			$state{$RAD_REQUEST{'User-Name'}} = 1;
# 		}
# 	}
# 
# 	if ($state{'User-Name'}==0){
# 		if ($RAD_REQUEST{'EAP-Type'} eq "MS-CHAP-V2") { #Set password for mschap auth
# 			$state=1;
# 			$RAD_CHECK{'Cleartext-Password'} = &get_Password($RAD_REQUEST{'User-Name'});
# 			return RLM_MODULE_UPDATED;
# 		}
# 	} elsif ($state==1){
# 		if ($RAD_REQUEST{'EAP-Type'} eq "PEAP") { #Right way to victory
# 			$state=2;
# 			return RLM_MODULE_UPDATED;
# 		} else {
# 			$state=0;
# 		}
# 	} elsif ($state==2){
# 		if ($RAD_REQUEST{'EAP-Type'} eq "MS-CHAP-V2") { #Issue card url
# 			$state=3;
# 			my ($cardid) = &get_Card_Id;
# 			if ($cardid ne ""){
# 				&connect_user($RAD_REQUEST{'User-Name'},$cardid,$RAD_REQUEST{'EAP-Type'});
# 				&radiusd::radlog(1, "----------->    CARDID $cardid");
# 				#Request an Infocard for the user to the STS
# 				$RAD_REPLY{'EDUROAM-Card-URL'} = &get_InfoCard($RAD_REQUEST{'User-Name'},$cardid);
# 				return RLM_MODULE_UPDATED;
# 			}
# 		} else {
# 			$state=0;
# 		}
# 	} elsif ($state==3){
# 	}
# 
# 	return RLM_MODULE_NOOP;
}

# Function to handle authenticate
sub authenticate {
        &radiusd::radlog(1, "----------->    AUTENTICACION");
       # For debugging purposes only
#       &log_request_attributes;
        return RLM_MODULE_OK;
}

# Function to handle preacct
sub preacct {
       # For debugging purposes only
#       &log_request_attributes;
	&radiusd::radlog(1, "----------->    PRE ACCOUNTING");

       return RLM_MODULE_OK;
}

# Function to handle accounting
sub accounting {

	&radiusd::radlog(1, "----------->    ACCOUNTING");
for (keys %RAD_REQUEST) {&radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");}
for (keys %RAD_REPLY) {&radiusd::radlog(1, "RAD_REPLY: $_ = $RAD_REPLY{$_}");}
for (keys %RAD_CHECK) {&radiusd::radlog(1, "RAD_CHECK: $_ = $RAD_CHECK{$_}");}
	return RLM_MODULE_OK;
}

# Function to handle checksimul
sub checksimul {
       # For debugging purposes only
#       &log_request_attributes;

       return RLM_MODULE_OK;
}

# Function to handle pre_proxy
sub pre_proxy {
       # For debugging purposes only
#       &log_request_attributes;

       return RLM_MODULE_OK;
}

# Function to handle post_proxy
sub post_proxy {
       # For debugging purposes only
#       &log_request_attributes;

       return RLM_MODULE_OK;
}

# Function to handle post_auth
sub post_auth {
       # For debugging purposes only
#       &log_request_attributes;
        &radiusd::radlog(1, "----------->    POST-AUTH");
	for (keys %RAD_REQUEST) {
               &radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
       }
       return RLM_MODULE_OK;
}

# Function to handle xlat
sub xlat {
       # For debugging purposes only
#       &log_request_attributes;

       # Loads some external perl and evaluate it
       my ($filename,$a,$b,$c,$d) = @_;
       &radiusd::radlog(1, "From xlat $filename ");
       &radiusd::radlog(1,"From xlat $a $b $c $d ");
       local *FH;
       open FH, $filename or die "open '$filename' $!";
       local($/) = undef;
       my $sub = <FH>;
       close FH;
       my $eval = qq{ sub handler{ $sub;} };
       eval $eval;
       eval {main->handler;};
}

# Function to handle detach
sub detach {
       # For debugging purposes only
#       &log_request_attributes;

       # Do some logging.
       &radiusd::radlog(0,"rlm_perl::Detaching. Reloading. Done.");
} 

#
# Some functions that can be called from other functions
#

sub test_call {
       # Some code goes here
}

sub log_request_attributes {
       # This shouldn't be done in production environments!
       # This is only meant for debugging!
       for (keys %RAD_REQUEST) {
               &radiusd::radlog(1, "RAD_REQUEST: $_ = $RAD_REQUEST{$_}");
       }
}
