path: root/lib/CatDap/Controller/forgot_password.pm

package CatDap::Controller::forgot_password;
use Moose;
use namespace::autoclean;
use Email::Valid;
use Data::UUID;

BEGIN {extends 'Catalyst::Controller'; }

=head1 NAME

CatDap::Controller::forgot_password - Catalyst Controller

=head1 DESCRIPTION

Catalyst Controller.

=head1 METHODS

=cut


=head2 index

=cut

sub index :Path :Args(0) : Form {
	my ( $self, $c ) = @_;

	if (defined $c->user) {
		# if we're logged in, we haven't forgotten the password
		$c->log->debug('Redirecting to /user');
		$c->res->redirect('/user');
	}
}

sub check : Local {
	my ( $self, $c ) = @_;

	my %details = %{$c->request->params};
	my $username = lc($c->request->params->{uid});
	my @errors;
	$c->stash(errors => []);
	my $email = $c->request->params->{mail};
	if (! Email::Valid->address($email)) {
		push @errors, $c->loc('Invalid email address');
	}

	if (@errors) {
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}

	# check in LDAP now that we have validated username and email
	my $emailfilter = $c->config->{'authentication'}{'realms'}{'ldap'}{'store'}{'email_filter'};
	$emailfilter =~ s/\%s/$email/g,
	$c->log->debug("Searching for email $email with filter $emailfilter");
	my $mesg = $c->model('Proxy')->search($emailfilter);
	if (!$mesg->entries()) {
		push @errors,$c->loc(
			'This email address is not bound to an account'
		);
	}

	if (@errors) {
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}

	if ($mesg->code) {
		push @errors,$mesg->error;
		$c->log->info( sprintf("finding email $email failed: %s", $mesg->error) );
		$c->stash(errors => \@errors);
		$c->stash(template => 'register/index.tt');
		return;
	}

	my $secret = gen_secret($c, $email);

	$c->stash(
		email => {
			'to'		=> $email,
			'from'		=> ${$c->config}{'emailfrom'},
			'subject'	=> ${$c->config}{'apptitle'} . " - " . $c->loc('Forgot password'),
			'template'	=> 'forgot_password.tt',
		},
		url => $c->uri_for('/forgot_password/confirm') . "?secret=$secret",
	);

	$c->log->info("Sending forgot password mail to email address $email");
	$c->forward( $c->view('Email::Template') );
	if ( @{ $c->error } ) {
		my $errors = join "\n",@{ $c->error };
		$c->log->info("Sending activation mail to $email failed: $errors");
		$c->response->body($c->loc('An error occured sending the email, please try again later. Errors [_1]', $errors));
		$c->error(0); # Reset the error condition if you need to
	}
	$c->stash(template => 'forgot_password/complete.tt');
}

sub confirm : Local {
	my ($self, $c) = @_;
	my $secret = $c->req->param('secret');
	my @errors;

	# show confirm page which can enter new password
	if (defined $c->user) {
		# if we're logged in, we haven't forgotten the password
		$c->log->debug('Redirecting to /user');
		$c->res->redirect('/user');
	}

	# find secret
	my $email = find_secret($c, $secret);
	if (!$email) {
		push @errors, "Secret has expired, please try again.";
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}
	my $mesg = find_user_email($c, $email);
	if ($mesg->code) {
		push @errors, "Secret has expired, please try again.";
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}

	# show template to enter a new password
	$c->stash(secret => $secret, template => 'forgot_password/confirm.tt');
}

sub change_password : Local {
	my ($self, $c) = @_;
	my @errors = ();
	my $secret = $c->req->param('secret');
	my $newpass;

	# find secret
	my $email = find_secret($c, $secret);
	if (!$email) {
		push @errors, "Secret has expired, please try again.";
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}
	my $mesg = find_user_email($c, $email);
	if ( $mesg->code) {
		push @errors, "Secret has expired, please try again.";
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/index.tt');
		return;
	}
	my $entry = $mesg->entry;

	# check if both passwords are equal and are confirm the validation norms
	if ($c->req->param('newpassword1') eq $c->req->param('newpassword2')) {
		$newpass = $c->req->param('newpassword1');
	} else {
		push @errors, "New passwords dont match";
	}
	# if error show confirm page again to retry
	if (@errors) {
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/confirm.tt');
		return;
	}

	# change password
	my $pp = Net::LDAP::Control::PasswordPolicy->new;
	$mesg = $c->model('Proxy')->set_password(
		user => $entry->dn,
		newpasswd => $newpass,
		control => [ $pp ],
	);
	if ($mesg->code) {
		my $perror = $mesg->error;
		push @errors, "Password change failed: $perror";
		$c->detach;
	}

	# if error show confirm page again to retry
	if (@errors) {
		$c->stash(errors => \@errors);
		$c->stash(template => 'forgot_password/confirm.tt');
		return;
	}

	# TODO: log in by setting the $c->user

	# remove the stored secret
	remove_secret($c, $secret);

	# redirect to /
	$c->log->debug('Redirecting to /');
	$c->res->redirect('/');
}

sub gen_secret {
	my ($c, $email) = @_;
	my $ug = new Data::UUID;
	# generate a unique secret
	my $secret = $ug->create_str();
	my $filename = $c->config->{'forgot_password'}{'secret'}{'path'} .'/'. $c->config->{'forgot_password'}{'secret'}{'prefix'} . $secret;
	# store secret with email
	open FILE, ">$filename";
	print FILE $email;
	close FILE;
	return $secret;
}

sub find_secret {
	my ($c, $secret) = @_;
	my $email;
	my $filename = $c->config->{'forgot_password'}{'secret'}{'path'} .'/'. $c->config->{'forgot_password'}{'secret'}{'prefix'} . $secret;
	my $timeout = 259200; # 3days in seconds
	if ($c->config->{'forgot_password'}{'secret'}{'timeout'}) {
		$timeout = $c->config->{'forgot_password'}{'secret'}{'timeout'};
	}

	# find secret
	if (!$secret || !open(FILE, "<$filename")) {
		# if secret is wrong, timeout expired?
		return '';
	}
	read(FILE, $email, 255);
	close FILE;

	# check the time, and see if it's longer than timeout
	my @s = stat($filename);
	if (time() > $s[9] + $timeout) {
		# expired
		return '';
	}

	return $email;
}

sub remove_secret {
	my ($c, $secret) = @_;
	my $filename = $c->config->{'forgot_password'}{'secret'}{'path'} .'/'. $c->config->{'forgot_password'}{'secret'}{'prefix'} . $secret;
	unlink $filename;
}

sub find_user_email {
	my ($c, $email) = @_;

	# find user by email;
	my $emailfilter = $c->config->{'authentication'}{'realms'}{'ldap'}{'store'}{'email_filter'};
	$emailfilter =~ s/\%s/$email/g,
	$c->log->debug("Searching for email $email with filter $emailfilter");
	return $c->model('Proxy')->search($emailfilter);
}


=head1 AUTHOR

Buchan Milne

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

__PACKAGE__->meta->make_immutable;

1;