#!/usr/bin/perl
# CGI to allow users to test their password (against password policy), and be
# prompted to change their password if it has expired or been reset
# Buchan Milne <bgmilne@staff.telkomsa.net> 2008
use strict;
no strict 'subs';
use warnings;
use Net::LDAP;
use Net::LDAP::Control::PasswordPolicy 0.02;
use Net::LDAP::Constant qw( LDAP_CONTROL_PASSWORDPOLICY );
use Net::LDAP::Constant;
use Net::LDAP::Extension::SetPassword 0.03;
use DateTime;
use DateTime::Duration;

#Configuration:
my $ldapserver = 'ldaps://tiger.ranger.dnsalias.com';
my $basedn = 'ou=People,dc=ranger,dc=dnsalias,dc=com';
my $userattrib = 'uid';
my $empty = '';
my $css = <<'CSS';
input[type=text], input[type=search], textarea {
	color: #7f899a;
	width: 120px;
	font-size: 10px;
	padding: 2px 0 2px 2px;
	margin: 0;
	border: 1px solid #ccc;
}

input[type=password], input[type=search], textarea {
	color: #444;
	width: 120px;
	font-size: 10px;
	padding: 2px 0 2px 2px;
	margin: 0;
	border: 1px solid #ccc;
}

input[type=submit] {
	width: 120px;
	margin: 0;
	font: bold 11px Arial, Verdana, Helvetica, sans-serif;
	background-color: #b3c1d9;
	color: #ffffff;
}
p {
        margin-top:0px;
        margin-bottom:2px;
}
a, a:link, a:visited, a:active
{
	text-decoration: none;
}
a:hover
{
	text-decoration: none;
	color: #7f899a;
}
td, th
{
	vertical-align: middle;
}
body
{
	margin: 25px 4%;
	font-size: 10px;
}
html, body
{
	background-color: #fff;
	color: #7f899a;
	font-family: arial, helvetica, sans-serif;
}
CSS

my $pp = Net::LDAP::Control::PasswordPolicy->new;
my %pp2text;

my $ppcode;
$ppcode = Net::LDAP::Constant->LDAP_PP_PASSWORD_EXPIRED;
$pp2text{$ppcode} = 'Password has expired';
$ppcode = Net::LDAP::Constant->LDAP_PP_ACCOUNT_LOCKED;
$pp2text{$ppcode} = 'Account is locked out';
$ppcode = Net::LDAP::Constant->LDAP_PP_CHANGE_AFTER_RESET;
$pp2text{$ppcode} = 'Password was reset and needs to be changed';
$ppcode = Net::LDAP::Constant->LDAP_PP_PASSWORD_MOD_NOT_ALLOWED;
$pp2text{$ppcode} = 'Password change is not permitted';
$ppcode = Net::LDAP::Constant->LDAP_PP_MUST_SUPPLY_OLD_PASSWORD;
$pp2text{$ppcode} = 'Password change requires supplying the old password';
$ppcode = Net::LDAP::Constant->LDAP_PP_INSUFFICIENT_PASSWORD_QUALITY;
$pp2text{$ppcode} = 'Password does not meet complexity requirements';
$ppcode = Net::LDAP::Constant->LDAP_PP_PASSWORD_TOO_SHORT;
$pp2text{$ppcode} = 'Password is too short';
$ppcode = Net::LDAP::Constant->LDAP_PP_PASSWORD_TOO_YOUNG;
$pp2text{$ppcode} = 'Password may not yet be changed';
$ppcode = Net::LDAP::Constant->LDAP_PP_PASSWORD_IN_HISTORY;
$pp2text{$ppcode} = 'The new password has already been used';

my ($username,$password,$newpassword1,$newpassword2,$forcechange);
my ($status,$error,$resp,$time,$grace);
my $cgi = 0;
if (defined $ENV{'REQUEST_URI'}) { $cgi = 1;};


