#! /usr/bin/perl -w
# $Id: gatekeeper.in 46959M 2017-09-19 09:40:28Z (local) $
# $URL: https://svn.uvt.nl/its-id/trunk/sources/pwdmodifier/gatekeeper/src/gatekeeper.in $
use MIME::Base64;
use strict;
use warnings FATAL => 'all';
use Carp qw(confess carp croak cluck);
use Time::Local;

our $testlibdir;
our $LOCALSTATEDIR;
our $VERSION;
our $PACKAGE = "gatekeeper";
our $SYSCONFDIR;

BEGIN {
	$LOCALSTATEDIR    = "/usr/local/var/gatekeeper";
	$SYSCONFDIR       = "/usr/local/etc/gatekeeper";
	$VERSION = "2.39";

	$testlibdir =  '';
	if($testlibdir ne '@TEST'.'LIBDIR@' and $testlibdir) {
		unshift(@INC, "$testlibdir");
	}
}
binmode STDOUT, ':utf8';
use utf8;
use Data::Dumper;
use Baseobject;
use Errorlog;
use Net::LDAPS;
use Crypt::Cracklib;
use UvT::PwdModifier::Conduit;
use UvT::PwdModifier::Replacer;
use UvT::PwdModifier::Directory;
use UvT::PwdModifier::ControlTower;

use CGI;
use Email::Valid;
use Encode;

my $skipEND = 0;

my $log;
my $uidFromToken;
my $temporarely_offline = "The service is momentarily off line, the maintainer has been notified.\nPlease try again later";
my $polite_message = $temporarely_offline;

