2010-07-22 11:06:50 +02:00
|
|
|
## @file
|
2010-01-21 18:38:55 +01:00
|
|
|
# Module for password reset by mail
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @class Lemonldap::NG::Portal::MailReset
|
2010-01-21 18:38:55 +01:00
|
|
|
# Module for password reset by mail
|
|
|
|
package Lemonldap::NG::Portal::MailReset;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use warnings;
|
|
|
|
|
2011-01-25 11:57:45 +01:00
|
|
|
our $VERSION = '1.0.2';
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
use Lemonldap::NG::Portal::Simple qw(:all);
|
|
|
|
use base qw(Lemonldap::NG::Portal::SharedConf Exporter);
|
2010-01-22 12:25:37 +01:00
|
|
|
use HTML::Template;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
2010-10-02 17:45:10 +02:00
|
|
|
#inherits Lemonldap::NG::Portal::_SMTP
|
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
*EXPORT_OK = *Lemonldap::NG::Portal::Simple::EXPORT_OK;
|
|
|
|
*EXPORT_TAGS = *Lemonldap::NG::Portal::Simple::EXPORT_TAGS;
|
|
|
|
*EXPORT = *Lemonldap::NG::Portal::Simple::EXPORT;
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method boolean process()
|
2010-01-21 18:38:55 +01:00
|
|
|
# Call functions to handle password reset by mail issued from
|
|
|
|
# - itself:
|
|
|
|
# - smtpInit
|
|
|
|
# - extractMailInfo
|
|
|
|
# - storeMailSession
|
|
|
|
# - sendConfirmationMail
|
2010-01-22 12:25:37 +01:00
|
|
|
# - sendPasswordMail
|
2010-01-21 18:38:55 +01:00
|
|
|
# - portal core module:
|
|
|
|
# - setMacros
|
|
|
|
# - setLocalGroups
|
|
|
|
# - setGroups
|
|
|
|
# - userDB module:
|
|
|
|
# - userDBInit
|
|
|
|
# - getUser
|
|
|
|
# - setSessionInfo
|
|
|
|
# - passwordDB module:
|
|
|
|
# - passwordDBInit
|
|
|
|
# - resetPassword
|
2010-07-22 11:06:50 +02:00
|
|
|
# @return 1 if all is OK
|
2010-01-21 18:38:55 +01:00
|
|
|
sub process {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
# Process subroutines
|
|
|
|
$self->{error} = PE_OK;
|
2010-07-22 11:06:50 +02:00
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
$self->{error} = $self->_subProcess(
|
|
|
|
qw(smtpInit userDBInit passwordDBInit extractMailInfo
|
2010-10-21 12:28:47 +02:00
|
|
|
getUser setSessionInfo setMacros setLocalGroups setGroups setPersistentSessionInfo
|
2010-01-22 12:25:37 +01:00
|
|
|
storeMailSession sendConfirmationMail resetPassword sendPasswordMail)
|
2010-01-21 18:38:55 +01:00
|
|
|
);
|
2010-07-22 11:06:50 +02:00
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
return (
|
|
|
|
(
|
|
|
|
$self->{error} <= 0
|
|
|
|
or $self->{error} == PE_PASSWORD_OK
|
|
|
|
or $self->{error} == PE_MAILOK
|
|
|
|
) ? 0 : 1
|
|
|
|
);
|
|
|
|
}
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method int smtpInit()
|
2010-01-21 18:38:55 +01:00
|
|
|
# Load SMTP methods
|
2010-07-22 11:06:50 +02:00
|
|
|
# @return Lemonldap::NG::Portal constant
|
2010-01-21 18:38:55 +01:00
|
|
|
sub smtpInit {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
eval { use base qw(Lemonldap::NG::Portal::_SMTP) };
|
2010-07-22 11:06:50 +02:00
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
if ($@) {
|
|
|
|
$self->lmLog( "Unable to load SMTP functions ($@)", 'error' );
|
|
|
|
return PE_ERROR;
|
|
|
|
}
|
|
|
|
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method int extractMailInfo
|
2010-01-21 18:38:55 +01:00
|
|
|
# Get mail from form or from mail_token
|
2010-07-22 11:06:50 +02:00
|
|
|
# @return Lemonldap::NG::Portal constant
|
2010-01-21 18:38:55 +01:00
|
|
|
sub extractMailInfo {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
return PE_MAILFORMEMPTY
|
|
|
|
unless ( $self->param('mail') || $self->param('mail_token') );
|
|
|
|
|
|
|
|
$self->{mail_token} = $self->param('mail_token');
|
|
|
|
|
|
|
|
# If a mail token is present, find the corresponding mail
|
|
|
|
if ( $self->{mail_token} ) {
|
|
|
|
|
|
|
|
$self->lmLog( "Token given for password reset: " . $self->{mail_token},
|
|
|
|
'debug' );
|
|
|
|
|
|
|
|
# Get the corresponding session
|
|
|
|
my $h = $self->getApacheSession( $self->{mail_token} );
|
|
|
|
|
|
|
|
if ( ref $h ) {
|
|
|
|
$self->{mail} = $h->{ $self->{mailSessionKey} };
|
|
|
|
$self->lmLog( "Mail associated to token: " . $self->{mail},
|
|
|
|
'debug' );
|
|
|
|
}
|
|
|
|
|
|
|
|
# Mail token can be used only one time, delete the session
|
|
|
|
tied(%$h)->delete() if ref $h;
|
|
|
|
|
|
|
|
return PE_BADMAILTOKEN unless ( $self->{mail} );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
|
|
|
|
# Use submitted value
|
|
|
|
$self->{mail} = $self->param('mail');
|
|
|
|
}
|
|
|
|
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method int storeMailSession
|
|
|
|
# Create mail session and store token
|
|
|
|
# @return Lemonldap::NG::Portal constant
|
2010-01-21 18:38:55 +01:00
|
|
|
sub storeMailSession {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
# Skip this step if confirmation was already sent
|
|
|
|
return PE_OK if $self->{mail_token};
|
|
|
|
|
|
|
|
# Create a new session
|
|
|
|
my $h = $self->getApacheSession();
|
|
|
|
|
|
|
|
# Set _utime for session autoremove
|
|
|
|
$h->{_utime} = time();
|
|
|
|
|
|
|
|
# Store mail
|
|
|
|
$h->{ $self->{mailSessionKey} } = $self->{mail};
|
|
|
|
|
|
|
|
# Untie session
|
|
|
|
untie %$h;
|
|
|
|
|
|
|
|
PE_OK;
|
|
|
|
}
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method int sendConfirmationMail
|
|
|
|
# Send confirmation mail
|
|
|
|
# @return Lemonldap::NG::Portal constant
|
2010-01-21 18:38:55 +01:00
|
|
|
sub sendConfirmationMail {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
# Skip this step if confirmation was already sent
|
|
|
|
return PE_OK if $self->{mail_token};
|
|
|
|
|
|
|
|
# Build confirmation url
|
|
|
|
my $url = $self->{mailUrl} . "?mail_token=" . $self->{id};
|
2011-01-25 11:57:45 +01:00
|
|
|
$url .= '&' . $self->{authChoiceParam} . '=' . $self->{_authChoice}
|
|
|
|
if ( $self->{_authChoice} );
|
2010-01-21 18:38:55 +01:00
|
|
|
|
2010-01-22 12:25:37 +01:00
|
|
|
# Build mail content
|
|
|
|
my $subject = $self->{mailConfirmSubject};
|
|
|
|
my $body;
|
|
|
|
my $html;
|
|
|
|
if ( $self->{mailConfirmBody} ) {
|
|
|
|
|
|
|
|
# We use a specific text message, no html
|
|
|
|
$body = $self->{mailConfirmBody};
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
|
|
|
|
# Use HTML template
|
|
|
|
my $template = HTML::Template->new(
|
2011-02-04 13:50:24 +01:00
|
|
|
filename => $self->getApacheHtdocsPath() . "skins/common/mail_confirm.tpl",
|
2010-01-22 12:25:37 +01:00
|
|
|
filter => sub { $self->translate_template(@_) }
|
|
|
|
);
|
|
|
|
$body = $template->output();
|
|
|
|
$html = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Replace variables in body
|
|
|
|
$body =~ s/\$url/$url/g;
|
|
|
|
$body =~ s/\$(\w+)/$self->{sessionInfo}->{$1}/g;
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
# Send mail
|
2010-01-22 12:25:37 +01:00
|
|
|
return PE_MAILERROR
|
|
|
|
unless $self->send_mail( $self->{mail}, $subject, $body, $html );
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
PE_MAILOK;
|
|
|
|
}
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
## @method int sendPasswordMail
|
|
|
|
# Send mail containing the new password
|
|
|
|
# @return Lemonldap::NG::Portal constant
|
2010-01-22 12:25:37 +01:00
|
|
|
sub sendPasswordMail {
|
2010-07-22 11:06:50 +02:00
|
|
|
my ($self) = splice @_;
|
2010-01-22 12:25:37 +01:00
|
|
|
|
|
|
|
# Build mail content
|
|
|
|
my $subject = $self->{mailSubject};
|
|
|
|
my $body;
|
|
|
|
my $html;
|
|
|
|
if ( $self->{mailBody} ) {
|
|
|
|
|
|
|
|
# We use a specific text message, no html
|
|
|
|
$body = $self->{mailBody};
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
|
|
|
|
# Use HTML template
|
|
|
|
my $template = HTML::Template->new(
|
2011-02-04 13:50:24 +01:00
|
|
|
filename => $self->getApacheHtdocsPath() . "skins/common/mail_password.tpl",
|
2010-01-22 12:25:37 +01:00
|
|
|
filter => sub { $self->translate_template(@_) }
|
|
|
|
);
|
|
|
|
$body = $template->output();
|
|
|
|
$html = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
# Replace variables in body
|
|
|
|
my $password = $self->{reset_password};
|
|
|
|
$body =~ s/\$password/$password/g;
|
|
|
|
$body =~ s/\$(\w+)/$self->{sessionInfo}->{$1}/g;
|
|
|
|
|
|
|
|
# Send mail
|
|
|
|
return PE_MAILERROR
|
|
|
|
unless $self->send_mail( $self->{mail}, $subject, $body, $html );
|
|
|
|
|
|
|
|
PE_MAILOK;
|
|
|
|
}
|
2010-07-22 11:06:50 +02:00
|
|
|
|
2010-01-21 18:38:55 +01:00
|
|
|
1;
|
|
|
|
|
|
|
|
__END__
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
|
|
=encoding utf8
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::MailReset - Manage password reset by mail
|
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
|
|
use Lemonldap::NG::Portal::MailReset;
|
|
|
|
|
2010-07-22 11:06:50 +02:00
|
|
|
my $portal = new Lemonldap::NG::Portal::MailReset();
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
$portal->process();
|
|
|
|
|
|
|
|
# Write here HTML to manage errors and confirmation messages
|
|
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
|
|
Lemonldap::NG::Portal::MailReset enables password reset by mail
|
|
|
|
|
|
|
|
See L<Lemonldap::NG::Portal::SharedConf> for a complete example of use of
|
|
|
|
Lemonldap::Portal::* libraries.
|
|
|
|
|
|
|
|
=head1 METHODS
|
|
|
|
|
|
|
|
=head3 process
|
|
|
|
|
|
|
|
Main method.
|
|
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
|
|
|
|
L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal::SharedConf>, L<CGI>,
|
2010-10-26 08:08:16 +02:00
|
|
|
L<http://lemonldap-ng.org/>
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
|
|
|
|
Clement Oudot, E<lt>clement@oodo.netE<gt>
|
|
|
|
|
|
|
|
=head1 BUG REPORT
|
|
|
|
|
|
|
|
Use OW2 system to report bug or ask for features:
|
2010-10-26 08:08:16 +02:00
|
|
|
L<http://jira.ow2.org>
|
2010-01-21 18:38:55 +01:00
|
|
|
|
|
|
|
=head1 DOWNLOAD
|
|
|
|
|
|
|
|
Lemonldap::NG is available at
|
|
|
|
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
|
2010-10-23 10:35:38 +02:00
|
|
|
Copyright (C) 2005, 2009, 2010 by Xavier Guimard E<lt>x.guimard@free.frE<gt> and
|
2010-01-21 18:38:55 +01:00
|
|
|
Clement Oudot, E<lt>clement@oodo.netE<gt>
|
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
2010-10-24 09:25:44 +02:00
|
|
|
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
2010-01-21 18:38:55 +01:00
|
|
|
at your option, any later version of Perl 5 you may have available.
|
|
|
|
|
|
|
|
=cut
|