view release on metacpan or  search on metacpan

lib/Catalyst/Authentication/Store/LDAP/Backend.pm  view on Meta::CPAN

    }
    my $filter = $self->_replace_filter( $self->user_filter, $id );
    push( @searchopts, 'filter' => $filter );
    push( @searchopts, 'scope'  => $self->user_scope );
    if ( defined( $self->user_search_options ) ) {
        push( @searchopts, %{ $self->user_search_options } );
    }
    my $usersearch = $ldap->search(@searchopts);

    return undef if ( $usersearch->is_error );

    my $userentry;
    my $user_field     = $self->user_field;
    my $results_filter = $self->user_results_filter;
    my $entry;
    if ( defined($results_filter) ) {
        $entry = &$results_filter($usersearch);
    }
    else {
        $entry = $usersearch->pop_entry;
    }
    if ( $usersearch->pop_entry ) {
        Catalyst::Exception->throw(
                  "More than one entry matches user search.\n"
                . "Consider defining a user_results_filter sub." );
    }

    # a little extra sanity check with the 'eq' since LDAP already
    # says it matches.
    # NOTE that Net::LDAP returns exactly what you asked for, but
    # because LDAP is often case insensitive, FoO can match foo
    # and so we normalize with lc().
    if ( defined($entry) ) {
        unless ( lc( $entry->get_value($user_field) ) eq lc($id) ) {
            Catalyst::Exception->throw(
                "LDAP claims '$user_field' equals '$id' but results entry does not match."
            );
        }
        $userentry = $entry;
    }

    $ldap->unbind;
    $ldap->disconnect;
    unless ($userentry) {
        return undef;
    }
    my $attrhash;
    foreach my $attr ( $userentry->attributes ) {
        my @attrvalues = $userentry->get_value($attr);
        if ( scalar(@attrvalues) == 1 ) {
            $attrhash->{ lc($attr) } = $attrvalues[0];
        }
        else {
            $attrhash->{ lc($attr) } = \@attrvalues;
        }
    }

    eval { Catalyst::Utils::ensure_class_loaded( $self->entry_class ) };
    if ( !$@ ) {
        bless( $userentry, $self->entry_class );
        $userentry->{_use_unicode}++;
    }
    my $rv = {
        'ldap_entry' => $userentry,
        'attributes' => $attrhash,
    };
    return $rv;
}

=head2 lookup_roles($userobj, [$ldap])

This method looks up the roles for a given user.  It takes a
L<Catalyst::Authentication::Store::LDAP::User> object
as its first argument, and can optionally take a I<Net::LDAP> object which
is used rather than the default binding if supplied.

It returns an array containing the role_field attribute from all the
objects that match its criteria.

=cut

sub lookup_roles {
    my ( $self, $userobj, $ldap ) = @_;
    if ( $self->use_roles == 0 || $self->use_roles =~ /^false$/i ) {
        return ();
    }
    $ldap ||= $self->role_search_as_user
        ? $userobj->ldap_connection : $self->ldap_bind;
    my @searchopts;
    if ( defined( $self->role_basedn ) ) {
        push( @searchopts, 'base' => $self->role_basedn );
    }
    else {
        Catalyst::Exception->throw(
            "You must set up role_basedn before looking up roles!");
    }
    my $filter_value = $userobj->has_attribute( $self->role_value );
    if ( !defined($filter_value) ) {
        Catalyst::Exception->throw( "User object "
                . $userobj->username
                . " has no "
                . $self->role_value
                . " attribute, so I can't look up its roles!" );
    }
    my $filter = $self->_replace_filter( $self->role_filter, $filter_value );
    push( @searchopts, 'filter' => $filter );
    push( @searchopts, 'scope'  => $self->role_scope );
    push( @searchopts, 'attrs'  => [ $self->role_field ] );
    if ( defined( $self->role_search_options ) ) {
        push( @searchopts, %{ $self->role_search_options } );
    }
    my $rolesearch = $ldap->search(@searchopts);
    my @roles;
RESULT: foreach my $entry ( $rolesearch->entries ) {
        push( @roles, $entry->get_value( $self->role_field ) );
    }
    return @roles;
}

sub _replace_filter {
    my $self    = shift;