if ($cgi) {
#use autouse CGI => qw/:standard *table/;
#use autouse CGI::Carp;
use CGI qw/:standard *table/;
use CGI::Carp;
#require "CGI" qw/:standard *table/;
	my ($ppstatus,$pperror);
	$forcechange = param('forcechange');
	($username,$password,$newpassword1,$newpassword2) = (
		param('username'),param('password'),param('newpassword1'), param('newpassword2'),);
	if (defined $forcechange and $forcechange ne $empty) {password_form('change'); carp 'User requested password change'; exit 0}
	if (not defined $password or $password eq $empty or not defined $username or $username eq $empty) {password_form('test'); exit 0}
	my $ldap = Net::LDAP->new($ldapserver) or croak $!;
	my ($dn,$error)  = search_user($ldap,$username);
	if ((not defined $dn) || ( $dn eq $empty)) {
		$ldap->unbind;
		error_page('User unknown or password incorrect');
		carp "Error after search: $error\n";
		exit 0;
	}
	if (not defined $newpassword1 or $newpassword1 eq $empty ) {
		($status,$error,$resp) = test_password($ldap,$dn,$password,$pp);
		($ppstatus,$pperror,$time,$grace) = check_policy_results($resp);
		if ($status == 2 ) {
			$ldap->unbind;
			if (defined $ppstatus) {
				error_page("Password failed: $pperror");
			} else {
				error_page('User unknown or password incorrect');
			}
			exit 0;
		}
		$status = $ppstatus;
		$error .= $pperror;
		if (defined $status) {
			if ($status == 1) { print_locked(); $ldap->unbind;exit 1 };
			if ($status == 0 or $status == 2) {
				$ldap->unbind;
				password_form('change',$error);
				exit 0;
			}
		} else {
			if (defined $error && $error ne $empty) {
				$ldap->unbind;
				error_page("Errors: $error");
				exit 0;
			} else {
			$ldap->unbind;
			success_page('Password testing succeeded');
			exit 0;
			}
		}
	} else {
		if ($newpassword1 ne $newpassword2) {
			 error_page('New passwords did not match');
			 exit 0;
		 }
		my $mesg = $ldap->bind($dn,password => $password);
		$mesg->code && error_page($mesg->error) && exit 0;
		carp($mesg->error);
		($status,$error) = change_password($ldap,$newpassword1);
		if (! $status) {
			$ldap->unbind;
			success_page('Password changed successfully');
			exit 0;
		} else {
			$ldap->unbind;
			error_page("Password change failed: $error");
			exit 0;
		}
	}

} else {
#use autouse Term::ReadKey;
#use autouse Carp;
use Term::ReadKey;
use Carp;
	print "Getting password: \n";
	($username,$password) = get_password();
	my ($ppstatus,$pperror);
	my $ldap = Net::LDAP->new($ldapserver) or croak $!;
	my ($dn,$error)  = search_user($ldap,$username);
	($status,$error,$resp) = test_password($ldap,$dn,$password,$pp);
	#print "test_password status: $status $error\n";
	($ppstatus,$pperror,$time,$grace) = check_policy_results($resp);
	#print "ppolicy status: $status $error\n";
	if ($status == 2) {
		$ldap->unbind;
		if (defined $ppstatus) {croak "Password failed: $pperror";}
		croak "Password failed: $error";
	}
	($status,$error,$time,$grace) = check_policy_results($resp);
	#print "check_policy status: $status\n";
	(defined $error) && carp "Errors: $error";
	if (defined $status) {
		if ($status == 1) { print_locked();$ldap->unbind; exit 1 };
		if ($status == 0 or $status == 2) {
			if ( $newpassword1 = get_new_pass()) {
				($status,$error) = change_password($ldap,$newpassword1);
				if (! $status) {
					print "\nPassword changed successfully\n";
				} else {
					print "Password change failed: $error\n";
				}
			} else {
				croak 'Passwords did not match';
			}
		}
	} else {
	       print "\nPassword is correct, and no action required\n";
       }
}


sub get_password {
	my ($user,$pass);
	print 'Enter username: ';
	$user = ReadLine(0);
	chomp $user;
	print 'Enter password: ';
	ReadMode('noecho');
	$pass = ReadLine(0);
	chomp $pass;
	ReadMode(0);
	return ($user,$pass);
}

sub search_user {
	my ($ldap,$username) = @_;
	my $dn;
	my $mesg = $ldap->bind;
	$mesg->code && croak $mesg->error;
	$mesg = $ldap->search(base => $basedn,filter => "($userattrib=$username)");
	$mesg->code && croak $mesg->error;
	if ($mesg->count == 0) {
		$error = 'No such user exists';
	} elsif ($mesg->count != 1) {
		$error = 'More than one entry matched';
	} else {
		my @entries = $mesg->entries;
		$dn = $entries[0]->dn;
	}
	return ($dn,$error);
}