my $cgi = new CGI();
# read cgi-parameters
my $cgiparams = $cgi->Vars();
$cgiparams = {map {	eval { $_ = Encode::decode_utf8($_, Encode::FB_CROAK) } // utf8::upgrade($_); $_} %$cgiparams};
$log->debug($log->inspect($cgiparams));

my $language = getLanguage();

BEGIN {
	$log = new Errorlog({
		output => [qw ( syslog )],
		newrunmarker => "-- version: $VERSION  ".'-'x60,
					  });
	warn "Errorlog problem:", $log->error() if $log->error();
}

$log->debug ( "Verbosity level ". Baseobject::verbosity);

sub replacable {
	my $var = shift // '';
	return new UvT::PwdModifier::Replacable($var);
}

# read configuration
my $cf= new Readconfig ({
	'language' => $language,
	'needs' => [  qw (
             adDeviceAttribs
             SHAConcatenation
             capath
             cracklib_pw_dict
             ldapRetries
             ldap_orgstat
             rememberPassword
             urgencyClass
             validatepasswords
			 )]});
die "Error in configuration for cf", $cf->error() if $cf->error();

my $feedbackConfig = new Readconfig ({
	'configfile' => "$SYSCONFDIR/gatekeeper.feedback",
	'language' => $language,
	'allows' => [ '.*' ] });
die "Error in configuration: ", $feedbackConfig->error() if $feedbackConfig->error();

$cf->mergedata($feedbackConfig);
my $implementation;

if ($SYSCONFDIR =~ /\/home\//){
	$implementation = 'test';
} else {
	$implementation = 'production';
}

my $isc = new Readconfig ({
	'configfile' => "${implementation}Specific.cf",
	'needs' => [ qw (
             ldapbase
             ldaphost
             staticUrlPrefix
             ssh_pubkey2keymaster
             keymaster)]}
	);

die "Error in configuration: ", $isc->error() if $isc->error();

$cf->mergedata($isc);

my $cfhash = $cf->hash();
die "Error in configuration for cf", $cf->error() if $cf->error();

sub makeUrgencyClassHash {
	my $urgencyClass = $cfhash->{urgencyClass};
	$urgencyClass =~ s/[\n]//g;  
	my $h;

	my @groups = split(/\s*;\s*/, $urgencyClass);
	foreach my $group (@groups) {
#		warn "group: $group";
		my ($attrib, $pairs) = split (/:/, $group );
#		warn "attrib: $attrib, pairs: $pairs";

		my @pairs = split(',', $pairs);
		foreach my $pair (@pairs) {
#			warn "pair: $pair";

			next unless $pair; 
			my ($values, $class) = split(/\s*\=\s*/, $pair);
			next unless $class;
			my (@values) = split(/\s+/, $values);
			foreach my $value (@values){
				next unless $value;
				$h->{$attrib}->{$value} = $class;
			}		
		}
	}
	$h;
}
 
my $urgencyClassHash  = makeUrgencyClassHash();
#warn Dumper('urgencyClassHash', $urgencyClassHash);

my $sshpubkey = $cfhash->{ssh_pubkey2keymaster};

die "Error in configuration for cf", $cf->error()
	if $cf->error();

die "configuration error:", "ssh_pubkey2keymaster: \"$sshpubkey\", file not found "
	unless -e $sshpubkey;

my $thash;
my $tryagain=0;
my $returnpage;
my $userInfo;

my $template_cf = new Readconfig (
	{ 'configfile'=>"$SYSCONFDIR/gatekeeper.template",
	  'language'=>$language,
	  'allows'  => [ '.*' ],
	});

die "Error in configuration for template_cf", $template_cf->error() if $template_cf->error();

#read this string again, now we have read the configfiles
$temporarely_offline =  $cf->value('offline');

$thash = {};
my $nhash = $template_cf->hash();
while (my ($key, $value) = each(%$nhash)) {
	$thash->{$key} = replacable($value);
}

$thash->{_version} =  replacable($VERSION);

# warn $log->inspect($thash);

my $ipaddress = $ENV{REMOTE_ADDR};
die "REMOTE_ADDR not defined!\n"
	unless defined $ipaddress;

die 'Script should only be called via HTTPS!'
	unless $ENV{HTTPS};

my @params = qq ( ssh $cfhash->{keymaster} -T -i $sshpubkey );
$log->debug("params for conduit: @params");
my $conduit = new UvT::PwdModifier::Conduit(command => \@params);

#####  algemeen  ######################################################
sub formatTime {
	my $time = shift;
	$time = time unless defined($time);

	my ($sec, $min, $hours, $mday, $month, $year, $wday, $yday) = localtime $time;

	my ($day, $monthName);
	if ($language eq 'nl') {
		$day = qw(zondag maandag dinsdag woensdag donderdag vrijdag zaterdag)[$wday];
		$monthName = qw(januari februari maart april mei juni juli augustus september oktober november december) [$month];
	} else {	
	$day = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday)[$wday];
		$monthName = qw(January February March April May June July August September October November December)[$month];
	}
	$year +=  1900;
	return "$day $mday $monthName $year";
}

sub rememberPassword {
	if ($cfhash->{rememberPassword}) {
		$thash->{_password} = $cgi->param('password') || '';
	} else {
		$thash->{_password} = '';
	}
}

sub getUID {
	my $cgi = shift;
	my $uid = $cgi->param('uid') || $cgi->param('_uid') || $uidFromToken || '';
	$uid =~ s/\s+//g;
	$uid;
}

sub gatherUserInfo {
	my $uid = shift;
	my $missingUIDError = shift // 'missingUID';
	
	unless ($uid) {
		cluck "No uid";
		die ['userError',$missingUIDError];
	}
	my $dir = new UvT::PwdModifier::Directory(cf => $cf);
	my ($entry, $err) = $dir->getAccount($uid);
	if ($err) {
		warn "user not found: $uid; $err";
		return 0 ;
	}

	$userInfo = $entry->stuff("joinArrays");
	$userInfo->{anr} = $entry->anr;

#	warn "UserInfo";
#	warn Dumper($userInfo);
	
	my $pwdchanged = 'datePasswdChanged';
	$userInfo->{$pwdchanged} = formatTime($userInfo->{$pwdchanged});

	while (my ($key, $value) = each %$userInfo ) {
#		warn "value: $value, ref: " . ref ($value); 
		$value = join('/', @{$value}) if ref($value) eq 'ARRAY';
		$thash->{"_$key"} = $value;
		$value = '' unless $value;
#		warn "key: $key, value: $value";
	}

	return 1;
}

sub verifyPassword {
	my ($uid, $password) = @_;

	return 1 if ($userInfo && $userInfo->{passwordStatus} && $userInfo->{passwordStatus} =~/closed|hijacked|set-only/);

	my $dir = new UvT::PwdModifier::Directory(cf => $cf);
	my $err = $dir->verify_password($uid, $password, $cfhash->{SHAConcatenation});
	return !$err;
}

sub convertLine {
	my $line = shift;
	if ($cfhash->{$line}) {
		$line = $cfhash->{$line}
	} else {
		cluck "unconverted message: '$line'" if Baseobject::verbosity() > 1;
	}
	return $line;
}

sub convertMessage {
	my $message = shift;
	return convertLine($message) unless ref($message);
	
	if (ref($message) eq 'ARRAY') {
		my $combinedMessage  = '';
		foreach my $line (@$message) {
			my $res = convertLine($line);
			$combinedMessage .= "$res\<br\>" if $res;
		}
		return $combinedMessage if $combinedMessage;
	}
	return $message;
}


sub handleException {
	my $var = $@;
	if(ref $var) {
		warn "Exception";
		warn Dumper ($var);

		my ($error, $message) = @$var;
		cluck "Error: $error, message: $message";
		$message = convertMessage($message);

		$log->end() if ($error eq 'systemError');
		return ($error, $message);

	} else {
		warn "Error: \"$var\"";
		$log->end();
		return 'systemError', $cfhash->{'offline'};
	}
}

sub requestControlTower {
	my $command = shift;
	my $uid = getUID($cgi);
	confess ['userError','enterYourUID'] unless $uid;
	my $adminStatus = 0;
	$adminStatus = 1 if $cgi->param('admin') or $cgi->param('token');
	if ($adminStatus) {
		$userInfo->{changed_by} = 'someOneElse';
	} else {
		$userInfo->{changed_by} = '_self_';
	}
	my $dir = new UvT::PwdModifier::Directory(cf => $cf);
	my $controlTower = new UvT::PwdModifier::ControlTower('userinfo' => $userInfo, 
														  'debug' => $Baseobject::verbosity >= 1,
														  'readonly' => 1,
														  'dir' => $dir);
	$controlTower->regulateTraffic($command);

	if ($controlTower->error) {
		$log->debug("ControlTower error");
		$log->debug(Dumper($controlTower->{fields}->{details}));
		$log->debug(Dumper($controlTower->{fields}->{message}));
		die ['userError', $controlTower->{fields}->{message}]; 
	} 
}


sub engageConduit {
	my $command = $_[0];
	my $token = $cgi->param('token');
	requestControlTower($command) unless $token;

	my ($status, $res) = $conduit->engage(@_);
	$log->debug( "res: ", Dumper($res));
	$log->debug( "status: ", Dumper($status));

	unless($status eq 'success') {
		warn "Engage dying, status: $status";
		my $feedbackmessage = $res->{message};
		$feedbackmessage = convertMessage($feedbackmessage);

#		Dit toont soms ook interne errors en regelnummers, toon alleen als de details beginnen met: "Explanation: "
		if (defined ($res->{details}) &&  $res->{details} =~ s/^Explanation:\s//) {
			$feedbackmessage .= "<br>" . $res->{details}
		}
		die [$status, $feedbackmessage];
	}
	return $res;
}

sub mergeActionTemplate {
	my ($action, $feedbacktype, $feedbackmessage) = @_;

	$thash->{_action} = $action;
	$log->debug("ACTION: $action");
	$log->debug( "FEEDBACK: $feedbacktype; \"$feedbackmessage\"") if $feedbacktype and $feedbackmessage;
	# giet de confighash in de template, one melting pot...
	while(my ($key, $val) = each(%$cfhash)) {
		$thash->{$key} = replacable($val);
	}

	foreach my $template ("gatekeeper.jacket", "$action.template") {
		my $conf = new Readconfig({
				configfile => "$SYSCONFDIR/$template",
				language => $language,
				allows => [ '.*' ],
			});
		die $conf->error if $conf->error;
		my $confhash = $conf->hash();
		while(my ($key, $val) = each(%$confhash)) {
			$thash->{$key} = replacable($val);
		}
	}

	my $rfeedbacktype = $feedbacktype || 'userError';
	my $rfeedbackmessage = $feedbackmessage || $thash->{initialFeedback} || '';

	$thash->{_feedbacktype} = replacable($rfeedbacktype);
	$thash->{_feedbackmessage} = replacable($rfeedbackmessage);
}

##### getQAM/setQAM #######################################################
sub getQAMStatus {
	my $cgi = shift;
	my $uid = getUID($cgi);
	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');

	return undef unless $uid;
	my $res;
	eval {
		my %args = (
			ipaddress => $ipaddress,
			victim => $uid,
			);
		$res = engageConduit('getqamstatus', \%args);
		$log->debug( Dumper($res));
	};
	return $res;
}


sub displayQAMStatus {
	my $qamstatus = shift;
	$log->debug("qamstatus3: ", Dumper($qamstatus));
	$log->debug("within displayQAMStatus");

	while (my ($key, $value) =  each %$qamstatus ) {
		warn "key: $key, value: $value";
		$thash->{"${key}"} = replacable('$iconActivatedImage') if ($value);
	}
}


sub argsQAM {
	my $cgi = shift;
	my $action = shift;

	my $uid = getUID($cgi);
	die ['userError', 'insufficient_credentials']
		unless $uid;

	my $password = $cgi->param('password');
	die ['userError', 'insufficient_credentials']
		unless $password;

	my $mail = $cgi->param('extraMail');
	if ($mail) {
		die ['userError', 'emailunlikely'] 
			unless Email::Valid->address(-address => $mail);
	}

	my %args = (victim => $uid, ipaddress => $ipaddress, password => $password);

	foreach(@_) {
		my $val = $cgi->param($_) || '';
		$args{$_} = $val;
	}
	return engageConduit($action, \%args);
}

sub getQAM {
	return argsQAM(shift, 'getqam');
}

sub setQAM {
	return argsQAM(shift, 'setqam', qw(Q1 Q2 A1 A2 extraMail));
}

##### changeqam ###########################################################


sub changeQAMReadyPage {
	my ($cgi, $feedbacktype, $feedbackmessage, $res) = @_;

	# nb: éérst changeQAMPage aanroepen, daarna variabelen overschrijven
	mergeActionTemplate('changeQAM', $feedbacktype, $feedbackmessage);
	# Yet Another Template!
	mergeActionTemplate('ready');

	@$thash{ map { "_$_" } keys %$res} = values %$res;
	$thash->{_setMailAddress} = replacable('$setMailAddress');
	gatherMailAddresses();
	$thash->{_readySwitch} = replacable('$readyQAM');
	$thash->{"_time"} = formatTime($res->{time});
}

sub changeQAMPage {
	my ($cgi, $feedbacktype,  $feedbackmessage) = @_;
	mergeActionTemplate('changeQAM', $feedbacktype, $feedbackmessage);
	rememberPassword();
 	foreach my $q (qw(Q1 Q2 A1 A2 extraMail)) {
		$thash->{"_$q"} = $cgi->param($q) || '';
	}
}

sub changeQAMAuthenticatedPage {
	my ($cgi, $feedbacktype, $feedbackmessage, $res) = @_;
	changeQAMPage($cgi, $feedbacktype, $feedbackmessage);
	@$thash{ map { "_$_" } keys %$res} = values %$res;
	$thash->{_setMailAddress} = replacable('$setMailAddress');
	$thash->{_setQuestionsSection} = replacable('$setQuestionsSection');
	$thash->{"_time"} = formatTime($res->{time});
}


sub changeqam {
	my $cgi = shift;

	$log->verbose("changeqam");
	my $res;
	eval {
		my $uid = getUID($cgi);
		die ['userError', 'insufficient_credentials']
			unless $uid;
		gatherUserInfo($uid) or die ['userError', 'accountunknown'];

		my $feedbacktype = "";
		my $feedbackmessage = "";
		if($cgi->param('changed') || $cgi->param('token')) {
			$feedbacktype = 'success';
			$feedbackmessage = $cfhash->{qammodified};
			$res= setQAM($cgi);
			$log->debug(Dumper ($res));
			$feedbacktype = $res->{message} if $res->{message};
			if ($feedbacktype eq 'success') {
				changeQAMReadyPage($cgi, $feedbacktype, $feedbackmessage, getQAM($cgi));
				return;
			}
		}
		changeQAMAuthenticatedPage($cgi, $feedbacktype, $feedbackmessage, getQAM($cgi));
	};
	return unless $@;
	my $saved = $@;
	warn "changeqam DIED: ", Dumper($saved);

	# als er al parameters werden meegegeven neem de Ready page
	if ($cgi->param('extraMail')|| $cgi->{'Q1'}) {
		$@ = $saved;
		changeQAMAuthenticatedPage($cgi, handleException);
	} else {
		$@ = $saved;
		changeQAMPage($cgi, handleException);
	}
}

##### setPassword ###################################################

sub setPasswordPage {
	my ($cgi, $feedbacktype, $feedbackmessage, $keymasterToken) = @_;
	my $token = $keymasterToken || $cgi->param('token')||'';
	my $admin = $cgi->param('admin');

	mergeActionTemplate('setPassword', $feedbacktype, $feedbackmessage);

	my $victim = getUID($cgi);
	if ($victim) {
		gatherUserInfo($victim) or die ['userError', 'accountunknown'];
		$log->debug( "found victim: $victim");
	} else	{
		$thash->{'_userInformation'} = replacable('');
	}

	# zet dit uit anders krijgt de gebruiker na de tweede gefaalde poging plotseling 
	$thash->{'_userInformation'} = replacable('') unless $admin;

	# expliciete action als afkomstig via een andere action met een token
	my $url = $cgi->url();
	$thash->{_newAction} = replacable("action=\"$url/setpassword\"");

	$thash->{_token} =  $token;
	$thash->{_newpwd1} = '';
	$thash->{_newpwd2} = '';
}

# vraagt niet op het oude password
sub setpassword {
	my $cgi = shift;
	eval {
		my $res = doSetPwd($cgi, 'setPwd');
		changePasswordReadyPage($cgi,$res);
		$log->debug("Dumper");
		$log->debug(Dumper($res));
	};
	return unless $@;
	setPasswordPage($cgi, handleException);
}

sub answerQuestionsPage {
	my ($cgi, $res, $number, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('answerQuestions', $feedbacktype, $feedbackmessage);

	$thash->{_number} = $number;
#	carp Dumper $res;
	if ($res->{"Q$number"} or $cgi->param("Q$number")) {
		$thash->{_switchUsername} = replacable('');
	} else {
		$thash->{_answerQuestions} = replacable('');
	}

	$thash->{_switchShowQuestion}  = replacable ("\$sw_showQuestion$number");
	$thash->{_question} = $res->{"Q$number"} || $cgi->param("Q$number") || '';
	$thash->{_token} = $res->{token} || $cgi->param("token") || '';
	$thash->{_answer} = $cgi->param("A$number") || '';
}

sub answerquestions {
	my $cgi = shift;
	my $answer = $cgi->param('answer');
	my $number = 1;
	my $A1 = $cgi->param('A1');
	my $A2 = $cgi->param('A2');
	my $Q1 = $cgi->param('Q1');
	my $Q2 = $cgi->param('Q2');

	eval {
		my $uid = getUID($cgi);
		die ['userError', 'missingUID']
			unless $uid;

		gatherUserInfo($uid) or die ['userError', 'noquestions'];
		requestControlTower('getqam');

		my %args = (victim => $uid, ipaddress => $ipaddress);

 		if($A2) {
			$number = 2;
			my $token = $cgi->param('token');
			die ['userError', "missing token parameter"]
				unless $token;
			my $res = engageConduit('verifyQ2', {%args, answer => $A2, token => $token});
			setPasswordPage($cgi, '', '', $res->{token});

		} elsif($A1) {
			die ['userError', "let's not get greedy here"]
				if $A2;

			my $res = engageConduit('verifyQ1', {%args, answer => $A1});
			$number = 2;
			answerQuestionsPage($cgi, $res, $number);
		} else {
			my $res = engageConduit('getQ1', \%args);
			$log->debug(Dumper ($res));
			die ['userError', "noquestions"] unless $res->{Q1};
			answerQuestionsPage($cgi, $res, $number);
		}
	};
	return unless $@;
	#answerQuestionsPage($cgi,question, number, feedbacktype, feedbackmessage);
	my $saved = $@;
	warn "DIED with ", Dumper($saved);

	my $res = {Q1 => ''};
	$@ = $saved;
	answerQuestionsPage($cgi, $res, $number, handleException);
}


##### changepassword ######################################################

sub changePasswordPage {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;

	mergeActionTemplate('changePassword',$feedbacktype, $feedbackmessage);

	rememberPassword();
	$thash->{_newpwd1} = '';
	$thash->{_newpwd2} = '';
	# let op de leading space:
	$thash->{_afterwards} = replacable(' $afterwards');
	$thash->{_hints} = replacable('$hints');
	
}

sub changePasswordReadyPage {
	my ($cgi, $qamstatus) = @_;
	my $uid = getUID($cgi);
	$log->debug("qamstatus: ", Dumper($qamstatus));
	if ($qamstatus->{uid}) {
		$uid = $qamstatus->{uid};
		# waarom gebeurt dit?
		delete($qamstatus->{uid});
	}

	mergeActionTemplate('ready');
	$thash->{_uid} = $uid;

	gatherUserInfo($uid) or die ['userError', 'insufficient_credentials'];
	gatherMailAddresses();
	$log->debug("changePasswordReadyPage: ");
#	$log->debug(Dumper($userInfo));
	$log->debug("changePasswordReadyPage: display qamstatus");
	$log->debug("qamstatus2: ", Dumper($qamstatus));
	displayQAMStatus($qamstatus);
	$thash->{_readySwitch} = replacable('$readySetChangePassword');
	presentAdInfo();
}

# vraagt ook om het oude password
sub changepassword { # -> {wachtwoordZetten, wachtwoordGezet}
	my $cgi = shift;

	eval {
		my $uid = getUID($cgi);
		if ($uid) {
			gatherUserInfo($uid) or die ['userError', 'usernotfound'];
		}
		requestControlTower('setpwd');
		my $res = doSetPwd($cgi, 'setPwd');
		$log->debug(Dumper($res));
		$thash->{_hints} = replacable('$hints');
		$thash->{_username}= $uid;
		changePasswordReadyPage($cgi, $res);
	};
	return unless $@;
	changePasswordPage($cgi, handleException );

}


##############  changeTemporaryPassword ##########################

sub changeTemporaryPasswordReadyPage {
	mergeActionTemplate('ready');
	$thash->{_readySwitch} = replacable('$readyChangeTemporaryPassword');
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'insufficient_credentials'];
	}

	$thash->{_switchDisplayDisabledState} = replacable('$displayDisabledState');
	if ($userInfo->{accountTemporarilyDisabled}) {
		$thash->{_accountTemporarilyDisabled} = replacable($userInfo->{accountTemporarilyDisabled});
	} else {
		$thash->{_accountTemporarilyDisabled} = replacable('$accountCleared');
	}

}

