Remove already transformed files (#595)
This commit is contained in:
parent
6e837af219
commit
6b2b7edd80
|
@ -1,144 +0,0 @@
|
|||
##@file
|
||||
# AD authentication backend file
|
||||
|
||||
##@class
|
||||
# AD authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthAD;
|
||||
|
||||
use strict;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use base qw(Lemonldap::NG::Portal::AuthLDAP);
|
||||
|
||||
*_formateFilter = *Lemonldap::NG::Portal::UserDBAD::formateFilter;
|
||||
*getDisplayType = *Lemonldap::NG::Portal::AuthLDAP::getDisplayType;
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Add specific attributes for search
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
my $self = shift;
|
||||
|
||||
$self->{ldapExportedVars}->{_AD_pwdLastSet} = 'pwdLastSet';
|
||||
$self->{ldapExportedVars}->{_AD_userAccountControl} = 'userAccountControl';
|
||||
$self->{ldapExportedVars}->{_AD_msDS_UACC} =
|
||||
'msDS-User-Account-Control-Computed';
|
||||
|
||||
return $self->SUPER::authInit();
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Authenticate user by LDAP mechanism.
|
||||
# Check AD specific attribute to get password state.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
my $self = shift;
|
||||
|
||||
my $res = $self->SUPER::authenticate;
|
||||
|
||||
unless ( $res == PE_OK ) {
|
||||
|
||||
# Check specific AD attributes
|
||||
my $pls = $self->{sessionInfo}->{_AD_pwdLastSet};
|
||||
my $computed = $self->{sessionInfo}->{_AD_msDS_UACC};
|
||||
my $mask = 0xf00000; # mask to get the 8 at 6th position
|
||||
my $expired_flag =
|
||||
0x800000; # 8 at 6th position for flag UF_PASSWORD_EXPIRED to be set
|
||||
if ( ( $computed & $mask ) == $expired_flag ) {
|
||||
$self->lmLog( "[AD] Password has expired", 'warn' );
|
||||
$res = PE_PP_PASSWORD_EXPIRED;
|
||||
}
|
||||
|
||||
# Password must be changed if pwdLastSet 0
|
||||
if ( defined $pls and $pls == 0 ) {
|
||||
$self->lmLog( "[AD] Password reset. User must change his password",
|
||||
'warn' );
|
||||
$res = PE_PP_CHANGE_AFTER_RESET;
|
||||
}
|
||||
|
||||
}
|
||||
else {
|
||||
|
||||
# Getting password max age (delay)
|
||||
my $ADPwdMaxAge = $self->{ADPwdMaxAge} || 0;
|
||||
$ADPwdMaxAge *= 10000000; # padding with '0' to obtain 0.1 micro-seconds
|
||||
|
||||
# Getting password expiration warning time (delay)
|
||||
my $ADPwdExpireWarning = $self->{ADPwdExpireWarning} || 0;
|
||||
$ADPwdExpireWarning *=
|
||||
10000000; # padding with '0' to obtain 0.1 micro-seconds
|
||||
|
||||
if ( $ADPwdExpireWarning > $ADPwdMaxAge ) {
|
||||
$ADPwdExpireWarning = $ADPwdMaxAge;
|
||||
$self->lmLog(
|
||||
"Error: ADPwdExpireWarning > ADPwdMaxAge, this should not happen",
|
||||
'warn'
|
||||
);
|
||||
}
|
||||
|
||||
# get userAccountControl to ckeck password expiration flags
|
||||
my $_adUac = $self->{sessionInfo}->{_AD_userAccountControl} || 0;
|
||||
|
||||
# Compute current timestamp in AD format (date)
|
||||
my $time = time; # unix timestamp (seconds since Jan 01 1970)
|
||||
my $a_time =
|
||||
$time + 11644473600; # adding difference (in s) from Jan 01 1601
|
||||
my $timestamp =
|
||||
$a_time . '0000000'; # padding with '0' to obatin 0.1 micro-seconds
|
||||
|
||||
# Compute password expiration time (date)
|
||||
my $_pwdExpire = $self->{sessionInfo}->{_AD_pwdLastSet} || $timestamp;
|
||||
$_pwdExpire += $ADPwdMaxAge;
|
||||
|
||||
# computing when the warning message is displayed on portal (date - delay = date)
|
||||
my $_pwdWarning = $_pwdExpire - $ADPwdExpireWarning;
|
||||
|
||||
# display warning if account warning time before expiration is
|
||||
# reached and flag "password nevers expires" is not set
|
||||
if ( $timestamp > $_pwdWarning
|
||||
&& $timestamp < $_pwdExpire
|
||||
&& ( $_adUac & 0x10000 ) != 0x10000 )
|
||||
{
|
||||
|
||||
# calculating remaining time before password expiration
|
||||
my $remainingTime = $_pwdExpire - $timestamp;
|
||||
$self->info(
|
||||
"<h3>"
|
||||
. sprintf(
|
||||
$self->msg(PM_PP_EXP_WARNING),
|
||||
$self->convertSec(
|
||||
substr( $remainingTime, 0, length($remainingTime) - 7 )
|
||||
)
|
||||
)
|
||||
. "</h3>"
|
||||
);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
# Remember password if password reset needed
|
||||
$self->{oldpassword} = $self->{password}
|
||||
if (
|
||||
$res == PE_PP_CHANGE_AFTER_RESET
|
||||
or ( $res == PE_PP_PASSWORD_EXPIRED
|
||||
and $self->{ldapAllowResetExpiredPassword} )
|
||||
);
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
## @method boolean stop
|
||||
# Define which error codes will stop Multi process
|
||||
# @param res error code
|
||||
# @return result 1 if stop is needed
|
||||
sub stop {
|
||||
my ( $self, $res ) = @_;
|
||||
|
||||
return 1
|
||||
if ( $res == PE_PP_PASSWORD_EXPIRED
|
||||
or $res == PE_PP_CHANGE_AFTER_RESET );
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,179 +0,0 @@
|
|||
##@file
|
||||
# Apache authentication backend file
|
||||
|
||||
##@class
|
||||
# Apache authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthApache;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int authInit()
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int extractFormInfo()
|
||||
# Read username return by Apache authentication system.
|
||||
# By default, authentication is valid if REMOTE_USER environment
|
||||
# variable is set.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub extractFormInfo {
|
||||
my $self = shift;
|
||||
unless ( $self->{user} = $ENV{REMOTE_USER} ) {
|
||||
$self->lmLog( 'Apache is not configured to authenticate users!',
|
||||
'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
# This is needed for Kerberos authentication
|
||||
$self->{user} =~ s/^(.*)@.*$/$1/g;
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setAuthSessionInfo()
|
||||
# Set _user and authenticationLevel.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setAuthSessionInfo {
|
||||
my $self = shift;
|
||||
|
||||
# Store user submitted login for basic rules
|
||||
$self->{sessionInfo}->{'_user'} = $self->{'user'};
|
||||
|
||||
$self->{sessionInfo}->{authenticationLevel} = $self->{apacheAuthnLevel};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "logo";
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
=encoding utf8
|
||||
|
||||
Lemonldap::NG::Portal::AuthApache - Perl extension for building Lemonldap::NG
|
||||
compatible portals with Apache authentication.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Lemonldap::NG::Portal::SharedConf;
|
||||
my $portal = new Lemonldap::NG::Portal::Simple(
|
||||
configStorage => {...}, # See Lemonldap::NG::Portal
|
||||
authentication => 'Apache',
|
||||
);
|
||||
|
||||
if($portal->process()) {
|
||||
# Write here the menu with CGI methods. This page is displayed ONLY IF
|
||||
# the user was not redirected here.
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "...";
|
||||
|
||||
# or redirect the user to the menu
|
||||
print $portal->redirect( -uri => 'https://portal/menu');
|
||||
}
|
||||
else {
|
||||
# If the user enters here, IT MEANS THAT APACHE AUTHENTICATION DOES NOT WORK
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "<html><body><h1>Unable to work</h1>";
|
||||
print "This server isn't well configured. Contact your administrator.";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
and of course, configure Apache to protect the portal.
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This library just overload few methods of Lemonldap::NG::Portal::Simple to use
|
||||
Apache authentication mechanism: we've just try to get REMOTE_USER environment
|
||||
variable.
|
||||
|
||||
See L<Lemonldap::NG::Portal::Simple> for usage and other methods.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::Simple>,
|
||||
L<http://lemonldap-ng.org/>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
=over
|
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUG REPORT
|
||||
|
||||
Use OW2 system to report bug or ask for features:
|
||||
L<http://jira.ow2.org>
|
||||
|
||||
=head1 DOWNLOAD
|
||||
|
||||
Lemonldap::NG is available at
|
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
=over
|
||||
|
||||
=item Copyright (C) 2007-2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
||||
|
||||
=item Copyright (C) 2009-2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
|
||||
=cut
|
||||
|
|
@ -1,276 +0,0 @@
|
|||
##@file
|
||||
# BrowserID authentication backend file
|
||||
|
||||
##@class
|
||||
# BrowserID authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthBrowserID;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use Lemonldap::NG::Portal::_Browser;
|
||||
use HTTP::Request;
|
||||
use JSON;
|
||||
|
||||
our @ISA = (qw(Lemonldap::NG::Portal::_Browser));
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Enables Browser ID (required for templates)
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
my $self = shift;
|
||||
|
||||
$self->{browserIdVerificationURL} ||=
|
||||
"https://verifier.login.persona.org/verify";
|
||||
$self->{browserIdAuthnLevel} = "2"
|
||||
unless defined $self->{browserIdAuthnLevel};
|
||||
$self->{browserIdSiteName} ||= "LemonLDAP::NG";
|
||||
$self->{browserIdBackgroundColor} ||= "#000";
|
||||
$self->{browserIdAutoLogin} ||= "0";
|
||||
|
||||
# Enable BrowserID in template
|
||||
$self->{tpl_browserIdEnabled} = 1;
|
||||
|
||||
# Set BrowserID customization parameters
|
||||
$self->{tpl_browserIdSiteName} = $self->{browserIdSiteName}
|
||||
if $self->{browserIdSiteName};
|
||||
$self->{tpl_browserIdSiteLogo} = $self->{browserIdSiteLogo}
|
||||
if $self->{browserIdSiteLogo};
|
||||
$self->{tpl_browserIdBackgroundColor} = $self->{browserIdBackgroundColor}
|
||||
if $self->{browserIdBackgroundColor};
|
||||
$self->{tpl_browserIdAutoLogin} = $self->{browserIdAutoLogin}
|
||||
if $self->{browserIdAutoLogin};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setAuthSessionInfo()
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setAuthSessionInfo {
|
||||
my $self = shift;
|
||||
|
||||
$self->{sessionInfo}->{_user} = $self->{user};
|
||||
$self->{sessionInfo}->{authenticationLevel} = $self->{browserIdAuthnLevel};
|
||||
$self->{sessionInfo}->{_browserIdAnswer} = $self->{browserIdAnswer};
|
||||
$self->{sessionInfo}->{_browserIdAnswerRaw} = $self->{browserIdAnswerRaw};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int extractFormInfo()
|
||||
# Get BrowserID assertion
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub extractFormInfo {
|
||||
my $self = shift;
|
||||
|
||||
# Assertion should be browserIdAssertion parameter
|
||||
if ( $self->{browserIdAssertion} = $self->param('browserIdAssertion') ) {
|
||||
$self->lmLog(
|
||||
"BrowserID Assertion found: " . $self->{browserIdAssertion},
|
||||
'debug' );
|
||||
|
||||
# Resolve assertion
|
||||
my $postdata =
|
||||
"assertion="
|
||||
. $self->{browserIdAssertion}
|
||||
. "&audience="
|
||||
. $self->{portal};
|
||||
|
||||
$self->lmLog( "Send $postdata to " . $self->{browserIdVerificationURL},
|
||||
'debug' );
|
||||
|
||||
my $request =
|
||||
HTTP::Request->new( 'POST' => $self->{browserIdVerificationURL} );
|
||||
$request->content_type('application/x-www-form-urlencoded');
|
||||
$request->content($postdata);
|
||||
|
||||
my $answer = $self->ua()->request($request);
|
||||
|
||||
$self->lmLog( "Verification response: " . $answer->as_string, 'debug' );
|
||||
|
||||
if ( $answer->code() == "200" ) {
|
||||
|
||||
# Get JSON answser
|
||||
$self->{browserIdAnswerRaw} = $answer->content;
|
||||
$self->lmLog(
|
||||
"Received BrowserID answer: " . $self->{browserIdAnswerRaw},
|
||||
'debug' );
|
||||
|
||||
my $json = JSON->new();
|
||||
$self->{browserIdAnswer} =
|
||||
$json->decode( $self->{browserIdAnswerRaw} );
|
||||
|
||||
if ( $self->{browserIdAnswer}->{status} eq "okay" ) {
|
||||
$self->{user} = $self->{browserIdAnswer}->{email};
|
||||
|
||||
$self->lmLog(
|
||||
"Found user "
|
||||
. $self->{user}
|
||||
. " in BrowserID verification answer",
|
||||
'debug'
|
||||
);
|
||||
|
||||
return PE_OK;
|
||||
}
|
||||
else {
|
||||
if ( $self->{browserIdAnswer}->{reason} ) {
|
||||
$self->lmLog(
|
||||
"Assertion "
|
||||
. $self->{browserIdAssertion}
|
||||
. " verification error: "
|
||||
. $self->{browserIdAnswer}->{reason},
|
||||
'error'
|
||||
);
|
||||
|
||||
}
|
||||
else {
|
||||
$self->lmLog(
|
||||
"Assertion "
|
||||
. $self->{browserIdAssertion}
|
||||
. " not verified by BrowserID provider",
|
||||
'error'
|
||||
);
|
||||
}
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->lmLog(
|
||||
"Fail to validate BrowserId assertion "
|
||||
. $self->{browserIdAssertion},
|
||||
'error'
|
||||
);
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
return PE_OK;
|
||||
}
|
||||
|
||||
# No assertion, return to login page with BrowserID login script
|
||||
$self->{tpl_browserIdLoadLoginScript} = 1;
|
||||
return PE_FIRSTACCESS;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Verify assertion and audience
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Call BrowserID logout method
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
my $self = shift;
|
||||
$self->{tpl_browserIdLoadLogoutScript} = 1;
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "logo";
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
=encoding utf8
|
||||
|
||||
Lemonldap::NG::Portal::AuthBrowserID - Perl extension for building Lemonldap::NG
|
||||
compatible portals with Mozilla BrowserID protocol
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Lemonldap::NG::Portal::SharedConf;
|
||||
my $portal = new Lemonldap::NG::Portal::Simple(
|
||||
configStorage => {...}, # See Lemonldap::NG::Portal
|
||||
authentication => 'BrowserID',
|
||||
);
|
||||
|
||||
if($portal->process()) {
|
||||
# Write here the menu with CGI methods. This page is displayed ONLY IF
|
||||
# the user was not redirected here.
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "...";
|
||||
|
||||
# or redirect the user to the menu
|
||||
print $portal->redirect( -uri => 'https://portal/menu');
|
||||
}
|
||||
else {
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "<html><body><h1>Unable to work</h1>";
|
||||
print "This server isn't well configured. Contact your administrator.";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This library just overload few methods of Lemonldap::NG::Portal::Simple to
|
||||
create sessions for anonymous users.
|
||||
|
||||
See L<Lemonldap::NG::Portal::Simple> for usage and other methods.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::Simple>,
|
||||
L<http://lemonldap-ng.org/>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
=over
|
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUG REPORT
|
||||
|
||||
Use OW2 system to report bug or ask for features:
|
||||
L<http://jira.ow2.org>
|
||||
|
||||
=head1 DOWNLOAD
|
||||
|
||||
Lemonldap::NG is available at
|
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
=over
|
||||
|
||||
=item Copyright (C) 2013 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
|
||||
=cut
|
||||
|
|
@ -1,100 +0,0 @@
|
|||
##@file
|
||||
# DBI authentication backend file
|
||||
|
||||
##@class
|
||||
# LDAP authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthDBI;
|
||||
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use base qw(Lemonldap::NG::Portal::_WebForm Lemonldap::NG::Portal::_DBI);
|
||||
use strict;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
our $initDone;
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
require threads::shared;
|
||||
threads::shared::share($initDone);
|
||||
};
|
||||
}
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Check DBI paramaters
|
||||
#@return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
my $self = shift;
|
||||
return PE_OK if ($initDone);
|
||||
|
||||
unless ($self->{dbiAuthChain}
|
||||
and $self->{dbiAuthTable}
|
||||
and $self->{dbiAuthUser}
|
||||
and $self->{dbiAuthPassword}
|
||||
and $self->{dbiAuthLoginCol}
|
||||
and $self->{dbiAuthPasswordCol} )
|
||||
{
|
||||
$self->lmLog( "Missing configuration parameters for DBI authentication",
|
||||
'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
$self->{_authnLevel} = $self->{dbiAuthnLevel};
|
||||
|
||||
$initDone = 1;
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Find row in DBI backend with user and password criterions
|
||||
#@return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
my $self = shift;
|
||||
|
||||
# Connect
|
||||
my $dbh =
|
||||
$self->dbh( $self->{dbiAuthChain}, $self->{dbiAuthUser},
|
||||
$self->{dbiAuthPassword} );
|
||||
return PE_ERROR unless $dbh;
|
||||
|
||||
# Check credentials
|
||||
my $result = $self->check_password($dbh);
|
||||
if ($result) {
|
||||
return PE_OK;
|
||||
}
|
||||
else {
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Disconnect.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
my $self = shift;
|
||||
|
||||
eval { $self->{_dbh}->disconnect(); };
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "standardform";
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,173 +0,0 @@
|
|||
##@file
|
||||
# Demo authentication backend file
|
||||
|
||||
##@class
|
||||
# Demo authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthDemo;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use base qw(Lemonldap::NG::Portal::_WebForm);
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Initialize demo accounts
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
my $self = shift;
|
||||
|
||||
# Sample accounts from Doctor Who characters
|
||||
$self->{_demoAccounts} = {
|
||||
'rtyler' => {
|
||||
'uid' => 'rtyler',
|
||||
'cn' => 'Rose Tyler',
|
||||
'mail' => 'rtyler@badwolf.org',
|
||||
},
|
||||
'msmith' => {
|
||||
'uid' => 'msmith',
|
||||
'cn' => 'Mickey Smith',
|
||||
'mail' => 'msmith@badwolf.org',
|
||||
},
|
||||
'dwho' => {
|
||||
'uid' => 'dwho',
|
||||
'cn' => 'Doctor Who',
|
||||
'mail' => 'dwho@badwolf.org',
|
||||
},
|
||||
};
|
||||
|
||||
$self->{_authnLevel} = 0;
|
||||
|
||||
# Add warning in log
|
||||
$self->lmLog(
|
||||
"Using demonstration mode, go in Manager to edit the configuration",
|
||||
'warn' );
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
my $self = shift;
|
||||
|
||||
return PE_BADCREDENTIALS unless ( $self->{user} eq $self->{password} );
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "standardform";
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
=encoding utf8
|
||||
|
||||
Lemonldap::NG::Portal::AuthDemo - Perl extension for building Lemonldap::NG
|
||||
compatible portals with built-in authentication.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Lemonldap::NG::Portal::SharedConf;
|
||||
my $portal = new Lemonldap::NG::Portal::Simple(
|
||||
configStorage => {...}, # See Lemonldap::NG::Portal
|
||||
authentication => 'Demo',
|
||||
);
|
||||
|
||||
if($portal->process()) {
|
||||
# Write here the menu with CGI methods. This page is displayed ONLY IF
|
||||
# the user was not redirected here.
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "...";
|
||||
|
||||
# or redirect the user to the menu
|
||||
print $portal->redirect( -uri => 'https://portal/menu');
|
||||
}
|
||||
else {
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "<html><body><h1>Unable to work</h1>";
|
||||
print "This server isn't well configured. Contact your administrator.";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This library just overload few methods of Lemonldap::NG::Portal::Simple to
|
||||
create sessions for sample users.
|
||||
|
||||
See L<Lemonldap::NG::Portal::Simple> for usage and other methods.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::Simple>,
|
||||
L<http://lemonldap-ng.org/>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
=over
|
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUG REPORT
|
||||
|
||||
Use OW2 system to report bug or ask for features:
|
||||
L<http://jira.ow2.org>
|
||||
|
||||
=head1 DOWNLOAD
|
||||
|
||||
Lemonldap::NG is available at
|
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
=over
|
||||
|
||||
=item Copyright (C) 2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
|
||||
=cut
|
||||
|
|
@ -1,115 +0,0 @@
|
|||
##@file
|
||||
# LDAP authentication backend file
|
||||
|
||||
##@class
|
||||
# LDAP authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthLDAP;
|
||||
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use Lemonldap::NG::Portal::_LDAP 'ldap'; #link protected ldap
|
||||
use Lemonldap::NG::Portal::_WebForm;
|
||||
use Lemonldap::NG::Portal::UserDBLDAP; #inherits
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
use base qw(Lemonldap::NG::Portal::_WebForm);
|
||||
|
||||
*_formateFilter = *Lemonldap::NG::Portal::UserDBLDAP::formateFilter;
|
||||
*_search = *Lemonldap::NG::Portal::UserDBLDAP::search;
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Set _authnLevel
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
my $self = shift;
|
||||
|
||||
$self->{_authnLevel} = $self->{ldapAuthnLevel};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Authenticate user by LDAP mechanism.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
my $self = shift;
|
||||
|
||||
unless ( $self->ldap ) {
|
||||
return PE_LDAPCONNECTFAILED;
|
||||
}
|
||||
|
||||
# Set the dn unless done before
|
||||
unless ( $self->{dn} ) {
|
||||
my $tmp = $self->_subProcess(qw(_formateFilter _search));
|
||||
$self->{sessionInfo}->{dn} = $self->{dn};
|
||||
return $tmp if ($tmp);
|
||||
}
|
||||
|
||||
my $res =
|
||||
$self->ldap->userBind( $self->{dn}, password => $self->{password} );
|
||||
|
||||
# Remember password if password reset needed
|
||||
$self->{oldpassword} = $self->{password}
|
||||
if (
|
||||
$res == PE_PP_CHANGE_AFTER_RESET
|
||||
or ( $res == PE_PP_PASSWORD_EXPIRED
|
||||
and $self->{ldapAllowResetExpiredPassword} )
|
||||
);
|
||||
|
||||
# Unbind if there was an error
|
||||
unless ( $res == PE_OK ) {
|
||||
$self->ldap->unbind;
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Unbind.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
my $self = shift;
|
||||
|
||||
if ( ref( $self->{ldap} ) && $self->{flags}->{ldapActive} ) {
|
||||
$self->ldap->unbind();
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "standardform";
|
||||
}
|
||||
|
||||
## @method boolean stop
|
||||
# Define which error codes will stop Multi process
|
||||
# @param res error code
|
||||
# @return result 1 if stop is needed
|
||||
sub stop {
|
||||
my ( $self, $res ) = @_;
|
||||
|
||||
return 1
|
||||
if ( $res == PE_PP_PASSWORD_EXPIRED
|
||||
or $res == PE_PP_ACCOUNT_LOCKED
|
||||
or $res == PE_PP_CHANGE_AFTER_RESET );
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,163 +0,0 @@
|
|||
##@file
|
||||
# Null authentication backend file
|
||||
|
||||
##@class
|
||||
# Null authentication backend class
|
||||
package Lemonldap::NG::Portal::AuthNull;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int authInit()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authInit {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setAuthSessionInfo()
|
||||
# Set _user value to 'anonymous' and authenticationLevel to 0
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setAuthSessionInfo {
|
||||
my $self = shift;
|
||||
|
||||
$self->{sessionInfo}->{'_user'} = 'anonymous';
|
||||
$self->{sessionInfo}->{authenticationLevel} = $self->{nullAuthnLevel};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int extractFormInfo()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub extractFormInfo {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authenticate()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authenticate {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authFinish()
|
||||
# Does nothing.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authFinish {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int authLogout()
|
||||
# Does nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub authLogout {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod boolean authForce()
|
||||
# Does nothing
|
||||
# @return result
|
||||
sub authForce {
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string getDisplayType
|
||||
# @return display type
|
||||
sub getDisplayType {
|
||||
return "";
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
=encoding utf8
|
||||
|
||||
Lemonldap::NG::Portal::AuthNull - Perl extension for building Lemonldap::NG
|
||||
compatible portals with no authentication.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Lemonldap::NG::Portal::SharedConf;
|
||||
my $portal = new Lemonldap::NG::Portal::Simple(
|
||||
configStorage => {...}, # See Lemonldap::NG::Portal
|
||||
authentication => 'Null',
|
||||
);
|
||||
|
||||
if($portal->process()) {
|
||||
# Write here the menu with CGI methods. This page is displayed ONLY IF
|
||||
# the user was not redirected here.
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "...";
|
||||
|
||||
# or redirect the user to the menu
|
||||
print $portal->redirect( -uri => 'https://portal/menu');
|
||||
}
|
||||
else {
|
||||
print $portal->header('text/html; charset=utf-8'); # DON'T FORGET THIS (see CGI(3))
|
||||
print "<html><body><h1>Unable to work</h1>";
|
||||
print "This server isn't well configured. Contact your administrator.";
|
||||
print "</body></html>";
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This library just overload few methods of Lemonldap::NG::Portal::Simple to
|
||||
create sessions for anonymous users.
|
||||
|
||||
See L<Lemonldap::NG::Portal::Simple> for usage and other methods.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Portal::Simple>,
|
||||
L<http://lemonldap-ng.org/>
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
=over
|
||||
|
||||
=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
||||
|
||||
=back
|
||||
|
||||
=head1 BUG REPORT
|
||||
|
||||
Use OW2 system to report bug or ask for features:
|
||||
L<http://jira.ow2.org>
|
||||
|
||||
=head1 DOWNLOAD
|
||||
|
||||
Lemonldap::NG is available at
|
||||
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
=over
|
||||
|
||||
=item Copyright (C) 2010 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
|
||||
|
||||
=item Copyright (C) 2010-2012 by Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>
|
||||
|
||||
=back
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2, or (at your option)
|
||||
any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see L<http://www.gnu.org/licenses/>.
|
||||
|
||||
=cut
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
##@file
|
||||
# AD user database backend file
|
||||
|
||||
##@class
|
||||
# AD user database backend class
|
||||
package Lemonldap::NG::Portal::UserDBAD;
|
||||
|
||||
use strict;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
use base qw(Lemonldap::NG::Portal::UserDBLDAP);
|
||||
|
||||
## @apmethod protected int formateFilter()
|
||||
# Set the default LDAP filter for AD.
|
||||
# By default, the user is searched in the LDAP server with sAMAccountName.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub formateFilter {
|
||||
my $self = shift;
|
||||
|
||||
$self->{AuthLDAPFilter} ||= '(&(sAMAccountName=$user)(objectClass=person))';
|
||||
$self->{mailLDAPFilter} ||= '(&(mail=$mail)(objectClass=person))';
|
||||
|
||||
return $self->SUPER::formateFilter;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,122 +0,0 @@
|
|||
## @file
|
||||
# DBI userDB mechanism
|
||||
|
||||
## @class
|
||||
# DBI userDB mechanism class
|
||||
package Lemonldap::NG::Portal::UserDBDBI;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use Lemonldap::NG::Portal::_DBI; #inherits
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int userDBInit()
|
||||
# Set default values
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userDBInit {
|
||||
my $self = shift;
|
||||
|
||||
# DBI access to user is the same as authentication by default
|
||||
$self->{dbiUserChain} ||= $self->{dbiAuthChain};
|
||||
$self->{dbiUserUser} ||= $self->{dbiAuthUser};
|
||||
$self->{dbiUserPassword} ||= $self->{dbiAuthPassword};
|
||||
$self->{dbiUserTable} ||= $self->{dbiAuthTable};
|
||||
$self->{userPivot} ||= $self->{dbiAuthLoginCol};
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int getUser()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub getUser {
|
||||
my $self = shift;
|
||||
|
||||
# Connect
|
||||
my $dbh =
|
||||
$self->dbh( $self->{dbiUserChain}, $self->{dbiUserUser},
|
||||
$self->{dbiUserPassword} );
|
||||
return PE_ERROR unless $dbh;
|
||||
|
||||
my $table = $self->{dbiUserTable};
|
||||
my $pivot = $self->{userPivot};
|
||||
my $user = $self->{user};
|
||||
|
||||
# If in mailProcess, adapt search criteriums
|
||||
if ( $self->{mail} ) {
|
||||
$pivot = $self->{dbiPasswordMailCol};
|
||||
$user = $self->{mail};
|
||||
}
|
||||
|
||||
$user =~ s/'/''/g;
|
||||
my $sth;
|
||||
|
||||
eval {
|
||||
$sth = $dbh->prepare("SELECT * FROM $table WHERE $pivot=?");
|
||||
$sth->execute($user);
|
||||
};
|
||||
if ($@) {
|
||||
$self->lmLog( "DBI error: $@", 'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
unless ( $self->{entry} = $sth->fetchrow_hashref() ) {
|
||||
$self->_sub( 'userNotice', "User $user not found" );
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
|
||||
# In mail process, get user value
|
||||
if ( $self->{mail} ) {
|
||||
$table = $self->{dbiAuthTable};
|
||||
$pivot = $self->{dbiAuthLoginCol};
|
||||
$user = $self->{entry}->{ $self->{userPivot} };
|
||||
eval {
|
||||
$sth = $dbh->prepare("SELECT * FROM $table WHERE $pivot=?");
|
||||
$sth->execute($user);
|
||||
};
|
||||
if ($@) {
|
||||
$self->lmLog( "DBI error: $@", 'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
my $results;
|
||||
|
||||
unless ( $results = $sth->fetchrow_hashref() ) {
|
||||
$self->_sub( 'userNotice', "User $user not found" );
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
|
||||
$self->{user} = $results->{$pivot};
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setSessionInfo()
|
||||
# Get columns for each exportedVars
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setSessionInfo {
|
||||
my $self = shift;
|
||||
|
||||
# Set _user unless already defined
|
||||
$self->{sessionInfo}->{_user} ||= $self->{user};
|
||||
|
||||
my %vars = ( %{ $self->{exportedVars} }, %{ $self->{dbiExportedVars} } );
|
||||
while ( my ( $var, $attr ) = each %vars ) {
|
||||
$self->{sessionInfo}->{$var} = $self->{entry}->{$attr}
|
||||
if ( defined $self->{entry}->{$attr} );
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setGroups()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setGroups {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
## @file
|
||||
# Demo userDB mechanism
|
||||
|
||||
## @class
|
||||
# Demo userDB mechanism class
|
||||
package Lemonldap::NG::Portal::UserDBDemo;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int userDBInit()
|
||||
# Check AuthDemo use
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userDBInit {
|
||||
my $self = shift;
|
||||
|
||||
if ( $self->get_module('auth') =~ /^Demo/ ) {
|
||||
|
||||
# Call authInit if demo accounts not found
|
||||
$self->authInit() unless defined $self->{_demoAccounts};
|
||||
|
||||
return PE_OK;
|
||||
}
|
||||
else {
|
||||
$self->lmLog( "Use UserDBDemo only with AuthDemo", 'error' );
|
||||
return PE_ERROR;
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int getUser()
|
||||
# Check known accounts
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub getUser {
|
||||
my $self = shift;
|
||||
|
||||
# Search by login
|
||||
if ( $self->{user} ) {
|
||||
return PE_OK
|
||||
if ( defined $self->{_demoAccounts}->{ $self->{user} } );
|
||||
}
|
||||
|
||||
# Search by mail
|
||||
if ( $self->{mail} ) {
|
||||
foreach my $user ( keys %{ $self->{_demoAccounts} } ) {
|
||||
if ( $self->{_demoAccounts}->{$user}->{mail} eq $self->{mail} ) {
|
||||
$self->{user} = $user;
|
||||
return PE_OK;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PE_USERNOTFOUND;
|
||||
}
|
||||
|
||||
## @apmethod int setSessionInfo()
|
||||
# Get sample data
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setSessionInfo {
|
||||
my $self = shift;
|
||||
|
||||
my %vars = ( %{ $self->{exportedVars} }, %{ $self->{demoExportedVars} } );
|
||||
while ( my ( $k, $v ) = each %vars ) {
|
||||
$self->{sessionInfo}->{$k} =
|
||||
$self->{_demoAccounts}->{ $self->{user} }->{$v}
|
||||
|| "";
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setGroups()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setGroups {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,203 +0,0 @@
|
|||
##@file
|
||||
# LDAP user database backend file
|
||||
|
||||
##@class
|
||||
# LDAP user database backend class
|
||||
package Lemonldap::NG::Portal::UserDBLDAP;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use Lemonldap::NG::Portal::_LDAP 'ldap'; #link protected ldap
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @method int userDBInit()
|
||||
# Transform ldapGroupAttributeNameSearch in ARRAY ref
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userDBInit {
|
||||
my $self = shift;
|
||||
|
||||
unless ( ref $self->{ldapGroupAttributeNameSearch} eq 'ARRAY' ) {
|
||||
my @values = split( /\s/, $self->{ldapGroupAttributeNameSearch} );
|
||||
$self->{ldapGroupAttributeNameSearch} = \@values;
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int getUser()
|
||||
# 7) Launch formateFilter() and search()
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub getUser {
|
||||
my $self = shift;
|
||||
return $self->_subProcess(qw(formateFilter search));
|
||||
}
|
||||
|
||||
## @apmethod protected int formateFilter()
|
||||
# Set the LDAP filter.
|
||||
# By default, the user is searched in the LDAP server with its UID.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub formateFilter {
|
||||
my $self = shift;
|
||||
$self->{LDAPFilter} =
|
||||
$self->{mail}
|
||||
? $self->{mailLDAPFilter}
|
||||
: $self->{AuthLDAPFilter}
|
||||
|| $self->{LDAPFilter};
|
||||
if ( $self->{LDAPFilter} ) {
|
||||
$self->lmLog( "LDAP submitted filter: " . $self->{LDAPFilter},
|
||||
'debug' );
|
||||
}
|
||||
else {
|
||||
$self->{LDAPFilter} =
|
||||
$self->{mail}
|
||||
? '(&(mail=$mail)(objectClass=inetOrgPerson))'
|
||||
: '(&(uid=$user)(objectClass=inetOrgPerson))';
|
||||
}
|
||||
$self->{LDAPFilter} =~ s/\$(user|_?password|mail)/$self->{$1}/g;
|
||||
$self->{LDAPFilter} =~ s/\$(\w+)/$self->{sessionInfo}->{$1}/g;
|
||||
$self->lmLog( "LDAP transformed filter: " . $self->{LDAPFilter}, 'debug' );
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod protected int search()
|
||||
# Search the LDAP DN of the user.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub search {
|
||||
my $self = shift;
|
||||
unless ( $self->ldap ) {
|
||||
return PE_LDAPCONNECTFAILED;
|
||||
}
|
||||
my @attrs = (
|
||||
values %{ $self->{exportedVars} },
|
||||
values %{ $self->{ldapExportedVars} }
|
||||
);
|
||||
my $mesg = $self->ldap->search(
|
||||
base => $self->{ldapBase},
|
||||
scope => 'sub',
|
||||
filter => $self->{LDAPFilter},
|
||||
deref => $self->{ldapSearchDeref} || 'find',
|
||||
attrs => \@attrs,
|
||||
);
|
||||
$self->lmLog(
|
||||
'LDAP Search with base: '
|
||||
. $self->{ldapBase}
|
||||
. ' and filter: '
|
||||
. $self->{LDAPFilter},
|
||||
'debug'
|
||||
);
|
||||
if ( $mesg->code() != 0 ) {
|
||||
$self->lmLog( 'LDAP Search error: ' . $mesg->error, 'error' );
|
||||
$self->ldap->unbind;
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
return PE_LDAPERROR;
|
||||
}
|
||||
if ( $mesg->count() > 1 ) {
|
||||
$self->lmLog( 'More than one entry returned by LDAP directory',
|
||||
'error' );
|
||||
$self->ldap->unbind;
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
unless ( $self->{entry} = $mesg->entry(0) ) {
|
||||
my $user = $self->{mail} || $self->{user};
|
||||
$self->_sub( 'userError', "$user was not found in LDAP directory" );
|
||||
$self->ldap->unbind;
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
$self->{dn} = $self->{entry}->dn();
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setSessionInfo()
|
||||
# 7) Load all parameters included in exportedVars parameter.
|
||||
# Multi-value parameters are loaded in a single string with
|
||||
# a separator (param multiValuesSeparator)
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setSessionInfo {
|
||||
my $self = shift;
|
||||
$self->{sessionInfo}->{dn} = $self->{dn};
|
||||
|
||||
my %vars = ( %{ $self->{exportedVars} }, %{ $self->{ldapExportedVars} } );
|
||||
while ( my ( $k, $v ) = each %vars ) {
|
||||
$self->{sessionInfo}->{$k} =
|
||||
$self->{ldap}->getLdapValue( $self->{entry}, $v )
|
||||
|| "";
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setGroups()
|
||||
# Load all groups in $groups.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setGroups {
|
||||
my $self = shift;
|
||||
my $groups = $self->{sessionInfo}->{groups};
|
||||
my $hGroups = $self->{sessionInfo}->{hGroups};
|
||||
|
||||
if ( $self->{ldapGroupBase} ) {
|
||||
|
||||
# Push group attribute value for recursive search
|
||||
push(
|
||||
@{ $self->{ldapGroupAttributeNameSearch} },
|
||||
$self->{ldapGroupAttributeNameGroup}
|
||||
)
|
||||
if ( $self->{ldapGroupRecursive}
|
||||
and $self->{ldapGroupAttributeNameGroup} ne "dn" );
|
||||
|
||||
# Get value for group search
|
||||
my $group_value =
|
||||
$self->{ldap}
|
||||
->getLdapValue( $self->{entry}, $self->{ldapGroupAttributeNameUser} );
|
||||
|
||||
$self->lmLog(
|
||||
"Searching LDAP groups in "
|
||||
. $self->{ldapGroupBase}
|
||||
. " for $group_value",
|
||||
'debug'
|
||||
);
|
||||
|
||||
# Call searchGroups
|
||||
my $ldapGroups = $self->{ldap}->searchGroups(
|
||||
$self->{ldapGroupBase}, $self->{ldapGroupAttributeName},
|
||||
$group_value, $self->{ldapGroupAttributeNameSearch}
|
||||
);
|
||||
|
||||
foreach ( keys %$ldapGroups ) {
|
||||
my $groupName = $_;
|
||||
$hGroups->{$groupName} = $ldapGroups->{$groupName};
|
||||
my $groupValues = [];
|
||||
foreach ( @{ $self->{ldapGroupAttributeNameSearch} } ) {
|
||||
next if $_ =~ /^name$/;
|
||||
my $firstValue = $ldapGroups->{$groupName}->{$_}->[0];
|
||||
push @$groupValues, $firstValue;
|
||||
}
|
||||
$groups .=
|
||||
$self->{multiValuesSeparator} . join( '|', @$groupValues );
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
$self->{sessionInfo}->{groups} = $groups;
|
||||
$self->{sessionInfo}->{hGroups} = $hGroups;
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int userDBFinish()
|
||||
# Unbind.
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userDBFinish {
|
||||
my $self = shift;
|
||||
|
||||
if ( ref( $self->{ldap} ) && $self->{flags}->{ldapActive} ) {
|
||||
$self->ldap->unbind();
|
||||
$self->{flags}->{ldapActive} = 0;
|
||||
}
|
||||
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
## @file
|
||||
# Null userDB mechanism
|
||||
|
||||
## @class
|
||||
# Null userDB mechanism class
|
||||
package Lemonldap::NG::Portal::UserDBNull;
|
||||
|
||||
use strict;
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @apmethod int userDBInit()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userDBInit {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int getUser()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub getUser {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setSessionInfo()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setSessionInfo {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
## @apmethod int setGroups()
|
||||
# Do nothing
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub setGroups {
|
||||
PE_OK;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,30 +0,0 @@
|
|||
##@file
|
||||
# Add LWP::UserAgent object
|
||||
|
||||
##@class
|
||||
# Add LWP::UserAgent object
|
||||
package Lemonldap::NG::Portal::_Browser;
|
||||
|
||||
use strict;
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
our $_ua;
|
||||
|
||||
## @method LWP::UserAgent ua()
|
||||
# @return LWP::UserAgent object
|
||||
sub ua {
|
||||
my $self = shift;
|
||||
|
||||
return $_ua if ($_ua);
|
||||
eval { require LWP::UserAgent; };
|
||||
$self->abort( 'LWP::UserAgent isn\'t installed', $@ ) if ($@);
|
||||
|
||||
# TODO : LWP options to use a proxy for example
|
||||
$_ua = LWP::UserAgent->new() or $self->abort($@);
|
||||
push @{ $_ua->requests_redirectable }, 'POST';
|
||||
$_ua->env_proxy();
|
||||
return $_ua;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,164 +0,0 @@
|
|||
##@file
|
||||
# DBI common functions
|
||||
|
||||
##@class
|
||||
# DBI common functions
|
||||
package Lemonldap::NG::Portal::_DBI;
|
||||
|
||||
use DBI;
|
||||
use base qw(Exporter);
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use strict;
|
||||
|
||||
our @EXPORT = qw(dbh);
|
||||
|
||||
our $VERSION = '2.0.0';
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_DBI dbh(string dbiChain, string dbiUser, string dbiPassword)
|
||||
# Create connection to database
|
||||
# @param dbiChain DBI connection chain
|
||||
# @param dbiUser DBI connection user
|
||||
# @param dbiPassword DBI connection password
|
||||
# @return dbh object
|
||||
sub dbh {
|
||||
my $self = shift;
|
||||
my $dbiChain = shift;
|
||||
my $dbiUser = shift;
|
||||
my $dbiPassword = shift;
|
||||
my $dbh;
|
||||
|
||||
# Open connection to database
|
||||
eval {
|
||||
$dbh =
|
||||
DBI->connect_cached( $dbiChain, $dbiUser, $dbiPassword,
|
||||
{ RaiseError => 1, },
|
||||
);
|
||||
};
|
||||
if ($@) {
|
||||
$self->lmLog( "DBI connection error: $@", 'error' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
$self->{_dbh} = $dbh;
|
||||
return $dbh;
|
||||
}
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_DBI hash_password(string password, string hash)
|
||||
# Return hashed password for use in SQL statement
|
||||
# @param password clear password
|
||||
# @param hash hash mechanism
|
||||
# @return SQL statement string
|
||||
sub hash_password {
|
||||
my $self = shift;
|
||||
my $password = shift;
|
||||
my $hash = shift;
|
||||
|
||||
if ( $hash =~ /^(md5|sha|sha1|encrypt)$/i ) {
|
||||
$self->lmLog( "Using " . uc($hash) . " to hash password", 'debug' );
|
||||
return uc($hash) . "($password)";
|
||||
}
|
||||
else {
|
||||
$self->lmLog( "No valid password hash, using clear text for password",
|
||||
'warn' );
|
||||
return $password;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_DBI hash_password_for_select(string password, string hash)
|
||||
# Return hashed password for use in SQL SELECT statement
|
||||
# Call hash_password unless encrypt hash is choosen
|
||||
# @param password clear password
|
||||
# @param hash hash mechanism
|
||||
# @return SQL statement string
|
||||
sub hash_password_for_select {
|
||||
my $self = shift;
|
||||
my $password = shift;
|
||||
my $hash = shift;
|
||||
my $passwordCol = $self->{dbiAuthPasswordCol};
|
||||
|
||||
if ( $hash =~ /^encrypt$/i ) {
|
||||
return uc($hash) . "($password,$passwordCol)";
|
||||
}
|
||||
else {
|
||||
return $self->hash_password( $password, $hash );
|
||||
}
|
||||
}
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_DBI check_password(ref dbh, string user, string password)
|
||||
# Verify user and password with SQL SELECT
|
||||
# @param dbh database handle
|
||||
# @param user user
|
||||
# @param password password
|
||||
# @return boolean result
|
||||
sub check_password {
|
||||
my $self = shift;
|
||||
my $dbh = shift;
|
||||
my $user = shift || $self->{user};
|
||||
my $password = shift || $self->{password};
|
||||
my $table = $self->{dbiAuthTable};
|
||||
my $loginCol = $self->{dbiAuthLoginCol};
|
||||
my $passwordCol = $self->{dbiAuthPasswordCol};
|
||||
|
||||
# Password hash
|
||||
my $passwordsql =
|
||||
$self->hash_password_for_select( "?", $self->{dbiAuthPasswordHash} );
|
||||
|
||||
my @rows = ();
|
||||
eval {
|
||||
my $sth = $dbh->prepare(
|
||||
"SELECT $loginCol FROM $table WHERE $loginCol=? AND $passwordCol=$passwordsql"
|
||||
);
|
||||
$sth->execute( $user, $password );
|
||||
@rows = $sth->fetchrow_array();
|
||||
};
|
||||
if ($@) {
|
||||
$self->lmLog( "DBI error: $@", 'error' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
if ( @rows == 1 ) {
|
||||
$self->lmLog( "One row returned by SQL query", 'debug' );
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
$self->_sub( 'userError', "Bad password for $user" );
|
||||
return 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_DBI modify_password(string user, string password, string userCol, string passwordCol)
|
||||
# Modify password with SQL UPDATE
|
||||
# @param user user
|
||||
# @param password password
|
||||
# @param userCol optional user column
|
||||
# @param passwordCol optional password column
|
||||
# @return boolean result
|
||||
sub modify_password {
|
||||
my $self = shift;
|
||||
my $user = shift;
|
||||
my $password = shift;
|
||||
my $userCol = shift || $self->{dbiAuthLoginCol};
|
||||
my $passwordCol = shift || $self->{dbiAuthPasswordCol};
|
||||
|
||||
my $table = $self->{dbiAuthTable};
|
||||
|
||||
# Password hash
|
||||
my $passwordsql = $self->hash_password( "?", $self->{dbiAuthPasswordHash} );
|
||||
|
||||
eval {
|
||||
my $sth =
|
||||
$self->{_dbh}->prepare(
|
||||
"UPDATE $table SET $passwordCol=$passwordsql WHERE $userCol=?");
|
||||
$sth->execute( $password, $user );
|
||||
};
|
||||
if ($@) {
|
||||
$self->lmLog( "DBI password modification error: $@", 'error' );
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
|
@ -1,696 +0,0 @@
|
|||
##@file
|
||||
# LDAP common functions
|
||||
|
||||
##@class
|
||||
# LDAP common functions
|
||||
package Lemonldap::NG::Portal::_LDAP;
|
||||
|
||||
use Net::LDAP; #inherits
|
||||
use Net::LDAP::Util qw(escape_filter_value);
|
||||
use Exporter;
|
||||
use base qw(Exporter Net::LDAP);
|
||||
use Lemonldap::NG::Portal::Simple;
|
||||
use Encode;
|
||||
use Unicode::String qw(utf8);
|
||||
use strict;
|
||||
|
||||
our @EXPORT = qw(ldap);
|
||||
our $VERSION = '2.0.0';
|
||||
our $ppLoaded = 0;
|
||||
|
||||
BEGIN {
|
||||
eval {
|
||||
require threads::shared;
|
||||
threads::shared::share($ppLoaded);
|
||||
};
|
||||
}
|
||||
|
||||
## @cmethod Lemonldap::NG::Portal::_LDAP new(Lemonldap::NG::Portal::Simple portal)
|
||||
# Build a Net::LDAP object using parameters issued from $portal
|
||||
# @return Lemonldap::NG::Portal::_LDAP object
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $portal = shift;
|
||||
my $self;
|
||||
unless ($portal) {
|
||||
$class->abort("$class : portal argument required !");
|
||||
}
|
||||
my $useTls = 0;
|
||||
my $tlsParam;
|
||||
my @servers = ();
|
||||
foreach my $server ( split /[\s,]+/, $portal->{ldapServer} ) {
|
||||
if ( $server =~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) {
|
||||
$useTls = 1;
|
||||
$server = $1;
|
||||
$tlsParam = $2 || "";
|
||||
}
|
||||
else {
|
||||
$useTls = 0;
|
||||
}
|
||||
push @servers, $server;
|
||||
}
|
||||
$self = Net::LDAP->new(
|
||||
\@servers,
|
||||
onerror => undef,
|
||||
( $portal->{ldapPort} ? ( port => $portal->{ldapPort} ) : () ),
|
||||
( $portal->{ldapTimeout} ? ( timeout => $portal->{ldapTimeout} ) : () ),
|
||||
( $portal->{ldapVersion} ? ( version => $portal->{ldapVersion} ) : () ),
|
||||
( $portal->{ldapRaw} ? ( raw => $portal->{ldapRaw} ) : () ),
|
||||
);
|
||||
unless ($self) {
|
||||
$portal->lmLog( $@, 'error' );
|
||||
return 0;
|
||||
}
|
||||
bless $self, $class;
|
||||
if ($useTls) {
|
||||
my %h = split( /[&=]/, $tlsParam );
|
||||
$h{cafile} = $portal->{caFile} if ( $portal->{caFile} );
|
||||
$h{capath} = $portal->{caPath} if ( $portal->{caPath} );
|
||||
my $mesg = $self->start_tls(%h);
|
||||
if ( $mesg->code ) {
|
||||
$portal->lmLog( 'StartTLS failed', 'error' );
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
$self->{portal} = $portal;
|
||||
|
||||
# Setting default LDAP password storage encoding to utf-8
|
||||
$self->{portal}->{ldapPwdEnc} ||= 'utf-8';
|
||||
return $self;
|
||||
}
|
||||
|
||||
## @method Net::LDAP::Message bind(string dn, hash args)
|
||||
# Reimplementation of Net::LDAP::bind(). Connection is done :
|
||||
# - with $dn and $args->{password} as dn/password if defined,
|
||||
# - or with Lemonldap::NG account,
|
||||
# - or with an anonymous bind.
|
||||
# @param $dn LDAP distinguish name
|
||||
# @param %args See Net::LDAP(3) manpage for more
|
||||
# @return Net::LDAP::Message
|
||||
sub bind {
|
||||
my $self = shift;
|
||||
my $mesg;
|
||||
my ( $dn, %args ) = @_;
|
||||
unless ($dn) {
|
||||
$dn = $self->{portal}->{managerDn};
|
||||
$args{password} = decode( 'utf-8', $self->{portal}->{managerPassword} );
|
||||
}
|
||||
if ( $dn && $args{password} ) {
|
||||
if ( $self->{portal}->{ldapPwdEnc} ne 'utf-8' ) {
|
||||
eval {
|
||||
my $tmp = encode(
|
||||
$self->{portal}->{ldapPwdEnc},
|
||||
decode( 'utf-8', $args{password} )
|
||||
);
|
||||
$args{password} = $tmp;
|
||||
};
|
||||
print STDERR "$@\n" if ($@);
|
||||
}
|
||||
$mesg = $self->SUPER::bind( $dn, %args );
|
||||
}
|
||||
else {
|
||||
$mesg = $self->SUPER::bind();
|
||||
}
|
||||
return $mesg;
|
||||
}
|
||||
|
||||
## @method Net::LDAP::Message unbind()
|
||||
# Reimplementation of Net::LDAP::unbind() to force call to disconnect()
|
||||
# @return Net::LDAP::Message
|
||||
sub unbind {
|
||||
my $self = shift;
|
||||
my $ldap_uri = $self->uri;
|
||||
|
||||
$self->{portal}->lmLog( "Unbind and disconnect from $ldap_uri", 'debug' );
|
||||
|
||||
my $mesg = $self->SUPER::unbind();
|
||||
$self->SUPER::disconnect();
|
||||
|
||||
return $mesg;
|
||||
}
|
||||
|
||||
## @method private boolean loadPP ()
|
||||
# Load Net::LDAP::Control::PasswordPolicy
|
||||
# @return true if succeed.
|
||||
sub loadPP {
|
||||
my $self = shift;
|
||||
return 1 if ($ppLoaded);
|
||||
|
||||
# Minimal version of Net::LDAP required
|
||||
if ( $Net::LDAP::VERSION < 0.38 ) {
|
||||
$self->{portal}->abort(
|
||||
"Module Net::LDAP is too old for password policy, please install version 0.38 or higher"
|
||||
);
|
||||
}
|
||||
|
||||
# Require Perl module
|
||||
eval { require Net::LDAP::Control::PasswordPolicy };
|
||||
if ($@) {
|
||||
$self->{portal}->lmLog(
|
||||
"Module Net::LDAP::Control::PasswordPolicy not found in @INC",
|
||||
'error' );
|
||||
return 0;
|
||||
}
|
||||
$ppLoaded = 1;
|
||||
}
|
||||
|
||||
## @method protected int userBind(string dn, hash args)
|
||||
# Call bind() with dn/password and return
|
||||
# @param $dn LDAP distinguish name
|
||||
# @param %args See Net::LDAP(3) manpage for more
|
||||
# @return Lemonldap::NG portal error code
|
||||
sub userBind {
|
||||
my $self = shift;
|
||||
|
||||
if ( $self->{portal}->{ldapPpolicyControl} ) {
|
||||
|
||||
# Create Control object
|
||||
my $pp = Net::LDAP::Control::PasswordPolicy->new();
|
||||
|
||||
# Bind with user credentials
|
||||
my $mesg = $self->bind( @_, control => [$pp] );
|
||||
|
||||
# Get server control response
|
||||
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
||||
|
||||
# Return direct unless control resonse
|
||||
unless ( defined $resp ) {
|
||||
if ( $mesg->code == 49 ) {
|
||||
$self->{portal}->_sub( 'userError',
|
||||
"Bad password for $self->{portal}->{user}" );
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
return ( $mesg->code == 0 ? PE_OK : PE_LDAPERROR );
|
||||
}
|
||||
|
||||
# Check for ppolicy error
|
||||
my $pp_error = $resp->pp_error;
|
||||
if ( defined $pp_error ) {
|
||||
$self->{portal}->_sub( 'userError',
|
||||
"Password policy error $pp_error for $self->{portal}->{user}" );
|
||||
return [
|
||||
PE_PP_PASSWORD_EXPIRED,
|
||||
PE_PP_ACCOUNT_LOCKED,
|
||||
PE_PP_CHANGE_AFTER_RESET,
|
||||
PE_PP_PASSWORD_MOD_NOT_ALLOWED,
|
||||
PE_PP_MUST_SUPPLY_OLD_PASSWORD,
|
||||
PE_PP_INSUFFICIENT_PASSWORD_QUALITY,
|
||||
PE_PP_PASSWORD_TOO_SHORT,
|
||||
PE_PP_PASSWORD_TOO_YOUNG,
|
||||
PE_PP_PASSWORD_IN_HISTORY,
|
||||
]->[$pp_error];
|
||||
}
|
||||
elsif ( $mesg->code == 0 ) {
|
||||
|
||||
# Get expiration warning and graces
|
||||
if ( $resp->grace_authentications_remaining ) {
|
||||
$self->{portal}->info( "<h3>"
|
||||
. $resp->grace_authentications_remaining . " "
|
||||
. $self->{portal}->msg(PM_PP_GRACE)
|
||||
. "</h3>" );
|
||||
}
|
||||
if ( $resp->time_before_expiration ) {
|
||||
$self->{portal}->info(
|
||||
"<h3>"
|
||||
. sprintf(
|
||||
$self->{portal}->msg(PM_PP_EXP_WARNING),
|
||||
$self->{portal}
|
||||
->convertSec( $resp->time_before_expiration )
|
||||
)
|
||||
. "</h3>"
|
||||
);
|
||||
}
|
||||
|
||||
return PE_OK;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $mesg = $self->bind(@_);
|
||||
if ( $mesg->code == 0 ) {
|
||||
return PE_OK;
|
||||
}
|
||||
}
|
||||
$self->{portal}
|
||||
->_sub( 'userError', "Bad password for $self->{portal}->{user}" );
|
||||
return PE_BADCREDENTIALS;
|
||||
}
|
||||
|
||||
## @method int userModifyPassword(string dn, string newpassword, string confirmpassword, string oldpassword, boolean ad)
|
||||
# Change user's password.
|
||||
# @param $dn DN
|
||||
# @param $newpassword New password
|
||||
# @param $confirmpassword New password
|
||||
# @param $oldpassword Current password
|
||||
# @param $ad Active Directory mode
|
||||
# @return Lemonldap::NG::Portal constant
|
||||
sub userModifyPassword {
|
||||
my ( $self, $dn, $newpassword, $confirmpassword, $oldpassword, $ad ) = @_;
|
||||
my $ppolicyControl = $self->{portal}->{ldapPpolicyControl};
|
||||
my $setPassword = $self->{portal}->{ldapSetPassword};
|
||||
my $asUser = $self->{portal}->{ldapChangePasswordAsUser};
|
||||
my $requireOldPassword = $self->{portal}->{portalRequireOldPassword};
|
||||
my $passwordAttribute = "userPassword";
|
||||
my $err;
|
||||
my $mesg;
|
||||
|
||||
# Verify confirmation password matching
|
||||
unless ( $newpassword eq $confirmpassword ) {
|
||||
$self->{portal}->lmLog(
|
||||
"Password $newpassword and password $confirmpassword are not the same",
|
||||
'debug'
|
||||
);
|
||||
return PE_PASSWORD_MISMATCH;
|
||||
}
|
||||
|
||||
# Adjust configuration for AD
|
||||
if ($ad) {
|
||||
$ppolicyControl = 0;
|
||||
$setPassword = 0;
|
||||
$passwordAttribute = "unicodePwd";
|
||||
|
||||
# Encode password for AD
|
||||
$newpassword = utf8( chr(34) . $newpassword . chr(34) )->utf16le();
|
||||
if ( $oldpassword and $asUser ) {
|
||||
$oldpassword = utf8( chr(34) . $oldpassword . chr(34) )->utf16le();
|
||||
}
|
||||
$self->{portal}->lmLog( "Active Directory mode enabled", 'debug' );
|
||||
|
||||
}
|
||||
|
||||
# First case: no ppolicy
|
||||
if ( !$ppolicyControl ) {
|
||||
|
||||
if ($setPassword) {
|
||||
|
||||
# Bind as user if oldpassword and ldapChangePasswordAsUser
|
||||
if ( $oldpassword and $asUser ) {
|
||||
|
||||
$mesg = $self->bind( $dn, password => $oldpassword );
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
|
||||
# Use SetPassword extended operation
|
||||
require Net::LDAP::Extension::SetPassword;
|
||||
$mesg =
|
||||
($oldpassword)
|
||||
? $self->set_password(
|
||||
user => $dn,
|
||||
oldpasswd => $oldpassword,
|
||||
newpasswd => $newpassword
|
||||
)
|
||||
: $self->set_password(
|
||||
user => $dn,
|
||||
newpasswd => $newpassword
|
||||
);
|
||||
|
||||
# Catch the "Unwilling to perform" error
|
||||
if ( $mesg->code == 53 ) {
|
||||
$self->{portal}->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
||||
# AD specific
|
||||
# Change password as user with a delete/add modification
|
||||
if ( $ad and $oldpassword and $asUser ) {
|
||||
$mesg = $self->modify(
|
||||
$dn,
|
||||
changes => [
|
||||
delete => [ $passwordAttribute => $oldpassword ],
|
||||
add => [ $passwordAttribute => $newpassword ]
|
||||
]
|
||||
);
|
||||
}
|
||||
|
||||
else {
|
||||
if ($requireOldPassword) {
|
||||
|
||||
return PE_MUST_SUPPLY_OLD_PASSWORD if ( !$oldpassword );
|
||||
|
||||
# Check old password with a bind
|
||||
$mesg = $self->bind( $dn, password => $oldpassword );
|
||||
|
||||
# For AD password expiration to work:
|
||||
# ppolicy must be desactivated,
|
||||
# and "change as user" must be desactivated
|
||||
if ($ad) {
|
||||
if ( $mesg->error =~ /LdapErr: .* data ([^,]+),.*/ ) {
|
||||
|
||||
# extended data message code:
|
||||
# 532: password expired (but provided password is correct)
|
||||
# 773: must change password at next connection (but provided password is correct)
|
||||
# 52e: password is incorrect
|
||||
unless ( ( $1 eq '532' ) || ( $1 eq '773' ) ) {
|
||||
$self->{portal}
|
||||
->lmLog( "Bad old password", 'warn' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
|
||||
# if error message has not been catched, then it IS a success
|
||||
}
|
||||
else
|
||||
{ # this is not AD, a 0 error code means good old password
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}
|
||||
->lmLog( "Bad old password", 'warn' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
|
||||
# Rebind as Manager only if user is not granted to change its password
|
||||
$self->bind() unless $asUser;
|
||||
}
|
||||
|
||||
# Use standard modification
|
||||
$mesg =
|
||||
$self->modify( $dn,
|
||||
replace => { $passwordAttribute => $newpassword } );
|
||||
}
|
||||
}
|
||||
$self->{portal}
|
||||
->lmLog( "Modification return code: " . $mesg->code, 'debug' );
|
||||
return PE_WRONGMANAGERACCOUNT
|
||||
if ( $mesg->code == 50 || $mesg->code == 8 );
|
||||
return PE_PP_INSUFFICIENT_PASSWORD_QUALITY
|
||||
if ( $mesg->code == 53 && $ad );
|
||||
return PE_PP_PASSWORD_MOD_NOT_ALLOWED
|
||||
if ( $mesg->code == 19 && $ad );
|
||||
return PE_LDAPERROR unless ( $mesg->code == 0 );
|
||||
$self->{portal}
|
||||
->_sub( 'userNotice', "Password changed $self->{portal}->{user}" );
|
||||
|
||||
# Rebind as manager for next LDAP operations if we were bound as user
|
||||
$self->bind() if $asUser;
|
||||
|
||||
return PE_PASSWORD_OK;
|
||||
}
|
||||
else {
|
||||
|
||||
# Create Control object
|
||||
my $pp = Net::LDAP::Control::PasswordPolicy->new;
|
||||
|
||||
if ($setPassword) {
|
||||
|
||||
# Bind as user if oldpassword and ldapChangePasswordAsUser
|
||||
if ( $oldpassword and $asUser ) {
|
||||
|
||||
$mesg = $self->bind(
|
||||
$dn,
|
||||
password => $oldpassword,
|
||||
control => [$pp]
|
||||
);
|
||||
my ($bind_resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
||||
|
||||
unless ( defined $bind_resp ) {
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
||||
# Check if password is expired
|
||||
my $pp_error = $bind_resp->pp_error;
|
||||
if ( defined $pp_error
|
||||
and $pp_error == 0
|
||||
and $self->{portal}->{ldapAllowResetExpiredPassword} )
|
||||
{
|
||||
$self->{portal}->lmLog(
|
||||
"Password is expired but user is allowed to change it",
|
||||
'debug'
|
||||
);
|
||||
}
|
||||
else {
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}
|
||||
->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Use SetPassword extended operation
|
||||
# Warning: need a patch on Perl-LDAP
|
||||
# See http://groups.google.com/group/perl.ldap/browse_thread/thread/5703a41ccb17b221/377a68f872cc2bb4?lnk=gst&q=setpassword#377a68f872cc2bb4
|
||||
use Net::LDAP::Extension::SetPassword;
|
||||
$mesg =
|
||||
($oldpassword)
|
||||
? $self->set_password(
|
||||
user => $dn,
|
||||
oldpasswd => $oldpassword,
|
||||
newpasswd => $newpassword,
|
||||
control => [$pp]
|
||||
)
|
||||
: $self->set_password(
|
||||
user => $dn,
|
||||
newpasswd => $newpassword,
|
||||
control => [$pp]
|
||||
);
|
||||
|
||||
# Catch the "Unwilling to perform" error
|
||||
if ( $mesg->code == 53 ) {
|
||||
$self->{portal}->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ($oldpassword) {
|
||||
|
||||
# Check old password with a bind
|
||||
$mesg = $self->bind(
|
||||
$dn,
|
||||
password => $oldpassword,
|
||||
control => [$pp]
|
||||
);
|
||||
my ($bind_resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
||||
|
||||
unless ( defined $bind_resp ) {
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
||||
# Check if password is expired
|
||||
my $pp_error = $bind_resp->pp_error;
|
||||
if ( defined $pp_error
|
||||
and $pp_error == 0
|
||||
and $self->{portal}->{ldapAllowResetExpiredPassword} )
|
||||
{
|
||||
$self->{portal}->lmLog(
|
||||
"Password is expired but user is allowed to change it",
|
||||
'debug'
|
||||
);
|
||||
}
|
||||
else {
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->{portal}
|
||||
->lmLog( "Bad old password", 'debug' );
|
||||
return PE_BADOLDPASSWORD;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Rebind as Manager only if user is not granted to change its password
|
||||
$self->bind()
|
||||
unless $asUser;
|
||||
}
|
||||
|
||||
# Use standard modification
|
||||
$mesg = $self->modify(
|
||||
$dn,
|
||||
replace => { $passwordAttribute => $newpassword },
|
||||
control => [$pp]
|
||||
);
|
||||
}
|
||||
|
||||
# Get server control response
|
||||
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
||||
|
||||
$self->{portal}
|
||||
->lmLog( "Modification return code: " . $mesg->code, 'debug' );
|
||||
return PE_WRONGMANAGERACCOUNT
|
||||
if ( $mesg->code == 50 || $mesg->code == 8 );
|
||||
if ( $mesg->code == 0 ) {
|
||||
$self->{portal}->_sub( 'userNotice',
|
||||
"Password changed $self->{portal}->{user}" );
|
||||
|
||||
# Rebind as manager for next LDAP operations if we were bound as user
|
||||
$self->bind() if $asUser;
|
||||
|
||||
return PE_PASSWORD_OK;
|
||||
}
|
||||
|
||||
if ( defined $resp ) {
|
||||
my $pp_error = $resp->pp_error;
|
||||
if ( defined $pp_error ) {
|
||||
$self->{portal}->_sub( 'userError',
|
||||
"Password policy error $pp_error for $self->{portal}->{user}"
|
||||
);
|
||||
return [
|
||||
PE_PP_PASSWORD_EXPIRED,
|
||||
PE_PP_ACCOUNT_LOCKED,
|
||||
PE_PP_CHANGE_AFTER_RESET,
|
||||
PE_PP_PASSWORD_MOD_NOT_ALLOWED,
|
||||
PE_PP_MUST_SUPPLY_OLD_PASSWORD,
|
||||
PE_PP_INSUFFICIENT_PASSWORD_QUALITY,
|
||||
PE_PP_PASSWORD_TOO_SHORT,
|
||||
PE_PP_PASSWORD_TOO_YOUNG,
|
||||
PE_PP_PASSWORD_IN_HISTORY,
|
||||
]->[$pp_error];
|
||||
}
|
||||
}
|
||||
else {
|
||||
return PE_LDAPERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
## @method protected Lemonldap::NG::Portal::_LDAP ldap()
|
||||
# @return Lemonldap::NG::Portal::_LDAP object
|
||||
sub ldap {
|
||||
my $self = shift;
|
||||
return $self->{ldap}
|
||||
if ( ref( $self->{ldap} ) and $self->{flags}->{ldapActive} );
|
||||
if ( $self->{ldap} = Lemonldap::NG::Portal::_LDAP->new($self)
|
||||
and my $mesg = $self->{ldap}->bind )
|
||||
{
|
||||
if ( $mesg->code != 0 ) {
|
||||
$self->lmLog( "LDAP error: " . $mesg->error, 'error' );
|
||||
$self->{ldap}->unbind;
|
||||
}
|
||||
else {
|
||||
if ( $self->{ldapPpolicyControl}
|
||||
and not $self->{ldap}->loadPP() )
|
||||
{
|
||||
$self->lmLog( "LDAP password policy error", 'error' );
|
||||
$self->{ldap}->unbind;
|
||||
}
|
||||
else {
|
||||
$self->{flags}->{ldapActive} = 1;
|
||||
return $self->{ldap};
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->lmLog( "LDAP error: $@", 'error' );
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
## @method string searchGroups(string base, string key, string value, string attributes)
|
||||
# Get groups from LDAP directory
|
||||
# @param base LDAP search base
|
||||
# @param key Attribute name in group containing searched value
|
||||
# @param value Searched value
|
||||
# @param attributes to get from found groups (array ref)
|
||||
# @return hashRef groups
|
||||
sub searchGroups {
|
||||
my ( $self, $base, $key, $value, $attributes ) = @_;
|
||||
|
||||
my $portal = $self->{portal};
|
||||
my $groups = {};
|
||||
|
||||
# Creating search filter
|
||||
my $searchFilter =
|
||||
"(&(objectClass=" . $portal->{ldapGroupObjectClass} . ")(|";
|
||||
foreach ( split( $portal->{multiValuesSeparator}, $value ) ) {
|
||||
$searchFilter .= "(" . $key . "=" . escape_filter_value($_) . ")";
|
||||
}
|
||||
$searchFilter .= "))";
|
||||
|
||||
$portal->lmLog( "Group search filter: $searchFilter", 'debug' );
|
||||
|
||||
# Search
|
||||
my $mesg = $self->search(
|
||||
base => $base,
|
||||
filter => $searchFilter,
|
||||
attrs => $attributes,
|
||||
);
|
||||
|
||||
# Browse results
|
||||
if ( $mesg->code() == 0 ) {
|
||||
|
||||
foreach my $entry ( $mesg->all_entries ) {
|
||||
|
||||
$portal->lmLog( "Matching group " . $entry->dn() . " found",
|
||||
'debug' );
|
||||
|
||||
# If recursive search is activated, do it here
|
||||
if ( $portal->{ldapGroupRecursive} ) {
|
||||
|
||||
# Get searched value
|
||||
my $group_value =
|
||||
$self->getLdapValue( $entry,
|
||||
$portal->{ldapGroupAttributeNameGroup} );
|
||||
|
||||
# Launch group search
|
||||
if ($group_value) {
|
||||
|
||||
$portal->lmLog( "Recursive search for $group_value",
|
||||
'debug' );
|
||||
|
||||
my $recursive_groups =
|
||||
$self->searchGroups( $base, $key, $group_value,
|
||||
$attributes );
|
||||
|
||||
my %allGroups = ( %$groups, %$recursive_groups )
|
||||
if ( ref $recursive_groups );
|
||||
$groups = \%allGroups;
|
||||
}
|
||||
}
|
||||
|
||||
# Use first attribute as group name
|
||||
my $groupName = $entry->get_value( $attributes->[0] );
|
||||
$groups->{$groupName}->{name} = $groupName;
|
||||
|
||||
# Now parse attributes
|
||||
foreach (@$attributes) {
|
||||
|
||||
# Next if group attribute value
|
||||
next if ( $_ eq $portal->{ldapGroupAttributeValueGroup} );
|
||||
|
||||
my $data = $entry->get_value( $_, asref => 1 );
|
||||
|
||||
if ($data) {
|
||||
$portal->lmLog( "Store values of $_ in group $groupName",
|
||||
'debug' );
|
||||
$groups->{$groupName}->{$_} = $data;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $groups;
|
||||
}
|
||||
|
||||
## @method string getLdapValue(Net::LDAP::Entry entry, string attribute)
|
||||
# Get the dn, or the attribute value with a separator for multi-valuated attributes
|
||||
# @param entry LDAP entry
|
||||
# @param attribute Attribute name
|
||||
# @return string value
|
||||
sub getLdapValue {
|
||||
my ( $self, $entry, $attribute ) = @_;
|
||||
|
||||
return $entry->dn() if ( $attribute eq "dn" );
|
||||
|
||||
my $value;
|
||||
|
||||
foreach ( $entry->get_value($attribute) ) {
|
||||
$value .= $_;
|
||||
$value .= $self->{portal}->{multiValuesSeparator};
|
||||
}
|
||||
|
||||
$value =~ s/\Q$self->{portal}->{multiValuesSeparator}\E$//;
|
||||
|
||||
return $value;
|
||||
}
|
||||
|
||||
1;
|
Loading…
Reference in New Issue
Block a user