Remove already transformed files (#595)

This commit is contained in:
Xavier Guimard 2016-05-24 05:23:05 +00:00
parent 6e837af219
commit 6b2b7edd80
15 changed files with 0 additions and 2518 deletions

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;