sub changeTemporaryPasswordPage2 {
	my ($cgi, $feedbacktype, $feedbackmessage, $keymasterToken) = @_;
	my $token = $keymasterToken || $cgi->param('token')||'';
	mergeActionTemplate('changeTemporaryPassword2', $feedbacktype, $feedbackmessage);
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'accountunknown'];
	}

	if ($userInfo->{accountTemporarilyDisabled}) {
		$log->debug("temporary Password already set");
		$thash->{_switchsettemppwd} = replacable('$unsetTempPwd');
		$thash->{_switchDisplayDisabledState} = replacable('$displayDisabledState');
		$thash->{_accountTemporarilyDisabled} = replacable($userInfo->{accountTemporarilyDisabled});
	} else {
		$thash->{_switchDisplayDisabledState} = replacable('');
	}

	$thash->{_token} =  $token;
	$thash->{_newpwd1} = '';
	$thash->{_newpwd2} = '';

	rememberPassword();
	$thash->{_admin}   = $cgi->param('admin') || '';
}

sub changeTemporaryPasswordPage1 {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('changeTemporaryPassword', $feedbacktype, $feedbackmessage);

	rememberPassword();
	$thash->{_admin} = $cgi->param('admin') || '';
}

sub changetemporarypassword { # -> {wachtwoordZetten, wachtwoordGezet}
	my $cgi = shift;
	my $uid = getUID($cgi);

	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');
	my $feedback;

	eval {
		my $token = $cgi->param('token');

		if ($token) {
			gatherUserInfo($uid) or
				die ['userError', 'accountunknown'];

			if ($userInfo->{accountTemporarilyDisabled}) {
				warn "TEMPORARY PASSWORD ALREADY set";
				$thash->{_switchsettemppwd} = replacable('$unsetTempPwd');
				restoreAccount('unsetTmpPwd', $cgi);
				$feedback = $cfhash->{tmpPasswordUnset};
				$thash->{'_userInformation'} = '';

			} else {
				doSetPwd($cgi, 'settmppwd');
				$feedback = $cfhash->{tmpPasswordSet};
			}

			# NB deze parameters worden nooit gebruikt?!
			changeTemporaryPasswordReadyPage($cgi,'success', $feedback);


		} else {
			die ['userError', 'needADMIN']
				unless $admin;

			die ['userError', 'missingPWD']
				unless $password;

			die ['userError', 'insufficient_credentials']
				unless verifyPassword($admin, $password);

			die ['userError', 'missingTARGET']
				unless $uid;

			# NB, check userinfo pas na admin authenticatie
			gatherUserInfo($uid) or
				die ['userError', 'accountunknown'];

			my %args = (
				ipaddress => $ipaddress,
				victim => $uid,
				admin =>$admin,
				password => $password,
				);

			my $res = engageConduit('gettsetpwd', \%args);
			$log->debug(Dumper($res));
			changeTemporaryPasswordPage2($cgi,'','',$res->{token});
		}
	};
	return unless $@;
	changeTemporaryPasswordPage1($cgi, handleException );
}


