LDAP.pm 4.03 KB
Newer Older
1 2 3 4
package Lemonldap::NG::Portal::UserDB::LDAP;

use strict;
use Mouse;
5 6
use Lemonldap::NG::Portal::Main::Constants
  qw(PE_OK PE_LDAPCONNECTFAILED PE_LDAPERROR PE_BADCREDENTIALS);
7

Xavier Guimard's avatar
Xavier Guimard committed
8
extends 'Lemonldap::NG::Portal::Lib::LDAP';
9

Xavier Guimard's avatar
Xavier Guimard committed
10 11 12 13
our $VERSION = '2.0.0';

has ldapGroupAttributeNameSearch => (
    is      => 'rw',
14
    lazy    => 1,
Xavier Guimard's avatar
Xavier Guimard committed
15
    builder => sub {
16 17 18 19 20 21 22 23
        my $attributes = [];
        @$attributes =
          split( /\s+/, $_[0]->{conf}->{ldapGroupAttributeNameSearch} )
          if $_[0]->{conf}->{ldapGroupAttributeNameSearch};
        push( @$attributes, $_[0]->{conf}->{ldapGroupAttributeNameGroup} )
          if (  $_[0]->{conf}->{ldapGroupRecursive}
            and $_[0]->{conf}->{ldapGroupAttributeNameGroup} ne "dn" );
        return $attributes;
Xavier Guimard's avatar
Xavier Guimard committed
24 25 26 27 28
    }
);

has attrs => (
    is      => 'rw',
29
    lazy    => 1,
Xavier Guimard's avatar
Xavier Guimard committed
30 31 32 33 34 35 36 37
    builder => sub {
        return [
            values %{ $_[0]->{conf}->{exportedVars} },
            values %{ $_[0]->{conf}->{ldapExportedVars} }
        ];
    }
);

Xavier Guimard's avatar
Xavier Guimard committed
38 39
# RUNNING METHODS

Xavier Guimard's avatar
Xavier Guimard committed
40 41
sub getUser {
    my ( $self, $req ) = @_;
Xavier Guimard's avatar
Xavier Guimard committed
42
    return PE_LDAPCONNECTFAILED unless $self->ldap and $self->bind();
Xavier Guimard's avatar
Xavier Guimard committed
43 44 45 46 47 48 49 50
    my $mesg = $self->ldap->search(
        base   => $self->conf->{ldapBase},
        scope  => 'sub',
        filter => $self->filter->($req),
        defer  => $self->conf->{ldapSearchDeref} || 'find',
        attrs  => $self->attrs,
    );
    if ( $mesg->code() != 0 ) {
51
        $self->logger->error( 'LDAP Search error: ' . $mesg->error );
Xavier Guimard's avatar
Xavier Guimard committed
52 53 54
        return PE_LDAPERROR;
    }
    if ( $mesg->count() > 1 ) {
55
        $self->logger->error('More than one entry returned by LDAP directory');
56
        eval { $self->p->_authentication->setSecurity($req) };
Xavier Guimard's avatar
Xavier Guimard committed
57 58
        return PE_BADCREDENTIALS;
    }
Xavier Guimard's avatar
Xavier Guimard committed
59
    unless ( $req->datas->{entry} = $mesg->entry(0) ) {
Xavier Guimard's avatar
Xavier Guimard committed
60
        my $user = $req->{mail} || $req->{user};
61
        $self->userLogger->warn("$user was not found in LDAP directory");
62
        eval { $self->p->_authentication->setSecurity($req) };
Xavier Guimard's avatar
Xavier Guimard committed
63 64 65 66 67 68 69 70 71 72 73 74
        return PE_BADCREDENTIALS;
    }
    $req->datas->{dn} = $req->datas->{entry}->dn();
    PE_OK;
}

# 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, $req ) = @_;
75
    $req->{sessionInfo}->{_dn} = $req->datas->{dn};
Xavier Guimard's avatar
Xavier Guimard committed
76 77 78 79

    my %vars = ( %{ $self->conf->{exportedVars} },
        %{ $self->conf->{ldapExportedVars} } );
    while ( my ( $k, $v ) = each %vars ) {
80
        $req->sessionInfo->{$k} =
81
          $self->ldap->getLdapValue( $req->datas->{entry}, $v ) || "";
Xavier Guimard's avatar
Xavier Guimard committed
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
    }

    PE_OK;
}

# Load all groups in $groups.
# @return Lemonldap::NG::Portal constant
sub setGroups {
    my ( $self, $req ) = @_;
    my $groups  = $req->{sessionInfo}->{groups};
    my $hGroups = $req->{sessionInfo}->{hGroups};

    if ( $self->conf->{ldapGroupBase} ) {

        # Get value for group search
        my $group_value = $self->ldap->getLdapValue( $req->datas->{entry},
            $self->conf->{ldapGroupAttributeNameUser} );

100
        $self->logger->debug( "Searching LDAP groups in "
101
              . $self->conf->{ldapGroupBase}
102
              . " for $group_value" );
Xavier Guimard's avatar
Xavier Guimard committed
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119

        # Call searchGroups
        my $ldapGroups = $self->ldap->searchGroups(
            $self->conf->{ldapGroupBase},
            $self->conf->{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;
            }
120 121
            $groups .= $self->conf->{multiValuesSeparator} if $groups;
            $groups .= join( '|', @$groupValues );
Xavier Guimard's avatar
Xavier Guimard committed
122 123 124 125
        }

    }

126
    $req->{sessionInfo}->{groups}  = $groups;
127
    $req->{sessionInfo}->{hGroups} = $hGroups;
Xavier Guimard's avatar
Xavier Guimard committed
128 129 130
    PE_OK;
}

131
1;