2008-12-31 16:10:02 +01:00
|
|
|
##@file
|
|
|
|
# LDAP common functions
|
|
|
|
|
|
|
|
##@class
|
|
|
|
# LDAP common functions
|
2008-10-05 20:42:50 +02:00
|
|
|
package Lemonldap::NG::Portal::_LDAP;
|
|
|
|
|
2009-11-25 13:38:22 +01:00
|
|
|
use Net::LDAP; #inherits
|
2009-02-15 09:53:44 +01:00
|
|
|
use Exporter;
|
|
|
|
use base qw(Exporter Net::LDAP);
|
2009-04-08 12:32:33 +02:00
|
|
|
use Lemonldap::NG::Portal::Simple;
|
2010-06-21 16:47:27 +02:00
|
|
|
use Encode;
|
2009-02-15 09:53:44 +01:00
|
|
|
use strict;
|
|
|
|
|
|
|
|
our @EXPORT = qw(ldap);
|
2008-10-05 20:42:50 +02:00
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
our $VERSION = '0.3';
|
2008-10-05 20:42:50 +02:00
|
|
|
|
2008-12-31 16:10:02 +01:00
|
|
|
## @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
|
2008-10-05 20:42:50 +02:00
|
|
|
sub new {
|
2008-10-07 22:15:48 +02:00
|
|
|
my $class = shift;
|
2008-10-05 20:42:50 +02:00
|
|
|
my $portal = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
my $self;
|
|
|
|
unless ($portal) {
|
2008-11-21 08:27:08 +01:00
|
|
|
$class->abort("$class : portal argument required !");
|
2008-10-05 20:42:50 +02:00
|
|
|
}
|
|
|
|
my $useTls = 0;
|
|
|
|
my $tlsParam;
|
2009-03-08 18:37:31 +01:00
|
|
|
my @servers = ();
|
2008-10-07 22:15:48 +02:00
|
|
|
foreach my $server ( split /[\s,]+/, $portal->{ldapServer} ) {
|
2008-10-05 20:42:50 +02:00
|
|
|
if ( $server =~ m{^ldap\+tls://([^/]+)/?\??(.*)$} ) {
|
|
|
|
$useTls = 1;
|
|
|
|
$server = $1;
|
|
|
|
$tlsParam = $2 || "";
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
$useTls = 0;
|
|
|
|
}
|
2009-03-08 18:37:31 +01:00
|
|
|
push @servers, $server;
|
|
|
|
}
|
|
|
|
$self = Net::LDAP->new(
|
|
|
|
\@servers,
|
2009-10-12 18:55:35 +02:00
|
|
|
onerror => undef,
|
2009-03-08 18:37:31 +01:00
|
|
|
( $portal->{ldapPort} ? ( port => $portal->{ldapPort} ) : () ),
|
2009-10-12 18:55:35 +02:00
|
|
|
);
|
2008-10-07 22:15:48 +02:00
|
|
|
unless ($self) {
|
2009-02-12 20:48:53 +01:00
|
|
|
$portal->lmLog( $@, 'error' );
|
2008-10-07 22:15:48 +02:00
|
|
|
return 0;
|
|
|
|
}
|
2008-10-08 10:45:15 +02:00
|
|
|
bless $self, $class;
|
2008-10-05 20:42:50 +02:00
|
|
|
if ($useTls) {
|
|
|
|
my %h = split( /[&=]/, $tlsParam );
|
2008-10-07 22:15:48 +02:00
|
|
|
$h{cafile} = $portal->{caFile} if ( $portal->{caFile} );
|
|
|
|
$h{capath} = $portal->{caPath} if ( $portal->{caPath} );
|
2009-01-17 20:45:21 +01:00
|
|
|
my $mesg = $self->start_tls(%h);
|
2008-10-07 22:15:48 +02:00
|
|
|
if ( $mesg->code ) {
|
2009-02-12 20:48:53 +01:00
|
|
|
$portal->lmLog( 'StartTLS failed', 'error' );
|
2008-10-07 22:15:48 +02:00
|
|
|
return 0;
|
|
|
|
}
|
2008-10-05 20:42:50 +02:00
|
|
|
}
|
2008-10-07 22:15:48 +02:00
|
|
|
$self->{portal} = $portal;
|
2010-06-21 16:47:27 +02:00
|
|
|
|
|
|
|
# Setting default LDAP password storage encoding to utf-8
|
|
|
|
$self->{portal}->{ldapPwdEnc} ||= 'utf-8';
|
2008-10-07 22:15:48 +02:00
|
|
|
return $self;
|
2008-10-05 20:42:50 +02:00
|
|
|
}
|
|
|
|
|
2008-12-31 16:10:02 +01:00
|
|
|
## @method Net::LDAP::Message bind(string dn, %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
|
2008-10-05 20:42:50 +02:00
|
|
|
sub bind {
|
|
|
|
my $self = shift;
|
2008-10-07 22:15:48 +02:00
|
|
|
my $mesg;
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $dn, %args ) = splice @_;
|
2009-02-12 20:48:53 +01:00
|
|
|
unless ($dn) {
|
2008-12-31 16:10:02 +01:00
|
|
|
$dn = $self->{portal}->{managerDn};
|
|
|
|
$args{password} = $self->{portal}->{managerPassword};
|
|
|
|
}
|
2008-11-05 22:26:37 +01:00
|
|
|
if ( $dn && $args{password} ) {
|
2010-06-21 16:47:27 +02:00
|
|
|
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 ($@);
|
|
|
|
}
|
2008-11-05 22:26:37 +01:00
|
|
|
$mesg = $self->SUPER::bind( $dn, %args );
|
2008-11-21 18:51:52 +01:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
$mesg = $self->SUPER::bind();
|
2008-11-05 22:26:37 +01:00
|
|
|
}
|
|
|
|
return $mesg;
|
2008-10-05 20:42:50 +02:00
|
|
|
}
|
|
|
|
|
2009-04-08 12:32:33 +02:00
|
|
|
our $ppLoaded = 0;
|
|
|
|
|
|
|
|
## @method private boolean loadPP ()
|
|
|
|
# Load Net::LDAP::Control::PasswordPolicy
|
|
|
|
# @return true if succeed.
|
|
|
|
sub loadPP {
|
|
|
|
my $self = shift;
|
|
|
|
return 1 if ($ppLoaded);
|
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
# Minimal version of Net::LDAP required
|
2010-03-24 16:53:55 +01:00
|
|
|
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"
|
|
|
|
);
|
2010-03-24 11:00:52 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
# Require Perl module
|
2009-10-12 18:55:35 +02:00
|
|
|
eval { require Net::LDAP::Control::PasswordPolicy };
|
2009-04-08 12:32:33 +02:00
|
|
|
if ($@) {
|
2009-10-11 13:21:52 +02:00
|
|
|
$self->{portal}->lmLog(
|
2009-04-08 12:32:33 +02:00
|
|
|
"Module Net::LDAP::Control::PasswordPolicy not found in @INC",
|
|
|
|
'error' );
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
$ppLoaded = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method protected int userBind(string dn, %args)
|
2009-05-14 18:19:49 +02:00
|
|
|
# Call bind() with dn/password and return
|
2009-04-08 12:32:33 +02:00
|
|
|
# @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
|
2009-10-12 18:55:35 +02:00
|
|
|
my $mesg = $self->bind( @_, control => [$pp] );
|
2009-04-08 12:32:33 +02:00
|
|
|
|
|
|
|
# Get server control response
|
|
|
|
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
|
|
|
return ( $mesg->code == 0 ? PE_OK : PE_LDAPERROR )
|
|
|
|
unless ( defined $resp );
|
|
|
|
|
|
|
|
# Get expiration warning and graces
|
2010-01-15 23:01:04 +01:00
|
|
|
if ( $resp->grace_authentications_remaining ) {
|
|
|
|
$self->{portal}->info(
|
|
|
|
"<h3>"
|
|
|
|
. $resp->grace_authentications_remaining . " "
|
|
|
|
. &Lemonldap::NG::Portal::_i18n::msg( PM_PP_GRACE,
|
|
|
|
$ENV{HTTP_ACCEPT_LANGUAGE} )
|
|
|
|
. "</h3>"
|
|
|
|
);
|
|
|
|
}
|
|
|
|
if ( $resp->time_before_expiration ) {
|
|
|
|
$self->{portal}->info(
|
|
|
|
"<h3>"
|
|
|
|
. $resp->time_before_expiration . " "
|
|
|
|
. &Lemonldap::NG::Portal::_i18n::msg( PM_PP_EXP_WARNING,
|
|
|
|
$ENV{HTTP_ACCEPT_LANGUAGE} )
|
|
|
|
. "</h3>"
|
|
|
|
);
|
|
|
|
}
|
2009-04-08 12:32:33 +02:00
|
|
|
|
|
|
|
my $pp_error = $resp->pp_error;
|
|
|
|
if ( defined $pp_error ) {
|
2009-10-12 18:55:35 +02:00
|
|
|
$self->{portal}->_sub( 'userError',
|
|
|
|
"Password policy error $pp_error for $self->{portal}->{user}" );
|
2009-05-14 18:19:49 +02:00
|
|
|
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,
|
2009-11-25 13:38:22 +01:00
|
|
|
]->[$pp_error];
|
2009-04-08 12:32:33 +02:00
|
|
|
}
|
|
|
|
elsif ( $mesg->code == 0 ) {
|
|
|
|
return PE_OK;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else {
|
2009-10-12 18:55:35 +02:00
|
|
|
my $mesg = $self->bind(@_);
|
2009-04-08 12:32:33 +02:00
|
|
|
if ( $mesg->code == 0 ) {
|
|
|
|
return PE_OK;
|
|
|
|
}
|
|
|
|
}
|
2009-10-12 18:55:35 +02:00
|
|
|
$self->{portal}
|
|
|
|
->_sub( 'userError', "Bad password for $self->{portal}->{user}" );
|
2009-04-08 12:32:33 +02:00
|
|
|
return PE_BADCREDENTIALS;
|
|
|
|
}
|
|
|
|
|
2009-05-14 18:19:49 +02:00
|
|
|
## @method private int _changePassword(string newpassword,string confirmpassword,string oldpassword)
|
|
|
|
# Change user's password.
|
|
|
|
# @param $newpassword New password
|
|
|
|
# @param $confirmpassword New password
|
|
|
|
# @param $oldpassword Current password
|
|
|
|
# @return Lemonldap::NG::Portal constant
|
|
|
|
sub userModifyPassword {
|
2010-01-31 09:25:05 +01:00
|
|
|
my ( $self, $dn, $newpassword, $confirmpassword, $oldpassword ) = splice @_;
|
2009-05-14 18:19:49 +02:00
|
|
|
my $err;
|
|
|
|
my $mesg;
|
|
|
|
|
|
|
|
# Verify confirmation password matching
|
|
|
|
return PE_PASSWORD_MISMATCH unless ( $newpassword eq $confirmpassword );
|
|
|
|
|
|
|
|
# First case: no ppolicy
|
|
|
|
if ( !$self->{portal}->{ldapPpolicyControl} ) {
|
2009-10-12 18:55:35 +02:00
|
|
|
|
|
|
|
if ( $self->{portal}->{ldapSetPassword} ) {
|
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
# Bind as user if oldpassword and ldapChangePasswordAsUser
|
|
|
|
if ( $oldpassword and $self->{ldapChangePasswordAsUser} ) {
|
|
|
|
|
|
|
|
$mesg = $self->bind( $dn, password => $oldpassword );
|
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code != 0 );
|
|
|
|
}
|
|
|
|
|
2009-05-14 18:19:49 +02:00
|
|
|
# Use SetPassword extended operation
|
|
|
|
use Net::LDAP::Extension::SetPassword;
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg =
|
|
|
|
($oldpassword)
|
|
|
|
? $self->set_password(
|
|
|
|
user => $dn,
|
|
|
|
oldpasswd => $oldpassword,
|
|
|
|
newpassword => $newpassword
|
|
|
|
)
|
|
|
|
: $self->set_password(
|
|
|
|
user => $dn,
|
|
|
|
newpassword => $newpassword
|
|
|
|
);
|
|
|
|
|
2009-05-18 15:53:51 +02:00
|
|
|
# Catch the "Unwilling to perform" error
|
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code == 53 );
|
2009-10-12 18:55:35 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
if ($oldpassword) {
|
|
|
|
|
2009-05-18 15:53:51 +02:00
|
|
|
# Check old password with a bind
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg = $self->bind( $dn, password => $oldpassword );
|
2009-05-18 15:53:51 +02:00
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code != 0 );
|
2009-10-12 18:55:35 +02:00
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
# Rebind as Manager only if user is not granted to change its password
|
|
|
|
$self->bind()
|
|
|
|
unless $self->{portal}->{ldapChangePasswordAsUser};
|
2009-05-18 15:53:51 +02:00
|
|
|
}
|
2009-10-12 18:55:35 +02:00
|
|
|
|
2009-05-14 18:19:49 +02:00
|
|
|
# Use standard modification
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg =
|
|
|
|
$self->modify( $dn, replace => { userPassword => $newpassword } );
|
2009-05-14 18:19:49 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
return PE_WRONGMANAGERACCOUNT
|
|
|
|
if ( $mesg->code == 50 || $mesg->code == 8 );
|
|
|
|
return PE_LDAPERROR unless ( $mesg->code == 0 );
|
2009-10-12 18:55:35 +02:00
|
|
|
$self->{portal}
|
|
|
|
->_sub( 'userNotice', "Password changed $self->{portal}->{user}" );
|
2009-05-14 18:19:49 +02:00
|
|
|
return PE_PASSWORD_OK;
|
|
|
|
}
|
|
|
|
else {
|
2009-10-12 18:55:35 +02:00
|
|
|
|
2009-05-14 18:19:49 +02:00
|
|
|
# Create Control object
|
|
|
|
my $pp = Net::LDAP::Control::PasswordPolicy->new;
|
|
|
|
|
2009-10-12 18:55:35 +02:00
|
|
|
if ( $self->{portal}->{ldapSetPassword} ) {
|
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
# Bind as user if oldpassword and ldapChangePasswordAsUser
|
|
|
|
if ( $oldpassword and $self->{ldapChangePasswordAsUser} ) {
|
|
|
|
|
|
|
|
$mesg = $self->bind( $dn, password => $oldpassword );
|
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code != 0 );
|
|
|
|
}
|
|
|
|
|
2009-11-25 13:38:22 +01:00
|
|
|
# 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
|
2009-05-14 18:19:49 +02:00
|
|
|
use Net::LDAP::Extension::SetPassword;
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg =
|
|
|
|
($oldpassword)
|
|
|
|
? $self->set_password(
|
|
|
|
user => $dn,
|
|
|
|
oldpasswd => $oldpassword,
|
|
|
|
newpassword => $newpassword,
|
|
|
|
control => [$pp]
|
|
|
|
)
|
|
|
|
: $self->set_password(
|
|
|
|
user => $dn,
|
|
|
|
newpassword => $newpassword,
|
|
|
|
control => [$pp]
|
|
|
|
);
|
|
|
|
|
2009-05-18 15:53:51 +02:00
|
|
|
# Catch the "Unwilling to perform" error
|
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code == 53 );
|
2009-10-12 18:55:35 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
if ($oldpassword) {
|
|
|
|
|
2009-05-18 15:53:51 +02:00
|
|
|
# Check old password with a bind
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg = $self->bind( $dn, password => $oldpassword );
|
2009-05-18 15:53:51 +02:00
|
|
|
return PE_BADOLDPASSWORD if ( $mesg->code != 0 );
|
2009-10-12 18:55:35 +02:00
|
|
|
|
2010-03-24 11:00:52 +01:00
|
|
|
# Rebind as Manager only if user is not granted to change its password
|
|
|
|
$self->bind()
|
|
|
|
unless $self->{portal}->{ldapChangePasswordAsUser};
|
2009-05-18 15:53:51 +02:00
|
|
|
}
|
2009-10-12 18:55:35 +02:00
|
|
|
|
2009-05-14 18:19:49 +02:00
|
|
|
# Use standard modification
|
2009-10-12 18:55:35 +02:00
|
|
|
$mesg = $self->modify(
|
|
|
|
$dn,
|
|
|
|
replace => { userPassword => $newpassword },
|
|
|
|
control => [$pp]
|
|
|
|
);
|
2009-05-14 18:19:49 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
# Get server control response
|
|
|
|
my ($resp) = $mesg->control("1.3.6.1.4.1.42.2.27.8.5.1");
|
|
|
|
|
|
|
|
return PE_WRONGMANAGERACCOUNT
|
|
|
|
if ( $mesg->code == 50 || $mesg->code == 8 );
|
|
|
|
if ( $mesg->code == 0 ) {
|
2009-10-12 18:55:35 +02:00
|
|
|
$self->{portal}->_sub( 'userNotice',
|
|
|
|
"Password changed $self->{portal}->{user}" );
|
2009-05-14 18:19:49 +02:00
|
|
|
return PE_PASSWORD_OK;
|
|
|
|
}
|
|
|
|
|
|
|
|
if ( defined $resp ) {
|
|
|
|
my $pp_error = $resp->pp_error;
|
|
|
|
if ( defined $pp_error ) {
|
2009-10-12 18:55:35 +02:00
|
|
|
$self->{portal}->_sub( 'userError',
|
2009-11-25 13:38:22 +01:00
|
|
|
"Password policy error $pp_error for $self->{portal}->{user}"
|
2009-10-12 18:55:35 +02:00
|
|
|
);
|
2009-05-14 18:19:49 +02:00
|
|
|
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;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-02-15 09:53:44 +01:00
|
|
|
## @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} ) );
|
|
|
|
if ( $self->{ldap} = Lemonldap::NG::Portal::_LDAP->new($self)
|
|
|
|
and my $mesg = $self->{ldap}->bind )
|
|
|
|
{
|
2009-10-12 18:55:35 +02:00
|
|
|
if ( $mesg->code != 0 ) {
|
|
|
|
$self->lmLog( "LDAP error: " . $mesg->error, 'error' );
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
if ( $self->{ldapPpolicyControl} and not $self->{ldap}->loadPP() ) {
|
2009-11-25 13:38:22 +01:00
|
|
|
$self->lmLog( "LDAP password policy error", 'error' );
|
2009-10-12 18:55:35 +02:00
|
|
|
}
|
|
|
|
else {
|
|
|
|
return $self->{ldap};
|
|
|
|
}
|
|
|
|
}
|
2009-02-15 09:53:44 +01:00
|
|
|
}
|
|
|
|
else {
|
2009-05-14 18:19:49 +02:00
|
|
|
$self->lmLog( "LDAP error: $@", 'error' );
|
2009-02-15 09:53:44 +01:00
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2010-02-05 15:17:55 +01:00
|
|
|
## @method string searchGroups(string base, string key, string value, string attributes)
|
|
|
|
# Get groups from LDAP directory
|
|
|
|
# @param string base LDAP search base
|
|
|
|
# @param string key Attribute name in group containing searched value
|
|
|
|
# @param string value Searched value
|
|
|
|
# @param string attributes to get from found groups (array ref)
|
2010-04-15 13:15:36 +02:00
|
|
|
# @return string groups separated with multiValuesSeparator
|
2010-02-05 15:17:55 +01:00
|
|
|
sub searchGroups {
|
|
|
|
my $self = shift;
|
|
|
|
my $base = shift;
|
|
|
|
my $key = shift;
|
|
|
|
my $value = shift;
|
|
|
|
my $attributes = shift;
|
|
|
|
|
|
|
|
my $portal = $self->{portal};
|
|
|
|
my $groups;
|
|
|
|
|
|
|
|
# Creating search filter
|
|
|
|
my $searchFilter =
|
|
|
|
"(&(objectClass=" . $portal->{ldapGroupObjectClass} . ")(|";
|
2010-04-15 13:15:36 +02:00
|
|
|
foreach ( split( $portal->{multiValuesSeparator}, $value ) ) {
|
2010-02-05 15:17:55 +01:00
|
|
|
$searchFilter .= "(" . $key . "=" . $_ . ")";
|
|
|
|
}
|
|
|
|
$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
|
2010-03-01 21:32:28 +01:00
|
|
|
my $group_value =
|
|
|
|
$self->getLdapValue( $entry,
|
|
|
|
$portal->{ldapGroupAttributeNameGroup} );
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-03-01 21:32:28 +01:00
|
|
|
# Launch group search
|
2010-02-05 15:17:55 +01:00
|
|
|
if ($group_value) {
|
|
|
|
|
|
|
|
$portal->lmLog( "Recursive search for $group_value",
|
|
|
|
'debug' );
|
|
|
|
|
|
|
|
my $recursive_groups =
|
|
|
|
$self->searchGroups( $base, $key, $group_value,
|
|
|
|
$attributes );
|
|
|
|
|
2010-04-15 13:15:36 +02:00
|
|
|
$groups .=
|
|
|
|
$recursive_groups . $portal->{multiValuesSeparator}
|
|
|
|
if ($recursive_groups);
|
2010-02-05 15:17:55 +01:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
# Now parse attributes
|
|
|
|
foreach (@$attributes) {
|
|
|
|
|
|
|
|
# Next if group attribute value
|
|
|
|
next if ( $_ eq $portal->{ldapGroupAttributeValueGroup} );
|
|
|
|
|
|
|
|
my $data = $entry->get_value($_);
|
|
|
|
|
|
|
|
if ($data) {
|
|
|
|
$portal->lmLog( "Store $data in groups", 'debug' );
|
|
|
|
$groups .= $data . "|";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
$groups =~ s/\|$//g;
|
2010-04-15 13:15:36 +02:00
|
|
|
$groups .= $portal->{multiValuesSeparator};
|
2010-02-05 15:17:55 +01:00
|
|
|
}
|
|
|
|
|
2010-04-15 13:15:36 +02:00
|
|
|
$groups =~ s/\Q$portal->{multiValuesSeparator}\E$//;
|
2010-02-05 15:17:55 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
return $groups;
|
|
|
|
}
|
|
|
|
|
|
|
|
## @method string getLdapValue(Net::LDAP::Entry entry, string attribute)
|
2010-04-15 13:15:36 +02:00
|
|
|
# Get the dn, or the attribute value with a separator for multi-valuated attributes
|
2010-02-05 15:17:55 +01:00
|
|
|
# @param Net::LDAP::Entry LDAP entry
|
|
|
|
# @param string attribute name
|
|
|
|
# @return string value
|
|
|
|
sub getLdapValue {
|
2010-03-01 21:32:28 +01:00
|
|
|
my $self = shift;
|
|
|
|
my $entry = shift;
|
|
|
|
my $attribute = shift;
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-03-01 21:32:28 +01:00
|
|
|
return $entry->dn() if ( $attribute eq "dn" );
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-03-01 21:32:28 +01:00
|
|
|
my $value;
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-03-01 21:32:28 +01:00
|
|
|
foreach ( $entry->get_value($attribute) ) {
|
|
|
|
$value .= $_;
|
2010-04-15 13:15:36 +02:00
|
|
|
$value .= $self->{portal}->{multiValuesSeparator};
|
2010-03-01 21:32:28 +01:00
|
|
|
}
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-04-15 13:15:36 +02:00
|
|
|
$value =~ s/\Q$self->{portal}->{multiValuesSeparator}\E$//;
|
2010-02-05 15:17:55 +01:00
|
|
|
|
2010-03-01 21:32:28 +01:00
|
|
|
return $value;
|
2010-02-05 15:17:55 +01:00
|
|
|
}
|
|
|
|
|
2008-10-05 20:42:50 +02:00
|
|
|
1;
|