############## supervisedSetPassword ##########################

sub supervisedSetPasswordPage {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('supervisedSetPassword', $feedbacktype, $feedbackmessage);
	rememberPassword();
	$thash->{_admin} = $cgi->param('admin') || '';
 }

sub supervisedsetpassword { # -> {wachtwoordZetten, wachtwoordGezet}
	my $cgi = shift;
	my $uid = getUID($cgi);
	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');
	my $token = $cgi->param('token');

	eval {
		die ['userError', 'needADMIN']
				unless $admin;

		unless ($token) {
			die ['userError', 'insufficient_credentials']
				unless verifyPassword($admin, $password);
		}

		gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];
		requestControlTower('getTsetpwd');

		my %args = (
			ipaddress => $ipaddress,
			victim => $uid,
			admin => $admin,
			password => $password,
			);
		my $res = engageConduit('gettsetpwd', \%args);
		$log->debug(Dumper($res));

		setPasswordPage($cgi,'','',$res->{token});
	};
	return unless $@;
	supervisedSetPasswordPage($cgi, handleException );
}

sub setPasswordExpirationStatus {
	if (my $stage = $thash->{_passwordExpirationStage}) {
		$thash->{_passwordExpirationSwitch } = replacable('$passwordExpiration');
		my $date = $thash->{_passwordExpirationFinalDay};
		my ($year, $month, $mday) = split('-', $date);
		$thash->{_passwordExpirationFinalDay} = formatTime(timelocal(0, 0, 0, $mday, $month -1 , $year));
		my $urgencyClass = fetchUrgencyClass('passwordExpirationStage', $stage);
#		warn "urgency: $stage, $urgencyClass";
		$thash->{_passwordExpirationUrgencyClass} = replacable($urgencyClass);

	} else {
		$thash->{_passwordExpirationSwitch } = replacable('');
	}
	
}

sub setTemporarilyDisabledStatus {
	if ($userInfo->{accountTemporarilyDisabled}) {
		$thash->{_temporarilyDisabledSwitch} = replacable('$temporarilyDisabled');
		$thash->{_accountTemporarilyDisabled} = replacable($userInfo->{accountTemporarilyDisabled});
	} 
}

sub setBlockedStatus {
	if ($userInfo->{accountBlocked}) {
		$thash->{_blockedSwitch} = replacable('$blocked');
		$thash->{_accountBloacked} = replacable($userInfo->{accountBlocked});
	} 
}

##### showAccountSettings #################################################

sub showAccountSettingsPage {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('showAccountSettings',$feedbacktype, $feedbackmessage);
	rememberPassword();
}


sub cleanThash {
	unless ($userInfo) {
		$thash->{_anr} = 
            $thash->{_passwordExpirationFinalDay} = 
            $thash->{_datePasswdChanged} = 
            $thash->{_extraMail} = 
            $thash->{_mail} = 
            $thash->{_passwordExpirationStage} = 
            $thash->{_privateEmail} = 
			$thash->{_passwordStatus} =
			$thash->{_sn} = '';
		
		warn "no info found, using empty values";
	} 
}

sub getAdInfo {
	my $cgi = shift;
	my $uid = getUID($cgi);

	die ['userError', 'insufficient_credentials']
		unless $uid;

	my %args = (
		ipaddress => $ipaddress,
		victim => $uid
		);

	my $adResult = engageConduit('getadinfo', \%args);
#	warn $log->inspect($adResult);

	#
    # device voorbeeldje
	# device_1_whenCreated' => '20111003112732.0Z'
	#

	my $h;
	my $deviceHash;
	my ($line, $value);
	while (($line, $value) = each %$adResult) {
		my ($deviceNr, $attrib) = $line =~ /^device_(\d+)_(.*)/;
		if ($deviceNr) {
			$deviceHash->{"$deviceNr"}->{"$attrib"} = $value;
		} elsif ($line eq 'lockoutTime'){
			$h->{lockoutTime} = $value;
		} elsif ($line eq 'NoAdAccount') {
			return undef;

		} else {
			warn "Error: Invalid attrib in adResult: $line, $value";
		}
	}
	$h->{deviceHash} = $deviceHash;
	$h;
}