sub test_password {
	my ($ldap,$dn,$password,$pp) = @_;
	my ($error,$resp);
	my $mesg = $ldap->bind($dn,password => $password, control => [ $pp ]);
#$mesg->code && croak $mesg->error;
	if ($mesg->code) {
		$error = $mesg->error;
		if (not defined $error) {$error = ''};
		($resp) = $mesg->control( LDAP_CONTROL_PASSWORDPOLICY );
		return(2,$error,$resp);
	} else {
		($resp) = $mesg->control( LDAP_CONTROL_PASSWORDPOLICY );
		if (defined $resp) {$error = $resp->error};
		if (not defined $error) {$error = ''};
		return(0,$error,$resp);
	}
}

sub check_policy_results {
	my $resp = shift;
	my ($error,$status);
	if (defined $resp) {
		if ($ENV{'DEBUG'}) { carp 'Got password policy response';}

		my $v = $resp->pp_error;
		if (defined $v) {
			if ($ENV{'DEBUG'}) { carp "Password policy error $v\n";}
			foreach (sort keys %pp2text) {
				 if ($_ eq $v ) { $error .= "$pp2text{$_}\n";}
			}
			if ($v == Net::LDAP::Constant->LDAP_PP_PASSWORD_EXPIRED
				|| $v == Net::LDAP::Constant->LDAP_PP_CHANGE_AFTER_RESET ) {
				$status = 'changerequired';
			}
		}
		$time = $resp->time_before_expiration;
		if (defined $time) {
			$error .= "Your password will expire in $time seconds";
			my $d = DateTime::Duration->new(seconds => $time);
			my $dt = DateTime->now;
			$dt->add_duration($d);
			my $expiretime = $dt->strftime("%c");
			$error .= " or $expiretime";
			$error .= ".";
		}
		my $grace = $resp->grace_authentications_remaining;
		if (defined $grace) {
			$error = "Your password has expired, $grace grace authentications remain";
			$v = 2;
		}
		return ($v,$error,$time,$grace);
	} else {
		($ENV{'DEBUG'}) && carp "Bound successfully with no password policy problems";
		return (undef,$empty,undef,undef);
	}
}

sub change_password {
	my ($ldap,$newpass) = @_;
	my $mesg = $ldap->set_password(newpasswd => $newpass, control => [ $pp ]);
	return($mesg->code,$mesg->error);
}

sub get_new_pass {
	print 'Enter new password: ';
	ReadMode('noecho');
	$newpassword1 = ReadLine(0);
	chomp $newpassword1;
	print "\nRepeat new password: ";
	$newpassword2 = ReadLine(0);
	chomp $newpassword2;
	ReadMode(0);
	if ($newpassword1 eq $newpassword2) {
		return(1,$newpassword1);
	} else {
		return 0;
	}
}

sub password_form {
	my ($type,$error) = @_;
	my $newprompt =
		Tr(td[('New password: '),(password_field('newpassword1'))]) .
		Tr(td[('Repeat new password: '),(password_field('newpassword2'))]);
	print header(),
	start_html(-title=>"Password $type page",-style=>{'code'=>$css});
	(defined $error) ? print p({-align=>'center'}),$error : print p;
	print start_form,
	table({-align=>'CENTER'},
		Tr(td[('Username: '),textfield('username')]),
		Tr(td[('Password: '),(password_field('password'))]),
		($type eq 'change') ? $newprompt : $empty,
		Tr(td[$empty,submit('Submit')]),
		end_form,
		);
	end_form;
	if ($type ne 'change') {
		print p({-align=>'center'}),
		start_form,
		hidden('forcechange','true'),
		submit('Password Change'),
		end_form
		;
	}
	return 0;
}

sub error_page {
	my ($error_message) = @_;
	print header(),
	start_html(-title=>'Password operation failed',-style=>{'code'=>$css}),
	p({-align=>'center'}),
	'An error occured with the operation: ',
	p({-align=>'center'}),
	$error_message,
	p({-align=>'center'}),
	"<a href=$ENV{'REQUEST_URI'}>Click here to return</a>";
	return 1;
}

sub success_page {
	my ($success_message) = @_;
	print header(),
	start_html(-title=>'Password operation succeeded',-style=>{'code'=>$css}),
	p({-align=>'center'}),
	'The operation was successful:',
	p({-align=>'center'}),
	$success_message;
	return 1;
}