sub presentAdInfo {
	my $AdInfo = getAdInfo($cgi);
#	$log->debug(Dumper($AdInfo));
	unless ($AdInfo) {
		$thash->{_lockoutTime} = replacable('$noAdAccount');
		return ;
	}

	my $deviceHash = $AdInfo->{deviceHash};
	my $lockoutTime = $AdInfo->{lockoutTime};

	my @AdDeviceAttribs = split(/\s/, $cf->value('adDeviceAttribs'));
	die "ConfigError ", $cf->error if $cf->error;

	my $deviceInfo;
	my $nrDevices = 0;

	if ($deviceHash) {
		my @keys = keys(%$deviceHash);

		my @sortedList = reverse sort ({$deviceHash->{$a}->{whenChanged} cmp $deviceHash->{$b}->{whenChanged}} keys %$deviceHash);
		$log->debug(Dumper(@sortedList));

		$deviceInfo .= '<table class="deviceInfo"><tr><td colspan="2" id="deviceHeader" >$deviceExplanation</td><tr>';
		foreach my $el (@sortedList) {
			my  $device = $deviceHash->{$el};
			next unless $device->{msExchDeviceID};
			$nrDevices++;

			foreach my $attrib (@AdDeviceAttribs) {
				my $name = $attrib; $name =~ s/^msExch//;
				my $value = $device->{$attrib};
				next unless $value;
				if ($value =~ /\.0Z$/) {
					my ($year, $month, $day) = $value =~ /(\d{4})(\d{2})(\d{2})/;
					$value = "$year $month $day";
				}
				$deviceInfo .= '<tr><th class="deviceName">'. $name . '</th><td class="deviceValue">' . $value . '</td></tr>';
			}
			$deviceInfo .= '<tr><td> &nbsp;</td></tr>';
		}
		$deviceInfo .= '</table>';
	}

	if ($lockoutTime) {
		# microsoft nano seconds 
		my $epoch = ($lockoutTime/10000000) - 11644473600;
		my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($epoch);

		$mon++;
		$year += 1900;
		my $localLockTime = sprintf("$year-%02d-%02d %02d:%02d", $mon, $mday, $hour, $min);
		$thash->{_lockoutTime} = replacable($localLockTime);
		$thash->{_lockoutTimeUrgencyClass} = replacable('urgencyAlert');
	} 

	if ($nrDevices) {
		$thash->{_showDevices} = replacable('$_showMoreDevices');
		$thash->{_nrDevices} = replacable($nrDevices);
		$thash->{_deviceInfo} = replacable($deviceInfo);
		$thash->{_dynamicDeviceInfo} = replacable('$dynamicDeviceInfo');
		$thash->{_showMoreDevices} = replacable('$showMoreDevices');
	}
}

sub fetchUrgencyClass  {
	my ($attrib, $value) = @_;
	my $urgency = $urgencyClassHash->{$attrib}->{$value};
	my $urgencyClass = "urgency\u$urgency";
	if ($urgency) {
		$log->debug("urgencyClass: $urgencyClass");
	} else {
		warn "Could not establish the urgency for attrib: $attrib, value: $value";
		warn Dumper($urgencyClassHash);
	}
	return $urgencyClass;
}


sub displayAccountSettings {
	my ($cgi, $res) = @_;
	# gemeenschappelijk spul van show/check AccountSettings
	# giet hash over in een andere en voeg underscores toe aan de keys.
	@$thash{map { "_$_" } keys %$res} = values %$res;

	cleanThash();
 	presentAdInfo();
	setPasswordExpirationStatus();

	my $passwordStatus = $userInfo->{passwordStatus} // '';
	$log->debug("passwordStatus: $passwordStatus") if $passwordStatus;

	my $urgencyClass = fetchUrgencyClass('passwordStatus', $passwordStatus);
	$thash->{_passwordStatusUrgencyClass} = replacable($urgencyClass);
}


sub showAccountSettingsReadyPage {
	my ($cgi, $res) = @_;
	my $qam = getQAM($cgi);

	mergeActionTemplate('showAccountSettings');
	mergeActionTemplate('ready');
	$thash->{legendFeedback} = replacable('$introShowAccountSettings');

	displayAccountSettings(@_);
	my $extraMailaddres = $qam->{extraMail};
	$thash->{_extraMailAddresses} = replacable($extraMailaddres?"($extraMailaddres)":'-&nbsp;');
	$thash->{_dynamicAccountSettings} = replacable('$dynamicAccountSettingsWithChanges');
	$thash->{_readySwitch} = replacable('$readyShowAccountSettings');
	$thash->{clickPath} = replacable('showAccountSettings');
	$thash->{clickPath_nl} = replacable('showAccountSettings');
 	displayQAMStatus($res);
}


sub showaccountsettings {
	my $cgi = shift;
	eval {
		my $uid = getUID($cgi);
		die ['userError', 'insufficient_credentials']
			unless $uid;

		gatherUserInfo($uid) or die ['userError', 'accountunknown'];
		requestControlTower('qamstatus');

		die ['userError', 'insufficient_credentials']
				unless verifyPassword($uid, $cgi->param('password'));

		showAccountSettingsReadyPage($cgi, getQAMStatus($cgi));
	};
	return unless $@;
	# gebruik geen warn vóór de aanroep van handleException!
	showAccountSettingsPage($cgi, handleException);
}


############## checkAccountSettings ##########################
sub checkAccountSettingsPage {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('checkAccountSettings', $feedbacktype, $feedbackmessage);
	rememberPassword();
	$thash->{_admin} = $cgi->param('admin') || '';
}


sub checkAccountSettingsReadyPage {
	my ($cgi, $res) = @_;
	mergeActionTemplate('checkAccountSettings');
	mergeActionTemplate('ready');
	displayAccountSettings(@_);

	my $uid = getUID($cgi);
	gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];

	my $passwordStatus = $userInfo->{passwordStatus} // '';
	$log->debug("passwordStatus: $passwordStatus") if $passwordStatus;

	if ($passwordStatus) {
		$thash->{_passwordStatus} = replacable($passwordStatus);
	} else {
		$thash->{_passwordStatus} = replacable('normal');
	}

	setTemporarilyDisabledStatus();
	setBlockedStatus();

	my $extraMailaddres = $res->{Mset};
	$thash->{_extraMailAddresses} = replacable($extraMailaddres?"($extraMailaddres)":'-&nbsp;');

	$thash->{_readySwitch} = replacable('$readyCheckAccountSettings');
	$thash->{_dynamicAccountSettings} = replacable('$dynamicAccountSettingsWithoutChanges');

	$thash->{clickPath} = replacable('checkAccountSettings');
	$thash->{clickPath_nl} = replacable('checkAccountSettings');
	displayQAMStatus($res);

}


sub checkaccountsettings {
	my $cgi = shift;
	my $uid = getUID($cgi);
	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');
	my $token = $cgi->param('token');

	eval {
		die ['userError', 'needADMIN']
				unless $admin;

		unless ($token) {
			die ['userError', 'insufficient_credentials']
				unless verifyPassword($admin, $password);
		}

		my $uid = getUID($cgi);
		die ['userError', 'missingUID']
			unless $uid;
		gatherUserInfo($uid) or die ['userError', 'usernotfound'];

		my %args = (
			ipaddress => $ipaddress,
			victim => $uid,
			admin =>$ admin,
			password => $password,
			);

		my $res = engageConduit('checkqamstatus', \%args);
		checkAccountSettingsReadyPage($cgi, $res);
	};
	return unless $@;
	# gebruik geen warn vóór de aanroep van handleException!
	checkAccountSettingsPage($cgi, handleException);
}


###########################################################

sub restoreAccount {
	my ($restoreCommand, $cgi) = @_;
	my $token = $cgi->param('token');
	my $uid = getUID($cgi);

	die ['userError', 'insufficient_credentials']
		unless $token ;

	my %args = (
		ipaddress => $ipaddress,
		victim => $uid,
		);
	$args{token} = $token
		if $token;

	my $res = engageConduit($restoreCommand, \%args);
	return $res;
}


sub doSetPwd {
	my ($cgi, $command) = @_;

 	my $password = $cgi->param('password');
	my $token = $cgi->param('token');
	my $uid = getUID($cgi);

	die ['userError', 'insufficient_credentials']
		unless $uid || $token;

	die ['userError', 'insufficient_credentials']
		unless $token || $password;

	die ['userError', "Both password and token supplied"]
		if $token && $password;

	my $newpwd1 = $cgi->param('newpwd1');
	die ['userError', 'neednewpwd']
		unless $newpwd1;
	my $newpwd2 = $cgi->param('newpwd2');
	die ['userError', "needpwdtwice"]
		unless $newpwd2;
	die ['userError', "needexactrepeat"]
		unless $newpwd1 eq $newpwd2;

	my %args = (
		ipaddress => $ipaddress,
		victim => $uid,
		newPwd => $newpwd1
		);
	$args{token} = $token
		if $token;
	$args{password} = $password
		if $password;

	unless ($uid) {
		# request via een challenge bevat de uid niet
		my $res = engageConduit('getuserinfo', \%args);
		$uid = $res->{uid};
		$uidFromToken = $uid;
		gatherUserInfo($uid) or die ['userError', 'accountunknown'];
	}

	my $denied = checkPasswordPolicy();
	die ['userError', $denied ]
		if $denied;

	my $res = engageConduit($command, \%args);
	return $res;
}

##### infoOnDevices ######################################################
sub infoOnDevicesReadyPage {
	$log->debug("infoOnDevicesReadyPage");
	my $cgi = shift;

	my $feedbacktype = 'infoOnDevices';
	mergeActionTemplate('infoOnDevices',$feedbacktype);
	$thash->{localfeedback} = '';

}

##### mailchallenge #######################################################
sub gatherMailAddresses {
	my $res = getQAMStatus($cgi);
	$log->debug("RESULT: " . Dumper($res));
	my $h;
	$h->{ lc($res->{Mset})} = 1 if $res->{Mset};
	$h->{ lc($userInfo->{privateEmail})} = 1 if $userInfo->{privateEmail};
	$h->{ lc($userInfo->{mail})} = 1;

	$thash->{_mailAddressList} = join (', ', keys(%$h)) ;
}

sub mailChallengeReadyPage {
	my $cgi = shift;
	mergeActionTemplate('ready');
	$thash->{_readySwitch} = replacable('$readyMailChallenge');
	gatherMailAddresses();
}


sub mailChallengePage {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	mergeActionTemplate('mailChallenge',$feedbacktype, $feedbackmessage);
}

# -> {mailedChallenge, wachtwoordVergeten}
sub mailchallenge {
	my $cgi = shift;
	$log->debug("mailchallenge");

	eval {
		my $uid = getUID($cgi);
		
		if ( $uid =~ /\@/ ){
			my $dir = new UvT::PwdModifier::Directory(cf => $cf);
			warn "Requested uid or mail: \"$uid\"";
			my $filterPart = $uid;

			my $filter = "(|(privateEmail=$filterPart)(mail=$filterPart))";
			
			warn "filter: $filter";
			my ($entry, $err) = $dir->ldap_search_filter($filter);
			
			if (!defined($entry)) {
				warn "Nothing found for filter: $filter";
				die ['userError', 'wrongUIDorEMAIL'];
				
			} else { 
				$uid = $entry->get_value('uid');
			}					
		} else {
			die ['userError', 'wrongUIDorEMAIL']
				unless $uid;
		}
		
		gatherUserInfo($uid) or die ['userError', 'usernotfound'];
		requestControlTower('mailchallenge');
		my %args = (victim => $uid, ipaddress => $ipaddress);

		engageConduit('mailchallenge', \%args);

		mailChallengeReadyPage($cgi);
	};
	return unless $@;
	mailChallengePage($cgi, handleException);
}

########## block account ############################### 

sub blockAccountReadyPage {
	mergeActionTemplate('ready');
	$thash->{_readySwitch} = replacable('$readyChangeAccountBlockedStatus');
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];
	}

	$thash->{_switchDisplayDisabledState} = replacable('$displayBlockedState');
	if ($userInfo->{accountBlocked}) {
		$log->debug("account is blocked");
		$thash->{_accountBlocked} = replacable($userInfo->{accountBlocked});
	} else {
		$log->debug("account is not blocked");
		$thash->{_accountBlocked} = replacable('$accountCleared');
	}
}


sub blockAccountPage2{
	my ($cgi, $feedbacktype, $feedbackmessage, $keymasterToken) = @_;
	my $token = $keymasterToken || $cgi->param('token')||'';
	mergeActionTemplate('blockAccount2', $feedbacktype, $feedbackmessage);

	$thash->{_readySwitch} = replacable('$readyChangeAccountBlockedStatus');
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];
	}

	if ($userInfo->{accountBlocked}) {
		$log->debug("accountBlocked currently set");
		$thash->{_switchBlocked} = replacable('$blocked');
		$thash->{_switchDisplayDisabledState} = replacable('$displayBlockedState');
		$thash->{_accountBlocked} = replacable($userInfo->{accountBlocked});

	} else {
		$thash->{_switchDisplayDisabledState} = replacable('');
	}
	$thash->{_token} =  $token;
	$thash->{_newpwd1} = '';
	$thash->{_newpwd2} = '';

	rememberPassword();
	$thash->{_admin}   = $cgi->param('admin') || '';

}

sub blockAccountPage1 {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	warn "feedbacktype: $feedbacktype, feedbackmessage: $feedbackmessage";
	mergeActionTemplate('blockAccount', $feedbacktype, $feedbackmessage);
	$thash->{_admin} = $cgi->param('admin') || '';
	rememberPassword();
}

sub blockaccount {
	my $cgi = shift;
	my $uid = getUID($cgi);
	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');
	my $token = $cgi->param('token');
	
	eval {
		my $feedback; 
		if ($token) {
			gatherUserInfo($uid) or
				die ['userError', 'accountunknown'];

			if ($userInfo->{accountBlocked}) {
				$log->debug("Account is currently blocked");
				$thash->{_switchblockaccount} = replacable('$unblock');
				
				# restoreAccount doet ook het %args spul
				restoreAccount('unblockaccount', $cgi);

				$feedback = $cfhash->{accountUnblocked};
				$thash->{'_userInformation'} = '';

			} else {
				# not suspended yet
				my %args = (
					ipaddress => $ipaddress,
					token => $token,
					);

				my $res = engageConduit('blockaccount', \%args);
				$feedback = $cfhash->{accountBlocked};
			}
			blockAccountReadyPage($cgi, 'success', $feedback);


		} else {
			die ['userError', 'needADMIN']
				unless $admin;
			
			unless ($token) {
				die ['userError', 'insufficient_credentials']
					unless verifyPassword($admin, $password);
			}

			gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];

			my %args = (
				ipaddress => $ipaddress,
				victim => $uid,
				admin =>$admin,
				password => $password,
				);
			# get token for two step operation dit moet gettblock worden 
			my $res = engageConduit('getTblock', \%args);
			$log->debug(Dumper($res));
			blockAccountPage2($cgi,'','',$res->{token});
		}
	};
	return unless $@;
	blockAccountPage1($cgi, handleException );
}


############# invalidatePassword

sub invalidatePasswordReadyPage {
	mergeActionTemplate('ready');
	$thash->{_readySwitch} = replacable('$readyPasswordInvalidatedStatus');
	                                      
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];
	}

	$thash->{_switchDisplayDisabledState} = replacable('$displayPasswordInvalidatedState');
	if ($userInfo->{passwordInvalidated}) {
		$log->debug("password is invalidated ");
		$thash->{_passwordInvalidated} = replacable($userInfo->{passwordInvalidated});
	} else {
		$log->debug("account is not invalidated");
		$thash->{_passwordInvalidated} = replacable('$passwordNotInvalidated');
	}
}



sub invalidatePasswordPage2{
	my ($cgi, $feedbacktype, $feedbackmessage, $keymasterToken) = @_;
	my $token = $keymasterToken || $cgi->param('token')||'';
	mergeActionTemplate('invalidatePassword2', $feedbacktype, $feedbackmessage);

	$thash->{_readySwitch} = replacable('$readyChangePasswordInvalidatedStatus');
	my $uid = getUID($cgi);

	# refresh userinfo
	if ($uid) {
		gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];
	}

	if ($userInfo->{passwordInvalidated}) {
		$log->debug("passwordInvalidated currently set");
		$thash->{_switch} = replacable('$passwordInvalid');
		$thash->{_switchPasswordInvalidatedState} = replacable('$passwordInvalid');
		$thash->{_passwordInvalidated} = replacable($userInfo->{passwordInvalidated});

	} 
		else {
		$thash->{_switchPasswordInvalidatedState} = replacable('$passwordValid');
	}
	$thash->{_token} =  $token;
	$thash->{_newpwd1} = '';
	$thash->{_newpwd2} = '';

	rememberPassword();
	$thash->{_admin}   = $cgi->param('admin') || '';

}


sub invalidatePasswordPage1 {
	my ($cgi, $feedbacktype, $feedbackmessage) = @_;
	warn "feedbacktype: $feedbacktype, feedbackmessage: $feedbackmessage";
	mergeActionTemplate('invalidatePassword', $feedbacktype, $feedbackmessage);
	$thash->{_admin} = $cgi->param('admin') || '';
	rememberPassword();
}


sub invalidatePassword {
	
	my $cgi = shift;
	my $uid = getUID($cgi);
	my $admin = $cgi->param('admin');
	my $password = $cgi->param('password');
	my $token = $cgi->param('token');

	
	eval {
		my $feedback; 
		if ($token) {
			gatherUserInfo($uid) or
				die ['userError', 'accountunknown'];

			if ($userInfo->{passwordInvalidated}) {
				$log->debug("password is already invalidated");
				# EN TOEN?
				
			} else {
				# not suspended yet
				my %args = (
					ipaddress => $ipaddress,
					token => $token,
					);

				my $res = engageConduit('invalidatepassword', \%args);
				$feedback = $cfhash->{passwordInvalidated};
			}
			invalidatePasswordReadyPage($cgi, 'success', $feedback);


		} else {
			die ['userError', 'needADMIN']
				unless $admin;
			
			unless ($token) {
				die ['userError', 'insufficient_credentials']
					unless verifyPassword($admin, $password);
			}

			gatherUserInfo($uid) or die ['userError', 'targetusernotfound'];

			my %args = (
				ipaddress => $ipaddress,
				victim => $uid,
				admin =>$admin,
				password => $password,
				);
			# get token for two step operation dit moet gettblock worden 
			my $res = engageConduit('getTblock', \%args);
			$log->debug(Dumper($res));
			invalidatePasswordPage2($cgi,'','',$res->{token});
		}
	};
	return unless $@;
	invalidatePasswordPage1($cgi, handleException );
}





# mogelijke actions 
my %actions = (
	changepassword => \&changepassword,           # changePasswordPage -> passwordReadyPage
	setpassword => \&setpassword,                 # changePasswordPage -> passwordReadyPage

	supervisedsetpassword => \&supervisedsetpassword,
	changetemporarypassword => \&changetemporarypassword,

	showaccountsettings => \&showaccountsettings, # showAccountSettingsPage -> showAccountSettingsReadyPage 
	checkaccountsettings => \&checkaccountsettings, # checkAccountSettingsPage -> checkAccountSettingsReadyPage
	changeqam => \&changeqam,                     # changeQAMPage -> changeQAMReadyPage

	answerquestions => \&answerquestions,
	mailchallenge => \&mailchallenge,             # mailchallenge -> mailChallengeReadyPage

	blockaccount => \&blockaccount,               # blockaccount -> blockAccountReadyPage
	invalidatepassword => \&invalidatePassword,      # invalidatePassword -> invalidatePasswordReadyPage
	
	infoondevices => \&infoOnDevicesReadyPage,             # infoOnDevices => infoOnDevicesReadyPage

	);

main();

sub main {
	$polite_message =  "Internal error! An email has been sent to the application maintainer. Please try again later.";
	my @path = grep($_, split('/', $cgi->path_info()));
	my $actionRequest = $path[0] if @path;
	my $action = '';
	$action = $actions{$actionRequest} if $actionRequest; 

	# alle pagina's willen de variabelen _language en _uid
	$thash->{_language} = $language || '';
	$thash->{_uid} = $cgi->param('uid') || '';

	if( @path != 1 || !$action) {
		warn "Invalid path or command: @path";
		$skipEND = 1;
		print
			"Status: 404 Not found\n",
			"Content-type: text/html; charset=UTF-8\n\n",
			"<html><head>\n",
			"<title>404 Not found</title>\n",
			"</head><body>\n",
			"<h1>404 Not found</h1>\n",
			"</body></html>\n"
			or die $!;
		exit 0;
	}
	$log->debug(Dumper($cgiparams));

	my $uid = getUID($cgi) || '';
	if ($uid) {
		eval {
			gatherUserInfo($uid) ; # hier geen: or die ['userError', 'usernotfound'];
		};
		if ($@){
		    die "Ldap connection error: $@";
		}
	}
		
	# doe je ding
	$action->($cgi);

	my $rep = new UvT::PwdModifier::Replacer(items => $thash);

	# Voorkom dat de replace stopt vanwege een undefined variable,
	# maar klaag hier wel over.
	map {$thash->{$_} = '-' unless defined $thash->{$_}} keys(%$thash);

	my $res = $rep->replace('$jacket');
	print $cgi->header(-type => 'text/html',
					   -charset => 'UTF-8',
					   -Pragma => 'no-cache',
					   -Cache_Control => 'no-cache, must-revalidate, no-store');

	print $res or die $!;
}


sub outOfRange {
	my $pwd = shift;
	# $accepted ziet er ongeveer zo uit: ~!@#$%^&*()-=_+[]\{}|;':",.\/<>?
	my $accepted = $cfhash->{acceptedPasswordCharacters};

	my @chars = $pwd =~ /(.)/g;
	foreach my $character (@chars) {
	    next if $character =~ /[a-z]|[A-Z]|[0-9]/;
		next if index($accepted, $character) >= 0;
		return 1;
	}
	return 0;
}

sub UvTPwdCheck {
	my $pwd = $cgi->param('newpwd1');
	return 'needmorechars' if length($pwd) < int($cfhash->{minpasswordlength});
	return 'needlesschars' if length($pwd) > int($cfhash->{maxpasswordlength});
	return 'needacceptedchars' if outOfRange($pwd);
	return 'needvariation' if
		($pwd !~ /[A-Z]/  ||
		 $pwd !~ /[a-z]/  ||
		 $pwd !~ /\d|\W/  );
	
	unless ($userInfo) {
		warn "no userinfo";
		return "";
	}

	foreach my $var (qw (sn uid anr givenname)) {
		if ($userInfo->{$var}) {
			if ($pwd =~ /$userInfo->{$var}/i) {
				$log->debug("pwd contains: $userInfo->{$var}, $pwd");
				return 'pwd_contains';
			} 
		}
	}

#	$log->debug("pwdcheck passed for: $pwd");
	return "";
}

sub checkPasswordPolicy {
	unless ($cfhash->{validatepasswords}) {
		warn "NOT validating passwords";
		return 0 ;
	}
	my $uvtcheck = UvTPwdCheck();
	return $uvtcheck if $uvtcheck;

	die "Could not read file: $cfhash->{cracklib_pw_dict}.pwd " unless -r "$cfhash->{cracklib_pw_dict}.pwd";
	my $simplifiedPassword = $cgiparams->{newpwd1};
	$simplifiedPassword =~ s/\W+/ /g;
	my $crackresult = fascist_check($simplifiedPassword, $cfhash->{cracklib_pw_dict});
	if ($crackresult eq 'ok') {
		return 0;
	}

	if($language eq 'nl') {
		#
		# Voorzie in beetje nederlandse vertaling voor de foutmeldingen van cracklib
		#
		my $tt;
		my @translationtable = grep($_, $cf->value('cracklib_translation_table'));
		if(@translationtable) {
			map { my ($key, $value) = split(/\s*;\s*/); $tt->{$key}=$value } @translationtable ;
			$crackresult = $tt->{$crackresult} if exists $tt->{$crackresult};
		} else {
			warn "no cracklib_translation_table provided";
		}
	}

	$log->debug("crackresult: $crackresult");
	return $crackresult;
}

sub getLanguage {
	my $lan = 'en';
	if (exists($ENV{'HTTP_ACCEPT_LANGUAGE'})){
		$lan = $ENV{'HTTP_ACCEPT_LANGUAGE'};
	}
		
	if ($cgiparams->{language})	{
		return 'en' if ($cgiparams->{language} eq 'en');
		return 'nl' if ($cgiparams->{language} eq 'nl');
	}
	#index not found returns -1
	my $nl = index ($lan,'nl') + 1;
	my $en = index ($lan,'en') + 1;
	my $res='en';

	if ($nl && $en)	{
		if ($nl < $en){
			$res='nl';
		}
	}
	elsif ($nl)	{
		$res='nl';
	}
	return $res;
}





=head1 NAME

gatekeeper

=head1 DESCRIPTION

(beschrijving:)

Gatekeeper is de GUI en CGI kant van de UvT-passwordmodifier.

De gatekeeper stelt de gebruiker (of pwdadministrator) in staat een nieuw password in te
voeren, of een challenge toe te sturen naar de UvT mailbox van de gebruiker.  Validiteit
van het password gebeuren wordt gechecked. Eerst door middel van javascript op de client
computer, daarna door middel van cracklib aan de serverkant.  De gatekeeper stuurt ieder
request in zijn geheel, base64 encoded via ssh naar de 'keymaster'.

=head1 INSTALLATIE op apache

Omdat gatekeeper passwords zet is het vanzelfsprekend dat het script alleen via https://
mag worden gebruikt. Het weigert dan ook als dat niet het geval is.

De productie versie van het gatekeeper cgi script wordt op twee plaatsen geinstalleerd:
op een PUBLIEKE lokatie, op dit moment:
  https://cgi.uvt.nl/cgi-bin/pwdmodifier

en een met ldap of in de toekomst met aselect GEAUTENTICEERDE lokatie, op het moment:
  https://cgi.uvt.nl/cgi-bin/auth/pwdmodifier

Het verschil is dat als de applicatie op lokatie ../auth/.. wordt aangeroepen er extra
functionaliteit in de GUI verschijnt om voor een pwdadmin ook andermans password te kunnen
zetten.

Verder is er typisch ook een test versie op een corresponderende ~user lokatie.
Op dit moment op geldt dat voor user 'anton'.
  https://cgi.uvt.nl/~anton/cgi-bin/pwdmodifier
  https://cgi.uvt.nl/~anton/cgi-bin/auth/pwdmodifier

Een installatie op deze plek geeft de naam 'anton' door aan de keymaster.
De keymaster stuurt dan alle mail die normaal naar een echte gebruiker gestuurd
zou worden naar 'eenofandereuser'@uvt.nl, naar anton@uvt.nl.

=head1 CONFIGURATIE

L<@SYSCONFIDIR@/gatekeeper_errorlog.cf>
Deze bevat configuratie voor L<Errorlog.pm> Hierin MOET ook een mailto address
worden ingevuld.

In de productieomgeving wordt ook mailonfailure=1 aangeraden.


L<@SYSCONFIDIR@/gatekeeper.cf> bevat overige systeem configuratie.

Default op dit moment:

 keymaster              =  keymaster@hollerith.uvt.nl
 ssh_pubkey2keymaster   =  /var/www/.ssh/anton2keymaster

 #                        host                              base
 ldaphost               =  ldap://chang.uvt.nl:636  ;    o=Universiteit van Tilburg, c=NL

 keymaster              =  keymaster@hollerith.uvt.nl
 ssh_pubkey2keymaster   =  /var/www/.ssh/anton2keymaster

 capath                 =  /etc/ssl/certs

 # set to 0 to skip validation of the password, should be set to 1 in production
 validatepasswords      =  1

 cracklib_pw_dict       =  /var/cache/cracklib/cracklib_dict


Let op de 'anton' in ssh_pubkey2keymaster. Ook hier geldt weer dat er voor de
testsituatie een andere 'user'2keymaster gebruikt zal worden, typisch: anton2keymaster,
zodat er naast een productie ook een testkey gebruikt kan worden op het keymaster account.

L</usr/local/share/gatekeeper/gatekeeper.template> bevat de meeste teksten die worden gebruikt
als feedback naar de gebruiker.

L</usr/local/share/gatekeeper/gatekeeper.html> bevat de html en bijbehorden javascript code voor
de GUI.


=head1 USERFEEDBACK

De userfeedback bestaat uit twee mogelijke typen van foutmeldingen:

=over

=item Input fout.

De gebruiker heeft een fout gemaakt in de input. Dit kan van alles zijn. De gebruiker
krijgt hierover feedback en kan een volgende poging doen.

=item Systeem fout.

Ergens is iets misgegaan waarop de gebruiker geen invloed heeft. De gebruiker wordt
ervan op de hoogte gebracht dat de applicatie tijdelijk 'off line' is.
De applicatie beheerder wordt automatisch gemailed.

De beheerder wordt ook gemailed in geval van ldap_unknown_user of oracle_unknown_user
want in die gevallen kan de gebruiker er ook niets aan doen en moet er toch een
beheerder aan te pas komen.

=back 

=head1 DEPENDENCIES

=over

  Baseobject.pm Trailer.pm Errorlog.pm Registrationdesk.pm Straitjacket
  Net::LDAPS  Crypt::Cracklib;

=back 

=head1 AUTHOR

Anton Sluijtman, E<lt>anton@uvt.nlE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2017 by Tilburg University

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
at your option, any later version of Perl 5 you may have available.

=cut
# Local Variables:
# mode:perl
# mode:font-lock
# End:
